; UNIT XFER; {Copyright 1983, 1984 Apple Computer, Inc.}

; {changed 01/20/83 2026   Added EqualBytes
; {changed 01/05/83 2149   Moved several routines to CLASLIB so they can go into PASLIB;
;                          Here we still have (in SgCLAres):
;                               LIntDivLint, LIntDivInt, LIntMulInt, LIntAndLInt, LIntOrLInt,
;                               XferLeft, XferRight, RotatePattern, EnterLisabug}
; {changed 01/01/83 2000   Added %_JmpTo, %_ExitCaller, %_ExitFunny, %_CallMethod, %_Super;
;                          Replaced IsJsr by %_NextMethod;
;                          Deleted XPNewMethod;
;                          Changed Segment from SgABCres to SgCLAres & added some SgCLAini procedures;
;                          Added $D information conditioned on DEBUGF flag;
;                          (Note: SP=A7)}
; {changed 09/13/83 1115   RELEASE TK7D TO TOOLKIT TEAM}
; {changed 08/30/83 2000   RELEASE TK7C TO TOOLKIT TEAM}


;=============================================================================================
DEBUGF  .EQU  1                 ; 1 to include $D+ info, 0 to exclude it
;=============================================================================================

        .MACRO HEAD
          .IF DEBUGF
            LINK    A6,#0       ; These two instructions form a slow no-op
            MOVE.L  (SP)+,A6
          .ENDC
        .ENDM

        .MACRO TAIL
          .IF DEBUGF
            UNLK    A6
            RTS
            .ASCII  %1
          .ENDC
        .ENDM


;=============================================================================================
        .SEG    'SgXFER'
;=============================================================================================


        .PROC XFERLEFT
        HEAD

; PROCEDURE XferLeft(source, dest: TP; nBytes: INTEGER);
;
; uses A0,A1,D0,D1
;

        MOVE.L  (SP)+,D1        ; POP RETURN ADDRESS
        MOVE.W  (SP)+,D0        ; D0 := NBYTES
        MOVE.L  (SP)+,A1        ; A1 := DEST
        MOVE.L  (SP)+,A0        ; A0 := SOURCE
        MOVE.L  D1,-(SP)        ; PUSH RETURN ADDRESS FOR RTS

        SUB.W   #1,D0           ; DECREMENT NBYTES

        BLT.S   RTSLEFT         ; NBYTES <= 0, SO EXIT

XFER    MOVE.B  (A0)+,(A1)+
        DBF     D0,XFER

RTSLEFT RTS

        TAIL    'XFERLEFT'

;=============================================================================================

        .PROC XFERRIGH
        HEAD

; PROCEDURE XferRight(source, dest: TP; nBytes: INTEGER);
;
; uses A0,A1,D0,D1
;

        MOVE.L  (SP)+,D1        ; POP RETURN ADDRESS
        MOVE.W  (SP)+,D0        ; D0 := NBYTES
        MOVE.L  (SP)+,A1        ; A1 := DEST
        MOVE.L  (SP)+,A0        ; A0 := SOURCE
        MOVE.L  D1,-(SP)        ; PUSH RETURN ADDRESS FOR RTS

        TST.W   D0              ; TEST NBYTES
        BLE.S   RTSRIGH         ; NBYTES <= 0, SO EXIT

        ADDA.W  D0,A0           ; START AT RIGHT END
        ADDA.W  D0,A1

        SUB.W   #1,D0           ; DECREMENT NBYTES

XFER    MOVE.B  -(A0),-(A1)
        DBF     D0,XFER

RTSRIGH RTS

        TAIL    'XFERRIGH'

;=============================================================================================

        .PROC EqualBytes
        HEAD

; PROCEDURE EqualBytes(source, dest: TP; nBytes: INTEGER);
;
; uses A0,A1,D0,D1
;

        MOVE.L  (SP)+,D1        ; POP RETURN ADDRESS
        MOVE.W  (SP)+,D0        ; D0 := NBYTES
        MOVE.L  (SP)+,A1        ; A1 := DEST
        MOVE.L  (SP)+,A0        ; A0 := SOURCE
        MOVE.L  D1,-(SP)        ; PUSH RETURN ADDRESS FOR RTS

        MOVE.B  #1,4(SP)        ; RETURN TRUE UNLESS PROVEN UNEQUAL

        SUB.W   #1,D0           ; DECREMENT NBYTES

        BLT.S   RTSEQUL         ; NBYTES <= 0, SO EXIT

XFER    MOVE.B  (A0)+,D1
        CMP.B   (A1)+,D1
        BNE     UNEQUL
        DBF     D0,XFER

RTSEQUL RTS

UNEQUL  CLR.B   4(SP)           ; RETURN FALSE
        RTS

        TAIL    'EQUALBYT'

;=============================================================================================


        .PROC ROTATEPA
        HEAD

; PROCEDURE RotatePattern(pInPat, pOutPat: ^Pattern; dh, dv: LONGINT);
;
; uses A0-A2,D0-D4
;

        MOVEM.L (SP)+,D0-D2/A0-A1  ; D0 := RETURN ADDRESS, D1 := dv; D2 := dh, A0 := pOutPat, A1 := pInPat
        MOVE.L  D0,-(SP)           ; PUSH RETURN ADDRESS FOR RTS
        MOVEM.L A2/D3-D4,-(SP)     ; Save A2,D3,D4

        AND.L   #7,D2              ; dh := dh MOD 8

; ***** FOR D3 := 7 DOWNTO 0 DO *****

        MOVE.W  #7,D3           ; Loop count

; *****    BEGIN *****

RLOOP   MOVE.B  $00(A1,D3.W),D0 ; D0 := next byte in inPat

        ROL.B   D2,D0           ; Rotate byte in D0 left by D2 (dh)

        MOVE.W  D3,D4
        SUB.W   D1,D4
        AND.W   #7,D4           ; D4 := (D3 - dv) MOD 8

        MOVE.B  D0,$00(A0,D4.W) ; next byte in outPat := D0

        DBF     D3,RLOOP

; *****    END; *****

        MOVEM.L (SP)+,A2/D3-D4  ; Restore A2,D3,D4

        RTS

        TAIL    'ROTATEPA'

;=============================================================================================

        .FUNC LINTDIVL
        HEAD

; FUNCTION  LIntDivLint(i, j: LONGINT): LONGINT;
;
; uses A0,D0,D1
;

        .REF    LD

        MOVE.L  (SP)+,A0        ; Return address

        MOVE.L  (SP)+,D0        ; D0 := j
        MOVE.L  (SP)+,D1        ; D1 := i

CHEK    CMP.L   #32767,D0       ; Is j too long to use LIntDivInt?
        BGT     TOOLONG         ; Too big
        CMP.L   #-32768,D0
        BLT     TOOLONG         ; Too small
        JMP     LD              ; Can't BGT LD in this assembler

TOOLONG ASR.L   #1,D0
        ASR.L   #1,D1
        JMP     CHEK

        TAIL    'LINTDIVL'

;=============================================================================================

        .FUNC LINTDIVI
        HEAD

; FUNCTION  LIntDivInt(i: LONGINT; j: INTEGER): LONGINT;
;
; uses A0,D0,D1,D2
;

        .DEF    LD

        MOVE.L  (SP)+,A0        ; Return address

        MOVE.W  (SP)+,D0        ; D0 := j
        MOVE.L  (SP)+,D1        ; D1 := i

LD      CMP.W   #1,D0           ; IF j = 1, return i
        BEQ     DV1

        MOVE.L  D1,-(SP)        ; Push i as LONGINT
        MOVE.W  D0,-(SP)        ; Push j as INTEGER

        CLR.L   D1

        TST.W   (SP)            ; If j is negative, negate both
        BGE     JPOS
        NEG.W   (SP)            ; negate j
        NEG.L   2(SP)           ; negate i

JPOS    TST.L   2(SP)           ; If i is negative, negate it but remember it was
        SMI     D2              ; D2 := (i < 0)
        BGE     IPOS
        NEG.L   2(SP)           ; negate i

IPOS    MOVE.W  2(SP),D1        ; Divide MSW of i by j
        DIVU    (SP),D1

        MOVE.L  D1,D0           ; Remainder becomes MSW of next Divide
        MOVE.W  4(SP),D0        ; Divide ((preceding remainder) concat (LSW of i)) by j
        DIVU    (SP)+,D0        ; Pop j at the same time

        SWAP    D1              ; Quotient of first divide is MSW of result
        MOVE.W  D0,D1           ; Quotient of second divide is LSW of result

        TST.B   D2              ; Was i negative?
        BEQ     DUN
        NEG.L   D1

DUN     ADD.L   #4,SP           ; Popeye

DV1     MOVE.L  D1,(SP)         ; Store function result

        JMP     (A0)            ; Return

        TAIL    'LINTDIVI'

;=============================================================================================

        .FUNC LINTMULI
        HEAD

; FUNCTION  LIntMulInt(i: LONGINT; j: INTEGER): LONGINT;
;
; uses A0,D0,D1,D2
;

        MOVE.L  (SP)+,A0        ; Return address

        MOVE.W  (SP)+,D1        ; D1 := j
        MOVE.L  (SP)+,D0        ; D0 := i

        CMP.W   #1,D1           ; IF j = 1, return i
        BEQ     MU1

        MOVE.L  D2,-(SP)        ; Save D2

        MOVE.W  D0,D2           ; D2 := LSW of I
        SWAP    D0              ; D0 := MSW of I

        MULU    D1,D0           ; D0 := D0 * j
        LSL.L   #8,D0
        LSL.L   #8,D0
        MULU    D1,D2
        ADD.L   D2,D0           ; D0 := product

        MOVE.L  (SP)+,D2        ; restore D2

MU1     MOVE.L  D0,(SP)         ; Store function result

        JMP     (A0)            ; Return

        TAIL    'LINTMULI'

;=============================================================================================

        .FUNC LINTANDL
        HEAD

; FUNCTION  LIntAndLInt(i, j: LONGINT): LONGINT;
;
; uses A0,D0
;

        MOVE.L  (SP)+,A0        ; Return address

        MOVE.L  (SP)+,D0        ; D0 := j
        AND.L   (SP)+,D0        ; D0 := i AND j

        MOVE.L  D0,(SP)         ; Store function result

        JMP     (A0)            ; Return

        TAIL    'LINTANDL'

;=============================================================================================

        .FUNC LINTORLI
        HEAD

; FUNCTION  LIntOrLInt(i, j: LONGINT): LONGINT;
;
; uses A0,D0
;

        MOVE.L  (SP)+,A0        ; Return address

        MOVE.L  (SP)+,D0        ; D0 := j
        OR.L    (SP)+,D0        ; D0 := i OR j

        MOVE.L  D0,(SP)         ; Store function result

        JMP     (A0)            ; Return

        TAIL    'LINTORLI'

;=============================================================================================

        .FUNC LINTXORL
        HEAD

; FUNCTION  LIntXorLInt(i, j: LONGINT): LONGINT;
;
; uses A0,D0, D1
;

        MOVE.L  (SP)+,A0        ; Return address

        MOVE.L  (SP)+,D0        ; D0 := j
        MOVE.L  (SP)+,D1        ; D1 := i
        EOR.L   D1,D0           ; D0 := i XOR j

        MOVE.L  D0,(SP)         ; Store function result

        JMP     (A0)            ; Return

        TAIL    'LINTXORL'

;=============================================================================================

        .PROC ENTERLIS
        HEAD

; PROCEDURE EnterLisabug;

        TRAP    #0
        RTS

        TAIL    'ENTERLIS'

;=============================================================================================


        .END