Trailing-Edge
-
PDP-10 Archives
-
BB-4170G-SM
-
sources/mflout.mac
There are 48 other files named mflout.mac in the archive. Click here to see a list.
;<3-MONITOR>MFLOUT.MAC.26, 7-Nov-77 13:04:08, EDIT BY KIRSCHEN
;MORE COPYRIGHT UPDATING...
;<3-MONITOR>MFLOUT.MAC.25, 12-Oct-77 13:59:34, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-MONITOR>MFLOUT.MAC.24, 2-May-77 21:38:08, EDIT BY BOSACK
;<3-MONITOR>MFLOUT.MAC.23, 23-Jan-77 15:07:55, Edit by MCLEAN
;<3-MONITOR>MFLOUT.MAC.22, 27-Dec-76 17:34:53, EDIT BY HURLEY
;<3-MONITOR>MFLOUT.MAC.21, 30-Nov-76 01:43:23, Edit by MCLEAN
;<3-MONITOR>MFLOUT.MAC.20, 26-Nov-76 02:33:50, Edit by MCLEAN
;<2MONITOR>MFLOUT.MAC.18, 19-JAN-76 12:20:46, EDIT BY MURPHY
;<2MONITOR>MFLOUT.MAC.17, 23-DEC-75 12:52:05, EDIT BY LEWINE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976, 1977, 1978 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH PROLOG,MONSYM,MACSYM
TTITLE FLOUT
SALL
SWAPCD
;FLOATING POINT OUTPUT CONVERSION AND FORMATTING ROUTINES
IFNDEF MONFLG,<MONFLG==1>
;FLOUT IS ASSEMBLED FOR MONITOR OR USE TESTING DEPENDING ON STATE OF
;MONFLG, 1 FOR MONITOR
INTERN .DFOUT,.FLOUT,DXP.
EXTERN EDFAD.,EDFMP.,EDFDV.
EXTERN MENT0,MRETN
EXTERN BOUTA
;VARIABLES FOR FLOUT WHICH ARE SAVED ON STACK
CBD==0
CAD==1
SAVDIG==2
DX==3
CEXP==4
CFILL==5
BKSTK=15 ;BACKPOINTER TO STACK, USED AS INDEX FOR VARIABLES
;LEFT HALF OF BKSTK USED TO STORE ERROR NUMBER
P=17 ;CONTROL PUSHDOWN
EOL==37 ;END-OF-LINE CHARACTER
;FLOUT., THE NUMBER PRINTING ROUTINE FOR TENEX.
;
;TAKS EX RANGE DOUBLE PRECISION FLOATING POINT NUMBER IN AC'S A AND
;A+1.
;STANDARD ("FREE") FORMAT USES DIGIT COUNT IN AC "SIG".
;"IN FORM" OUTPUT USES NUMBER OF DIGITS SPECIFIED BY FORMAT CTRL ARG.
;FLOUT. IS TRANSPARENT TO AC'S 12,15,17 AND CLOBBERS ALL OTHERS.
;EXTERNAL VARIABLES USED
;TEM STORAGE LOACTIONS USED (EXTERNAL BECUASE REENTRANT):
;CBD(BKSTK) COLUMNS IN FORMAT BEFORE DECIMAL POINT
; (NUMBER OF #'S LESS 1 IF NEEDED FOR "-")
;CAD(BKSTK) COLUMNS AFTER POINT (NUMBER OF #'S AFTER POINT)
;SAVDIG(BKSTK) DIGIT SAVED FOR USED AFTER C(ZERS) ZEROES PRINTED ("DIGIT")
;DX(BKSTK) DECIMAL EXPONENT OF NUMBER
;AC USE IN FLOUT AND ITS SUBRS (PARENS ENCLOSE SUBR NAMES)
;0: FLOATING FORMAT WORD
;1: CHARACTER (FIELD, LCH), DIGIT DURING PRINTING
DIG==1
;2 CLOBBERED BY LCH, LATER NUMBER OF DIGITS TO PRINT
NDP==2
DF==3 ;FLOUT'S INTERNAL FLAGS (NEXT PAGE)
BX==4 ;BINARY EXPONENT (DXP). BX+1 IS ALSO USED.
DBD=4 ;NUMBER OF DIGITS TO PRINT BEFORE DECIMAL POINT
DAD=5 ;...AFTER
ZERS=6 ; # OF LEADING ZEROS BEFORE (ADDITIONAL) SIGNIF DIGITS (DIGIT)
MINF==7 ;AC FOR MINIMUM POWER OF TEN FOR F FORMAT CASE OF G FORMAT
MAXF==10;...MAXIMUM
M=10 ;MEMORY OPERAND POINTER FOR FLOATING POINT ROUTINES
A=12 ;A AND A+1 HOLD NUMBER DURING NORMALIZATION AND PRINTING
;A MUST BE SAME AS USED BY FLOATING POINT ROUTINES.
T==11 ;GENERAL TEMPORARY. 11 IS CLOBBERED BY EDFPT ROUTINES (3/7/69).
;14 IS CLOBBERED IN EDFPT ROUTINES (3/7/69)
;FLAGS USED IN DF. THOSE IN LH RELATE TO FORMAT SPECIFICATIONS:
;1 "-"
;2 "+"
;4 "*"
;10 "0"
;20 "$"
;40 "."
;100 PRINT EXPONENENT VALUE
;200 PRINT "E" IF 100 SET
;400 PRINT "*10^" IF 100 SET
;1000 PRINT "D" IF 100 SET
;2000 FIRST CHAR POS EXP ALWAYS SIGN
;4000 FIRST CHAR POS EXP SPACE ON POS #
;10000 B0,1 OF FORMAT CONTROL 01 OR 11
;20000 WRAP AROUND FIELD 1 FOR LEFT JUSTIFICATION
;40000 PRINT AT LEAST ONE DIGIT IN FIELD 1
;400000 SUPPRESS LEADING SPACES IN FREE FORMAT
;FLAGS IN RH OF DF
;1 NUMBER IS NEGATIVE
;2 SUPPRESS TRAILING ZEROS, NON-SIG ".", AND SPACE AND 0 IN EXPONENT
;4 NUMBER ALREADY ROUNDED ("ROUND" CAN GET CALLED TWICE)
;10 SET IF ON SECOND SCAN TO FIND FIELD (FOR "NO FIELDS" ERROR MSG)
;20 DO OUTPUT ON COLUMN OVERFLOW
;40 *'S TO FILL FIELD, COLUMN OVERFLOW
;100 FORCED FREE FORMAT OR EXPANDED EXPONENT
;B18-B22 RESERVED FOR PRECISION SPEC
.DFOUT: IFG MONFLG,<MCENT >
MOVE A,2
MOVE A+1,3
MOVE 0,4
PUSHJ P,FLOUT.
JRST DFOUTX
AOS -1(P)
.DFOT1: IFG MONFLG,<
JRST MRETN>
IFLE MONFLG,<
POPJ P,>
DFOUTX: IFG MONFLG<
UMOVEM P5,4>
JRST .DFOT1
.FLOUT: IFG MONFLG,<MCENT >
MOVE A,2
SETZ A+1,
MOVE 0,3
PUSHJ P,FLOUT.
JRST FLOUTX
AOS -1(P)
.FLOT1: IFG MONFLG,<
JRST MRETN>
IFLE MONFLG,<
POPJ P,>
FLOUTX: IFG MONFLG,<
UMOVEM P5,3>
JRST .FLOT1
IFG MONFLG,<
.CO: PUSH P,2
MOVE 2,DIG ;CHARACTER FOR OUTPUT GOES IN 2
UMOVE 1,1 ;DEST DESIG'RET GOES IN 1
PUSHJ P,BOUTA ;BOUT WITHOUT CHANGING CLFMMON FLAG
MOVE DIG,2
POP P,2
POPJ P,
>
IFLE MONFLG,<
.CO: PBOUT
POPJ P,>
ILLFMT: MOVEI P5,FLOTX3
CALL FIXSTK ;FIX UP THE STACK THEN RETURN
POPJ P,0
RGOOD: AOS (P)
RBAD: POPJ P,0
TOOSML: MOVEI P5,FLOTX1
CALL FIXSTK ;FIX UP THE STACK FIRST
TRNE DF,100 ;SHOULD BE IMPOSSIBLE FOR FORCED FREE OR EXP
;EXPAND TO GET HERE BUT AVOID POSSIBLE DISASTERS
JRST RGOOD ;REALLY BAD RETURN EFFECTIVELY
TRNN DF,20
POPJ P, ;NO OUTPUT ON COLUMN OVERFLOW
TLZ DF,777777 ;FORCED FREE OUTPUT, COLUMN OVERFLOW
TRZ DF,777772
TRO DF,100 ;SET FORCED FLAG
SETZ 0, ;AND FORCE FREE
SOS (P) ;FORCE BAD RETURN
CALL UPSTK
JRST FLOUTF ;AND GO AGAIN
EXPOVF: MOVEI P5,FLOTX2
CALL FIXSTK ;FIX UP THE STACK
TRNE DF,100
JRST RGOOD ;AGAIN REALLY BAD RETURN EFFECTIVELY
TRNN DF,20
POPJ P, ;NO ADDITIONAL OUTPUT, COLUMN OVERFLOW
TRO DF,100 ;SET FORCED EXP EXPAND FLAG
SOS (P) ;FORCE BAD RETURN
CALL UPSTK
MOVEI T,5
MOVEM T,CEXP(BKSTK)
JRST PX0
UPSTK: POP P,T
XMOVEI BKSTK,1(P) ;BACKPOINTER TO STACK
ADD P,BHC+6 ;NOW UPDATE STACK POINTER BY 6
IFG MONFLG,<
EXTERN MSTKOV
JUMPGE P,MSTKOV>
JRST 0(T)
;TENEX NUMERIC OUTPUT ROUTINE, COMMENTS ON PREVIOUS 2 PAGES
FLOUT.: SETZ DF, ;CLEAR ALL .FLOUT'S INTERNAL FLAGS
SKIPGE A
TRO DF,1 ;FLAG FOR NEGATIVE ARGUMENT
TRNE DF,1
DFN A,A+1 ;MAKE ARGUMENT POSITIVE
CALL UPSTK
;CONVERT ARGUMENT TO DECIMAL EXPONENT IN DX(BKSTK) AND FRACTION IN A, A+1
CALL DXP
;IS OUTPUT TO BE FREE FORMAT?
FLOUTF: TRNE 0,77B23 ;0 SPEC FOR FIELD 1 IMPLIES FREE
JRST DECODE ;NO
;THE NEXT 5 INSTRUCTIONS DETERMINE TENEX'S STANDARD FORMAT.
MOVNI MINF,3 ;USE F FORMAT IF ARG >=10^-3 AND
MOVEI MAXF,6 ;...<=10^6, OTHERWISE USE E FORMAT.
LDB NDP,[POINT 5,0,17]
SKIPN NDP
MOVEI NDP,^D7 ;STANDARD NUMBER OF SIGNIFICANT DIGITS
TLO DF,400201 ;PRINT "E" IF EXPONENT PRINTED,
;PRINT SPACE IF POSITIVE, "-" IF NEGATIVE
TLNE 0,(1B6) ;POINT REQUESTED?
TLO DF,40 ;YES, FORCE IT
TRO DF,2 ;SUPPRESS TRAILING ZEROS, POINT, ETC.
MOVEI T,4
MOVEM T,CEXP(BKSTK)
JRST G ;TO G FORMAT ROUTINE
DECODE: SETZM CBD(BKSTK)
LDB T,[POINT 2,0,1]
SKIPE T
SOS CBD(BKSTK) ;SIGN WILL ALWAYS BE PRINTED SO LEAVE SPACE
CAIN T,2
TLO DF,2 ;ALWAYS PRINT SIGN
TRNE T,1
TLO DF,10001
DCODE1: LDB T,[POINT 2,0,3]
CAIN T,0
JRST DCODE2 ;NORMAL SPACE FILL TO LEFT
CAIN T,1
TLO DF,10 ;0 FILL
CAIN T,2
TLO DF,4 ;* FILL
CAIN T,3
TLO DF,20000 ;WRAP AROUND FIELD 1
DCODE2: TLNE 0,(1B4)
TLO DF,40000 ;PRINT AT LEAST ONE DIGIT FIELD
TLNN 0,(1B5)
JRST .+3
SOS CBD(BKSTK)
TLO DF,20 ;$ PREFIX
TDNE 0,[1B6+77B29] ;FIELD 2 OR POINT REQUESTED?
TLO DF,40 ;YES, PRINT POINT
SETZM CEXP(BKSTK)
LDB T,[POINT 2,0,8]
CAIE T,0
JRST .+4
TRNE 0,77
JRST ILLFMT ;ROOM IN FIELD 3 BUT NO EXP DESIRED
JRST DCODE5 ;NO EXP FIELD
TLO DF,100
TRNN 0,76
JRST ILLFMT ;NO ROOM FOR EXP
CAIN T,1
TLO DF,200 ;PRINT E THEN EXP
CAIN T,2
TLO DF,1000 ;PRINT D THEN EXP
SOS EXP
CAIE T,3
JRST DCODE4
TRNN 0,74
JRST ILLFMT ;NO ROOM
HRROI T,-3
ADDM T,CEXP(BKSTK)
TLO DF,400 ;"*10^" THEN EXP
DCODE4: LDB T,[POINT 2,0,10]
CAIN T,0
JRST DCODE5 ;NORMAL EXP FIELD
CAIN T,1
TLO DF,2000 ;FIRST CHAR POS EXP ALWAYS SIGN
CAIN T,2
TLO DF,4000
DCODE5: TLNN 0,(1B11)
JRST DCODE6 ;NO OUTPUT COLUMN OVERFLOW
TRO DF,20
TLNE 0,(1B12)
TRO DF,40
DCODE6: LDB T,[POINT 6,0,23]
ADDM T,CBD(BKSTK)
LDB T,[POINT 6,0,29]
MOVEM T,CAD(BKSTK)
LDB T,[POINT 6,0,35]
ADDM T,CEXP(BKSTK)
LDB T,[POINT 5,0,17]
DPB T,[POINT 5,DF,22]
;BEGINNING OF SECTION TO SET UP PRINTING PARAMETERS (DBD,DAD,ZERS),
;AS A FUNCTION OF FORMAT SPECIFIED AND OF THE VALUE OF THE ARGUMENT
;FIRST, IF THE NUMBER IS NEGATIVE BUT FORMAT CONTAINED NEITHER + NOR -,
;REDUCE COLUMNS BEFORE POINT BY 1 TO ALLOW FOR - SIGN.
TRNE DF,1 ;TEST FOR NOT NEGATIVE
TLNE DF,3
JRST SETU1 ;"+" OR "-" IN FORMAT
SOSLE CBD(BKSTK) ;REDUCE COLUMNS LEFT FOR DIGITS BEFORE POINT
JRST SETU1 ;STILL SPACE FOR AT LEAST ONE DIGIT B4 . .
;EXPAND FIELD IF NECESSARY TO MAKE ROOM FOR -
SKIPE CBD(BKSTK) ;WAS THERE A COLUMN BEFORE POINT ?
SETZM CBD(BKSTK) ;NO, COULD MAKE ERROR COMMENT HERE.
SKIPG CAD(BKSTK) ;ARE THERE ANY COLUMNS AFTER POINT ?
AOS CBD(BKSTK) ;NO, PUT ONE BEFORE POINT
;GO TO F FORMAT ROUTINE IF NO EXPONENT WAS SPECIFIED IN FORMAT
SETU1: TLNN DF,100
JRST FUM
;SET UP FOR E FORMAT: OUTPUT WITH EXPONENT
SETZ ZERS, ;NO LEADING ZEROS
MOVE DBD,CBD(BKSTK) ;USE ALL AVAILABLE COLUMNS BEFORE POINT,
MOVE DAD,CAD(BKSTK) ;AND AFTER.
JUMPE A,EZER ;TEST FOR ZERO ARGUMENT
MOVN T,DBD ;REDUCE EXPONENT FOR DIGITS BEFORE POINT
ADDM T,DX(BKSTK)
E1: MOVE NDP,DBD
ADD NDP,DAD ;COMPUTE # SIG DIGITS = # DIGITS BEING PRINTED
CALL ROUND ;ROUND CO NDP DIGITS
JRST .+1 ;OV DURING ROUND, HANDLING IN ROUND IS OK.
JRST PRINT ;GO PRINT NUMBER
EZER: SETZ DBD,
TLNE DF,40000
MOVEI DBD,1 ;NUMBER IS ZERO, PRINT ONE 0 BEFORE POINT,
JRST E1 ;LEAVE EXPONENT ZERO.
;F FORMAT - NO EXPONENT.
FUM: SKIPG DBD,DX(BKSTK) ;TEST FOR NBR <1. IF >=1, EXPONENT IS DIGS B4 "."
JRST FSMAL
CAMLE DBD,CBD(BKSTK)
JRST TOOSML ;FIELD ONE TOO SMALL
MOVE DBD,DX(BKSTK) ;EXPONENT IS NUMBER OF DIGITS BEFORE .
SETZ ZERS, ;NO LEADING ZEROES
MOVE DAD,CAD(BKSTK) ;USE ALL COLUMNS AFTER DECIMAL FOR DIGITS
JRST FROUN ;GO ROUND
FSMAL: SETZ DBD, ;DX(BKSTK) <= O. NO DIGITS BEFORE POINT.
MOVM ZERS,DX(BKSTK) ;LEADING ZEROS=MIN(ABS(DX(BKSTK)),CAD(BKSTK))
CAMLE ZERS,CAD(BKSTK) ;..
MOVE ZERS,CAD(BKSTK) ;..
MOVE DAD,CAD(BKSTK) ;FIELD AFTER . IS DIGITS. (DAD INCLUDES 0S)
;IF NUMBER IS ZERO, OR IF NO COLUMNS AFTER "." (ALL NUMBERS HERE ARE <1),
;THEN PRINT ONE ZERO BEFORE ".".
TLNE DF,40000
JRST .+3
JUMPE A,.+2 ;NUMBER ZERO?
SKIPN CAD(BKSTK) ;NO, ARE THERE NO COLUMNS AFTER . ?
SKIPG CBD(BKSTK) ;YES (ON ONE OR THE OTHER), ANY SPACE BEFORE .?
JRST FROUN
AOS DBD ;YES, SAY PRINT A DIGIT BEFORE .
AOS ZERS ;MAKE THAT DIGIT A ZERO.
FROUN: MOVE NDP,DBD ;COMPUTE # SIG DIGITS = # DIGS BEFORE POINT,
ADD NDP,DAD ;...PLUS NUMBER AFTER.,
SUB NDP,ZERS ;...MINUS LEADING ZEROS
CALL ROUND ;ROUND TO NDP DIGITS AND SKIP UNLESS OVERFLOW
JRST FUM ;ON ROUNDING OVERFLOW MUST RE-SETUP FORMAT.
JRST PRINT ;GOOD RETURN, GO PRINT NUMBER.
;"G FORMAT" - THAT IS USE F FORMAT IF NUMBER IN RANGE, OTHERWISE E
;FORMAT. USED FOR TENEX STANDARD FORMAT, INCLUDING MODIFIED
;STANDARD FORMAT FOR "PLOT ON" COMMAND. USES FORMAT
;SUCH THAT DECIMAL POINTS OF ALL NUMBERS LINE UP (FOR SAME MINF,MAXF).
;AC'S THAT MUST BE SET BEFORE COMING HERE:
; MINF: SMALLEST POWER OF TEN FOR F FORMAT
; MAXF: LARGEST DITTO
; NDP: NUMBER OF SIGNIFICANT DIGITS TO PRINT
;ALSO FLAGS IN DF SHOULD BE PRESET FOR SUPPRESSION, *10^, POINT, ETC.
G: CALL ROUND ;ROUND TO NDP DIGITS 1ST CAUSE CAN CHANGE DX.
JRST .+1
MOVEM MAXF,CBD(BKSTK) ;COLUMNS BEFORE DECIMAL (E OR F FORMAT)
MOVE T,NDP ;NDP-DX(BKSTK) COLUMNS AFTER POINT IS EXACTLY ENOUGH
SUB T,DX(BKSTK) ;FOR A TOTAL OF NDP DIGITS.
MOVEM T,CAD(BKSTK)
CAMG MINF,DX(BKSTK)
CAMGE MAXF,DX(BKSTK)
JRST .+2
JRST FUM ;DECIMAL EXPONENT IN RANGE, USE F FORMAT
MOVEI DBD,1 ;E FORMAT REQUIRED. 1 DIGIT BEFORE POINT.
MOVEI DAD,-1(NDP) ;REST OF DIGITS AFTER POINT.
SOS DX(BKSTK) ;REDUCE EXPONENT BECUASE OF THE DIGIT BEFORE .
SETZ ZERS, ;NO LEADING ZEROS
TLO DF,100 ;SAY PRINT EXPONENT
;NOW PRINT THE NUMBER. THE ORDER OF THINGS IS:
; LEADING BLANKS IF NO * NOR 0'S SPECIFIED,
; SIGN, * OR 0 FILL, $,
; DIGITS, POINT, MORE DIGITS,
; E OR "*10^", EXPONENT SIGN, EXPONENT MAGNITUDE.
PRINT: MOVE T,CBD(BKSTK) ;NUMBER OF FILL CHARACTERS = COLUMNS BEFORE POINT
SUB T,DBD ;...MINUS DIGITS BEFORE POINT.
MOVEM T,CFILL(BKSTK)
JRST PR1
;FILL WITH SPACES IF NEITHER * NOR 0'S SPECIFIED AND NOT SUPPRESSED
MOVEI DIG," "
TLNN DF,420000 ;FLAG TO SUPPRESS LEADING SPACES
CALL .CO ;PRINT A SPACE
PR1: TLNN DF,14 ;SKIP IF * OR 0 SPECIFIED
SOJGE T,.-4
;SIGN: - IF NEGATIVE, "+", " ", OR NOTHING IF PLUS.
TRNE DF,1 ;IS NUMBER NEGATIVE?
JRST PR2 ;YES
TLNE DF,500000 ;"NO LEADING SPACES" MODE?
JRST PR4 ;YES, PRINT NOTHING FOR SIGN OF POS NUMBER.
MOVEI DIG," "
TLNE DF,1
CALL .CO ;SPACE FOR "-" IN FORM
MOVEI DIG,"+"
TLNE DF,2
CALL .CO ; + FOR + IN FORM IF NUMBER +
JRST PR4
PR2: MOVEI DIG,"-" ; - FOR ANY NEGATIVE NUMBER
CALL .CO
JRST PR4
;FILL WITH * OR 0 IF SO SPECIFIED (COUNT SET UP IN T ABOVE)
PR3: TLNE DF,20000 ;TRAILING BLANKS?
JRST PR4+1 ;YES
MOVEI DIG,"*"
TLNE DF,4
CALL .CO ; * FILL
MOVEI DIG,"0"
TLNE DF,10
CALL .CO ; 0 FILL
PR4: SOJGE T,PR3
; $ IF SPECIFIED
MOVEI DIG,"$"
TLNE DF,20
CALL .CO
;DIGITS, POINT, AND MORE DIGITS:
;ON FLAG SUPPRESS TRAILING 0'S AFTER . AND . IF ONLY 0'S AFTER IT.
SETZM SAVDIG(BKSTK);INIT DIGIT ROUTINE: MAKES SURE LAST LEADING 0 IS 0
JRST PR6
PR5: CALL DIGIT ;DIGITS BEFORE POINT
JRST .+1 ;PRINT NON-SIGNIFICANT ZEROES BEFORE POINT
ADDI DIG,60 ;CONVERT TO ASCII THEN PRINT
CALL .CO
PR6: SOJGE DBD,PR5
CALL DIGIT ;GET NEXT DIGIT, SKIP IF SIGNIFICANT
TLNE DF,40 ;NOT SIG'CANT, POINT REQUESTED ANYHOW?
CAIA
JRST PEXP ;PRINT NO POINT OR FRACTION PART
PUSH P,DIG ;SAVE DIGIT
MOVEI DIG,"."
CALL .CO ;PRINT POINT
POP P,DIG
JRST PR8
PR7: ADDI DIG,60 ;PRIN DIGIT
CALL .CO
CALL DIGIT ;DIGITS AFTER POINT
JRST PEXP ;ON SUPPRESSED TRAILING 0 GO DO EXPONENT
PR8: SOJGE DAD,PR7
;PRINT EXPONENT IF SPECIFIED
PEXP: TLNN DF,100 ;FLAGS 200 OR 400 WO 100 MUST BE IGNORED.
JRST PX6 ;NO EXPONENT, DONE PRINTING
TLNN DF,6000
SKIPGE DX(BKSTK)
SOS CEXP(BKSTK)
MOVM 1,DX(BKSTK)
SETZ T,
IDIVI 1,^D10
AOS T
JUMPG 1,.-2
CAMLE T,CEXP(BKSTK)
JRST EXPOVF
PX0: TLNN DF,400 ;"*10^" FLAG OVERIDES E FLAG.
JRST PX1
MOVEI DIG,"*"
CALL .CO
MOVEI DIG,"1"
CALL .CO
MOVEI DIG,"0"
CALL .CO
MOVEI DIG,"^"
CALL .CO
JRST PX2
PX1: MOVEI DIG,"E"
TLNE DF,200 ;200 BUT NOT 400 SAYS PRINT "E"
CALL .CO
MOVEI DIG,"D"
TLNE DF,1000
CALL .CO
;EXPONENT SIGN: SUPPRESS PLUS IF "SUPPRESS" FLAG ON
PX2: MOVE 1,DX(BKSTK) ;GET EXPONENT
JUMPL 1,PX3
MOVEI DIG," "
TLNE DF,4000
CALL .CO
MOVEI DIG,"+"
TRNE DF,2
JRST .+3
TLNE DF,2000 ;SIGN ALWAYS IN EXP?
CALL .CO
MOVE 1,DX(BKSTK)
JRST PX4
PX3: MOVEI DIG,"-"
CALL .CO
MOVM 1,DX(BKSTK) ;TAKE ABSOLUTE VALUE OF EXPONENT
;PRINT EXPONENT VALUE: LEADING 0'S IF NOT SUPPRESSED.
PX4: MOVE 0,DF
MOVE 2,1
IFLE MONFLG,<
MOVEI 1,101>
SETZ 3,
TRNN 0,2
HRL 3,CEXP(BKSTK)
HRRI 3,^D10
TLO 3,400000
TRNN 0,2
TLO 3,140000
IFLE MONFLG,<
NOUT>
IFG MONFLG,<
EXTERN NOUTXX
CALL NOUTXX>
JFCL ; CAN'T FAIL
MOVE DF,0
PX6: TLNN DF,20000
JRST PDONE
MOVE T,CFILL(BKSTK)
JRST PX5
MOVEI DIG," "
CALL .CO
PX5: SOJGE T,.-2
;PRINTING COMPLETE
PDONE: CALL FIXSTK
AOS (P)
POPJ P, ;RETURN
FIXSTK: POP P,M
SUB P,BHC+6
JRST 0(M) ;STACK NOW FIXED UP SO RETURN
;SUBROUTINE TO REDUCE NUMBER IN A AND A+1 TO DECIMAL EXPONENENT IN DX(BKSTK)
;AND FRACTION (DIGIT PART) IN A AND A+1, 1>FRACTION>=.1.
;METHOD IS TO DIVIDE OR MULTIPLY BY POWERS OF TEN UNTIL FRACTION IS IN
;RANGE. THEN DECIMAL EXPONENT IS SUM OF POWERS OF TEN USED.
;THIS SUBROUTINE IS USED INTERNALLY IN FLOUT
;AND EXTERNALLY IN XP AND DP FUNCTIONS.
;CLOBBERS AC "T"
DXP.: DXP: SE1CAL
HRRZS BKSTK
SETZM DX(BKSTK) ;START WITH 0 DECIMAL EXPONENT
SE1CAL
JUMPE A,DXPR ;IF NUMBER IS 0 WE'RE DONE
;FIRST GET NUMBER OUT OF EXPTENDED RANGE BY OPERATING WITH
;10^50 (A RANDOM NUMBER BETWEEN 10^38 AND 10^76). WE DON'T CARE HOW
;SLOW THIS IS, ESPECIALLY NUMBERS OVER 10^99.
DXP1: TLNN A+1,400000 ;EXTENDED RANGE ?
JRST DXP2 ;NO
MOVEI M,E50 ;OPERAND FOR MULTIPLY OR DIVIDE
TLNN A+1,200000 ;TEST SIGN OF EXTENDED EXPONENT, REMEMBERING
TLNN A+1,177000 ;THAT EXPONENTS 0-33 ARE "NEGATIVE"
JRST DXP1A
CALL EDFDV. ;EXPONENT POSITIVE, DIVIDE.
MOVEI T,^D50 ;EXPONENT POSITIVE, INCREASE DEC EXP
DXP1B: ADDM T,DX(BKSTK)
JRST DXP1
DXP1A: CALL EDFMP. ;EXPONENT NEGATIVE, MULTIPLY,
MOVNI T,^D50 ;AND DECREASE DECIMAL EXPONENT.
JRST DXP1B
;IN NON-EXTENDED RANGE TEST BITS OF BINARY EXPONENT TO DETERMINE POWER
;OF 10 TO USE. FOR EACH LOOP GET BINARY EXPONENT FROM NUMBER AND JFFO
;ON IT. TERMINATES ON BIN EXP OF 0, -1, OR -2, OR AFTER DIVIDING BY
;10 FOR BINARY EXPONENTS OF 1 OR 2 OR 3.
DXP2: HLLZ BX,A ;GET BINARY EXPONENT
TLZ BX,400777 ;..
TLZN BX,200000 ;CONVERT FROM EXCESS 128
JRST DXP4 ;EXECUTED IF EXPONENT NEGATIVE
JFFO BX,.+2
DXPR: RET ;DONE IF BIN EXP =0
MOVE T,IPTAB-1(BX+1) ;ADD POWER OF TEN TO DECIMAL EXPONENT
ADDM T,DX(BKSTK) ;..
LSH BX+1,1 ;TABLE HAS 2-WORD ENTRIES
MOVEI M,FPPTAB-2(BX+1) ;CHOOSE POWER OF TEN IN TABLE
CALL EDFDV. ;DIVIDE BY POWER OF TEN
CAMLE BX,[3000000000]
JRST DXP2
RET ;NOW DONE IF BIN EXP WAS 1,2,3 BEFORE DIVIDE
DXP4: TLO BX,600000 ;NEGATIVE EXPONENT. COMPLEMENT IT.
MOVN BX,BX
CAMG BX,[2000000000]
RET ;DONE IF BIN EXP IS -1 OR -2.
JFFO BX,.+1 ;FIND HIEST SET BIT IN MAGNITUDE OF EXPONENT
MOVN T,IPTAB-1(BX+1) ;SUBTRACT FROM DECIMAL EXPONENT
ADDM T,DX(BKSTK) ;..
LSH BX+1,1
MOVEI M,FPPTAB-2(BX+1)
CALL EDFMP. ;MULTIPLY BY POWER OF TEN
JRST DXP2
;POWERS OF TEN FOR DXP AS INTEGERS, IN ORDER, FOR EXPONENT BITS 1 THRU 8
IPTAB: DEC 38,19,9,4,2,1,1,1
;SAME POWERS OF 10 IN DOUBLE PRECISION FLOATING POINT
FPPTAB: OCT 377454732312,344413241535 ;10^38
OCT 300425434430,245110475000 ;10^19
OCT 236734654500,0 ;10^9
OCT 216470400000,0 ;10^4
OCT 207620000000,0 ;10^2
TEN: OCT 204500000000,0 ;10. THE LABEL "TEN" IS USED IN GETDIG.
OCT 204500000000,0,204500000000,0 ;2 MORE 10^S
E50: OCT 047421541661,401277144456 ;10^50
;SUBROUTINE TO ROUND FRACTION IN A,A+1 TO C(NDP) DIGITS.
;IF ROUNDING PRODUCES NUMBER >= 1, SUBSTITUTE .1 AND ADD
;1 TO DECIMAL EXPONENT IN DX(BKSTK) AND GIVE R1. R2 IN ALL OTHER CASES.
;ROUNDS AT 12TH DIGIT IF LARGER # DIGITS REQUESTED,
; BUT IF "PRECIS" >0, ALLOWS UP TO 14 DIGITS,
; OR IF <0, ROUNDS AT ACTUAL REQUEST OR NOT AT ALL IF REQUEST >17.
;NOP IF CALLED A SECOND TIME (2 CALLS OCCUR IF OV IN F FORMAT, AND ALWAYS
;IN F FORMAT CASE OF G FORMAT).
ROUND: SKIPG NDP ;CHECK FOR 0-COL FIELD
SKIPLE ZERS
JRST .+2
JRST TOOSML ;FIELD TOO SMALL
LDB T,[POINT 5,DF,22]
CAIN T,37
JRST ROUN1 ;NO MAXISUM IF PRECIS <0
TRNN T,37
MOVEI T,^D12 ;USUAL MAX NUMBER OF DIGITS
CAILE NDP,(T) ;COMPARE REUSTED # DIGITS TO MAXIMUM
MOVEI NDP,(T) ;REDUCE REQUEST TO MAX
ROUN1: TRON DF,4 ;SET "ROUNDED" FLAG AND SKIP IF WAS SET
CAILE NDP,^D17 ;NO ROUND FOR MORE THAN 17 DIGITS
JRST RGOOD
JUMPE A,RGOOD ;EXIT IF NUMBER IS ZERO
PUSH P,M ;MUST BE TRANS CAUSE M=MAXF
MOVE M,NDP
LSH M,1 ;TABLE INDEX IS TWICE # DIGITS
MOVEI M,RNDP(M)
CALL EDFAD. ;ADD 0.5 TIMES PROPER POWER OF TEN
POP P,M
CAMGE A,[201000000000] ;NUMBER NOW >= 1 ?
JRST RGOOD ;NO
MOVE A,PNT1 ;>=1. CHANGE TO 0.1
MOVE A+1,PNT1+1
AOS DX(BKSTK) ;INDEX EXPONENT
RET ;RETURN 1
PNT1: OCT 175631463146,142314631463 ;0.1
RNDP: OCT 200400000000,0 ;5*10^-1
OCT 174631463146,141314631462 ;5*10^-2
OCT 171507534121,136727024365 ; -3
OCT 166406111564,133570651767 ;-4
OCT 162643334272,127616103131 ;-5
OCT 157517436542,124161550740 ;-6
OCT 154414336750,121132755430 ;-7
OCT 150655376246,115536257220 ;-8
OCT 145527461670,112430214163 ;-9
OCT 142422701372,107023326450 ;-10
OCT 136667633766,103353675560 ;-11
OCT 133537657770,100274544450 ;-12
OCT 130431363140,075226752040 ;-13
OCT 124702270232,071044566400 ;-14
OCT 121550223341,066520453460 ;-15
OCT 116440165747,063563526053 ;-16
OCT 112715126245,057754211570 ;-17
OCT 107560736521,054443324452 ;-18
;OCT 144471113564,051351103524 ;-19
;DIGIT SUBROUTINE.
;SKIPS AND RETURNS DIGIT (0-11) IN DIG EXCEPT NO SKIP IF DIGIT IS
;TRAILING (NON-SIGNIFICANT) ZERO AND "SUPPRESS TRAILING 0'S" FLAG
;IS ON.
;METHOD: ON SEEING 0, CONVERTS ADDITIONAL DIGITS TO SEE IF ANY NO-0'S
;LEFT, STORES NUMBER OF INTERVENING ZEROES IN "ZERS", NON-0
;DIGIT THAT FOLLOWS ZEROS IN "SAVDIG(BKSTK)".
;AT ENTRY IF ZERS>0, ZERS IS DECREMENTED AND A 0 IS RETURNED EXCEPT
;IF ZERS WAS 1 SAVDIG(BKSTK) IS USED. ZERS IS ALSO PRESET TO
;NUMBER OF LEADING 0'S FOR NUMBERS SUCH AS .001 OR 0.0.
;ALWAYS GIVES ZEROES AFTER C(NDP) CALLS
DIGIT: JUMPE ZERS,DIG1 ;JUMP IF NO SAVED ZEROES TO OUTPUT
JUMPL NDP,RNSZ ;IF NO MORE SIG DIGITS, RETURN TRAILING 0
SOJG ZERS,PSZ ;GO PRINT SIGNIF 0 UNLESS COUNT USED UP
MOVE DIG,SAVDIG(BKSTK) ;PRINT SAVED DIGIT (THIS CELL IS INITIALLY ZERO)
JRST RGOOD
DIG1: SOJL NDP,RNSZ ;COUNT SIG DIGITS USED, RET 0 IF ALL GONE
CALL GETDIG ;GET NEXT DIGIT FROM FRACTION
JUMPN DIG,RGOOD ;R2 UNLESS ZERO
;ZERO SEEN. GET ADDITIONAL DIGITS TO SEE IF THIS 0 IS SIGNIFICANT OR NOT.
;"ZERS" IS ASSUMED 0 HERE BETTER BE 0, NOT -1 !!!
DZER1: AOS ZERS ;COUNT ZEROS FOR POSSIBLE LATER OUTPUT
SOJL NDP,RNSZ ;IF NO MORE DIGITS THIS ONE IS NON-SIGNIF
CALL GETDIG ;NEXT DIGIT
JUMPE DIG,DZER1 ;LOOP IF ZERO
MOVEM DIG,SAVDIG(BKSTK) ;FOUND SIG DIGIT TO PUT AFTER THE 0'S
PSZ: SETZ DIG, ;RETURN SIGNIFICANT ZERO OR UNSUPPRESSED ZERO
JRST RGOOD
;RETURN NON-SIGNIFICANT ZERO
RNSZ: SETZ DIG,
TRNE DF,2 ;SUPPRESS TRAILING ZEROES FLAG
JRST RBAD ;FLAG ON, NO SKIP
JRST RGOOD
;GET NEXT DIGIT FROM FRACTION.
;METHOD: MULTIPLY BY 10, SHIFT TO POSITION BINARY POINT, CHOP OFF
;4 BITS OF MANTISSA, PUT BACK A ZERO EXPONENT (NEEDN'T BE NORMALIZED).
GETDIG: MOVEI M,TEN
CALL EDFMP. ;FRACTION TIMES TEN
LDB DIG,[POINT 8,A,8] ;EXPONENT
TLZ A,777000 ;REMOVE HI-ORDER EXPONENT
ASH A+1,10 ; " LO " "
ASHC A,-200(DIG) ;LEFT SHIFT BY EXPONENT, PUTS BIN PT AFTER B8
LDB DIG,[POINT 8,A,8] ;INTEGER BITS ARE DIGIT
TLZ A,777000 ;CREAM INTEGER PART
TLO A,200000 ;SUPPLY EXPONENT OF 200
ASH A+1,-10
TLO A+1,145000 ;LO ORDER EXPONENT 200-33
POPJ P, ;NEEDN'T BE NORMALIZED.
;END OF FLOUT
END