Google
 

Trailing-Edge - PDP-10 Archives - BB-D480F-SB_FORTRAN10_V10 - mthcnv.mac
There are 7 other files named mthcnv.mac in the archive. Click here to see a list.
	SEARCH	MTHPRM
	TV	MTHCNV	Conversion routines and tables, 2(4010)


;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
;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 WHICH IS NOT SUPPLIED BY DIGITAL.

COMMENT \

***** Begin Revision History *****

4003	JLC	8-Sep-83
	Moved POWTAB from FORLIB.

4004	JLC	26-Sep-83
	Moved most of the rest of FORCNV here. Reworked integer
	output code to use string instructions.

4005	JLC	5-Oct-83
	Added code to do truncation for FLOUT if %FTAST not set.
	Fixed INTO to suppress leading blanks if %FTSLB set.

4006	JLC	27-Oct-83
	Fix new FLOUT to handle outsize scale factors and decimal widths.

4007	JLC	29-Feb-84
	Change references to F to S3, a new MTHPRM definition.

4010	JLC	16-Mar-84
	Changed the fatal error calls to $ACALL.

\

	PRGEND
	TITLE	FLIRT	FLOATING POINT INPUT 
	SUBTTL	DAVE NIXON AND TOM EGGERS
	SUBTTL	D.M.NIXON /DMN/DRT/HPW/MD/CLRH/DCE/CYM	   28-Oct-81
	SEARCH	MTHPRM




;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
;ALL RIGHTS RESERVED.

	SEGMENT	DATA

%FLESG:	BLOCK	1		;EXPONENT SIGN FLAG
%FLFSG:	BLOCK	1		;FRACTION SIGN FLAG
%FLRFR:	BLOCK	2		;RAW FRACTION
%FLRBX:	BLOCK	1		;RAW BINARY EXPONENT
%FLINF:	BLOCK	1		;DECIMAL POINT OR EXPONENT FOUND

	SEGMENT	CODE

	ENTRY	%FLIRT,%GRIN,%ERIN,%DIRT,%REALI,%FLSPR,%FLDPR,%FLGPR

	INTERN	%FLRFR,%FLRBX,%FLFSG,%FLINF

	EXTERN	%IBYTE,%FWVAL,%DWVAL
	EXTERN	IO.ADR,IO.TYP,%SAVE4,%SCLFC,ILLEG.
	EXTERN	%HITEN,%LOTEN,%EXP10,%PTMAX,%HIMAX,%SIZTB
	EXTERN	%EEMUL,%EEDIV,%EENRM
	EXTERN	%SKIP
	EXTERN	%BZFLG
	EXTERN	%FIXED,%ERTYP

;IF THE FLAG ILLEG. HAS BEEN SET (BY A CALL TO ILL), THE
;INPUT VALUE WILL BE SET TO 0 IF ANY ILLEGAL CHARACTERS
;ARE SCANNED FOR THAT VALUE.

;THE SYNTAX ANALYSIS FOR THE SINGLE AND DOUBLE PRECISION INPUT
;IS STATE TABLE DRIVEN. EACH NEW INPUT CHARACTER IS CONVERTED TO
;A CHARACTER TYPE AND COMBINED WITH THE OLD "STATE". THIS RESULT
;IS THEN LOOKED UP IN THE TABLE "NXTSTA" TO GET THE NEW STATE AND
;AN INDEX INTO THE "XCTTAB" TABLE TO DISPATCH FOR THE INPUT
;CHARACTER. THE STATE TABLE LOGIC AND THE DISPATCH ROUTINES BUILD
;THREE RESULTS: A DOUBLE PRECISION INTEGER(IN B,C) FOR THE FRACTIONAL
;PART OF THE RESULT, AN INTEGER(IN XP) FOR THE EXPONENT AFTER
;"D" OR "E", AND A COUNTER(IN "X") TO KEEP TRACK OF THE DECIMAL POINT.
;WHEN A TERMINATING CHARACTER IS FOUND, THE DOUBLE PRECISION INTEGER
;IS NORMALIZED TO THE LEFT TO GIVE A DOUBLE PRECISION FRACTION.
;THE DECIMAL POINT POSITION(FROM "X")OR THE IMPLIED DECIMAL POINT
;POSITION FROM THE FORMAT STATEMENT, THE "D" OR "E" EXPONENT, AND ANY
;SCALING FROM THE FORMAT STATEMENT ARE COMBINED INTO A DECIMAL
;EXPONENT. THIS DECIMAL EXPONENT IS USED AS AN INDEX INTO A POWER
;OF TEN TABLE (KEPT IN DOUBLE PRECISION INTEGER PLUS EXPONENT FORM
;SO INTERMEDIATE RESULTS WILL HAVE 8 MORE BITS OF PRECISION THAN
;FINAL RESULTS) TO MULTIPLY THE DOUBLE PRECISION FRACTION. THIS
;RESULT IS THEN ROUNDED TO GIVE A SINGLE PRECISION,
;PDP6/KI10 DOUBLE PRECISION RESULT.
;OVERFLOWS RETURN THE LARGEST POSSIBLE
;NUMBER (WITH CORRECT SIGN), WHILE UNDERFLOWS RETURN 0.

;ACCUMULATOR DEFINITIONS

A==T0
B=A+1			;RESULT RETURNED IN A OR A AND B
C=B+1			;B,C, AND D ARE USED AS A MULTIPLE PRECISION
D1=C+1			;  REGISTER FOR DOUBLE PRECISION OPERATIONS
E=D1+1			;EXTRA AC
XP=T5			;EXPONENT AFTER D OR E
BXP=P1			;BINARY EXPONENT
ST==P1			;STATES
;P2			;Used for really temp purposes only
W==P3			;FIELD WIDTH
X==P4			;COUNTS DIGITS AFTER POINT


;RIGHT HALF FLAGS IN AC "F"
DOTFL==1		;DOT SEEN
EXPFL==2		;EXPONENT SEEN IN DATA (MAY BE 0)

LOCFLG==DOTFL+EXPFL

;INPUT CHARACTER TYPES
NULTYP==1	;NULL
DOTTYP==2	;DECIMAL POINT
DIGTYP==3	;DIGITS 0-9
SPCTYP==4	;SPACE OR TAB
EXPTYP==5	;D OR E
PLSTYP==6	;PLUS SIGN (+)
MINTYP==7	;MINUS SIGN (-)
		;ANYTHING ELSE IS TYPE 0
%DIRT:
%ERIN:
%GRIN:
%FLIRT:				;INPUT
	MOVE	T1,IO.TYP	;GET DATA TYPE
	JUMPE	T1,%REALI	;IF ZERO, JUST READ INTO RAW COMPONENTS
	CAIN	T1,TP%DPX	;G-FLOATING?
	 JRST	GPIN		;YES
	MOVE	T1,%SIZTB(T1)	;NO. GET ENTRY SIZE
	CAIN	T1,2		;DOUBLE PRECISION?
	 JRST	DPIN		;YES

SPIN:	PUSHJ	P,%REALI	;GET RAW COMPONENTS
	PJRST	%FLSPR		;AND CONVERT TO SINGLE PRECISION

DPIN:	PUSHJ	P,%REALI	;GET RAW COMPONENTS
	PJRST	%FLDPR		;AND CONVERT TO DOUBLE PRECISION

GPIN:	PUSHJ	P,%REALI	;GET RAW COMPONENTS
	PJRST	%FLGPR		;AND CONVERT TO G-FLOATING

%REALI:	PUSHJ	P,%SAVE4	;SAVE P1-P4
	SETZM	%FLRFR		;CLEAR ALL RAW DATA AND EXPS
	SETZM	%FLRFR+1
	SETZM	%FLRBX
	TXZ	S3,LOCFLG	;CLEAR LOCAL FLAGS IN F
	SETZM	%FLFSG		;CLEAR FRACTION SIGN
	SETZM	%FLESG		;AND EXPONENT SIGN
	SETZM	%FLINF		;CLEAR INFORMATION WORD
	MOVE	W,%FWVAL	;GET THE FIELD WIDTH
	SETZB	C,D1		;INIT D.P. FRACTION
	SETZB	ST,XP		;INIT STATE AND DECIMAL EXPONENT
	SETZ	X,		;INIT "DIGITS AFTER POINT" COUNTER
	JUMPG	W,GETCH1	;FIELD SPECIFIED
	SETO	W,		;SET FREE FORMAT FLAG
	PUSHJ	P,%SKIP		;FREE FORMAT - SKIP SPACES
	  JRST	ENDF1		;COMMA OR EOL = NULL FIELD
	JRST	GETCH2		;PROCESS FIELD

GETNXT:
GETCHR:	JUMPE	W,ENDF1		;END OF FIELD
	LSH	ST,-^D30	;MOVE STATE TO BITS 30-32
GETCH1:	PUSHJ	P,%IBYTE	;GET NEXT CHARACTER
GETCH2:	JUMPE	T1,GOTNUL	;GO SET NULL FLAG FOR NULL
	CAIL	T1,"0"		;CHECK FOR NUMBER
	CAILE	T1,"9"
	JRST	CHRTYP		;NO, TRY OTHER
	SUBI	T1,"0"		;CONVERT TO NUMBER
GOT1:	IORI	ST,DIGTYP	;SET TYPE
GOTST:	MOVE	ST,NXTSTA(ST)	;GET NEXT STATE
	ROT	ST,-3		;PUT DISPATCH ADDRESS IN BITS 32-35
				; AND NEW STATE IN BITS 0-2
	MOVEI	P2,(ST)		;GET JUST DISPATCH INDEX
	XCT	XCTTAB(P2)	;DISPATCH OR EXECUTE
	SOJA	W,GETNXT	;RETURN FOR NEXT CHAR.

GOTNUL:	IORI	ST,NULTYP	;FLAG GOT NULL
	JRST	GOTST		;BACK FOR DISPATCH

XCTTAB:	JRST	ILLCH		; (00) ILLEGAL CHAR
	JRST	NULLIN		; (01) NULL	[JLC]
	IORI	S3,DOTFL		; (02) PERIOD
	JRST	DIG		; (03) DIGIT BEFORE POINT
	JRST	BLNKIN		; (04) BLANK OR TAB
	SOJA	W,GETNXT	; (05) RETURN FOR NEXT CHAR.
	SETOM	%FLFSG		; (06) NEGATIVE FRACTION
	SETOM	%FLESG		; (07) NEGATIVE EXP
	SOJA	X,DIGAFT	; (10) DIGIT AFTER POINT
	JRST	DIGEXP		; (11) EXPONENT
	JRST	DELCK		; (12) DELIMITER TO BACK UP OVER

CHRTYP:	CAIN	T1,"+"		;CONVERT INPUT CHARS TO CHARACTER TYPE
	IORI	ST,PLSTYP
	CAIN	T1,"-"
	IORI	ST,MINTYP
	CAIE	T1," "		;SPACE
	CAIN	T1,"	"	;TAB
	IORI	ST,SPCTYP
	CAIE	T1,"."		;DECIMAL POINT?
	JRST	NOTDOT		;NO
	IORI	ST,DOTTYP
	HRROS	%FLINF		;SIGNAL DECIMAL POINT FOUND
NOTDOT:	CAIE	T1,"D"
	CAIN	T1,"E"
	JRST	GOTEXP
	CAIE	T1,"d"		;LOWER CASE D?
	CAIN	T1,"e"		;LOWER CASE E?
	JRST	GOTEXP		;YES
	JRST	GOTST		;NO
GOTEXP:	IORI	ST,EXPTYP	;SET STATUS FOR EXPONENT
	HRROS	%FLINF		;SET INFO FOR EXPONENT FOUND
	JRST	GOTST		;GO DISPATCH ON OLD STATE AND CHAR TYPE

DIGAFT:	AOS	%FLINF		;INCR # DIGITS AFTER DOT
DIG:	JUMPN	C,DPDIG		;NEED D.P. YET?
	CAMLE	D1,MAGIC	;NO, WILL MUL AND ADD CAUSE OVERFLOW?
	JRST	DPDIG		;MAYBE, SO DO IT IN DOUBLE PRECISION
	IMULI	D1,12		;NO, MULTIPLY BY 10 SINGLE PRECISION
	ADD	D1,T1		;ADD DIGIT INTO NUMBER
	SOJA	W,GETNXT	;GO GET NEXT CHARACTER

DPDIG:	CAMLE	C,MAGIC		;WILL MULTIPLY AND ADD CAUSE OVERFLOW?
	AOJA	X,DIGRET	;YES
	IMULI	C,12		;MULTIPLY HIGH D.P. FRACTION BY 10
	MULI	D1,12		;MULTIPLY LOW D.P. FRACTION BY 10
	ADD	C,D1		;ADD HI PART OF LO PRODUCT INTO RESULT
	MOVE	D1,E		;GET LO PART OF LO PRODUCT
	TLO	D1,(1B0)	;STOP OVERFLOW IF CARRY INTO HI WORD
	ADD	D1,T1		;ADD DIGIT INTO FRACTION
	TLZN	D1,(1B0)	;SKIP IF NO CARRY INTO HI WORD
	ADDI	C,1		;PROPOGATE CARRY INTO HI WORD
DIGRET:	SOJA	W,GETNXT	;DECREMENT FIELD WIDTH AND GET NEXT CHAR

MAGIC:	<377777777777-9>/^D10	;LARGEST NUM PRIOR TO MULTIPLY AND ADD

DIGEXP:	HRROS	%FLINF		;SET INFO FOR EXPONENT FOUND
	IORI	S3,EXPFL		;SET FLAG TO SAY WE'VE SEEN EXPONENT
	IMULI	XP,12		;MULTIPLY BY TEN
	ADD	XP,T1		;ADD IN NEXT DIGIT
	SOJA	W,GETNXT	;DECREMENT FIELD WIDTH AND GET NEXT CHAR


;LAST DIGIT IS THE NEXT STATE NUMBER
;1ST 2 DIGITS ARE THE "ACTION" TO TAKE
;STATE 0 = NOTHING SIGNIFICANT READ YET
;STATE 1 = DIGIT OR SIGN SEEN
;STATE 2 = DECIMAL POINT SEEN
;STATE 3 = D OR E SEEN
;STATE 4 = SIGN SEEN AFTER DIGITS OR D OR E

;	 ? ,CR , . ,0-9,   ,D E, + , - ,
NXTSTA:	EXP
	000,050,022,031,050,000,051,061,
	000,011,022,031,041,053,054,074,
	000,012,120,102,042,053,054,074,
	000,013,120,114,043,000,054,074,
	000,014,120,114,044,000,120,120
	

;ERROR PROCESSING. IF A REAL ILLEGAL CHARACTER (E.G. ALPHA CHAR) IS
;FOUND DIRECTLY AFTER A NUMBER, IT IS ILLEGAL. IF THE "ILLEGAL FLAG" (ILLEG.)
;IS SET, WE JUST IGNORE THE REST OF THE INPUT AND SET THE RESULT
;TO 0.

ILLCH:
DELCK:	CAME	W,[-1]		;FIRST ILLEGAL CHAR IN FREE FORMAT
	JUMPL	W,ENDF		;NO - DELIMITER OF FREE FORMAT
	SKIPE	ILLEG.		;ILLEGAL CHAR. FLAG SET?
	JRST	ERROR1		;YES. THROW AWAY REST AND SET RESULT=0
	$ACALL	ILC		;"ILLEGAL CHARACTER IN DATA"
	POPJ	P,		;RETURN TO FOROTS

;[JLC]
;NULL IS A LEGAL CHARACTER, TREATED AS IF IT WERE A BLANK WITH
;BLANK='NULL' SPECIFIED.
NULLIN:	JUMPL	W,ENDF		;DONE IF FREE FORMAT
	SOJA	W,GETNXT	;OTHERWISE JUST SKIP IT

;THE STATE IS NOT DISTURBED BY BLANKS, THUS IF BZ IS ON (BLANK=ZERO)
;WE CAN MIMIC THE CODE AT GETNXT (MOVING THE STATE TO BITS 30-32) AND
;JUMP TO THE PLACE WHERE A DIGIT WOULD HAVE GONE.
BLNKIN:	SETZ	T1,		;SET TO NULL CHAR
	JUMPL	W,ENDF		;FREE FORMAT
	SKIPN	%BZFLG		;BLANK=ZERO?
	 SOJA	W,GETNXT	;NO. SKIP THE SPACE
	LSH	ST,-^D30	;YES. PUT STATE IN BITS 30-32
	JRST	GOT1		;AND USE IT

