Subversion Repositories NedoOS

;
; LONG function for long integer package:
;

        ;INCLUDE "bds.lib"


        FUNCTION "LONG"
        FUNCHEAD longsz

; temporary storage is allocated in the
; "args" area of the run-time environment

u       equ  args       ;temporary quad storage (4 bytes)
uh      equ  u          ;high word of u
ul      equ  u+2        ;low word of u
mq      equ  u+4        ;temporary quad storage used by
                        ;multiplication and division routines
temp    equ  mq+4       ;temporary storage byte used by div'n routine


; long is main routine which dispatches to the various functions
; of the package according to the value of its first argument

long:   push bc         ;save for benefit of caller
        call ma2toh     ;get 1st arg (function code) into HL and A
        ld  d,h
        ld  e,l
        add hl,hl
        add hl,de               ;HL now has triple the function code
        ld de,jtab      ;base of jump table
        add hl,de
        jp (hl)         ;dispatch to appropriate function

jtab:   jp  lmake       ;jump table for quad functions
        jp  lcomp
        jp  ladd
        jp  lsub
        jp  lmul
        jp  ldiv
        jp  lmod


; lmake converts integer (arg3) to a long (arg2)

lmake:  call ma4toh     ;get arg3 into HL
        ld  a,h ;look at sign first
        or  a
        push af ;save it
        call m,cmh      ;take abs value
        ex de,hl                ;into (DE)
        ld bc,0 ;zero out high word
        pop  af
        call m,qneg     ;complement if necessary
        jp  putarg      ;copy result into arg2 and return

