Google
 

Trailing-Edge - PDP-10 Archives - tops20v41_monitor_sources - monitor-sources/mflout.mac
There are 48 other files named mflout.mac in the archive. Click here to see a list.
; UPD ID= 5, FARK:<4-1-WORKING-SOURCES.MONITOR>MFLOUT.MAC.2,  10-Mar-82 17:19:24 by ZIMA
;EDIT 2001 - Change TITLE for Autopatch consistency.
;<4-1-FIELD-IMAGE.MONITOR>MFLOUT.MAC.2, 25-Feb-82 20:30:32, EDIT BY DONAHUE
;UPDATE COPYRIGHT DATE
; UPD ID= 755, FARK:<4-WORKING-SOURCES.MONITOR>MFLOUT.MAC.4,  26-Aug-81 13:57:06 by ZIMA
;Edit 1933 - remove unneeded UMOVE before call to BOUTA.
; UPD ID= 622, FARK:<4-WORKING-SOURCES.MONITOR>MFLOUT.MAC.3,  23-Jun-81 14:06:01 by ZIMA
; UPD ID= 620, FARK:<4-WORKING-SOURCES.MONITOR>MFLOUT.MAC.2,  23-Jun-81 13:56:48 by ZIMA
;Edit 1897 - fix error code to set LSTERR too.
; UPD ID= 135, FARK:<4-WORKING-SOURCES.MONITOR>MFLOUT.MAC.2,  28-Jul-80 11:41:49 by ZIMA
;Edit 1762 - Prevent ILLUUO BUGHLTs caused by bad stack level at TOOSML.
;<4.MONITOR>MFLOUT.MAC.31,  3-Jan-80 08:09:35, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<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.



;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,1979,1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	SEARCH PROLOG,MONSYM,MACSYM
;**;[2001] Change one line at SEARCH PROLOG, +1L	JGZ	10-MAR-82
	TTITLE MFLOUT		;[2001] 
	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:	UMOVEM P5,4
;**;[1897][1898] Add/change one line at DFOUTX: +1L	JGZ	23-JUN-81
	MOVE T1,P5		;[1897][1898] SET UP ERROR CODE FOR LSTERR
	EMRETN

.FLOUT:	MCENT
	MOVE A,2
	SETZ A+1,
	MOVE 0,3
	CALL FLOUT.
	 JRST FLOUTX
	SMRETN

FLOUTX:	UMOVEM P5,3
;**;[1897][1898] Add/change one line at FLOUTX: +1L	JGZ	23-JUN-81
	MOVE T1,P5		;[1897][1898] SET UP ERROR CODE FOR LSTERR
	EMRETN

.CO:	PUSH P,2
	MOVE 2,DIG		;CHARACTER FOR OUTPUT GOES IN 2
;**;[1933] Delete one line at .CO: +3L	JGZ	26-AUG-81
	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:	SE1CAL
	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
;**;[1762] Replace one line at ROUND: +3L	JGZ	28-JUL-80
	JRST [	ADJSP P,-1	;[1762] PUT STACK LEVEL WHERE TOOSML EXPECTS
		JRST TOOSML]	;[1762] AND GO THERE, 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