MATH2.ASM

	SUBTTL	 $FIDIG  ADD TEXT DIGIT TO CURRENT ACCUMULATED NUMBER
;***************************************************************
;
;       $FIDIG  CONVERTS DIGIT POINTED TO BY (BX) TO BINARY
;               VALUE AND ADDS TO NUMBER ACCUMULATED. AT THE
;               APPROPRIATE TIMES CONVERSION WILL TAKE
;               PLACE TO THE NEXT HIERARCHY OF NUMBERS,I.E.
;               INTEGER-SINGLE PRECISION-DOUBLE PRECISION.
;       CALLING SEQUENCE:       CALL    $FIDIG
;               WITH (BX) POINTING TO NUMBER IN THE
;               TEXT BUFFER. NUMBER IS ACCUMULATED IN THE FAC.
;
;****************************************************************

;******************************************************************
;AS $FIDIG IS ENTERED CF=1 AND (DI) WILL HOLD PLACES TO THE RIGHT OF
;DECIMAL POINT (IF DECIMAL POINT HAS OCCURRED).(CX) WILL BE EITHER
;ALL BITS SET OR ALL BITS CLEARED. ALL BITS SET INDICATES A DECIMAL
;POINT HAS NOT BEEN SEEN YET AND (CX)=0 INDICATES D. P. SEEN
;******************************************************************
$FIDIG: ADC	DI,CX		;(DI) INCREMENTED ONLY IF D.P. SEEN
	PUSH	BX		;MUST NOW SAVE ALL NECESSARY REGS.
	PUSH	DI
	PUSH	CX
	SUB	AL,LOW "0"      ;SUBTRACT OUT ASCII BIAS
	PUSH	AX		;SAVE ON STACK
	CALL	$GETYP		;SET CONDITION CODES
	POP	AX		;RECALL DIGIT
	CBW			;ZERO AH
	JNS	FI05		;MUST BE S.P. OR D.P. ALREADY
	MOV	BX,WORD PTR $FACLO	;FETCH THE INTEGER ALREADY ACCUM.
	CMP	BX,3277D	;IS IT ALREADY TOO BIG TO ADD
				;ANOTHER DIGIT TO?
	JNB	FFI10		;IF SO GO MAKE S.P. FIRST
	MOV	CX,BX		;SAVE ORIGINAL (BX)
	SHL	BX,1		;(BX)=(BX)*2
	SHL	BX,1		;(BX)=(BX)*4
	ADD	BX,CX		;(BX)=(BX)*5
	SHL	BX,1		;(BX)=(BX)*10
	ADD	BX,AX		;ADD IN THE DIGIT
	JS	FFI10		;IF SF=1 WE HAVE 32768 OR 32769
	MOV	WORD PTR $FACLO,BX	;STORE IN $FAC
	JMP	SHORT FI50
FI05:				;TO GET HERE NUMBER WAS ALREADY S.P. OR D.P.
	PUSH	AX		;SAVE THE NUMBER
	JB	FFFI20		;IT'S CURRENTLY SINGLE PRECISION
	JMP	SHORT FI40	;DOUBLE PRECISION
FFI10:				;TO GET HERE NUMBER WAS PREVIOUSLY AN INTEGER BUT HAS
				;GROWN TOO LARGE - MUST MAKE IT SINGLE PRECISION
	PUSH	AX		;SAVE THE NUMBER
	CALL	$CSI		;CONVERT INTEGER TO S.P.
	JMP	SHORT FI30	;MUL BY 10 AND ADD IN DIGIT
FFFI20:			;TO GET HERE NUMBER WAS ALREADY SINGLE PRECISION
				;MUST CHECK TO SEE IF ACCURACY MIGHT BE LOST IF WE
				;MULTIPLY OUR FAC BY 10,I.E. FAC MUST BE SMALLER
				;THAN 1000000.
	MOV	WORD PTR $DBUFF+4,22000
	MOV	WORD PTR $DBUFF+6,112164
	MOV	BX,OFFSET $DBUFF+6
	CALL	$COMPM		;COMPARE TO $FAC
	JNS	FI35		;GO DO D.P. IF TOO LARGE FOR S.P.
FI30:	CALL	$MUL10		;MULTIPLY $FAC BY 10
	POP	DX		;RECALL DIGIT
	PUSH	WORD PTR $FACLO
	PUSH	WORD PTR $FAC-1 ;FAC PUSHED ON STACK
	CALL	$FLT		;CONVERT INTEGER TO S.P.
	POP	BX		;RECALL FAC
	POP	DX
	CALL	$FADDS		;ADD IN THE NEW DIGIT
	JMP	SHORT FI50	;GET STACK RIGHT AND RETURN
FI35:				;TO GET HERE WE ALREADY HAVE 7 DIGITS AND WOULD
				;HAVE A LOSS OF ACCURACY IF WE CONTINUED IN S.P. SO WE
				;NEED TO CONVERT TO D.P. MULTIPLY BY 10 AND ADD IN THE DIG.
	CALL	$CDS		;CONVERT THE SINGLE TO D.P.
FI40:	CALL	$MUL10		;MULTIPLY BY 10
	CALL	$MOVAF		;MOVE $FAC TO $ARG
	POP	DX		;RECALL DIGIT
	CALL	$FLT		;CONVERT TO S.P.
	CALL	$CDS		;CONVERT TO D.P.
	CALL	$FADDD		;ADD IN THE OLD ACCUMULATED VALUE
FI50:	POP	CX		;GET DECIMAL POINT FLAG BACK
	POP	DI		;GET NO. DIGITS TO RIGHT OF DECIMAL PT.
	POP	BX		;GET TEXT POINTER BACK
	RET			;COMPLETE

	SUBTTL	 $FINEX  EXPONENT INPUT ROUTINE
;*************************************************************
;
;       $FINEX  THE PURPOSE OF THIS ROUTINE IS TO DETERMINE
;               THE INPUT EXPONENT BASE 10 AND LEAVE IN (DX).
;               ADDITIONALLY IF A MINUS "-" SIGN IS ENCOUNTERED
;               $FINEX WILL SET ALL BITS OF (SI). OTHERWISE ALL
;               BITS OF (SI) WILL BE CLEARED.
;       CALLING SEQUENCE:       CALL    $FINEX
;               WITH THE SIGNIFICANT DIGITS OF THE NUMBER IN
;               THE FAC.
;
;***************************************************************

$FINEX: LAHF			;SAVE STATUS
	CMP	BYTE PTR $VALTP,LOW 10	;SEE IF ALREADY D.P.
	JNZ	EXA
	SAHF			;GET STACK RIGHT
	JMP	EXB
EXA:	SAHF			;RESTORE CODES
	PUSH	BX		;SAVE IMPORTANT REGISTERS
	PUSH	DI		;PRECISION ACCORDING TO ZF. IF
	CALL	$FINFC		;ZF=1 S.P.:ZF=0 THEN D.P.
	POP	DI		;RECALL DIGITS TO RIGHT OF D.P.
	POP	BX		;RECALL TEXT POINTER
EXB:	XOR	SI,SI		;IN CASE EXPONENT IS POSITIVE
	MOV	DX,SI		;WILL BUILD EXPONENT IN DX
	CALL	$CHRGT		;GET FIRST CHARACTER OF EXPONENT
	JB	FX20		;NO SIGN SO DEFAULT POS.
	CMP	AL,LOW "-"      ;NEGATIVE EXPONENT
	JNZ	FX00		;IF NOT MUST BE POSITIVE
	NOT	SI		;NEGATIVE EXPONENT
	JMP	SHORT FX10	;GO GET NEXT CHARACTER
FX00:	CMP	AL,LOW "+"
	JZ	FX10
				;ILLEGAL CHARACTER MUST LEAVE
	RET			;(BX) POINTING HERE
FX10:	CALL	$CHRGT		;GET NEXT CHARACTER
	JB	FX20		;IF DIGIT PROCESS AS EXPONENT
	RET			;OTHERWISE RETURN
FX20:	CMP	DX,3276D	;OVERFLOW IF THIS DOESN'T GET CF=1
	JB	FX30		;NO-USE THIS DIGIT
	MOV	DX,32767D	;TO ASSURE OVERFLOW
	JMP	SHORT FX10
FX30:	PUSH	AX		;SAVE NEW DIGIT
	MOV	AX,10D		;MUST MULTIPLY DX BY 10
	MUL	DX		;ANSWER NOW IN AX
	POP	DX		;RECALL DIGIT TO DX
	SUB	DL,LOW 60	;SUBTRACT OUT ASCII BIAS
	XOR	DH,DH		;TO BE SURE AX HAS CORRECT NO.
	ADD	DX,AX		;ADD TO DX
	JMP	SHORT FX10

	SUBTTL	 FINFC	 INPUT FORCE ROUTINES FOR "#","%","!"
;*********************************************************
;
;       FINFC   THIS MODULE CONTAINS THE ROUTINES $FINI,
;               $FIND, AND $FINS FOR FORCING THE INPUT TO
;               INTEGER, DOUBLE PRECISION OR SINGLE PRECISION
;               RESPECTIVELY IN RESPONSE TO AN INPUT "$","#", OR
;               "!". ADDITIONALLY THIS MODULE CONTAINS
;               THE UTILITY ROUTINES $FI,$FS,$FD,$CSI,$CSD,$CDS
;               FOR FORCING INTEGER,SINGLE,DOUBLE,CONVERTING
;               INTEGER TO SINGLE,CONVERTING DOUBLE TO SINGLE, AND
;               CONVERTING SINGLE TO DOUBLE, RESPECTIVELY
;       CALLING SEQUENCE:       CALL    $FINI
;               OR              CALL    $FIND
;               OR              CALL    $FINS
;               OR              CALL    $FS
;               OR              CALL    $FD
;               OR              CALL    $FI
;               OR              CALL    $CSI
;               OR              CALL    $CSD
;               OR              CALL    $CDS
;               WITH THE FAC CONTAINING THE CURRENT ACCUMULATED
;               NUMBER.
;
;***********************************************************

$FIND:				;FORCE INPUT TO DOUBLE PRECISION
	OR	AL,LOW 1	;TO SIGNAL DOUBLE PRECISION
$FINS:				;FORCE INPUT TO SINGLE PRECISION (caller has set Z flag)
	PUSH	BX		;SAVE TEXT POINTER
	PUSH	DI		;SAVE NO DIGITS AFTER DECIMAL POINT
	JNZ	FC10		;Force to double for $FIND callers.
	CALL	$FS		;Force to single for $FINS callers.
	JMP	SHORT FC20	;Skip over $FD call.

FC10:	CALL	$FD		;FORCE FAC TO DOUBLE PREC.
FC20:	POP	DI		;RECALL NO DIGITS TO RT. OF DEC PT
	POP	BX		;RECALL TEXT POINTER
	XOR	SI,SI		;SINCE THIS IS A FORCED
	MOV	DX,SI		;NO. EXPONENT IS ZERO
	CALL	$FINE		;DO IMPLIED EXPONENT FIX-UP
FC30:	INC	BX		;Point past the force character and
	RET			;return.

$FINI:	CALL	$GETYP		;SET COND CODES ACCORDING TO TYPE
	JS	FC30
	JMP	$SNERR		;CAN'T MAKE INTEGER IF NOT ALREADY
$FINFC: JZ	$FD		;IF ZF=1 THEN DOUBLE PRECISION
FRCSNG:
$FS:				;FORCE SINGLE PRECISION
	CALL	$GETYP		;SET COND CODES ACC. TO TYPE
	JPO	FC200		;IF ALREADY S.P. RETURN
	JNZ	FS10
	JMP	$TMERR		;CAN'T FORCE A STRING
FS10:
	JNS	$CSD		;IF NOT INTEGER FORCE DOUBLE TO S.P.
	CALL	$CSI		;FORCE INTEGER TO SINGLE
	JMP	SHORT FC200
$CSD:				;CONVERT DOUBLE TO SINGLE PRECISION
	MOV	AL,LOW 4	;SINGLE PREC DESIGNATION
	MOV	BYTE PTR $VALTP,AL
	MOV	BL,BYTE PTR $FAC-1	;FETCH HIGH MANTISSA BITS
	MOV	BYTE PTR $FAC+1,BL	;MOVE SIGN TO $FAC+1
	MOV	DX,WORD PTR $FAC-3	;FETCH REST OF MANTISSA
	MOV	AH,BYTE PTR $FAC-4	;FETCH OVERFLOW BITS
	OR	AH,LOW 100	;WANT ROUND-UP IF HIGH BIT SET
	OR	BL,LOW 200	;PUT IN UNDERSTOOD 1
	JMP	$ROUNM		;GO ROUND THE NUMBER
FRCDBL:
$FD:				;FORCE TO DOUBLE PRECISION
	CALL	$GETYP		;DETERMINE CURRENT TYPE
	JNB	FC200		;IF ALREADY DOUBLE EXIT
	JNZ	FD10

	JMP	$TMERR
FD10:
	JNS	$CDS		;IF NOT INTEGER PROCEED
	CALL	$CSI		;CONVERT INTEGER TO SINGLE PREC.
$CDS:	MOV	AL,LOW 10	;DOUBLE PREC. INDICATOR
	MOV	BYTE PTR $VALTP,AL	;SET TYPE TO D.P.
	XOR	AX,AX		;MUST ZERO OVERFLOW BYTES
	MOV	WORD PTR $DFACL,AX
	MOV	WORD PTR $DFACL+2,AX
	RET
$CSI:	PUSH	DX		;SAVE (DX)
	PUSH	SI		;SAVE (SI)
	MOV	DX,WORD PTR $FACLO	;FETCH THE INTEGER
	CALL	$FLT		;FLOAT THE INTEGER AND STORE IN FAC
	POP	SI		;GET REGISTERS RIGHT
	POP	DX
FC200:	RET
FRCINT:
$FI:				;FORCE INTEGER
	CALL	$GETYP		;SEE WHAT WE'RE IN FOR
	JNS	FI10		;IF NOT INTEGER ALREADY - JUMP
	MOV	BX,WORD PTR $FACLO
	RET