ERROR1:	SOJLE	W,ZERO		;HAVEN'T DECR WIDTH YET
	PUSHJ	P,%IBYTE	;THROW AWAY CHAR
	JRST	ERROR1		;KEEP GOING UNTIL DONE

ENDF:
ENDF1:	DMOVE	A,C		;MOVE 2-WORD RESULT TO BOTTOM AC'S
	TXNE	S3,DOTFL		;HAS DECIMAL POINT BEEN INPUT?
	JRST	ENDF2		;YES
	MOVE	D1,%DWVAL	;NO, GET DIGITS AFTER POINT FROM FORMAT
	SUB	X,D1		;  AND MODIFY DECIMAL EXPONENT
ENDF2:	HRRE	D1,%SCLFC	;GET SCALE FACTOR
	TXNN	S3,EXPFL		;EXPONENT IN DATA?
	SUB	X,D1		;NO, ADD INTO EXPONENT
	SKIPE	%FLESG		;WAS D OR E EXPONENT NEGATIVE?
	 MOVNS	XP		;YES, SO NEGATE IT
	ADD	X,XP		;ADD EXPONENT FROM D OR E
NORM:	MOVEI	BXP,106		;INIT BINARY EXPON FOR D.P. INTEGER
	JUMPN	A,NORM1		;XFER IF AT LEAST ONE 1 IN HIGH HALF
	EXCH	A,B		;HIGH HALF ZERO, MOVE LOW HALF TO HIGH,
				;AND CLEAR LOW HALF
	SUBI	BXP,^D35	;AND ADJUST EXPONENT FOR 35 SHIFTS
NORM1:	JUMPE	A,ZERO		;LEAVE IF BOTH WORDS ZERO
	MOVE	D1,A		;COPY 1ST WORD
	JFFO	D1,NORM2	;FIND 1ST BIT
NORM2:	ASHC	A,-1(E)		;NORMALIZE D.P. INTEGER WITH BIN POINT
				;BETWEEN BITS 0 AND 1 IN HIGH WORD
	SUBI	BXP,-1(E)	;AND ADJUST EXPON TO ALLOW FOR SHIFTING
	JUMPE	X,ENDF6		;IF DECIMAL EXP=0, NO MUL BY 10 NEEDED
ENDF3:	CAILE	X,%HIMAX	;WITHIN ABSOLUTE G-FLOAT BOUNDS?
	 JRST	EXPTB		;NO. TOO BIG
	CAMGE	X,[-%HIMAX]
	 JRST	EXPTS		;NO. TOO SMALL
	PUSHJ	P,EETST		;GO TEST FOR BIG SCALING
	MUL	B,%HITEN(X)	;LO FRAC TIMES HI POWER OF TEN(RESULT IN B,C)
	MOVE	E,B		;GET HI PART OF PREVIOUS PRODUCT OUT OF WAY
	MOVE	B,A		;COPY HI PART OF FRACTION
	MOVE	C,%LOTEN(X)	;GET LOW POWER OF TEN
	ADDI	C,1		;BIAS IT - IT IS TRUNCATED
	MUL	B,C		;HI FRAC TIMES LO POWER OF TEN
	TLO	E,(1B0)
	ADD	E,B		;SUM OF HI PARTS OF CROSS PRODUCTS TO AC T
	MUL	A,%HITEN(X)	;HI FRACTION TIMES HI POWER OF TEN
	TLON	E,(1B0)		;DID CARRY OCCUR?  ALLOW FOR NEXT CARRY
	ADDI	A,1		;CARRY FROM ADDING CROSS PRODUCTS
	ADD	B,E		;ADD CROSS PRODUCTS TO LO PART
				;  OF (HI FRAC TIMES HI POW TEN)
	TLZN	B,(1B0)
	AOJA	A,ENDF5		;AND PROPOGATE A CARRY, IF ANY
ENDF5:	TLNE	A,(1B1)		;NORMALIZED? 1.0 > RESULT >= 0.25
	JRST	ENDF5A		;YES, RESULT >= 0.5
	ASHC	A,1		;NO, SHIFT LEFT ONE PLACE
	SUBI	BXP,1		;AND ADJUST EXPONENT
ENDF5A:	MOVE	X,%EXP10(X)	;GET BINARY EXPONENT
	ADD	BXP,X		;ADJUST BINARY EXPONENT
ENDF6:	DMOVEM	A,%FLRFR	;SAVE THE RAW LEFT-JUSTIFIED FRACTION
	MOVEM	BXP,%FLRBX	;AND THE RAW BINARY EXPONENT
NOCVT:	POPJ	P,

ZERO:	DMOVEM	A,%FLRFR	;SAVE 0 IN RAW FRACTION
	SETZM	%FLRBX		;AND RAW FRACTION
	POPJ	P,

EXPTB:	HRLOI	A,377777	;RETURN HUGE RAW NUMBERS
	HRLOI	B,377777
	SKIPE	%FLFSG		;NEGATE IF NECESSARY
	 DMOVN	A,A
	DMOVEM	A,%FLRFR	;SAVE OVERFLOW AMOUNT
	MOVEI	A,2000		;RETURN LARGEST G-FLOAT EXPONENT
	SKIPE	%FLESG		;NEGATE IF NECESSARY
	 MOVN	A,A
	MOVEM	A,%FLRBX	;SAVE RAW EXPONENT
	POPJ	P,

EXPTS:	$ECALL	FUN		;GIVE FLOATING UNDERFLOW MESSAGE
	SETZM	%FLRFR		;RETURN ZERO
	SETZM	%FLRBX
	SETZM	%FLFSG		;WITH NO SIGNS
	POPJ	P,

%FLSPR:	MOVE	A,%FLRFR	;GET HIGH WORD OF RAW FRACTION
	JUMPE	A,SPZERO	;IF ZERO, DON'T PUT IN AN EXPONENT
	MOVE	XP,%FLRBX	;GET RAW BINARY EXPONENT
	TLO	A,(1B0)		;START ROUNDING (ALLOW FOR OVERFLOW)
	ADDI	A,200		;NO, ROUND IN HIGH WORD
	TRZ	A,377		;GET RID OF USELESS (UNUSED) BITS
	TLZE	A,(1B0)		;CARRY PROPOGATE TO BIT 0?
	JRST	SPRET		;NO
	ASHC	A,-1		;YES, RENORMALIZE TO RIGHT
	ADDI	XP,1		;AND ADJUST BINARY EXPONENT
	TLO	A,(1B1)		;AND TURN ON HI FRACTION BIT
SPRET:	CAIL	XP,200		;OUT OF RANGE
	 JRST	SEXPTB		;YES. TOO BIG
	CAMGE	XP,[-200]
	 JRST	SEXPTS		;YES. TOO SMALL
	ADDI	XP,200		;ADD IN EXCESS 200
	ASHC	A,-8		;NO, LEAVE ROOM FOR EXPONENT
	DPB	XP,[POINT 9,A,8] ;INSERT EXPONENT INTO HI WORD
CSRET:	SKIPGE	%FLFSG		;RESULT NEGATIVE?
	MOVN	A,A		;YES. SO NEGATE RESULT
SPZERO:	MOVEM	A,@IO.ADR	;STORE IN USER AREA
	POPJ	P,		;RETURN TO USER

SEXPTB:	MOVE	A,IO.TYP	;GET DATA TYPE
	MOVEM	A,%ERTYP	;SAVE FOR USER SUBR
	HRLOI	A,377777	;SET NUMBER TO LARGEST POSSIBLE
	MOVEM	A,%FIXED	;SAVE FOR USER CALL
	$ECALL	FOV		;GIVE FLOATING OVERFLOW MSG
	MOVE	A,%FIXED	;GET FIXED-UP RESULT
	JRST	CSRET

SEXPTS:	MOVE	A,IO.TYP	;GET DATA TYPE
	MOVEM	A,%ERTYP	;SAVE FOR USER SUBR
	SETZM	%FIXED		;SETUP FIXED-UP RESULT
	$ECALL	FUN		;GIVE FLOATING UNDERFLOW MSG
	MOVE	A,%FIXED	;GET FIXED-UP RESULT
	JRST	CSRET

DEXPTB:	HRLOI	A,377777	;SET NUMBER TO LARGEST POSSIBLE
	HRLOI	B,377777
	DMOVEM	A,%FIXED	;SETUP FIXED-UP RESULT
	$ECALL	FOV		;GIVE FLOATING OVERFLOW MSG
	DMOVE	A,%FIXED	;GET FIXED-UP RESULT
	JRST	CDRET

DEXPTS:	SETZM	%FIXED		;SETUP FIXED-UP RESULT
	SETZM	%FIXED+1
	$ECALL	FUN		;GIVE FLOATING UNDERFLOW MSG
	DMOVE	A,%FIXED	;GET FIXED-UP RESULT
	JRST	CDRET
;IF RUNNING ON A KL, WE CAN USE THE SPARSE POWER
;OF TEN TABLE TO SCALE THE NUMBER. IT IS ABSOLUTELY NECESSARY
;FOR EXTENDED EXPONENT NUMBERS
EETST:	MOVM	P2,X		;GET MAGNITUDE OF DECIMAL EXPONENT
	CAIG	P2,%PTMAX	;WITHIN NORMAL RANGE?
	POPJ	P,		;YES. JUST DO IT NORMALLY
	ASHC	A,-1		;PREVENT DIVIDE CHECK
	ADDI	BXP,1		;AND MODIFY BINARY EXPONENT
	ASH	P2,1		;CALCULATE FACTOR OF TEN TO USE
	IDIVI	P2,^D21		;IN SPARSE TABLE
	SUBI	P2,2		;STARTS WITH 10**21
	IMULI	P2,3		;AND EACH ENTRY IS 3 LOCS
	JUMPL	X,EENEG		;GO DO DIVIDE IF EXP NEGATIVE
	PUSHJ	P,%EEMUL	;OR MULTIPLY IF POSITIVE
	SUBI	X,(XP)		;REDUCE THE DECIMAL EXP
	ADDI	BXP,(P3)	;AND ADD THE BINARY EXP FOUND
	POPJ	P,

EENEG:	PUSHJ	P,%EEDIV	;DO D.P. DIVIDE
	ADDI	X,(XP)		;REDUCE MAGNITUDE OF X
	SUBI	BXP,(P3)	;MODIFY BINARY EXPONENT
	POPJ	P,

;HERE FOR DOUBLE PRECISION ROUNDING

%FLDPR:	DMOVE	A,%FLRFR	;GET RAW FRACTION
	JUMPE	A,DPZERO	;IF ZERO, RETURN ZERO
	MOVE	XP,%FLRBX	;GET RAW BINARY EXPONENT
	TLO	A,(1B0)		;START ROUNDING (ALLOW FOR OVERFLOW)
	TLO	B,(1B0)		;START ROUNDING (ALLOW FOR CARRYS)
	ADDI	B,200	 	;LOW WORD ROUNDING FOR PDP-6 OR KI10
	TLZN	B,(1B0)		;DID CARRY PROPOGATE TO SIGN?
	 ADDI	A,1		;YES, ADD CARRY INTO HIGH WORD
	TLZE	A,(1B0)		;CARRY PROPOGATE TO BIT 0?
	 JRST	DPRET		;NO
	ASHC	A,-1		;YES, RENORMALIZE TO RIGHT
	ADDI	XP,1		;AND ADJUST BINARY EXPONENT
	TLO	A,(1B1)		;AND TURN ON HI FRACTION BIT
DPRET:	CAIL	XP,200		;OUT OF RANGE
	 JRST	DEXPTB
	CAMGE	XP,[-200]
	 JRST	DEXPTS		;YES. RETURN ZERO OR INFINITY
	ADDI	XP,200		;ADD IN EXCESS 200
	ASHC	A,-8		;NO, LEAVE ROOM FOR EXPONENT
	DPB	XP,[POINT 9,A,8] ;INSERT EXPONENT INTO HI WORD
CDRET:	SKIPGE	%FLFSG		;RESULT NEGATIVE?
	DMOVN	A,A		;YES. SO NEGATE RESULT
DPZERO:	DMOVEM	A,@IO.ADR	;STORE IN USER AREA
	POPJ	P,		;RETURN TO USER

%FLGPR:	DMOVE	A,%FLRFR	;GET RAW FRACTION
	JUMPE	A,GDZERO	;IF ZERO, RETURN ZERO
	MOVE	XP,%FLRBX	;GET RAW BINARY EXPONENT
	TLO	A,(1B0)		;START ROUNDING (ALLOW FOR OVERFLOW)
	TLO	B,(1B0)		;START ROUNDING (ALLOW FOR CARRYS)
	ADDI	B,2000		;YES. DO SPECIAL ROUNDING
	TLZN	B,(1B0)		;DID CARRY PROPOGATE TO SIGN?
	 ADDI	A,1		;YES, ADD CARRY INTO HIGH WORD
	TLZE	A,(1B0)		;CARRY PROPOGATE TO BIT 0?
	 JRST	GPRET		;NO
	ASHC	A,-1		;YES, RENORMALIZE TO RIGHT
	ADDI	XP,1		;AND ADJUST BINARY EXPONENT
	TLO	A,(1B1)		;AND TURN ON HI FRACTION BIT
GPRET:	CAIL	XP,2000		;OUT OF RANGE?
	 JRST	DEXPTB		;YES. TOO BIG
	CAMGE	XP,[-2000]
	 JRST	DEXPTS		;YES. TOO SMALL
	ADDI	XP,2000		;ADD IN EXCESS 2000
	ASHC	A,-^D11		;SHIFT TO MAKE ROOM FOR EXP
	DPB	XP,[POINT 12,A,11];DEPOSIT THE EXPONENT
	SKIPGE	%FLFSG		;RESULT NEGATIVE?
	DMOVN	A,A		;YES. SO NEGATE RESULT
GDZERO:	DMOVEM	A,@IO.ADR	;STORE IN USER AREA
	POPJ	P,		;RETURN TO USER

	PRGEND
	TITLE	FLOUT 	FLOATING POINT OUTPUT 
	SUBTTL	D. NIXON AND T. W. EGGERS
	SUBTTL	JLC - REWORKED FOR USE OF STRING INSTRUCTIONS
	SEARCH	MTHPRM



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
;ALL RIGHTS RESERVED.

	SEGMENT	CODE


	XP==T5		;DECIMAL EXPONENT

	NOSIGN==1	;NO SPACE FOR + SIGN
	NOEFLG==2	;DO NOT PRINT "D" OR "E" IN EXPONENT
	NOPNT==4	;DO NOT PRINT THE DECIMAL POINT (FOR FTAST=0)

	LOCFLG==NOSIGN+NOEFLG+NOPNT

	DPMAX==^D20	;MAXIMUM NUMBER OF DIGITS TO PRINT
			;IF WE PRINT ANY MORE, WE WILL BE LYING TO THE
			;USER, AS THIS IS THE MAXIMUM PRECISION OF
			;OUR SCALING FACTORS OF 10.
			;WE CANNOT KNOW WHETHER THE NUMBER WE
			;HAVE IN THE MACHINE IS AN EXACT REPRESENTATION
			;OF WHATEVER WAS INPUT - WE MUST ASSUME THAT
			;WHAT IS IN THE MACHINE IS EXACTLY WHAT IS DESIRED.
			;THEREFORE THERE IS NO REASON NOT TO GIVE AS MANY
			;DIGITS AS ARE ACCURATE. THE ONLY LIMITATION ON
			;THIS CURRENTLY IS THE SCALING ALGORITHM.

	LZALWAYS==1	;SWITCH FOR ALWAYS PRINTING LEADING ZEROES
	LZSOME==0	;SWITCH FOR SOMETIMES - ALWAYS EXCEPT WHEN
			;MANTISSA .LE. 1.0 AND DIGIT OUTPUT WITH
			;LEADING ZERO WOULD COMPLETELY FILL THE
			;FIELD, A SPACE IS SUBSTITUTED FOR THE
			;LEADING ZERO.

	ENTRY	%FLOUT,%DOUBT,%GROUT,%EOUT

	EXTERN	%EEMUL,%EEDIV
	EXTERN	%OBYTE,%EXP10,%HITEN,%LOTEN,%SPFLG
	EXTERN	%FWVAL,%DWVAL,%XPVAL
	EXTERN	IO.ADR,IO.TYP,%SCLFC,%SAVE4,%FTAST,%FTSLB
	EXTERN	%SIZTB,%HIINT,%LOINT
	EXTERN	%NMEXP,%PMEXP,%OMPAD,%OMSPC,%CBDO
	EXTERN	%FTSUC

	SEGMENT	CODE