;all other routines copy their arguments into the quad register (BCDE)
;and the temporary quad storage location u  (note that temporary storage
;must be used to keep the routines from clobbering the user's arguments)


;lcomp compares arg2 with arg3, returns -1, 0, 1 for <, =, >, resp

lcomp:  call ma3toh     ;get pointer to arg2
        call qld        
        ld hl,u
        call qst        ;arg2 now in u
        call ma4toh     ;get pointer to arg3
        call qld        ;arg3 now in (BCDE)
        ld hl,-1        ;presume <
        call qsub
        call qtst
        pop bc          ;restore bc for caller
        ret m
        inc hl
        ret z
        inc hl
        ret

; long addition

ladd:   call getargs    ;get args into (BCDE) and u
        call qadd       ;do the addition
        jp  putarg      ;copy result into arg2 and return

lsub:   call getargs
        call qsub
        jp  putarg

lmul:   call getargs
        call qmul
        jp  putarg

ldiv:   call getargs
        call qdiv
        jp  putarg

lmod:   call getargs
        call qmod
        jp  putarg

;getargs gets arg3 into u, arg4 into (BCDE)

getargs:
        call ma5toh             ;get ptr to arg3 (note use ma5 cause of 
                                ;return addr on stack)
        call qld                ;arg3 now in (BCDE)
        ld hl,u
        call qst                ;now in u
        call ma6toh             ;get ptr to arg4
        jp  qld         ;arg4 now in (BCDE)


; putarg copies (BCDE) into result arg (arg2) and cleans up

putarg: call ma3toh             ;get pointer to arg2
        call qst                ;copy (BCDE) into it
        pop bc                  ;restore BC for caller
        ret



; quad subtraction  u - (BCDE) -> (BCDE)

qsub:   call qneg       ;complement (BCDE) and fall thru to add

; quad addition     u + (BCDE) -> (BCDE)

qadd:   push hl
        ld hl,u+3       ;tenSHUN
        ld  a,(hl)      ;hup
        add  e          ;two
        ld  e,a ;three
        dec hl          ;four
        ld  a,(hl)      ;hup
        adc  d          ;two
        ld  d,a ;three
        dec hl          ;four
        ld  a,(hl)      ;hup
        adc  c          ;two
        ld  c,a ;three
        dec hl          ;four
        ld  a,(hl)      ;hup
        adc  b          ;two
        ld  b,a ;three
        pop hl          ;four
        ret             ;at ease        
        

; two's complement (BCDE)

qneg:   push hl
        xor  a
        ld  l,a
        sbc  e
        ld  e,a
        ld  a,l
        sbc  d
        ld  d,a
        ld  a,l
        sbc  c
        ld  c,a
        ld  a,l
        sbc  b
        ld  b,a
        pop hl
        ret


qneghl: push bc
        push de
        call qld
        call qneg
        call qst
        pop de
        pop bc
        ret

; signed quad multiplication
; u * (BCDE) --> (BCDE)

qmul:   call csign                      ;take abs values and compute signs
        push af                 ;save result sign
        call uqmul                      ;compute product
qmul1:  pop  af
        jp m,qneg                       ;complement product if needed
        ret

; csign takes abs vals of u, (BCDE), and computes product of their signs

csign:  ld  a,b                 ;look at (BCDE) first
        or  a
        push af                 ;save flags
        call m,qneg                     ;complement if needed
        ld hl,u                 ;now look at u
        ld  a,(hl)
        or  a
        jp   csign1
        call qneghl
        pop  af
        xor  80h                        ;flip sign
        ret
csign1: pop af
        ret

; unsigned quad multiplication 
; u * (BCDE) --> (BCDE)     (expects ptr. to u in (HL)

uqmul:  ld hl,u
        push hl                         ;put pointer to u on stack
        ld hl,mq
        call qst                        ;(BCDE) -> mq
        ld bc,0                 ;init product to 0
        ld de,0
uqmul1: call qtsthl                     ;test if mq is 0
        jp z,uqmul2                     ;if so, done
        xor  a                          ;clear carry
        call qrarhl                     ;shift mq over
        call c,qadd                     ;add u to (BCDE) if lsb=1
        ex (sp),hl                              ;get pointer to u
        xor  a                          ;clear carry
        call qralhl                     ;double u
        ex (sp),hl                              ;get back pointer to mq
        jp  uqmul1
uqmul2: pop hl                          ;restore stack
        ret

; signed division  u / (BCDE) --> (BCDE)

qdiv:   call qtst                       ;first test for zero divisor
        ret z
        call csign                      ;take care of signs
        push af                 ;save quotient sign
        call uqdiv
        call qld                        ;get quotient in (BCDE)
        jp  qmul1                       ;adjust sign of result

;  signed remainder  u mod (BCDE) --> (BCDE)

qmod:   call qtst                       ;test for zero modulus
        ret z
        lda u                           ;sign of u is that of result
        or  a
        push af                 ;save flags
        call csign                      ;get abs val of args
        call uqdiv                      ;remainder in (BCDE)
        jp  qmul1


;  unsigned division  u / (BCDE) --> mq, remainder in (BCDE)



uqdiv:  ld hl,mq                        ;mq will contain quotient
        call qclrhl                     ;clear it
        push hl                         ;save it on the stack

        ld  l,1                 ;now normalize divisor
uqdiv1: ld  a,b                 ;look at most signif non-sign bit
        and  40h
        jp nz,uqdiv2
        call qral                       ;if not 1, shift left
        inc  l
        jp  uqdiv1
uqdiv2: ld  a,l
        sta  temp                       ;save normalization count
        ld hl,u                 
        call qxchg                      ;want divid in (BCDE), divisor in u
        ex (sp),hl                              ;pointer to mq in (HL), u on stack

;main loop

uqdiv3: call trial                      ;trial subtraction of divisor
        call qralhl                     ;shift in the carry
        lda  temp                       ;get the count
        dec  a
        jp z,uqdiv4                     ;done
        sta  temp                       ;save count again
        ex (sp),hl                              ;divisor in (HL)
        xor  a
        call qrarhl                     ;shift it right one
        ex (sp),hl                              ;quotient in (HL)
        jp  uqdiv3

uqdiv4: inc sp
        inc sp                          ;clean off top of stack
        ret


trial:  call qsub                       ;subtract divid from divisor
        call qneg                       ;actually want divisor from divid
        scf                             ;assume was positive
        ret p
        call qadd                       ;else must restore dividend
        xor  a                          ;clear carry
        ret


;
; routines to manipulate quads
;
; qld loads the quad pointed to by (HL) into (BCDE)

qld:    push hl
        ld b,(hl)
        inc hl
        ld c,(hl)
        inc hl
        ld d,(hl)
        inc hl
        ld e,(hl)
        pop hl
        ret

; qst is inverse of qld

qst:    push hl
        ld (hl),b
        inc hl
        ld (hl),c
        inc hl
        ld (hl),d
        inc hl
        ld (hl),e
        pop hl
        ret



; rotate  (BCDE) right thru carry

qrar:   ld a,b
        rra
        ld b,a
        ld a,c
        rra
        ld c,a
        ld a,d
        rra
        ld d,a
        ld a,e
        rra
        ld e,a
        ret

; same for quad pointed to by (HL)

qrarhl: push hl
        ld a,(hl)
        rra
        ld (hl),a
        inc hl
        ld a,(hl)
        rra
        ld (hl),a
        inc hl
        ld a,(hl)
        rra
        ld (hl),a
        inc hl
        ld a,(hl)
        rra
        ld (hl),a
        pop hl
        ret


; rotate (BCDE) left thru carry

qral:   ld a,e
        rla
        ld e,a
        ld a,d
        rla
        ld d,a
        ld a,c
        rla
        ld c,a
        ld a,b
        rla
        ld b,a
        ret

; qralhl does it for quad pointed to by (HL)

qralhl: inc hl
        inc hl
        inc hl                          ;get to rightmost byte
        ld a,(hl)
        rla
        ld (hl),a
        dec hl
        ld a,(hl)
        rla
        ld (hl),a
        dec hl
        ld a,(hl)
        rla
        ld (hl),a
        dec hl
        ld a,(hl)
        rla
        ld (hl),a
        ret
        

;qclrhl clears quad pointed to by (HL)

qclrhl: push hl
        xor a
        ld (hl),a
        inc hl
        ld (hl),a
        inc hl
        ld (hl),a
        inc hl
        ld (hl),a
        pop hl
        ret


; qtst tests sign of (BCDE), setting the usual flags

qtst:   ld  a,b                 ;look at most signif byte
        or  a
        ret nz
        or  c                           ;test for zero
        or  d
        or  e
qtst1:  ret p
        ld  a,1
        or  a  
        ret
        
qtsthl: ld  a,(hl)
        or  a
        ret nz
        push hl
        inc hl
        or  (hl)
        inc hl
        or  (hl)
        inc hl
        or  (hl)
        pop hl
        jp  qtst1

; swap (BCDE) with thing pointed to by HL

qxchg:  push hl
        ld  a,(hl)
        ld  (hl),b
        ld  b,a
        inc hl
        ld  a,(hl)
        ld  (hl),c
        ld  c,a
        inc hl
        ld  a,(hl)
        ld  (hl),d
        ld  d,a
        inc hl
        ld  a,(hl)
        ld  (hl),e
        ld  e,a
        pop hl
        ret

        ENDFUNC longsz