FI10:
	JNZ	FFI20
	JMP	$TMERR		;IF STRING - ERROR
FFI20:
$CINC:				;Single precision, operand in FAC
$CIND:				;Double precision uses same routine
	PUSH	AX
	PUSH	CX
	MOV	AX,WORD PTR $FACM1	;Get exponent
	MOV	CX,WORD PTR $FACLO	;Get mantissa
CINT:
	XOR	BX,BX		;Set up zero result
	SUB	AH,LOW 200O	;Take bias out of exponent
	JB	CXRET		;Return zero if no integer part
	MOV	BH,AL		;Highest byte of mantissa
	MOV	BL,CH
	XCHG	AX,CX
	MOV	CL,LOW 16D
	SUB	CL,CH		;Number of bits to shift mantissa right
	MOV	AH,BH		;Save sign
	JB	OVERFLOW	;If negative shift, it won't fit in 16 bits
	JZ	OVCHK		;Only -32768 has 16 bits - go check for it
	OR	BH,LOW 200O	;Set implied bit
	SHR	BX,CL		;Position the integer
	ADC	BX,0		;Perform rounding
	JO	POSBOVER
	OR	AH,AH		;Check sign now
	JNS	CXRET
	NEG	BX
CXRET:
	POP	CX
	POP	AX
	MOV	WORD PTR $FACLO,BX	;Result in both FAC and BX

VALINT:
$VALNT: MOV	BYTE PTR $VALTP,LOW 2
	RET
POSBOVER:			;Here for either -32768 or overflow
	OR	AH,AH		;If signed then -32768
	JS	CXRET
	JMP	SHORT OVERFLOW
OVCHK:
;Come here if no shift is needed on the number, i.e., it requires a full
;16 bits. Only -32768 (8000H) is allowed.
	CMP	BX,100000O	;The 1 is sign bit (negative), not implied bit
	JNZ	OVERFLOW
	TEST	AL,LOW 200O	;Should we be rounding up?
	JZ	CXRET		;If so, that causes overflow
OVERFLOW:
	JMP	$OVERR

	SUBTTL	 $FLT	 CONVERT INTEGER IN (DX) TO REAL AND STORE IN FAC
;****************************************************************
;       $FLT    CONVERTS THE SIGNED INTEGER IN (DX) TO A REAL
;               (FLOATING POINT ) NUMBER AND STORES IT IN THE FAC
;               AND SETS $VALTP=4
;*****************************************************************
$FLT:	XOR	BX,BX		;CLEAR HIGH MANTISSA BYTE (BL)
	XOR	AH,AH		;CLEAR OVERFLOW BYTE
	MOV	SI,OFFSET $FAC+1	;FETCH $FAC ADDRESS TO (SI)
	MOV	BYTE PTR [SI-1],LOW 220 ;SET EXPONENT TO 16
	MOV	BYTE PTR [SI-0],LOW 0	;SET SIGN POSITIVE
	OR	DX,DX		;SETS SF=1 IF NEGATIVE NO.
	JNS	FLT10		;IF POSITIVE PROCEED
	NEG	DX		;NEED POSTIVE MAGNITUDE
	MOV	BYTE PTR 0[SI],LOW 200	;SET SIGN TO NEGATIVE
FLT10:	MOV	BL,DH		;WILL MOVE (DX) TO (BLDH)
	MOV	DH,DL		;
	MOV	DL,BH		;SET (DL)=0
	MOV	BYTE PTR $VALTP,LOW 4	;SET TYPE TO S.P.
	JMP	$NORMS		;GO NORMALIZE

	SUBTTL	 $FMULD  DOUBLE PRECISION MULTIPLICATION
;**************************************************************
;
;       $FMULD  THIS ROUTINE FORMS THE DOUBLE PRECISION PRODUCT
;               ($FAC):=($FAC)*($ARG)
;               THE TECHNIQUE USED IS DESCRIBED IN KNUTH, VOL II
;               P.233 AND IS CALLED ALGORITHM "M"
;       CALLING SEQUENCE:       CALL    $FMULD
;               WITH THE MULTIPLIER AND MULTIPLICAND IN THE
;               $FAC AND $ARG
;
;**************************************************************

DMULT:
$FMULD:			;DOUBLE PRECISION MULT., (FAC)=(FAC)*(ARG)
	MOV	AL,BYTE PTR $FAC	;WILL FIRST SEE IF FAC IS ZERO
	OR	AL,AL		;AND IF SO JUST RETURN
	JZ	FMD10
	MOV	AL,BYTE PTR $ARG	;WILL NOW SEE IF ARG IS ZERO AND
	OR	AL,AL		;IF SO SET FAC TO ZERO AND RETURN
	JNZ	FMD20		;IF NOT ZERO PROCEED TO MULTIPLY
	JMP	$DZERO		;ZERO THE FAC
FMD10:	RET
FMD20:
	MOV	BX,WORD PTR $ARG-1	;FETCH SIGN AND EXP. TO BX
	CALL	$AEXPS		;ADD THE EXPONENTS
	PUSH	WORD PTR $FAC	;EXPONENT,SIGN
	MOV	WORD PTR $ARG-1,BX	;REPLACE UNPACKED MANTISSA
				;PUT THE SIGN OF THE PRODUCT IN
				;FAC+1
	CALL	$SETDB		;MOVE THE FAC TO $DBUFF SO PRODUCT
				;CAN BE FORMED IN THE FAC, AND ZERO
				;THE FAC AND RETURNS WITH (AX)=0
	MOV	SI,AX		;J
	MOV	WORD PTR $FAC,AX
	MOV	BX,OFFSET $DBUFF	;
	MOV	WORD PTR $ARG,AX
	MOV	BP,OFFSET $ARGLO	;POINT TO MULTIPLICAND BASE
M1:	MOV	AX,WORD PTR 0[BX+SI]	;FETCH MULTIPLIER V(J)
	OR	AX,AX		;SEE IF ZERO
	JZ	M4D		;IF ZERO W(J)=0
	MOV	DI,0		;I
	MOV	CX,DI		;K
M4:	MOV	AX,WORD PTR 0[BX+SI]	;FETCH MULTIPLIER V(J)
	MUL	WORD PTR 0[BP+DI]	;FORM PRODUCT V(J)*U(J) IN (DXAX)
	PUSH	BX		;SAVE PTR. TO MULTIPLIER BASE
	MOV	BX,SI		;
	ADD	BX,DI		;I+J
	ADD	BX,OFFSET $DFACL-10	;W(I+J) ADDRESS IN BX
	ADD	AX,WORD PTR 0[BX]	;(DXAX)=U(I)*V(J)+W(I+J)
	JNB	M4A
	INC	DX
M4A:	ADD	AX,CX		;T=U(I)*V(J)+W(I+J)+K
	JNB	M4B
	INC	DX
M4B:	MOV	WORD PTR 0[BX],AX	;W(I+J)= T MOD 2^16
	MOV	CX,DX		;K=INT(T/2^16)
	POP	BX		;RECALL PTR TO MULTIPLIER BASE
	CMP	DI,6		;FINISHED INNER LOOP?
	JZ	M4C		;IF SO JUMP AND SET W(J)
	INC	DI
	INC	DI
	JMP	SHORT M4
M4C:	MOV	AX,CX		;(AX)=K
M4D:	PUSH	BX		;SAVE PTR TO MULTIPLIER BASE
	MOV	BX,OFFSET $DFACL
	MOV	WORD PTR 0[BX+SI],AX	;W(J)=K OR 0 (0 IF V(J) WERE 0)
	POP	BX		;RECALL PTR TO MULTIPLIER BASE
	CMP	SI,6		;FINISHED OUTER LOOP?
	JZ	M5
	INC	SI
	INC	SI
	JMP	SHORT M1
M5:				;MULTIPLICATION COMPLETE AND IN FAC
	MOV	SI,OFFSET $DFACL-2	;WILL NOW SET ST
	STD			;WANT NON-ZERO BYTE ASAP SO PROB.
				;SEEMS HIGHER OF GETTING ONE IF
				;(SI) IS DECREMENTED
	MOV	CX,7		;7-BYTE CHECK
M5AA:	LODSB			;FETCH NEXT BYTE
	OR	AL,AL
	LOOPZ	M5AA
	JZ	M5AB		;DON'T NEED TO SET ST
	OR	BYTE PTR $DFACL-1,LOW 40	;"OR" IN ST BIT
M5AB:
	MOV	AL,BYTE PTR $FAC-1	;SEE IF WE NEED TO INC EXPONENT
	OR	AL,AL
	POP	WORD PTR $FAC	;RESTORE EXPONENT,SIGN
	JS	M6
	MOV	BX,OFFSET $DFACL-1	;MUST SHIFT 1 BIT LEFT
	MOV	CX,4
M5A:	RCL	WORD PTR 0[BX],1
	INC	BX
	INC	BX
	LOOP	M5A
M5B:	JMP	$ROUND		;NOW ROUND
M6:	INC	BYTE PTR $FAC	;INCREMENT EXPONENT
	JNZ	M5B
	JMP	$OVFLS		;OVERFLOW!

	SUBTTL	 $FMULS  SINGLE PRECISION 8086 MULTIPLICATION
;**********************************************************
;       $FMULS  FMULS MULTIPLIES THE SINGLE PRECISION
;               FLOATING POINT QUANTITIES (BXDX) AND (FAC)
;               AND RETURNS THE PRODUCT IN THE (FAC). ONLY
;               SEGMENT REGISTERS ARE PRESERVED.
;***********************************************************

$FMULS:			;(FAC)=(BXDX)*(FAC)
	CALL	$SIGNS		;ZF=1 WILL BE SET IF (FAC)=0
	JZ	FMS00		;JUST RETURN IF (FAC)=0
	OR	BH,BH		;IF EXPONENT OF (BXDX) IS ZERO
	JNZ	FMS05		;PROCEED IF NON-ZERO
FMS00:	JMP	$ZERO		;THE NUMBER IS ZERO.
FMS05:
	CALL	$AEXPS		;ADD THE S.P. EXPONENTS
;***************************************************************
;WILL NOW PROCEED TO MULTIPLY THE MANTISSAS. THE MULTIPLICATION
;WILL UTILIZE THE 16 BIT MUL INSTRUCTION AND THUS WILL TAKE
;PLACE AS PARTIAL PRODUCTS SINCE WE HAVE 24 BIT MANTISSAS TO
;MULTIPLY.
;***************************************************************
	MOV	CX,WORD PTR $FAC-1	;(CH)=($FAC):(CL)=($FAC-1)
	XOR	CH,CH		;(CX) CONTAINS HIGH MANTISSA BITS
	MOV	AX,WORD PTR $FAC-3	;(AX) CONTAINS LOW MANTISSA BITS OF FAC
	MOV	BH,CH		;SET (BH)=0 AS WELL
;*************************************************************
;AT THIS POINT WE HAVE THE FAC MANTISSA IN (CLAX) AND THE
;(BXDX) MANTISSA IN (BLDX). THE UNDERSTOOD LEADING MANTISSA
;BIT WAS INSTALLED BY $AEXPS AND THE SIGN OF THE PRODUCT
;WAS STORED IN FAC+1
;THE PRODUCT WILL BE FORMED IN (BXCX) BY PARTIAL PRODUCTS.
;FIRST THE NECESSARY ELEMENTS WILL BE PUSHED ON THE STACK
;THEN UTILIZED IN REVERSE ORDER(THAT'S THE BEST WAY TO
;GET THE THEM OFF THE LIFO STACK -TURKEY!)
;************************************************************
	MOV	SI,BX
	MOV	DI,CX
	MOV	BP,DX
	PUSH	CX		;HIGH FAC MANTISSA BITS
	PUSH	AX		;LOW FAC MANTISSA BITS
	MUL	DX		;32 BIT PRODUCT FORMED(ONLY NEED
	MOV	CX,DX		;MOST 16 SIGNIFICANT BITS)
	POP	AX		;LOW FAC MANTISSA BITS
	MUL	BX		;TIMES HIGH MANTISSA BITS OF (BLDX)
	ADD	CX,AX		;ADD TO PREVIOUS CALCULATION
	JNB	FMS10		;IF CARRY NOT PRODUCED PROCEED
	INC	DX
FMS10:	MOV	BX,DX		;PROBABLY ONLY 8 BITS HERE
	POP	DX		;HIGH FAC MANTISSA BITS
	MOV	AX,BP		;LOW 16 MANTISSA BITS OF (BLDX)
	MUL	DX		;
	ADD	CX,AX		;ADD IN LOW ORDER BITS
	JNB	FMS20		;JUMP IF CARRY NOT PRODUCED
	INC	DX		;
FMS20:	ADD	BX,DX		;CAN'T PRODUCE CARRY HERE
	MOV	DX,DI		;HIGH FAC MANTISSA BITS
	MOV	AX,SI		;HIGH FAC MANTISSA BITS
	MUL	DL		;(AX) HAS ENTIRE PRODUCT
	ADD	BX,AX		;ADD IT IN
	JNB	FMS30		;IF NO CARRY PROCEED
	RCR	BX,1		;MOVE EVERYTHING RIGHT
	RCR	CX,1		;
	INC	BYTE PTR $FAC	;MUST NOW CHECK FOR OVERFLOW
	JNZ	FMS30		;PROCEED IF NON-ZERO
	JMP	$OVFLS
FMS30:				;PRODUCT FORMED, MUST NOW GET MANTISSA IN (BLDXAH) FOR ROUNS
				;PRODUCT IS CURRENTLY IN (BXCX)
	OR	BH,BH		;MUST BE SURE PRODUCT LEFT JUSTIFIED
	JNS	FMS35		;IN (BXCX)
	INC	BYTE PTR $FAC	;NEED TO INCREMENT EXP.
	JNZ	FMS37		;IF NOT OVERFLOW PROCEED
	JMP	$OVFLS		;OVERFLOW JUMP
