Skip to content
This repository has been archived by the owner. It is now read-only.

/ GW-BASIC Archived

Permalink
master
Switch branches/tags

GW-BASIC/MATH2.ASM

Go to file
 
 
Cannot retrieve contributors at this time
1883 lines (1813 sloc) 69.8 KB
Raw Blame
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 -1[SI],LOW 220 ;SET EXPONENT TO 16
MOV BYTE PTR 0[SI],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: DB 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
MOVS ?CSLAB,WORD PTR ?CSLAB
;FETCH FROM CODE SEGMENT
MOVS ?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