%EOUT:	MOVEI	T1,"E"		;OUTPUT AN "E" WITH EXPONENT
	MOVEM	T1,EXPCHR	;SAVE IT
	JRST	COMDE		;JOIN COMMON CODE IN %DOUBT

%DOUBT:	MOVEI	T1,"D"		;OUTPUT A "D" WITH EXPONENT
	MOVEM	T1,EXPCHR
COMDE:	PUSHJ	P,%SAVE4	;SAVE P1-P4
	PUSHJ	P,FLOCNV	;CONVERT TO FRACTION AND DECIMAL EXPONENT
	PUSHJ	P,FLOUT6	;GET FIELD WIDTHS

;E-FORMAT REQUIRES THAT THE NUMBER OF SIGNIFICANT DIGITS IS
;CALCULATED AS FOLLOWS: IF THE SCALE FACTOR IS POSITIVE, ENCODE
;D+1 DIGITS (WHERE D IS THE DECIMAL WIDTH), UNLESS THE SCALE
;FACTOR IS GREATER THAN D+1, IN WHICH CASE ENCODE %SCLFC DIGITS.
;IF THE SCALE FACTOR IS NEGATIVE OR ZERO, ENCODE D+%SCLFC DIGITS, I.E.,
;REDUCE THE NUMBER OF DIGITS ENCODED.
GECNV1:	DMOVE	T0,%FLRDF	;GET 2-WORD FRACTION AGAIN
	MOVE	P3,P2		;GET # DECIMAL PLACES
	SKIPLE	T2,%SCLFC	;POSITIVE SCALE FACTOR?
	 MOVEI	T2,1		;YES. SET TO 1 FOR ADD
	ADD	P3,T2		;ADD SCLFCT OR 1
	CAMGE	P3,%SCLFC	;IS SCLFCT .GT. D+1?
	 MOVE	P3,%SCLFC	;YES. ENCODE %SCLFC DIGITS
	PUSHJ	P,DIGOK		;ENCODE DIGITS
	 JRST	FLOU16		;NO ROUNDING OVERFLOW OCCURRED

;OVERFLOW ROUNDING OCCURRED. IF NO DIGITS HAVE BEEN ENCODED, DON'T
;TOUCH ANYTHING. IF DIGITS HAVE BEEN ENCODED, THE NUMBER IS
;ONE FACTOR OF 10 TOO BIG, SO RELOAD THE NUMBER WITH THE
;NEXT TABLE ENTRY DOWN.

	JUMPG	P3,GESCL	;DON'T BOTHER ANYTHING IF NO DIGITS
	MOVEI	P3,1		;1 DIGIT HAS BEEN ENCODED
	JRST	FLOU16		;GO SAVE IT

GESCL:	MOVE	T0,%HIINT-1(P3)	;GET SCALED-DOWN FACTOR OF 10
	MOVE	T1,%LOINT-1(P3)
	AOS	%FLRDX		;INCREMENT EXPONENT, HOWEVER

FLOU16:	DMOVEM	T0,%FLINT	;SAVE 2-WORD INTEGER
	MOVE	P4,%SCLFC	;GET SCALE FACTOR
	JUMPLE	P4,FLOU17	;IF FACTOR .LE. 0, GO CHECK EXP
	SUBI	P1,1		;EXTRA DIGIT PRINTED
	SUBI	P2,-1(P4)	;REDUCE DIGITS AFTER POINT
	JUMPGE	P2,FLOU17	;TO COMPENSATE FOR THOSE IN FRONT
	ADD	P1,P2		;HOWEVER IF NOT ENOUGH LEFT
				;TAKE FROM IN FRONT
FLOU17:	PUSHJ	P,CHEKDE	;CHECK EXPONENT AND FIT, SKIP RETURN IF OK
	 JRST	%FTSUC		;PRINT ASTERISKS IF IT DOESN'T FIT
	JRST	EFORM		;OUTPUT NUMBER

;G-FORMAT OUTPUT. IF THE VALUE IS .GE. 0.1 AND .LT. 10**D, IT IS
;PRINTED IN F-FORMAT. OTHERWISE IT IS PRINTED IN E-FORMAT. IN THE
;CASE THAT IT IS PRINTED IN F-FORMAT, THE SCALE FACTOR HAS NO EFFECT.
%GROUT:	PUSHJ	P,%SAVE4	;SAVE P1-P4
	MOVEI	T1,"E"		;USE "E" IF WE GO TO E-FORMAT
	MOVEM	T1,EXPCHR
	PUSHJ	P,FLOCNV	;CONVERT TO FRACTION AND DECIMAL EXPONENT
	PUSHJ	P,FLOUT6	;GET FIELD WIDTHS

;HERE IS THE FIRST G-FORMAT NUMBER FILTER. THE NUMBER IS CHECKED
;IF IT IS "PROPER MAGNITUDE" FOR G-FORMAT. IF THE MAGNITUDE OF THE
;NUMBER IS SMALLER THAN 10**D OR GREATER THAN OR EQUAL TO 0.1,
;THE NUMBER SHOULD BE PRINTED IN F-FORMAT. SINCE THE NUMBER HAS NOT
;BEEN ROUNDED YET, WE CHECK THE NUMBER JUST USING THE DECIMAL EXPONENT,
;AND ALLOW NUMBERS WITH XP GREATER THAN -1 (WHICH COULD INCLUDE
;NUMBERS LESS THAN 0.1). A SECOND CHECK IS DONE AFTER
;THE NUMBER HAS BEEN ENCODED, TO SEE IF ROUNDING FORCED THE NUMBER
;INTO OR OUT OF THE F-FORMAT RANGE.

	JUMPE	T0,GECNV1	;IF ZERO, MAKE IT E-FORMAT
	MOVE	T2,%FLRDX	;GET DECIMAL EXPONENT
	CAML	T2,[-1]		;IF EXPONENT .LT. 1
	 CAMLE	T2,P2		;OR .GT. # DECIMAL PLACES
	  JRST	GECNV1		;MAKE IT E-FORMAT

;HERE WE FIGURE OUT HOW MANY SIGNIFICANT DIGITS TO GET FROM THE
;NUMBER.  FOR G-FORMAT, THIS IS JUST "D" (AS IN W.D).
;THE NUMBER IS ENCODED INTO P3 DIGITS, AND THE
;ACTUAL NUMBER IS IN T0/T1.

	MOVE	P3,P2		;GET # DECIMAL PLACES
	PUSHJ	P,DIGOK		;ENCODE DIGITS
	 JRST	GNORND		;DID NOT OVERFLOW ROUND

;OVERFLOW ROUNDING HAS OCCURRED. CHECK THE EXPONENT AGAIN TO SEE
;IF THE NUMBER IS STILL IN RANGE FOR F-FORMAT PRINTING.

	CAMG	P2,%FLRDX	;IS NON-UPDATED EXPONENT OK?
	 JRST	GECNV1		;NO. GO PRINT IT AS E-FORMAT

	AOS	%FLRDX		;UPDATE EXPONENT
	ADDI	P3,1		;UPDATE # DIGITS ENCODED

GNORND:	DMOVEM	T0,%FLINT	;SAVE 2-WORD INTEGER
	SKIPGE	T2,%FLRDX	;SEE IF EXPONENT STILL NEGATIVE
	 JRST	GECNV1		;IF SO, PRINT AS E-FORMAT

	MOVEI	P4,(T2)		;MAKE DECIMAL EXPONENT THE # LEADING DIGITS
	SUBI	P2,(T2)		;REDUCE DIGITS AFTER POINT

	MOVE	T2,%XPVAL	;GET EXPONENT WIDTH
	CAIN	T2,0		;OR USE DEFAULT
	 MOVEI	T2,2
	ADDI	T2,2		;ADD 2 FOR E+
	MOVEM	T2,EXPWID	;SAVE FOR LATER
	SUBI	P1,(T2)		;REDUCE WIDTH WHERE EXPONENT WOULD GO
	PUSHJ	P,TRYFIT	;CHECK FOR FIT, SKIP RETURN IF IT DOESN'T
	 JRST	%FTSUC		;DOESN'T. GO PRINT ASTERISKS
	PUSHJ	P,FFORM		;OUTPUT NUMBER IN F-FORMAT
	MOVE	T3,EXPWID	;OUTPUT BLANKS WHERE EXPONENT WOULD GO
	PJRST	%OMSPC

;F-FORMAT - PRINT THE NUMBER IN STANDARD FIXED-POINT NOTATION nnnn.nnnn
;WITHOUT EXPONENT. IF THERE IS A SCALE FACTOR, ACTUALLY CHANGE THE
;OUTPUT TO BE THAT FACTOR OF 10 LARGER OR SMALLER THAN THE DATA.
%FLOUT:	PUSHJ	P,%SAVE4	;SAVE P1-P4
	PUSHJ	P,FLOCNV	;CONVERT TO FRACTION AND DECIMAL EXPONENT
	PUSHJ	P,FLOUT6	;GET FIELD WIDTHS

	MOVE	P3,P2		;GET # DECIMAL PLACES
	ADD	P3,%FLRDX	;ADD MAGNITUDE OF NUMBER
	ADD	P3,%SCLFC	;ADD SCLFCT TO # DIGITS DESIRED
	PUSHJ	P,DIGOK		;ENCODE DIGITS
	 JRST	FNORND		;NO OVERFLOW ROUNDING OCCURRED

;OVERFLOW ROUNDING HAS OCCURRED. INCREMENT THE EXPONENT AND THE
;NUMBER OF DIGITS ENCODED.

	AOS	%FLRDX		;INCREMENT EXPONENT
	ADDI	P3,1		;INCREMENT # DIGITS ENCODED

;WE ARE NOW READY TO OUTPUT THE NUMBER. CALCULATE THE NUMBER
;OF LEADING DIGITS IN P4.
FNORND:	DMOVEM	T0,%FLINT	;SAVE 2-WORD INTEGER
	MOVE	P4,%SCLFC	;GET SCALE FACTOR
	JUMPG	P3,POSDIG	;CLEAR SCALE FACTOR IF NO DIGITS ENCODED
	SETZ	P4,		;YES. SET SCALE FACTOR TO 0
POSDIG:	ADD	P4,%FLRDX	;COUNT THE LEADING DIGITS
	JUMPLE	P4,NEGSCL	;IGNORE NEG SCALING
	SUBI	P1,(P4)		;REDUCE WIDTH BY # LEADING DIGITS
NEGSCL:	PUSHJ	P,TRYFIT	;CHECK FIT, SKIP RETURN IF IT DOES
	 JRST	%FTSUC		;OUTPUT ASTERISKS IF IT DOESN'T FIT
	JRST	FFORM		;OUTPUT NUMBER

;CONVERT THE BINARY FLOATING-POINT MANTISSA IN T0/T1 TO A NUMBER
;IN THE RANGE .1 .LE. X .LT. 1.0, WITH A NORMALIZED MANTISSA
;IN T0/T1 AND A DECIMAL EXPONENT IN XP.
FLOCNV:	TXZ	S3,LOCFLG	;CLEAR LOCAL FLAGS IN F
	MOVE	T1,IO.TYP	;GET VARIABLE TYPE
	JRST	FLOBT(T1)	;DO FLOATING OUTPUT BY TYPE

FLOBT:	JRST	FLOSPR		;(0) UNDEFINED (INTEGER)
	JRST	FLOSPR		;(1) LOGICAL
	JRST	FLOSPR		;(2) INTEGER
	JRST	FLOSPR		;(3)
	JRST	FLOSPR		;(4) SINGLE REAL
	JRST	FLOSPR		;(5)
	JRST	FLOSPR		;(6) SINGLE OCTAL (INTEGER)
	JRST	FLOSPR		;(7) LABEL
	JRST	FLODPR		;(10) DOUBLE REAL
	JRST	FLODPR		;(11) DOUBLE INTEGER
	JRST	FLODPR		;(12) DOUBLE OCTAL
	JRST	FLOGPR		;(13) EXTENDED DOUBLE REAL
	JRST	FLOSPR		;(14) COMPLEX
	POPJ	P,		;(15) COBOL BYTE STRING
	POPJ	P,		;(16)
	POPJ	P,		;(17) ASCIZ

FLOSPR:	SETZ	T1,		;CLEAR 2ND WORD
	MOVE	T0,@IO.ADR	;GET SINGLE WORD
	JUMPG	T0,.+2		;IF POSITIVE, LEAVE ALONE
	MOVN	T0,T0		;IF NEGATIVE, MAKE POSITIVE
	LDB	P1,[POINT 9,T0,8] ;GET EXPONENT
	HRREI	P1,-200(P1)	;EXPONENT IS EXCESS 200
	TLZ	T0,777000	;CLEAR THE EXPONENT
	JRST	FLOCOM		;JOIN COMMON CODE

FLODPR:	DMOVE	T0,@IO.ADR	;GET D.P. DATA
	TLZ	T1,400000	;CLEAR TRASH BIT IN 2ND WORD
	JUMPG	T0,.+2		;IF POSITIVE, LEAVE ALONE
	DMOVN	T0,T0		;IF NEGATIVE, MAKE POSITIVE
	LDB	P1,[POINT 9,T0,8] ;GET EXPONENT
	HRREI	P1,-200(P1)	;EXPONENT IS EXCESS 200
	TLZ	T0,777000	;CLEAR THE EXPONENT
	JRST	FLOCOM		;JOIN COMMON CODE

FLOGPR:	DMOVE	T0,@IO.ADR	;GET D.P. DATA
	TLZ	T1,400000	;CLEAR TRASH BIT IN 2ND WORD
	JUMPG	T0,.+2		;IF POSITIVE, LEAVE ALONE
	DMOVN	T0,T0		;IF NEGATIVE, MAKE POSITIVE
	LDB	P1,[POINT 12,T0,11] ;GET EXPONENT
	HRREI	P1,-2000(P1)	;EXPONENT IS EXCESS 2000
	TLZ	T0,777700	;CLEAR THE EXPONENT
	ASHC	T0,3		;MAKE MANTISSA LOOK LIKE REAL

;THE INTENTION IN THE CODE FOLLOWING IS TO LEFT-JUSTIFY THE MANTISSA
;AFTER EXTRACTING THE BINARY EXPONENT, AND THEN TO "SCALE" THE NUMBER
;BY ONE OR MORE POWERS OF TEN SO THAT IT ENDS UP WITH VALUE LESS
;THAN 1.0 BUT GREATER THAN OR EQUAL TO 0.1, KEEPING TRACK OF THE
;POWERS OF TEN USED IN THE SCALING PROCESS. THESE POWERS OF TEN
;ARE ACCUMULATED INTO A DECIMAL EXPONENT, KEPT IN XP.
;
;EXTENDED EXPONENT NUMBERS WHICH REQUIRE A HUGE POWER OF TEN TO SCALE
;THEM DOWN (OR UP) ARE FILTERED THROUGH A SPECIAL ROUTINE WHICH USES
;A SPARSE POWER OF TEN TABLE TO BRING THE NUMBER INTO THE "NORMAL"
;RANGE.

FLOCOM:	SETZ	XP,		;CLEAR EXPONENT
	CAMG	P1,%PMEXP	;WITHIN NORMAL RANGE?
	 CAMGE	P1,%NMEXP
	  PUSHJ	P,EEDEC		;NO. REDUCE EE NUMBER TO NORMAL RANGE

	MOVE	T3,T0		;GET THE HI FRACTION
	JFFO	T3,FLOU2A	;GET HI BIT
	EXCH	T0,T1		;NONE. SWAP LO AND HI
	SUBI	P1,^D35		;AND DECR BINARY EXPONENT
	MOVE	T3,T0		;GET NEW HI WORD
	JFFO	T3,FLOU2A	;GET HI BIT
	SETZM	%FLRDX		;NUMBER IS ZERO. CLEAR EXPONENT
	DMOVEM	T0,%FLRDF	;AND FRACTION
	POPJ	P,

FLOU2A:	ASHC	T0,-1(T4)	;NORMALIZE NUMBER
	SUBI	P1,-^D9(T4)	;AND MODIFY BINARY EXPONENT
				;8 MORE ADDED TO EXPONENT BECAUSE
				;IT WAS NORMALIZED ON BIT 9
