Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
monitor/mflout.mac
There are 48 other files named mflout.mac in the archive. Click here to see a list.
; UPD ID= 8553, RIP:<7.MONITOR>MFLOUT.MAC.2, 11-Feb-88 11:03:07 by GSCOTT
;TCO 7.1218 - Update copyright date.
; UPD ID= 2122, SNARK:<6.1.MONITOR>MFLOUT.MAC.9, 5-Jun-85 09:57:27 by MCCOLLUM
;TCO 6.1.1406 - Update copyright notice.
; UPD ID= 4815, SNARK:<6.MONITOR>MFLOUT.MAC.8, 17-Sep-84 10:13:55 by PURRETTA
;Update copyright notice
; UPD ID= 1844, SNARK:<6.MONITOR>MFLOUT.MAC.7, 20-Feb-83 22:18:13 by MURPHY
;TCO 6.1514 - No error code in AC if ERJMP/ERCAL.
; UPD ID= 143, SNARK:<6.MONITOR>MFLOUT.MAC.6, 19-Oct-81 16:09:37 by COBB
;TCO 6.1029 - CHANGE SE1CAL TO EA.ENT
; UPD ID= 124, SNARK:<5.MONITOR>MFLOUT.MAC.5, 26-Aug-81 16:42:48 by ZIMA
;TCO 5.1460 - remove unneeded UMOVE before call to BOUTA.
; UPD ID= 105, SNARK:<5.MONITOR>MFLOUT.MAC.4, 17-Aug-81 11:22:11 by ZIMA
;TCO 5.1458 - Change title for Autopatch consistency.
; UPD ID= 2248, SNARK:<5.MONITOR>MFLOUT.MAC.3, 23-Jun-81 18:55:53 by ZIMA
;TCO 5.1381 - fix error handling code to set LSTERR too.
; UPD ID= 821, SNARK:<5.MONITOR>MFLOUT.MAC.2, 2-Aug-80 17:30:16 by ZIMA
;TCO 5.1121 - prevent ILLUUO BUGHLTs caused by misadjusted stack.
;<4.MONITOR>MFLOUT.MAC.30, 27-Sep-79 18:41:15, EDIT BY MURPHY
;REMOVE USE OF NON-STANDARD DOUBLE PRECISION NUMBER FORMAT
;<4.MONITOR>MFLOUT.MAC.29, 27-Aug-79 17:17:45, EDIT BY ZIMA
;TCO 4.2424 - Convert nonstandard zeros to standard form at FLOUT.
;<4.MONITOR>MFLOUT.MAC.28, 4-Mar-79 18:31:09, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<3-MONITOR>MFLOUT.MAC.27, 6-Nov-78 11:50:00, EDIT BY ZIMA
;TCO 4.2081 - PRESERVE P5 ACROSS CALLS TO EDFAD.,EDFMP.,EDFDV.
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH PROLOG,MONSYM,MACSYM
TTITLE MFLOUT
SWAPCD
;FLOATING POINT OUTPUT CONVERSION AND FORMATTING ROUTINES
INTERN .DFOUT,.FLOUT
;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
;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
;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.
;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: MCENT
DMOVE A,2
MOVE 0,4
CALL FLOUT.
JRST DFOUTX
SMRETN
DFOUTX: CALL TSTERJ ;ERJMP/ERCAL PRESENT?
UMOVEM P5,4 ;NO
MOVE T1,P5 ;SET UP ERROR CODE FOR LSTERR
EMRETN
.FLOUT: MCENT
MOVE A,2
SETZ A+1,
MOVE 0,3
CALL FLOUT.
JRST FLOUTX
SMRETN
FLOUTX: CALL TSTERJ ;ERJMP/ERCAL PRESENT?
UMOVEM P5,3 ;NO
MOVE T1,P5 ;SET UP ERROR CODE FOR LSTERR
EMRETN
.CO: PUSH P,2
MOVE 2,DIG ;CHARACTER FOR OUTPUT GOES IN 2
CALL BOUTA ;BOUT WITHOUT CHANGING CLFMMON FLAG
MOVE DIG,2
POP P,2
RET
ILLFMT: MOVEI P5,FLOTX3
CALL FIXSTK ;FIX UP THE STACK THEN RETURN
RET
RGOOD: AOS (P)
RBAD: RET
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
RET ;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
RET ;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
ADJSP P,6
JRST 0(T)
;TENEX NUMERIC OUTPUT ROUTINE, COMMENTS ON PREVIOUS 2 PAGES
FLOUT.: SETZ DF, ;CLEAR ALL .FLOUT'S INTERNAL FLAGS
LDB T,[POINT 27,A,35] ;GET THE MANTISSA TO CHECK FOR FAKE ZERO
JUMPE T,[JUMPN A+1,.+1 ;DONE IF NONZERO
SETZ A,0 ; ELSE MAKE A PROPER ZERO TO USE
JRST .+1] ; AND CONTINUE IN LINE
SKIPGE A
TRO DF,1 ;FLAG FOR NEGATIVE ARGUMENT
TRNE DF,1
DMOVN A,A ;MAKE 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: TXNE 0,FL%FST ;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.
LOAD NDP,FL%RND,0 ;GET ROUNDING POSITION
SKIPN NDP
MOVEI NDP,^D7 ;STANDARD NUMBER OF SIGNIFICANT DIGITS
DPB NDP,[POINT 5,DF,22] ;ROUNDING POSITION SAME AS NUMBER DIGITS
TLO DF,400201 ;PRINT "E" IF EXPONENT PRINTED,
;PRINT SPACE IF POSITIVE, "-" IF NEGATIVE
TXNE 0,FL%PNT ;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)
LOAD T,FL%SGN,0 ;SIGN CONTROL
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
LOAD T,FL%JUS,0 ;JUSTIFICATION
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: TXNE 0,FL%ONE
TLO DF,40000 ;PRINT AT LEAST ONE DIGIT FIELD
TXNN 0,FL%DOL
JRST DECOD3
SOS CBD(BKSTK)
TLO DF,20 ;$ PREFIX
DECOD3: TXNE 0,<FL%PNT+FL%SND> ;FIELD 2 OR POINT REQUESTED?
TLO DF,40 ;YES, PRINT POINT
SETZM CEXP(BKSTK)
LOAD T,FL%EXP,0 ;EXPONENT CONTROL
CAIE T,0
JRST DECOD7
TXNE 0,FL%THD
JRST ILLFMT ;ROOM IN FIELD 3 BUT NO EXP DESIRED
JRST DCODE5 ;NO EXP FIELD
DECOD7: 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: LOAD T,FL%ESG,0 ;EXPONENT SIGN CONTROL
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: TXNN 0,FL%OVL
JRST DCODE6 ;NO OUTPUT COLUMN OVERFLOW
TRO DF,20
TLNE 0,(1B12) ;* ON COL OVERFLOW
TRO DF,40
DCODE6: LOAD T,FL%FST,0
ADDM T,CBD(BKSTK)
LOAD T,FL%SND,0
MOVEM T,CAD(BKSTK)
LOAD T,FL%THD,0
ADDM T,CEXP(BKSTK)
LOAD T,FL%RND,0
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
SETZ 3,
TRNN 0,2
HRL 3,CEXP(BKSTK)
HRRI 3,^D10
TLO 3,400000
TRNN 0,2
TLO 3,140000
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)
RET ;RETURN
FIXSTK: POP P,M
ADJSP P,-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: EA.ENT
HRRZS BKSTK
SETZM DX(BKSTK) ;START WITH 0 DECIMAL EXPONENT
JUMPE A,DXPR ;IF NUMBER IS 0 WE'RE DONE
;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
DFDV A,FPPTAB-2(BX+1) ;DIVIDE BY SELECTED POWER OF 10
CAMLE BX,[3B8]
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,[2B8]
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
DFMP A,FPPTAB-2(BX+1) ;MULTIPLY BY SELECTED POWER OF 10
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,205520661075 ;10^38
OCT 300425434430,044236400000 ;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
OCT 204500000000,0 ;2 MORE 10^S
;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 [ ADJSP P,-1 ;PUT STACK WHERE TOOSML EXPECTS AND
JRST TOOSML] ; ENTER TOOSML ON 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
DFAD A,RNDP(M) ;ADD 0.5 TIMES PROPER POWER OF TEN
POP P,M
CAMGE A,[201B8] ;NUMBER NOW >= 1 ?
JRST RGOOD ;NO
DMOVE A,PNT1 ;>=1. CHANGE TO 0.1
AOS DX(BKSTK) ;INDEX EXPONENT
RET ;RETURN 1
PNT1: OCT 175631463146,146314631463 ;0.1
RNDP: 200400,,0 ;5.0E-1
0
174631,,463146 ;5.0E-2
146314,,631463
171507,,534121 ;5.0E-3
353412,,172703
166406,,111564 ;5.0E-4
274324,,773717
162643,,334272 ;5.0E-5
307041,,454513
157517,,426542 ;5.0E-6
70664,,360411
154414,,336750 ;5.0E-7
55366,,615155
150655,,376246 ;5.0E-8
257127,,510257
145527,,461670 ;5.0E-9
214106,,71677
142422,,701372 ;5.0E-10
11553,,224546
136667,,633766 ;5.0E-11
165736,,672560
133537,,657770 ;5.0E-12
136262,,225300
130431,,363140 ;5.0E-13
113365,,21063
124702,,270232 ;5.0E-14
22273,,201605
121550,,223341 ;5.0E-15
250225,,633004
116440,,165747 ;5.0E-16
271653,,25466
112715,,126245 ;5.0E-17
366104,,674127
107560,,736521 ;5.0E-18
221552,,226422
;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: DFMP A,TEN ;FRACTION TIMES TEN
LDB DIG,[POINT 8,A,8] ;EXPONENT
TLZ A,777000 ;REMOVE HI-ORDER EXPONENT
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
DFAD A,[OCT 0,0] ;NORMALIZE FOR NEXT DFMP
RET
;END OF FLOUT
END