home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
DRI-archive
/
roche
/
FLTARITH.ASM
< prev
next >
Wrap
Assembly Source File
|
2009-12-11
|
19KB
|
912 lines
; FLTARITH.ASM
; ------------
;
; See FALCONER.WS4 for doc.
;
; (Retyped by Emmanuel ROCHE.)
;
;--------------------------------
; External routines required
;
extrn aerc ; Arithmetic error trap
;
;--------------------------------
; External routine in INTARITH.ASM
;
extrn c1de,c2bc,c2de,derc,dhlz
extrn idiv,imul,stadr
;
;--------------------------------
; Allowable entry points
;
; Data manipulation
;
entry hlrd,fxchg
;
; Memory addressing
;
entry lfds,lfbs,fload,fstor
entry lfbis,lfdis,sfdis
;
; Arithmetic operators
;
entry fmult,fdivt,fmul
entry fdiv,fdivr,frcip
entry fadd,fsub,fsubr
;
; Testing, integer extraction
;
entry fcmp,fint
;
; Format conversion
;
entry flota,flotp,flotd,flot
entry fixt,fixr
;
;--------------------------------
; Macro definitions
;--------------------------------
;
; Change sign of real operand B or D
;
fsign macro reg
bc.l equ b
de.h equ d
if reg*(reg-d)
error "R"
endif
mov a,reg
xri 80H
mov reg,a
endm
;
; Load (& pop) real (reg) from TOS, stored by SFTS macro
;
lfts macro reg
bc.l equ b
de.h equ d
pop reg
mov 5-reg/2,reg
pop reg
if reg*(reg-d)
error "R"
endif
endm
;
; Load (reg) from TOS & leave on stack (reg)
;
ltos macro reg
pop reg
push reg
endm
;
; Move operation on register pair B, D, or H
;
movd macro r1,r2
if ((r1-d)*(r1-h)*r1) OR ((r2-d)*(r2-h)*r2)
error "R"
endif
mov r1,r2
mov r1+1,r2+1
endm
;
; Move floating operand from Reg1 to Reg2
;
movf macro r2,r1
bc.l equ b
de.h equ d
if (r1*(r1-d)) OR (r2*(r2-d))
error "R"
endif
mov r2,r1
mov r2+1,r1+1
mov 5-r2/2,5-r1/2
endm
;
; Reload (BC.L), stored by PUSH B, PUSH H sequence
;
reload macro reg
bc.l equ b
if reg-B
error "R"
db 0,0,0
endif
if reg-b=0 ; Was IFZ
pop b
mov l,c
pop b
endif
endm
;
; "Return" and check stack level zero
;
rtn macro
if .lvl
error "0"+.lvl
.lvl set 0
endif
ret
endm
;
; Save (BC.L), to be restored by RELOAD BC.L later
;
save macro reg
bc.l equ b
if reg-b
error 'R'
db 0,0
endif
if reg-b=0 ; Was IFZ
push b
push h
endif
endm
;
; Store real value on top of stack; note SFTS B affects (A)
;
sfts macro r
bc.l equ b
de.h equ d
if r*(r-d)
error 'R'
endif
if r=0 ; Was IFZ
mov a,l
endif
push r
push psw-r
endm
;
;--------------------------------
; Auxiliary routines
;--------------------------------
;
; Normalize the 32 bit value in (DEHL) left
; and round to 16 bits. Discard the high order
; bit. (B) returns shift count (in offset binary).
; Return Carry for value zero.
; A,F,B,D,E,H,L
;
hlrd: mvi b,80H ;
mov a,d ;
ora a ;
jm hlrd2 ; Normalized
ora e ;
ora h ;
ora l ;
stc ;
rz ; Zero value
hlrd1: dcr b ;
call dhlz ; Left shift
jp hlrd1 ;
hlrd2: ani 7FH ;
mov d,a ; Discard high order bit
mov a,h ;
ora a ; Check for rounding
rp ; Not needed
inr e ; Round up
rnz ; No Carry
inr d ;
rp ; No overflow
inr b ; Modify shift count
mov d,e ; Set result
rtn ;
;
; Set the high order bits in (BC) and (DE) for
; arithmetic operations. Discard original signs.
; Reset Carry.
; A,F,B,D
;
sethi: mov a,b ;
ori 80H ;
mov b,a ;
mov a,d ;
ori 80H ;
mov d,a ;
rtn ;
;
; Exchange floating operands
; A,B<=>D,C<=>E,H<=>L
;
fxchg: mov a,b ;
mov b,d ;
mov d,a ;
mov a,c ;
mov c,e ;
mov e,a ;
mov a,l ;
mov l,h ;
mov h,a ;
rtn ;
;
; Load (DE.H) from stack level (A)
; Value was stored with PUSH D, PUSH H sequence.
; A,F,D,E,H
;
lfds: push h ;
call stadr ; Get abs address
inx h ;
mov a,m ; Get exponent
inx h ;
mov e,m ;
inx h ;
mov d,m ; Get mantissa
pop h ;
mov h,a ;
rtn ;
;
; Load (BC.L) from stack level (A)
; Value was stored by PUSH D, PUSH H sequence.
; A,F,B,C,L
;
lfbs: push h ;
call stadr ; Get abs address
inx h ;
mov a,m ; Get exponent
inx h ;
mov c,m ; Get mantissa
inx h ;
mov b,m ;
pop h ;
mov l,a ;
rtn ;
;
; Load indirect (BC.L) via stack level (A) ptr
; A,F,B,C,L
;
lfbis: push h ;
call stadr ; Form abs address
mov a,m ; LS mem address
inx h ;
mov h,m ; MS mem address
mov l,a ;
mov a,m ; Get exponent
inx h ;
mov c,m ;
inx h ;
mov b,m ; Get mantissa
pop h ;
mov l,a ;
rtn ;
;
; Load indirect (DE.H) via stack level (A) ptr
; A,F,D,E,H
;
lfdis: push h ;
call stadr ; Form abs address
mov a,m ; LS mem address
inx h ;
mov h,m ; MS mem address
mov l,a ;
mov a,m ; Get exponent
inx h ;
mov e,m ;
inx h ;
mov d,m ; Get mantissa
pop h ;
mov h,a ;
rtn ;
;
; Store (DE.D) indirect via stack level (A) ptr
; A,F
;
sfdis: push h ;
push b ;
mov c,m ; Keep exponent
inr a ; Allow for PUSH B
call stadr ; Get abs address
mov a,m ;
inx h ;
mov h,m ;
mov l,a ; Get pointer
mov m,c ; Store exponent
inx h ;
mov m,e ;
inx h ;
mov m,d ; Store mantissa
pop b ;
pop h ;
rtn ;
;
; Load (DE.H) via pointer (BC); advance (BC)
; B,C,D,E,H
;
fload: push psw ;
ldax b ;
mov m,a ;
inx b ;
ldax b ;
mov e,a ; Mantissa
inx b ;
ldax b ;
mov d,a ; Exponent
inx b ; Setup for next time
pop psw ;
rtn ;
;
; Store (DE.H) via pointer (BC); advance (BC)
; B,C
;
fstor: push psw ;
mov a,h ;
stax b ;
inx b ;
mov a,e ;
stax b ;
inx b ;
mov a,d ;
stax b ;
inx b ; Setup for next time
pop psw ;
rtn ;
;
;--------------------------------
; Floating point arithmetic system for YALE 8080-based
; computers -- by Charles B. FALCONER, April 1976
;
; Real representation can express values in the absolute value
; range 0.29388 * 10^-38 through 1.7018 * 10^+38, and zero,
; together with sign, with approximately 4.8 decimal digit
; accuracy. The resolution of a value between 1 and 2 is
; approximately 0.00003. The system is designed to maximize
; register (as opposed to memory) use during computation.
;
; A real (floating point) value is represented by a unipolar
; 16 bit mantissa, whose value is in the range 1.0 > mantissa
; > -1.0. The mantissa absolute value is always >= 0.5.
; Thus, the high order bit of the mantissa is always a "one",
; and is replaced by a sign bit in internal representation.
; A "one" sign bit represents negative values.
;
; Real values are stored in 3 adjacent memory bytes:
; Lowest address: exponent
; Next address: least significant byte of mantissa
; Highest address: most significant byte of mantissa
;
; Real operands can appear in either of two 8080 internal
; register configurations. The normal position (considered
; the real accumulator) is the DE.H register, in which the
; D and E registers hold the mantissa (sign bit in D), and
; the M register holds the exponent. A second operand may
; be held in the BC.L register, where the B and C registers
; hold the mantissa, and the L register holds the exponent.
;
; Note the storage and load macros SFTS and LFTS above for
; stacking and unstacking floating values. Also note that
; "SFTS B" will disturb the A and F registers,
; while "SFTS D" will not.
;
; The SAVE and RELOAD macros above do not use the standard
; memory format, and operate only on the BC.L internal
; register group.
;
;--------------------------------
; Code for the arithmetic system proper
;--------------------------------
;
; Flating multiply by 10; (DE.H) := 10 * (DE.H)
; Carry for overflow, returns max value
; A,F,D,E,H
;
fmult: save bc.l ;
lxi b,2000H ; 10.0
mvi l,84H ;
call fmul ;
reload fmul ;
rtn ;
;
; Floating div by 10; (DE.H) := (DE.H) * 0.10000
; Carry for underflow, returns zero
; A,F,D,E,H
;
fdivt: save bc.l ;
lxi b,4CCDH ; 0.10000
mvi l,80H-3 ;
call fmul ;
reload bc.l ;
rtn ;
;
; Floating multiply (DE.H) := (DE.H) * (BC.L)
; Carry for overflow or underflow, when
; maximum or zero values are returned.
; A,F,D,E,H
;
fmul: mov a,h ;
ora a ;
rz ; Acc zero, return same
mov a,l ;
ora a ;
jnz fmul1 ; (BC.L) not zero
mov h,l ; (BC.L) zero, return zero
rtn ;
fmul1: mov a,d ;
xra b ; Form result sign
push b ;
push h ; Save (BC.L)
push psw ; Save result sign
call sethi ; Set hi order operand bit
call imul ; Perform multiplication
call hlrd ; Normalize and round
pop psw ;
ani 80H ; Result sign
ora d ;
mov d,a ; Set result sign
mov a,b ; Shift count
pop h ; Original exponents
pop b ; Original BC
;
; Add exponents H := H + L + A; all in offset code
; Carry for overflow, when set extremes in (DE.H)
; A,F,H (DE)
;
addx: add h ;
push psw ; Save Carry
add l ;
mov h,a ; Result
jc addx1 ; One overflow required
@01 set .lvl ;
pop psw ;
cmc ;
rnc ; In range
mvi h,00H ; Underflow
rtn ;
.lvl set @01 ;
addx1: pop psw ; Had 1st Carry
rnc ; In range
;
; Set max value for exponent overflow
; A,F,D,E,H
;
ovex: mvi h,0FFH ; Overflow, set max
mov e,h ; and mantissa
mov a,d ;
ori 7FH ; Prserve result sign
mov d,a ;
stc ; Mark overflow
rtn ;
;
; Floating divide (DE.H) := (DE.H) / (BC.L)
; Carry for overflow or underflow when
; maximum or zero values are returned.
; Division by zero causes a system trap.
; A,F,D,E,H
;
fdiv: mov a,l ;
ora a ;
cz aerc ; Division by zero, fatal
rc ;
fdiv1: mov a,h ;
ora a ;
rz ; 0/non-zero=0
mov a,d ;
xra b ; Form result sign
push b ;
push h ;
push psw ;
call sethi ;
call derc ; Extend and position dividend
mvi l,0 ;
mov a,l ;
rar ; Last bit
mov h,a ;
call idiv ; Returns 15 or 16 bits
push d ; Save quotient
mxi d,0 ;
call c2bc ;
mvi a,-2 ; Need 2 more bits for rounding
fdiv2: push psw ; Save iterations count
dad h ; Left shift (HLDE)
rar ; Save Carry out
xchg ;
dad h ;
xchg ;
jnc fdiv3 ; No Carry into L
inx h ;
fdiv3: ral ; Regain Carry from H
jc fdiv4 ; Yes, generate quotient bit
mov a,l ;
add c ; Test for quotient bit
mov a,h ;
adc b ;
jnc fdiv5 ; No bit
fdiv4: dad b ; Subtract
inx d ; Insert quotient bit
fdiv5: pop psw ; Get iteration count
inr a ;
jn fdiv2 ; Not done
mov a,e ;
rrc ;
rrc ;
mov h,a ; Extend quotient
pop d ; Restore quotient
call hlrd ; Normalize and round
inr b ; Correct bin point
pop psw ;
ltos h ; Original exponent
ani 80H ;
ora d ;
mov d,a ; Form result sign
mov a,l ;
cma ;
inr a ; Complement divisor exponent
mov l,b ; Shift count
call addx ; Form result exponent
mov a,h ;
pop h ; Original exponent
mov h,a ;
pop b ;
rtn ; With any addx Carry
;
; Floating reverse div (DE.H) := (BC.L) / (DE.H)
; Carry for overflow or underflow when
; maximum or zero values are returned.
; Division by zero causes a system trap.
; A,F,D,E,H
;
fdivr: save bc.l ;
call fxchg ;
call fdiv ;
reload bc.l ;
rtn ;
;
; Floating reciprocal (DE.H) := 1.0 / (DE.H)
; Division by zero (orig (DE.H) causes system trap
; A,F,D,E,H
;
frcip: save bc.l ;
movf b,d ;
lxi d,0 ;
mvi h,81H ; Floating 1.0
call fdiv ;
reload bc.l ;
rtn ;
;
; Align operands for add
; Returns two 24 bit values in (BC.L) and (DE.H)
; with binary points aligned. The actual binary
; point is that of the larger (on input) magnitude
; plus 1; i.e., right shifted one place. This allows
; space for overflows on addition.
; A,F,B,C,D,E,H,L
;
alin: mov a,h ;
sub l ;
ora a ; Reset any Carry
push psw ; Relative magnitudes
mov a,b ; BC.L := (BC OR 8000H) SHR 1
ori 80H ;
rar ;
mov b,a ;
mov a,c ;
rar ;
mov c,a ;
mov a,0 ;
rar ;
mov l,a ;
mov a,d ; DE := (DE OR 8000H) SHR 1
ori 80H ;
rar ;
mov d,a ;
mov a,e ;
rar ;
mov e,a ;
mov a,0 ;
rar ;
mov h,a ;
alin1: pop psw ;
rz ; Aligned
jp alin2 ; DE mag > BC mag
inr a ; BC mag > DE mag
push psw ; Save rel mag
mov a,d ; Shift DE.H right, 0 in
rar ;
mov d,a ;
mov a,e ;
rar ;
mov e,a ;
mov a,h ;
rar ;
mov h,a ;
jmp alin1 ; Now test
.lvl set .lvl-1 ;
alin2: dcr a ;
push psw ;
mov a,b ; Shift BC.L right, 0 in
rar ;
mov b,a ;
mov a,c ;
rar ;
mov c,a ;
mov a,l ;
rar ;
mov l,a ;
jmp .lvl-1 ;
.lvl set .lvl-1 ;
;
; Floating reverse subtract (DE.H) := (BC.L) - (DE.H)
; Carry for over/underflow, sets extreme value
; A,F,D,E,H
;
fsubr: fsign d ; Change D sign
;
; Floating add (DE.H) := (DE.H) + (BC.L)
; Carry for over/underflow, sets extreme value
; A,F,D,E,H
;
fadd: mov a,l ;
ora a ;
rz ; BC.L = 0
mov a,h ;
ora a ;
jnz fadd2 ; DE.H <> 0
fadd1: movf d,b ; DE.H << BC.L
rtn ;
fadd2: sub l ;
jc fadd3 ; BC mag > DE mag
cpi 16+1 ;
rnc ; BC.L << DE.H
mov a,h ; Will be result magnitude
jmp fadd4 ;
fadd3: cpi -16 ;
cmc ;
jnc fadd1 ; DE.H << BC.L
mov a,l ; Will be result magnitude
fadd4: save bc.l ;
push psw ; Save result magnitude
mov a,b ;
xra d ;
mov a,b ;
jp fadd5 ; Signs same
@01 set .lvl ;
ana b ; Signs different
cp fxchg ; DE.H neg, BC.L pos
call alin ; Now, DE.H pos and BC.L neg
mov a,h ;
sub l ;
mov h,a ;
mov a,e ;
sbb c ; Perform subtraction
mov e,a ;
mov a,d ;
sbb b ;
mov d,a ;
push psw ; Save result sign
jp fadd6 ; No complement needed
call c1de ;
mov a,h ;
cma ;
inr a ;
mov h,a ;
jnz fadd6 ; No propagation
inx d ;
jmp fadd6 ; Now magnitude, sign is stacked
.lvl set @01 ;
fadd5: push psw ; Result sign
call alin ;
mov a,h ;
add l ;
mov h,a ; Add mantissa
mov a,e ;
adc c ;
mov e,a ;
mov a,d ;
adc b ;
mov d,a ;
fadd6: xra a ;
mov l,a ;
ora d ;
ora e ;
ora m ;
@01 set .lvl ;
jnz fadd7 ; Result not zero
pop psw ; Purge sign
pop psw ; Purge magnitude
ora a ; Reset any Carry
jmp fadd8 ;
.lvl set @01 ;
fadd7: call hlrd ;
pop psw ;
ani 80H ;
ora d ;
mov d,a ; Set result sign
mov h,b ;
mvi l,81H ;
pop psw ; Saved result magnitude
call addx ; Set result magnitude
fadd8: reload bc.l ;
rtn ; With addx Carry if overflow
;
; Floating subtract (DE.H) := (DE.H) - (BC.L)
; Carry for over/underflow, sets extreme value
; A,F,D,E,H
;
fsub: save bc.l ;
fsign b ; Change B sign
call fadd ;
reload bc.l ;
rtn ;
;
; Floating compare, set flags for (DE.H) - (BC.L)
; Zero flag if equal
; Plus flag if (DE.H) >= (BC.L)
; Minus falg if (DE.H) < (BC.L)
; A,F
;
fcmp: mov a,l ;
ora a ;
jnz fcmp1 ; BC.L <> zero
mov a,h ;
ora a ;
rz ; Both zero
mov a,d ;
ori l ; Set flags according to DE.H
rtn ; sign.
fcmp1: mov a,h ;
ora a ;
jz fcmp2 ; (DE.H) = 0, flags inverse
sub l ; of (BC.L) sign.
jz fcmp4 ; Magnitude same
mov a,d ;
jp fcmp3 ; DE.H controlling magnitude
fcmp2: mov a,b ; BC.L controlling magnitude
cma ;
fcmp3: ori 01H ; Set flags via appropriate
rtn ; operand sign.
fcmp4: ora b ; Check signs
jm fcmp5 ; (BC.L) < 0
ora d ; (BC.L) > 0, check (DE.H)
rn ; (DE.H) < 0
mov a,e ; Both >= 0
sub c ;
mov a,d ;
sbb b ;
rtn ;
fcmp5: mov a,d ;
ori 01H ;
rp ; (DE.H) > 0 and (BC.L) < 0
mov a,c ;
sub e ; Both < 0
mov a,b ;
sbb d ;
rtn ;
;
; Convert signed integer (A) to real DE.H)
; A,F,D,E,H
;
flota: ora a ;
mov h,a ;
rz ; Zero
mov d,a ;
mvi e,00H ;
ani 80H ;
flot5: push psw ; Save sign
mvi h,80H ; Binary point
mov a,d ;
jp flot2 ;
cma ;
inr a ;
mov d,a ;
jmp flot2 ; -ve input
.lvl set .lvl-1 ;
;
; Convert positive integer (A) to real (DE.H)
; A,F,D,E,H
;
flotp: ora a ;
mov h,a ;
rz ; Zero
mov d,a ;
xra a ;
mov e,a ;
jmp flot5 ;
;
; Convert positive integer (DE) to real (DE.H)
; A,F,D,E,H
;
flotd: xra a ;
mov h,a ;
jmp flot1 ;
;
; Extract integer portion of (DE.H) in real form
; A,F,D,E,H
;
fint: call fixt ; Convert to integer
cnc ;
rnc ; Already integer
;
; Convert signed integer (DE) to real (DE.H)
; A,F,D,E,H
;
flot: mvi h,00H ;
mov a,d ;
ani 80H ;
flot1: push psw ; Save sign
cm c2de ; Magnitude
mov a,d ;
ora e ;
jz flot3 ; Zero value
mvi h,90H ; Binary point
flot2: mov a,d ;
ora a ;
jp flot4 ; Further normalizing
ani 7FH ;
mov d,a ;
flot3: pop psw ; Get sign
ora d ;
mov d,a ;
rtn ;
flot4: xchg ;
dad h ; Left sign
xchg ;
dcr h ; Adjust binary point
jmp flot2 ;
;
; Convert real (DE.H) to signed integer (truncate)
; (DE.H) := signed integer result, truncated.
; Carry if not 32767 >= value >= -32768, unconverted.
; A,F,D,E,H
;
fixt: mov a,h ;
ora a ;
jnz fixt2 ; Non-zero
fixt1: xra a ;
mov d,a ; Zero integer part
mov e,a ;
rtn ;
fixt2: jp fixt1 ; No integer part
sui 81H ;
jm fixt1 ; No integer part
sui 15 ;
jnz fixt3 ; Magnitude < 32768
mov a,d ;
sui 80H ;
stc ;
rnz ; Not -32768
ora e ;
rz ; Exactly -32768
stc ;
rtn ; Oversize
fixt3: cnc ;
rc ; Oversize
mov h,a ; Binary point 0 for 1 to 2
mov a,d ;
push psw ;
ori 80H ;
mov d,a ;
fixt4: ora a ;
call derc ; Right shift, 0 in
inr h ;
jm fixt4 ;
pop psw ;
ora a ;
rp ; Positive
jmp c2de ; Insert sign
;
; Fix and round (DE.H) to signed integer in (DE)
; Return Carry if mag > 32767, without converting
; A,F,D,E,H
;
fixr: save bc.l ;
sfts d ; Save in case of error
lxi b,7FFFH ;
mov l,b ; 0.49999 to prevent FADD
mov a,d ; roundup.
ora a ;
jp fixr1 ; (DE.H) > 0
fsign b ;
fixr1: call fadd ; Round
call fixt ; Fix
@01 set .lvl ;
jc fixr2 ; Overflow error
pop b ; Purge original argument
pop b ;
jmp fixr3 ; Restore BC.L
.lvl set @01 ;
fixr2: lfts d ; Restore argument
fixr3: reload bc.l ;
rtn ;
;
;--------------------------------
;
end ; of FLTARITH.ASM