FLOU2B:	MOVE	P2,P1		;GET BINARY EXPONENT
	IMULI	P2,232		;DEC EXP=LOG10(2)*BIN EXP=.232(OCTAL)*BIN EXP
	ADDI	P2,400		;ROUND TO NEAREST INTEGER
	ASH	P2,-^D9		;GET RID OF 3 OCTAL FRACTION DIGITS
				;THE ABOVE WORKS FOR NEGATIVE EXPONENTS BECAUSE
				;THE ASH TRUNCATION EFFECTIVELY
				;ROUNDS UP IN THE NEGATIVE DIRECTION
				;FOR NEGATIVE VALUES

;P2 HOLDS A FIRST TRIAL DECIMAL EXPONENT. IT MAY BE
;ONE (BUT NO MORE) TOO SMALL TO DIVIDE THE BINARY NUM
;BY TO GET THE RANGE 1.0 .GT. NUM .GE. 0.1

FLOUT3:	CAMGE	P1,%EXP10(P2)	;IS NUMBER'S EXP .GE. POWER OF TEN'S?
	 JRST	FLOT4A		;NO. OK
	CAME	P1,%EXP10(P2)	;ARE THEY EQUAL?
	 AOJA	P2,FLOT4A	;NUMBER'S IS GREATER. USE BIGGER POWER OF TEN
	CAMGE	T0,%HITEN(P2)	;YES. IS HIGH WORD .GE. POWER OF TEN'S?
	 JRST	FLOT4A		;NO. OK
	CAMN	T0,%HITEN(P2)	;YES. ARE THEY EQUAL?
	 CAML	T1,%LOTEN(P2)	;YES. IS LOW WORD .LT. POWER OF TEN'S?
	  ADDI	P2,1		;NO. USE BIGGER POWER OF TEN
FLOT4A:	PUSHJ	P,DPMUL		;SCALE BY POWER OF 10
	DMOVEM	T0,%FLRDF	;SAVE 2-WORD DECIMAL FRACTION
	MOVEM	XP,%FLRDX	;AND DECIMAL EXPONENT
	POPJ	P,

FLOUT6:	MOVE	P1,%FWVAL	;GET FIELD WIDTH
	MOVE	P2,%DWVAL	;GET DECIMAL WIDTH
	JUMPN	P1,FLOU6E	;IF ZERO, DEFAULT BOTH
	MOVE	P2,IO.TYP	;GET DATA TYPE
	MOVE	P2,%SIZTB(P2)	;GET DATA SIZE
	HLRZ	P1,FLFWID(P2)	;GET DEFAULT FIELD WIDTH
	HRRZ	P2,FLFWID(P2)	;GET DEFAULT DECIMAL WIDTH
FLOU6E:	SUBI	P1,2(P2)	;REDUCE WIDTH FOR SIGN, POINT, AND DEC
	POPJ	P,

;HERE THE NUMBER IS "ENCODED", I.E., TURNED INTO A 2-WORD INTEGER
;ACCORDING TO THE NUMBER OF DIGITS TO "ENCODE" IN P3. THE DECIMAL
;FRACTION IS MULTIPLIED BY THE APPROPRIATE POWER OF TEN. THE 3RD
;WORD THEN CONTAINS THE ROUNDING BIT. IF IT IS ON, 1 IS ADDED TO THE
;2-WORD PRODUCT, AND IT IS COMPARED WITH THE FACTOR OF 10 USED FOR
;THE ORIGINAL MULTIPLIER. IF THEY ARE EQUAL, OVERFLOW ROUNDING HAS
;OCCURRED (E.G. THE FRACTION .99995, WHEN MULTIPLIED BY 10**4 AND
;ROUNDED WOULD YIELD 10**4), AND A SKIP RETURN IS TAKEN.
DIGOK:	JUMPE	T0,NODIG	;IF NUMBER IS ZERO, ENCODE NO DIGITS
	JUMPL	P3,DIGZER	;IF # DIGITS TO ENCODE .LT. 0, LEAVE
	CAILE	P3,DPMAX	;TOO MANY DECIMAL PLACES
	 MOVEI	P3,DPMAX	;YES, REDUCE TO MAX POSSIBLE
	MOVE	T2,%HIINT(P3)	;GET HIGH FACTOR OF 10
	MOVE	T3,%LOINT(P3)	;GET LOW FACTOR OF 10
	DMUL	T0,T2		;GET PRODUCT
	TLNN	T2,(1B1)	;ROUNDING BIT ON?
	 POPJ	P,		;NO.
	DADD	T0,[EXP 0,1]	;YES. ADD 1 TO 2-WORD RESULT
	CAMN	T0,%HIINT(P3)	;DID WE OVERFLOW ROUND
	 CAME	T1,%LOINT(P3)
	  POPJ	P,		;NO
	AOS	(P)		;YES. SKIP RETURN
NODIG:	POPJ	P,

DIGZER:	DMOVE	T0,[EXP 0,0]	;GET 2 ZEROES
	POPJ	P,		;NO OVERFLOW ROUNDING


;CHECK TO SEE IF THE EXPONENT WILL FIT, THEN JOIN
;THE CODE WHICH CHECKS TO SEE WHETHER THE NUMBER WILL FIT
CHEKDE:	MOVE	T2,%XPVAL	;GET EXPONENT WIDTH
	JUMPN	T2,GOTEXW	;MIGHT BE DEFAULT
	MOVEI	T2,2		;WHICH IS 2
GOTEXW:	MOVEM	T2,EXPWID	;SAVE FOR PRINTING OF EXPONENT
	MOVE	T1,%FLRDX	;GET EXPONENT
	SUB	T1,P4		;REDUCE BY SCALE FACTOR
	MOVM	T1,T1		;GET MAGNITUDE
	CAMGE	T1,EXPTAB(T2)	;[3273] WILL EXPONENT FIT?
	 JRST	EXPOK		;[3273] YES
	MOVE	T3,%XPVAL	;[3273] NO. IF EXPONENT WIDTH GIVEN, DIE
	JUMPN	T3,NOFIT	;[3273] TOO BAD. THE STANDARD REQUIRES STARS
	TXO	S3,NOEFLG	;MAYBE JUST BARELY WITH NO "D" OR "E"
	CAML	T1,EXPTAB+1(T2)	;WILL IT FIT AT ALL?
	 JRST	NOFIT		;NO
EXPOK:	SUBI	P1,(T2)		;REDUCE SPACE FOR EXPONENT
	SUBI	P1,2		;ALLOW FOR E+ OR + AND 1ST DIGIT OF EXP
TRYFIT:	JUMPG	P1,FIT		;WILL IT FIT?
	JUMPL	P1,TRYF0	;NO. SERIOUS IF .LT. 0
	JUMPG	P4,FIT		;C=0, OK IF DIGITS BEFORE POINT
IFN LZALWAYS,<
	SKIPL	@IO.ADR		;IS SIGN POSITIVE?
	 SKIPE	%SPFLG		;YES. CAN WE SHED PLUS SIGN?
	  JRST	CHKDEC		;NO. CHECK IF DIGITS AFTER POINT
	AOJA	P1,POSIGN	;YES. ELIMINATE IT FOR LEADING ZERO>
CHKDEC:	JUMPG	P2,FIT		;NO. BUT WE'RE OK IF DIGITS AFTER POINT
TRYF0:	SKIPL	@IO.ADR		;IS SIGN POSITIVE?
	 SKIPE	%SPFLG		;YES. CAN WE SHED PLUS SIGN?
	  JRST	NOFIT		;NO. NO GOOD
	JUMPG	P2,TRYF1	;YES. ANY DIGITS AFTER POINT?
	JUMPG	P4,TRYF1	;NO. ANY DIGITS BEFORE POINT?
	JUMPL	P1,NOFIT	;NO. MUST BE ROOM FOR LEADING 0
TRYF1:	CAML	P1,[-1]		;YES. WOULD THERE BE ROOM WITHOUT SIGN?
	AOJA	P1,POSIGN	;YES. PRINT WITHOUT SIGN

NOFIT:	SKIPE	%FWVAL		;IF FREE FORMAT
	 JRST	FIT		;IT ALWAYS FITS
	SKIPE	%FTAST		;ASTERISKS FOR OVERFLOW?
	 POPJ	P,		;YES. NON-SKIP RETURN

	SKIPGE	@IO.ADR		;NEGATIVE?
	 JRST	NOFIT1		;YES. CAN'T REMOVE SIGN
	ADDI	P1,1		;NO. REMOVE SIGN
	TXO	S3,NOSIGN	;AND PRINT NO SIGN LOC
NOFIT1:	ADD	P2,P1		;REDUCE # DIGITS AFTER DEC POINT
	JUMPGE	P2,FITDIV	;IF WE HAVE NEGATIVE
	TXO	S3,NOPNT		;OUTPUT NO DECIMAL POINT
	AOJGE	P2,FITDIV	;IF WE STILL HAVE NEGATIVE
	ADD	P4,P2		;REDUCE THE DIGITS BEFORE DEC PNT
	ADD	P1,P2		;ACCUMULATE NEG # DIGITS TRUNCATED
FITDIV:	MOVM	P1,P1		;GET POSITIVE
	SETZB	T0,T1		;CLEAR HIGH ORDER WORDS
	DMOVE	T2,%FLINT	;GET 2-WORD INTEGER
	MOVE	T4,%HIINT(P1)	;DIVIDE BY 10**P1
	MOVE	T5,%LOINT(P1)
	DDIV	T0,T4
	DMOVEM	T0,%FLINT	;SAVE AGAIN FOR OUTPUT
	SETZ	P1,		;CLEAR ROOM LEFT
	AOS	(P)		;SKIP RETURN
	POPJ	P,

FIT:	JUMPLE	P1,NOSPC	;NO EXTRA SPACE
	MOVEI	T3,(P1)		;GET # SPACES LEFT
	CAIG	P4,0		;IF INTEGER PART, DON'T NEED LEADING 0
	 SOJA	T3,GOSPC	;NO INTEGER PART, LEAVE ROOM FOR 0
	SUBI	P1,(T3)		;UPDATE ROOM LEFT
GOSPC:	PUSHJ	P,%OMSPC	;OUTPUT SPACES
NOSPC:	AOS	(P)		;SKIP RETURN
	POPJ	P,

POSIGN:	TXO	S3,NOSIGN	;SIGNAL NO ROOM FOR SIGN
	AOS	(P)		;SKIP RETURN
	POPJ	P,		;DONE WITH FIT

;E FORMAT

EFORM:	JUMPLE	P4,EFORM1	;JUMP IF NO LEADING DIGITS
	PUSHJ	P,SIGN		;OUTPUT SIGN

	CAIG	P3,(P4)		;ANY TRAILING DIGITS ENCODED?
	 JRST	ENODIV		;IF NO ENCODED TRAILING DIGITS, NO DIV
	SUBI	P3,(P4)		;GET # TRAILING DIGITS ENCODED
	DMOVE	T2,%FLINT	;GET THE 2-WORD INTEGER
	SETZB	T0,T1		;CLEAR THE HIGH WORDS
	MOVE	T4,%HIINT(P3)	;DIVIDE BY 10**P2
	MOVE	T5,%LOINT(P3)
	DDIV	T0,T4
	MOVEM	T2,%FLINT	;SAVE REMAINDER FOR AFTER POINT
	JRST	EFDO		;GO OUTPUT LEADING DIGITS

ENODIV:	DMOVE	T0,%FLINT	;GET THE NUMBER
	MOVEI	T3,(P3)		;OUTPUT ENCODED DIGITS
	PUSHJ	P,%CBDO

	SUBI	P4,(P3)		;GET # ZEROES TO FOLLOW DIGITS
	SETZ	P3,		;CLEAR ENCODED DIGITS LEFT
	JUMPE	P4,EFPNT	;IF NONE, GO OUTPUT DEC PNT
	MOVEI	T3,(P4)		;OUTPUT ZEROES FOR REST OF LEADING DIGITS
	MOVEI	T1,"0"
	PUSHJ	P,%OMPAD
	JRST	EFPNT

EFDO:	MOVEI	T3,(P4)		;OUTPUT P4 LEADING DIGITS
	PUSHJ	P,%CBDO

EFPNT:	PUSHJ	P,PERIOD	;OUTPUT DOT
	JUMPLE	P3,EFCTZ	;NO MORE IF NO DECODED DIGITS

	DMOVE	T0,%FLINT	;GET REMAINDER OF NUMBER
	MOVEI	T3,(P2)		;GET # DIGITS TO PRINT
	PUSHJ	P,%CBDO		;OUTPUT P2 TRAILING DIGITS

EFCTZ:	SUBI	P2,(P3)		;GET # TRAILING ZEROS TO PAD
	JUMPLE	P2,EFORM4	;OUTPUT EXPONENT IF NONE
	MOVEI	T1,"0"		;OUTPUT TRAILING ZEROES
	MOVEI	T3,(P2)
	PUSHJ	P,%OMPAD
	JRST	EFORM4		;GO OUTPUT EXPONENT

;FOR NEGATIVE SCALE FACTORS, THERE ARE NO LEADING SIGNIFICANT
;DIGITS. ABS(%SCLFC) ZEROES ARE OUTPUT, FOLLOWED BY D-ABS(%SCLFC)
;SIGNIFICANT DIGITS. IF D=ABS(%SCLFC), SO THAT THERE WOULD BE NO
;SIGNIFICANT DIGITS OUTPUT AND THE LAST ZERO WOULD JUST PRECEDE
;WHERE THE 1ST SIGNIFICANT DIGIT WOULD HAVE BEEN, WE MODIFY
;THE ALGORITHM TO OUTPUT ABS(%SCLFC)-1 ZEROES AND 1 SIGNIFICANT
;DIGIT. IN THIS CASE, THE NUMBER OF DIGITS ENCODED IS 0, BUT
;THERE MIGHT HAVE BEEN ROUNDING (I.E., THE NUMBER IS .GE. 0.5),
;SO WE REALLY WANT TO PRINT A NUMBER FROM %FLINT+1 1 AS THE LAST
;DIGIT. DIGOK HAS BEEN CODED TO CHECK FOR ROUNDING EVEN IF P3=0, AND TO
;LEAVE THE ROUNDED RESULT IN T1, STORED IN %FLINT+1 (FOR P3 .LE. 0
;THE E-FORMAT CODE DOES NOT GET A REDUCED TABLE ENTRY).
EFORM1:	PUSHJ	P,SIGN		;OUTPUT SIGN
	PUSHJ	P,ZERO		;OUTPUT ZERO IF NECESSARY
EFORM2:	PUSHJ	P,PERIOD	;AND DECIMAL POINT
	JUMPLE	P2,EFORM4	;GO TO EXPONENT IF NO DIGITS
	JUMPE	P4,EFORM3	;ACCOUNT FOR ZERO SCALING
	MOVM	P4,P4		;GET MAGNITUDE
	CAIGE	P4,(P2)		;SCLFCT .GE. # DECS?
	JRST	EFRM2A		;NO. THINGS ARE OK
	CAIE	P4,(P2)		;EQUAL?
	MOVEI	P4,1(P2)	;GREATER. SET P4=D
	SUBI	P4,1		;EQUAL. SET P4=D-1
EFRM2A:	JUMPE	P4,EFORM3	;IF SCLFCT (P4) NOW ZERO, NO LEADING ZEROES
	SUBI	P2,(P4)		;REDUCE # TRAILING DIGITS
	MOVEI	T1,"0"		;OUTPUT P4 LEADING ZEROES
	MOVEI	T3,(P4)
	PUSHJ	P,%OMPAD

EFORM3:	JUMPLE	P3,EFRM3A	;LEAVE IF NO ENCODED DIGITS AFTER POINT
	DMOVE	T0,%FLINT	;GET NUMBER AGAIN
	MOVEI	T3,(P3)		;GET # DIGITS TO OUTPUT
	PUSHJ	P,%CBDO		;OUTPUT THE NUMBER

EFRM3A:	SUBI	P2,(P3)		;CALCULATE # OF TRAILING ZEROES
	JUMPLE	P2,EFORM4	;IF NONE, GO OUTPUT EXPONENT
	MOVEI	T1,"0"		;OUTPUT P2 TRAILING ZEROES
	MOVEI	T3,(P2)
	PUSHJ	P,%OMPAD

