home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C/C++ Interactive Guide
/
c-cplusplus-interactive-guide.iso
/
c_ref
/
csource3
/
196_01
/
fp64.csm
< prev
next >
Wrap
Text File
|
1985-11-15
|
41KB
|
3,082 lines
;/*
;*****************************************************************
;* Written by : Hakuo Katayose (JUG-CP/M No.179) *
;* JIP 980 *
;* 49-114 kawauchi-Sanjuunin-machi *
;* Sendai, Miyagi, Japan. *
;* Telph.No (0222)61-3219 *
;* Edited by : *
;* *
;*****************************************************************
;*/
;
INCLUDE "BDS.LIB"
BIASEXP EQU 0400H
NBYTES EQU 8
;
;--------------------------------------------------------------
;--------------------------------------------------------------
;
; 64_bit INTEGER basic_subroutines.
;
; IMUL64 64_bit multiplay. LA = LA * (hl).
; IDIV64 64_bit divide. LA = LA / (hl).
; IADDA 64_bit addition. LA = LA + (hl).
; ISUBA 64_bit subtruction. LA = LA - (hl).
;
; IADD64 64_bit addition. (de) = (de) + (hl).
; ISUB64 64_bit subtruction. (de) = (de) - (hl).
;
; ICMP64 64_bit compare. c,z = (de) - (hl).
;
; INEG64 64_bit negation. (hl) = ~(hl).
;
; SFTL64 64_bit left shift. (carry set).
; SFTR64 64_bit right shift. (carry set).
;
; DSHFTL 128_bit left shift.
; DSHFTR 128_bit right shift.
;
; ITENTH 64_bit 10 times. (hl) = (hl) * 10.
;
;
; work area:
; TEN 64_bit constant. 10.
; LLWORK LLong type work_area.
;
;--------------------------------------------------------------
;
;
;--------------------------------------------------------------
;--------------------------------------------------------------
;
; 64_bit floting opration result flags.
;
; EP 1 byte length.
; OUTSGN 1 byte length.
; OUTBUF 20 byte length.
;
; OVF 1 byte length.
; UNF 1 byte length.
; ZERO 1 byte length.
; MINUS 1 byte length.
;
;--------------------------------------------------------------
;
; 64_bit floting work_registers.
;
; TEMPW 16 byte length.
;
; UU nbytes byte length.
; VV nbytes byte length.
; WW nbytes byte length.
; XX nbytes byte length.
; YY nbytes byte length.
;
;--------------------------------------------------------------
;
; 64_bit floting Acc registers.
;
; LA 64_bit floting ACC_A. A_Acc extention.
; AREG 64_bit floting ACC_A. A_Acc.
; AEXP 64_bit floting ACC_A. expornemt.
; ASIGN 64_bit floting ACC_A. sign_flag.
;
; LB 64_bit floting ACC_B. B_Acc extention.
; BREG 64_bit floting ACC_B. B_Acc.
; BEXP 64_bit floting ACC_B. expornemt.
; BSIGN 64_bit floting ACC_B. sign_flag.
;
; TEN1 64_bit floting constant. 10.0
; ONE 64_bit floting constant. 1.0
; TENM1 64_bit floting constant. 0.1
; NUM0 64_bit floting constant. 0.0
;
;
;
;
FUNCTION fp64
call arghak
push b
lda arg1
cpi 255
jz FPTST1
cpi 254
jz FPTST2
lhld arg1
dad h
lxi b,JMPTBL
dad b
mov a,m
inx h
mov h,m
mov l,a
push h
popix
lhld arg3
xchg
lhld arg2 ; de = arg3. hl = arg2.
pcix
JMPTBL: dw FPGETK
dw FPADD ; no.1
dw FPSUB
dw FPMUL
dw FPDIV
dw FPCMP
dw FPNEG
dw FPSFT
dw FPHALF
dw FPDBL
dw FPCNV ; no.10
dw FPIN
dw SQRT
dw SIN
dw ATAN2
dw EXPP
dw LOG
dw exitp ;jmp17
dw exitp ;jmp18
dw exitp ;jmp19
dw exitp ;jmp20
dw LLADD
dw LLSUB
dw LLMUL
dw LLDIV
dw LLCMP
dw LLNEG
dw LLMOV
dw LLSFTL
dw LLSFTR
dw ATOLL
dw LLTOA
dw LLTEN
exitp: lhld arg4
xchg
call pack
lxi h,OVF
xra a
ora m
inx h
ora m
inx h
ora m
inx h
ora m
mov l,a
mvi h,0
pop b
ret
;
;
;
FPADD: push h
lxi h,BREG
call unpack ; (arg3) --> Bcc. (Unpack).
pop d
lxi h,AREG
call unpack ; (arg2) --> Acc. (Unpack).
call FPADD0
jmp exitp
;
;
FPSUB: push h
lxi h,BREG
call unpack ; (arg3) --> Bcc. (Unpack).
pop d
lxi h,AREG
call unpack ; (arg2) --> Acc. (Unpack).
call FPSUB0
jmp exitp
;
;
FPMUL: push h
lxi h,BREG
call unpack ; (arg3) --> Bcc. (Unpack).
pop d
lxi h,AREG
call unpack ; (arg2) --> Acc. (Unpack).
call FPMUL0
jmp exitp
;
;
FPDIV: push h
lxi h,BREG
call unpack ; (arg3) --> Bcc. (Unpack).
pop d
lxi h,AREG
call unpack ; (arg2) --> Acc. (Unpack).
call FPDIV0
jmp exitp
;
;
FPCMP: lxi b,NBYTES-1
dad b
xchg
dad b
ldax d
ora a
jp fpcmp1
mov a,m
ora a
xchg
jm fpcmp2
lxi h,-1
pop b
ret
fpcmp1: mov a,m
ora a
jp fpcmp2
lxi h,1
pop b
ret
fpcmp2: call icmp64
lxi h,0
pop b
rz
lxi h,-1
rc
lxi h,1
ret
;
;
FPNEG: lhld arg2
xchg
lhld arg4
xchg
lxi b,NBYTES
ldir
lhld arg4
lxi b,nbytes-1
dad b
mvi a,080h
xra m
mov m,a
pop b
ret
;
;
FPCNV: xchg
lxi h,AREG
call unpack ; (arg2) --> Acc. (Unpack).
jmp FPCONV
;
;
LLADD: xchg
lhld arg4
push h
xchg
lxi b,NBYTES
ldir
pop d
lhld arg2
call iadd64
pop b
ret
LLSUB: xchg
lhld arg4
push h
xchg
lxi b,NBYTES
ldir
pop d
lhld arg3
call isub64
pop b
ret
LLMUL: lxi d,la
lxi b,nbytes
ldir
lhld arg3
call imul64
lhld arg4
xchg
lxi h,la
lxi b,nbytes
ldir
pop b
ret
LLDIV: lxi d,la
lxi b,nbytes
ldir
lhld arg3
call idiv64
lhld arg4
xchg
lxi h,la
lxi b,nbytes
ldir
pop b
ret
LLCMP: lxi b,NBYTES-1
dad b
xchg
lhld arg3
dad b
ora a
xchg
lhld arg3
call icmp64
lxi h,0
pop b
rz
lxi h,-1
rc
lxi h,1
ret
LLNEG: call ineg64
pop b
ret
LLTEN: call itenth
pop b
ret
LLMOV: xchg
lhld arg4
xchg
lxi b,nbytes
ldir
pop b
ret
LLSFTL: lda arg4
rar
call sftl64
jmp sftext
LLSFTR: lxi d,nbytes-1
dad d
lda arg3
rar
call sftr64
pop b
sftext: lxi h,0
rnc
lxi h,080h
ret
ATOLL: mvi a,' '
sta asign
lxi h,0
shld la
shld la+2
shld la+4
shld la+6
lhld arg2
encod1: mov a,m
call isdigit
jnc encod3
cpi ' '
jz encod2
cpi '+'
jz encoda
cpi '-'
jnz encod8
mvi a,'-'
sta asign
encoda: inx h
jmp encod3
encod2: inx h
jmp encod1
encod3: mvi b,18
encod7: mov a,m
call isdigit
jnc encod9
cpi ','
jnz encod8
inx h
jmp encod7
encod9: push b
push h
push psw
lxi h,la
call itenth
pop psw
ani 0fh
lxi h,la
add m
mov m,a
jnc encod5
mvi b,nbytes-1
encod4: inx h
mvi a,0
adc m
mov m,a
jnc encod5
dcr b
jnz encod4
encod5: pop h
pop b
inx h
dcr b
jnz encod7
encod8: lda asign
cpi '-'
lxi h,la
cz ineg64
lhld arg4
xchg
lxi h,la
lxi b,nbytes
ldir
pop b
ret
LLTOA: lxi d,la
lxi b,nbytes
ldir
lxi h,outbuf
lxi d,outbuf+1
lxi b,18
mvi m,' '
ldir
lxi h,outbuf+19
mvi m,0
lhld la
mov a,h
ora l
jnz decode
lhld la+2
mov a,h
ora l
jnz decode
lhld la+4
mov a,h
ora l
jnz decode
lhld la+6
mov a,h
ora l
jnz decode
lxi h,outbuf+18
mvi m,'0'
lxi h,outbuf
pop b
ret
decode: lda la+nbytes-1
ani 080h
mvi a,' '
jz decod1
lxi h,la
call ineg64
mvi a,'-'
decod1: sta outsgn
lxi h,outbuf+18
mvi m,'0'
decod3: push h
lxi h,ten
call idiv64
pop h
jc decod4
lda la+nbytes
adi '0'
mov m,a
dcx h
mov a,m
ana a
jnz decod3
decod4: lda outsgn
mov m,a
lxi h,outbuf
pop b
ret
FPHALF: xchg
lhld arg4
xchg
lxi b,nbytes
ldir
lhld arg4
lxi d,nbytes-2
dad d
mov a,m
sui 010h
mov m,a
jnc fphlf1
inx h
dcr m
fphlf1: pop b
ret
FPDBL: xchg
lhld arg4
xchg
lxi b,nbytes
ldir
lhld arg4
lxi d,nbytes-2
dad d
mov a,m
adi 010h
mov m,a
jnc fpdbl1
inx h
inr m
fpdbl1: pop b
ret
FPSFT: xchg
lhld arg4
xchg
lxi b,nbytes
ldir
lhld arg3
mov a,h
ora l
jz fpsft5
dad h
dad h
dad h
dad h
xchg
lhld arg4
lxi b,nbytes-1
dad b
push h
mov a,m
dcx h
mov l,m
mov h,a
ani 080h
dadc d
jpo fpsft4 ; parity=odd --> no overflow.
lxi h,0
jnc fpsft3
lxi h,07fffh
fpsft3: ora h
mov h,a
fpsft4: xchg
pop h
mov m,d
dcx h
mov m,e
fpsft5: pop b
ret
;
;--------------------------------------------------------------
; FLOATING POINT DIVIDE ------ Acc = Acc / Bcc.
;--------------------------------------------------------------
FPDIV0: lxi h,0
shld OVF
shld ZERO
lhld BEXP
mov a,h
ora l
jz ovrfw
lhld AEXP
mov a,h
ora l
jz setzero
;
fdiv1: lxi h,0
shld LA