; LLLFPODT.ASM ; --------- ; ; Lawrence Livermore Laboratories Floating-Point package ; ; 1973: Floating-Point Package for the MCS8 by David Mead ; 1974: 24-bit mantissa and I/O by Hal Brand ; 1975: Under/overflow bug fixed by Frank Olken ; Sept-Oct 2006: Disassembled by Emmanuel ROCHE ; ;-------------------------------- ORG 0900H ; Special case ;-------------------------------- ; Octal Debugger Tool (ODT) TTY routines ; outr EQU 0030H ; Output char in ? inp EQU 00DBH ; Input char from ? ; ; Characteristics with sign extended ; minch EQU 192 ; Minimum maxch EQU 63 ; Maximum ; ;-------------------------------- ; Divide subroutine. ; ldiv: CALL csign ; Compute sign of result CALL zchk ; Check if dividend = zero JNZ dtst2 ; If dividend <> 0, check divisor CALL bchk ; Check for zero/zero JZ indfc ; Zero/zero = indefinite JMP wzerc ; Zero/non-zero = zero ; dtst2: CALL bchk ; Come here if dividend <> 0 JZ oflwc ; Non-zero/zero = overflow ; If we get here, things look okay MOV E,L ; Save base in E MOV L,C ; Base 6 to L CALL dclr ; Clear quotient mantissa slot MOV L,E ; Restore base in L CALL ent1 ; Do first cycle MOV L,C ; Base 6 to L CALL dlst ; Move quotient over one place MVI D,23 ; Number of iterations to D rep3: MOV L,E ; CALL ent2 ; DCR D ; Decrement D JZ goon ; MOV A,L ; MOV L,C ; Base 6 to L MOV C,A ; CALL dlst ; Move quotient mantissa over MOV A,L ; C-ptr to A MOV E,C ; L-ptr to E MOV C,A ; C-ptr to C JMP rep3 ; ; goon: CALL aors ; Check if result is normalized JM crin ; MOV A,L ; L-ptr to A MOV L,C ; C-ptr to L MOV C,A ; L-ptr to C CALL dlst ; Shift quotient left MOV C,L ; MOV L,E ; CALL ldcp ; Compute the characteristic of result RET ; ; crin: CALL cfche ; Get A=char(HL), E=char(H,B) SUB E ; New char = char(dividend) - char(divisor) CPI 7FH ; Check max positive number JZ oflwc ; Jump on overflow ADI 01H ; Add 1, since we did not left shift CALL cchk ; Check and store chraracteristic RET ; ; ;-------------------------------- ; Addition subroutine. ; ladd: XRA A ; Set up to add JMP lads ; Now, do it ; ;-------------------------------- ; Subtraction subroutine. ; lsub: MVI A,128 ; Set up to subtract ; ; Subroutine LADS. ; ; Floating-Point add or sub ; A = 128 on entry to SUB ; A = 0 on entry to ADD ; F-S F, first operand destroyed ; Base 11 used for scatch ; lads: CALL acpr ; Save entry point at base 6 CALL bchk ; Check addend/subtrahend = zero RZ ; If so, result=arg, so return ; This will prevent underflow ; indication on zero + or - zero. CALL ccmp ; JZ eq02 ; If equal, go on MOV D,A ; Save L-ptr char in D JC lltb ; SUB E ; L > D if here ANI 127 ; MOV D,A ; Difference to D MOV E,L ; Save base in E MOV L,C ; C-ptr to L INR L ; C-ptr 1 to L MOV M,E ; Save base in C ptr 1 MOV L,B ; B-ptr to L JMP nchk ; ; lltb: MOV A,E ; L < B if here, B-ptr to A SUB D ; Subtract L-ptr char from B-ptr char ANI 127 ; MOV D,A ; Difference to D nchk: MVI A,24 ; CMP D ; JNC sh10 ; MVI D,24 ; sh10: ORA A ; CALL drst ; DCR D ; JNZ sh10 ; MOV A,L ; CMP B ; JNZ eq02 ; F > S if L <> B MOV L,C ; C-ptr to L INR L ; C-ptr 1 to L MOV L,M ; Restore L eq02: CALL lasd ; Check what to CALL acpr ; Save answer CPI 02H ; Test for zero answer JNZ not0 ; JMP wzer ; Write floating zero and return ; not0: MVI D,01H ; Will test for sub ANA D ; JZ addz ; LSB 1 implies sub CALL tstr ; Check normal/reverse JZ subz ; If normal, go SUBZ MOV A,L ; Otherwise, reverse MOV L,B ; roles MOV B,A ; of L and B. subz: CALL dsub ; Subtract smaller from bigger CALL mant ; Set up sign of result CALL tstr ; See if we need to interchange B-ptr and L-ptr JZ norm ; No interchange nexessary, so normalize ; and return. MOV A,L ; Interchange MOV L,B ; L MOV B,A ; and B. MOV A,C ; C-ptr to A MOV C,B ; B-ptr to C MOV E,L ; L-ptr to E MOV B,A ; C-ptr to B CALL lxfr ; Move B-ptr> to L-ptr> MOV A,B ; MOV B,C ; MOV C,A ; MOV L,E ; JMP norm ; Normalize result and return ; ; Copy the larger characteristic to the result. ; addz: CALL ccmp ; Compare the characteristic JNC add2 ; If char(HL) > char(H,B) continue CALL bctl ; If char(HL) < char(H,B), then copy ; char(H,B) to char(HL). add2: CALL mant ; Compute sign of result CALL dadd ; Add mantissas JNC sccfg ; If there is no overflow: done CALL drst ; If overflow, shift right CALL incr ; and increment characteristic. RET ; All done, so return ; ; This routine stores the mantissa sign in the result. ; The sign has previously been computed by LASD. ; mant: MOV E,L ; Save L-ptr MOV L,C ; C-ptr to L MOV A,M ; Load index word ANI 128 ; Scarf sign MOV L,E ; Restore L-ptr INR L ; L-ptr 2 INR L ; INR L ; To L MOV E,A ; Save sign in E MOV A,M ; ANI 127 ; Scarf char ADD E ; Add sign MOV M,A ; Store it DCR L ; Restore DCR L ; DCR L ; L-ptr RET ; ; ; Subroutine LASD. ; ; Utility routine for LADS. ; Calculates true operand and sign. ; Returns answer in ; lasd: CALL msfh ; Fetch mantissa signs, F in A,D CMP E ; Compare signs JC abch ; F, S- means go to A branch JNZ bbch ; F-, S means go to B branch ADD E ; Same sign if here: add signs JC bmin ; If both minus, will overflow CALL aors ; Both positive if here JP L000 ; If an add, load 0 com1: CALL dcmp ; Compare F sign S JC L131 ; S > F, so load 131 JNZ L001 ; F > S, so load 1 L002: MVI A,02H ; Error condition: zero answer RET ; ; bmin: CALL aors ; Check for add or sub JP L128 ; Add, so load 128 com2: CALL dcmp ; Compare F with S JC L003 ; S > F, so load 3 JNZ L129 ; F > S, so load 129 JMP L002 ; Error ; abch: CALL aors ; FT, S-, so test for A/S JM L000 ; Subtract, so load 0 JMP com1 ; Add, so go to DCMP ; bbch: CALL aors ; F-, S, so test for A/S JM L128 ; Sub JMP com2 ; Add ; L000: XRA A ; 0 RET ; ; L001: MVI A,1 ; 1 RET ; ; L003: MVI A,3 ; 3 RET ; ; L128: MVI A,128 ; 128 RET ; ; L129: MVI A,129 ; 129 RET ; ; L131: MVI A,131 ; 131 RET ; ; ;-------------------------------- ; Subroutine LMCM. ; ; Compares the magnitude of two floating-point numbers. ; Z 1 if, C 1 if F < S ; lmcm: CALL ccmp ; Check chars RNZ ; Return if not equal CALL dcmp ; If equal, check mantissas RET ; ; ;-------------------------------- ; Multiply subroutine. ; ; L-ptr * B-ptr to C-ptr ; lmul: CALL csign ; Compute sign of result and store it CALL zchk ; Check first operand for zero JZ wzerc ; Zero * anything = zero CALL bchk ; Check second operand for zero JZ wzerc ; Anything * zero = zero MOV E,L ; Save L-ptr MOV L,C ; C-ptr to L CALL dclr ; Clear product mantissa locations MOV L,E ; L-ptr to L MVI D,24 ; Load number of iterations CALL dclr ; Shift L-ptr right JC dclr ; Will add B-ptr if C < 1 MOV A,L ; Interchange MOV L,C ; L and MOV C,A ; C ptrs. intr: CALL dclr ; Shift product over MOV A,L ; Interchange MOV L,C ; L and C ptrs back to MOV C,A ; original>. DCR D ; JNZ dclr ; More cycles if Z < 0 CALL dclr ; Test if result is normalized JM dclr ; If normalized, go compute char MOV E,L ; Save L-ptr in E MOV L,C ; Set L=C-ptr CALL dclr ; Left shift result to normalize MOV L,E ; Restore L-ptr CALL dclr ; Otherwise, set A=char(HL), E=char(H,B) ADD E ; Char(result) = char(HL) + char(H,B) CPI 32 ; Check for smallest negative number JZ dclr ; If so, then underflow SUI 01H ; Subtract 1 to compensate for normalize CALL dclr ; Check characteristic and store it RET ; Return ; madd: MOV A,L ; Interchange MOV L,C ; L and MOV C,A ; C ptrs. CALL dclr ; Accumulate product JMP intr ; ; ;-------------------------------- ; Subroutine NORM. ; ; This subroutine will normalize a floating-point number, ; preserving its original sign. ; We check for underflow, and set the condition flag appropriately. ; (See "Error returns".) ; There is an entry point to float a signed integer (FLOAT), ; and an entry point to float an unsigned integer. ; ; Entry points: ; NORM -- Normalize floating-point number at (HL) ; FLOAT -- Float triple-precision integer at (HL), ; preserving sign bit in (HL)+3. ; DFXL -- Float unsigned (positive) triple-precision integer at (HL). ; ; Registers on exit: ; A = condition flag (see "Error returns".) ; D,E = garbage ; B,C,H,L = same as on entry ; norm: MOV E,L ; Save L in E CALL gchar ; Get char(HL) in A with sign extended MOV D,A ; Save char in D MOV L,E ; Restore L fxl2: CALL zmchk ; Check for zero mantissa JZ wzer ; If zero mantissa, then zero result rep6: MOV A,M ; Get MSByte of mantissa ORA A ; Set flags JM schar ; If MSB=1, then number is normalized ; and we go to store the characteristic. MOV A,D ; Otherwise, check for underflow CPI minch ; Compare with minimum char JZ wund ; If equal, then underflow CALL dlst ; Shift mantissa left DCR D ; Decrement characteristic JMP rep6 ; Loop and test next bit schar: JMP incr3 ; Store the charactersitic, using ; the same code as the increment. ; dfxl: MOV E,L ; Enter here to float unsigned integer ; First, save L in E INR L ; Make (HL) point to char INR L ; Make (HL) point to char INR L ; Make (HL) point to char XRA A ; Zero Accumulator MOV M,A ; Store a plus (+) sign MOV L,E ; Restore L float: MVI D,24 ; Enter here to float integer, ; preserving original sign in (HL)+3. JMP fxl2 ; Go float the number ; ;-------------------------------- ; Subroutine ZCHK. ; ; This routine sets the Zero flag if it detects a floating zero at (HL). ; ; Subroutine ZMCHK. ; ; This routine sets the Zero flag if it detects a zero mantissa at (HL). ; zchk: zmchk: INR L ; Set L to point to last byte of mantissa INR L ; Set L to point to last byte of mantissa MOV A,M ; Load least significant byte DCR L ; L points to middle byte ORA M ; OR with LSByte DCR L ; L points to MSByte of mantissa (org val) ORA M ; OR in MSByte RET ; Returns with Zero flag set appropriately ; ;-------------------------------- ; Subroutine BCHK. ; ; This routine checks (H,B) for floating-point zero. ; bchk: MOV E,L ; Save L-ptr in E MOV L,B ; Set L=B-ptr CALL zchk ; Check for zero MOV L,E ; Restore L=L-ptr RET ; Return ; ;-------------------------------- ; Subroutine DLST. ; ; Shifts double word one place left. ; dlst: INR L ; INR L ; TP MOV A,M ; Load it ORA A ; Kill Carry RAL ; Shift if left MOV M,A ; Store it DCR L ; MOV A,M ; Load it RAL ; Shift if left ; If Carry set by first shift, it will be in LSB of second word. MOV M,A ; DCR L ; TP extension MOV A,M ; RAL ; MOV M,A ; All done TP RET ; ; ;-------------------------------- ; Subroutine DRST. ; ; Shifts double word one place to the right. ; Does not affect D. ; drst: MOV E,L ; TP modified right shift TP MOV A,M ; Load first word RAR ; Rotate it right MOV M,A ; Store it INR L ; TP MOV A,M ; Load second word RAR ; Shift it right MOV M,A ; Store it INR L ; TP extension MOV A,M ; RAR ; MOV M,A ; MOV L,E ; TP -- All done TP RET ; ; ;-------------------------------- ; Subroutine DADD. ; ; Adds two double precision words, C 1 if there is overflow. ; dadd: MOV E,L ; Save base in E MOV L,B ; Base 3 to L INR L ; Base 4 to L INR L ; TP MOV A,M ; Load S mantB MOV L,E ; Base to L INR L ; Base+1 to L INR L ; TP ADD M ; Add two mantBs MOV M,A ; Store answer MOV L,B ; TP extension INR L ; MOV A,M ; MOV L,E ; INR L ; ADC M ; MOV M,A ; TP -- All done MOV L,B ; Base 3 to L MOV A,M ; MantA of S to A MOV L,E ; Base to L ADC M ; Add with Carry MOV M,A ; Store answer RET ; ; ;-------------------------------- ; Subroutine DCLR. ; ; Clears two successive locations of memory. ; dclr: XRA A ; MOV M,A ; INR L ; MOV M,A ; INR L ; TP extension MOV M,A ; TP zero 3 DCR L ; TP -- All done DCR L ; RET ; ; ;-------------------------------- ; Subroutine DSUB. ; ; Double precision subtract. ; dsub: MOV E,L ; Save base in E INR L ; TP extension INR L ; Start with lows MOV A,M ; Get arg MOV L,B ; Now, set up to subtract INR L ; INR L ; SUB M ; Now, do it MOV L,E ; Now, must put it back INR L ; INR L ; MOV M,A ; Put back DCR L ; TP -- All done MOV A,M ; Get low of L-op MOV L,B ; Set to B-op INR L ; Set to B-op low SBB M ; Get difference of lows MOV L,E ; Save in L-op low INR L ; To L-op low MOV M,A ; Into RAM DCR L ; Back up to L-op high MOV A,M ; Get L-op high MOV L,B ; Set to B-op high SBB M ; Subtract with Carry MOV L,E ; Save in L-op high MOV M,A ; Into RAM RET ; All done ; ;-------------------------------- ; Subroutine GCHAR. ; ; This subroutine returns the characteristic of the floating-point ; number pointed to by (HL) in the A-register, with its sign extended ; into the leftmost bit. ; ; Registers on exit: ; A = characteristic of (HL) with sign extended ; L = (original L)+3 ; B,C,D,E,H = same as on entry ; gchar: INR L ; Make (HL) point to char INR L ; Make (HL) point to char INR L ; Make (HL) point to char MOV A,M ; Set A=char + mantissa sign ANI 7FH ; Get rid of mantissa sign bit ADI 64 ; Propagate char sign into leftmost bit XRI 64 ; Restore original sign bit RET ; ; ; Return with (HL) pointing to the char = original (HL)+3 ; Someone else will clean up ;-------------------------------- ; Subroutine CFCHE. ; ; This subroutine returns the characteristic of the floating-point numbers ; pointed to by (HL) and (HB) in the A and E registers, respectively, with ; their signs extended into the leftmost bit. ; ; Registers on exit: ; A = characteristic of (HL) with sign extended ; C = characteristic of (HB) with sign extended ; B,C,H,L = same as on entry ; D = A ; cfche: MOV E,L ; Save L-ptr in E MOV L,B ; Set L=B-ptr CALL gchar ; Get char(HB) with sign extended in A MOV L,E ; Restore L=L-ptr MOV E,A ; Set E=char(HB) with sign extended CALL gchar ; Set A=char(HL) with sign extended DCR L ; Restore L=L-ptr DCR L ; Restore L=L-ptr DCR L ; Restore L=L-ptr MOV D,A ; Set D=A=char(HL) with sign extended RET ; ; ;-------------------------------- ; Subroutine CCMP. ; ; This subroutine compares the charactersitic of floating-point numbers ; pointed to by (HL) and (HB). ; The Zero flag is set if char(HL) equals char(HB). ; The Carry flag is set if char(HL) is less than char(HB). ; ; Registers on exit: ; A = characteristic of (HL) with sign extended ; E = charactersitic of (HB) with sign extended ; D = A ; B,C,H,L = same as on entry ; ccmp: CALL cfche ; Fetch characteristic with sign extended ; into A (char(HL)) and E (char(HB)) regs. MOV D,A ; Save char (HL) SUB E ; Subtract E (char(HB)) RAL ; Rotate sign bit into Carry bit MOV A,D ; Restore A=char(HL) RET ; Return ; ;-------------------------------- ; Error returns. ; ; The following code is used to return various error conditions. ; In each case, a floating point number is stored in the four words ; pointed to by (HL), and a flag is stored in the Accumulator. ; ; Condition Flag Result (+) Result (-) ; --------- ---- ----------- ----------- ; Underflow FF 00 00 00 40 00 00 00 C0 ; Overflow 7F FF FF FF 3F FF FF FF BF ; Indefinite 3F FF FF FF 3F FF FF FF BF ; Normal num. 00 xx xx xx xx xx xx xx xx ; Normal zero 00 00 00 00 40 (always returns +0) ; ; Entry points: ; WUND -- Write UNDerflow ; WOVR -- Write OVeRflow ; WIND -- Write INDefinite ; WZER -- Write normal ZERo ; ; (WFLT = Write FLoaTing-point number) ; wflt MACRO vmant,vchar,vflag,label MVI D,vchar ;; Load charactersitic into D-register CALL wchar ;; Write characteristic label: MVI A,vmant ;; Load mantissa value ;; We assume here that all bytes of mantissa are the same CALL wmant ;; Write the mantissa MVI A,vflag ;; Set Accumulator to flag ORA A ;; Set flags properly RET ;; Return (WMANT restored (HL)) ENDM ; ; Write underflow, using WFLT macro. ; wund: wflt 00H,40H,0FFH,uflw1 ; ; Write overflow, using WFLT macro. ; wovr: wflt 0FFH,3FH,7FH,oflw1 ; ; Write indefinite, using WFLT macro. ; wind: wflt 0FFH,3FH,3FH,indf1 ; ; Write normal zero (not a macro). ; wzer: INR L ; INR L ; INR L ; MVI M,40H ; Store characteristic for zero XRA A ; Zero Accumulator CALL wmant ; Store zero mantissa ORA A ; Set flags properly RET ; Return ; ;-------------------------------- ; Routine to write mantissa for "error returns". ; wmant: DCR L ; Point LSByte of mantissa MOV M,A ; Store LSByte of mantissa DCR L ; Point to next LSByte of mantissa MOV M,A ; Store next LSByte of mantissa DCR L ; Point to MSByte of mantissa MOV M,A ; Store MSByte of mantissa RET ; Floating-point result ; ;-------------------------------- ; Routine to write characteristic for "error returns". ; wchar: INR L ; Set (HL) to point to characteristic INR L ; Idem INR L ; Idem MOV A,M ; Load characteristic in A ANI 80H ; Just keep mantissa sign ORA D ; OR in new characteristic MOV M,A ; Store it back RET ; ; ; Return with (HL) pointing to characteristic of result ; Someone else will fix up (HL) ;-------------------------------- ; Subroutine INDFC. ; ; This routine writes a floating-point indefinite at (HC), ; sets the condition flag, and returns. ; indfc: MOV E,L ; Save L-ptr in E MOV L,C ; Set L=C-ptr, so (HL)=addr of result CALL wind ; Write indefinite MOV L,E ; Restore L=L-ptr RET ; Return ; ;-------------------------------- ; Subroutine WZERC. ; ; This routine writes a normal floating-point zero at (HC), ; sets the condition flag, and returns. ; wzerc: MOV E,L ; Save L-ptr in E MOV L,C ; Set L=C-ptr, so (HL)=addr of result CALL wzer ; Write normal zero MOV L,E ; Restore L=L-ptr RET ; Return ; ;-------------------------------- ; Subroutine INCR. ; ; This subroutine increments the characteristic of the floating-point ; number pointed to by (HL). ; We test for overflow, and set appropriate flag (see "Error returns"). ; ; Registers on exit: ; A = condition flag (see "Error returns") ; D = clobbered ; B,C,H,L = same as on entry ; incr: CALL gchar ; Get char with sign extended CPI maxch ; Compare with max char permitted JZ oflw1 ; Increment would cause overflow MOV D,A ; Save it in D INR D ; Increment it JMP incr2 ; Jump around alternate entry point ; incr3: INR L ; Come here to store characteristic INR L ; Point (HL) to char INR L ; Point (HL) to char incr2: MVI A,127 ; ANA D ; Kill sign bit MOV D,A ; Back to D MOV A,M ; Now, sign it ANI 128 ; Get mantissa sign ORA D ; Put together MOV M,A ; Store it back DCR L ; Now, back to base DCR L ; TP DCR L ; sccfg: XRA A ; Set success flag RET ; ; ;-------------------------------- ; Subroutine DECR. ; ; This subroutine decrements the characteristic of the floating-point ; number pointed to by (HL). ; We test for underflow and set appropriate flag (see "Error returns"). ; ; Registers on exit: ; A = condition flag (see "Error returns") ; D = clobbered ; B,C,H,L = same as on entry ; decr: CALL gchar ; Get char with sign extended CPI minch ; Compare with min char permitted JZ uflw1 ; Decrement would cause underflow MOV D,A ; Save characteristic in D DCR D ; Decrement characteristic JMP incr2 ; Go store it back ; ;-------------------------------- ; Subroutine AORS. ; ; Return S=1 if base \6 has a 1 in MSB. ; aors: MOV E,L ; Save base MOV L,C ; Base \6 to L MOV A,M ; Load it ORA A ; Set flags MOV L,E ; Restore base RET ; ; ;-------------------------------- ; Subroutine TSTR. ; ; Checks C-ptr, to see if next LSB=1. ; Returns Z=1 if not. ; Destroys F, D. ; tstr: MOV E,L ; Save base MOV L,C ; C-ptr to L MVI D,02H ; Mask to D MOV A,M ; Load value MOV L,E ; Restore base ANA D ; AND value with mask RET ; ; ;-------------------------------- ; Subroutine ACPR. ; ; Stores A in location of C-ptr. ; L-ptr in E. ; acpr: MOV E,L ; Save L-ptr MOV L,C ; C-ptr to L MOV M,A ; Store A MOV L,E ; Restore base RET ; ; ;-------------------------------- ; Subroutine DCMP. ; ; Compares two double length words. ; dcmp: MOV A,M ; Number mantissa to A MOV E,L ; Save base in E MOV L,B ; Base 3 to L CMP M ; Compare with den (?) mantissa MOV L,E ; Return base to L RNZ ; Return if not the same INR L ; L to number mantissa B (?) MOV A,M ; Load it MOV L,B ; Den (?) mantissa B (?) add to L INR L ; Base 4 to L CMP M ; MOV L,E ; RNZ ; TP extension INR L ; Now, check byte 3 INR L ; MOV A,M ; Get for compare MOV L,B ; INR L ; INR L ; Byte 3 now CMP M ; Compare MOV L,E ; TP -- All done RET ; ; ;-------------------------------- ; Subroutine DIVC. ; ; Performs one cycle of double precision floating-point divide. ; Enter at ENT1 on first cycle. ; Enter at ENT2 all thereafter. ; ent2: CALL dlst ; Shift moving dividend JC over ; If Carry=1, number > D (?) ent1: CALL dcmp ; Compare number with Den(ormalized?) JNC over ; If Carry not set, number > Den (?) RET ; ; over: CALL dsub ; Call double subtract MOV E,L ; Save base in E MOV L,C ; Base 6 to L INR L ; Base 7 to L INR L ; TP MOV A,M ; ADI 01H ; Add 1 MOV M,A ; Put it back MOV L,E ; Restore base to L RET ; ; ;-------------------------------- ; Subroutine LXFR. ; ; Moves C-ptr to E-ptr. ; Moves 3 words if enter at LXFR. ; lxfr: MVI D,04H ; Move 4 words rep5: MOV L,C ; C-ptr to L MOV A,M ; C-ptr> to A MOV L,E ; E-ptr to L MOV M,A ; INR C ; Increment C INR E ; Increment E to next DCR D ; Test for done JNZ rep5 ; Go for til D=0 MOV A,E ; Now, reset C and E SUI 04H ; Reset back by 4 MOV E,A ; Put back in E MOV A,C ; Now, reset C SUI 04H ; by 4. MOV C,A ; Back to C RET ; Done ; ;-------------------------------- ; Subroutine LDCP. ; ; This subroutine computes the characteristic for the floating-point ; divide routine. ; ; Registers on exit: ; A = condition flag (see "Error returns") ; D,E = garbage ; B,C,H,L = same as on entry ; ; Registers on entry: ; (H,B) = address of divisor ; (H,C) = address of quotient ; (HL) = address of dividend ; ldcp: CALL cfche ; Set E=char(H,B), A=char(HL) SUB E ; Subtract to get new characteristic JMP cchk ; Go check for over/underflow ; and store characteristic. ; ;-------------------------------- ; Subroutine LMCP. ; ; This subroutine computes the characteristic for the floating-point ; multiply routine. ; ; Registers on exit: ; A = condition flag (see "Error returns") ; D,F = garbage ; B,C,H,L = same as on entry ; ; Registers on entry: ; (H,B) = address of multiplicand ; (H,C) = address of product ; (HL) = address of multiplier ; lmcp: CALL cfche ; Set E=char(H,B), A=char(HL) ADD E ; Add to get new characteristic ; ; Now, fall into the routine which checks for over/underflow, ; and store characteristic. ; ; Subroutine CCHK. ; ; This subroutine checks a characteristic in the Accumulator for ; overflow or underflow. ; It then stores the characteristic, preserving the previously ; computed mantissa sign. ; ; Registers on entry: ; (HL) = address of one operand ; (H,B) = address of other operand ; (H,C) = address of result ; A = new characteristic of result ; ; Registers on exit: ; A = condition flag (see "Error returns") ; D,E = garbage ; B,C,H,L = same as on entry ; cchk: CPI 64 ; Check for 0 to +63 JC storc ; Jump if okay CPI 128 ; Check for +64 to +127 JC oflwc ; Jump if overflow CPI 192 ; Check for -128 to -65 JC uflwc ; Jump if underflow storc: MOV E,L ; Save L in E MOV L,C ; Let L point to result MOV D,A ; Save characteristic in D CALL incr3 ; Store characteristic MOV L,E ; Restore L RET ; Return ; ;-------------------------------- ; Subroutine OFLWC. ; ; This routine writes a floating-point overflow at (H,C), ; sets the condition flag, and returns. ; oflwc: MOV E,L ; Save L in E MOV L,C ; Set L=C-ptr, so (HL)=addr of result CALL wovr ; Write out overflow MOV L,E ; Restore L RET ; Return ; ;-------------------------------- ; Subroutine UFLWC. ; ; This routine writes a floating-point underflow at (H,C), ; sets the condition flag, and returns. ; uflwc: MOV E,L ; Save L in E MOV L,C ; Set L=C-ptr, so (HL)=addr of result CALL wund ; Write out underflow MOV L,E ; Restore L RET ; Return ; ;-------------------------------- ; Subroutine CSIGN. ; ; This subroutine computes and store the mantissa sign for the ; floating-point multiply and divide routines. ; ; Registers on entry: ; (HL) = address of one operand ; (H,B) = address of other operand ; (H,C) = address of result ; ; Registers on exit: ; A,D,E = garbage ; B,C,H,L = same as on entry ; csign: CALL msfh ; Set A=sign(HL), E=sign(H,B) XRA E ; Exclusive-OR signs, to get new sign CALL cstr ; Store sign into result RET ; Return ; ;-------------------------------- ; Subroutine CSTR. ; ; Stores value in A in C-ptr\2. ; Puts L-ptr in E. ; cstr: MOV E,L ; Save L-ptr in E MOV L,C ; C-ptr to L INR L ; C-ptr\2 INR L ; To L INR L ; TP MOV M,A ; Store answer MOV L,E ; L-ptr back to L RET ; ; ;-------------------------------- ; Subroutine MSFH. ; ; This subroutine fetches the signs of the mantissas of the floating-point ; numbers pointed to by (HL) and (H,B) into the A and E registers, ; respectively. ; ; Registers on exit: ; A = sign of mantissa of (HL) ; E = sign of mantissa of (H,B) ; B,C,D,H,L = same as on entry ; msfh: MOV E,L ; Save L-ptr MOV L,B ; B-ptr to L INR L ; B-ptr\2 INR L ; TP INR L ; To L MOV A,M ; B-ptr\2> to A ANI 128 ; Save mantissa sign MOV L,E ; L-ptr back to L MOV E,A ; Store B-ptr mantissa sign INR L ; L-ptr\2 INR L ; TP INR L ; To L MOV A,M ; L-ptr\2> to A ANI 128 ; Save L-ptr mantissa sign DCR L ; L-ptr back DCR L ; To L DCR L ; LP RET ; ; ;-------------------------------- ; Subroutine BCTL. ; ; Moves B-ptr char to L-ptr char. ; Destroys E. ; bctl: MOV E,L ; L-ptr to E MOV L,B ; B-ptr to L INR L ; B-ptr \2 INR L ; TP INR L ; To L MOV A,M ; B-ptr to A MOV L,E ; L-ptr to L INR L ; L-ptr \2 INR L ; To L INR L ; TP MOV M,A ; Store B-ptr char in L-ptr char MOV L,E ; L-ptr to L RET ; ; ;-------------------------------- ; Square root. ; ; The L register points to the ? to be operated on. ; The B register points to the location where the result is to be stored. ; The C register points to a 17-byte scratch area, where: ; ; C = iteration count ; C+1 = L register ; C+2 = B register ; C+3 to C+6 = internal register 1 ; C+7 to C+10 = internal register 2 ; C+11 to C+14 = internal register 3 ; C+15 = ? ; dsqrt: MOV A,L ; Store L in MOV L,C ; 2nd word scratch. MVI M,00H ; Initialize iterative count INR L ; MOV M,A ; INR L ; Store B in 3rd MOV M,B ; word of scratch. INR L ; Set C to internal MOV C,L ; register 1. MOV L,A ; Set L ptr at (?) MOV A,H ; Set registers for copy CALL copy ; Copy (?) to internal register 1 CALL gchr ; Put char in A MOV B,A ; Make copy ANI 128 ; Check negative JNZ ersq ; MOV A,B ; ANI 64 ; Check negative exponent MOV A,B ; JZ epos ; RAR ; Divide by 2 ANI 7FH ; ORI 64 ; Set Sign bit MOV M,A ; Save first approximation JMP agn4 ; ; epos: RAR ; Divide by 2 ANI 7FH ; MOV M,A ; Save first approximation agn4: MOV L,C ; Set registers MOV A,C ; to copy ADI 04H ; first approximation MOV C,A ; into internal register 2 MOV A,H ; from internal register 1. CALL copy ; MOV A,C ; SUI 04H ; Multiply internal register 1 MOV L,A ; MOV B,C ; Times internal register 2 ADI 08H ; Place result in MOV C,A ; internal register 3. CALL lmul ; MOV A,C ; SUI 08H ; Copy original into MOV C,A ; internal register 1. SUI 02H ; MOV L,A ; MOV L,M ; MOV A,H ; CALL copy ; MOV A,C ; ADI 08H ; Add MOV L,A ; internal register 3 MOV B,C ; to internal register 1. ADI 04H ; Answer to MOV C,A ; internal register 3 CALL ladd ; MOV A,L ; SUI 04H ; Divide internal register 3 MOV B,A ; by internal register 2. SUI 04H ; Put answer in MOV C,A ; internal register 1. CALL ldiv ; CALL gchr ; SUI 01H ; ANI 7FH ; MOV M,A ; MOV A,C ; SUI 03H ; C points to internal register 1 MOV L,A ; Get iteration count MOV B,M ; INR B ; Increment it MOV M,B ; MOV A,B ; CPI 05H ; If = 5, return answer JNZ agn4 ; Otherwise, continue MOV L,C ; aldn: DCR L ; Copy answer into MOV C,M ; location requested. INR L ; MOV A,H ; CALL copy ; RET ; ; ersq: MOV L,C ; CALL wzer ; Write a floating zero JMP aldn ; C+1 = L register ; ;-------------------------------- ; 5-digit floating-point output. ; ; Routine to convert floating-point numbers to ASCII, and ; output them via a subroutine called OUTR. ; cvrt: CALL zchk ; Check for new zero JNZ nnzro ; Not zero INR C ; It was, offset C by 2 INR C ; MOV L,C ; CALL wzer ; Write zero CALL sign ; Send space on positive zero INR L ; Point to decimal exponent INR L ; INR L ; INR L ; XRA A ; Set it to zero MOV M,A ; JMP mdskp ; Output it ; nnzro: MOV D,M ; Get the number to convert INR L ; MOV B,M ; INR L ; MOV E,M ; INR L ; 4 word TP MOV A,M ; INR C ; Offset scratch pointer by 2 INR C ; MOV L,C ; L not needed anymore MOV M,D ; Save number in scratch INR L ; MOV M,B ; INR L ; MOV M,E ; TP INR L ; TP MOV B,A ; Save copy of char & sign ANI 7FH ; Get only char MOV M,A ; Save ABS(number) CPI 64 ; Check for zero JZ nzro ; SUI 01H ; Get sign of decimal exponent ANI 64 ; Get sign of char nzro: RLC ; Move it to sign position INR L ; Move to decimal exponent MOV M,A ; Save sign of exponent MOV A,B ; Get mantissa sign back CALL sign ; Output sign MVI L,(ten5 AND 255) ; Try mult. or div. by 100.000 first CALL copt ; Make a copy in RAM tstb: CALL gchr ; Get char of number MOV B,A ; Save a copy ANI 64 ; Get absolute value of char MOV A,B ; In case plus JZ gotv ; Already plus MVI A,128 ; Make minus into plus SUB B ; Plus = 128 - char gotv: CPI 18 ; Test for use of 100.000 JM try1 ; Wont go CALL mord ; Will go, so do it ADI 05H ; Increment decimal exponent by 5 MOV M,A ; Update memory JMP tstb ; Go try again ; try1: MVI L,(ten AND 255) ; Now, use just TEN CALL copt ; Put it in RAM tst1: CALL gchr ; Get characteristic CPI 01H ; Must get in range 1 to 6 JP ok1 ; At least it is 1 or bigger mdgn: CALL mord ; Must mult. or div. by 10 ADI 01H ; Increment decimal exponent MOV M,A ; Update memory JMP tst1 ; Now, try again ; ok1: CPI 07H ; Test for less than 7 JP mdgn ; Nope -- 7 or greater mdskp: MOV L,C ; Set up digit count DCR L ; DCR L ; in first word of scratch. MVI M,05H ; 5 digits MOV E,A ; Save char as left shift count CALL lsft ; Shift left proper number CPI 10 ; Test for 2 digits here JP twod ; Jump if 2 digits to output CALL digo ; Output first digit popD: CALL multt ; Multiply the number by 10 inpop: CALL digo ; Print digit in A JNZ popD ; More digits? MVI A,197 ; No, so print E CALL outr ; Basic call to output CALL getex ; Get decimal exponent MOV B,A ; Save a copy CALL sign ; Output sign MOV A,B ; Get exponent back ANI 3FH ; Get good bits CALL ctwo ; Go convert 2 digits digo: ADI 0B0H ; Make A into ASCII CALL outr ; Output digit MOV L,C ; Get digit count DCR L ; Back up to digit count DCR L ; MOV A,M ; Test for decimal point CPI 05H ; Print "." after first digit MVI A,0AEH ; Just in case CZ outr ; Output "." if first digit MOV D,M ; Now, decrement digit count DCR D ; MOV M,D ; Update memory, and leave flops set RET ; Serves as terminator for DIGO & CVRT ; multt: MVI E,01H ; Multiply by 10 (start with *2) CALL lsft ; Left shift 1 = *2 MOV L,C ; Save *2 in "result" DCR L ; Set to top of number MOV A,C ; Set C to result ADI 09H ; MOV C,A ; Now, C set right MOV A,H ; Show RAM-to-RAM transfer CALL copy ; Save *2 finally MOV A,C ; Must reset C SUI 09H ; Back to normal MOV C,A ; MVI E,02H ; Now, get (*2)*4 = *8 MOV L,C ; But must save overflow DCR L ; CALL tlp2 ; Get *8 MOV L,C ; Set up to call DADD MOV A,C ; Set B to *2 ADI 0AH ; To *2 MOV B,A ; CALL dadd ; Add 2 low words DCR L ; Back up to overflow MOV A,M ; Get it MOV L,B ; Now, set to *2 overflow DCR L ; It is a B-1 ADC M ; Add with carry -- Carry was preserved RET ; All done, return overflow in A ; lsft: MOV L,C ; Set ptr for left shift of number DCR L ; Back up to overflow XRA A ; Overflow = zero the first time tloop: MOV M,A ; Save overflow tlp2: DCR E ; Test for done RM ; Done when E minus INR L ; Move to low INR L ; INR L ; TP extension MOV A,M ; Shift left 4 bytes RAL ; MOV M,A ; Put back DCR L ; TP -- All done MOV A,M ; Get low RAL ; Shift left 1 MOV M,A ; Restore it DCR L ; Back up to high MOV A,M ; Get high RAL ; Shift it left with Carry MOV M,A ; Put it back DCR L ; Back up to overflow MOV A,M ; Get overflow RAL ; Shift it left JMP tloop ; Go for more ; sign: ANI 80H ; Get sign bit MVI A,0A0H ; Space, instead of plus JZ plsv ; Test for + MVI A,0ADH ; Negative plsv: CALL outr ; Output sign RET ; ; gchr: MOV L,C ; Get characteristic geta: INR L ; Move to it INR L ; INR L ; TP MOV A,M ; Fetch into A RET ; Done ; mord: CALL getex ; Mult. or div. depending on exponent MOV E,A ; Save decimal exponent MOV B,L ; Set up to mult. or div. INR B ; Now, increments pointer set MOV L,C ; L points to number to convert MOV A,C ; Point C at "result" area ADI 09H ; In scratch MOV C,A ; Now, C set right MOV A,E ; Now, test for mult. ANI 80H ; Test negative decimal exponent JZ divit ; If exponent is +, then divide CALL lmul ; Multiply finup: MOV A,C ; Save location of result MOV C,L ; C = location of number (it was destroyed) MOV L,A ; Set L to location of result MOV A,H ; Show RAM-to-RAM transfer CALL copy ; Move result to number getex: MOV L,C ; Now, get decimal exponent INR L ; JMP geta ; Use part og GCHR ; divit: CALL ldiv ; Divide JMP finup ; ; twod: CALL ctwo ; Convert to 2 digits MOV B,A ; Save ones digit CALL getex ; Get decimal exponent MOV E,A ; Save a copy ANI 80H ; Test for negative JZ add1 ; Bump exponent by 1, since 2 digits DCR E ; Decrement negative exponent, since 2 digits finit: MOV M,E ; Restore exponent with new value MOV A,B ; Now, do second digit JMP inpop ; Go out second, and rest fo (?) digits ; add1: INR E ; Compensate for 2 digits JMP finit ; ; ctwo: MVI E,0FFH ; Convert 2 digit bin to BCD loop: INR E ; Add up tens digit SUI 0AH ; Subtract 10 JP loop ; Till negative result ADI 0AH ; Restore ones digit MOV B,A ; Save ones digit MOV A,E ; Get tens digit CALL digo ; Output it MOV A,B ; Set A to second digit RET ; ; copt: MOV A,C ; Copy from 10 N to RAM ADI 05H ; MOV C,A ; Set C to place to put MVI A,(ten5 / 256) ; CALL copy ; Copy it MOV A,C ; Now, reset C SUI 05H ; MOV C,A ; It is reset RET ; ; copy: MOV B,H ; Save RAM H MOV H,A ; Set to source H MOV A,M ; Get 4 words into the registers INR L ; MOV D,M ; INR L ; MOV E,M ; INR L ; MOV L,M ; Last one erases L MOV H,B ; Set to destination RAM MOV B,L ; Save 4th word in B MOV L,C ; Set to destination MOV M,A ; Save first word INR L ; MOV A,M ; Save this word in A (input saves C here) MOV M,D ; Now, put second word INR L ; MOV M,E ; INR L ; MOV M,B ; All 4 copied, now RET ; All done ; ;-------------------------------- ten5 DB 0C3H,50H,00H,11H ; = 100000. ten DB 0A0H,00H,00H,04H ; = 10 ;-------------------------------- ; Scratch map for I/O conversion routines. ; ; Relative to (C+2) Use ; ----------------- --- ; C-2 Digit count ; C-1 Overflow ; C High number -- Mantissa ; C+1 Low number ; C+2 Characteristic ; C+3 Decimal exponent (sign & magnitude) ; C+4 Ten ** N ; C+5 Ten ** N ; C+6 Ten ** N ; C+7 Result of multiplication and division ; C+8 and temporary for *2. ; C+9 (idem) ; C+10 L for number to go into (input only) ; C+11 Digit just input (input only) ; err: MVI A,0BFH ; Error in input CALL outr ; Send a ? (space) MVI A,0A0H ; CALL outr ; Output a space JMP prmt ; Go prompt user, and restart ; ;-------------------------------- ; 4-1/2 digit input routine. ; ; L points to where to put input number ; C points to 13 words of scratch ; input: MOV B,L ; Save address where data MOV A,C ; is to go in scratch. ADI 0FH ; Compute location in scratch MOV L,A ; MOV M,B ; Put it INR C ; Offset scratch pointer INR C ; by 2. prmt: MVI A,0BAH ; Prompt user with ":" CALL outr ; Output ":" CALL zroit ; Zero number INR L ; and zero MOV M,A ; decimal exponent. CALL gnum ; Get integer part of number CPI 0FEH ; Terminator = "." ? JZ decpt ; Yes tstex: CPI 15H ; Test for E JZ inexp ; Yes: Handle exponent CPI 0F0H ; Test for space terminator JNZ err ; Not legal terminator CALL fltsgn ; Float and sign it scale: CALL getex ; Get decimal exponent ANI 7FH ; Get good bits MOV E,A ; Save copy ANI 40H ; Get sign of exponent RLC ; into sign bit. ORA A ; Set flops MOV B,A ; Save sign MOV A,E ; Get exponent back JZ apls ; Jump is + MVI A,80H ; Make minus SUB E ; Now, it is + apls: ADD B ; Sign number MOV M,A ; Save exponent (sign & magnitude) MVI L,(ten5 AND 255) ; Try MORD with 10**5 first CALL copt ; Transfer to RAM CALL getex ; Get decimal exponent int5: ANI 3FH ; Get magnitude of exponent CPI 05H ; Test for use of 10**5 JM trytn ; Wont go: Try 10 CALL mord ; Will go, so do it SUI 05H ; Magnitude = magnitude - 5 MOV M,A ; Update decimal exponent in RAM JMP int5 ; Go try again ; trytn: MVI L,(ten AND 255) ; Put ten in RAM CALL copt ; CALL getex ; Set up for loop int1: ANI 3FH ; Get magnitude ORA A ; Test for 0 JZ saven ; Done, move number out, and get out CALL mord ; Not done: do 10 SUI 01H ; Exponent = exponent - 1 MOV M,A ; Update memory JMP int1 ; Try again ; decpt: MOV L,C ; Zero digit count, DCR L ; since it is necessary DCR L ; to compute exponent. MVI M,00H ; Zeroed CALL ep1 ; GNUM in middle MOV E,A ; Save terminator MOV L,C ; Move digit count to exponent DCR L ; Back up to digit count DCR L ; MOV B,M ; Got digit count CALL getex ; Set L to decimal exponent MOV M,B ; Put exponent MOV A,E ; terminator back to A. JMP tstex ; Test for E+or-XX ; inexp: CALL fltsgn ; Float and sign number CALL saven ; Save number in (L) temporarily CALL zroit ; Zero out number for inputting exponent CALL gnum ; Now, input exponent CPI 0F0H ; Test for space terminator JNZ err ; Not legal: Try again MOV L,C ; Get exponent out of memory INR L ; TP INR L ; Exponent limited to 5 bits MOV A,M ; Get lowest 8 bits ANI 1FH ; Get good bits MOV B,A ; Save them INR L ; Set sign of exponent MOV A,M ; into A. ORA A ; Set flops MOV A,B ; In case nothing to do JM useit ; If negative, use as + MVI A,00H ; If +, make - SUB B ; 0-X = -X useit: INR L ; Point at exponent ADD M ; Get real decimal exponent MOV M,A ; Put in memory MOV A,C ; Now, get number back ADI 0DH ; Get add of L MOV L,A ; L points to L of number MOV L,M ; Now, L points to number MOV A,H ; RAM-to-RAM copy CALL copy ; Copy it back JMP scale ; Now, adjust for exponent ; gnum: CALL inp ; Get a character CPI 0A0H ; Ignore leading spaces JZ gnum ; CPI 0ADH ; Test for - JNZ tryp ; Not minus MOV L,C ; Minus, so set sign INR L ; in char location. INR L ; TP INR L ; MVI M,80H ; Set - sign JMP gnum ; ; tryp: CPI 0ABH ; Ignore + JZ gnum ; tstn: SUI 0B0H ; Strip ASCII RM ; Return if terminator CPI 0AH ; Test for number RP ; Illegal MOV E,A ; Save digit CALL getn ; Location of digit storage to L MOV M,E ; Save digit CALL multt ; Multiply number by 10 ORA A ; Test for too many digits RNZ ; Too many digits CALL getn ; Get digit MOV L,C ; Set L to number INR L ; INR L ; TP ADD M ; Add in the digit MOV M,A ; Put result back DCR L ; Now, do high MOV A,M ; Get high to add in Carry ACI 00H ; Add in Carry MOV M,A ; Update high DCR L ; TP extension MOV A,M ; ACI 00H ; Add in Carry MOV M,A ; TP -- All done RC ; Overflow error DCR L ; Bump digit count now DCR L ; MOV B,M ; Get digit count INR B ; Bump digit count MOV M,B ; Update digit count ; ep1: CALL inp ; Get next char JMP tstn ; Must be number or terminator ; fltsgn: MOV L,C ; Point L at number to float JMP float ; Go float it ; saven: MOV A,C ; Put number in (L) ADI 0DH ; Get add of L MOV L,A ; MOV E,M ; Get L of result MOV L,E ; Point L at (L) INR L ; Set to second word to save C MOV M,C ; Save C in (L)+1, since it will be destroyed MOV L,C ; Set up to call copy MOV C,E ; Now, L & C set MOV A,H ; RAM-to-RAM copy CALL copy ; Copy to L MOV C,A ; (L)+1 returned here, so set as C RET ; Now, everything hunky-dorry ; getn: MOV A,C ; Get digit ADI 0EH ; Last location in scratch MOV L,A ; Put in L MOV A,M ; Get digit RET ; ; zroit: MOV L,C ; Zero number XRA A ; MOV M,A ; TP INR L ; TP MOV M,A ; INR L ; MOV M,A ; INR L ; Now, set sign to + MOV M,A ; RET ; Done ; ;-------------------------------- ; END