EFORM4:	MOVE	T1,EXPCHR	;GET THE EXPONENT CHAR
	TXNN	S3,NOEFLG	;DON'T PRINT IF NO ROOM
	 PUSHJ	P,%OBYTE	;OUTPUT "E" OR "D"
EFORM5:	MOVN	T1,%SCLFC	;SUBTRACT SCALE FACTOR FROM EXPONENT
	ADDM	T1,%FLRDX
	SKIPN	%FLINT		;SEE IF NUMBER IS ZERO
	 SKIPE	%FLINT+1
	  JRST	ENONZ		;NUMBER IS NOT ZERO
	SETZM	%FLRDX		;NUMBER IS ZERO. SET EXPONENT TO 0
ENONZ:	PUSHJ	P,ESIGN		;PRINT SIGN
	MOVE	T3,EXPWID	;AND SET DIGIT COUNT
	TXNE	S3,NOEFLG	;DID WE PRINT "D" OR "E"?
	ADDI	T3,1		;NO. MORE ROOM FOR EXPONENT

	SETZ	T0,		;HIGH ORDER WORD IS ZERO
	MOVM	T1,%FLRDX	;GET DECIMAL EXPONENT MAGNITUDE
	PJRST	%CBDO		;OUTPUT EXPONENT

;F FORMAT

FFORM:	JUMPLE	P4,FFORM3	;NO LEADING DIGITS
	PUSHJ	P,SIGN		;OUTPUT SIGN
	CAIG	P3,(P4)		;ENCODED DIGITS .GT. LEADING DIGITS?
	 JRST	FNODIV		;NO. NO TRAILING DIGITS, NO DIV
	SUBI	P3,(P4)		;GET # TRAILING ENCODED DIGITS
	DMOVE	T2,%FLINT	;GET NUMBER IN LOW WORDS
	SETZB	T0,T1		;CLEAR HIGH WORDS
	MOVE	T4,%HIINT(P3)	;DIVIDE BY 10**P3
	MOVE	T5,%LOINT(P3)
	DDIV	T0,T4
	DMOVEM	T2,%FLINT	;SAVE REMAINDER FOR AFTER POINT
	JRST	FFDO		;GO OUTPUT LEADING DIGITS

FNODIV:	DMOVE	T0,%FLINT	;GET THE NUMBER
	MOVEI	T3,(P3)		;OUTPUT ENCODED DIGITS
	PUSHJ	P,%CBDO

	SUBI	P4,(P3)		;GET # ZEROES
	SETZ	P3,		;AND CLEAR ENCODED DIGITS LEFT
	JUMPE	P4,FFPNT	;IF NO ZEROES, GO OUTPUT DEC PNT
	MOVEI	T3,(P4)		;OUTPUT ZEROES
	MOVEI	T1,"0"
	PUSHJ	P,%OMPAD
	JRST	FFPNT

FFDO:	MOVEI	T3,(P4)		;OUTPUT P4 LEADING DIGITS
	PUSHJ	P,%CBDO

FFPNT:	PUSHJ	P,PERIOD	;PRINT DECIMAL POINT

FFORM1:	JUMPLE	P3,FFRM1A	;IF NO ENCODED DIGITS, GO CHECK OTHERS
	MOVEI	T3,(P3)		;GET # ENCODED DIGITS TO OUTPUT
	DMOVE	T0,%FLINT	;GET TRAILING NUMBER
	PUSHJ	P,%CBDO		;OUTPUT THEM

FFRM1A:	SUBI	P2,(P3)		;GET # TRAILING ZEROES
	SKIPG	T3,P2		;ANY?
	 POPJ	P,		;NO. DONE
	MOVEI	T1,"0"		;OUTPUT P2 TRAILING ZEROES
	PJRST	%OMPAD

FFORM3:	PUSHJ	P,SIGN		;OUTPUT SIGN
	PUSHJ	P,ZERO		;OUTPUT LEADING "0" IF NECESSARY
	PUSHJ	P,PERIOD	;OUTPUT DEC. POINT
	ADD	P2,P4		;REDUCE DEC BY # ZEROES TO PRINT
	JUMPGE	P2,FFRM3C	;FINISH IF OK
	SUB	P2,P4		;RESTORE ORIGINAL # DEC PLACES
	SKIPG	T3,P2		;ANY TRAILING DIGITS AT ALL?
	 POPJ	P,		;NO. DONE
	MOVEI	T1,"0"		;YES. OUTPUT THEM
	PJRST	%OMPAD		;AND LEAVE

FFRM3C:	MOVM	T3,P4		;OUTPUT ABS(P4) ZEROES
	MOVEI	T1,"0"
	PUSHJ	P,%OMPAD
	JRST	FFORM1

;WE USE A SPARSE POWER OF TEN TABLE TO SCALE THE MANTISSA
;AND LOWER THE MAGNITUDE OF THE BINARY EXPONENT. THE TABLE IS ARRANGED
;SO THAT EACH POWER OF TEN WILL SCALE 2**35 MORE THAN THE NEXT,
;SO WE JUST DIVIDE THE BINARY EXPONENT BY 35 TO GET THE TABLE ENTRY
;TO USE.
;WE LEAVE THE MANTISSA ALIGNED WITH BIT 9 TO AVOID DIVIDE CHECKS. WE
;DON'T LOSE ANY PRECISION THEREBY BECAUSE FOR BOTH MULTIPLICATION
;AND DIVISION WE GET A 4-WORD RESULT. AFTER THE SCALING OPERATION,
;WE HAVE TO ALIGN THE MANTISSA ON BIT 1. THIS TIME,
;HOWEVER, IT MIGHT START ANYWHERE, SO WE CALL %EENRM.
EEDEC:	MOVM	P2,P1		;GET MAGNITUDE OF EXP
	SUBI	P2,^D70		;MODIFY FOR SPARSE 10'S TABLE
	IDIVI	P2,^D35		;DERIVE INDEX FOR EXPONENT
	IMULI	P2,3		;GET PROPER INDEX
	JUMPL	P1,EENEG	;GO DO MUL IF NEGATIVE
	PUSHJ	P,%EEDIV	;AND DIVIDE IF POSITIVE
	SUBI	P1,(P3)		;REDUCE THE BINARY EXPONENT
	POPJ	P,

EENEG:	PUSHJ	P,%EEMUL	;DO D.P. MULT
	MOVNI	XP,(XP)		;RECORD NEGATIVE DECIMAL EXPONENT
	ADDI	P1,(P3)		;REDUCE MAGNITUDE OF BINARY EXP
	POPJ	P,

;SCALE THE BINARY FRACTION BY A POWER OF TEN. SINCE THE OBJECT OF
;THIS EXERCISE IS TO PRODUCE A NUMBER [0.1 .LT. NUMBER .LT. 1.0],
;P2 WILL HAVE BEEN CHOSEN SUCH THAT THE BINARY EXPONENT
;CORRESPONDING TO THE POWER OF TEN, %EXP10(P2), IS GREATER THAN
;OR EQUAL TO THE BINARY EXPONENT OF THE ORIGINAL NUMBER, P1. THEREFORE
;WHEN %EXP10(-P2) IS ADDED TO P1, THE "LEFTOVER" BINARY EXPONENT
;SHOULD BE ZERO OR LESS. HOWEVER, BECAUSE OF THE ASSYMETRY OF
;THE POWER OF TEN TABLE (THE BINARY EXPONENT ASSOCIATED WITH 0.1
;IS -3, WHEREAS THE BINARY EXPONENT ASSOCIATED WITH 10 IS 4),
;THE "LEFTOVER" CAN BE 1. AT THE END OF THE SCALING, WE SHIFT THE RESULT
;USING THIS "LEFTOVER" EXPONENT, SO THAT IT HAS AN EFFECTIVE BINARY
;EXPONENT OF ZERO, AN ABSOLUTE FRACTION, WHICH CAN THEN BE USED
;DIRECTLY TO ENCODE DIGITS.

DPMUL:	JUMPN	P2,EXPNZ	;IF DEC EXP IS NONZERO, CONTINUE
	SETZ	T2,		;CLEAR THE 3RD AND 4TH WORDS
	SETZ	T3,
	JUMPN	P1,DPSCAL	;IF LEFTOVER, GO SCALE FRACTION
	POPJ	P,		;NONE LEFT

EXPNZ:	ADD	XP,P2		;PUT DEC SCALE FACTOR INTO XP
	MOVN	P2,P2		;TAKE RECIPROCAL OF POWER OF TEN
	ADD	P1,%EXP10(P2)	;ADD CORRESPONDING BIN EXP

	MOVE	T2,%HITEN(P2)	;GET DOUBLE SCALING FACTOR
	MOVE	T3,%LOTEN(P2)
	ADDI	T3,1		;BIAS IT - IT IS TRUNCATED
	DMUL	T0,T2		;GET DP PRODUCT
	JUMPE	P1,NOSCAL	;NO MORE SCALING IF NO LEFTOVER

DPSCAL:	MOVN	T4,P1		;GET THE NEGATIVE OF SHIFT
	JUMPL	P1,RSHIFT	;NEGATIVE IS THE USUAL CASE
	ASHC	T0,(P1)		;SCALE 1ST AND 2ND WORDS
	ASH	T1,(T4)		;GET 2ND WORD BACK AGAIN
	ASHC	T1,(P1)		;SCALE 2ND AND 3RD WORDS
	ASH	T2,(T4)		;GET 3RD WORD BACK AGAIN
	ASHC	T2,(P1)		;SCALE 3RD AND 4TH WORDS
	JRST	NOSCAL		;GO CHECK 3RD AND 4TH WORDS

RSHIFT:	ASHC	T2,(P1)		;SCALE 3RD AND 4TH WORDS
	ASH	T2,(T4)		;GET 3RD WORD BACK AGAIN
	ASHC	T1,(P1)		;SCALE 2ND AND 3RD WORD
	ASH	T1,(T4)		;GET 2ND WORD BACK AGAIN
	ASHC	T0,(P1)		;SCALE 1ST AND 2ND WORD
NOSCAL:	CAIN	T2,0		;IF ANY DATA IN 3RD OR 4TH WORD
	 CAIE	T3,0
	  DADD	T0,[EXP 0,1]	;ADD 1 TO 2-WORD PRODUCT
	POPJ	P,		;RETURN

; OUTPUT ROUTINES

PERIOD:	TXNE	S3,NOPNT		;SUPPRESS DEC PNT?
	 POPJ	P,		;YES. JUST LEAVE
	MOVEI	T1,"."		;DECIMAL POINT
	PJRST	%OBYTE		;PRINT AND RETURN

SPACE:	SKIPE	%FTSLB		;SUPPRESS LEADING BLANKS?
	 POPJ	P,		;YES. LEAVE
	MOVEI	T1," "		;SPACE
	PJRST	%OBYTE

ZERO:
IFN LZALWAYS!LZSOME,<
	JUMPLE	P1,NOLZ		;AND IF WE CAN,>
IFE LZALWAYS!LZSOME,<
	JUMPG	P2,NOLZ		;OR IF NO TRAILING DIGITS>
	MOVEI	T1,"0"
	JRST	%OBYTE
NOLZ:	POPJ	P,

SIGN:	TXZE	S3,NOSIGN	;NO ROOM FOR SIGN?
	 POPJ	P,		;JUST RETURN
	MOVEI	T1," "
	SKIPE	%SPFLG		;FORCE PLUS SIGN?
	 MOVEI	T1,"+"		;YES
	SKIPGE	@IO.ADR		;IF NUMBER NEGATIVE
	 MOVEI	T1,"-"		;USE MINUS
	CAIN	T1," "		;IS IT A SPACE?
	 SKIPN	%FTSLB		;YES. SUPPRESS LEADING BLANK?
	  PJRST	%OBYTE		;NO. PRINT
	POPJ	P,

ESIGN:	MOVEI	T1,"+"
	SKIPGE	%FLRDX		;IF EXPONENT NEGATIVE
	 MOVEI	T1,"-"		;OUTPUT MINUS SIGN
	PJRST	%OBYTE		;OUTPUT THE SIGN

FLFWID:	0
	^D15,,7			;15.7 DEFAULT
	^D25,,^D17		;25.17 DEFAULT

EXPTAB:	1	;10**0
	^D10	;10**1
	^D100	;10**2
	^D1000	;10**3

	SEGMENT	DATA

%FLRDX:	BLOCK	1		;RAW DECIMAL EXPONENT
%FLRDF:	BLOCK	2		;RAW DECIMAL FRACTION
%FLINT:	BLOCK	2		;FRACTION EXPRESSED AS AN INTEGER
EXPCHR:	BLOCK	1		;EXPONENT CHARACTER
EXPWID:	BLOCK	1		;EXPONENT WIDTH

	SEGMENT	CODE

	PRGEND
	TITLE	GSCALE	GFLOATING SCALING ROUTINES
	SEARCH	MTHPRM


;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1983, 1985
;ALL RIGHTS RESERVED.

	ENTRY	%EEDIV,%EEMUL,%EENRM

	EXTERN	%BEXP,%DEXP

	SEGMENT	CODE

%EEDIV:	SETZB	T2,T3		;CLEAR LOWER AC'S
	SETZB	T4,T5		;AND EVEN LOWER AC'S
	DDIV	T0,%BEXP(P2)	;GET 2-WORD RESULT
	DDIV	T2,%BEXP(P2)	;GET 4-WORD RESULT
	JRST	EECOM		;JOIN COMMON CODE

%EEMUL:	DMOVE	T2,%BEXP(P2)	;GET POWER OF TEN
	ADDI	T3,1		;BIAS IT - IT IS TRUNCATED
	DMUL	T0,T2		;GET 4-WORD RESULT
EECOM:	PUSHJ	P,%EENRM	;NORMALIZE IT
	TLO	T0,(1B0)	;PREPARE FOR OVERFLOW
	TLNE	T2,(1B1)	;ROUNDING BIT ON?
	DADD	T0,[EXP 0,1]	;YES. ROUND UP
	TLZ	T1,(1B0)	;TURN OFF LOW SIGN
	TLZE	T0,(1B0)	;DID WE OVERFLOW?
	JRST	EEOK		;NO
	TLO	T0,(1B1)	;YES. TURN JUST HIGH BIT ON
	ADDI	P1,1		;AND INCR THE BINARY EXP
EEOK:	HLRZ	P3,%DEXP(P2)	;GET THE BINARY EXPONENT
	HRRZ	T5,%DEXP(P2)	;GET DECIMAL EXPONENT
	POPJ	P,

%EENRM:	MOVE	T4,T0		;GET THE HIGH WORD
	JFFO	T4,EENZ		;LOOK FOR 1ST 1
	DMOVE	T0,T1		;SHOVE THE NUMBER OVER
	SUBI	P1,^D35		;AND MODIFY THE EXPONENT
	MOVE	T4,T0		;TRY NEXT WORD
	JFFO	T4,EENZ
	JRST	EENEND		;STILL NONE
EENZ:	SOJE	T5,EENEND	;LEAVE STARTING AT BIT 1, DONE IF NO SHIFT
	SUB	P1,T5		;MODIFY THE BINARY EXPONENT
	MOVN	T4,T5		;AND GET NEG SHIFT ALSO
	JUMPL	T5,RGTSFT	;DIFFERENT FOR RIGHT SHIFT
	ASHC	T0,(T5)		;MOVE 1ST AND 2ND WORDS
	ASH	T1,(T4)		;MOVE BACK 2ND WORD
	ASHC	T1,(T5)		;MOVE 2ND AND 3RD WORD
EENEND:	POPJ	P,

RGTSFT:	ASHC	T1,(T5)		;MOVE 2ND AND 3RD
	ASH	T1,(T4)		;MOVE 2ND BACK
	ASHC	T0,(T5)		;MOVE 1ST AND 2ND
	POPJ	P,

	PRGEND
	TITLE	INTEG	DECIMAL INTEGER INPUT/OUTPUT 
	SUBTTL	D. TODD/DRT/HPW/MD	28-Oct-81
	SEARCH	MTHPRM




;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
;ALL RIGHTS RESERVED.

;FROM LIB40 %4(367)

	SEGMENT	CODE

	ENTRY	%INTI,%INTO,%GINTI,%GINTO
	EXTERN	%IBYTE,%OBYTE,%FWVAL,%DWVAL
	EXTERN	IO.ADR,IO.TYP,%SAVE1,%FTAST,%FTSLB
	EXTERN	%SKIP,%SPFLG
	EXTERN	%BZFLG
	EXTERN	%FTSUC,%ERTYP,IO.TYP,%FIXED
	EXTERN	%OMSPC,%CBDO,%LOINT,%HIINT,%SIZTB