FMS35:
	RCL	CX,1
	RCL	BX,1
FMS37:
	MOV	DL,CH
	MOV	DH,BL
	MOV	BL,BH
	MOV	AH,CL		;OVERFLOW BYTE
	JMP	$ROUNS		;GO ROUND
	RET

	SUBTTL	 $FOTAN  ROUTINE TO PUT IN DECIMAL POINT AND LEADING ZEROS
;*****************************************************************
;
;       $FOTAN  THIS ROUTINE IS CALLED BY THE FREE FORMAT OUTPUT
;               CODE TO OUTPUT DECIMAL POINT AND LEADING ZEROS.
;       $FOTED  THIS ROUTINE IS CALLED BY BOTH THE FREE FORMAT
;               OUTPUT ROUTINE AND THE PRINT USING CODE TO OUTPUT
;               THE DECIMAL POINT WHEN NECESSARY AND TO PUT IN
;               COMMAS "," AFTER EACH THREE DIGITS IF THIS OPTION
;               IS INVOKED.
;       CALLING SEQUENCE:       CALL    $FOTAN
;                               CALL    $FOTED
;               WITH $FMTCX CONTAINING NUMBER PLACES PRIOR TO
;               DECIMAL POINT(NEGATIVELY) IN UPPER BYTE AND
;               NO PLACES BEFORE NEXT COMMA IN LOW BYTE
;
;*******************************************************************

$FOTAN:
	DEC	CH		;IF NEGATIVE THEN LEADING ZEROS
	JNS	FTD05		;
	MOV	WORD PTR $DPADR,BX	;SAVE DECIMAL POINT COUNT
	MOV	BYTE PTR 0[BX],LOW "."  ;MOVE IN DECIMAL POINT
FTN10:	INC	BX		;POINT TO NEXT OUTPUT POSITION
	MOV	BYTE PTR 0[BX],LOW "0"  ;PUT IN LEADING ZERO
	INC	CH		;WILL INCREMENT CH UNTIL ZERO
	JNZ	FTN10		;PUT IN LEADING ZEROS UNTIL CH ZERO
	INC	BX		;POINT TO NEXT BUFFER POSITION
	XOR	CX,CX		;ZERO OUT DECIMAL POINT AND COMMA CTS.
	JMP	SHORT FTD20	;GET STACK RIGHT AND RETURN
$FOTED:
	DEC	CH		;SEE IF TIME FOR D.P.
FTD05:	JNZ	FTD10		;IF NOT D.P. TIME SEE IF COMMA TIME
	MOV	BYTE PTR 0[BX],LOW "."  ;PUT IN D.P.
	MOV	WORD PTR $DPADR,BX	;SAVE ADDR OF DECIMAL POINT
	INC	BX		;INCREMENT PAST D.P.
	XOR	CX,CX		;ZERO COUNTS & SET ZF=1
	JMP	SHORT FTD20	;GET STACK RIGHT AND RETURN
FTD10:	DEC	CL		;IF ZERO TIME FOR COMMA
	JNZ	FTD20
	MOV	BYTE PTR 0[BX],LOW 54O	;COMMA
	INC	BX		;POINT TO NEXT BUFFER POSITION
	MOV	CL,LOW 3	;
FTD20:	MOV	WORD PTR $FMTCX,CX	;UPDATE D.P.&COMMA COUNTS
	RET

	SUBTTL	 $FOTCV  CONVERT FAC TO ASCII DIGITS
;************************************************************
;
;       $FOTCV  CONVERSION OF SINGLE OR DOUBLE PRECISION
;               NUMBER TO ASCII DIGITS.IF DOUBLE PRECISION
;               10 DIGITS WILL BE CONVERTED WITH DOUBLE
;               PRECISION POWER OF TEN INTEGERS, 3 DIGITS
;               WITH SINGLE PRECISION POWER OF TEN INTEGERS
;               AND 3 DIGITS WITH INTEGER POWERS OF TEN
;       CALLING SEQUENCE:       CALL    $FOTCV
;               WITH THE NUMBER TO BE CONVERTED HAVING PREVIOUSLY
;               BEEN OPERATED ON BY $FOTNV TO BRACKET THE
;               NUMBER AND HAVE ALL DIGITS IN THE INTEGER PORTION
;               OF THE FAC. AND THE CORRESPONDING EXPONENT WILL
;               BE SAVED ON THE STACK AND CONVERTED LATER.
;
;**************************************************************

$FOTCV: CALL	$GETYP		;SET CONDITION CODES FOR VALTYP
	JPO	FCV40		;IF SINGLE PRECISION GO PROCESS
	PUSH	CX		;SAVE DIGIT AND COMMA COUNT
	PUSH	BX		;SAVE BUFFR PTR.
	MOV	SI,OFFSET $DFACL	;WILL MOVE FAC TO ARG
	MOV	DI,OFFSET $ARGLO
	MOV	CX,4
	CLD
 REP	MOVSW
	CALL	$DINT		;WILL SEE IF FAC ALREADY INTEGER
	PUSH	BX		;NEED TO CALL VCOMP WITH BX=ARG-1
	MOV	BX,OFFSET $ARG-1
	CALL	$VCOMP		;DO COMPARE
	POP	BX		;GET BUFFER POINTER BACK
	MOV	SI,OFFSET $ARGLO	;WILL MOVIE ARG TO FAC
	MOV	DI,OFFSET $DFACL
	MOV	CX,4
	CLD
 REP	MOVSW
	JZ	FCV05		;DON'T ADD .5 IF NO DIFF.
	CALL	$DADDH		;ADD .5 TO NUMBER
FCV05:	MOV	CL,BYTE PTR $FAC	;SHIFT COUNT IN (CL)
	SUB	CL,LOW 270
	NEG	CL		;MAKE SHIFT COUNT POSITIVE
	CLC			;TO TELL DINT NOT TO NORMALIZE
	CALL	$FTDNT		;MAKE SURE ITS STILL INTEGER
	POP	BX		;RECALL BUFFER PTR.
	POP	CX		;RECALL DIGIT AND COMMA COUNT
	MOV	SI,OFFSET $FODTB	;DOUBLE PRECISION OUTPUT INTEGERS
	MOV	AL,LOW 9D	;9 DIGITS TO BE CONVERTED WITH D.P.
FCV10:	CALL	$FOTED		;SEE IF DECIMAL POINT NEEDED
	PUSH	AX		;SAVE DIGIT COUNT
	MOV	AL,LOW OFFSET "0"-1     ;WILL FORM DIGIT IN (AL)
	PUSH	AX
FCV20:	POP	AX		;RECALL DIGIT
	INC	AL		;INCREMENT TO NEXT DIGIT
	PUSH	AX		;SAVE DIGIT
	CALL	DSUBI		;SUBTRACT POWER OF TEN
	JNB	FCV20
	CALL	DADDI		;ADD POWER 10 BACK IN
				;AND ADVANCE SI TO NEXT POWER 10
	POP	AX		;GET DIGIT BACK
	MOV	BYTE PTR 0[BX],AL	;PUT IN ASCII DIGIT
	INC	BX		;POINT TO NEXT BUFFER POSITION
	POP	AX		;GET DIGIT COUNT
	DEC	AL		;SEE IF 10 DIGITS FORMED
	JNZ	FCV10		;IF NOT CONTINUE THE ALGORITHM
	PUSH	CX		;SAVE DECIMAL POINT COUNT
	MOV	SI,OFFSET $DFACL	;WILL MOVE INTO FAC
	MOV	DI,OFFSET $FACLO
	MOV	CX,2
	CLD
 REP	MOVSW
	POP	CX		;RECALL DECIMAL POINT COUNT
	JMP	SHORT FCV50	;GO DO THE REST OF THE DIGITS
FCV40:
;**************************************************************
;CODE BELOW WORKS WITH SINGLE PRECISION NUMBERS
;***************************************************************
	PUSH	BX		;SAVE BUFFER PTR
	PUSH	CX		;SAVE DIGIT AND COMMA COUNTS
	CALL	$PUSHF		;SAVE $FAC ON STACK
	CALL	$INT		;WILL SEE IF INTEGER CURRENTLY
	POP	DX		;RECALL FAC
	POP	BX
	CALL	$FCOMP		;COMPARE IF EQUAL DON'T ADD .5
	JZ	FCV45
	MOV	WORD PTR $FAC-1,BX	;MOVE BACK TO FAC
	MOV	WORD PTR $FACLO,DX
	CALL	$FADDH		;ADD .5 TO NUMBER
FCV45:	MOV	AL,LOW 1	;FLAG TO QINT WE HAVE A POS. NO.
	CALL	$QINT		;GET INTEGER INTO (BLDX)
	MOV	WORD PTR $FAC-1,BX
	MOV	WORD PTR $FACLO,DX	;MOVE TO FAC
	POP	CX		;RECALL DIGIT AND COMMA COUNTS
	POP	BX		;RECALL BUFFER PTR


FCV50:
	MOV	AL,LOW 3	;WILL CONVERT 3 DIGITS IN THIS CODE
	MOV	DX,OFFSET $FOSTB	;Print S.P. numbers with 7 digits
FCV60:	CALL	$FOTED		;SEE IF NEED A DECIMAL POINT OR COMMA
	PUSH	AX		;SAVE DIGIT COUNT
	PUSH	BX		;SAVE BUFFER POINTER
	PUSH	DX		;SAVE POWER OF TEN POINTER
	CALL	$MOVRF		;FETCH INTEGER
	POP	BP		;FETCH POWER TEN POINTER
	MOV	AL,LOW OFFSET "0"-1     ;WILL BUILD DIGIT IN (AL)
	PUSH	AX		;SAVE DIGIT
FCV70:	POP	AX		;RECALL DIGIT
	INC	AL		;GO TO NEXT DIGIT
	PUSH	AX
	CALL	$RSUBM		;SUBTRACT NO. POINTED TO BY (BP)
				;FROM (BLDX)
	JNB	FCV70		;CONTINUE UNTIL CF=1
				;POWER TEN TABLE IN CODE SEGMENT
	ADD	DX,WORD PTR CS:0[BP]	;ADD WORD PORTION
	ADC	BL,BYTE PTR CS:2[BP]
				;SINCE WE SUBTRACTED ONE TOO MANY
	INC	BP		;INCREMENT TO NEXT POWER OF TEN
	INC	BP
	INC	BP
	CALL	$MOVFR		;SAVE (BLDX) IN FAC
	POP	AX		;RECALL DIGIT
	XCHG	DX,BP		;SAVE POWER TEN PTR. IN DX
	POP	BX		;RECALL BUFFER POINTER
	MOV	BYTE PTR 0[BX],AL	;SEND OUT DIGIT
	INC	BX		;INCREMENT TO NEXT BUFFER POSITION
	POP	AX		;RECALL DIGIT COUNT
	DEC	AL		;SEE IF FINISHED
	JNZ	FCV60		;IF NOT CONTINUE
	INC	DX		;NEED TO INCREMENT PAST 1ST
	INC	DX		;INTEGER SO THAT FOTCI WILL
	MOV	BP,DX		;FOTCI IS EXPECTING POINTER IN BP
	MOV	AH,LOW 4	;CONVERT ONLY 4 DIGITS
	JMP	$FCI4
				;INTEGER ARITHMETIC
DSUBI:				;SUBTRACT 7 BYTE INTEGER POINTED TO BY (SI) FROM $DFACL
	PUSH	CX		;FIRST SAVE CX,SI,DI
	PUSH	SI
	MOV	CX,7		;7 BYTES
	MOV	DI,OFFSET $DFACL
	CLC			;CF=0
	CLD			;SO LODC WILL INCREMENT
DSUBI1:			;NEED NO. FROM CODE SEGMENT
	LODS	BYTE PTR ?CSLAB ;FETCH BYTE TO AL
	SBB	BYTE PTR 0[DI],AL	;SUBTRACT
	INC	DI
	LOOP	DSUBI1
	POP	SI
	POP	CX
	RET
DADDI:				;ADD 7 BYTE INTEGER POINTED TO BY (SI) FROM $DFACL
	PUSH	CX		;SAVE CX,SI,DI
	MOV	CX,7
	MOV	DI,OFFSET $DFACL
	CLC
	CLD			;SO LODC WILL INCREMENT SI
DADDI1:			;WANT NO. FETCHED FROM CODE SEGMENT
	LODS	BYTE PTR ?CSLAB ;FETCH NEXT BYTE TO ADD
	ADC	BYTE PTR 0[DI],AL	;ADD IT IN
	INC	DI
	LOOP	DADDI1
	POP	CX
	RET

	SUBTTL	 $FOTNV  BRACKET FAC SO PRINTABLE DIGITS IN INTEGER PART
;****************************************************************
;
;       $FOTNV  THIS ROUTINE MULTIPLIES THE FAC BY APPROPRIATE
;               VALUES SO THAT THE PRINTABLE DIGITS (7 FOR SINGLE
;               PRECISION, 16 FOR DOUBLE PRECISION) ARE IN THE
;               INTEGER PART OF THE FAC . IT RETURNS THE COMPLEMENT-
;               ING EXPONENT IN (AL).
;       CALLING SEQUENCE:       CALL    $FOTNV
;               WITH THE FAC CONTAINING THE DESIRED VALUE TO PRINT
;               REGISTERS (BX) AND (CX) WILL RETAIN THEIR VALUES
;
;*****************************************************************

$FOTNV:
	PUSH	BX		;WON'T ALTER (BX) OR (CX)
	PUSH	CX
	XOR	DI,DI		;INITIALIZE EXPONENT
	PUSH	DI		;SAVE EXPONENT
