; 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