DGSEEN==400000,,0		;MUST BE 400000, CHECKED WITH JUMPL
SGNFLG==200000,,0		;MINUS SIGN SEEN
OVRFLG==100000,,0		;INTEGER OVERFLOW
%GINTI:
%INTI:	PUSHJ	P,%SAVE1	;SAVE P1
	MOVE	P1,IO.ADR	;GET ADDR OF VARIABLE
	MOVE	T3,%FWVAL	;GET THE FIELD WIDTH
	SETZB	T5,T2		;CLEAR STORAGE
	SETZ	T4,
	JUMPG	T3,INTI1	;FIELD WIDTH SPECIFIED
	SETO	T3,		;SET VARIABLE FIELD FLAG
	PUSHJ	P,%SKIP		;SKIP SPACES
	  JRST	INTI6		;COMMA OR EOL (NULL FIELD)
	JRST	INTI1B		;PROCESS FIELD
INTI1:	JUMPE	T3,INTI6	;FIELD EXHAUSTED
	PUSHJ	P,%IBYTE	;NO, GET NEXT INPUT CHARACTER
INTI1B:	CAIG	T1,"9"		;CHECK FOR A
	 CAIGE	T1,"0"		;DECIMAL DIGIT (0-9)
	  JRST	INTI3		;NOT A DECIMAL DIGIT
	TXO	T2,DGSEEN	;SET DIGIT SEEN FLAG
INTI1A:	ANDI	T1,17		;MAKE A BINARY NUMBER
	MOVE	T4,T5		;PREPARE FOR 2-WORD MUL
	MULI	T4,12		;MULT NUMBER BY A POWER OF 10
	TLO	T5,400000	;TURN ON SIGN BIT TO STOP OVERFLOW
	ADD	T5,T1		;ACCUMULATE THE SUM
	TLZE	T5,400000	;DID WE OVERFLOW?
	 JUMPE	T4,INTI2	;NO. ANYTHING IN HIGH WORD?
	TXO	T2,OVRFLG	;YES. WE OVERFLOWED!
	ADDI	T4,1		;YES. ADD ONE TO OVERFLOW
INTI2:	SOJA	T3,INTI1	;GET NEXT DIGIT


;NULLS ARE LEGAL
INTI3:	JUMPN	T1,INOTNL	;IF NOT NULL, CONTINUE
	JUMPL	T3,INTFRE	;IF FREE FORMAT, GO CHECK IF ANYTHING ELSE SEEN
	SOJA	T3,INTI1	;OTHERWISE, TREAT AS BLANK WITH BLANK='NULL'

INOTNL:	CAIN	T1,11		;<TAB>
	MOVEI	T1," "		;CLEAR THE <TAB> CHARACTER
	CAIE	T1," "		;CHECK FOR A BLANK
	JRST	INTI3A		;NOT A BLANK OR <TAB>
	JUMPL	T3,INTFRE	;YES, CHECK BZ IF NOT FREE FORM
	SKIPN	%BZFLG		;BLANK=ZERO?
	 SOJA	T3,INTI1	;NO. SKIP THE CHAR
	JRST	INTI1A		;YES. TREAT AS A ZERO

INTFRE:	JUMPGE	T2,INTI1	;NO DIGITS CONTINUE SCAN IF FREE FORM
	JRST	INTI4		;DONE IF DIGITS SEEN

INTI3A:	JUMPL	T2,INTI4	;DIGIT SEEN YET
	CAIN	T1,"-"		;NO, IS THIS A MINUS SIGN
	 TXOA	T2,SGNFLG	;YES, SET THE FLAG
	CAIN	T1,"+"		;CHECK FOR A PLUS
	 TXOA	T2,DGSEEN	;TREAT SIGNS LIKE DIGITS
	JRST	INTI4		;NO. OTHER CHAR
	SOJA	T3,INTI1	;GET NEXT DIGIT

INTI4:	CAME	T3,[-1]		;IF FIRST CHAR THEN ILLEGAL
	JUMPL	T3,INTI6	;NO, CHECK FOR VARIABLE FIELD
	$ACALL	ILC		;"ILLEGAL CHARACTER IN DATA"
	POPJ	P,		;RETURN TO FOROTS

INTI6:	TXNN	T2,OVRFLG	;DID WE OVERFLOW?
	 JRST	INTI6A		;NO
	HRLOI	T1,377777	;YES. LOAD BIGGEST VALUE
	MOVEM	T1,%FIXED	;SAVE FOR POSSIBLE USER SUBSTITUTION
	MOVE	T1,IO.TYP	;GET DATA TYPE
	MOVEM	T1,%ERTYP	;SAVE FOR USER SUBR
	$ECALL	IOV
	MOVE	T5,%FIXED	;GET FIXED-UP RESULT
INTI6A:	TXNE	T2,SGNFLG	;CHECK FOR SIGN
	MOVN	T5,T5		;NEGATE THE RESULT
	MOVEM	T5,(P1)		;PUT RESULT IN USER'S VARIABLE
	POPJ	P,		;RETURN TO FOROTS
%GINTO:	MOVEI	T1,1		;AT LEAST ONE DIGIT FOR G-FORMAT
	SKIPN	%FWVAL		;IF FREE FORMAT
	 MOVEM	T1,%DWVAL
%INTO:	SKIPG	T3,%FWVAL	;GET FIELD WIDTH
	 MOVEI	T3,17		;FREE. TURN INTO FIXED!
	MOVE	T1,IO.TYP	;GET DATA TYPE
	MOVE	T1,%SIZTB(T1)	;GET DATA SIZE
	JRST	ICNV(T1)	;GO CONVERT IT

ICNV:	JRST	INTSNG		;DATA SIZE = 0
	JRST	INTSNG		;DATA SIZE = 1
	JRST	INTDBL		;DATA SIZE = 2

INTDBL:	DMOVE	T0,@IO.ADR	;GET DATA
	TLZ	T1,400000	;NO SIGN BIT IN 2ND WORD!
	JUMPE	T0,INTPOS	;HIGH WORD ZERO. TREAT AS SINGLE
	JUMPG	T0,DIPOS	;NOTHING MUCH TO DO IF POSITIVE
	CAMN	T0,[400000,,0]	;POSSIBLY LARGEST POSSIBLE NEGATIVE NUMBER?
	 JUMPE	T1,DIPOS	;IT IS IF LOW ORDER WORD IS ZERO
	DMOVN	T0,T0		;GET MAGNITUDE
DIPOS:	DMOVEM	T0,INTNUM	;SAVE IT
	EXCH	T0,T1		;SWAP FOR JFFO
	JFFO	T1,.+1		;GET 1ST BIT
	EXCH	T0,T1		;GET DATA BACK WHERE IT BELONGS
	MOVE	T2,ILOG10(T2)	;GET LARGEST NUMBER OF DIGITS TO REPRESENT IT
	CAMGE	T0,%HIINT-1(T2)	;IS NUMBER .GE. 10**(T2-1)?
	 JRST	DIRE		;NO. REDUCE NUMBER OF DIGITS
	CAME	T0,%HIINT-1(T2)	;HIGH ORDER WORD EQUAL TO 10**(T2-1)?
	 JRST	INTOCM		;NO. IT WAS GREATER. IT IS OK
	CAMG	T1,%LOINT-1(T2)	;YES. IS LOW WORD .GT. 10**(T2-1)?
DIRE:	 SUBI	T2,1		;NO. REDUCE NUMBER DIGITS NEEDED
	JRST	INTOCM		;JOIN COMMON CODE

INTSNG:	SETZ	T0,		;SINGLE INTEGER HAS NO HIGH-ORDER WORD
	SKIPL	T1,@IO.ADR	;GET THE NUMBER
	 JRST	INTPOS		;POSITIVE. NOTHING MUCH TO DO
	CAME	T1,[400000,,0]	;LARGEST NEGATIVE NUMBER?
	 JRST	NLNN		;NO
	DMOVE	T0,[EXP 1,0]	;YES. GET EQUIVALENT POSITIVE INTEGER
	DMOVEM	T0,INTNUM	;SAVE IT
	MOVE	T2,SLOG10	;SIMULATE JFFO
	JRST	INTSGN		;SKIP COMPARISON - WE KNOW IT WILL FIT

NLNN:	MOVM	T1,T1		;GET MAGNITUDE
INTPOS:	DMOVEM	T0,INTNUM	;SAVE IT
	JFFO	T1,INTNZ	;GET BIT # OF 1ST BIT
	 JRST	INTZER		;NO BITS. NUMBER IS ZERO
INTNZ:	MOVE	T2,SLOG10(T2)	;GET # DIGITS MAXIMUM TO REPRESENT IT
	CAMGE	T1,%LOINT-1(T2)	;IS NUMBER .GE. 10**(T2-1)?
	 SUBI	T2,1		;NO. NEED 1 LESS DIGIT TO REPRESENT IT
INTOCM:	SKIPG	@IO.ADR		;IS NUMBER POSITIVE?
	 JRST	INTSGN		;NO. IT MUST HAVE A SIGN
	SKIPN	%SPFLG		;IS PLUS SIGN DESIRED?
	 JRST	NOISGN		;NO
INTSGN:	CAIG	T3,(T2)		;ROOM FOR NUMBER AND SIGN?
	 JRST	INTFTS		;NO. FIELD WIDTH TOO SMALL
	MOVE	T4,%DWVAL	;GET MINIMUM # DIGITS
	CAIL	T4,(T3)		;ROOM FOR SIGN?
	 JRST	INTFTS		;NO. FIELD WIDTH TOO SMALL
	CAIGE	T2,(T4)		;IS ROOM NEEDED .GE. MINIMUM # DIGITS?
	 MOVEI	T2,(T4)		;NO. GET MINIMUM # DIGITS
	MOVEM	T2,INTDIG	;SAVE IT
	SUBI	T3,1(T2)	;GET # SPACES
	JUMPE	T3,SGNNS	;NO SPACE IF ZERO
	SKIPN	%FTSLB		;SUPPRESS LEADING BLANKS?
	 PUSHJ	P,%OMSPC	;NO. OUTPUT THEM
SGNNS:	MOVEI	T1,"-"		;ASSUME MINUS
	SKIPL	@IO.ADR		;NEGATIVE NUMBER?
	 MOVEI	T1,"+"		;NO. USE PLUS SIGN
	PUSHJ	P,%OBYTE	;OUTPUT THE SIGN
	JRST	INTOUT		;GO OUTPUT THE NUMBER

INTZER:
NOISGN:	CAIGE	T3,(T2)		;ROOM FOR NUMBER?
	 JRST	INTFTS		;NO. FIELD WIDTH TOO SMALL
	MOVE	T4,%DWVAL	;GET MINIMUM # DIGITS
	CAILE	T4,(T3)		;ROOM FOR THEM?
	 JRST	INTFTS		;NO. FIELD WIDTH TOO SMALL
	CAIGE	T2,(T4)		;IS ROOM NEEDED .GE. MINIMUM # DIGITS?
	 MOVEI	T2,(T4)		;NO. GET MINIMUM # DIGITS
	MOVEM	T2,INTDIG	;SAVE IT
	SUBI	T3,(T2)		;GET # LEADING SPACES
	JUMPE	T3,INTOUT	;NO SPACES IF ZERO
	SKIPN	%FTSLB		;SUPPRESS LEADING BLANKS?
	 PUSHJ	P,%OMSPC	;NO. OUTPUT THEM
INTOUT:	DMOVE	T0,INTNUM	;GET THE MAGNITUDE AGAIN
	SKIPE	T3,INTDIG	;AND THE WIDTH DESIRED
	 JRST	%CBDO		;OUTPUT THE NUMBER
	POPJ	P,

INTFTS:	JRST	%FTSUC		;NO HANDLING OF NOAST YET!!!


ILOG10:	^D22
	^D22
	^D22
	^D21
	^D21
	^D21
	^D20
	^D20
	^D20
	^D19
	^D19
	^D19
	^D19
	^D18
	^D18
	^D18
	^D17
	^D17
	^D17
	^D16
	^D16
	^D16
	^D16
	^D15
	^D15
	^D15
	^D14
	^D14
	^D14
	^D13
	^D13
	^D13
	^D13
	^D12
	^D12
	^D12
SLOG10:	^D11		;2**36-1=68719476735
	^D11		;2**35-1=34359738367
	^D11		;2**34-1=17179869183
	^D10		;2**33-1= 8589934591
	^D10		;2**32-1= 4294967295
	^D10		;2**31-1= 2147483647
	^D10		;2**30-1= 1073741823
	 9		;2**29-1=  536870911
	 9		;2**28-1=  268435455
	 9		;2**27-1=  134217727
	 8		;2**26-1=   67108863
	 8		;2**25-1=   33554431
	 8		;2**24-1=   16777215
	 7		;2**23-1=    8388607
	 7		;2**22-1=    4194303
	 7		;2**21-1=    2097151
	 7		;2**20-1=    1048575
	 6		;2**19-1=     524287
	 6		;2**18-1=     262143
	 6		;2**17-1=     131071
	 5		;2**16-1=      65535
	 5		;2**15-1=      32767
	 5		;2**14-1=      16383
	 4		;2**13-1=       8191
	 4		;2**12-1=       4095
	 4		;2**11-1=       2047
	 4		;2**10-1=       1023
	 3		;2** 9-1=        511
	 3		;2** 8-1=        255
	 3		;2** 7-1=        127
	 2		;2** 6-1=         63
	 2		;2** 5-1=         31
	 2		;2** 4-1=         15
	 1		;2** 3-1=          7
	 1		;2** 2-1=          3
	 1		;2** 1-1=          1

	SEGMENT	DATA

INTNUM:	BLOCK	2		;THE MAGNITUDE OF THE DATA
INTDIG:	BLOCK	1		;THE NUMBER OF DIGITS TO ENCODE

	SEGMENT	CODE

	PRGEND
	TITLE	OCTAL	OCTAL INPUT/OUTPUT 
	SUBTTL	D. TODD/DRT/HPW/MD/SWG/DCE		28-OCT-81
	SEARCH	MTHPRM




;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
;ALL RIGHTS RESERVED.

	SEGMENT	CODE

	ENTRY	%OCTI,%OCTO,%GOCTI,%GOCTO
	EXTERN	%IBYTE,%OBYTE,%FWVAL,%DWVAL,%SAVE2
	EXTERN	%SKIP,%SIZTB
	EXTERN	IO.ADR,IO.TYP,%FTAST,%FTSLB
	EXTERN	%BZFLG
	EXTERN	%FTSUC

DGSEEN==400000,,0		;MUST BE 400000, TEST WITH JUMPL
SGNFLG==200000,,0		;MINUS SIGN SEEN
%GOCTI:
%OCTI:	PUSHJ	P,%SAVE2	;SAVE P1 & P2
	PUSHJ	P,OCTSET	;DO SETUP
	SETZB	T4,T5		;CLEAR THE OUTPUT WORD
	SETZM	ODGCNT		;[3342] AND DIGIT-READ COUNT
	JUMPG	T3,OCTI1	;FIELD SPECIFIED
	SETO	T3,		;NO, SET VARIABLE FLAG
	PUSHJ	P,%SKIP		;SKIP SPACES
	  JRST	OCTI5		;NULL FIELD DELIMITED BY COMMA OR EOL
	JRST	OCTI1B		;PROCESS FIELD
OCTI1:	JUMPE	T3,OCTI5	;CHECK FOR END OF FIELD
	PUSHJ	P,%IBYTE	;GET AN INPUT CHARACTER
OCTI1B:	CAIG	T1,"7"		;CHECK FOR AN OCTAL
	 CAIGE	T1,"0"		;DIGIT (0-7)
	  JRST	OCTI2		;NO, NOT AN OCTAL DIGIT
	TXO	T2,DGSEEN	;SET DIGIT SEEN FLAG
OCTI1A:	ANDI	T1,7		;MAKE AN OCTAL DIGIT
	LSHC	T4,3		;POSITION OUTPUT WORD
	TRO	T5,(T1)		;OR IN DIGIT
	AOS	ODGCNT		;[3342] COUNT THIS DIGIT
	SOJA	T3,OCTI1	;RETURN FOR NEXT CHARACTER