FNV10:	MOV	BX,OFFSET $FOTB ;ADDRESS OF BRACKET CONTROL TABLE
	MOV	AL,BYTE PTR $FAC	;FETCH THE EXPONENT
				;MUST FETCH FROM CODE SEGMENT
	XLAT	BYTE PTR ?CSLAB ;GET MULTIPLIER
	OR	AL,AL		;IF ZERO - DONE
	JZ	FNV20
	POP	DI		;RECALL EXPONENT
	CBW			;CONVERT AL TO WORD
	SUB	DI,AX		;GET EXPONENT CORRECT
	PUSH	DI		;SAVE EXPONENT
	MOV	DX,AX		;DX:=exponent for MDPTEN.
	CALL	MDPTEN		;Multiply or divide by power of ten.
	JMP	SHORT FNV10	;See if need to do it again.

FNV20:	MOV	BX,OFFSET $DP06+4	;LOWER BOUND
	CALL	$MOVBS		;MOVE OUT TO "DS" AREA
	CALL	$COMPM		;ONE MORE MULT. POSSIBLE
				;$COMPM WILL SET CF=1 IF $DP06
				;IS LARGER, CF=0 FOR EQ OR GT
	JNB	FNV30		;JUMP IF NOT NEEDED
	CALL	$MUL10		;MULTIPLY BY TEN
	POP	DI		;RECALL EXPONENT
	DEC	DI		;ACCOUNT FOR MULTIPLY BY 10.
	PUSH	DI
FNV30:	CALL	$GETYP		;SET CONDITION CODES FOR TYPE


	JB	FNV40		;done if single precision

	MOV	BX,OFFSET $DP09 ;MUST MULTIPLY BY 10^9
	CALL	$MOVAC		;MOVE 10^9 TO $ARG
	CALL	$FMULD		;PERFORM MULTIPLICATION
	POP	AX		;RECALL EXPONENT
	SUB	AL,LOW 11	;SUBTRACT 9
	PUSH	AX		;Resave the exponent.
	MOV	BX,OFFSET HIDBL ;Is the number too big?  (Will it
	CALL	$MOVBF		;overflow when $FOTCV adds .5 to it?)
	CALL	$DCMPM
	JNA	FNV40		;No.
FNV44:	CALL	$DIV10		;Yes, divide by ten and fix up the
				;the decimal exponent.
	POP	AX		;restore the exponent
	INC	AL		;adjust for $DIV10
	PUSH	AX
FNV40:	POP	AX		;recall exponent
FNV50:	POP	CX		;restore registers
	POP	BX
	OR	AL,AL		;SET CONDITION CODES ACCORDING TO EXP
	RET

;
; The largest double precision value that .5 can be added to without
; overflow occuring.
;

HIDBL	DW	375,377,3,277,311,33,16,266	;9999999999999999.



	SUBTTL	 $FOUT	 CONTROL OUTPUT CONVERSION
;***************************************************************
;
;       $FOUT   THIS ROUTINE PROVIDES TOP-LEVEL CONTROL OF THE
;               FREE FORMAT OUTPUT FUNCTION.
;       CALLING SEQUENCE:       CALL    $FOUT
;
;****************************************************************

S:	MOV	BX,OFFSET $FBUFF+1	;FETCH BUFFER POINTER
	MOV	BYTE PTR 0[BX],LOW " "  ;MOVE IN SPACE FOR POSSIBLE SIGN
	PUSH	BX		;SAVE BUFFER POINTER
	CALL	$SIGNS		;DETERMINE SIGN OF NUMBER
	POP	BX		;RECALL BUFFER POINTER
	PUSHF			;SAVE FLAGS FOR LATER
	JNS	FO20		;JUMP IF POSITIVE
	MOV	BYTE PTR 0[BX],LOW "-"  ;PUT IN MINUS SGN
	PUSH	BX		;SAVE TEXT POINTER
	CALL	$VNEG		;NEGATE NO. SO WE WORK ONLY WITH
	POP	BX		;RECALL TEXT POINTER
	OR	AL,LOW 1	;POS. NOS. AND SET ZF=0
FO20:	INC	BX		;POINT TO NEXT BUFFER POSITION
	MOV	BYTE PTR 0[BX],LOW "0"  ;PUT IN ZERO IN CASE NO IS ZERO
	POPF			;RECALL FLAGS
	RET
FOUT:
$FOUT:				;FREE-FORMAT ENTRY POINT
	CALL	S		;DO SIGN FIX-UP
	JNZ	$FOUT2		;IF NON-ZERO PROCEED
	INC	BX		;POINT TO NEXT OUTPUT BUFFER POS.
	MOV	BYTE PTR 0[BX],LOW 0	;INDICATE END OF NUMBER
	MOV	BX,OFFSET $FBUFF+1	;POINT (BX) TO START POSITION
	RET
$FOUT2: CALL	$GETYP		;GET TYPE NO.
	JNS	FO50		;GO FORMAT SINGLE OR DOUBLE PREC.
	MOV	CX,OFFSET 7*400 ;default 7 digits prior to dp.
	XOR	AX,AX		;CLEAR COMMA COUNT
	MOV	WORD PTR $FMTAX,AX
	MOV	WORD PTR $FMTCX,CX
	CALL	$FOTCI		;CONVERT INTEGER TO ASCII
	JMP	$FOTZS		;DO LEADING ZERO SUPPRESSION
FO50:	JMP	$FOFMT		;SINGLE OR DOUBLE PREC. OUTPUT

	SUBTTL	 $INT	 CONVERT PRESENT NO. TO INTEGER BY TRUNCATION
;***********************************************************
;
;       $INT    SINGLE PRECISION INT ROUTINE
;       $DINT   DOUBLE PRECISION INT ROUTINE
;       $QINT   CONVERT TO INT AND LEAVE IN (BLDX)
;       $FTDNT  FOUT ENTRY TO CONVERT TO INT AND LEAVE RT.ADJUSTED
;       $SHRD   SHIFT DOUBLE PRECISION MANTISSA RIGHT
;
;**********************************************************
;**********************************************************
;THE INT TECHNIQUE IS PRETTY STRAIGHT FORWARD EXCEPT
;FOR NEGATIVE NON-INTEGERS. THE RUB WITH THESE NOS. IS THAT
;IF THEY HAVE ANY FRACTIONAL BITS THE ANSWER IS TO
;BE THE NEXT LOWER VALUE INTEGER. FOR EXAMPLE : INT(-1.1) SHOULD
;RETURN -2 WHEREAS INT(1.1) SHOULD RETURN 1. THE TRICK USED TO
;EFFECT THIS IS TO SUBTRACT 1 FROM NEGATIVE NON-INTEGER MANTISSAS
;PRIOR TO SHIFTING OUT FRACTIONAL BITS THEN ADD 1 BACK TO THE
;MANTISSA ONCE FRACTIONAL BITS HAVE BEEN SHIFTED OUT. WITH THE
;FOLLOWING EXAMPLE (IN BINARY) WATCH HOW THIS TECHNIQUE WORKS:
;FIND INT(10011.011)
;       (1)     SINCE THIS IS A POSITIVE NO WE JUST SHIFT OUT
;               THE FRACTIONAL BITS AND NORMALIZE
;FIND INT(-10011.011)
;       (1)     SUBTRACT ONE FROM THE MANTISSA YIELDING -10011.010
;       (2)     SHIFT OUT THE FRACTIONAL BITS YIELDING -10011.
;       (3)     ADD 1 TO MANTISSA YIELDING -10100 THE CORRECT VALUE
;FIND INT(-10011.000)
;       (1)     SUBTRACT ONE FROM MANTISSA YIELDING -10010.111
;       (2)     SHIFT OUT THE FRACTIONAL BITS YIELDING -10010.
;       (3)     ADD 1 TO MANTISSA YIELDING -10011. THE CORRECT VALUE
;******************************************************************
$DINT:				;DOUBLE PRECISION INT FUNCTION
	MOV	CL,BYTE PTR $FAC	;CL:=exponent.
	SUB	CL,LOW 270	;Is there a fractional part?
	JNB	DNT20		;RETURN IF NO FRACTIONAL BITS
	NEG	CL		;CL NOW POSITIVE
$FTDNT: PUSHF			;FOUT ENTRY POINT. THIS IS SEPARATE
				;ENTRY POINT BECAUSE FOUT WISHES
				;TO HAVE INTEGER RIGHT ADJUSTED
				;IN THE MANTISSA BITS. WE WILL DO
				;THE NECESSARY SHIFTS AND RETURN
				;PRIOR TO NORMALIZATION IF CALLED
				;BY FOUT (SIGNIFIED BY CF=0)
	TEST	BYTE PTR $FAC,LOW 377O	;Is the exponent zero?
	JNE	DINTNZ		;No, proceed.
	POPF			;Yes, if the exponent is zero the
	RET			;number is zero.  Don't operate on
				;the possible garbage in the mantissa.
DINTNZ: MOV	BX,OFFSET $FAC-2
	MOV	AL,BYTE PTR 1[BX]	;FETCH SIGN BYTE
	MOV	BYTE PTR 3[BX],AL	;AND PUT IN $FAC+1  FOR $NORMD
	OR	AL,AL		;SEE IF NEGATIVE
	PUSHF
	OR	AL,LOW 200	;RESTORE HIDDEN 1
	MOV	BYTE PTR 1[BX],AL	;AND REPLACE
	MOV	BYTE PTR 2[BX],LOW 270	;SET EXPONENT FOR POST SHIFT VALUE
	POPF			;RECALL SF
	PUSHF
	JNS	DNT10		;IF POSITIVE PROCEED
;*****************************************************************
;NEGATIVE NO. MUST DO THE FANCY FOOTWORK DESCRIBED ABOVE
;*****************************************************************
	CALL	DINTA		;SUBTRACT 1 FROM MANTISSA BITS
DNT10:	XOR	CH,CH		;(CX)=SHIFT COUNT
	CALL	$SHRD		;DOUBLE PRECISION SHIFT RIGHT
	POPF			;RECALL SF
	JNS	DNT15		;IF POSITIVE PROCEED
	CALL	ADD1D		;ADD 1 TO MANTISSA BITS
DNT15:	MOV	BYTE PTR $DFACL-1,LOW 0 ;ZERO THE OVERFLOW BYTE
	POPF			;SEE IF CALLED BY FOUT (CF=0)
	JNB	DNT20		;IF SO JUST RETURN
	JMP	$NORMD		;OTHERWISE NORMALIZE
DNT20:	RET

$SHRD:				;SHIFT RIGHT DOUBLE PRECISION

SHRD10: PUSH	CX		;SAVE OUTER LOOP VARIABLE (BITS TO
				;BE SHIFTED RIGHT)
	PUSH	BX		;SAVE POINTER TO HIGH BYTE TO SHIFT
	CLC			;CF=0
	CALL	$SHDR		;SHIFT 1 BIT RIGHT
	POP	BX
	POP	CX		;GET OUTER LOOP VARIABLE
	LOOP	SHRD10
	RET

DINTA:	PUSH	BX
	MOV	BX,OFFSET $DFACL	;BEGINNING ADDRESS FOR SUBTRACT
DINA10: SUB	WORD PTR 0[BX],1	;NEED CF SO CAN'T USE DEC
	JNB	DINA20
	INC	BX
	INC	BX		;CAN DO WORD SUBTRACTS SINCE HIGH BIT
				;OF MANTISSA IS SET (THUS PROTECTING
				;THE EXPONENT FROM THE SUBTRACT)
	JMP	SHORT DINA10
DINA20: POP	BX
	RET

ADD1D:				;ADD 1 TO DOUBLE PRECISION MANTISSA BITS
	PUSH	BX		;
	MOV	BX,OFFSET $DFACL
ADD10:	INC	BYTE PTR 0[BX]
	JNZ	ADD20
	INC	BX		;POINT TO NEXT BYTE THERE WAS A CARRY
	JMP	SHORT ADD10
ADD20:	POP	BX
	RET

_INT:
$INT:				;SINGLE PRECISION INT FUNCTION
	MOV	CL,BYTE PTR $FAC	;FETCH EXPONENT
	SUB	CL,LOW 230	;CALCULATE SHIFT COUNT
	JNB	INT20		;ALREADY INTEGER PROCEED
	NEG	CL		;GET POSITIVE SHIFT COUNT
;
; Note - At this point the carry is set.  This will be used
; to indicate that this is not a QINT call.  Also note that
; if the exponent is zero the above subtraction did set the
; carry so the check for the zero exponent case below is
; guaranteed to be executed.
;
QINTX:				; $QINTX'S ENTRY POINT
	MOV	DX,WORD PTR $FACLO	;FETCH LOW MANTISSA BITS
	MOV	BX,WORD PTR $FAC-1	;FETCH EXP,SIGN,HIGH MANTISSA BITS
	INC	BH		;Is the exponent zero?  (Test for zero
	DEC	BH		;without affecting the carry.)
	JNE	QINTNZ		;No, proceed.
	XOR	BL,BL		;Yes, put zero into BL,DX for QINT
	XOR	DX,DX		;rather than work with the possible
	RET			;garbage in the mantissa (an exponent
				;of zero means the number is zero).
QINTNZ: PUSHF			;Save carry which if clear indicates
				;this is a QINT call.
	OR	BL,BL		;SEE IF NEGATIVE
	PUSHF			;SAVE
	MOV	BYTE PTR $FAC+1,BL	;SAVE SIGN FOR NORMS
	MOV	BYTE PTR $FAC,LOW 230	;SET EXP FOR POST SHIFT
	OR	BL,LOW 200	;RESTORE HIDDEN 1
	POPF
	PUSHF			;SAVE SIGN
	JNS	INT10		;
	SUB	DX,1		;CAN'T DO A 'DEC' BECAUSE NEED CF
	SBB	BL,LOW 0	;DO APPROPRIATE SUBTRACT TO HIGH BYTE
INT10:	XOR	CH,CH		;CX HAS LOOP COUNT
	OR	CL,CL		;IF SHIFT COUNT ZERO MUST JUMP OVER
	JZ	INT12		;RIGHT SHIFTS
INT11:	SHR	BL,1		;SHIFT RIGHT INTO CF
	RCR	DX,1		;ROTATE RIGHT
	LOOP	INT11		;WILL DO (CX) RIGHT SHIFTS
