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
/
lllfp_roche.asm
< prev
next >
Wrap
Assembly Source File
|
2009-12-11
|
43KB
|
1,623 lines
; 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