;NULLS ARE LEGAL
OCTI2:	JUMPN	T1,ONOTNL	;IF NOT NULL, CONTINUE
	JUMPL	T3,OCTFRE	;IF FREE FORMAT, CHECK IF ANYTHING ELSE SEEN
	SOJA	T3,OCTI1	;OTHERWISE TREAT AS BLANK WITH BLANK='NULL'

ONOTNL:	CAIN	T1,11		;<TAB> CHARACTER
	MOVEI	T1," "		;CLEAR THE <TAB>
	CAIE	T1," "		;CHECK FOR A BLANK
	JRST	OCTI2A		;NOT A BLANK OR <TAB>
	JUMPL	T3,OCTFRE	;FREE FORMAT?
	SKIPN	%BZFLG		;BLANK=ZERO?
	SOJA	T3,OCTI1	;NO. SKIP CHARACTER
	JRST	OCTI1A		;YES. TREAT AS A ZERO
OCTFRE:	JUMPGE	T2,OCTI1	;DIGIT NOT SEEN IN FREE FORM
OCTI2A:	JUMPL	T2,OCTI3	;HAS A DIGIT BEEN SEEN
	CAIN	T1,"-"		;CHECK FOR A MINUS SIGN
	 TXOA	T2,SGNFLG	;SET MINUS FLAG
	CAIN	T1,"+"		;CHECK FOR A PLUS SIGH
	 TXOA	T2,DGSEEN	;TREAT SIGNS LIKE DIGITS
	JRST	OCTI3		;NOT A SIGN
	SOJA	T3,OCTI1	;YES, COUNT AND GET NEXT CHAR

OCTI3:	CAME	T3,[-1]		;FIRST CHAR ILLEGAL
	JUMPL	T3,OCTI5	;NO ERROR ON VARIABLE FIELD INPUT
	$ACALL	ILC		;"ILLEGAL CHARACTER IN DATA"

OCTI5:	TXNN	T2,SGNFLG	;[3342] CHECK THE SIGN OF THE OUTPUT
	JRST	OCTI6		;POSITIVE
	DMOVN	T4,T4		;NEGATIVE (NEGATE THE RESULT)
	JUMPE	T5,OCTI6	;[3342] IF 2ND WORD ZERO, DON'T TURN ON BIT
	TLO	T5,400000	;DMOVN ZEROES SIGN BIT OF RIGHT
				;[3342] WORD - VAL IS NEG SO TURN IT ON 
OCTI6:	MOVE	T1,ODGCNT	;[3342] GET DIGITS-READ COUNT
	CAIN	P2,2		;[3342] DOUBLE WORD TARGET?
	 JRST	OCTI6A		;[3342] YES.
	CAILE	T1,^D12		;[3342] SINGLE. HAVE WE READ MORE THAN 1 WORD?
	 MOVE	T5,T4		;[3342] YES, RETURN HIGH-ORDER WORD
	MOVEM	T5,(P1)		;[3342] OR LOW-ORDER IF <12 DIGITS READ
	POPJ	P,		;[3342] RETURN SINGLE RESULT.

OCTI6A:	CAIG	T1,^D12		;[3342] TARGET IS DOUBLE. LESS THAN 12 DIGITS?
	 EXCH	T4,T5		;[3342] YES. RETURN HI=RESULT, LOW=0
	DMOVEM	T4,(P1)		;[3342] OTHERWISE RETURN HI/HI, LOW/LOW
	POPJ	P,		;[3342] RETURN TO FOROTS

	SEGMENT	DATA		;[3342]
				;[3342]
ODGCNT:	BLOCK	1		;[3342] COUNT OF DIGITS READ
				;[3342]
	SEGMENT	CODE		;[3342]
				;[3342]
%GOCTO:
%OCTO:	PUSHJ	P,%SAVE2	;SAVE P1 & P2
	PUSHJ	P,OCTSET	;DO SETUP
	MOVSI	T5,(POINT 3,(P1))	;GET AN OCTAL BYTE POINTER
	JUMPN	T3,OCTO1	;CHECK FOR VARIABLE FIELD OUTPUT
	MOVEI	T3,^D15		;YES SET FILED WIDTH TO O15
	CAIN	P2,2		;IF DOUBLE REAL
	MOVEI	T3,^D25		;THEN ITS O25
OCTO1:	MOVE	T4,%DWVAL	;GET MINIMUM # DIGITS
	JUMPN	T4,GOTMIN	;DONE IF NON-ZERO
	MOVEI	T4,(T3)		;USE WIDTH IF 0
GOTMIN:	SUBI	T3,(T2)		;FIND THE EXCESS FIELD WIDTH
	JUMPLE	T3,OCTO2	;W<= MAX FIELD WIDTH
	MOVEI	T1," "		;SET UP A BLANK FILLER
	SKIPE	%FTSLB		;DON'T OUTPUT IF SUPPRESS SWITCH ON
	 JRST	OCTNB
	PUSHJ	P,%OBYTE	;OUTPUT THE FILLER
	SOJG	T3,.-1		;CONTINUE UNTIL W=0 (EXCESS)

OCTNB:	SETZ	T3,		;DONE WITH LEADING BLANKS
OCTO2:	JUMPE	T3,OCTO2B	;GO ON IF FITS
	ADD	T2,T3		;MODIFY # CHARS FOR OUTPUT
OCTO2A:	ILDB	T1,T5		;GET CHAR
	SKIPE	%FTAST		;ASTERISKS ON OVERFLOW?
	 JUMPN	T1,%FTSUC	;YES. OVERFLOW IF DIGIT NON-ZERO
	AOJL	T3,OCTO2A

OCTO2B:	ILDB	T1,T5		;GET A CHAR
	JUMPN	T1,OCTO3A	;GO PRINT ALL IF NON-ZERO
	MOVEI	T1,"0"		;MAYBE PRINT A ZERO
	CAILE	T2,(T4)		;PRINT A SPACE IF ALLOWED TO
	MOVEI	T1," "		;IF W.M WAS SPECIFIED
	PUSHJ	P,%OBYTE	;OUTPUT ZERO OR SPACE
	SOJG	T2,OCTO2B
	POPJ	P,		;LEAVE IF DIGITS EXHAUSTED

OCTO3:	ILDB	T1,T5		;GET THE NEXT OCTAL DIGIT
OCTO3A:	ADDI	T1,"0"		;CONVERT TO ASCII
	PUSHJ	P,%OBYTE	;OUTPUT A DIGIT
	SOJG	T2,OCTO3	;BACK FOR MORE
OCTORT:	POPJ	P,		;RETURN TO FOROTS

OCTSET:	MOVE	P1,IO.ADR	;GET ADDR OF VARIABLE
	MOVEI	T2,^D12		;12 DIGITS ONLY
	MOVE	P2,IO.TYP	;GET VARIABLE TYPE
	MOVE	P2,%SIZTB(P2)	;GET ENTRY SIZE
	IMULI	T2,(P2)		;GET CORRESPONDING # DIGITS
	MOVE	T3,%FWVAL	;GET THE FIELD WIDTH
	POPJ	P,

	PRGEND
	TITLE	HEXIO	HEX INPUT/OUTPUT 
	SUBTTL	CHRIS SMITH/CKS		28-Oct-81
	SEARCH	MTHPRM




;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
;ALL RIGHTS RESERVED.

;FROM OCTAL I/O 

	SEGMENT	CODE

	ENTRY	%HEXI,%HEXO
	EXTERN	%IBYTE,%OBYTE,%FWVAL,%DWVAL,%SAVE2
	EXTERN	%SKIP,%SIZTB
	EXTERN	IO.ADR,IO.TYP,%FTAST
	EXTERN	%BZFLG
	EXTERN	%FTSUC

DGSEEN==400000,,0		;MUST BE 400000, TEST WITH JUMPL
SGNFLG==200000,,0		;MINUS SIGN SEEN
%HEXI:	PUSHJ	P,%SAVE2	;SAVE P1 & P2
	PUSHJ	P,HEXSET	;DO SETUP
	SETZB	T4,T5		;CLEAR THE OUTPUT WORD
	JUMPG	T3,HEXI1	;FIELD SPECIFIED
	SETO	T3,		;NO, SET VARIABLE FLAG
	PUSHJ	P,%SKIP		;SKIP SPACES
	  JRST	HEXI5		;NULL FIELD DELIMITED BY COMMA OR EOL
	JRST	HEXI1B		;PROCESS FIELD
HEXI1:	JUMPE	T3,HEXI5	;CHECK FOR END OF FIELD
	PUSHJ	P,%IBYTE	;GET AN INPUT CHARACTER
HEXI1B:	CAILE	T1,140		;LOWER CASE?
	  SUBI	T1,40		;YES, CONVERT TO UPPER
	CAIG	T1,"F"		;CHECK FOR HEX DIGIT
	 CAIGE	T1,"A"
	CAIG	T1,"9"
	 CAIGE	T1,"0"
	  JRST	HEXI2		;NON-DIGIT
	TXO	T2,DGSEEN	;DIGIT, SET DIGIT SEEN FLAG
	SUBI	T1,"0"		;MAKE INTO DIGIT
	CAIL	T1,"A"-"0"
	  SUBI	T1,"A"-"0"-^D10
HEXI1A:	LSHC	T4,4		;POSITION OUTPUT WORD
	TRO	T5,(T1)		;OR IN DIGIT
	SOJA	T3,HEXI1	;RETURN FOR NEXT CHARACTER

;NULLS ARE LEGAL
HEXI2:	JUMPN	T1,HNOTNL	;IF NOT NULL, CONTINUE
	JUMPL	T3,HEXFRE	;IF FREE FORMAT, CHECK IS ANYTHING ELSE SEEN
	SOJA	T3,HEXI1	;OTHERWISE, TREAT AS BLANK WITH BLANK='NULL'

HNOTNL:	CAIN	T1,11		;<TAB> CHARACTER
	MOVEI	T1," "		;CLEAR THE <TAB>
	CAIE	T1," "		;CHECK FOR A BLANK
	JRST	HEXI2A		;NOT A BLANK OR <TAB>
	JUMPL	T3,HEXFRE	;FREE FORMAT?
	SKIPN	%BZFLG		;BLANK=ZERO?
	SOJA	T3,HEXI1	;NO. SKIP CHARACTER
	SETZ	T1,		;YES. TREAT AS A ZERO
	JRST	HEXI1A		;GO INSERT IN OUTPUT NUMBER
HEXFRE:	JUMPGE	T2,HEXI1	;DIGIT NOT SEEN IN FREE FORM
HEXI2A:	JUMPL	T2,HEXI3	;HAS A DIGIT BEEN SEEN
	CAIN	T1,"-"		;CHECK FOR A MINUS SIGN
	 TXOA	T2,SGNFLG	;SET MINUS FLAG
	CAIN	T1,"+"		;CHECK FOR A PLUS SIGH
	 TXOA	T2,DGSEEN	;TREAT SIGNS LIKE DIGITS
	JRST	HEXI3		;NOT A SIGN
	SOJA	T3,HEXI1	;YES, COUNT AND GET NEXT CHAR

HEXI3:	CAME	T3,[-1]		;FIRST CHAR ILLEGAL
	JUMPL	T3,HEXI5	;NO ERROR ON VARIABLE FIELD INPUT
	$ACALL	ILC		;"ILLEGAL CHARACTER IN DATA"

HEXI5:	JUMPN	T4,HEXI5A	;LEAVE ALONE IF NON-ZERO 1ST WORD
	EXCH	T4,T5		;ELSE SWAP THEM
HEXI5A:	TXNN	T2,SGNFLG	;CHECK THE SIGN OF THE OUTPUT
	JRST	HEXI6		;POSITIVE
	DMOVN	T4,T4		;NEGATIVE (NEGATE THE RESULT)
	TLO	T5,400000	;DMOVN ZEROES SIGN BIT OF RIGHT
				;WORD - VAL IS NEG SO TURN IT ON ALWAYS
HEXI6:	MOVEM	T4,(P1)		;ASSUME SINGLE PREC
	CAIN	P2,2		;[735] IF DOUBLE PRECISION
	MOVEM	T5,1(P1)	;[735] THEN RETURN BOTH HALVES
	POPJ	P,		;RETURN TO FOROTS
%HEXO:	PUSHJ	P,%SAVE2	;SAVE P1 & P2
	PUSHJ	P,HEXSET	;DO SETUP
	MOVSI	T5,(POINT 4,(P1)) ;GET A HEX BYTE POINTER
	JUMPN	T3,HEXO1	;CHECK FOR VARIABLE FIELD OUTPUT
	MOVEI	T3,^D15		;YES SET FIELD WIDTH TO O15
	CAIN	P2,2		;IF DOUBLE REAL
	MOVEI	T3,^D25		;THEN ITS O25
HEXO1:	MOVE	T4,%DWVAL	;GET MINIMUM # DIGITS
	JUMPN	T4,GOTMIN	;DONE IF NON-ZERO
	MOVEI	T4,(T3)		;USE WIDTH IF 0
GOTMIN:	SUBI	T3,(T2)		;FIND THE EXCESS FIELD WIDTH
	JUMPLE	T3,HEXO2	;W<= MAX FIELD WIDTH
	MOVEI	T1," "		;SET UP A BLANK FILLER
	PUSHJ	P,%OBYTE	;OUTPUT THE FILLER
	SOJG	T3,.-1		;CONTINUE UNTIL W=0 (EXCESS)

HEXO2:	JUMPE	T3,HEXO2B	;GO ON IF FITS
	ADD	T2,T3		;MODIFY # CHARS FOR OUTPUT
HEXO2A:	ILDB	T1,T5		;GET CHAR
	SKIPE	%FTAST		;ASTERISKS ON OVERFLOW?
	 JUMPN	T1,%FTSUC	;YES. OVERFLOW IF DIGIT NON-ZERO
	AOJL	T3,HEXO2A

HEXO2B:	ILDB	T1,T5		;GET A CHAR
	JUMPN	T1,HEXO3A	;GO PRINT ALL IF NON-ZERO
	MOVEI	T1,"0"		;MAYBE PRINT A ZERO
	CAILE	T2,(T4)		;PRINT A SPACE IF ALLOWED TO
	MOVEI	T1," "		;IF W.M WAS SPECIFIED
	PUSHJ	P,%OBYTE	;OUTPUT ZERO OR SPACE
	SOJG	T2,HEXO2B
	POPJ	P,		;LEAVE IF DIGITS EXHAUSTED

HEXO3:	ILDB	T1,T5		;GET THE NEXT HEXAL DIGIT
HEXO3A:	ADDI	T1,"0"		;CONVERT TO ASCII
	CAILE	T1,"9"		;PAST 9?
	  ADDI	T1,"A"-"0"-^D10	;YES, CONVERT TO RANGE A-F
	PUSHJ	P,%OBYTE	;OUTPUT A DIGIT
	SOJG	T2,HEXO3	;BACK FOR MORE
HEXORT:	POPJ	P,		;RETURN TO FOROTS

HEXSET:	MOVE	P1,IO.ADR	;GET ADDR OF VARIABLE
	MOVEI	T2,9		;9 DIGITS ONLY
	MOVE	P2,IO.TYP	;GET VARIABLE TYPE
	MOVE	P2,%SIZTB(P2)	;GET ENTRY SIZE
	IMULI	T2,(P2)		;GET CORRESPONDING # DIGITS
	MOVE	T3,%FWVAL	;GET THE FIELD WIDTH
	POPJ	P,

	PRGEND
	TITLE	POWTAB	D.P. INTEGER POWER OF TEN TABLES 
	SEARCH	MTHPRM


;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
;ALL RIGHTS RESERVED.

	SEGMENT	CODE

	ENTRY	%HITEN,	%LOTEN,	%EXP10,	%PTMAX,%NMEXP,%PMEXP
	ENTRY	%DEXP,%HIMAX,%BEXP,%HIINT,%LOINT,%LFMSK,%SIZTB

	;POWER OF TEN TABLE IN DOUBLE PRECISION
	;INTEGER FORMAT. EACH ENTRY CONSISTS OF TWO WORDS,
	;EACH WITH 35 BITS OF FRACTION (SIGNS ARE EXCLUDED).
	;THE BINARY POINT IS BETWEEN BITS 0 AND 1 OF THE
	;HI ORDER WORD. THE EXPONENT FOR THE 70 BIT
	;FRACTION IS STORED IN THE SHORT TABLE CALLED "EXPTEN".
	;FOLLOWING THE STANDARD TABLE IS ATHE EXTENDED EXPONENT
	;TABLE, WHICH IS A SPARSE POWER OF TEN TABLE RANGING FROM
	;10**21 TO 10**326, FOR USE IN ENCODING AND DECODING G-FLOATING
	;NUMBERS.

	;THE NUMBERS IN BOTH TABLES ARE TRUNCATED, THAT IS, NO
	;ROUNDING HAS BEEN DONE FROM THE (VIRTUAL) THIRD WORD OF
	;PRECISION. THUS, ON AVERAGE, THE TABLES ARE BIASED 1/2 BIT
	;DOWNWARDS.
