; 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