INT12:	POPF			;RECALL SIGN OF NO.
	LAHF			;STORE FLAGS TEMPORARILY
	JNS	INT15		;PROCEED IF POSITIVE
	INC	DX
	JNZ	INT15
	INC	BL
INT15:
	POPF			;CF=0 IF CALLED BY QINT
	JNB	INT20		;JUST RETURN IF QINT CALL
	XOR	AH,AH		;CLEAR OVERFLOW BYTE
	JMP	$NORMS		;NORMALIZE AND RETURN
INT20:	SAHF			;MUST SEE IF NEGATIVE
NGBLDX: JNS	INT30		;IF NOT PROCEED AS NORMAL
	NOT	DX		;COMPLEMENT DX
	NOT	BL		;AND BL
	ADD	DX,1		;NEED CF SET IF DX OVERFLOWS
	ADC	BL,LOW 0	;2's COMPLEMENT NOW FORMED
INT30:	RET
QINT:
$QINT:				;DO INT(FAC) AND LEAVE IN (BLDX)
	MOV	CL,LOW 230
	SUB	CL,BYTE PTR $FAC	;GET SHIFT COUNT TO CL
	CLC			;CF=0
	JMP	SHORT QINTX	;LEAVE RIGHT ADJUSTED

	SUBTTL	 $LOG	 SINGLE PRECISION NATURAL LOG FUNCTION
;**********************************************************
;
;       $LOG    COMPUTE THE NATURAL LOG OF THE VALUE IN THE FAC
;       CALLING SEQUENCE:       CALL    $LOG
;               WITH INPUT ARGUMENT IN THE FAC
;       MLLN2   IF THIS ENTRY POINT IS USED THE FAC WILL BE
;               MULTIPLIED BY LN(2)
;
;************************************************************

LOG:
$LOG:	CALL	$SIGNS		;ERROR IF ($FAC).LE..0
	JLE	LG100
;****************************************************************
;       WILL NOW PERFORM SPECIAL TEST FOR ARGUMENT OF 1.0 AND IF
;       FOUND EQUAL ANSWER IS 0
;*****************************************************************
	MOV	DX,0		;FETCH 1.0 TO (BXDX)
	MOV	BX,100400
	CALL	$FCOMP
	JNZ	LOG10		;PROCEED IF NOT 1.0
	MOV	WORD PTR $FACLO,DX	;WILL ZERO $FAC AND RETURN
	MOV	WORD PTR $FACM1,DX
	RET
LOG10:
	MOV	AL,BYTE PTR $FAC	;FETCH EXPONENT
	SUB	AL,LOW 200	;TAKE OUT BIAS
	CBW			;CONVERT BYTE TO WORD
	PUSH	AX		;AND SAVE
	MOV	BYTE PTR $FAC,LOW 200	;ZERO THE EXPONENT
	CALL	$PUSHF		;SAVE ARG FOR Q(X) CALCULATION
	MOV	BX,OFFSET $LOGP ;NOW TO USE HART APPROX FOR P(X)
	CALL	$POLY
	POP	DX		;GET X OFF THE STACK
	POP	BX
	CALL	$PUSHF		;SAVE P(X)
	CALL	$MOVFR		;MOVE X TO FAC
	MOV	BX,OFFSET $LOGQ
	CALL	$POLY		;CALCULATE Q(X)
	POP	DX		;RECALL P(X)
	POP	BX
	CALL	$FDIVS		;CALCULATE P(X)/Q(X)
	POP	DX		;FETCH RAW EXPONENT
	CALL	$PUSHF		;SAVE FAC ON THE STACK
	CALL	$FLT		;FLOAT THE VALUE INTO THE $FAC
	POP	DX		;RECALL LOG2 VALUE
	POP	BX
	CALL	$FADDS		;ADD
MLLN2:	MOV	BX,100061	;FETCH LN(2) TO (BXDX)
	MOV	DX,71030
	JMP	$FMULS		;MULTIPLY TO COMPLETE
LG100:	JMP	$FCERR

	SUBTTL	 $NORMD  DOUBLE PRECISION NORMALIZATION ROUTINE
;******************************************************************
;
;       $NORMD  NORMALIZES THE NUMBER IN $FAC+1 THRU $DFACL-1
;               AND JUMPS TO $ROUND
;       CALLING SEQUENCE:       CALL    $NORMD
;               OR              JMP     $NORMD
;               WILL RESULT IN NORMALIZATION FOLLOWED BY ROUNDING
;               AND PACKING THE $FAC.
;
;*******************************************************************

$NORMD: MOV	DL,LOW 71	;MAX BITS TO SHIFT LEFT
	MOV	BX,OFFSET $DFACL-1
NORD5:	MOV	DI,OFFSET $FAC-1
	MOV	SI,OFFSET $FAC
	JMP	SHORT NORD30
NORD10:
	MOV	CX,4
	CLC			;CF=0
NORD20: RCL	WORD PTR 0[BX],1
	INC	BX
	INC	BX		;POINT TO NEXT WORD
	LOOP	NORD20
	MOV	BX,OFFSET $DFACL-1	;POINT BACK TO END OF NUMBER
NORD25:
	DEC	BYTE PTR 0[SI]	;DECREMENT EXPONENT
	JZ	NORD40		;DO CLEAN-UP IF UNDERFLOW
	DEC	DL		;SEE IF MAX BITS SHIFTED
	JZ	NORD40		;IF SO TERMINATE SHIFTS
NORD30: TEST	BYTE PTR 0[DI],LOW 377	;SF=1 IF NOW NORMALIZED
	JS	NORD40		;NORMALIZED

	JNZ	NORD10		;MUST SHIFT BIT AT A TIME
;***************************************************************
;CAN DO AT 1 BYTE MOVE LEFT
;***************************************************************
	SUB	BYTE PTR 0[SI],LOW 10	;SUBTRACT 8
	JBE	NORD40		;UNDERFLOW
	SUB	DL,LOW 10	;SEE IF MAX BITS SHIFTED
	JBE	NORD40		;AND IF SO QUIT
	MOV	SI,OFFSET $FAC-2
	MOV	CX,7		;7 BYTES TO MOVE
	STD			;SO FOLLOWING MOVB WILL DECREMENT
		     ;REPEAT CX TIMES (THE MOVB)
 REP	MOVSB			;MOVE
	MOV	BYTE PTR $DFACL-1,LOW 0 ;ZERO OVERFLOW
	JMP	SHORT NORD5	;SEE IF MORE CASES
NORD40: JBE	NORD50		;UNDERFLOW JUMP
	JMP	$ROUND
NORD50:
	JMP	$DZERO

	SUBTTL	 $NORMS  SINGLE PRECISION NORMALIZATION ROUTINE
;************************************************************
;
;       $NORMS  SINGLE PRECISION NORMALIZATION ROUTINE
;               $NORMS SHIFTS (BLDXAH) LEFT UNTIL THE SIGN
;               BIT OF (BL)IS 1. FOR EACH LEFT SHIFT
;               $NORMS WILL DECREMENT THE FAC
;               ONCE THIS PROCESS IS COMPLETE, $NORMS WILL
;               JUMP TO $ROUNS TO ROUND THE NUMBER AND
;               PACK IT INTO THE FAC BYTES.
;
;*************************************************************

$NORMS:
	MOV	BH,BYTE PTR $FAC	;EXPONENT TO BH
	MOV	CX,4
NOR10:	OR	BL,BL		;SEE IF SIGN BIT SET
	JS	NOR20		;IF SO NORMALIZATION COMPLETE
	JNZ	NOR15		;UPPER BYTE NON-ZERO
	SUB	BH,LOW 10	;CAN WE SUBTRACT 8 W/O UNDERFLOW?
	JBE	NOR17
	MOV	BL,DH
	MOV	DH,DL
	MOV	DL,AH
	XOR	AH,AH		;CLEAR OVERFLOW BYTE
	LOOP	NOR10
	JZ	NOR17		;UNDERFLOW!
NOR15:
	CLC			;CLEAR CARRY FLAG [CF]
	RCL	AH,1		;SHIFT OVERFLOW BYTE LEFT.
	RCL	DX,1		;SHIFT LOWER MANTISSA WORD LEFT
	RCL	BL,1		;SHIFT HIGH MANTISSA BYTE LEFT
NOR16:	DEC	BH		;DECREMENT EXPONENT
	JNZ	NOR10		;CONTINUE UNLESS UNDERFLOW
NOR17:	JMP	$ZERO		;ZERO THE FAC AND RETURN
NOR20:	MOV	BYTE PTR $FAC,BH	;UPDATE EXPONENT
	JMP	$ROUNS

	SUBTTL $POLY	 SINGLE PRECISION POLYNOMIAL EVALUATOR
;*********************************************************
;
;       $POLY   EVALUATES THE POLYNOMIAL:
;                       P(X)=C0+C1X+C2X2+...+CNXN
;               THE EVALUATION IS ACCOMPLISHED VIA HORNER'S
;               RULE (SEE "THE ART OF COMPUTER PROGRAMMING"
;               VOL.2 PP423, BY KNUTH)
;       $POLYX  PERFORMS THE EVALUATION X(P(X**2)) ON THE
;               POLYNOMIAL MENTIONED ABOVE
;       CALLING SEQUENCE:       CALL $POLY
;               OR              CALL    $POLYX
;               WITH X STORED IN THE $FAC AND (BX)
;               POINTING TO THE FOLLOWING:
;                                       N+1
;                                       CN
;                                       CN-1
;                                       .
;                                       .
;                                       .
;                                       C0
;
;***********************************************************

$POLYX:
	MOV	DX,WORD PTR $FACLO	;FETCH LOW BYTES
	MOV	BP,WORD PTR $FACM1	;AND HIGH BYTES
	PUSH	DX		;SAVE X ON THE STACK
	PUSH	BP		;
	PUSH	BX		;SAVE COEFFICIENT POINTER
	MOV	BX,BP		;(BXDX)=X
	CALL	$FMULS		;FORM X**2
	POP	BX		;RECALL COEFFICIENT POINTER
	CALL	$POLY		;FORM P(X**2)
	POP	BX		;FETCH X TO REGISTERS
	POP	DX
	JMP	$FMULS

$POLY:	CLD			;9-Aug-82/MLC - Good for LODC, MOVW,
				;and MOVW down to POL10.
	MOV	SI,BX		;SO WE CAN USE STRING MOVES
				;MUST FETCH FROM THE CODE SEG
	LODS	BYTE PTR ?CSLAB ;FETCH NUMBER OF COEFFICIENTS
	CBW			;(AH)=0
	PUSH	AX		;PUSH NUMBER ELEMENTS ON STACK
	PUSH	WORD PTR $FACM1 ;SAVE THE FAC ON THE STACK
	PUSH	WORD PTR $FACLO
	MOV	DI,OFFSET $FACLO
				;WANT TO FETCH COEFF FROM
	MOVSW	;?CSLAB,WORD PTR ?CSLAB
				;FETCH FROM CODE SEGMENT
	MOVSW	;?CSLAB,WORD PTR ?CSLAB
POL10:
	POP	DX		;FETCH LOW X
	POP	BX		;FETCH HIGH X
	POP	AX		;RECALL COEFFICIENT COUNTER
	DEC	AX		;DECREMENT
	JZ	POL30		;JUMP WHEN COMPLETE
	PUSH	AX		;SAVE COUNTER
	PUSH	BX		;SAVE X ON THE STACK
	PUSH	DX
	PUSH	SI		;SAVE POINTER TO COEFFICIENTS
	CALL	$FMULS		;MULTIPLY BY X
	POP	SI		;FETCH COEFFICIENT POINTER
	CLD			;9-Aug-82/MLC - Good for next two
				;LODWs.
				;MUST FETCH FROM CODE SEGMENT
	LODS	WORD PTR ?CSLAB ;FETCH LOW WORD
	XCHG	AX,DX
				;MUST FETCH FROM CODE SEGMENT
	LODS	WORD PTR ?CSLAB ;FETCH HIGH WORD
	XCHG	AX,BX
	PUSH	SI		;SAVE COEFFICIENT POINTER
	CALL	$FADDS		;ADD IT IN
	POP	SI		;GET POINTER BACK
	JMP	SHORT POL10
POL30:				;CLEAR THE STACK
	RET

	SUBTTL	 $PUF	 PRINT-USING FOR FLOATING POINT NUMBERS
;**************************************************************
;
;       $PUF    THIS ROUTINE ACCEPTS EITHER SINGLE OR DOUBLE
;               PRECISION FLOATING VALUES AND FORMATS THEM
;               ACCORDING TO INPUT FORMATS. BOTH FIXED AND
;               "E" TYPE FORMATS ARE PRODUCED BY THIS CODE
;       CALLING SEQUENCE:       CALL    $PUF
;               WITH FLOATING POINT VALUE IN THE FAC, (BX) POINTING
;               TO THE NEXT PRINT POSITION IN THE OUTPUT BUFFER
;               AND FORMAT SPECIFICATIONS IN AX, AND CX.
;               $FMTAX LOADED INTO (AX) WILL CONTAIN COMMA COUNT
;               IN (AH) AND THE FOLLOWING FORMAT IN (AL):
;               BIT     7       =0 FREE FORMAT OUTPUT, NUMBER DICTATES
;                               OUTPUT FORMAT
;                               =1 PRINT USING OUTPUT. THE REMAINDER OF
;                               (AL) AND (CX) DICTATE HOW THE NUMBER IS
;                               TO BE PRINTED
;                       6       IF =1 GROUP THE DIGITS IN THE INTEGER
;                               PART IN GROUPS OF THREE AND SEPARATE
;                               WITH COMMAS.
;                       5       IF =1 FILL THE LEADING SPACES IN THE
;                               FIELD WITH ASTERISKS "*"
;                       4       IF =1 OUTPUT THE NUMBER WITH A FLOATING
;                               DOLLAR SIGN "$"
;                       3       IF =1 PRINT THE SIGN OF THE NUMBER WITH
;                               A PLUS "+" IF POSITIVE INSTEAD OF A SPC
;                       2       IF =1 PRINT THE SIGN AFTER THE NUMBER
;                       1       UNUSED
;                       0       IF =1 PRINT THE NUMBER IN SCIENTIFIC
;                               NOTATION AND IGNORE BIT 6.
;                               IF =0 USE FIXED POINT NOTATION.
;               $FMTCX WILL HAVE THE FOLLOWING FORMAT LOADED IN (CX)
;               (CH)    NUMBER PLACES IN FIELD TO LEFT OF DECIMAL POINT
;                       (DOES NOT INCLUDE THE DECIMAL POINT)
;               (CL)    NUMBER PLACES IN THE FIELD TO THE RIGHT OF THE
;                       DECIMAL POINT (INCLUDES DECIMAL POINT)
;
;****************************************************************