DEFINE .TAB. (A)<
	NUMBER -321,322477622614,164206201643
	NUMBER -315,203507673567,310523721106
	NUMBER -312,244431652525,272650705327
	NUMBER -307,315540225253,051423066615
	NUMBER -303,200434135252,371753742170
	NUMBER -300,240543164525,270346732626
	NUMBER -275,310674021653,046440521374
	NUMBER -272,373053026225,360150645673
	NUMBER -266,234732715735,266101407525
	NUMBER -263,304121501325,043521711452
	NUMBER -260,365146021612,154446273765
	NUMBER -254,231177613066,203667765371
	NUMBER -251,277437555704,044645762667
	NUMBER -246,357347511265,056017357445
	NUMBER -242,225520615661,074611525567
	NUMBER -237,273044761235,213754053125
	NUMBER -234,351656155504,356747065752
	NUMBER -230,222114704413,025260341562
	NUMBER -225,266540065515,332534432117
	NUMBER -222,344270103041,121263540543
	NUMBER -216,216563051724,322660234335
	NUMBER -213,262317664312,007434303425
	NUMBER -210,337003641374,211343364332
	NUMBER -204,213302304735,325716130610
	NUMBER -201,256162766125,113301556752
	NUMBER -176,331617563552,236162112545
	NUMBER -172,210071650242,242707256537
	NUMBER -167,252110222313,113471132267
	NUMBER -164,324532266776,036407360745
	NUMBER -160,204730362276,323044526457
	NUMBER -155,246116456756,207655654173
	NUMBER -152,317542172552,051631227231
	NUMBER -146,201635314542,132077636440
	NUMBER -143,242204577672,360517606150
	NUMBER -140,312645737651,254643547602
	NUMBER -135,375417327624,030014501542
	NUMBER -131,236351506674,217007711035
	NUMBER -126,306044030453,262611673245
	NUMBER -123,367455036566,237354252116
	NUMBER -117,232574123152,043523552261
	NUMBER -114,301333150004,254450504735
	NUMBER -111,361622002005,327562626124
	NUMBER -105,227073201203,246647575664
	NUMBER -102,274712041444,220421535242
	NUMBER -077,354074451755,264526064512
	NUMBER -073,223445672164,220725640716
	NUMBER -070,270357250621,265113211102
	NUMBER -065,346453122766,042336053323
	NUMBER -061,220072763671,325412633103
	NUMBER -056,264111560650,112715401724
	NUMBER -053,341134115022,135500702312
	NUMBER -047,214571460113,172410431376
	NUMBER -044,257727774136,131112537675
	NUMBER -041,333715773165,357335267655
	NUMBER -035,211340575011,265512262714
	NUMBER -032,253630734214,043034737477
	NUMBER -027,326577123257,053644127417
	NUMBER -023,206157364055,173306466551
	NUMBER -020,247613261070,332170204303
	NUMBER -015,321556135307,020626245364
	NUMBER -011,203044672274,152375747331
	NUMBER -006,243656050753,205075341217
	NUMBER -003,314631463146,146314631463
A:	NUMBER 001,200000000000,000000000000
	NUMBER 004,240000000000,000000000000
	NUMBER 007,310000000000,000000000000
	NUMBER 012,372000000000,000000000000
	NUMBER 016,234200000000,000000000000
	NUMBER 021,303240000000,000000000000
	NUMBER 024,364110000000,000000000000
	NUMBER 030,230455000000,000000000000
	NUMBER 033,276570200000,000000000000
	NUMBER 036,356326240000,000000000000
	NUMBER 042,225005744000,000000000000
	NUMBER 045,272207335000,000000000000
	NUMBER 050,350651224200,000000000000
	NUMBER 054,221411634520,000000000000
	NUMBER 057,265714203644,000000000000
	NUMBER 062,343277244615,000000000000
	NUMBER 066,216067446770,040000000000
	NUMBER 071,261505360566,050000000000
	NUMBER 074,336026654723,262000000000
	NUMBER 100,212616214044,117200000000
	NUMBER 103,255361657055,143040000000
	NUMBER 106,330656232670,273650000000
	NUMBER 112,207414740623,165311000000
	NUMBER 115,251320130770,122573200000
	NUMBER 120,323604157166,147332040000
	NUMBER 124,204262505412,000510224000
	NUMBER 127,245337226714,200632271000
	NUMBER 132,316627074477,241000747200
	NUMBER 136,201176345707,304500460420
	NUMBER 141,241436037271,265620574524
	NUMBER 144,311745447150,043164733651
	NUMBER 147,374336761002,054022122623
	NUMBER 153,235613266501,133413263574
	NUMBER 156,305156144221,262316140533
	NUMBER 161,366411575266,037001570661
	NUMBER 165,232046056261,323301053417
	NUMBER 170,300457471736,110161266322
	NUMBER 173,360573410325,332215544007
	NUMBER 177,226355145205,250330436404
	NUMBER 202,274050376447,022416546105
	NUMBER 205,353062476160,327122277527
	NUMBER 211,222737506706,206363367626
	NUMBER 214,267527430470,050060265574
	NUMBER 217,345455336606,062074343133
	NUMBER 223,217374313163,337245615771
	NUMBER 226,263273376020,327117161367
	NUMBER 231,340152275425,014743015665
	NUMBER 235,214102366355,050055710521
	NUMBER 240,257123064050,162071272645
	NUMBER 243,332747701062,216507551417
	NUMBER 247,210660730537,231114641751
	NUMBER 252,253035116667,177340012343
	NUMBER 255,325644342445,137230015034
	NUMBER 261,205506615467,133437010121
	NUMBER 264,247030361005,062346612146
	NUMBER 267,320636455206,177040354577
	NUMBER 273,202403074224,017324223757
	NUMBER 276,243103713271,023211270753
	NUMBER 301,313724676147,130053547146
	NUMBER 304,376712055601,056066501000
	NUMBER 310,237236234460,274642110500
	NUMBER 313,307105703574,354012532620
	NUMBER 316,370727264534,047015261364
>
DEFINE NUMBER (A,B,C) <B>

TENTAB:	.TAB. %HITEN

DEFINE NUMBER (A,B,C) <C>

	.TAB. %LOTEN
%PTMAX==%HITEN-TENTAB-1	;MAX ENTRY INDEX

DEFINE	NUMBER	(A,B,C) <A>

%NMEXP==.
	.TAB. %EXP10
%PMEXP==.-1

	DEFINE	HITABL <
%%EXP==0
 HIEXP  21, 0106, 330656232670, 273650000000
 HIEXP  31, 0147, 374336761002, 054022122623
 HIEXP  42, 0214, 267527430470, 050060265574
 HIEXP  52, 0255, 325644342445, 137230015034
 HIEXP  63, 0322, 233446460731, 230310256730
 HIEXP  73, 0363, 265072116565, 045110433532
 HIEXP  84, 0430, 203616042160, 325266273336
 HIEXP  94, 0471, 231321375525, 337205744037
 HIEXP 105, 0535, 337172572336, 007545174113
 HIEXP 115, 0577, 201742476560, 254305755623
 HIEXP 126, 0643, 275056630405, 050037577755
 HIEXP 136, 0704, 334103204270, 352046213535
 HIEXP 147, 0751, 240125245530, 066753037574
 HIEXP 158, 1015, 351045347212, 074316542736
 HIEXP 168, 1057, 207525153773, 310102120644
 HIEXP 179, 1123, 305327273020, 343641442602
 HIEXP 189, 1164, 345647674501, 121102720143
 HIEXP 200, 1231, 247161432765, 330455055455
 HIEXP 210, 1272, 302527746114, 232735577632
 HIEXP 221, 1337, 215510706516, 363467704427
 HIEXP 231, 1400, 244711331533, 105545654076
 HIEXP 242, 1444, 357747123347, 374251221667
 HIEXP 252, 1506, 213527073575, 262011603206
 HIEXP 263, 1552, 313176275662, 023427342311
 HIEXP 273, 1613, 354470426352, 214122564267
 HIEXP 284, 1660, 254120203313, 021677205125
 HIEXP 295, 1724, 372412614644, 074374052054
 HIEXP 305, 1766, 221645055640, 266335117623
 HIEXP 316, 2032, 324146136354, 344313410127
 HIEXP 326, 2073, 367020634251, 325055547056
>

%HIMAX==^D326

DEFINE	HIEXP	(DEXP,BEXP,HIWRD,LOWRD) <
	XWD	BEXP,^D<DEXP>
	EXP	HIWRD
	EXP	LOWRD
	%%EXP==%%EXP+1
>


%DEXP:	HITABL
%BEXP==%DEXP+1

;TABLE OF INTEGER POWERS OF TEN

	DEFINE	TABLE
<	NUMBER	 000000000000,000000000001	; 0
	NUMBER	 000000000000,000000000012	; 1
	NUMBER	 000000000000,000000000144	; 2
	NUMBER	 000000000000,000000001750	; 3
	NUMBER	 000000000000,000000023420	; 4
	NUMBER	 000000000000,000000303240	; 5
	NUMBER	 000000000000,000003641100	; 6
	NUMBER	 000000000000,000046113200	; 7
	NUMBER	 000000000000,000575360400	; 8
	NUMBER	 000000000000,007346545000	; 9
	NUMBER	 000000000000,112402762000	;10
	NUMBER	 000000000002,351035564000	;11
	NUMBER	 000000000035,032451210000	;12
	NUMBER	 000000000443,011634520000	;13
	NUMBER	 000000005536,142036440000	;14
	NUMBER	 000000070657,324461500000	;15
	NUMBER	 000001070336,115760200000	;16
	NUMBER	 000013064257,013542400000	;17
	NUMBER	 000157013326,164731000000	;18
	NUMBER	 002126162140,221172000000	;19
	NUMBER	 025536165705,254304000000	;20
	NUMBER	 330656232670,273650000000	;21
>
	DEFINE	NUMBER	(A,B)
<	EXP	A>

%HIINT:	TABLE

	DEFINE	NUMBER	(A,B)
<	EXP	B>

%LOINT:	TABLE

;%SIZTB GIVES THE NUMBER OF WORDS ASSOCIATED WITH EACH TYPE OF
;VARIABLE.
%SIZTB:	1			;(0) UNDEFINED (INTEGER)
	1			;(1) LOGICAL
	1			;(2) INTEGER
	1			;(3)
	1			;(4) SINGLE REAL
	1			;(5)
	1			;(6) SINGLE OCTAL (INTEGER)
	1			;(7) LABEL
	2			;(10) DOUBLE REAL
	2			;(11) DOUBLE INTEGER
	2			;(12) DOUBLE OCTAL
	2			;(13) EXTENDED DOUBLE REAL
	2			;(14) COMPLEX
	1			;(15) COBOL BYTE STRING
	1			;(16) CHARACTER
	1			;(17) ASCIZ

%LFMSK:	400000,,0
	200000,,0
	100000,,0
	40000,,0
	20000,,0
	10000,,0
	4000,,0
	2000,,0
	1000,,0
	400,,0
	200,,0
	100,,0
	40,,0
	20,,0
	10,,0
	4,,0
	2,,0
	1,,0
	400000
	200000
	100000
	40000
	20000
	10000
	4000
	2000
	1000
	400
	200
	100
	40
	20
	10
	4
	2
	1

	PRGEND

	TITLE	MTHAC	AC SAVE ROUTINES
	SEARCH	MTHPRM

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1979, 1985
;ALL RIGHTS RESERVED.

	ENTRY	%SAVE1,%SAVE2,%SAVE3,%SAVE4
	ENTRY	%POPJ,%POPJ1,%POPJ2
	ENTRY	%PUSHT,%POPT,%JPOPT

	SEGMENT	CODE

;ROUTINES TO SAVE P1-P4

%SAVE1:	EXCH	P1,0(P)		;Save P1, get return addr
	PUSHJ	P,JRET1		;STUFF RESTORE ROUTINE ADDR
	JRST	RET1		;WHICH IS HERE
	JRST	RET11		;SKIP RETURN
	JRST	RET12		;DOUBLE SKIP RETURN

JRET1:	PUSH	P,P1		;STUFF CURRENT RETURN ADDR
	MOVE	P1,-2(P)	;GET P1 BACK
	POPJ	P,

%SAVE2:	EXCH	P1,0(P)		;Save p1, get return addr
	PUSH	P,P2		;Save p2
	PUSHJ	P,JRET2		;STUFF RESTORE RETURN ADDR
	JRST	RET2		;WHICH IS HERE
	JRST	RET21		;SKIP RETURN
	JRST	RET22		;DOUBLE SKIP RETURN

JRET2:	PUSH	P,P1		;STUFF CURRENT RETURN ADDR
	MOVE	P1,-3(P)	;GET P1 BACK
	POPJ	P,

%SAVE3:	EXCH	P1,0(P)		;Save P1, get return addr
	PUSH	P,P2		;Save P2
	PUSH	P,P3		;Save P3
	PUSHJ	P,JRET3		;STUFF RESTORE RETURN ADDR
	JRST	RET3		;WHICH IS HERE
	JRST	RET31		;SKIP RETURN
	JRST	RET32		;DOUBLE SKIP RETURN

JRET3:	PUSH	P,P1		;STUFF CURRENT RETURN ADDR
	MOVE	P1,-4(P)	;GET P1 BACK
	POPJ	P,

%SAVE4:	EXCH	P1,0(P)		;Save P1, get return addr
	PUSH	P,P2
	PUSH	P,P3
	PUSH	P,P4
	PUSHJ	P,JRET4		;STUFF RESTORE RETURN ADDR
	JRST	RET4		;WHICH IS HERE
	JRST	RET41		;SKIP RETURN
	JRST	RET42		;DOUBLE SKIP RETURN

JRET4:	PUSH	P,P1		;STUFF CURRENT RETURN ADDR
	MOVE	P1,-5(P)	;GET P1 BACK
	POPJ	P,

RET4:	POP	P,P4
RET3:	POP	P,P3
RET2:	POP	P,P2
RET1:	POP	P,P1
	POPJ	P,		;Return to caller's caller.

;SKIP RETURNS
RET41:	POP	P,P4
RET31:	POP	P,P3
RET21:	POP	P,P2
RET11:	POP	P,P1
	AOS	(P)		;SKIP RETURN
	POPJ	P,

;DOUBLE SKIP RETURNS
RET42:	POP	P,P4
RET32:	POP	P,P3
RET22:	POP	P,P2
RET12:	POP	P,P1

%POPJ2:	AOS	(P)		;DOUBLE SKIP RETURN
%POPJ1:	AOS	(P)		;SINGLE SKIP
%POPJ:	POPJ	P,		;NONSKIP
;ROUTINES TO PUSH AND POP ALL T ACS

;Called by PUSHJ P,%PUSHT

%PUSHT:	PUSH	P,T1		;SAVE T1-T5
	PUSH	P,T2
	PUSH	P,T3
	PUSH	P,T4
	PUSH	P,T5
	EXCH	T0,-5(P)	;SAVE T0, GET RETURN ADDRESS
	PUSH	P,T0		;SAVE RETURN ADDRESS
	MOVE	T0,-6(P)	;RESTORE T0
	POPJ	P,		;RETURN


;Called by PUSHJ P,%POPT

%POPT:	POP	P,T0		;GET RETURN ADDRESS
	POP	P,T5		;RESTORE T5-T1
	POP	P,T4
	POP	P,T3
	POP	P,T2
	POP	P,T1
	EXCH	T0,(P)		;RESTORE T0
	POPJ	P,		;RETURN

;Called by PJRST %JPOPT

%JPOPT:	POP	P,T5		;RESTORE T5-T0
	POP	P,T4
	POP	P,T3
	POP	P,T2
	POP	P,T1
	POP	P,T0
	POPJ	P,		;RETURN

	END