$PUF:
	PUSH	BX		;SAVE OUTPUT BUFFER POINTER
	SHR	AL,1		;CF=1 IF "E" FORMAT DESIRED
	JNB	PUF10		;IF FIXED PROCEED
	JMP	$PUFE		;GO DO IT
PUF10:
;******************************************************************
;KNOW THAT A FIXED FORMAT IS DESIRED. THE FOLLOWING ANALYSIS WILL
;BE PERFORMED:  (1) SEE IF NO. IS .GE. 10^16 , AND IF SO
;GO PRINT WITH $FOUT AND INSERT A LEADING "%". (2) BRACKET THE
;PRINTABLE DIGITS IN THE INTEGER PART OF THE NUMBER WITH $FOTNV
;(3) SEE IF LEADING ZEROS ARE REQUIRED(THE POSITIONS SPECIFIED
;TO THE LEFT OF THE DECIMAL POINT ARE MORE THAN THE AVAILABLE
;DIGITS TO LEFT OF DECIMAL POINT). (4) SEE IF THE SUM OF THE DIGITS
;ON THE LEFT PLUS THOSE ON THE RIGHT ARE LESS THAN THE AVAILABLE
;DIGITS,I.E. WE HAVE MORE PRINTABLE DIGITS THAN REQUIRED. IF THIS
;IS THE CASE WE MUST SHIFT THE NUMBER RIGHT SO THAT WE CAN ROUND IT
;AT THE CORRECT POSITION. (5) PUT IN THE PRINTABLE DIGITS. (6) SEE
;IF TRAILING ZEROS ARE REQUIRED(SPECIFIED DIGITS TO THE RIGHT
;WERE IN EXCESS OF DIGITS AVAILABLE)
;********************************************************************
	MOV	BX,OFFSET $DP16 ;WILL FIRST SEE IF NO. TOO LARGE
	CALL	$MOVBF		;NO. MOVED TO DBUFF FOR COMPARISON
				;(IT WAS PREVIOUSLY IN CODE SEGMENT)
	CALL	$VCOMP		;(FAC)-10^16(CF=1 IF OK)
	JB	PUF30		;JUMP IF SMALL ENOUGH TO PROCESS
;******************************************************************
;NO. WAS TOO LARGE TO PRINT WITH FIXED FORMAT. MUST PRINT IN FREE-
;FORMAT WITH $FOUT AND INSERT A LEADING "%" TO INDICATE IT OVERFLOWED
;THE SPECIFIED PRINT FIELD
;*******************************************************************
	POP	BX		;RECALL PRINT BUFFER POINTER
	CALL	$FOUT		;PRINT IN FREE-FORMAT
	DEC	BX		;POINT TO POSITION 1
	MOV	BYTE PTR 0[BX],LOW "%"  ;PUT IN OVERFLOW INDICATOR
	RET			;DONE
PUF30:
;********************************************************************
;ALL WE KNOW AT THIS POINT IS THAT IT IS POSSIBLE TO PRINT THE
;NUMBER WITH A FIXED FORMAT, DO NOT KNOW THE SPECIFIED FIXED FORMAT
;IS SUFFICIENT. WHAT WE WILL DO IS FORMAT THE NUMBER IN FIXED FORMAT
;AND THEN JUMP TO $PUFXE AND LET HIM DETERMINE IF THE NUMBER WAS
;WITHIN THE SPECIFIED FORMAT.
;********************************************************************
	CALL	$GETYP		;DETERMINE TYPE
	MOV	CH,LOW 20	;ASSUME DOUBLE PREC. (16 PRINTABLE POS)
	JNB	PUF40


	MOV	CH,LOW 7	;7 print positions if single precision

PUF40:	CALL	$SIGNS		;SEE IF NO. IS ZERO
	JZ	PUF50		;IF SO DON'T CALL $FOTNV
	CALL	$FOTNV		;BRACKET NO. SO ALL PRINTABLE DIGITS
				;IN THE INTEGER PART OF THE NUMBER AND
				;RETURN COMPLEMENTING EXPONENT IN (AL)
				;AND SF=1 IF THIS EXPONENT IS NEG.
				;(THERE ARE DIGITS TO RIGHT OF D.P)
PUF50:	POP	BX		;GET OUTPUT BUFFER POINTER BACK
	JS	PUF80		;GO PRINT NO. WITH DIGITS TO RIGHT
				;OF DECIMAL POINT
;*********************************************************************
;KNOW AT THIS POINT WE HAVE A NUMBER LESS THAN 10^16 THAT HAS NO
;PRINTABLE DIGITS TO RIGHT OF THE DECIMAL POINT. THEREFORE WE HAVE
;TO PUT IN LEADING ZEROS IF THE SPECIFIED PRINT POSITIONS TO THE LEFT
;OF THE DECIMAL POINT ARE MORE THAN THE PRINTABLE POSITIONS (CH)
;AND THE POSITIVE EXPONENT IN (AL)
;********************************************************************
	MOV	DL,AL		;SAVE THIS POSITIVE EXP. FOR LATER
	ADD	AL,CH		;THIS IS NECESSARY PRINT POSITIONS
				;TO ACCOMODATE THIS NUMBER.
	SUB	AL,BYTE PTR $FMTCX+1	;SUBTRACT DIGITS TO LEFT
	JNS	PUF60		;NO LEADING ZEROS REQUIRED
	NEG	AL		;MUST MAKE (AL) POSITIVE FOR $FOTZ
	CALL	$FOTZ		;PUT IN (AL) LEADING ZEROS
PUF60:	XOR	CL,CL		;ZERO CREATED ZEROS
	CALL	DPCOM		;SET-UP DECIMAL POINT AND COMMA CT.
	PUSH	WORD PTR $FMTCX ;SAVE DECIMAL POINT INFO.
	PUSH	DX		;SAVE EXPONENT
	CALL	$FOTCV		;CONVERT THE BINARY NO. TO ASCII DIGITS
				;NOTE THAT $FOTCV WILL ONLY CONVERT
				;THE PRINTABLE DIGITS. IF THERE WAS A
				;NON-ZERO EXPONENT AS WELL WE MUST
				;INSERT SOME ZEROS PRIOR TO THE DECIMAL
				;POINT. FURTHER WE MUST PAY ATTENTION
				;TO OUR COMMA COUNT WHILE INSERTING
				;THESE ZEROS.
	POP	DX		;RECALL EXPONENT
	POP	WORD PTR $FMTCX ;RECALL DECIMAL POINT INFO.
	PUSH	WORD PTR $FMTCX ;SAVE DESIRED POSITIONS LEFT/RT.
	XOR	AL,AL		;WANT DL IN AL WITH APPROPRIATE SIGNS
	OR	AL,DL		;DL=EXPONENT
	JZ	PUF70		;IF NO ZEROS PRIOR TO D.P. JUMP
	CALL	$FOTZC		;PUT IN ZEROS AND PAY ATTENTION TO
				;COMMA COUNT.
	CALL	$FOTED		;PUT IN DECIMAL POINT
PUF70:	POP	WORD PTR $FMTCX ;RECALL DESIRED POSITIONS LEFT/RT.
	PUSH	WORD PTR $FMTCX ;AND SAVE AGAIN
	MOV	AL,BYTE PTR $FMTCX	;FETCH NO. POSITIONS TO RT. OF D.P.
	JMP	$PUIZ		;GO PUT IN ANY REQUIRED TRAILING ZEROS
				;AND CHECK TO ASSURE FIELD SPECS. MET
PUF80:
;********************************************************************
;AT THIS POINT WE KNOW WE HAVE PRINTABLE DIGITS TO THE RIGHT OF THE
;DECIMAL POINT . WE KNOW THIS BECAUSE $FOTNV WAS CALLED TO BRACKET
;THE NO. SUCH THAT THE PRINTABLE DIGITS WERE IN THE INTEGER PART
;OF THE NUMBER AND THE COMPLEMENTING EXPONENT WAS IN (AL). FURTHER
;SF=1 WAS SET TO INDICATE (AL) WAS NEGATIVE.
;WE FURTHER NEED TO DETERMINE IF WE NEED TO ROUND SOMEWHERE
;WITHIN THE PRINTABLE DIGITS. THIS WILL BE THE CASE IF THE
;DIGITS TO BE PRINTED TO THE RIGHT IS LESS THAN THOSE AVAILABLE
;TO THE RIGHT. (AL) HAS THOSE AVAILABLE TO THE RIGHT, $FMTCX HAS
;THOSE DESIRED.
;***************************************************************
	MOV	DL,AL		;SAVE THE COMPLEMENTING EXPONENT
	MOV	AL,BYTE PTR $FMTCX	;FETCH DIGITS DESIRED TO RIGHT
	OR	AL,AL		;IF NON-ZERO MUST SUBTRACT 1
				;BECAUSE DECIMAL POINT INCLUDED
	JZ	PUF90		;PROCEED IF NO DIG. TO RT. DESIRED
	DEC	AL		;TAKE OUT FOR DECIMAL POINT COUNT
PUF90:	MOV	DH,AL		;SAVE DESIRED DIGITS TO RIGHT COUNT
	ADD	AL,DL		;SUBTRACT DIGITS AVAILABLE TO RT.
				;(THIS IS A SUBTRACT BECAUSE (DL) IS
				;THE NEGATIVE TO DIGITS TO RT.)
	MOV	CL,AL		;WILL NEED THIS FOR LATER. IT
				;IS THE NEGATIVE OF THE NUMBER
				;OF DIGITS WE ARE ABOUT TO SHIFT
				;OFF TO THE RIGHT
	JS	PUF100		;JUMP IF INTERNAL ROUNDING NECESSARY
	XOR	AL,AL		;WILL NEED ALL PRINTABLE DIGITS
	MOV	CL,AL		;NO DIGITS SHIFTED OFF
	JMP	SHORT PUF110	;DO NOT NEED TO DIVIDE IF POSITIVE
PUF100: PUSH	AX
	PUSH	CX		;SAVE GENERATED LEADING ZEROS
	PUSH	DX		;
	PUSH	BX
	CALL	$DIV10		;NEED TO ELIMINATE EXCESS PRINTABLE
	POP	BX
	POP	DX
	POP	CX		;RECALL GENERATED LEADING ZEROS
	POP	AX		;RECALL EXCESS DIGITS
	INC	AL		;BECAUSE AL WAS ORIGINALLY NEGATIVE
	JS	PUF100		;CONTINUE FOR INTERNAL ROUNDING
	MOV	AH,CL		;WILL NEED CREATED LEADING ZEROS
				;LATER
PUF110:
	MOV	AL,DL		;GET NEGATIVE EXPONENT
	SUB	AL,CL		;ADD CREATED ZEROS
	ADD	AL,CH		;IF SF=1 THEN NO DIGITS TO LEFT
	JNS	PUF120		;JUMP IF DIGITS TO LEFT OF DECIMAL PT
;******************************************************************
;WE KNOW HERE THAT THE ENTIRE PRINTABLE DIGITS GO TO THE RIGHT OF
;THE DECIMAL POINT. IF DIGITS WERE REQUESTED TO THE LEFT THEN WE
;NEED TO INSERT LEADING ZEROS
;********************************************************************
	MOV	AL,BYTE PTR $FMTCX+1	;DESIRED LEADING DIGITS
	CALL	$FOTZ		;INSERT (AL) LEADING ZEROS
	MOV	BYTE PTR 0[BX],LOW "."  ;PUT IN DECIMAL POINT
	MOV	WORD PTR $DPADR,BX	;*** Save DP position for $FOTED, etc. ***
	INC	BX		;NEXT BUFFER POSITION
	XOR	CL,CL		;COMMA COUNT TO ZERO
;**********************************************************
;OK WE'VE PUT IN THE REQUIRED LEADING ZEROS PRIOR
;TO THE DECIMAL POINT. WE MAY FURTHER NEED TO PUT IN A FEW
;AFTER THE DECIMAL POINT. WE KNOW THAT THE EXPONENT IS
;GREATER IN ABSOLUTE VALUE THAN THE NO. OF PRINTABLE DIGITS.
;THE NUMBER OF LEADING ZEROS REQUIRE HERE THEN IS ABS.
;VALUE OF THE EXPONENT LESS PRINTABLE DIGITS
;**********************************************************
	MOV	AL,DH		;Get number of digits after decimal point
	SUB	AL,CH		;Subtract number that will be printed by $FOTCV
	CALL	$FOTZ		;PUT IN (AL) LEADING ZEROS
	XOR	CX,CX		;*** No longer need comma & decimal info ***
	PUSH	DX		;*** 8-Mar-82/ngt Fix                    ***
	PUSH	WORD PTR $FMTCX ;*** Balance number of PUSHes and POPs   ***
	JMP	SHORT PUF140	;GO PUT IN THE DIGITS
PUF120:
;*******************************************************************
;WE KNOW HERE THAT THERE ARE DIGITS TO THE LEFT OF THE DEC.PT.
;WE NEED TO DETERMINE IF LEADING ZEROS ARE REQUIRED. THEY WILL BE
;REQUIRED IF THE SPECIFIED DIGITS TO THE LEFT IS GREATER THAN
;THE NUMBER OF PRINTABLE DIGITS LESS THOSE TO THE RIGHT. RECALL THAT
;EARLIER WE PUT THE NUMBER OF PRINTABLE DIGITS IN (CH). DUE TO THE
;ABOVE CODE WE MAY HAVE INCREASED THE NUMBER OF DIGITS AVAILABLE TO
;THE LEFT BECAUSE WE SHIFTED THE NUMBER RIGHT BRINGING IN LEADING
;ZEROS. FOR EXAMPLE: IF WE GOT HERE WITH THE NUMBER 12.78575 $FOTNV
;WOULD HAVE 1278575. IN THE FAC AND -5 IN (AL), IF FURTHER THE INPUT
;FORMAT HAD BEEN ########.## WE WOULD HAVE SHIFTED THE NUMBER 3 DIGITS
;RIGHT FOR ROUNDING PURPOSES LEAVING 1278.575 IN THE FAC AND -3 IN
;(CL). ONCE WE GO TO $FOTCV , HE SHALL PRODUCE THE DIGITS
;00012.79 SO THE FORMULA FOR LEADING ZEROS IS:
;LEADING ZEROS=DESIRED DIGITS-[(CH)+(DL)-(CL)]
;               =DESIRED DIGITS-(CH)-(DL)+(CL)
;OR AS IN THIS EXAMPLE,LEADING ZEROS=8-[7+(-5)-(-3)]=3
;*********************************************************************
	MOV	AL,BYTE PTR $FMTCX+1	;FETCH DESIRED DIGITS
	PUSH	DX		;SAVE DIGITS TO RIGHT
	PUSH	WORD PTR $FMTCX ;SAVE DIGITS TO LEFT/RIGHT
	SUB	AL,CH		;SUBTRACT PRINTABLE DIGITS
	SUB	AL,DL		;ADD DIGITS TO RIGHT
	ADD	AL,CL		;SUBTRACT CREATED LEADING ZEROS
	JS	PUF130		;IF NO LEADING ZEROS REQUIRED JUMP
	CALL	$FOTZ		;PUT IN REQUIRED LEADING ZEROS
PUF130: CALL	DPCOM		;SET UP DECIMAL POINT AND COMMA CTS.
PUF140: PUSH	WORD PTR $FMTCX ;SAVE DECIMAL POINT INFO.
	CALL	$FOTCV		;CONVERT FAC TO ASCII DIGITS AND
				;INSERT INTO OUTPUT BUFFER. DECIMAL
				;POINT AND COMMA COUNTS ARE IN
				;(CH)&(CL) RESPECTIVELY
	POP	WORD PTR $FMTCX ;Retrieve the right and left counts.
				;($FMTCX:=digits to right of decimal
				;point plus one for the decimal point,
				;$FMTCX+1:=digits to left of decimal
				;point.)
	POP	AX		;RECALL DIGITS TO LEFT
	POP	DX		;RECALL DIGITS TO RIGHT
	TEST	BYTE PTR $FMTCX,LOW 377O	;Is the right side count zero?
				;(This count includes the point
				;point itself.)
	JNZ	PUF150		;No, retain the decimal point.
				;Go see if trailing zeroes are needed.
	MOV	BX,WORD PTR $DPADR	;Yes, get rid of the decimal point
				;by backing up the pointer so the
	JMP	$PUFXE		;GO DO FIX-UP
PUF150:
;*****************************************************************
;WE NEED TO NOW DETERMINE IF TRAILING ZEROS ARE TO BE PRINTED
;THIS WILL BE THE CASE IF NO. DIGITS TO THE RIGHT (DL) IS LESS
;THAN THOSE REQUESTED (AL).
;****************************************************************
	ADD	AL,DL		;SUBTRACT DIGITS TO THE RIGHT
	DEC	AL		;BECAUSE DECIMAL POINT WAS INCLUDED
	JS	PUF160		;GO DO FIX-UP
	CALL	$FOTZ		;PUT IN TRAILING ZEROS
PUF160: JMP	$PUFXE		;GO DO FIX-UP



DPCOM:				;ROUTINE TO SET UP DECIMAL POINT AND COMMA COUNTS
	MOV	AL,CH		;FETCH PRINTABLE DIGITS
	ADD	AL,DL		;SUBTRACT DIGITS TO RIGHT
	SUB	AL,CL		;ADD CREATED ZEROS
	INC	AL		;FOR SIGN
	MOV	CH,AL
DPC10:	SUB	AL,LOW 3	;SUBTRACT OUT AL MULTIPLES OF 3
	JG	DPC10
	ADD	AL,LOW 3
	MOV	CL,AL		;COMMA COUNT NOW SET
	MOV	AL,BYTE PTR $FMTAX	;FETCH FORMAT FLAGS
	AND	AL,LOW 100	;SEE IF COMMAS DESIRED
	JNZ	DPC20
	MOV	CL,AL		;ZERO COMMA COUNT
DPC20:	RET

	SUBTTL	 $PUFOT  PRINT USING OUTPUT ROUTINE
;***************************************************************
;
;       $PUFOT  THIS ROUTINE PROVIDES TOP-LEVEL CONTROL OF THE
;               PRINT USING OUTPUT FUNCTION.
;       CALLING SEQUENCE:       CALL    $PUFOT
;               WITH NUMBER TO BE OUTPUT IN THE FAC AND FORMAT
;               SPECIFICATIONS IN (AL), AND (CX).(AL) IS SET AS
;               FOLLOWS:
;               BIT     7       =0 FREE FORMAT OUTPUT, NUMBER DICTATES
;                               OUTPUT FORMAT
;                               =1 PRINT USING OUTPUT. THE REMAINDER OF
;                               (AL) AND (CX) DICTATE HOW THE NUMBER IS
;                               TO BE PRINTED
;                       6       IF =1 GROUP THE DIGITS IN THE INTEGER
;                               PART IN GROUPS OF THREE AND SEPARATE
;                               WITH COMMAS.
;                       5       IF =1 FILL THE LEADING SPACES IN THE
;                               FIELD WITH ASTERISKS "*"
;                       4       IF =1 OUTPUT THE NUMBER WITH A FLOATING
;                               DOLLAR SIGN "$"
;                       3       IF =1 PRINT THE SIGN OF THE NUMBER WITH
;                               A PLUS "+" IF POSITIVE INSTEAD OF A SPC
;                       2       IF =1 PRINT THE SIGN AFTER THE NUMBER
;                       1       UNUSED
;                       0       IF =1 PRINT THE NUMBER IN SCIENTIFIC
;                               NOTATION AND IGNORE BIT 6.
;                               IF =0 USE FIXED POINT NOTATION.
;               (CH)    NUMBER PLACES IN FIELD TO LEFT OF DECIMAL POINT
;                       (DOES NOT INCLUDE THE DECIMAL POINT)
;               (CL)    NUMBER PLACES IN THE FIELD TO THE RIGHT OF THE
;                       DECIMAL POINT (INCLUDES DECIMAL POINT)
;
;****************************************************************

PUFOUT:
$PUFOT:
	MOV	AH,AL		;FETCH FORMAT SPECS.
	TEST	AH,LOW 100	;ZF=0 IF COMMAS DESIRED
	MOV	AH,LOW 3	;IF COMMAS DESIRED
	JNZ	PFO05		;JUMP IF COMMAS DESIRED
	XOR	AH,AH		;COMMAS NOT DESIRED
PFO05:	MOV	WORD PTR $FMTAX,AX	;SAVE COMMA COUNT AND PFORMAT SPECS
	MOV	WORD PTR $FMTCX,CX	;SAVE POSITIONS TO RT./LEFT
				;OF DECIMAL POINT
	MOV	AH,AL		;FOR TESTING
	MOV	BX,OFFSET $FBUFF+1	;FETCH BUFFER POINTER
	MOV	BYTE PTR 0[BX],LOW " "  ;MOVE IN SPACE FOR POSSIBLE SIGN
	TEST	AH,LOW 10	;SEE IF "+" DESIRED
	JZ	PFO10		;JUMP IF NOT
	MOV	BYTE PTR 0[BX],LOW "+"  ;MOVE IN PLUS
PFO10:	PUSH	BX		;SAVE BUFFER POINTER
	CALL	$SIGNS		;DETERMINE SIGN OF NUMBER
	POP	BX		;RECALL BUFFER POINTER
	JNS	PFO20		;JUMP IF POSITIVE
	MOV	BYTE PTR 0[BX],LOW "-"  ;PUT IN MINUS SGN
	PUSH	BX		;SAVE BUFFER PTR.
	CALL	$VNEG		;NEGATE NO. SO WE WORK ONLY WITH
	POP	BX		;RECALL BUFFER PTR.
PFO20:	INC	BX		;POINT TO NEXT BUFFER POSITION
	MOV	BYTE PTR 0[BX],LOW "0"  ;PUT IN ZERO IN CASE NO IS ZERO
	CALL	$GETYP		;SET COND CODES ACCORDING TO TYPE
	MOV	AX,WORD PTR $FMTAX	;FETCH FORMAT SPECS
	MOV	CX,WORD PTR $FMTCX
	JS	PFO40		;IF INTEGER JUMP
	JMP	$PUF		;DO FLOATING POINT FORMATTING
PFO40:	JMP	$PUI		;PROCESS INTEGER

	SUBTTL	 $PUI	 PRINT USING FOR INTEGERS
;************************************************************
;
;       $PUI    PRINT THE INTEGER ACCORDING TO THE FORMATS IN
;               $FMTCX (NO PLACES TO LEFT/RIGHT OF DECIMAL POINT)
;               $FMTAX (AH)=0 OR 3 FOR COMMA INSERTION AND (AL)
;               HAS THE FOLLOWING MEANING:
;               BIT     7       =0 FREE FORMAT OUTPUT, NUMBER DICTATES
;                               OUTPUT FORMAT
;                               =1 PRINT USING OUTPUT. THE REMAINDER OF
;                               (AL) AND (CX) DICTATE HOW THE NUMBER IS
;                               TO BE PRINTED
;                       6       IF =1 GROUP THE DIGITS IN THE INTEGER
;                               PART IN GROUPS OF THREE AND SEPARATE
;                               WITH COMMAS.
;                       5       IF =1 FILL THE LEADING SPACES IN THE
;                               FIELD WITH ASTERISKS "*"
;                       4       IF =1 OUTPUT THE NUMBER WITH A FLOATING
;                               DOLLAR SIGN "$"
;                       3       IF =1 PRINT THE SIGN OF THE NUMBER WITH
;                               A PLUS "+" IF POSITIVE INSTEAD OF A SPC
;                       2       IF =1 PRINT THE SIGN AFTER THE NUMBER
;                       1       UNUSED
;                       0       IF =1 PRINT THE NUMBER IN SCIENTIFIC
;                               NOTATION AND IGNORE BIT 6.
;                               IF =0 USE FIXED POINT NOTATION.
;       CALLING SEQUENCE:       CALL    $PUI
;               WITH THE AFOREMENTIONED INFORMATION AVAILABLE
;
;******************************************************************

$PUI:	MOV	AX,WORD PTR $FMTAX	;FETCH PRINT DESCRIPTION DATA
	MOV	CL,AH		;$FOTCI WILL NEED COMMA INFO
				;IN (CL)
	MOV	CH,LOW 6	;AT MOST 6 PLACES PRIOR TO DECIMAL PT
	SHR	AL,1		;SETS CF=1 IF "E" TYPE PRINT DESIRED
	MOV	DX,WORD PTR $FMTCX	;FETCH PLACES TO LEFT/RIGHT OF DEC. PT
	JNB	PI10		;IF NOT "E" FORMAT JUMP
	PUSH	BX		;SAVE BUFFER POINTER
	PUSH	DX		;SAVE PLACES TO LEFT/RIGHT OF DEC. PT
	CALL	$CSI		;CONVERT THE INTEGER TO S.P.
	XOR	AL,AL		;MUST SET ZF=1 FOR $PUFE
	POP	DX		;FETCH PLACES TO LEFT /RIGHT OF D.P.
	JMP	$PUFE		;GO FORMAT THE SINGLE PRECISION NO.
PI10:	MOV	AL,DH		;FETCH PLACES TO LEFT OF D.P.
	SUB	AL,LOW 5	;LET'S SEE IF LEADING ZEROS NEEDED
;*******************************************************************
;AT MOST 5 PRINT POSITIONS NEEDED FOR INTEGER (-32768,32767) SO IF
;DESIRED NO. PLACES ON LEFT IS MORE THAN 5 WE NEED TO FILL THESE
;POSITIONS WITH ASCII SPACES.
;******************************************************************
	JS	PI20		;JUMP IF LESS THAN 5
	CALL	$FOTZ		;ZERO FILL (AL) POSITIONS
PI20:	PUSH	DX		;SAVE POSITIONS TO LEFT/RIGHT OF D.P.
	CALL	$FOTCI		;CONVERT THE INTEGER TO ASCII DIGITS
				;AND INSERT DECIMAL POINT AND COMMAS
				;AS DESIRED
	POP	AX		;RECALL NO. PLACESTO LEFT/RIGHT OF D.P.
	PUSH	AX		;AND SAVE AGAIN
$PUIZ:	OR	AL,AL		;IF 0 THEN NO DECIMAL POINT DESIRED
	JNZ	PI30		;IF DESIRED PROCEED
	DEC	BX		;THIS WILL ELIMINATE DECIMAL POINT
PI30:	DEC	AL		;MAY NEED TO INSERT ZEROS TO RIGHT
				;OF DECIMAL POINT.
	JS	PI40		;JUMP IF NOT DESIRED
	CALL	$FOTZ		;PUT (AL) ASCII ZEROS IN BUFFER
	MOV	BYTE PTR 0[BX],LOW 0	;RE-ESTABLISH END-OF-PRINT
PI40:	POP	WORD PTR $FMTCX ;MAINTAIN DIGITS LEFT/RT. OF DP.
	JMP	$PUFXE		;BE SURE FORMAT SPECS MET

	SUBTTL	 $RND	 PSEUDO-RANDOM NUMBER GENERATOR
;******************************************************************
;
;       $RND    GENERATE THE NEXT RANDOM NUMBER IN THE
;               SEQUENCE.
;
;       CALLING SEQUENCE:       CALL    $RND
;               WITH THE PREVIOUS RANDOM NUMBER IN $RNDX
;               AND DATA ITEMS $RNDA AND $RNDC SET PROPERLY
;       METHOD: LINEAR CONGRUENTIAL FROM VOL. 2 CHAPTER 3 OF
;               KNUTH - THE ART OF COMPUTER PROGRAMMING.
;               M=16,777,216 OR 2^24; [ A MOD 8 ]=5 AND
;               [ C MOD 8 ]=3
;               RND(N+1)=(RND(N)*A+C)MOD M
;
;               THE DATA ITEMS A AND C CORRESPOND TO $RNDA
;               AND $RNDC RESPECTIVELY AND WERE CAREFULLY
;               CHOSEN TO MEET THE RECIPE IN KNUTH.
;
;**************************************************************

RND:
$RND:	CALL	$SIGNS		;FIND WHICH MODE REQUESTED
	JZ	OLDRN		;RETURN PREVIOUS NO.?
	JNS	RND10		;GO DO NEW SEED
	MOV	AX,WORD PTR $FACLO	;FETCH NUMBER
	MOV	WORD PTR $RNDX,AX	;AND INITIALIZE LAST RANDOM #
	MOV	AL,BYTE PTR $FAC-1
	MOV	BYTE PTR $RNDX+2,AL	;SO SEQUENCE STARTS AGAIN
RND10:	MOV	AX,WORD PTR $RNDX	;FETCH LOW 16 BITS OF RNDX
	MUL	WORD PTR $RNDA	;MULTIPLY BY LOW BITS OF A
	MOV	DI,AX		;SAVE LOW 16 BITS
	MOV	CL,DL		;SAVE UPPER 8 BITS
	MOV	AL,BYTE PTR $RNDA+2	;FETCH UPPER 8 BITS OF A
	XOR	AH,AH		;CLEAR UPPER AX
	MUL	WORD PTR $RNDX	;MULTIPLY BY LOW RNDX
	ADD	CL,AL		;ADD TO UPPER 8 BITS
	XOR	AH,AH		;CLEAR UPPER AX
	MOV	AL,BYTE PTR $RNDX+2	;FETCH HIGH 8 BITS OF RNDX
	MUL	WORD PTR $RNDA	;MULTIPLY BY LOW 16 OF A
	ADD	CL,AL		;ADD IN TO UPPER 8
	XOR	AH,AH		;CLEAR OVERFLOW BYTE FOR NORM
	MOV	DX,WORD PTR $RNDC	;FETCH LOW 16 OF C
	ADD	DX,DI		;ADD IN LOW OF RND(N)*A
	MOV	BL,BYTE PTR $RNDC+2	;FETCH HIGH OF C
	ADC	BL,CL		;ADD WITH CARRY HIGH RND(N)*A
	MOV	BYTE PTR $FAC+1,AH	;SIGN IS POSITIVE
	MOV	AL,LOW 200	;SO NORM WILL PRODUCE NO.
				;LESS THAN 1
	MOV	BYTE PTR $FAC,AL
	MOV	WORD PTR $RNDX,DX	;SAVE NEW RND(N+1)
	MOV	BYTE PTR $RNDX+2,BL
	MOV	AL,LOW 4	;MUST SET VALTP TO SINGLE PREC.
	MOV	BYTE PTR $VALTP,AL
	JMP	$NORMS
NEWSD:				;DETERMINE NEW RANDOM NO. SEED
	MOV	BX,OFFSET $FBUFF	;WILL SUM THE FIRST 32 WDS OF
	MOV	CX,40		;RAM
NEW10:	ADD	AX,WORD PTR 0[BX]
	INC	BX
	INC	BX
	LOOP	NEW10
	AND	AL,LOW 376	;BE SURE BIT 0=0 SO AS TO NOT
				;MATCH RND0
	MOV	WORD PTR $RNDX,AX
	JMP	SHORT RND10	;GO PROCEED AS USUAL
OLDRN:				;RETURN THE PREVIOUS RANDOM NO.
	MOV	DX,WORD PTR $RNDX	;FETCH LOW 16 BITS
	MOV	BL,BYTE PTR $RNDX+2	;FETCH HIGH 8 BITS
	XOR	AX,AX		;CLEAR OVERFLOW BYTE (AH)
	MOV	AL,LOW 200	;EXPONENT OF 0
	MOV	BYTE PTR $FAC,AL
	MOV	BYTE PTR $FAC+1,AH	;POSITIVE SIGN
	JMP	$NORMS		;GO NORMALIZE

	SUBTTL	 $ROUND  DOUBLE PRECISION ROUND ROUTINE
;*****************************************************************
;
;       $ROUND  ROUND THE DOUBLE PRECISION FLOATING POINT NUMBER IN
;               $FAC+1 THRU $DFACL-1.
;       CALLING SEQUENCE:       CALL    $ROUND
;               WITH NUMBER IN $FAC TO BE ROUNDED
;
;******************************************************************

$ROUND:			;DOUBLE PRECISION ROUND AND PACK
	MOV	BX,OFFSET $DFACL-1
	ADD	WORD PTR 0[BX],200	;ADD TO HIGH BIT OV OVERFLOW BYTE
	MOV	CX,3		;3 MORE BYTES TO LOOK AT POTENTIALLY
	JNB	RDD20		;IF CF=0 WE ARE DONE
RDD10:	INC	BX
	INC	BX
	INC	WORD PTR 0[BX]	;IF THIS GETS ZF=1 THEN CARRY
	JNZ	RDD20		;FINISHED WHEN ZF=0
	LOOP	RDD10
	INC	BYTE PTR $FAC	;MUST INCREMENT EXPONENT
	RCR	WORD PTR 0[BX],1	;SET HIGH BYTE TO 200
RDD20:
	JZ	RDD30		;OVERFLOW HOOK
	TEST	BYTE PTR $DFACL-1,LOW 377	;SEE IF OVERFLOW BYTE ZERO
	JNZ	$ROUNX
	AND	BYTE PTR $DFACL,LOW 376 ;MAKE ANSWER EVEN
$ROUNX:
	AND	BYTE PTR $FAC-1,LOW 177 ;CLEAR SIGN BIT
	MOV	AL,BYTE PTR $FAC+1	;FETCH SIGN BYTE
	AND	AL,LOW 200	;CLEAR ALL BUT SIGN
	OR	BYTE PTR $FAC-1,AL	;AND SET SIGN APPROPRIATELY
	RET
RDD30:	JMP	$OVFLS

	SUBTTL	 $ROUNS  INTEL 8086 ROUNDING SUBROUTINE
;***********************************************************
;
;       $ROUNS  SINGLE PRECISION ROUNDING SUBROUTINE
;       CALLING SEQUENCE:       CALL    $ROUNS
;       ASSUMPTIONS:    (BLDXAH)WILL BE ROUNDED BY ADDING
;                       128 TO (AH) . IF CF (CARRY) IS SET
;                       AND (AH) IS NON-ZERO AFTER THIS
;                       ADDITION (BLDX) WILL BE INCREMENTED
;                       ONCE ROUNDING IS COMPLETE, LOGIC WILL
;                       CONTINUE INTO PAKSP FOR PACKING THE MANTISSA
;                       AND SIGN INTO THE FAC.
;
;**************************************************************

$ROUNS: AND	AH,LOW 340	;CLEAR SUPERFLUOUS BITS
$ROUNM: ADD	AH,LOW 200	;ADD TO MOST SIG. BIT OF AH
	JNB	PAKSP		;IF NO CARRY RETURN
	PUSHF			;IF ZF=1 WANT TO ROUND TO EVEN
	INC	DX		;IF ZF=1 MUST INCREMENT BL
	JNZ	TSTEVN
	POPF			;KNOW RESULT WILL BE EVEN
	INC	BL		;IF ZF=1 MUST INCREMENT EXPONENT
	JNZ	PAKSP
	STC			;CF=1
	RCR	BL,1		;THIS WILL SET HIGH BIT OF BL
	INC	BYTE PTR $FAC	;IF THIS CAUSES ($FAC)=0 WE HAVE
				;OVERFLOW IN ROUNDING
	JNZ	PAKSP
	JMP	$OVFLS
TSTEVN: POPF			;IF ZF=1 MUST CLEAR LOW BIT OF DL
	JNZ	PAKSP		;GO PACK THE FAC
	AND	DL,LOW 376	;CLEAR LOW BIT
PAKSP:				;PAK SINGLE PRECISION FAC. EXPONENT IS IN FAC,SIGN IN FAC+1
				;THE MANTISSA IS IN (BLDX)
	MOV	SI,OFFSET $FAC-3	;LOAD ADDRESS OF $FAC IN SI
	MOV	WORD PTR 0[SI],DX	;MOVE LOWER MANTISSA WORD IN
	INC	SI		;INCREMENT TO HIGH MANTISSA BYTE
	INC	SI		;
	MOV	BH,BYTE PTR $FAC+1	;FETCH SIGN
	AND	BX,100177	;CLEAR ALL BUT SIGN IN BH SIGN IN BL
	OR	BL,BH		;(BL) NOW IN CORRECT FORMAT
	MOV	BYTE PTR 0[SI],BL	;PUT INTO FAC-1
	RET

	SUBTTL	 $SIGD	 CALCULATE SIGNIFICANT DIGITS FOR $FOUT
;**************************************************************
;
;       $SIGD   WHEN $FOUT IS DETERMINING WHETHER TO PRINT
;               A NUMBER IN SCIENTIFIC NOTATION OR FIXED POINT
;               IT NEEDS TO KNOW THE NUMBER OF SIGNIFICANT DIGITS
;               IF THE NUMBER IS LESS THAN .01 .
;               PRIOR TO CALLING $SIGD, $FOUT HAS BRACKETED THE
;               SIGNIFICANT DIGITS VIA $FOUNV. THE NUMBER IN THE
;               FAC WILL BE AXXXXXX OR AXXXXXXXXXXXXXXX WHERE A IS
;               NON-ZERO. $SIGD'S JOB IS TO DETERMINE HOW MANY OF
;               THESE X'S STARTING FROM THE RIGHT ARE ZERO
;               PRIOR TO A NON-ZERO X. FOR EACH ZERO X, $SIGD WILL
;               INCREMENT (CL).
;       CALLING SEQUENCE:       CALL    $SIGD
;
;*******************************************************************

$SIGD:				;(CL)=(CL)+1 FOR EACH ZERO DIGIT STARTING FROM
				;THE RIGHT . ASSUMES $FOUNV HAS PREVIOUSLY OPERATED.
	MOV	SI,CX		;SAVE CX
	CALL	$VPSHF		;PUSH EITHER 4 OR 8 BYTES OF $FAC
				;ON THE STACK ACCORDING TO $VALTP
	MOV	CX,SI		;MUSU MAINTAIN (CL)
	PUSH	CX
;**************************************************************
;FIRST THING WE'LL DO IS ROUND THE FAC AND MAKE SURE WE
;STILL HAVE AN INTEGER.
;***************************************************************
;*****************************************************************
;IF WE ALREADY HAVE AN EXACT INTEGER DON'T WANT TO ADD .5 HERE
;*****************************************************************
	CALL	$GETYP
	JB	SI31		;JUMP IF SINGLE PREC
	CMP	BYTE PTR $FAC,LOW 270	;IF EQUAL OR SF=0 THEN INTEGER ALREADY
	JNS	SI20		;DON'T ADD .5
	JMP	SHORT SI32	;PROCESS FAC NORMALLY
SI31:	CMP	BYTE PTR $FAC,LOW 230	;IF SF=0 THEN INTEGER ALREADY
	JNS	SI20
SI32:	CALL	$VADDH		;ADD .5 TO FAC
	CALL	$VINT		;MAKE SURE WE STILL HAVE AN INTEGER
SI20:
	MOV	BX,OFFSET $ZLO	;FETCH ADDRESS OF Z INTO (BX)
	CALL	$VMVMF		;MOVE FAC TO Z , Z=INT(FAC+.5)
	POP	CX		;GET (CL) BACK
SI30:	PUSH	CX		;SAVE CX FOR LATER
	MOV	DI,OFFSET $Z1LO ;GET ADDRESS OF Z1
	MOV	BX,OFFSET $ZLO	;GET ADDRESS OF Z
	CALL	$VMOVM		;Z1=Z
	MOV	BX,OFFSET $ZLO	;FETCH ADDRESS OF Z
	CALL	$VMVFM		;MOVE Z TO FAC
	CALL	$DIV10		;FAC=Z/10
	CALL	$VINT		;FAC=INT(Z/10)
	MOV	BX,OFFSET $ZLO
	CALL	$VMVMF		;Z=INT(Z/10)
	CALL	$MUL10		;FAC=INT(Z/10)*10
	MOV	BX,OFFSET $Z1-1 ;ADDRESS OF Z1-1
	CALL	$GETYP		;NEED TO DECREMENT BX IF S.P.
	JNB	SI35
	SUB	BX,4		;NOW (BX) POINTS TO S.P.
SI35:
	CALL	$VCMPM		;COMPARE TO FAC
	POP	CX		;GET SIGNIFICANT DIGIT COUNT BACK
	JNZ	SI40		;THROUGH WHEN NON-ZERO
	INC	CL		;(CL)=(CL)+1
	JMP	SHORT SI30	;LET'S GO SEE IF WE CAN FIND ANOTHER
SI40:	MOV	BP,CX		;SAVE CX
	CALL	$VPOPF		;RESTORE ORIGINAL FAC
	MOV	CX,BP		;RESTORE CX


	RET
CSEG	ENDS
	END			;END MATH86.MAC