Google
 

Trailing-Edge - PDP-10 Archives - BB-4157D-BM - sources/forcnv.mac
There are 13 other files named forcnv.mac in the archive. Click here to see a list.
	TITLE	FORCNV	%5A(673)		CONVERSION ROUTINES
	SUBTTL	REVISION HISTORY

;256	 -----	CORRECT LSTDR% TO CHANGE FT.ELT TO FT.EXT
;345	(Q2322)	OUTPUT 2 WORDS OF DBLE PREC VAR EVEN IF F FORMAT REQUIRED
;347	 -----	RESTRICT DELIMITER FOR LIST-DIRECTED INPUT TO BLANK,
;		COMMA AND LINE TERMINATOR
;350	(13704)	LIST-DIRECTED INPUT DOES NOT TAKE END= RETURN
;354	 -----	FIX FREE FORMAT ON INPUT
;357	 -----	REDEFINE LABEL ERROR FOR MACRO V50
;366	 -----	FIX LIST DIRECTED I/O FOR ARRAYS
;367	(13951)	FIXED INTEGER FORMAT LOOSES BLANKS AT END OF RECORD
;372	 -----	FIX NAMELIST
;373	(13917)	FIX SCALING FACTOR
;374	 -----	END OF NAMELIST LIST FOR F10-V2
;376	 -----	CORRECT FIXED "A" FORMAT AFTER FREE FORMAT
;377	 -----	FIX  F  FORMAT
;400	 -----	FIX TO EDIT 372
;426	15142	HAVE NAMELIST ACCEPT ANY 6 CHARS NAMELIST NAME
;430	15596	FIX SO SCALING ON OUTPUT AFTER NAMELIST INPUT WORKS
;433	15880	FIX INPUT OF OCTAL NUMBERS TO CORRECTLY HANDLE MINUS SIGN
;441	16108	FIX FLOUT% SO SINGLE PREC. NOS. LIKE -1.999999 DON'T
;		LOSE PRECISION
;445	16517	FIX NAMELIST INPUT SO FLOATING POINT TO INTEGER CONV.
;		WORKS FOR ALL CASES EVEN #'S LIKE 1.0
;**************** BEGINNING OF VERSION 4C
;461	16741	FIX NAMELIST TO ACCEPT ANY 6 CHAR VARIABLE NAME
;462	16796	FIX FLIRT% SO CALL TO ILL CAUSES ILLEGAL CHARS IN DATA
;		TO BE SET TO ZERO AND NOT SKIP VALID FOLLOWING CHARS
;465	17142	FIX NMLST% TO INPUT STRINGS INTO DOUBLE PRECISION AND
;		COMPLEX VARIABLES CORRECTLY.
;476	17725	FIX G FORMAT WHEN FIELD TOO SMALL UNLESS 4X REMOVED.
;517	18268	FIX F2.0 TO NEVER PRINT JUST A DOT.
;533	19239	FIX LSTDR% TO CORRECTLY INPUT STRINGS INTO DOUBLE
;			PRECISION NUMBERS.
;534	19239	FIX NMLST% FOR INPUT OF STRINGS INTO ARRAYS
;541	19793	FIX NMLST% FOR LIST-DIRECTED INPUT OF QUOTED STRINGS
;			INTO ARRAYS WILL CLEAR FT.QOT
;544	12882	MAKE  P SCALING WORK WITH F FORMAT FOR NUMBERS
;			WHICH ARE IDENTICALLY ZERO
;563	(V5)	MAKE F FORMAT USE BOTH WORDS FOR DOUBLE PRECISION
;			(FLIRT% AND FLOUT%)
;566	Q00569	PRINT ZERO EXPONENT FOR IDENTICAL ZERO, D OR E
;			FORMAT (FLOUT%)
;574	Q00654	LIST DIRECTED INPUT OF COMPLEX NUMBERS SHOULD
;		REQUIRE PARENTHESIS AROUND THE ARGUMENT, AND
;		IF THERE IS A REPEAT COUNT IT SHOULD BE DELIMITED
;		BY AN ASTERISK.
;575	18964	LIST-DIRECTED I/O DOES NOT PROPERLY HANDLE S-LISTS
;			WITH INCREMENTS NOT EQUAL TO ONE.
;576	18964	LIST DIRECTED INPUT DOES NOT PROPERLY HANDLE S-LISTS
;		WITH INCREMENTS OTHER THAN ONE.
;
;	BEGIN VERSION 5A, 7-NOV-76
;
;622	QA873	NAMELIST PARTIAL ARRAYS AT END OF LIST
;**************** BEGINNING OF VERSION 5A
;652	22508	EXPONENT FIELDS SHOULD ACCEPT LOWER CASE D AND E
;653	22543	ACCEPT LOWER CASE T AND F FOR TRUE AND FALSE
;654	-----	FIX FLIRT TO HANDLE ALL INTEGERS CORRECTLY AND
;		FIX NAMELIST TO STORE DATA TYPE IN LOW CORE
;660	-----	FIX FLOUT% TO USE 8 NOT 9 AS MAX NUMBER OF MANTISSA
;		  DIGITS TO PRINT ON SINGLE PRECISION SO 5.55 IN F20.17
;		  WON'T PRINT AS 5.55000001...
;673	22607	IMPLEMENT VBL WIDTH DOUBLE PRECISION OCTAL I/O.
;**************** END OF REVISION HISTORY
	PRGEND
	TITLE	ALPHA%	RIGHT% %4.(354)	ALPHANUMBERIC INPUT/OUTPUT ROUTINES
	SUBTTL	D. TODD/DRT/HPW/MD		29-JUL-74




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

;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
	SEARCH	FORPRM		;GET THE FOROTS GLOBAL SYMBOL TABLE
;	DEFINE THE LOADING PARAMETERS
	SEGMEN

	ENTRY	ALPHA%,RIGHT%
	EXTERN	IBYTE.,OBYTE.,W.PNTR	;[265]
	EXTERN	GFDEL%		;[376]
RIGHT%:	TDZA	T2,T2		;RIGHT JUSTIFY ENTRY
ALPHA%:	MOVSI	T2,(POINT 7,(G1))	;LEFT JUSTIFY ENTRY
	MOVEI	T4,5		;ASSUME SINGLE PRECISION
	MOVE	T1,DAT.TP+2(P4)	;GET THE VARIABLE TYPE
	CAIN	T1,TP%DOR	;DOUBLE PRECISION REAL
	LSH	T4,1		;YES, ALLOW 10 CHARACTERS MAX.
	LDB	T5,W.PNTR	;[265] GET THE WIDTH FIELD
	JUMPG	T5,ALPHA1	;[354] SPECIFIED
	JUMPI	[ERROR (DAT,16,16,ALPHA1)]	;[354] ERROR IF INPUT
	MOVEI	T5,(T4)		;[305] NO-SET DEFAULT
ALPHA1:	MOVEI	T3,(T5)		;[354] SAVE THE W FIELD
	SUBI	T3,(T4)		;COMPUTE THE EXCESS FIELD SIZE
	CAILE	T5,(T4)		;IS THE W FIELD IN RANGE
	MOVEI	T5,(T4)		;NO, SET TO MAX SING.=5 DP=10
	JUMPO	ALPHO		;GO TO ALPHO ON OUTPUT
ALPHI:	MOVE	T0,[ASCII /     /];GET A SET OF 5 BLANKS
	MOVEM	T0,(G1)		;SET THE VARIABLE TO BLANK CLEAR BIT 35
	CAIN	T1,TP%DOR	;DOUBLE PRECISION REAL
	MOVEM	T0,1(G1)	;CLEAR THE LOW ORDER WORD
	JSP	P1,GFDEL%	;[376] RETRIEVE DELIMITER
	JUMPG	T3,ALPHI0	;[376] EXCESS W
	JUMPN	T2,ALPHI3	;[376] "A" FORMAT
	SETZB	T3,T4		;[376] RIGHT JUSTIFY - CLEAR DEST.
	JRST	RIGHI2		;[376] GO THERE
	JSP	P1,IBYTE.	;EXCESS W SKIP INPUT CHARACTERS
ALPHI0:	SOJG	T3,.-1		;[376] CONTINUE SKIPPING
	JUMPE	T2,RIGHI	;[376] RIGHT JUSTIFY
ALPHI1:	JSP	P1,IBYTE.	;GET AN INPUT BYTE
ALPHI3:	IDPB	T0,T2		;[376] PUT IN USER'S VARIBLE
	SOJG	T5,ALPHI1	;CONTINUE UNTIL W=0
ALPHI2:	POPJ	P,		;RETURN FOR FOROTS

ALPHO:				;ALPHA OUTPUT ROUTINE
	JUMPLE	T3,ALPHO0	;IS OUTPUT FILL NEEDED
	MOVEI	T0," "		;YES, GET A BLANK
	JSP	P1,OBYTE.	;FILL OUTPUT FILL WITH BLANKS
	SOJG	T3,.-2		;CONTINUE UNTIL MAX W IS REACHED
ALPHO0:	JUMPE	T2,RIGHO	;RIGHT JUSTIFY
ALPHO1:	ILDB	T0,T2		;GET THE CHARACTER FORM THE VARIABLE
	JUMPN	T0,ALPHO2	;JUMP IF NOT A NULL
	MOVEI	T0," "		;NULL, GET A BLANK
ALPHO2:	JSP	P1,OBYTE.	;OUTPUT THE CHARACTER
	SOJG	T5,ALPHO1	;CONTINUE UNTIL W=0
	POPJ	P,		;RETURN TO FOROTS
;ROUTINES TO RIGHT JUSTIFY ASCII STRING IN THE USER'S VARIABLE
RIGHI:		;RIGHT JUSTIFY INPUT
	SETZB	T3,T4		;CLEAR THE RECEIVING WORD
RIGHI1:	LSHC	T3,^D7		;SHIFT A CHARACTER
	JSP	P1,IBYTE.	;READ A CHARACTER
RIGHI2:	IOR	T4,T0		;[376] INSERT THE CHARACTER
	SOJG	T5,RIGHI1	;CONTINUE
	LSHC	T3,1		;CLEAR THE LOW ORDER SIGN BIT
	LSH	T4,-1		;AND POSITION
	MOVEM	T4,(G1)		;STORE THE LOW ORDER WORD (SINGLE)
	CAIE	T1,TP%DOR	;CHECK FOR DOUBLE PRECISION
	POPJ	P,		;NO, EXIT
	DMOVEM	T3,(G1)		;STORE BOTH WORDS (DOUBLE)
	POPJ	P,		;RETURN

RIGHO:				;RIGHT JUSTIFY OUTPUT
	MOVE	T2,[POINT 7,T3]	;TEMP BYTE POINTER
RIGHO1:	CAIN	T5,(T4)		;CHARACTERS TO SKIP
	JRST	RIGHO2		;NO, GET THE DATA WORD(S)
	IBP	T2		;YES, SKIP A CHARACTER
	SOJA	T4,RIGHO1	;CONTINUE
RIGHO2:	MOVE	T3,(G1)		;GET THE HIGH ORDER WORD
	SETZ	T4,		;CLEAR THE LOWER ORDER
	CAIN	T1,TP%DOR	;DOUBLE PRECISION
	MOVE	T4,1(G1)	;YES, GET THE LOW ORDER WORD
	LSHC	T3,1		;ASCII ALIGN
	JRST	ALPHO1		;DO THE OUTPUT
	PRGEND
	TITLE	FLIRT%	%5A.(654)	FLOATING POINT INPUT
	SUBTTL	DAVE NIXON AND TOM EGGERS
	SUBTTL	D.M.NIXON /DMN/DRT/HPW/MD/CLRH/DCE	26-APR-77




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

;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	FORPRM		;GET THE FOROTS GLOBAL SYMBOL TABLE
;	DEFINE THE LOADING PARAMETERS
	SEGMEN

	ENTRY	REAL%
	ENTRY	FLIRT%
	ENTRY	FLINC%		;[206] DP INPUT TO INTEGER CONVERSION
	EXTERN	IBYTE.,W.PNTR,D.PNTR	;[265]
	EXTERN	HITEN.,LOTEN.,EXP10.,PTLEN.
	EXTERN	GFDEL%,SFDEL%,SKIP%,MUN	;[354]


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

;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,
;KA10 DOUBLE PRECISION, OR PDP6/KI10 DOUBLE PRECISION RESULT.
;OVERFLOWS RETURN THE LARGEST POSSIBLE
;NUMBER (WITH CORRECT SIGN), WHILE UNDERFLOWS RETURN 0. NO ERROR
;MESSAGE IS GIVEN FOR  EITHER OVER OR UNDERFLOW.
;OLD ACCUMULATOR DEFINITIONS

A==T0			;RETURNED CHAR. FROM CHINN.
B=A+1			;RESULT RETURNED IN A OR A AND B
C=B+1			;B,C, AND D ARE USED AS A MULTIPLE PRECISION
D=C+1			;  REGISTER FOR DOUBLE PRECISION OPERATIONS
XP=D+1			;EXPONENT AFTER D OR E
W==T5			;FIELD WIDTH COUNTER
X==G1			;COUNTS DIGITS AFTER POINT
F==G2			;FLAGS
ST==G4			;STATES
;ST+1			;TEMPORARY, USES P1 WHICH CAN BE DESTROYED HERE
BXP==ST			;BINARY EXPONENT


;RIGHT HALF FLAGS IN AC "F"
DOTFL==1		;DOT SEEN
MINFR==2		;NEGATIVE FRACTION
MINEXP==4		;NEGATIVE EXPONENT
EXPFL==10		;EXPONENT SEEN IN DATA (MAY BE 0)

;INPUT CHARACTER TYPES
CRTYP==1	;CARRIAGE RETURN
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
	FT.INC==10		;CONVERSION TO INTEGER
FLINC%:	TLOA	P2,FT.INC!FT.PRC;[206] DP IONPUT TO INTEGER CONVERSION

REAL%:	JUMPO	FLOUT%##	;OUTPUT
FLIRT%:				;INPUT
	PUSH	P,G1		;SAVE THE GLOBAL AC'S BOTTOM TO TOP
	PUSH	P,G2		;
;	PUSH	P,G3		;DON'T NEED G3
	PUSH	P,G4		;MUST PUSH LAST (P1-G4 USED AS A PAIR)
	LDB	W,W.PNTR	;[265] GET THE FIELD WIDTH
	SETZB	B,C		;INIT D.P. FRACTION
	SETZB	ST,XP		;INIT STATE AND DECIMAL EXPONENT
	SETZB	X,F		;INIT "DIGITS AFTER POINT" COUNTER
	JSP	P1,GFDEL%	;[354] RETRIEVE DELIMITER
	JUMPG	W,GETCH2	;[354] FIELD SPECIFIED
	SETO	W,		;[354] SET FREE FORMAT FLAG
	PUSHJ	P,SKIP%		;[354] FREE FORMAT - SKIP SPACES
	  JRST	ENDF1		;[354] COMMA OR EOL = NULL FIELD
	JRST	GETCH2		;[354] PROCESS FIELD

GETNXT:
GETCHR:	JUMPE	W,ENDF1		;END OF FIELD
	LSH	ST,-^D30	;MOVE STATE TO BITS 30-32
GETCH1:	JSP	P1,IBYTE.	;GET NEXT CHARACTER
GETCH2:	CAIL	T0,"0"		;CHECK FOR NUMBER
	CAILE	T0,"9"
	JRST	CHRTYP		;NO, TRY OTHER
	SUBI	T0,"0"		;CONVERT TO NUMBER
GOT0:	IORI	ST,DIGTYP	;SET TYPE
GOTST:	LSHC	ST,-2		;DIVIDE BY NUMBER OF BYTES IN WORD
	TLNE	ST+1,(1B0)	;TEST WHICH HALF
	SKIPA	ST,NXTSTA(ST)	;RIGHT HALF (BYTES 2 OR 3)
	HLRZ	ST,NXTSTA(ST)	;UNFORTUNATELY BYTES 0 OR 1
	TLNN	ST+1,(1B1)	;WHICH QUADRANT
	LSH	ST,-9		;BYTES 0 OR 2
	ANDI	ST,777		;LEAVE ONLY RIGHT MOST  QUARTER
	ROT	ST,-3		;PUT DISPATCH ADDRESS IN BITS 32-35
				; AND NEW STATE IN BITS 0-2
	XCT	XCTTAB(ST)	;DISPATCH OR EXECUTE
	SOJA	W,GETNXT	;RETURN FOR NEXT CHAR.

XCTTAB:	JRST	ILLCH		; (00) ILLEGAL CHAR
	JRST	CRIN		; (01) CR-LF
	IORI	F,DOTFL		; (02) PERIOD
	JRST	DIG		; (03) DIGIT BEFORE POINT
	JRST	BLNKIN		; (04) BLANK OR TAB
	SOJA	W,GETNXT	; (05) RETURN FOR NEXT CHAR.
	IORI	F,MINFR		; (06) NEGATIVE FRACTION
	IORI	F,MINEXP	; (07) NEGATIVE EXP
	SOJA	X,DIG		; (10) DIGIT AFTER POINT
	JRST	DIGEXP		; (11) EXPONENT
	JRST	DELCK		; (12) DELIMITER TO BACK UP OVER
CHRTYP:	CAIN	T0,"+"		;CONVERT INPUT CHARS TO CHARACTER TYPE
	IORI	ST,PLSTYP
	CAIN	T0,"-"
	IORI	ST,MINTYP
	CAIE	T0," "		;SPACE
	CAIN	T0,"	"	;TAB
	IORI	ST,SPCTYP
	CAIN	T0,"."
	IORI	ST,DOTTYP
	CAIE	T0,"D"
	CAIN	T0,"E"
	IORI	ST,EXPTYP
;**;[652], INSERT @CHRTYP+11 1/2, DCE,12-APR-77
	CAIE	T0,"d"		;[652] LOWER CASE D?
	CAIN	T0,"e"		;[652] LOWER CASE E?
	IORI	ST,EXPTYP	;[652] YES
	TLNE	P3,IO.EOL	;56;END OF LINE SET
	TRC	ST,SPCTYP!CRTYP	;56;SET UP A BLANK
	JRST	GOTST		;GO DISPATCH ON OLD STATE AND CHAR TYPE


DIG:	JUMPN	B,DPDIG		;NEED D.P. YET?
	CAMLE	C,MAGIC		;NO, WILL MUL AND ADD CAUSE OVERFLOW?
	JRST	DPDIG		;MAYBE, SO DO IT IN DOUBLE PRECISION
	IMULI	C,12		;NO, MULTIPLY BY 10 SINGLE PRECISION
	ADD	C,0		;ADD DIGIT INTO NUMBER
	SOJA	W,GETNXT	;GO GET NEXT CHARACTER

DPDIG:	CAMLE	B,MAGIC		;WILL MULTIPLY AND ADD CAUSE OVERFLOW?
	AOJA	X,DIGRET	;YES
	IMULI	B,12		;MULTIPLY HIGH D.P. FRACTION BY 10
	MULI	C,12		;MULTIPLY LOW D.P. FRACTION BY 10
	ADD	B,C		;ADD HI PART OF LO PRODUCT INTO RESULT
	MOVE	C,D		;GET LO PART OF LO PRODUCT
	TLO	C,(1B0)		;STOP OVERFLOW IF CARRY INTO HI WORD
	ADD	C,0		;ADD DIGIT INTO FRACTION
	TLZN	C,(1B0)		;SKIP IF NO CARRY INTO HI WORD
	ADDI	B,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:	IORI	F,EXPFL		;SET FLAG TO SAY WE'VE SEEN EXPONENT
	CAILE	XP,^D100	;SIMPLE TEST FOR LARGNESS
	SOJA	W,GETNXT	;THROW DIGIT AWAY
	IMULI	XP,12		;MULTIPLY BY TEN
	ADD	XP,0		;ADD IN NEXT DIGIT
	SOJA	W,GETNXT	;DECREMENT FIELD WIDTH AND GET NEXT CHAR
;	 ? ,CR , . ,0-9,   ,D E, + , - ,
NXTSTA:	BYTE (9)
	000,010,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
	

CRIN:	TLNE	P3,IO.TTY	;INPUT FROM TTY?
	JRST	ENDF1		;YES, AS IF IN DELIMITER MODE (FREE FORMAT)
	JUMPL	W,ENDF1		;FREE FORMAT?, ALREADY PASSED OVER CR-LF

BLNKIN:	JUMPL	W,ENDF		;FREE FORMAT
	MOVEI	0,0		;NO, CHANGE SPACE TO 0
	LSH	ST,-^D30	;PUT STATE IN BITS 30-32
	JRST	GOT0		;AND USE IT

ILLCH:				;[354]
DELCK:				;[354]
ERROR0:	CAME	W,MUN		;[357] [354] FIRST ILLEGAL CHAR IN FREE FORMAT
	JUMPL	W,ENDF		;[354] NO - DELIMITER OF FREE FORMAT
	SKIPN	ILLEG.(P4)	;ILLEGAL CHAR. FLAG SET?
	ERROR	(DAT,7,7,GETCH2);ILLEGAL CHARACTER IN INPUT
;**;[462],ERROR1,DPL,01-AUG-75
ERROR1:	SOJLE	W,ZERO		;[462] COUNT BAD CHARACTER
	JSP	P1,IBYTE.	;GET NEXT CHAR
	TLNN	P3,IO.EOL	;SEE IF AT END OF LINE?
	JRST	ERROR1		;[462] NO, SKIP CHAR
	JRST	ZERO		;[462] YES, SET TO ZERO
ADDCNT:
ENDF:
ENDF1:	SKIPGE	W		;[354] CHECK FREE FORMAT
	PUSHJ	P,SFDEL%	;[354] YES, SAVE DELIMITER
	MOVE	G4,(P)		;GET THE WIDTH FIELD BACK
	TRNE	F,DOTFL		;HAS DECIMAL POINT BEEN INPUT?
	JRST	ENDF2		;YES
	LDB	D,D.PNTR	;[265] NO, GET DIGITS AFTER POINT FROM FORMAT
	SUB	X,D		;  AND MODIFY DECIMAL EXPONENT
ENDF2:	HRRE	D,SCL.SV(P4)	;GET SCALE FACTOR
	TRNN	F,EXPFL		;EXPONENT IN DATA?
	SUB	X,D		;NO, ADD INTO EXPONENT
	TRNE	F,MINEXP	;WAS D OR E EXPONENT NEGATIVE?
	MOVNS	XP		;YES, SO NEGATE IT
	ADD	X,XP		;ADD EXPONENT FROM D OR E
NORM:	MOVEI	BXP,306		;INIT BINARY EXPON FOR D.P. INTEGER
	JUMPN	B,NORM1		;XFER IF AT LEAST ONE 1 IN HIGH HALF
	EXCH	B,C		;HIGH HALF ZERO, MOVE LOW HALF TO HIGH,
				;AND CLEAR LOW HALF
	SUBI	BXP,^D35	;AND ADJUST EXPONENT FOR 35 SHIFTS
NORM1:	MOVE	A,B		;GET D.P. HIGH HALF INTO A
	JFFO	A,NORM2		;ANY ONES NOW?
	JRST	ZERO		;NO, RESULT IS 0
NORM2:	EXCH	B,C		;YES, GET D.P. LOW HALF INTO B, AND
				;PUT SHIFT COUNT INTO C
	ASHC	A,-1(C)		;NORMALIZE D.P. INTEGER WITH BIN POINT
				;BETWEEN BITS 0 AND 1 IN HIGH WORD
	SUBI	BXP,-1(C)	;AND ADJUST EXPON TO ALLOW FOR SHIFTING
	JUMPE	X,ENDF6		;IF DECIMAL EXP=0, NO MUL BY 10 NEEDED
ENDF3:	MOVM	D,X		;GET MAGNITUDE OF DECIMAL EXPONENT
	CAILE	D,PTLEN.	;BETWEEN 0 AND MAX. TABLE ENTRY?
	MOVEI	D,PTLEN.	;NO, MAKE IT SO
	SKIPGE	X		;AND RESTORE CORRECT SIGN
	MOVNS	D
	SUB	X,D		;LEAVE ANY EXCESS EXPONENT IN X
;**; [563] CHANGE @ ENDF3+6	CLRH	14-JUL-76
	PUSH	P,T2		;[563] GET A REGISTER
	MOVE	T2,DAT.TP+2(P4)	;[563] GET VARIABLE TYPE
	CAIN	T2,TP%DOR	;[563] DOUBLE PRECISION ?
	JRST	[POP	P,T2		;[563] YES, RESTORE T2
		JRST	DPMUL	]	;[563] TO DPMUL
	POP	P,T2		;[563] RESTORE T2
SPMUL:	MUL	A,HITEN.(D)	;NO, MULTIPLY BY POWER OF TEN
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:	IDIVI	D,4		;CONVERT DEC EXP TO BINARY EXPONENT
	LDB	D,EXTAB.(D+1)	;BY TABLE LOOKUP
	ADDI	BXP,-200(D)	;ADJUST BINARY EXPONET (LESS EXCESS 200)
	JUMPN	X,ENDF3		;ANY MORE DECIMAL EXPONENT LEFT?
ENDF6:	TLO	A,(1B0)		;NO, START ROUNDING (ALLOW FOR OVERFLOW)
;**; [563] CHANGE @ ENDF6+1	CLRH	14-JUL-76
	PUSH	P,T2		;[563] GET A REGISTER
	MOVE	T2,DAT.TP+2(P4)	;[563] GET VARIABLE TYPE
;**; [654] INSERT AT ENDF6+2	SWG	26-APR-77
	CAIE	T2,TP%INT	;[654] INTEGER? MUST NOT BE ROUNDED AS
				;[674] SINGLE PRECISION OR LOSES 8 BITS
	CAIN	T2,TP%DOR	;[563] DOUBLE PRECISION ?
	JRST	[POP	P,T2		;[563] YES, RESTORE T2
		JRST	DPRND	]	;[563] TO DPRND
	POP	P,T2		;[563] RESTORE T2
SPRND:	ADDI	A,200		;NO, ROUND IN HIGH WORD
	TRZ	A,377		;GET RID OF USELESS (UNUSED) BITS
	MOVEI	B,0		; DITTO
ENDF7:	TLZE	A,(1B0)		;CARRY PROPOGATE TO BIT 0?
	JRST	ENDF7A		;NO
	ASHC	A,-1		;YES, RENORMALIZE TO RIGHT
	ADDI	BXP,1		;AND ADJUST BINARY EXPONENT
	TLO	A,(1B1)		;AND TURN ON HI FRACTION BIT
ENDF7A:	TRNE	BXP,777400	;IS BINARY EXPONENT TOO LARGE
	JRST	BADEXP		;YES, RETURN ZERO OR INFINITY
	ASHC	A,-8		;NO, LEAVE ROOM FOR EXPONENT
	DPB	BXP,[POINT 9,A,8] ;INSERT EXPONENT INTO HI WORD
IFE CPU-KA10,<
;**; [563] CHANGE @ ENDF7A+4 (IN IFE CPU-KA10) CLRH 14-JUL-76
	PUSH	P,T2		;[563] GET A REGISTER 
	MOVE	T2,DAT.TP+2(P4)	;[563] GET VARIABLE TYPE
	CAIE	T2,TP%DOR	;[563] SINGLE PRECISION ?
	JRST	[POP	P,T2		;[563] YES, RESTORE T2
		JRST	ENDF8	]	;[563] AND TO ENDF8
	POP	P,T2		;[563] RESTORE T2
	ASH	B,-8		;YES, ALLOW ROOM FOR LOW EXPONENT
	JUMPE	B,ENDF8		;IS LOW FRACTION ALL ZERO?
	SUBI	BXP,^D27	;NO, INSERT EXPONENT 27 SMALLER THAN
	DPB	BXP,[POINT 9,B,8] ;  HIGH EXPONENT
ENDF8: >
RETURN:	TLZN	P2,FT.INC	;[445] FLINC TYPE CONVERSION
	JRST	RETRN2		;[445] NO
	HLRE	C,A		;[445] YES-GET THE EXPONENT
	ASH	C,-9		;[445] RIGHT 8 BITS
	TLZ	A,777000	;[445] CLEAR THE EXPONENT
	ASHC	A,-201-^D26(C)	;[445] CHANGE FRACTION TO INTEGER
	TLZ	P2,FT.PRC	;[445] CLEAR DP FLAG
RETRN2:	TRNE	F,MINFR		;[445] RESULT NEGATIVE?
	DFN	A,B		;[445] YES, SO NEGATE RESULT
	POP	P,G4		;RESTORE G4
;	POP	P,G3		;RESTORE 
	POP	P,G2
	POP	P,G1		;NOT REQUIRED
	MOVEM	T0,(G1)		;STORE IN USER AREA
;**; RETRN2+7L	CLRH	14-JUL-76
	PUSH	P,T2		;[563] SAVE T2
	MOVE	T2,DAT.TP+2(P4)	;[563] GET VARIABLE TYPE
	CAIN	T2,TP%DOR	;[563] DOUBLE PRECISION ?
	MOVEM	T1,1(G1)	;YES, STORE LOW ALSO
;**; [563] INSERT @ RETRN2+8 1/2 L	CLRH	14-JUL-76
	POP	P,T2		;[563] RESTORE T2
	POPJ	P,		;RETURN TO USER

BADEXP:	HRLOI	A,377777	;SET NUMBER TO LARGEST POSSIBLE
	JUMPSP	.+2		;SKIP IF SINGLE PRECISION
IFN CPU-KA10,<	HRLOI	B,377777 >	;FOR PDP-6 OR KI10
IFE CPU-KA10,<	HRLOI	B,344777 >	;FOR KA10
	TRNE	BXP,1B18	;IF EXPONENT IS NEGATIVE
ZERO:	SETZB	A,B		;SET TO ZERO
	JRST	RETURN

	POINT 9,EXP10.-1(D),17
	POINT 9,EXP10.-1(D),26
	POINT 9,EXP10.-1(D),35
EXTAB.:	POINT 9,EXP10.(D),8
	POINT 9,EXP10.(D),17
	POINT 9,EXP10.(D),26
	POINT 9,EXP10.(D),35
;HERE FOR DOUBLE PRECISION MULTIPLY, ROUNDING 

DPMUL:	MUL	B,HITEN.(D)	;LO FRAC TIMES HI POWER OF TEN(RESULT IN B,C)
	MOVE	P1,B		;GET HI PART OF PREVIOUS PRODUCT OUT OF WAY
	MOVE	B,A		;COPY HI PART OF FRACTION
	MUL	B,LOTEN.(D)	;HI FRAC TIMES LO POWER OF TEN
	TLO	P1,(1B0)
	ADD	P1,B		;SUM OF HI PARTS OF CROSS PRODUCTS TO AC T
	MUL	A,HITEN.(D)	;HI FRACTION TIMES HI POWER OF TEN
	TLON	P1,(1B0)		;DID CARRY OCCUR?  ALLOW FOR NEXT CARRY
	ADDI	A,1		;CARRY FROM ADDING CROSS PRODUCTS
	ADD	B,P1		;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
	JRST	ENDF5		;GO NORMALIZE RESULT

DPRND:	TLO	B,(1B0)		;START ROUNDING (ALLOW FOR CARRYS)
IFN CPU-KA10,<	ADDI	B,200 >	;LOW WORD ROUNDING FOR PDP-6 OR KI10
IFE CPU-KA10,<
	CAIGE	BXP,^D27	;KA10 LOW EXPONENT UNDERFLOW?
	JRST	SPRND		;YES, ROUND IN HIGH WORD
	ADDI	B,100000 >	;NO, KA10 ROUND IN LOW WORD
	TLZN	B,(1B0)		;DID CARRY PROPOGATE TO SIGN?
	AOJA	A,ENDF7		;YES, ADD CARRY INTO HIGH WORD
	JRST	ENDF7		;AND GO RENORMALIZE IF NECESSARY
	PRGEND
	TITLE	FLOUT%	%5A(660) 	FLOATING POINT OUTPUT
	SUBTTL	D. NIXON AND T. W. EGGERS
	SUBTTL	D. TODD /DMN/DRT/HPW/MD/JNG/CLRH	21-JUL-76



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

;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION

	SEARCH	FORPRM		;GET FOROTS GLOBAL SYMBOL TABLE
;	DEFINE THE LOADING PARAMETERS
	SEGMEN

;OLD ACCUMULATOR DEFINITIONS


;OLD ACCS
	AC0==T0		;FLOATING POINT NO. ON ENTRY
	AC1==T1		;USED IN FORMING DIGITS
	AC2==T2		;DITTO. D.P. ONLY
	XP==T3		;DECIMAL EXPONENT
	D==T4		;D, NO. OF DIGITS AFTER DEC. POINT
	W==T5		;FIELD WIDTH/NO. OF BLANKS TO OUTPUT
	C==T5		;CNTR./NO. OF CHARS BEFORE DEC. POINT
	SF==G1		;SCALE FACTOR
	F==P4		;FLAGS (IN UNUSED BITS)


	NUMSGN==1	;NEGATIVE NUMBER
	DIGEXH==2	;DIGITS EXHAUSTED
	NOSIGN==4	;NO SPACE FOR + SIGN
;**; [566] IN P4 LEFT DEFINITIONS	CLRH	21-JUL-76
	EQZER==10	;[566] ITEM IS IDENTICALLY ZERO

;**;[660] FLOUT%  SJW  26-MAY-77  BIND SPMAX TO 8 NOT 9
	SPMAX==8	;[660]MAXIMUM NO. OF DIGITS TO OUTPUT (SINGLE PRECISION)
IFE CPU-KA10,<DPMAX==^D16>	;DITTO. (DOUBLE PRECISION)
IFN CPU-KA10,<DPMAX==^D18>
	DPMIN==SPMAX	;NO. OF DIGITS IF LS. WORD IS NOT SIGNIFICANT

	FT.FTP==-<FT.ETP!FT.PRC!FT.GTP>
	ENTRY	FLOUT%
	EXTERN	OBYTE.,EXP10.,HITEN.,LOTEN.,PTLEN.
	EXTERN	W.PNTR,D.PNTR	;[265]
FLOUT%:
	PUSH	P,P4		;SAVE ACCS
	PUSH	P,P2		;SOME FLAGS ARE CHANGED
	PUSH	P,G1		;SAVE ALL G ACCS
	PUSH	P,G2		;GLOBAL AC'S MUST BE SAVE BOTTOM TO TOP
	PUSH	P,G3		;
	PUSH	P,G4		;G4 MUST BE LAST ON THE STACK
RETRY:	MOVE	T0,(G1)		;LOAD AC 0 WITH NUMBER
	SETZ	T1,		;[%441] CLEAR LOW WORD
	MOVE	XP,DAT.TP+2(P4)	;[345][%441] GET VARIABLE TYPE
;**; [563] CHANGE @ RETRY+3	CLRH	14-JUL-76
	CAIN	XP,TP%DOR	;[563] DOUBLE PRECISION ?
	SKIPA	T1,1(G1)	;[220] YES, GET LOW WORD ALSO
RETRY1:	FADRI	T0,0		;[%441] FORCE NORMALIZATION
;**; [566] CHANGE @ RETRY1+1	CLRH	21-JUL-76
	TLZ	P4,NUMSGN!DIGEXH!NOSIGN!EQZER	;[566]
	SETZ	XP,		;CLEAR EXPONENT
	JUMPGE	AC0,FLOUT1	;NUMBER NEGATIVE?
	DFN	AC0,AC1		;YES, NEGATE IT
	TLOA	F,NUMSGN	;AND - SET SIGN FLAG

FLOUT1:	JUMPE	AC0,FLOUT6	;ESCAPE IF ZERO
	HLRZ	G2,AC0		;EXTRACT EXPONENT
	LSH	G2,-9
IFE CPU-KA10,<CAIL	G2,^D27		;LOW HALF INVALID?
	JRST	.+3		;NO
	TLZE	P2,FT.PRC	;YES, SINGLE PRECISION ONLY
	TLO	P2,FT.ETP	;IF D.P., FORCE E TYPE
	LSH	AC1,8		;GET RID OF LOW EXP>
	TLZ	AC0,777000	;GET RID OF HIGH EXP
	ASHC	AC0,8		;PUT BIN POINT BETWEEN BITS 0 AND 1
FLOUT2:	HRREI	G3,-200+2(G2)	;GET RID OF EXCESS 200, +2 IS A DIDDLE
	IMULI	G3,232	;DEC EXP=LOG10(2)*BIN EXP=.232(OCTAL)*BIN EXP
	ASH	G3,-^D9		;GET RID OF 3 OCTAL FRACTION DIGITS
		;T1 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
	MOVM	G4,G3		;GET MAGNITUDE OF *10 SCALER
	CAIGE	G4,PTLEN.	;IS THE POWER OF 10 TABLE LARGE ENOUGH
	JRST	FLOUT3		;YES
	SKIPL	G3		;NO, SCALE 1ST BY LARGEST ENTRY
	SKIPA	G3,[PTLEN.]	;GET ADR OF LARGEST POSITIVE POWER OF 10
	MOVNI	G3,PTLEN.	;GET ADR OF LARGEST NEG POWER OF 10
	JUMPDP	[		;DOUBLE PRECISION
		PUSHJ	P,DPMUL	;SCALE BY LARGE POWER OF 10
		JRST	FLOUT2]	;GO DO 2ND SCALING
	PUSHJ	P,BINEXP	;GET CORRESPONDING BINARY POWER OF 2
	PUSHJ	P,FLODIV	;SCALE NUMBER BY A LARGE POWER OF 10
	JRST	FLOUT2		;AND GO DO THE SECOND SCALING
		;GET BINARY EXPONENT OF POWER OF 10, GIVEN DECIMAL EXP
BINEXP:	MOVE	G4,G3		;COPY DECIMAL POWER OF 10
	LSHC	G4,-2		;DIVIDE BY 4, EXP10. HAS 4 ENTRIES/WORD
	TLNE	P1,(1B0)	;WHICH HALF OF WORD?
	SKIPA	G4,EXP10.(G4)	;RIGHT HALF
	HLRZ	G4,EXP10.(G4)	;LEFT HALF
	TLNN	P1,(1B1)	;WHICH QUADRANT
	LSH	G4,-^D9		;1ST OR 3RD
	ANDI	G4,777		;MASK TO SIZE
	POPJ	P,

		;SCALE DOUBLE FRACTION BY A POWER OF 10
DPMUL:	JUMPE	G3,CPOPJ	;IF DEC EXP IS 0, RETURN
	ADD	XP,G3		;PUT DEC SCALE FACTOR INTO XP
	MOVN	G3,G3		;TAKE RECIPROCAL OF EXPONENT
	PUSHJ	P,BINEXP	;GET CORRESPONDING BIN EXP
	ADDI	G2,-200(G4)	;ADD POWER EXP INTO FRAC EXP
	MUL	AC1,HITEN.(G3)	;FORM FIRST CROSS PRODUCT
	MOVE	G4,AC0		;COPY HI FRACTION
	MUL	G4,LOTEN.(G3)	;FORM 2ND CROSS PRODUCT
	TLO	G4,(1B0)	;AVOID OVERFLOW
	ADD	G4,AC1		;ADD CROSS PRODUCTS	
	MUL	AC0,HITEN.(G3)	;FORM HI PRODUCT
	TLON	G4,(1B0)	;DID CROSS PRODUCT OVERFLOW
	ADDI	AC0,1		;YES
	ADD	AC1,G4		;ADD CROSS PRODUCTS IN
	TLZN	AC1,(1B0)	;OVERFLOW?
	ADDI	AC0,1		;YES
	TLNE	AC0,(1B1)	;NORMALIZED?
	POPJ	P,		;YES
	ASHC	AC0,1		;NO, SHIFT LEFT ONE
	SOJA	G2,CPOPJ		;AND ADJUST EXPONENT

		;SCALE SINGLE FRACTION BY A POWER OF 10
FLODIV:	JUMPE	G3,CPOPJ	;IF DEC EXP IS ZERO, RETURN
	ADD	XP,G3		;PUT DEC SCALE FACTOR INTO XP
	SUBI	G2,-200-1(G4)	;SUB BIN POWER OF 10 EXP FROM BIN FRACTION EXP
				;REMOVE EXCESS 200; -1 ALLOWS FOR ASHC
				;LEFT HALF OF T GETS GARBAGED
	MOVEI	AC1,0		;CLEAR LOW WORD OF BIN FRACTION
	CAMGE	AC0,HITEN.(G3)	;WILL DIV CAUSE DIVIDE CHECK?
	SOJA	G2,.+2		;NO, ALLOW FOR NOT DOING ASHC
	ASHC	AC0,-1		;YES, SCALE FRACTION
	DIV	AC0,HITEN.(G3)	;SCALE FRACTION BY POWER OF 10
CPOPJ:	POPJ	P,		;RETURN
FLOUT3:	PUSHJ	P,BINEXP	;GET BIN EXP THAT MATCHES DEC EXP
;**; [563] CHANGE @ FLOUT3+1	CLRH	14-JUL-76
	PUSH	P,T2		;[563] SAVE T2
	MOVE	T2,DAT.TP+2(P4)	;[563] GET VARIABLE TYPE
	CAIN	T2,TP%DOR	;[563] DOUBLE PRECISION ?
	JRST	[POP	P,T2		;[563] YES, RESTORE T2
		JRST	FLOT3A	]	;[563] LEAVE
	POP	P,T2		;[563] RESTORE T2
	CAILE	G4,(G2)		;IS THIS POWER OF 10 .GT. FRACTION?
	JRST	FLOUT4		;YES, IN THE EXPONENT
	CAIN	G4,(G2)		;MAYBE, LOOK AT EXPONENTS SOME MORE
	CAML	AC0,HITEN.(G3)	;EXPONENTS THE SAME, COMPARE FRACTIONS
	AOJA	G3,FLOUT3	;POWER OF 10 IS ONE TOO SMALL
FLOUT4:	PUSHJ	P,FLODIV	;POWER OF 10 IS OK, DO THE SCALING
	ASH	AC0,-200(G2)	;SCALE FRACTION RIGHT BY ANY REMAINING POWERS OF 2
	JRST	FLOUT6

FLOT3A:	CAILE	G4,(G2)		;FRACTION .GT. POWER OF 10?
	JRST	FLOT4A		;YES
	CAIE	G4,(G2)
	AOJA	G3,FLOT4A	;NOT IN EXPONENT
	CAMGE	AC0,HITEN.(G3)	;
	JRST	FLOT4A		;YES, IN HIGH FRACTION
	CAMN	AC0,HITEN.(G3)
	CAML	AC1,LOTEN.(G3)
	ADDI	G3,1		;NO, IN FRACTION PART
FLOT4A:	PUSHJ	P,DPMUL		;SCALE BY POWER OF 10
	ASHC	AC0,-200(G2)	;SCALE BY ANY REMAINING POWERS OF 2
FLOUT6:	MOVE	G4,(P)		;GET THE FIELD PARAMETERS
	LDB	W,W.PNTR	;[265]
	LDB	D,D.PNTR	;[265]
	HRRE	SF,SCL.SV(P4)	;GET THE SCALING FACTOR
;**; [544] INSERT @ FLOUT6+3 1/2	CLRH	11-MAY-76
	JUMPN	AC0,FLOU6A	;[544] SKIP THIS IF NOT IDENTICALLY ZERO
;**; [566] INSERT @ FLOUT6+4 1/2	CLRH	21-JUL-76
	TLO	P4,EQZER	;[566] FLAG IDENTICALLY ZERO
	MOVN	XP,SF		;[544] MAKE DECIMAL EXPONENT SCALING FACTOR
	SOJ	XP,		;[544] NEGATED, LESS  ONE, FOR ZERO ONLY
FLOU6A:	JUMPN	W,FLOUT7	;[544]
	TLNE	P2,FT.PRC	;DOUBLE PRECISION?
	ADDI	W,1		;YES, INCREMENT INDEX INTO TABLE
	HRRZ	D,FRMTAB(W)	;PICKUP DEFAULT FORMAT FOR D
	HLRZ	W,FRMTAB(W)	;SAME FOR W
FLOUT7:	TLNN	P2,FT.GTP	;G TYPE CONVERSION
	JRST	FLOUT8		;NO
	CAME	XP,[-1]
	CAMLE	XP,D
	TLO	P2,FT.ETP	;SET E TYPE CONVERSION
FLOUT8:	MOVE	G3,D
	TLNN	P2,FT.ETP!FT.PRC
	JRST	.+3
	JUMPLE	SF,FLOUT9
	AOJA	G3,FLOU10
	TLNE	P2,-FT.FTP
	JRST	FLOU10
	ADD	G3,XP
FLOUT9:	ADD	G3,SF
FLOU10:	CAILE	G3,DPMAX	;TOO MANY DECIMAL PLACES
	MOVEI	G3,DPMAX	;YES, REDUCE TO MAX POSSIBLE
;**; [563] CHANGE @ FLOU10+2	CLRH	14-JUL-76
	PUSH	P,T2		;[563] SAVE T2
	MOVE	T2,DAT.TP+2(P4)	;[563] GET VARIABLE TYPE
	CAIE	T2,TP%DOR	;[563] DOUBLE PRECISION ?
	CAIGE	G3,SPMAX	;TOO MANY DECIMAL PLACES?
	JRST	DIGOK		;NO,  SIZE OK
	MOVEI	G3,SPMAX	;YES, REPLACE BY MAX PERMITTED
	TLNN	G4,W.MASK##	;[266] FREE FORMAT?
	SUBI	G3,1		;YES, ONE LESS DIGIT HELPS ROUNDING
;**;[563] INSERT @ DIGOK	CLRH	14-JUL-76
DIGOK:	POP	P,T2		;[563] RESTORE T2
	MOVE	G2,P		;[563] MARK BOTTOM OF DIGIT STACK
	PUSH	P,[0]		;AND ALLOW FOR POSSIBLE OVERFLOW
	SKIPGE	G4,G3		;GET # OF DIGITS INTO T2
	MOVEI	G4,0		;IF NEGATIVE, ADD 0.5 TO FRACTION
	ADD	AC0,RNDHGH(G4)	;ROUND HI WORD TO CORRECT NUMBER OF DIGITS
;**; [563] CHANGE @ DIGOK+5	CLRH	14-JUL-76
	PUSH	P,T2		;[563] SAVE T2
	MOVE	T2,DAT.TP+2(P4)	;[563] GET VARIABLE TYPE
	CAIN	T2,TP%DOR	;[563] DOUBLE PRECISION ?
	JRST	[POP	P,T2		;[563] RESTORE T2
		JRST	DIGOK3	]	;[563] SKIP THIS
	POP	P,T2		;[563] RESTORE T2
	ADDI	AC0,2		;NO ROUND SLIGHTLY MORE
	TLZN	AC0,(1B0)	;DID CARRY PROPOGATE TO BIT 0?
	AOS	(P)		;YES, PROPOGATE CARRY TO LEADING 0
FLOU11:	MULI	AC0,^D10	;MULTIPLY BY 10
	PUSH	P,AC0		;STORE DIGIT ON DIGIT STACK
	MOVE	AC0,AC1		;AND SET UP NEW FRACTION
	SOJG	G4,FLOU11
	JRST	FLOU13

DIGOK3:	ADD	AC1,RNDLOW(G4)	;ROUND LOW
	TLZN	AC1,(1B0)	;CARRY?
	ADDI	AC0,1		;YES
	TLZN	AC0,(1B0)	;DID CARRY PROPAGATE TO BIT 0
	AOS	(P)		;YES , LEADING DIGIT IS A 1
FLOU12:	EXCH	AC0,AC1		;PUT HI WORD IN AC1
	MULI	AC1,^D10	;MUL HI WORD BY 10
	PUSH	P,AC1		;STORE DIGIT ON STACK
	MULI	AC0,^D10	;MUL LOW WORD BY 10
	TLO	AC0,(1B0)	;STOP OVERFLOW
	ADD	AC0,AC2		;ADD HI WORD BACK INTO AC0
	TLZN	AC0,(1B0)	;CARRY
	AOS	(P)		;YES, INCREMENT DIGIT ON STACK
	SOJG	G4,FLOU12	;LOOP
				;FALL INTO FLOU13
FLOU13:	MOVEI	G4,2(G2)		;GET BASE OF STACKED DIGITS
	MOVE	P1,1(G2)
	JUMPE	P1,FLOU14	;DID OVERFLOW OCCUR?
	SUBI	G4,1		;YES - MOVE BACK BASE POINTER
	ADDI	XP,1		;NO, INCREMENT EXPONENT

FLOU14:	TLNE	P2,FT.GTP
	TLNE	P2,FT.ETP!FT.PRC
	JRST	FLOU15
	SKIPL	XP
	CAIGE	D,(XP)		;WILL F FORMAT FIT?
	JRST	[TLO	P2,FT.ETP
		JUMPE	SF,FLOU15
		MOVE	P,G2
		MOVE	G1,-3(P)	;RELOAD G1
		JRST	RETRY]
	SETZ	SF,
FLOU15:	SUBI	C,2(D)		;SIGN, POINT AND CHARS. FOLLOWING
	TLNE	P2,FT.ETP!FT.PRC
	JRST	FLOU16


;HERE FOR F TYPE CONVERSION
	ADD	SF,XP		;COUNT THE LEADING DIGITS
	TLNE	P2,FT.GTP
	JRST	[SUBI	D,(XP)		;NO, REDUCE CHAR. AFTER POINT FOR F
		JRST	FLOU17]		;BUT IGNORE SCALE FACTOR IN WIDTH
	JUMPLE	SF,TRYFIT	;IGNORE NEG SCALING
	SUBI	C,(SF)		;+SCALING
	JRST	TRYFIT
;HERE FOR E AND D TYPE CONVERSION
FLOU16:	JUMPE	SF,FLOU17
	JUMPG	SF,[SUBI	D,-1(SF)
		JUMPGE	D,FLOU17
		ADD	C,D
		JRST	FLOU17]
	MOVM	SF,SF
	CAML	D,SF
	JRST	FLOU18
	ADD	C,D
	SUB	C,SF
FLOU18:	MOVN	SF,SF
FLOU17:	SUBI	C,4		;ALLOW FOR E+00
TRYFIT:	TLNE	P2,FT.ETP!FT.PRC	;[377] SPECIAL FOR F FORMAT
	SKIPG	SF		;[373] POSITIVE SCALING FACTOR
	JUMPGE	C,FIT		;[373] NO-WILL FIT FORMAT
	JUMPG	C,FIT		;[373] YES-WILL FIT
	TLNE	F,NUMSGN	;[373] IS SIGN POSITIVE
	JRST	TRYFI0		;[373] NO
	TLNE	P2,FT.ETP!FT.PRC	;[377] SPECIAL FOR F FORMAT
	SKIPG	SF		;[373] POSITIVE SCALING FACTOR
	AOJE	C,POSIGN	;[373] NO-YES, ALLOW IT
	JUMPE	C,POSIGN	;[373] YES-YES, ALLOW IT
TRYFI0:	TLNN	P2,FT.ETP!FT.PRC	;[373] IF E FORMAT
	TLZN	P2,FT.GTP	;WAS IT G TO F CONVERSION?
	JRST	NOFIT		;E TYPE OR NOT G TO F
;**;[476] Change @ TRYFI0+3L	JNG	22-Nov-75
	ADDI	C,4		;[476] REMOVE 4 TRAILING SPACES
	JRST	TRYFIT		;AND TRY AGAIN
NOFIT:
IFN ASTFL,<MOVE	P,G2		;RESTORE STACK POINTER
	POP	P,G4		;RESTORE THE WIDTH SPECS
	TLNN	G4,W.MASK##	;[266] FREE FORMAT?
	TLO	G4,17		;[266] YES - SET FIELD WIDTH
	ERROR	(DAT,5,2,RETRNF)	;OUTPUT ASTERICKS>
IFE ASTFL,<ADD	SF,C		;LESS DIGITS TO OUTPUT
	ADD	G3,C		;AND LESS IN STACK
	SUB	G4,C		;ADJUST STACK POINTER>

FIT:	CAIG	C,1		;SPACE FOR LEADING BLANKS?
	JRST	GO2ERF		;NO LEADING BLANKS
	TLNN	P2,FT.LSD	;LEADING BLANK FILL WANTED
	JSP	P1,SPACE	;YES, OUTPUT ONE
	SOJA	C,FIT		;UNTIL ENOUGH

POSIGN:	TLO	F,NOSIGN	;SIGNAL NO ROOM FOR + SIGN
GO2ERF:	TLNN	P2,FT.ETP!FT.PRC	;TEST FLOATING POINT FLAGS
	JRST	FFORM		;NO, USE FIXED POINT
				;FALL INTO EFORM
;E FORMAT

EFORM:	JUMPN	G3,.+2		;CHECK FOR NO SIGNIFICANT DIGITS
	TLO	F,DIGEXH	;ENSURE ZEROES WILL BE PRINTED
	SUB	XP,SF		;SCALE EXPONENT
	JUMPLE	SF,EFORM1	;JUMP IF NOT POSITIVE SCALING
				;HAVE 1 DIGIT BEFORE POINT
	JSP	P1,SIGN		;OUTPUT SIGN
	PUSH	P,SF
	JSP	P1,DIGIT		;OUTPUT LEADING DIGITS
	SOJN	G3,.+2		;COUNT EXPIRED?
	TLO	F,DIGEXH	;YES
	SOJN	SF,.-3		;RETURN FOR MORE
	POP	P,SF
	SOJA	SF,EFORM2		;SKIP LEADING ZERO

EFORM1:	JSP	P1,SIGN		;OUTPUT SIGN
	JUMPLE	C,EFORM2	;NO SPACE LEFT FOR "0"
	JSP	P1,ZERO		;OUTPUT ZERO
EFORM2:	JSP	P1,PERIOD	;AND DECIMAL POINT
	JUMPGE	SF,EFORM3	;ACCOUNT FOR POS SCALING
	ADD	D,SF		;NOT SO MANY DIGITS NOW
	JSP	P1,ZERO		;BY OUTPUTTING ZEROS
	AOJL	SF,.-1
EFORM3:	JUMPLE	D,EFORM4	;IF NOT ANY DIGITS AFTER POINT
	JSP	P1,DIGIT		;OUTPUT FRACTIONAL DIGIT
	SOJN	G3,.+2		;TOTAL COUNT EXPIRED?
	TLO	F,DIGEXH	;YES - FLAG DIGITS EXHAUSTED
	SOJG	D,.-3		;RETURN IF MORE DIGITS

EFORM4:	MOVEI	AC0,"E"
	TLNE	P2,FT.PRC	;DOUBLE PRECISION?
	MOVEI	AC0,"D"		;YES, GIVE USUAL D INSTEAD
	JSP	P1,OBYTE.	;OUTPUT "E" OR "D"
;**; [566] INSERT @ EFORM4 + 3 1/2	CLRH	21-JUL-76
	TLNE	P4,EQZER	;[566] EXACT ZERO ?
	SETZ	XP,		;[566] YES, ZERO THE EXPONENT ALSO
	JUMPGE	XP,EFORM5
	TLO	F,NUMSGN	;TYPE MINUS IF EXPONENT NEGATIVE
EFORM5:	JSP	P1,PLUS		;PRINT SIGN
	MOVEI	C,2		;AND SET DIGIT COUNT
	MOVE	P,G2		;RESTORE STACK POINTER
	MOVM	AC0,XP		;GET EXPONENT
	JRST	OUTP1		;AND LET OUTP1 DO THE WORK
;F FORMAT

FFORM:	JUMPLE	SF,FFORM3	;NO LEADING DIGITS
	SKIPLE	C		;ANY ROOM?
	JSP	P1,SPACE		;YES, ANOTHER BLANK THEN
	JSP	P1,SIGN		;OUTPUT SIGN
	JSP	P1,DIGIT		;OUTPUT INTEGRAL DIGIT
	SOJG	G3,.+2		;TOTAL COUNT EXPIRED?
	TLO	F,DIGEXH	;YES - FLAG DIGITS EXHAUSTED
	SOJG	SF,.-3		;RETURN IF MORE DIGITS
	JSP	P1,PERIOD	;PRINT DECIMAL POINT

FFORM1:	JUMPE	D,FFORM2	;TEST FOR DIG AFTER POINT 
	JSP	P1,DIGIT		;OUTPUT FRACTIONAL DIGIT
	SOJG	G3,.+2		;TOTAL COUNT EXPIRED?
	TLO	F,DIGEXH	;YES - FLAG DIGITS EXHAUSTED
	SOJG	D,FFORM1	;RETURN IF MORE DIGITS

FFORM2:	MOVE	P,G2		;RESTORE STACK
	TLNN	P2,FT.GTP	;G FORMAT REQUIRES 4 BLANKS
	JRST	RETRNO		;FINISHED
	MOVEI	C,4		;SET FOR 4
	JSP	P1,SPACE		;BLANKS
	SOJG	C,.-1
	JRST	RETRNO		;FINISHED

FFORM3:	ADD	D,SF		;REDUCE D IF SF NEGATIVE
	JUMPG	D,FFRM3A	; [517] IF D FIELD, GO TRY
	JUMPG	C,FFRM3A	; [517] IF ROOM FOR SIGN, GO DO IT
	TLNE	F,NUMSGN	; [517] IF MINUS SIGN, NO ROOM ANYWAYS
	IFN	ASTFL,<JRST	NOFIT>	; [517] ASTERISK IT OUT (A LITTLE LATE)
	IFE	ASTFL,<JFCL>	; [517] NO *'S, CONTINUE
	TLON	F,NOSIGN	; [517] ELSE SET NO ROOM FOR + SIGN
	ADDI	C,1		; [517] AND PUT BACK THE SPACE IT TOOK, IF ANY
FFRM3A:	JSP	P1,SIGN		; [517] OUTPUT SIGN
	SKIPLE	C		;IF ROOM FOR IT
	JSP	P1,ZERO		;OUTPUT "0"
	JSP	P1,PERIOD	;AND DEC. POINT
	JUMPGE	D,.+4		;IF D IS NEG. SF IS TOO BIG
	LDB	SF,[POINT 6,(G2),10]	;GET THE D FIELD SIZE
	MOVNS	SF		;SO USE DIGIT WIDTH FOR ZEROS
	SETZ	D,		;AND NO DIGITS
	JUMPE	SF,FFORM1	;NOW FOR DIGITS
	JSP	P1,ZERO		;ZERO AFTER POINT
	AOJA	SF,.-2		;LOOP ON ZEROS
; OUTPUT ROUTINES

PERIOD:	MOVEI	AC0,"."		;DECIMAL POINT
	PJSP	OBYTE.		;PRINT AND RETURN

SPACE:	MOVEI	AC0," "		;SPACE
	PJSP	OBYTE.

ZERO:	MOVEI	AC0,"0"
	JRST	OBYTE.

PLUS:	MOVEI	AC0,"+"
	JRST	SIGN1
SIGN:	TLZE	F,NOSIGN	;NO ROON FOR SIGN?
	JRSTF	@P1		;JUST RETURN
	MOVEI	AC0," "
SIGN1:	TLZE	F,NUMSGN	;ALWAYS CLEAR FLAG
	MOVEI	AC0,"-"		;SELECT SIGN
	PJSP	OBYTE.		;AND PRINT

DIGIT:	MOVEI	AC0,"0"
	TLNE	F,DIGEXH	;DIGITS EXHAUSTED?
	JRST	OBYTE.
	MOVE	AC0,(G4)	;GET NEXT DIGIT
	ADDI	AC0,"0"		;CONVERT TO ASCII
	AOJA	G4,OBYTE.	;AND PRINT

OUTP1:	MOVEI	XP,1		;SET UP DIGIT COUNT

OUTP2:	IDIVI	AC0,^D10	;AND GENERATE DIGITS IN REVERSE
	PUSH	P,AC1		;AND SAVE THEM ON THE STACK
	JUMPE	AC0,OUTP3	;ANY LEFT?
	AOJA	XP,OUTP2	;YES - COUNT AND CARRY ON

OUTP3:	CAML	XP,C		;ANY LEADING SPACES?
	JRST	OUTP4		;NO
	JSP	P1,ZERO		;YES - PRINT ONE
	SOJA	C,OUTP3		;AND DECREASE UNTIL FINISHED

OUTP4:	POP	P,AC0		;POP UP DIGIT
	ADDI	AC0,"0"		;ADD ASCII OFFSET
	JSP	P1,OBYTE.	;AND PRINT IT
	SOJN	XP,OUTP4	;REPEAT UNTIL FINISHED
RETRNO:
	POP	P,G4		;RESTORE THE STACK
RETRNF:	POP	P,G3	;G4 IS RESTORE BEFORE ASTERICK FILL ROUTINE CALL

	POP	P,G2
	POP	P,G1
	POP	P,P2
	POP	P,P4
	POPJ	P,		; EXIT FROM ROUTINE

FRMTAB:	17,,7
	DPMAX+8,,DPMAX
		;ROUNDING TABLE
		;THE SIGN BIT SET PREVENTS OVERFLOW WHEN ADDED
		;  INTO THE BINARY FRACTION
		;ALL NUMBERS BELOW ARE ROUNDED UP ALWAYS

DEFINE TABLE <
ROUND 200000000000,000000000000,0	;0.5E0
ROUND 014631463146,146314631463,2	;0.5E-1
ROUND 001217270243,327024365605,1
ROUND 000101422335,057065176763,7
ROUND 000006433342,353070414545,1
ROUND 000000517426,261070664360,5	;0.5E-5
ROUND 000000041433,336405536661,6
ROUND 000000003265,374515274536,5
ROUND 000000000253,314356106043,0
ROUND 000000000021,056027640466,7
ROUND 000000000001,267633766353,8	;0.5E-10
ROUND 000000000000,053765777027,5
ROUND 000000000000,004313631402,3
ROUND 000000000000,000341134115,0
ROUND 000000000000,000026411156,1
ROUND 000000000000,000002200727,8	;0.5E-15
ROUND 000000000000,000000163225,5
ROUND 000000000000,000000013416,9
ROUND 000000000000,000000001116,2
;ROUND 000000000000,000000000073,0
;ROUND 000000000000,000000000005,9	;0.5E-20
;ROUND 000000000000,000000000000,5	;0.5E-21
>

DEFINE ROUND (A,B,C)<	A+1B0>
RNDHGH:	TABLE

DEFINE ROUND (A,B,C)<	B+1B0+1>
RNDLOW:	TABLE

PRGEND
	TITLE	INTEG%	%4.(367)  DECIMAL INTEGER INPUT/OUTPUT FORTRAN IV
	SUBTTL	D. TODD/DRT/HPW/MD	06-SEP-74




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

;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION

	SEARCH	FORPRM		;GET FOROTS GLOBAL SYMBOL TABLE
;	DEFINE THE LOADING PARAMETERS
	SEGMEN

	ENTRY	INTEG%
	EXTERN	IBYTE.,OBYTE.,W.PNTR	;[265]
	EXTERN	GFDEL%,SFDEL%,SKIP%,MUN	;[354]

INTEG%:			;INTEGER INPUT/OUTPUT CONVERSION ROUTINE
	LDB	T3,W.PNTR	;[265] GET THE FIELD WIDTH
	SETZB	T5,T2		;CLEAR STORAGE
	JUMPO	INTO		;GO TO INTO (OUTPUT)
	JSP	P1,GFDEL%	;[354] RETRIEVE DELIMITER IF ANY
	JUMPG	T3,INTI1B	;[354] FIELD WIDTH SPECIFIED
	SETO	T3,		;SET VARIABLE FIELD FLAG
	PUSHJ	P,SKIP%		;[354] SKIP SPACES
	  JRST	INTI6		;[354] COMMA OR EOL (NULL FIELD)
	JRST	INTI1B		;[354] PROCESS FIELD
INTI1:	JUMPE	T3,INTI6	;FIELD EXHAUSTED
	JSP	P1,IBYTE.	;NO, GET NEXT INPUT CHARACTER
INTI1B:	CAIG	T0,"9"		;CHECK FOR A
	CAIGE	T0,"0"		;DECIMAL DIGIT (0-9)
	JRST	INTI3		;NOT A DECIMAL DIGIT
	TLO	T2,400000	;SET DIGIT SEEN FLAG
	TLNE	T2,100000	;HAS THE FIELD OVERFLOWED
	SOJA	T3,INTI1	;YES, DO NOT ACCUMULATE THE SUM
INTI1A:	ANDI	T0,17		;MAKE A BINARY NUMBER
	IMULI	T5,12		;MULT OUTPUT BY A POWER OF 10
	JFCL	11,INTI2	;FIELD OVERFLOW
	ADD	T5,T0		;ACCUMULATE THE SUM
	SOJA	T3,INTI1	;GET NEXT DIGIT
INTI2:	TLO	T2,100000	;SET FIELD OVERFLOW FLAG
	SOJA	T3,INTI1	;GET NEXT INPUT CHARACTER
INTI3:	TLNE	P3,IO.EOL	;IS THIS THE END OF LINE
	JRST	INTI5		;[367] YES
	CAIN	T0,11		;<TAB>
	MOVEI	T0," "		;CLEAR THE <TAB> CHARACTER
	CAIE	T0," "		;CHECK FOR A BLANK
	JRST	INTI3A		;NOT A BLANK OR <TAB>
	JUMPGE	T3,INTI1A	;YES, CONTINUE IF NOT FREE FORM
	JUMPGE	T2,INTI1	;NO DIGITS CONTINUE SCAN IF FREE FORM
INTI3A:	JUMPL	T2,INTI4	;DIGIT SEEN YET
	CAIN	T0,"-"		;NO, IS THIS A MINUS SIGN
	TLOA	T2,200000	;YES, SET THE FLAG
	CAIN	T0,"+"		;CKECK FOR A PLUS
	SOJA	T3,INTI1	;YES, GET NEXT CHARACTER
INTI4:	CAME	T3,MUN		;[354] IF FIRST CHAR THEN ILLEGAL
	JUMPL	T3,INTI6	;NO, CHECK FOR VARIABLE FIELD
	ERROR	(DAT,7,7,INTI1B);ILLEGAL CHARACTER IN INPUT
INTI5:	TLNN	P3,IO.TTY	;IS THIS A TELETYPE
	JUMPGE	T3,INTI1A		;NO, VARIABLE FIELD
INTI6:	TLZ	T5,400000	;YES, TTY END OF LINE OF W=0
	TLNE	T2,200000	;CHECK FOR SIGN
	MOVNS	T5		;MINUS (NEGATE THE RESULT)
	MOVEM	T5,(G1)		;PUT RESULT IN USER'S VARIALBLE
	PJMPL	T3,SFDEL%	;[354] SAVE DELIMITER IF NECESSARY
	POPJ	P,		;RETURN TO FOROTS
INTO:				;INTEGER OUTPUT ROUTINE
	SKIPN	T3		;CHECK FOR W=0
	MOVEI	T3,17		;SET DESCRIPTOR TO I15
	SKIPG	T4,(G1)		;GET USER'S VARIABLE CHECK SIGN
	MOVNS	T4		;NEGATIVE MAKE POSITIVE
	JFCL	[HRLOI	T4,377777	;GET LARGEST POSSIBLE NUMBER 
		IDIVI	T4,12		;GET A DIGIT
		ADDI	T5,"1"		;ADD AN ASCII 1
		JRST	INTO1+2]	;CONTINUE NORMAL CONVERSION
INTO1:	IDIVI	T4,12		;FORM AN INTEGER
	IORI	T5,"0"		;CONVERT TO ASCII
	PUSH	P,T5		;SAVE ON THE STACK
	SKIPE	T4		;CKECK FOR END OF DIGITS
	AOJA	T2,INTO1	;COUNT THE DIGIT AND CONTINUE
	AOS	T4,T2		;COUNT LAST AND SAVE IN T4
	SUB	T4,T3		;FIND THE EXCESS FIELD SIZE
	SKIPGE	(G1)		;CHECK THE VARIABLE SIGN
	AOJLE	T4,INTO2	;COUNT THE MINUS SIGN
	JUMPLE	T4,INTO2	;PLUS EXACT FIT IN THE FIELD
IFN ASTFL,<	MOVEI	T4,(T2)	;GET THE DIGITS ON THE STACK>
IFE ASTFL,<	SUB	T2,T4	;[242] GET THE NUMBER OF DIGITS
		MOVMS	T4	;MAKE POSITIVE>
	HRLS	T4		;SET UP EXCESS COUNT
	SUB	P,T4		;ADJUST THE STACK
IFN ASTFL,<	ERROR	(DAT,5,2,INTO6)	;FILL FIELD WITH ASTERICKS>
IFE ASTFL,<	SETZ	T4,	;CLEAR THE EXCESS COUNT>

INTO2:	AOJG	T4,INTO4	;CHECK FOR BLANK FILL
INTO3:	MOVEI	T0," "		;GET A FILL BLANK
	TLNN	P2,FT.LSD	;FILL BLANKS WANTED
	JSP	P1,OBYTE.	;OUTPUT THE FILL BLANK
	AOJLE	T4,INTO3	;CONTINUE FILLING
INTO4:	MOVEI	T0,"-"		;GET A MINUS SIGN
	SKIPGE	(G1)		;IS VARIABLE NEGATIVE
	JSP	P1,OBYTE.	;OUTPUT THE SIGN
INTO5:	POP	P,T0		;GET A CHARACTER FROM THE STACK
	JSP	P1,OBYTE.	;OUTPUT A DIGIT
	SOJG	T2,INTO5	;CONTINUE OUTPUTTING THE DIGITS
INTO6:	POPJ	P,		;RETURN TO FOROTS
	PRGEND
	TITLE	LOGIC%	%5A.(653)	LOGICAL INPUT/OUTPUT CONVERSION ROUTINES
	SUBTTL	D. TODD/HPW/MD/DCE	26-APR-77




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

;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION

	SEARCH	FORPRM		;GET THE FOROTS GLOBAL SYMBOLS
;	DEFINE THE LOADING PARAMETERS
	SEGMEN

	ENTRY	LOGIC%
	EXTERN	IBYTE.,OBYTE.,W.PNTR,O.PNTR	;[265]
	EXTERN	GFDEL%,SFDEL%,SKIP%,MUN		;[354]

LOGIC%:				;LOGICAL VARIABLE INPUT/OUTPUT ROUTINE
	LDB	T4,W.PNTR	;[265] GET THE FILD WIDTH
	JUMPO	LOUT		;GO TO LOUT ON OUTPUT
	SETZM	(G1)		;INPUT SET THE USER'S VARIABLE FALSE
	JSP	P1,GFDEL%	;[354] RETRIEVE DELIMITER
	JUMPG	T4,LINT0	;[354] NOT FREE FORMAT
	SETO	T4,		;[354] FREE FORMAT
	PUSHJ	P,SKIP%		;[354] SKIP SPACES
	  PJRST	SFDEL%		;[354] NULL FIELD
	JRST	LINT0		;[354] PROCESS FIELD
LINT:	JUMPE	T4,LINT3	;[354] IF W=0 RETURN
	JSP	P1,IBYTE.	;SKIP AN INPUT CHARACTER
LINT0:	CAIE	T0," "		;CKECK FOR A BLANK
	CAIN	T0,11		;OR <TAB>
	SOJA	T4,LINT		;[354] YES, IGNORE THE CHARACTER
	;**;[653], INSERT @ LINT0+2 1/2, DCE, 26-APR-77
	CAIE	T0,"f"		;[653] LOWER CASE F IS OK
	CAIN	T0,"F"		;CKECK FOR FALSE
	JRST	LINT1		;YES, PROCESS THE FALSE CHARACTER
	;**;[653], CHANGE @ LINT0+5, DCE, 26-APR-77
	CAIE	T0,"t"		;[653] CKECK, FOR TRUE
	CAIN	T0,"T"		;[653] UPPER CASE TOO
	SKIPA			;[653] FOUND A TRUE
	JRST	LINT2		;NO, ILLEGAL CHARACTER
	SETOM	(G1)		;YES, SET USER'S VARIABLE PRUE
LINT1:	SOJE	T4,LINT3	;[354] SPACING REQUIRED W=0
	JSP	P1,IBYTE.	;YES, SKIP AN INPUT CHARACTER
	JUMPG	T4,LINT1	;[354] CONTINUE UNTIL W=0
	CAIL	T0,"a"		;[354] FREE FORMAT - CHECK ALPHA
	CAILE	T0,"z"		;[354] LOWER CASE
	JRST	.+2		;[354] NO
	JRST	LINT1		;[354] IGNORE ALPHA
	CAIL	T0,"A"		;[354] CHECK ALPHA
	CAILE	T0,"Z"		;[354] UPPER CASE ALPHABETIC
	PJRST	SFDEL%		;[354] NO - CHECK DELIMITER
	JRST	LINT1		;[354] IGNORE ALPHA
LINT2:	ERROR	(DAT,7,7,LINT0)	;ILLEGAL CHARACTER IN INPUT
LINT3:	POPJ	P,	;RETURN

LOUT:				;LOGICAL VARIABLE OUTPUT ROUTINE
	SKIPG	T4		;[354] W SPECIFIED?
	MOVEI	T4,^D15		;[354] NO - SET DEFAULT = 15.
	SOJG	T4,LOUT1	;CHECK FOR W<0
	JUMPE	T4,LOUT2	;CKECK FOR W=0
LOUT1:	MOVEI	T0," "		;GET A BLANK FOR OUTPUT
	JSP	P1,OBYTE.	;OUTPUT A FILL BLANK
	SOJG	T4,LOUT1	;CONTINUE FILLING
LOUT2:	MOVEI	T0,"F"		;GET A F FOR FALSE
	SKIPGE	(G1)		;IS VARIABLE FALSE
	MOVEI	T0,"T"		;NO, SET T FOR TRUE
	JSP	P1,OBYTE.	;OUTPUT THE VALUE
LOUT3:	POPJ	P,		;RETURN TO FOROTS
	PRGEND
	TITLE	OCTAL%	%5A(673)	OCTAL INPUT/OUTPUT CONVERSION ROUTINE
	SUBTTL	D. TODD/DRT/HPW/MD/SWG		17-AUG-77




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

;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION

	SEARCH	FORPRM		;GET FOROTS GLOBAL SYMBOL TABLE
;	DEFINE THE LOADING PARAMETERS
	SEGMEN

	ENTRY	OCTAL%
	EXTERN	IBYTE.,OBYTE.,W.PNTR	;[265]
	EXTERN	GFDEL%,SFDEL%,SKIP%,MUN	;[354]

OCTAL%:				;OCTAL INPUT/OUTPUT CONVERSION ROUTINE
	MOVEI	T2,^D12		;12 DIGITS ONLY
;**; [673] INSERT @ OCTAL%+2L	SWG	17-AUG-77
	MOVE	T1,DAT.TP+2(P4)	;[673] GET VARIABLE TYPE
	CAIN	T1,TP%DOR	;[673] IF DOUBLE REAL
	MOVEI	T2,^D24		;[673] THEN ALLOW 24 DIGITS
	LDB	T3,W.PNTR	;[265] GET THE FIELD WIDTH
	JUMPO	OCTO		;GO TO OCTO ON OUTPUT

OCTI:				;OCTAL INPUT ROUTINE
	SETZB	T4,T5		;CLEAR THE OUTPUT WORD
	JSP	P1,GFDEL%	;[354] RETRIEVE DELIMITER
	JUMPG	T3,OCTI1B	;[354] FIELD SPECIFIED
	SETO	T3,		;[354] NO, SET VARIABLE FLAG
	PUSHJ	P,SKIP%		;[354] SKIP SPACES
	  JRST	OCTI5		;[354] NULL FIELD DELIMITED BY COMMA OR EOL
	JRST	OCTI1B		;[354] PROCESS FIELD
OCTI1:	JUMPE	T3,OCTI5	;CKECK FOR END OF FIELD
	JSP	P1,IBYTE.	;GET AN INPUT CHARACTER
OCTI1B:	CAIG	T0,"7"		;CKECK FOR AN OCTAL
	CAIGE	T0,"0"		;DIGIT (0-7)
	JRST	OCTI2		;56;NO, NOT AN OCTAL DIGIT
	TLO	T2,400000	;SET DIGIT SEEN FLAG
OCTI1A:	ANDI	T0,7		;MAKE AN OCTAL DIGIT
;**; [673] DELETE + INSERT @ OCTI1A+1	SWG	17-AUG-77
	LSHC	T4,3		;[673] POSITION OUTPUT WORD
	TDO	T5,T0		;[673] OR IN DIGIT
	SOJA	T3,OCTI1	;RETURN FOR NEXT CHARACTER
OCTI2:	TLNE	P3,IO.EOL	;IS THIS THE END OF LINE
	JRST	OCTI4		;YES, T0=BLANK
	CAIN	T0,11		;<TAB> CHARACTER
	MOVEI	T0," "		;CLEAR THE <TAB>
	CAIE	T0," "		;CHECK FOR A BLANK
	JRST	OCTI2A		;NOT A BLANK OR <TAB>
	JUMPGE	T3,OCTI1A	;YES, TREAT AS A ZERO
	JUMPGE	T2,OCTI1	;DIGIT NOT SEEN IN FREE FORM
OCTI2A:	JUMPL	T2,OCTI3	;HAS A DIGIT BEEN SEEN
	CAIN	T0,"-"		;CHECK FOR A MINUS SIGN
	TLOA	T2,200000	;SET MINUS FLAG
	CAIN	T0,"+"		;CHECK FOR A PLUS SIGH
	SOJA	T3,OCTI1	;[433] YES, COUNT AND GET NEXT CHAR
OCTI3:	CAME	T3,MUN		;[354] FIRST CHAR ILLEGAL
	JUMPL	T3,OCTI5	;NO ERROR ON VARIABLE FIELD INPUT
	ERROR	(DAT,7,7,OCTI1B)	;ILLEGAL CHARACTER IN INPUT
OCTI4:	TLNN	P3,IO.TTY	;IS THIS A TTY
	JUMPGE	T3,OCTI1A	;YES, IGNORE BLANKS
;**; [673] CHANGE,DEL + INSERT @ OCTI5	SWG	17-AUG-77
OCTI5:	TLNN	T2,200000	;[673] CHECK THE SIGN OF THE OUTPUT
	JRST	OCTI6		;[673] POSITIVE
	DMOVN	T4,T4		;[673] NEGATIVE (NEGATE THE RESULT)
	TLO	T5,400000	;[673] DMOVN ZEROES SIGN BIT OF RIGHT
				;[673] WORD - VAL IS NEG SO TURN IT ON ALWAYS
OCTI6:	MOVEM	T5,(G1)		;[673] ASSUME SINGLE PREC - RETURN LOW ORDER WORD
	MOVE	T1,DAT.TP+2(P4)	;[673] GET DATA TYPE
	CAIN	T1,TP%DOR	;[673] IF DOUBLE REAL
	DMOVEM	T4,(G1)		;[673] THEN RETURN BOTH HALVES
	PJMPL	T3,SFDEL%	;[354] SAVE DELIMITER IF NECESSARY
	POPJ	P,		;RETURN TO FOROTS

OCTO:				;OCTAL OUTPUT ROUTINE
	MOVSI	T5,(POINT 3,(G1))	;GET AN OCTAL BYTE POINTER
	JUMPN	T3,OCTO1	;CHECK FOR VARIABLE FIELD OUTPUT
	MOVEI	T3,^D15		;YES SET FILED WIDTH TO O15
;**; [673] INSERT @ OCTO1	SWG	17-AUG-77
	CAIN	T1,TP%DOR	;[673] IF DOUBLE REAL
	MOVEI	T3,^D25		;[673] THEN ITS O25
OCTO1:	SUB	T3,T2		;FIND THE EXCESS FIELD WIDTH
	JUMPLE	T3,OCTO2	;W<= MAX FIELD WIDTH
	MOVEI	T0," "		;SET UP A BLANK FILLER
	JSP	P1,OBYTE.	;OUTPUT THE FILLER
	SOJG	T3,.-2		;CONTINUE UNTIL W=0 (EXCESS)
OCTO2:	ILDB	T0,T5		;GET THE NEXT OCTAL DIGIT
IFN ASTFL,<JUMPGE  T3,.+3	;CHECK FOR SPACING
	JUMPN	T0,[ERROR	(DAT,5,2,OCTO3)];FILL WITH ASTERICKS
	AOJA	T3,OCTO2	;GET THE NEXT OCTAL DIGIT>
IFE ASTFL,<AOJLE  T3,OCTO2	;CONTINUE SPACING>
	ADDI	T0,"0"		;CONVERT TO ASCII
	JSP	P1,OBYTE.	;OUTPUT A DIGIT
	TLNE	T5,770000	;CHECK FOR COMPLETED WORD
	JRST	OCTO2		;NO, CONTINUE
;**; [673] INSERT @ OCTO3	SWG	17-AUG-77
	TRNE	T5,1		;[673] IF ADDR IN BYTE POINTER NOT 0,
	JRST	OCTO3		;[673] HAVE DONE DOUBLE PRECISION OUTPUT
	MOVE	T1,DAT.TP+2(P4)	;[673] ELSE GET DATA TYPE
	CAIN	T1,TP%DOR	;[673] IF DOUBLE REAL
	JRST	OCTO2		;[673] THEN CONTINUE FOR SECOND WORD
OCTO3:	POPJ	P,		;YES, RETURN TO FOROTS
	PRGEND
	TITLE	DELIM%	%4.(372)	ROUTINE TO HANDLE DELIMITER OF FREE FORMAT
	SUBTTL	M. DUHAMEL/MD		07-SEP-74




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

;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION

	SEARCH	FORPRM		;GET FOROTS GLOBAL SYMBOL TABLE
;	DEFINE THE LOADING PARAMETERS
	SEGMEN

	ENTRY	SFDEL%,GFDEL%,SKIP%
	EXTERN	IBYTE.
	INTERNAL	MUN

				;[354] ROUTINE TO SAVE EVENTUAL DELIMITER
				;[354] CALLED BY PUSHJ
SFDEL%:	TLNE	P2,FT.LSD!FT.NML ;[372] [354] NOT FOR LIST-DIRECTED INPUT
	POPJ	P,		;[354]
	PUSHJ	P,SKIP%		;[354] SKIP SPACES
	  POPJ	P,		;[354] COMMA OR EOL - DONT SAVE
	MOVEM	T0,CH.SAV(P4)	;[354] NO - SAVE
	POPJ	P,		;[354] FINI

				;[354] ROUTINE TO GET EVENTUAL DELIMITER
				;[354] CALLED BY JSP
GFDEL%:	SETZ	T0,		;[354]
	SKIPN	CH.SAV(P4)	;[354] SOMETHING SAVED
	PJSP	IBYTE.		;[354] GO GET A CHAR
	EXCH	T0,CH.SAV(P4)	;[354] RETRIEVE DEL, CLEAR IT
	JRST	(P1)		;[354]

				;[354] ROUTINE TO SKIP SPACES
				;[354] NON SKIP RETURN IF CHAR IS COMMA OR EOL
SKIP%:	CAIE	T0," "		;[354] BLANK
	CAIN	T0,"	"	;[354] OR TAB
	JRST	SKIP0		;[354] YES SKIP
	CAIE	T0,","		;[354] COMMA
	AOS	(P)		;[354]
	POPJ	P,		;[354]
SKIP0:	TLNE	P3,IO.EOL	;[354] FINI
	POPJ	P,		;[354] OUI-NON SKIP RETURN
	JSP	P1,IBYTE.	;[354] FIND NEXT
	JRST	SKIP%		;[354] CONTINUE

MUN:	-1			;[354] DEFINED FOR CONVERSION ROUTINES
	PRGEND
	TITLE	POWTB%	%4.(100)	D.P. INTEGER POWER OF TEN TABLE
	SUBTTL	D. TODD /DRT/     08-DEC-1972	TOM EGGERS




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

;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION

	SEARCH	FORPRM		;DEFINE THE GLOBAL SYMBOL TABLE

;	DEFINE THE LOADING PARAMETER
	SEGMEN

ENTRY	HITEN.,	LOTEN.,	EXP10.,	PTLEN.

	;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 (EXCESS 200) FOR THE 70 BIT
	;FRACTION IS STORED IN THE SHORT TABLE CALLED "EXPTEN".
DEFINE .TAB. (A)<
	REPEAT 0,<
	NUMBER 732,357347511265,056017357445	;D-50
	NUMBER 736,225520615661,074611525567
	NUMBER 741,273044761235,213754053125
	NUMBER 744,351656155504,356747065752
	NUMBER 750,222114704413,025260341562
	NUMBER 753,266540065515,332534432117
	NUMBER 756,344270103041,121263540543
	NUMBER 762,216563051724,322660234335
	NUMBER 765,262317664312,007434303425
	NUMBER 770,337003641374,211343364332
	NUMBER 774,213302304735,325716130610	;D-40
	NUMBER 777,256162766125,113301556752
	NUMBER 002,331617563552,236162112545	;D-38
	NUMBER 006,210071650242,242707256537
	NUMBER 011,252110222313,113471132267
	NUMBER 014,324532266776,036407360745
	NUMBER 020,204730362276,323044526457
	NUMBER 023,246116456756,207655654173
	NUMBER 026,317542172552,051631227231
	NUMBER 032,201635314542,132077636440
	NUMBER 035,242204577672,360517606150	;D-30
	NUMBER 040,312645737651,254643547602
	NUMBER 043,375417327624,030014501542
	NUMBER 047,236351506674,217007711035
	NUMBER 052,306044030453,262611673245
	NUMBER 055,367455036566,237354252116
	NUMBER 061,232574123152,043523552261
	NUMBER 064,301333150004,254450504735
	NUMBER 067,361622002005,327562626124
	NUMBER 073,227073201203,246647575664
	>
	NUMBER 076,274712041444,220421535242	;D-20
	NUMBER 101,354074451755,264526064512
	NUMBER 105,223445672164,220725640716
	NUMBER 110,270357250621,265113211102
	NUMBER 113,346453122766,042336053323
	NUMBER 117,220072763671,325412633103
	NUMBER 122,264111560650,112715401724
	NUMBER 125,341134115022,135500702312
	NUMBER 131,214571460113,172410431376
	NUMBER 134,257727774136,131112537675
	NUMBER 137,333715773165,357335267655	;D-10
	NUMBER 143,211340575011,265512262714
	NUMBER 146,253630734214,043034737477
	NUMBER 151,326577123257,053644127417
	NUMBER 155,206157364055,173306466551
	NUMBER 160,247613261070,332170204303
	NUMBER 163,321556135307,020626245364
	NUMBER 167,203044672274,152375747331
	NUMBER 172,243656050753,205075341217
	NUMBER 175,314631463146,146314631463	;D-01
A:	NUMBER 201,200000000000,0	;D00
	NUMBER 204,240000000000,0
	NUMBER 207,310000000000,0
	NUMBER 212,372000000000,0
	NUMBER 216,234200000000,0
	NUMBER 221,303240000000,0
	NUMBER 224,364110000000,0
	NUMBER 230,230455000000,0
	NUMBER 233,276570200000,0
	NUMBER 236,356326240000,0
	NUMBER 242,225005744000,0	;D+10
	NUMBER 245,272207335000,0
	NUMBER 250,350651224200,0
	NUMBER 254,221411634520,0
	NUMBER 257,265714203644,0
	NUMBER 262,343277244615,0
	NUMBER 266,216067446770,040000000000
	NUMBER 271,261505360566,050000000000
	NUMBER 274,336026654723,262000000000
	NUMBER 300,212616214044,117200000000
	NUMBER 303,255361657055,143040000000	;D+20
	REPEAT 0,<
	NUMBER 306,330656232670,273650000000
	NUMBER 312,207414740623,165311000000
	NUMBER 315,251320130770,122573200000
	NUMBER 320,323604157166,147332040000
	NUMBER 324,204262505412,000510224000
	NUMBER 327,245337226714,200632271000
	NUMBER 332,316627074477,241000747200
	NUMBER 336,201176345707,304500460420
	NUMBER 341,241436037271,265620574524
	NUMBER 344,311745447150,043164733651	;D+30
	NUMBER 347,374336761002,054022122623
	NUMBER 353,235613266501,133413263573
	NUMBER 356,305156144221,262316140531
	NUMBER 361,366411575266,037001570657
	NUMBER 365,232046056261,323301053415
	NUMBER 370,300457471736,110161266320
	NUMBER 373,360573410325,332215544004
	NUMBER 377,226355145205,250330436402	;D+38
	NUMBER 402,274050376447,022416546102
	NUMBER 405,353062476160,327122277522	;D+40
	NUMBER 411,222737506706,206363367623
	NUMBER 414,267527430470,050060265567
	NUMBER 417,345455336606,062074343124
	NUMBER 423,217374313163,337245615764
	NUMBER 426,263273376020,327117161361
	NUMBER 431,340152275425,014743015655
	NUMBER 435,214102366355,050055710514
	NUMBER 440,257123064050,162071272637
	NUMBER 443,332747701062,216507551406
	NUMBER 447,210660730537,231114641743	;D+50
	NUMBER 452,253035116667,177340012333
	>
>
DEFINE NUMBER (A,B,C)<	B>

TENTAB:	.TAB. HITEN.

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

	.TAB. LOTEN.
PTLEN.==HITEN.-TENTAB	;CALCULATE NUMBER OF TABLE ENTRIES BEFORE "TENS"
XX=PTLEN.
XX=XX-XX/4*4		;CALC XX=XX MOD 4

BINR1=<BINR2=<BINR3=0>>	;INIT THE BINARY

DEFINE NUMBER (A,B,C)<
IFE XX-1,<	BYTE (9) BINR1,BINR2,BINR3,<A>
	BINR1=<BINR2=<BINR3=0>> >
IFE XX-2,<BINR3=A>
IFE XX-3,<BINR2=A>
IFE XX,<BINR1=A
	XX=4>
XX=XX-1>

REPEAT 0,<		;BYTE POINTER TABLE IS IN FLIRT.
	POINT 9,EXP10.-1(D),17
	POINT 9,EXP10.-1(D),26
	POINT 9,EXP10.-1(D),35
EXTAB.:	POINT 9,EXP10.(D),8
	POINT 9,EXP10.(D),17
	POINT 9,EXP10.(D),26
	POINT 9,EXP10.(D),35
>	;END OF REPEAT 0

	.TAB. EXP10.
	IFN BINR1!BINR2!BINR3,<	BYTE (9) BINR1,BINR2,BINR3,0>

	PRGEND
	TITLE	LSTDR%	%5.(575)	LIST-DIRECTED I/O MODULE
	SUBTTL	D. TODD/DRT/HPW/MD/CLRH		24-AUG-76




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

;COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
	ENTRY	LSTDR%
	SEARCH	FORPRM
	RPT.SV==SCL.SV		;[325] TO SAVE REPEAT COUNT
	SEGMEN
LSTDR%:
	SETZ	G4,		;SET FREE FORM CONVERSION MODE
	MOVSI	P2,FT.LSD!FT.NUL;[325] SET THE NO FILL FLAG FOR LIST DR.
				;[325] AND COMMA SEEN FLAG FOR FIRST ITEM
	SETZM	RPT.SV(P4)	;[325] CLEAR REPEAT COUNT
	JUMPI	LSTDR1		;SKIP THE COLUMN COUNTS
	PUSHJ	P,NLOEN.##	;SET UP THE COLUMN COUNTS
LSTDR1:			;LIST DIRECTED DISPATCH ROUTINE INTO NMLST%
	JSP	P1,IOLS%%##	;GET THE I/O LIST VARIABLE
	TLNE	P2,FT.SLH	;[366] SLASH SEEN
	JRST	LSTDR1		;[366] YES-FINISH LIST
;**;  [575] CHANGE  @ LSTDR1 + 3	CLRH	24-AUG-76
	TLZ	P2,FT.ELT!FT.SLT;[575] [256] KILL THE EXTENDED LIST FLAGS
	HLRZ	T1,NMLTBL##(T5)	;GET THE NAME/LIST OUTPUT  DISPATCH
	JUMPO	LSTDR2		;JUMP ON OUTPUT
	HRRZ	T1,NMLTBL##(T5)	;GET THE NAME/LIST INPUT DISPATCH
	TLZE	P2,FT.QOT	;QUOTED STRING IN PROCESS
	MOVEI	T1,NLIS0##	;REENTER THE QUOTED STRING ROUTINE
;**; [533] INSERT @ LSTDR2 - 1/2	CLRH	14-APR-76
	CAIN	T5,TP%DOR	; [533] GET VARIABLE TYPE
	TLOA	P2,FT.PRC	; [533] SET DOUBLE PRECISION
	TLZ	P2,FT.PRC	; [533] OR SINGLE PRECISION
LSTDR2:	PUSHJ	P,(T1)		;OUTPUT THE VARIABLE
	JRST	LSTDR1		;GET THE NEXT I/O LIST VARIABLE
	PRGEND
	TITLE	NMLST%	%5A(654)	NAMELIST I/O
	SUBTTL	D. TODD /DRT/HPW/MD/JNG/CLRH/SWG	26-APR-77




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

;COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION

;THE NAMELIST PROGRAM CONSISTS OF TWO MAJOR ROUTINES - NLIN.
;FOR NAMELIST INPUT, AND NLOUT. FOR NAMELIST OUTPUT. THE CALLING
;SEQUENCE FOR THE NAMELIST PROGRAM IS
;	MOVEI	G1, POINTER TO NAMELIST TABLE
;	PUSHJ	P, NMLST.
;IF ACCUMULATOR P3 HAS A ONE IN THE SIGN BIT, THE NAMELIST
;OUTPUT ROUTINE IS CALLED. OTHERWISE, THE NAMELIST INPUT 
;ROUTINE IS CALLED. THIS ACCUMULATOR IS USUALLY SET UP BY
;FOROTS.  BEFORE NAMELIST IS CALLED.
;THE NAMELIST TABLE IS CONSTRUCTED BY THE COMPILER.
	SEARCH	FORPRM		;GET THE FOROTS GLOBAL SYMBOL TABLE
;	DEFINE THE LOADING PARAMETERS
	SEGMEN

ENTRY	NMLST%

EXTERN	REAL%,INTEG%,OBYTE.,IBYTE.,NXTLN.,IPEEK.

	RPT.SV==SCL.SV		;[325] TO SAVE REPEAT COUNT DURING
				;[325] LIST DIRECTED I/O
SUBTTL    NAME LIST SEQUENTIAL ACCESS CALLING SEQUENCES
REPEAT 0,<

     READ (u,name)
     READ (u,name,END=c,ERR=d)

     MOVEI 16,ARGBLK   0       89 12 14 1718             35
     PUSHJ 17,NLI.     ------------------------------------
                       !   3   !   !I! X ! u -unit#       !
                       ------------------------------------
                       !   ERR=d         !   END=c        !
                       ------------------------------------
                       !       ! t !I! X ! name list addr !
                       ------------------------------------

     WRITE (u,name)
     WRITE (u,name,END=c,ERR=d)

     MOVEI 16,ARGBLK   0       89 12 14 1718             35
     PUSHJ 17,NLO.     ------------------------------------
                       !   3   !   !I! X ! u -unit#       !
                       ------------------------------------
                       !   ERR=d         !   END=c        !
                       ------------------------------------
                       !       ! t !I! X ! name list addr !
                       ------------------------------------



     The NAMELIST table illustrated below is generated  form
     the  FORTRAN NAMELIST STATEMENT.  The first word of the
     table is the NAMELIST name in sixbit format.  Following
     that  are  a  number  of  two-word  entries  for scalar
     variables, and a number of (N+3)-word entries for array
     variables,  where N is the dimensionality of the array.
     The NAMELIST argument block has the following format.


     NAMELIST ADDR/    0       89 12 14 1718             35
                       ------------------------------------
                       ! SIXBIT /NAMELIST NAME/           !
                       ------------------------------------
                       !   NAME LIST ENTRIES              !
                       ------------------------------------
                       !                 0                !
                       ------------------------------------

     SCALAR ENTRIES

                       0       89 12 14 1718             35
                       ------------------------------------
                       ! SIXBIT /SCALAR NAME/             !
                       ------------------------------------
                       !   0   ! T !I! X ! SCALAR ADDR    !
                       ------------------------------------

     ARRAY ENTRIES

                       0       89 12 14 1718             35
                       ------------------------------------
                       ! SIXBIT /ARRAY NAME/              !
                       ------------------------------------
                       !# DIM'S! T !I! X ! BASE ADDR      !
                       ------------------------------------
                       !       SIZE      ! OFFSET         !
                       ------------------------------------
                       !       !   !I! X ! FACTOR 1       !
                       ------------------------------------
                       !       !   !I! X ! FACTOR 2       !
                       ------------------------------------
                       !       !   !I! X ! FACTOR 3       !
                       ------------------------------------
                       !       !   !I! X ! FACTOR N       !
                       ------------------------------------
>
;NAMELIST OUTPUT SECTION
;THE MAJOR FLOW OF EVENTS IN THE NAMELIST OUTPUT SECTION IS
;AS FOLLOWS: THE ROUTINE IS GIVEN A POINTER TO A NAMELIST TABLE
;(IN ACCUMULATOR P2), AND IT PROCEEDS TO OUTPUT THE VALUE OF
;EACH ARRAY IN THE TABLE, OR OF EACH ELEMENT OF EACH ARRAY IN
;THE TABLE. SINCE THERE IS INFORMATION IN THE TABLE INDICATING
;THE TYPE OF EACH VARIABLE, AND WHETHER THAT VARIABLE IS AN
;ARRAY OR A SCALAR, NLOUT. CAN DO THE FOLLOWING:
;	1. GET THE NEXT VARIABLE NAME FROM THE TABLE. PRINT
;	   IT ON THE OUTPUT DEVICE, FOLLOWED BY AN EQUAL SIGN.
;	2. IF THE VARIABLE IS A SCALAR, SIMPLY PLACE THE CORE
;	   ADDRESS WHERE THE VALUE OF THAT VARIABLE MAY BE FOUND
;	   IN ACCUMULATOR G1, AND PROCEED TO 4.
;	3. IF THE VARIABLE IS AN ARRAY, PREPARE AN AOBJN WORD
;	   IN ACCUMULATOR G1, WITH THE LEFT HALF HAVING A NEGATIVE
;	   COUNT OF THE NUMBER OF ELEMENTS IN THE ARRAY, AND THE
;	   RIGHT HALF CONTAINING THE CORE ADDRESS OF THE BASE OF
;	   OF THE ARRAY.
;	4. PICK UP THE TYPE OF THE ARGUMENT, AND DISPATCH TO THE
;	   PROPER OUTPUT ROUTINE AS A FUNCTION OF THE SCALAR/ARRAY
;	   AND TYPE NATURE OF THE ARGUMENT.
;A COLUMN COUNTER IS KEPT AT ALL TIMES SO THAT NLOUT. MAY KNOW
;WHICH COLUMN OF THE OUTPUT DEVICE WILL RECEIVE THE NEXT CHARACTER.
;BEFORE CALLING ONE OF THE OUTPUT ROUTINES, IT CHECKS TO MAKE SURE
;THERE IS ENOUGH ROOM ON THE LINE. IF NOT, THE ROUTINE CRLF IS
;CALLED TO OUTPUT A CARRIAGE RETURN, LINE FEED AND RESET THE
;COLUMN COUNTER.

FINCOD:	004000,,0		;[374] CODE CALL TO FIN.

NMLST%:
	MOVSI	P2,FT.NML	;[400] NAMELIST IN PROGRESS
	HRRI	P2,(G1)		;[372] PUT THE NAME LIST POINTER IN A P AC
	SETZ	G4,		;SET FREE FORM I/O
	JUMPI	NLIN.		;IF SIGN BIT=1, ITS OUTPUT

NLOUT.:
	MOVEI	T0," "		;OUTPUT A SPACE IN COLUMN 1
	JSP	P1,OBYTE.	;SEND THE CHARACTER OFF TO FOROTS.
	MOVEI	T0,"$"		;OUTPUT A DOLLAR SIGN IN COL. 2
	JSP	P1,OBYTE.	;...
	MOVE	T1,(P2)		;GET THE NAMELIST NAME
	PUSHJ	P,NLOSIX	;TYPE IT OUT
	PUSHJ	P, NLOLIN	;TYPE CR,LF, SET UP COLUMN COUNT
NLOVAR:	ADDI	P2,1		;MOVE POINTER TO NEXT VARIABLE
	SKIPE	T1,(P2)		;[374] ARE WE AT THE END OF THE TABLE?
	CAMN	T1,FINCOD	;[374] BY IMPLICIT CALL TO FIN.?
	JRST	NLOFIN		;YES, FINISH THE OUTPUT AND EXIT
				;NO, PICK UP THE VARIABLE NAME
	PUSHJ	P,NLONAM	;TYPE THE NAME, AND AN EQUAL SIGN
	HRRZ	G1,1(P2)	;GET THE ADDRESS OF THE VARIABLE
	LDB	G2,[POINT 9,1(P2),8] ;GET THE NUMBER OF DIMENSION IF ARRAY
	LDB	T5,[POINT 4,1(P2),12] ;GET THE TYPE CODE
	JUMPE	G2,NLOVA1	;JUMP IF SCALAR
	HLRZ	T1,2(P2)	;GET THE ARRAY SIZE
	MOVNS	T1		;NEGATE THE ARRAY SIZE
	CAIE	T5,TP%DOR	;DOUBLE PRECISION OR
	CAIN	T5,TP%COM	;COMPLEX VARABLE
	ASH	T1,1		;YES, DOUBLE THE RAY SIZE
	HRLI	G1,(T1)		;SET UP IOWD SIZE,,BASE
	ADDI	P2,1(G2)	;STEP PAST THE FACTORS,SIZE, OFFSET
NLOVA1:
;**; [654] INSERT AT NLOVA1	SWG	26-APR-77
	MOVEM	T5,DAT.TP+2(P4)		;[654] REMEMBER DATA TYPE
	HLRZ	T1,NMLTBL(T5)	;GET THE  OUTPUT DISPATCH ADDRESS
	PUSHJ	P,(T1)		;DO IT
	AOJA	P2,NLOVAR	;GET THE NEXT ENTRY

;DISPATCH TABLE FOR INPUT/OUTPUT ACCORDING TO VARIABLE TYPE
NMLTBL::	;OUTPUT	INPUT	TYPE
	XWD	NLOI,	NLII	;0;	INTEGER(DEFAULT)
	XWD	NLOL,	NLIL	;1;	LOGICAL
	XWD	NLOI,	NLII	;2;	INTEGER
	XWD	NLOER1,	NLIER1	;3;	INDEX(ILLEGAL)
	XWD	NLOF,	NLIF	;4;	FLOATING POINT
	XWD	NLOER1,	NLIER1	;5;	ILLEGAL
	XWD	NLOER1,	NLIER1	;6;	OCTAL(ILLEGAL)
	XWD	NLOER1,	NLIER1	;7;	ILLEGAL
	XWD	NLOD,	NLID	;10;	DOUBLE REAL
	XWD	NLOER1,	NLIER1	;11;	ILLEGAL
	XWD	NLOER1,	NLIER1	;12;	ILLEGAL
	XWD	NLOER1,	NLIER1	;13;	ILLEGAL
	XWD	NLOC,	NLIC	;14;	COMPLEX
	XWD	NLOER1,	NLIER1	;15;	ILLEGAL
	XWD	NLOER1,	NLIER1	;16;	ILLEGAL
	XWD	NLOER1,	NLIER1	;17;	ILLEGAL
;INTEGER OUTPUT ROUTINE
NLOI:	PUSHJ	P,NLORP1	;CHECK FOR A REPEATED VARIABLE
	PUSHJ	P,INTEG%	;VARIABLE FIELD INTEGER OUTPUT
	PUSHJ	P,NLOCMA	;TYPE A COMMA
;**; [575] INSERT @ NLOI + 3 1/2	CLRH	20-AUG-76
	TLNE	P2,FT.LSD	;[575] LIST-DIRECTED ?
	JRST	[ADD	G1,DAT.TP+1(P4)	;[575]  YES, ADD INCREMENT
		TLNE	G1,400000	;[575] STILL NEGATIVE ?
		JRST	NLOI		;[575] YES, LOOP
		POPJ	P,	]	;[575] NO, RETURN
	AOBJN	G1,NLOI		;CONTINUE
	POPJ	P,		;RETURN

;REAL OUTPUT ROUTINE
NLOF:	PUSHJ	P,NLORP1	;CHECK FOR A REPEATED VARIABLE
	TLO	P2,FT.GTP	 ;SET UP FOR "G" TYPE OUTPUT
	PUSHJ	P,REAL%		;VARIABLE FIELD REAL OUTPUT
	TLZ	P2,FT.GTP	;CLEAR "G" FLAG
	PUSHJ	P,NLOCMA	;TYPE A COMMA
;**; [575] INSERT @ NLOF + 5 1/2	CLRH	20-AUG-76
	TLNE	P2,FT.LSD	;[575] LIST-DIRECTED ?
	JRST	[ADD	G1,DAT.TP+1(P4)	;[575] YES, ADD INCREMENT
		TLNE	G1,400000	;[575] STILL NEGATIVE ?
		JRST	NLOF		;[575] YES, LOOP
		POPJ	P,	]	;[575] NO, RETURN
	AOBJN	G1,NLOF		;CONTINUE
	POPJ	P,		;RETURN

;LOGICAL OUTPUT ROUTINE
NLOL:	PUSHJ	P,NLORP1	;CHECK FOR A REPEATED VARIABLE
	MOVEI	T0, "T"		;ASSUME THAT WE HAVE A "TRUE"
	SKIPL	(G1)		;IS IT REALLY A "TRUE"
	MOVEI	T0, "F"		;NO, ITS AN "F"
	JSP	P1,OBYTE.	;PRINT THE CHARACTER
	PUSHJ	P,NLOCMA	;TYPE A COMMA
;**; [575] INSERT @ NLOL + 6 1/2	CLRH	20-AUG-76
	TLNE	P2,FT.LSD	;[575] LIST-DIRECTED ?
	JRST	[ADD	G1,DAT.TP+1(P4)	;[575] YES, INCREMENT
		TLNE	G1,400000	;[575] STILL NEGATIVE ?
		JRST	NLOL		;[575] YES, LOOP
		POPJ	P,	]	;[575] NO, RETURN
	AOBJN	G1,NLOL		;CONTINUE
	POPJ	P,

;DOUBLE PRECISION OUTPUT ROUTINE
NLOD:	PUSHJ	P,NLORP2	;CHECK FOR A REPEATED VARIABLE
	TLO	P2,FT.PRC	;SET DOUBLE PRECISION FLAG
	PUSHJ	P,REAL%		;DO CONVERSION
	TLZ	P2,FT.PRC	;CLEAR THE DOUBLE PRECISION FLAG
	PUSHJ	P,NLOCMA	;TYPE A COMMA
;**; [575] INSERT @ NLOD + 4 1/2
	TLNE	P2,FT.LSD	;[575] LIST-DIRECTED ?
	JRST	[ADD	G1,DAT.TP+1(P4)	;[575] YES, INCREMENT
		TLNE	G1,400000	;[575] STILL NEGATIVE ?
		JRST	NLOD		;[575] YES, LOOP
		POPJ	P,	]	;[575] NO, RETURN
	ADD	G1,[XWD 1,1]	;STEP PAST THE LOW ORDER PART
	AOBJN	G1,NLOD		;CONTINUE
	POPJ	P,		;RETURN
;COMPLEX OUTPUT ROUTINE
NLOC:	PUSHJ	P,NLORP2	;CHECK FOR A REPEATED VARIABLE
	MOVEI	T0,"("		;OUTPUT A LEFT PARENTHESIS
	JSP	P1,OBYTE.	;...
	PUSHJ	P,REAL%		;OUTPUT REAL PART OF COMPLEX NUMBER
	MOVEI	T0,","		;SEPERATE WITH A COMMA
	JSP	P1,OBYTE.	;OUTPUT
	ADD	G1,[XWD 1,1]	;MOVE POINTER TO THE COMPLEX PART
	PUSHJ	P,REAL%		;OUTPUT IT
	MOVEI	T0,")"		;OUT PUT A RIGHT PARENTHESIS
	JSP	P1,OBYTE.	;PRINT THE CHARACTER
	PUSHJ	P,NLOCMA	;TYPE A COMMA
;**; [575] INSERT @ NLOC + 13 1/2	CLRH	20-AUG-76
	TLNE	P2,FT.LSD	;[575] LIST-DIRECTED ?
	JRST	[SUB	G1,[XWD 1,1]	;[575] YES, BACK UP
		ADD	G1,DAT.TP+1(P4)	;[575] ADD INCREMENT
		TLNE	G1,400000	;[575] STILL NEGATIVE ?
		JRST	NLOC		;[575] YES, LOOP
		POPJ	P,	]	;[575] NO, RETURN
	AOBJN	G1,NLOC		;CONTINUE
	POPJ	P,		;EXIT

;ROUTINE TO COUNT THE NUMBER OF REPEATED SINGLE PRECISION
;QUANTITIES IN AN ARRAY (I.E. INTEGER,REAL,LOGICAL,LITERAL,OCTAL)
;AND OUTPUT THE COUNT (IF > 1) AS AN ITEGER FOLLOWED BY A *
NLORP1:	TDZA	T2,T2		;CLEAR THE REPEAT COUNT
	ADDI	T2,1		;INCREMENT COUNT
;**; [575] INSERT @ NLORP1 + 1 1/2	CLRH	20-AUG-76
	TLNE	P2,FT.LSD	;[575] LIST-DIRECTED ?
	JRST	[MOVE	T1,G1		;[575] YES, GET CURRENT ADDRESS
		ADD	T1,DAT.TP+1(P4)	;[575] ADD INCREMENT
		MOVE	T0,0(T1)	;[575] PICK UP VALUE
		JRST	NLRP1A	]	;[575] GO CHECK
	MOVE	T0, 1(G1)	;GET NEXT QUANTITY FROM ARRAY
;**; [575] CHANGE @ NLORP1 + 3	CLRH	20-AUG-76
NLRP1A:	CAME	T0, (G1)		;[575] DOES IT MATCH?
;**; [575] INSERT @ NLORP1 + 3 1/2	CLRH	20-AUG-76
	JRST	NLRP1B		;[575] NO
	TLNE	P2,FT.LSD	;[575] LIST-DIRECTED ?
	JRST	[ADD	G1,DAT.TP+1(P4)	;[575] YES, INCREMENT
		TLNE	G1,400000	;[575] STILL NEGATIVE ?
		JRST	NLORP1+1	;[575] YES, LOOP
		JRST	NLRP1B	]	;[575] NO, CONTINUE
	AOBJN	G1, NLORP1+1	;OR ARE WE THROUGH THE ARRAY?
;**; [575] CHANGE @ NLORP1 + 5	CLRH	20-AUG-76
NLRP1B:	JUMPE	T2, CPOPJ	;[575] IF COUNT WAS ZERO, IGNORE IT
	ADDI	T2,1		;MAKE THE REPEAT COUNT RIGHT
NLODEC:	PUSHJ	P,NLODE1	;PRINT REPETITION COUNT
	MOVEI	T0,"*"		;PICK UP *
	JRST	NLOASC		;OUTPUT IT
NLODE1:	IDIVI	T2, 12		;DECIMAL NUMBER OUTPUTTER
	HRLM	T3, (P)		;STORE REMAINDER ON PDLIST
	JUMPE	T2,.+2		;ALL DONE?
	PUSHJ	P, NLODE1	;NO, CALL NUMOUT RECURSIVELY
	HLRZ	T0, (P)		;YES, GET  NUMBER OFF STACK
	ADDI	T0,"0"		;MAKE IT ASCII
	PJRST	 NLOASC		;UPDATE COLUMN COUNT,TYPE,EXIT

;ROUTINE TO COUNT THE NUMBER OF REPEATED DOUBLE PRECISION 
;QUANTITIES IN AN ARRAY (DOUBLE PRECISION OR COMPLEX) AND OUTPUT
;THEM AS ABOVE
NLORP2:	MOVEI	T2, 0		;INITIALIZE REPETITION COUNT
	JRST	NLORP3		;SKIP THE INCREMENTATION
NLORP4:	ADDI	T2,1		;INCREMENT THE REPETITION COUNT
;**; [575] INSERT @ NLORP3	CLRH	20-AUG-76
NLORP3:	TLNE	P2,FT.LSD	;[575] LIST-DIRECTED ?
	JRST	[MOVE	T1,G1		;[575] YES, GET CURRENT ADDRESS
		ADD	T1,DAT.TP+1(P4)	;[575] ADD INCREMENT
		DMOVE	T0,0(T1)	;[575] FIRST PART OF NEXT ELEMENT
		JRST	NLRP3A	]	;[575] AND CONTINUE
	DMOVE	T0,2(G1)	;[575] PICK UP NEXT DOUBLE QUANITYT
;**; [575] CHANGE @ NLORP3 + 1	CLRH	20-AUG-76
NLRP3A:	CAMN	T0, (G1)	;[575] DO THE FIRST WORDS MATCH?
	CAME	T1, 1(G1)	;YES, DO THE SECOND WORDS MATCH?
	JRST	NLORP5		;NO
;**; [575] INSERT @ NLORP3 + 3 1/2	CLRH	20-AUG-76
	TLNE	P2,FT.LSD	;[575] LIST-DIRECTED ?
	JRST	[ADD	G1,DAT.TP+1(P4)	;[575] YES, ADD INCREMENT
		TLNE	G1,400000	;[575] STILL NEGATIVE ?
		JRST	NLORP4		;[575] YES, LOOP
		JRST	NLORP5	]	;[575] NO, QUIT
	ADD	G1,[XWD 1,1]	;INCREMENT THE ARRAY POINTER
	AOBJN	G1, NLORP4	;TRY SOME MORE UNLESS THRU ARRAY
NLORP5:	JUMPE	T2, CPOPJ	;IGNORE IF REPETITION COUNT IS 0
	AOJA	T2,NLODEC	;TYPE IT OUT AND EXIT
NLOFIN:	MOVEI	T0,"$"		;GET A DOLLAR SIGN TO TERMINATE
	JSP	P1,OBYTE.	;OUTPUT IT
	POPJ	P,		;[252] RETURN

NLONAM:	PUSHJ	P, NLOEN.	;NO, OUTPUT A CR
	MOVE	T1,(P2)		;GET THE VARIABLE NAME
	PUSHJ	P,NLOSIX	;OUTPUT THE NAME
	MOVEI	T0,"="		;GET AN EQUAL SIGN
	PJRST	NLOASC		;OUTPUT IT AND EXIT

;ROUTINE TO OUTPUT A SIXBIT NAME FROM T1
NLOSIX:	SETZ	T0,	;CLEAT THE OUTPUT WORD
	LSHC	T0,6		;GET A SIXBIT CHARACTER
	ADDI	T0," "		;CONVERT TO ASCII
	JSP	P1,OBYTE.	;OUTPUT IT
	JUMPN	T1,NLOSIX	;CHECK IF DONE
	POPJ	P,		;RETURN

;ROUTINE TO PRINT A COMMA
NLOCMA:	MOVEI	T0,","		;GET A COMMA
	JSP	P1,OBYTE.	;OUTPUT IT
NLOEN.::MOVM	T1,POS.TB(P4)	;GET THE COLUMN POSITION
	CAILE	T1,^D72-^D16	;CHECK FOR A TTY PAGE
	TLNN	P3,IO.TTY	;AND A TTY
	CAILE	T1,^D132-^D16	;NO, ALL OTHERS 132 COLUMNS
NLOLIN:	PUSHJ	P,NXTLN.	;START A NEW LINE
	MOVEI	T0," "		;START WITH A SPACE
NLOASC:	JSP	P1,OBYTE.	;OUTPUT IT
CPOPJ:	POPJ	P,		;RETURN
;NAMELIST INPUT SECTION
;THE MAJOR FLOW OF EVENTS IN THE INPUT SECTION IS AS FOLLOWS:
;	1.GET THE NAMELIST NAME FROM THE INPUT DEVICE. THE NAME
;	  BEGINS IN COLUMN 3 OF A RECORD, AND IS PRECEDED BY A
;	  DOLLAR SIGN OR AN AMPERSAND.
;	2.COLLECT A VARIABLE NAME IN SIXBIT  FORMAT FROM THE
;	  INPUT DEVICE. FIND THE SAME VARIABLE NAME IN THE 
;	  NAMELIST TABLE, AND DISPATCH TO AN INPUT ROUTINE
;	  DEPENDING ON THE TYPE OF THE VARIABLE. A SEPARATE
;	  DISPATCH IS ALSO MADE FOR ARRAY VARIABLES AS OPPOSED TO
;	  SCALAR VARIABLES.
;	3.ONCE IN THE INPUT ROUTINE, INPUT THE VALUE WITH THE
;	  PROPER FORTRAN INPUT ROUTINE, AND STORE IT IN THE CORE
;	  ADDRESS INDICATED IN THE NAMELIST TABLE. IF AN ARRAY,
;	  CONTINUE THE INPUT OF MORE ELEMENTS OF THIS ARRAY.


;THERE ARE TWO SPECIAL INTERFACES WITH THE FORTRAN OPERATING
;SYSTEM WHICH SHOULD BE NOTED:
;	1. ON THE RETURN FROM ANY OF THE INPUT ROUTINES -
;	   THE DELIMITING CHARACTER WILL BE FOUND IN "DD.HRI+1(P3)"
;	THIS FEATURE IS NECESSARY FOR NAMELIST
;	 TO BE ABLE TO HANDLE THE STRING LIKE
;		A=6*1.0,2.0,3.0
;	   WHERE A IS AN ARRAY CONSISTING OF 8 ELEMENTS. THE 6
;	   IS A REPETITION COUNT, AND IS RECOGNIZED BY THE PRESCENE
;	   OF THE * . 
;	2. WHEN INPUT IS DONE THROUGH THE IBYTE. ROUTINE, THE
;	   BUFFER POINTER WILL BE ADVANCED UNLESS THE INPUT
;	   CHARACTER IS A CARRIAGE RETURN. IN THAT CASE, THE
;	   BUFFER POINTER IS ADVANCED TO THE BEGINNING OF THE NEXT
;	   LINE, AND THE FLAG IO.EOL. IS SET IN P3. IN ORDER
;	   TO DO FURTHER INPUT, NMLST. MUST ZERO THE FLAG. ALSO,
;	   WHEN DOING INPUT WITH THE VARIOUS FORTRAN INPUT
;	   CONVERSION ROUTINES - FLIRT.,, ETC. -AN ILLEGAL
;	   TERMINATING CHARACTER WILL BE "GOBBLED UP". THUS, IF
;	   PART OF THE INPUT STRING IS ...1.0,2.0..... ONE CALL
;	   TO FLIRT. WILL INPUT THE 1.0, STOPPING ON AND ADVANCING
;	   PAST THE COMMA. THE SECOND CALL TO FLIRT. WILL BEGIN
;	   ITS INPUT WITH THE "2" OF 2.0


NLIN.:
	JSP	P1,IBYTE.	;GET FIRST CHARACTER OF RECORD
	JSP	P1,IBYTE.	;GET THE SECOND CHARACTER
	SETZM	SCL.SV(P4)	;[430] CLEAR SCALING FACTOR
	CAIE	T0,"$"		;IS IT A DOLLAR SIGN?
	CAIN	T0,"&"		;OR IS IT AN AMPERSAND?
	JRST	NLIN2		;YES, CHECK THE NAMELIST NAME
NLIN1:	TLNE	P3,IO.EOF	;END OF FILE PENDING
	POPJ	P,		;YES, RETURN NOT INPUT DATA
	PUSHJ	P, NXTLN.	;CALL FOROTS. FOR THE NEXT RECORD
	JRST	NLIN.		;TRY AGAIN

NLIN2:	PUSHJ	P,NLINAM	;GET THE NAMELIST NAME
	CAME	T1, (P2)	;DOES IT MATCH THE ONE IN OUR TABLE?
	JRST	NLIN.		;NO, MOVE ON TO NEXT RECORD
	TRNE	T1,77		;[426] HAVE WE A 6 CHARS NAME?
	JSP	P1,IBYTE.	;[426] YES - READ THE DELIMITER

NLIVAR:
	PUSHJ	P,NLINM		;GET A SIXBIT VARIABLE NAME
NLIVA0:	MOVEI	G4,1(P2)	;SPECIAL ENTRY, INITIALIZE SEARCH
NLIVA1:	SKIPN	(G4)		;END OF NAMELIST TABLE?
	JRST	NLIER2		;YES, SYNTAX ERROR
	ADDI	G4,2		;POINT TOT THE NEXT SYMBOL/OR DIMS
	LDB	G2,[POINT 9,-1(G4),8];GET THE NUMBER OF DIMS
	CAMN	T1,-2(G4)	;IS THIS THE VARIABLE
	JRST	NLIVA2	;FOUND THE VARIABLE
	JUMPE	G2,NLIVA1	;JUMP IF A SCALAR (FOR NEXT VAR.)
	ADDI	G4,1(G2)	;ARRAY, SKIP THE FACTORS ETC
	JRST	NLIVA1		;GET THE NEXT VARIABLE

NLIVA2:				;FOUND A VARIABLE THAT MATCHES
	SETZB	G1,G3		;INITIALIZE THE SUBSCRIPT AC'S
	JUMPE	G2,NLIAR4	;JUMP IF A SCALAR
NLIVA3:	CAIN	T0,"("		;STOP ON LEFT PAREN
	JRST	NLIAR1		;YES, PARTICAL ARRAY
	CAIN	T0,"="		;CHECK FOR ENTIRE ARRAY
	JRST	NLIAR3		;YES, EN+w
	TLNE	P3,IO.EOL	;CHECK FOR END OF LINE
	PUSHJ	P,NXTLN.	;GET THE NEXT RECORD
	JSP	P1,IBYTE.	;READ A CHARACTER
	JRST	NLIVA3		;CONTINUE

NLIAR1:	MOVNS	G2		;NEGATE THE NUMBER OF DOM'S
	MOVSS	G2		;PUT IN THE LEFT HALF
	HRRI	G2,1(G4)	;POINT TO THE FACTORS
NLIAR2:	PUSHJ	P,INTEG%	;GET A SUBSCRIPT
	IMUL	T0,(G2)		;MULTIPLY BY THE ASSOCIATED FACTOR
	ADD	G3,T0		;ACCUMULATE THE SUM
	LDB	T0,DD.HRI+1(P3)	;GET THE DELIMITER
	CAIE	T0,")"		;END OF SUBSCRITTS
	AOBJN	G2,NLIAR2	;OR DIM'S ..... NO
	LDB	T5,[POINT 4,-1(G4),12];GET THE TYPE CODE
	CAIE	T5,TP%COM	;COMPLEX
	CAIN	T5,TP%DOR	;OR DOUBLE REAL
	ASH	G3,1		;YES, TWO WORDS/ENTRY
	MOVE	G1,(G4)		;GET THE OFFSET
	SUBI	G3,(G1)		;SUB THE OFFSET
	HRRZ	G1,-1(G4)	;GET THE BASE ADDRESS
	ADDI	G1,(G3)		;ADD IN THE SUBSCRIPT CALC.
	JRST	NLIAR5		;GO DISPATCH

NLIAR3:	HLLZ	G1,(G4)		;GET THE ARRAY SIZE
	MOVNS	G1		;NEGATE THE ARRAY SIZE
NLIAR4:	LDB	T5,[POINT 4,-1(G4),12];GET THE VARIABLE TYPE
	CAIE	T5,TP%COM	;COMPLEX
	CAIN	T5,TP%DOR	;OR DOUBLE PRECISION
	ASH	G1,1		;DOUBLE THE ARRAY SIZE
	HRR	G1,-1(G4)	;GET THE VARIABLE ADDRESS
NLIAR5:	PUSHJ	P,NLIEQU	;SCAN FOR AN EQUAL SIGN
;**; [654] INSERT AT NLIAR5+1	SWG	26-APR-77
	MOVEM	T5,DAT.TP+2(P4)	;[654] REMEMBER DATA TYPE
	TLZ	P2,FT.PRC	;CLEAR DOUBLE PRECISION BITS
	HRRZ	T1,NMLTBL(T5)	;GET THE DISPATCH ADDRESS
	PUSHJ	P,(T1)		;GO TO THE ROUTINE
	LDB	T0,DD.HRI+1(P3)	;GET THE DELIMETER
	JRST	NLIVAR		;GET THE NEXT VARIABLE
;INTEGER INPUT ROUTINE
NLII:	PUSHJ	P,NLISCN	;FIND SOME DATA
	TLNE	P2,FT.NUL	;[366] NULL ITEM SEEN
	JRST	NLII1		;[366] YES
	PUSHJ	P,NLILSD	;[325] CHECK RPT. LIST-DIRECTED
	PUSHJ	P,FLINC%##	;[206] GET AN INTEGER VARIABLE
	JSP	P1,NLIDLM	;CHECK THE DELIMITER
;**; [576] Change @ NLII1, JMT, 31-AUG-76
NLII1:	TLNE	P2,FT.LSD	;[576] LIST DIRECTED INPUT ?
	JRST	[ADD	G1,DAT.TP+1(P4) ;[576] YES--ADD INCREMENT
		JUMPL	G1,NLII		;[576] STILL NEGATIVE,IF SO LOOP
		POPJ	P,]		;[576] NO--RETURN
	AOBJN	G1,NLII		;[366] CONTINUE
	POPJ	P,		;RETURN

;REAL INPUT ROUTINE (SINGLE/DOUBLE PRECISION)
;**;[465] Change @ NLID	JNG	11-Nov-75
NLID:	TLOA	P2,FT.PRC	;[465] SET DOUBLE PRECISION
NLIF:	TLZ	P2,FT.PRC	;[465] SET SINGLE PRECISION
;**; [576] Add new  label @ NLIF+1, JMT, 3-SEP-76
NLIF1:	PUSHJ	P,NLISCN	;[576] FIND SOME DATA
	TLNE	P2,FT.NUL	;[366] NULL ITEM
	JRST	NLIDF1		;[366] YES
	PUSHJ	P,NLILSD	;[325] CHECK RPT. LIST-DIRECTED
	PUSHJ	P,REAL%		;GET A REAL VARIABLE
	JSP	P1,NLIDLM	;CHECK THE DELIMITER
;**; [576] Change @ NLIDF1, JMT, 31-AUG-76
NLIDF1:	TLNE	P2,FT.LSD	;[576] LIST DIRECTED INPUT ?
	JRST	[ADD	G1,DAT.TP+1(P4) ;[576] YES--ADD INCREMENT
		JUMPL	G1,NLIF1	;[576] STILL NEGATIVE,IF SO LOOP
		POPJ	P,]		;[576] NO--RETURN
	JUMPSP	NLID1		;[366] JUMP ON SINGLE PRECISION
	ADD	G1,[XWD 1,1]	;POINT TO THE NEXT ENTRY
;**; [576] Change @ NLID1, JMT, 3-SEP-76
NLID1:	AOBJN	G1,NLIF1	;[576] CONTINUE
	POPJ	P,		;RETURN

;LOGICAL INPUT ROUTINE
NLIL6:	JSP	P1,IBYTE.	;EAT THE CHARACTR
NLIL:	PUSHJ	P,NLISCN	;FIND SOME DATA
	CAIN	T0,","		;IGNORE COMMAS
	JRST	NLIL6		;EAT IT
	CAIL	T0,"0"		;IS THIS A DIGIT
	CAILE	T0,"9"		;0-9
	JRST	NLIL5	;NO, NORMAL INPUT
	PUSHJ	P,INTEG%	;YES, GET THE REPEAT COUNT
	MOVE	G2,(G1)		;GET THE REPEAT COUNT
	PUSHJ	P,NLIL3		;GET THE VARIABLE VALUE
	MOVE	T0,(G1)		;GET THE VALUE
;**; [576] Change @ NLIL1, JMT, 31-AUG-76
NLIL1:	TLNE	P2,FT.LSD	;LIST DIRECTED INPUT ?
	JRST	[ADD	G1,DAT.TP+1(P4) ;[576] YES--ADD INCREMENT
		JUMPL	G1,.+2		;[576] STILL NEGATIVE, PROCEED
		POPJ	P,]		;[576] NO--RETURN
	AOBJP	G1,CPOPJ	;END OF ARRAY
	SOJLE	G2,NLIL		;END OF REPEAT
	MOVEM	T0,(G1)		;STORE THE VARIABLE
	JRST	NLIL1		;CONTINUE
NLIL5:	PUSHJ	P,NLIL3		;GET THE VALUE
;**; [576] Change @ NLIL5+1, JMT, 31-AUG-76
	TLNE	P2,FT.LSD	;LIST DIRECTED INPUT ?
	JRST	[ADD	G1,DAT.TP+1(P4) ;[576] YES--ADD INCREMENT
		JUMPL	G1,NLIL		;[576] STILL NEGATIVE,IF SO LOOP
		POPJ	P,]		;[576] NO--RETURN
	AOBJN	G1,NLIL		;CONTINUE IF ARRAY
	POPJ	P,		;RETURN
NLIL3:	CAIN	T0,"."		;DID WE STOP ON A PERIOD?
	JRST	NLIL2		;YES, LOOK FOR .TRUE., ETC.
	JSP	P1,IBYTE.	;GET A T OR F
	SETZM	(G1)		;ASSUME IT'S AN "F"
	CAIN	T0, "T"		;WAS IT REALLY?
	SETOM	(G1)		;NO, BY GOSH, IT WAS A "T"
	JSP	P1,IBYTE.	;SET TO THE NEXT FOR DELINM
	POPJ	P,		;EXIT FROM COMMON LOGICAL ROUTINE
NLIL2:	JSP	P1,IBYTE.	;EAT THE PERIOD
	JSP	P1,IBYTE.	;GET A "T" OR AN "F"
	SETZM	(G1)		;ASSUME ITS AN "F"
	CAIN	T0, "T"		;WAS IT REALLY?
	SETOM	(G1)		;GOOD GRIEF - IT WAS A "T" !!!
NLIL4:	JSP	P1,IBYTE.	;NOW LOOK FOR A CLOSING PERIOD
	CAIE	T0,"."		;BUT WAS IT REALLY A PERIOD?
	TLNE	P3,IO.EOL	;END OF LINE
	POPJ	P,		;YES, EXIT FROM COMMON LOGICAL ROUTINE
	CAIE	T0,"$"	;CHECK FOR END OF NAMELIST RECORD
	CAIN	T0,"&"
	POPJ	P,		;YES, RETURN
	JRST	NLIL4		;NO, TRY AGAIN

NLILSD:	TLNE	P2,FT.LSD	;[325] LIST DIRECTED I/O
	TRNN	P2,-1		;[325] AND ADDR. SAVED
	POPJ	P,		;[325] NO-NO
	MOVEM	T0,(G1)		;[325] YES- SAVE VALUE
	TLNE	P2,FT.PRC	;[325] DOUBLE PRECISION?
	MOVEM	T1,1(G1)	;[325] SAVE SECOND WORD
	AOS	(P)		;[325] SET SKIP RETURN
	POPJ	P,		;[325]
;COMPLEX INPUT ROUTINE
NLIC5:	JSP	P1,IBYTE.	;EAT THE CHARACTER TRY AGAIN
NLIC:	PUSHJ	P,NLISCN	;FIND SOME DATA
	TLNE	P2,FT.LSD	;[325] LIST-DIRECTED I/O
	TRNN	P2,-1		;[325] AND REPEAT COUNT
	JRST	NLIC7		;[325] NO-NO
	DMOVEM	T0,(G1)		;[325] KNOWN VALUES
	ADD	G1,[XWD 1,1]	;[325] UPDATE ADDR
	JRST	NLIC2		;[325] CONTINUE
NLIC7:	CAIE	T0,"("		;[325] STOP AT LEFT PAREN
	JRST	NLIC1		;MUST BE A REPEAT COUNT
NLIC4:	JSP	P1,IBYTE.	;EAT THE LEFT PAREN
	PUSHJ	P,REAL%		;INPUT REAL PART OF COMPLEX NMBR
	ADD	G1,[XWD 1,1]	;POINT TO IMAGINARY PART
	PUSHJ	P,NLISCN	;FIND SOME DATA
	PUSHJ	P,REAL%		;GET THE IMAGINARY PART OF COMPLEX
;**; [576] Change @ NLIC2, JMT, 31-AUG-76
NLIC2:	TLNE	P2,FT.LSD	;LIST DIRECTED INPUT ?
	JRST	[SUB	G1,[XWD 1,1]	;[576] YES--BACK UP
		ADD	G1,DAT.TP+1(P4)	;[576] ADD INCREMENT
		JUMPL	G1,NLIC		;[576] STILL NEGATIVE,IF SO LOOP
		POPJ	P,]		;[576] NO--RETURN
	AOBJN	G1,NLIC		;CONTINUE
	POPJ	P,		;RETURN

NLIC1:			;REPEAT COUNT FOR COMPLEX
	PUSHJ	P,INTEG%	;GET THE REPEAT COUNT
	MOVE	G2,(G1)		;GET THE REPEAT COUNT BACK
;**;[574] @NLIC1 + 1 1/2, JMT, 10-AUG-76
	LDB	T0,DD.HRI+1(P3)	;[574] GET THE DELIMETER
	CAIE	T0,"*"		;[574] REPEAT DELIMETER ?
	ERROR(DAT,15,15)	;[574] NO--ILLEGAL DELIMETER
	TLNE	G2,-1		;[574] IS IT AN INTEGER ?
IFE	CPU-KI10,<FIX	G2,G2	;[574] NO--CONVERT TO AN INTEGER>
IFE	CPU-KA10,<
	JRST	[MULI	G2,400	;[574] NO--SEPERATE FRACTION AND EXP.
		TSC	G2,G2	;[574] GET POSITIVE EXPONENT
		EXCH	G2,G3	;[574] PUT REAL RESULT IN G2
		ASH	G2,-243(G3)	;[574] USE EXP. AS AN INDEX
		JRST	.+1]>		;[574] CONTINUE
	PUSHJ	P,NLISCN	;FIND THE DATA
	CAIN	T0,"("		;LEFT PAREN
	JSP	P1,IBYTE.	;YES, EAT IT
	PUSHJ	P,REAL%		;GET THE REAL PART
	ADD	G1,[XWD 1,1]	;SET UP THE ARRAY
	PUSHJ	P,NLISCN	;FIND SOME DATA
	PUSHJ	P,REAL%		;GET THE IMAGINARY PART
	TLNN	P2,FT.LSD	;[325] LIST-DIRECTED I/O
	JRST	NLIC6		;[325] NO
	MOVEI	T0,-1(G1)	;[325] GET ADDR.
	HRRM	T0,P2		;[325] SAVE IT
	MOVEM	G2,RPT.SV(P4)	;[325] AND REPEAT COUNT
NLIC6:	DMOVE	T0,-1(G1)	;[325] GET THE COMPLEX NUMBER BACK
;**;[574] @NLIC3, JMT, 10-AUG-76
;**;[574] DELETE NLIC3:	AOBJP	G1,CPOPJ	;SET THE LOW ORDER WORD
;**; [576] Change @ NLIC3, JMT, 31-AUG-76
;**; [576] DELETE NLIC3:	AOBJP	G1,[HLLZS	P2	;[574] ZERO REPEAT ADDRESS
;**; [576] DELETE 		SETZM	RPT.SV(P4)	;[574] CLEAR REPEAT COUNT ALSO
;**; [576] DELETE 		JRST	CPOPJ]		;[574] SET THE LOW ORDER WORD
;**; [576] DELETE 	SOJLE	G2,NLIC		;REDUCE THE REPEAT COUNT
NLIC3:	TLNE	P2,FT.LSD	;[576] LIST DIRECTED INPUT ?
	JRST	[SUB	G1,[XWD 1,1]	;[576] YES--BACK UP
		ADD	G1,DAT.TP+1(P4)	;[576] ADD INCREMENT
		JUMPL	G1,.+2		;[576] IF NEGATIVE, PROCEED
		JRST	NLIC8]		;[576] OTHERWISE, ONWARD
	AOBJP	G1,NLIC8		;[576] [574] PROCEED IF END OF ARRAY
	SOJLE	G2,[SETZM RPT.SV(P4)	;[576] REDUCE THE REPEAT COUNT
		JRST	NLIC]		;[576] CLEAR REPEAT COUNT AND PROCEED
	DMOVEM	T0,(G1)		;STORE THE NEXT REPEATED COMPLEX NUMBER
	ADD	G1,[XWD 1,1]	;SET THE HIGH ORDER WORD
	JRST	NLIC3		;CONTINUE

;**; [576] Add new label, JMT, 31-AUG-76
NLIC8:	HLLZS	P2		;[576] [574] ZERO REPEAT ADDRESS
	SETZM	RPT.SV(P4)	;[576] [574] CLEAR REPEAT COUNT ALSO
	JRST	CPOPJ		;[576] [574] SET THE LOW ORDER WORD


NLIS:				;INPUT A STRING OF ASCII TEXT
				;TEXT IS BOUNDED BY SINGLE QUOTES  '...'
	JSP	P1,IBYTE.##	;EAT THE FIRST QUOTE MARK
;**;[465] Change @ NLIS0	JNG	6-Nov-75
NLIS0::MOVSI	T1,(POINT 7,)	;[465] ASCII BYTE POINTER
	HRRI	T1,(G1)		;[465] TO OUR OUTPUT DATA WORD
	MOVE	T0,[ASCII /     /];SET THE OUTPUT TO BLANKS FOR COMPARE
	MOVEM	T0,(G1)		;CLEAR THE OUTPUT WORD
	PUSH	P,[5]		;[465] SAVE CHAR COUNT TILL WORD FILLS
;**; [576] Change @ NLIS0+4 1/2, JMT, 8-AUG-76
	CAIE	T5,TP%COM	;[576] MORE TO DO IF COMPLEX, AND ALSO
	JUMPSP	NLIS1		;[465] MORE FIXING NEEDED IF D.P.
	MOVEM	T0,1(G1)	;[465] CLEAR 2ND HALF WORD
	MOVEI	T0,^D10		;[465] RESET COUNT TO 10 CHARS
	MOVEM	T0,(P)		;[465] SO CAN INPUT D.P. STRING
;**; [576] Delete line @ NLIS0+9L, JMT, 8-AUG-76
;**; [576] DELETE 	AOBJN	G1,.+1		;[465] ADVANCE G1 CORRECTLY FOR EXIT
NLIS1:	JSP	P1,IBYTE.##	;GET A CHARACTER
	CAIE	T0,"'"		;CHECK FOR THE END OF STRING
	TLNE	P3,IO.EOL	;OR END OF LINE
;**;[465] Change @ NLIS1+3L	JNG	6-Nov-75
	JRST	[POP	P,(P)	;[465] REMOVE JUNK FROM STACK
;**; [541] INSERT IN LITERAL @ NLIS1 + 3 1/2 L	CLRH	6-MAY-76
		TLZ	P2,FT.QOT	;[541] CLEAR QUOTE FLAG
		POPJ	P,]	;[465] RETURN END OF STRING
	IDPB	T0,T1		;NO, STORE THE CHARACTER
	SOSLE	(P)		;[465] END OF VARIABLE?
	JRST	NLIS1		;NO CONTINUE
	POP	P,(P)		;[465] CLEAR JUNK FROM STACK
;**; [534] DELETE @ NLIS1 + 9L	CLRH	23-APR-76
	JSP	P1,IPEEK.##	;CHECK FOR EXACT FIT
	CAIE	T0,"'"		;ENDING QUOTE
;**; [534] CHANGE @ NLIS1 + 12L	CLRH	23-APR-76
	JRST	NLIS2		;[534]
	JSP	P1,IBYTE.##	;YES, EAT THE QUOTE
;**; [541] INSERT @ NLIS2 -1 1/2	CLRH	6-MAY-76
	TLZ	P2,FT.QOT	;[541] CLEAR QUOTED STRING FLAG
	POPJ	P,		;END OF QUOTE FOR THIS VARIABLE
;**; [534] INSERT BEFORE NLINAM	CLRH	23-APR-76
NLIS2:	TLO	P2,FT.QOT	;[534] SET CONTINUE QUOTE FLAG
;**; [576] Change @ NLIS2, JMT, 3-SEP-76
	TLNE	P2,FT.LSD	;[576] LIST DIRECTED INPUT ?
	JRST	[ADD	G1,DAT.TP+1(P4)	;[576] YES--ADD INCREMENT
		JUMPL	G1,NLIS0	;[576] IF NEGATIVE, LOOP
		POPJ	P,]		;[576] RETURN
	AOBJN	G1,NLIS0	;[534] END OF ARRAY
	POPJ	P,		;[534] RETURN
	SUBTTL COMMON SUBROUTINES NLI
NLINAM:				;ROUTINE TO GET A VARIABLE NAME
	TLNE	P3,IO.EOL	;CHECK FOR END OF LINE
	PUSHJ	P,NXTLN.	;GET THE NEXT RECORD
	JSP	P1,IBYTE.	;GET A CHARACTER
NLINM:	CAIE	T0,"$"		;CHECK FOR END OF
	CAIN	T0,"&"		;OF NAME LIST DATA BLOCK
	JRST	NLIFIN		;YES, END BLOCK
	CAIL	T0,"A"		;VARIABLE MUST START WITH ALPHA
	CAILE	T0,"Z"		;A-Z
	JRST	NLINAM		;NO, TRY AGAIN
NLINA0:	TDZA	T1,T1		;CLEAR THE OUTPUT WORD
NLINA1:	JSP	P1,IBYTE.	;GET THE NEXT INPUT CHARACTER
	CAIL	T0,"A"		;IS IT AN ALPHA
	CAILE	T0,"Z"		;A-Z
	JRST	.+2		;NO, CHECK DIGITS
	JRST	NLINA2		;YES, STORE THE CHARACTER
	CAIL	T0,"0"		;CHECK THE DIGITS
	CAILE	T0,"9"		;0-9
	JRST	NLINA3		;NON ALPHA/NUM CHARACTER
;**;[461],NLINA2,DPL,18-JUL-75
NLINA2:	MOVE	T2,T0		;[461] USE T2, KEEP T0 ASCII
	TRC	T2,140		;[461] CONVERT THE ASCII
	TRNN	T2,140		;[461] CHARACTER TO A SIXIT
	IORI	T2,40		;[461] CHARACTER (CORRECT THE CASE)
	ANDI	T2,77		;[461] SAVE ONLY 6 BITS
	LSH	T1,6		;STORE IT T1
	IOR	T1,T2		;[461] INSET THE CHARACTER
	JUMPGE	T1,NLINA1	;CONTINUE FOR SIX CHARACTERS
	POPJ	P,		;RETURN T1=SIXBIT CHARACTER
NLINA3:	LSH	T1,6		;LEFT JUSTIFY THE CHARACTER
	JUMPGE	T1,.-1		;CONTINUE
	POPJ	P,		;RETURN


NLISC1:	JSP	P1,IBYTE.	;EAT THIS CHARACTER
	TLNE	P3,IO.EOL	;AT END OF LINE
	PUSHJ	P,NXTLN.	;YES, ADVANCE TO NEXT LINE
	TLNN	P2,FT.LSD	;[350] LIST-DIRECTED INPUT
	JRST	NLISCN		;[350] NO
	TLNE	P3,IO.EOF	;[350] CHECK EOF
	POPJ	P,		;[350] RETURN
NLISCN:	TLNE	P2,FT.LSD	;[325] LIST DIRECTED I/O?
	TRNN	P2,-1		;[325] ADDRESS SAVED?
	JRST	NLISC4		;[325] NO-NO
	SOSG	RPT.SV(P4)	;[325] DONE WITH REPEAT?
	JRST	NLISC3		;[325] YES
	DMOVE	T0,(P2)		;[325] NO-RETRIEVE VALUE
	POPJ	P,		;[325] RETURN
NLISC3:	HRRI	P2,0		;[325] YES CLEAR SAVED ADDR.
	SETZM	RPT.SV(P4)	;[325] AND CLEAR REPEAT COUNT
	LDB	T0,DD.HRI+1(P3)	;[325] RETRIEVE DELIMITER
	CAIE	T0,"/"		;[325] WAS END OF INPUT?
	JRST	NLISC4		;[325] NO
	SUB	P,[XWD 1,1]	;[366] [325] SET RETURN
	TLO	P2,FT.SLH	;[366] SET FLAG AS SLASH SEEN
	POPJ	P,		;[325]
NLISC4:	JSP	P1,IPEEK.	;[325] LOOK AT THE NEXT CHARACTER
NLISC2:	CAIE	T0,11		;SKIP TABS
	CAIN	T0," "		;AND SPACES
	JRST	NLISC1		;IGNORE THESE CHARACTERS
	CAIE	T0,15		;.IPEEK CAN RETRUN A CR
	TLNE	P3,IO.EOL	;AND END OF LINES
	JRST	NLISC1		;IGNORE IT
	TLNE	P2,FT.LSD	;LIST DIRECTED SCAN
	JRST	LSDSCN		;YES, CONTINUE AT LIST DIRECTED
	CAIE	T0,"$"		;AT END OF NAMELIST BLOCK
	CAIN	T0,"&"		; % OR %
	JRST	NLIFIN		;YES, QUIT
	CAIN	T0,","		;COMMA
	JRST	NLISC1		;IGNORE
	POPJ	P,		;GOT SOMETHING ELSE

LSDSCN:				;LIST DIRECTED SCAN ROUTINE
	CAIG	T0,<CR==15>	;[325] SKIP ALL THOSE CHAR.
	JRST	NLISC1		;[325] EAT THEM
	CAIN	T0,","		;CHECK FOR NULL INPUTS
	JRST	[TLON	P2,FT.NUL	;[325] COMMA ALREADY SEEN?
		 JRST	NLISC1		;[325] NO-SET SEEN AND IGNORE
		 JSP	P1,IBYTE.	;[325] YES-EAT COMMA
		 POPJ	P,]		;[325] WITH "NUL" ITEM
	CAIN	T0,"/"		;END OF INPUT
	JRST	[SUB	P,[XWD 1,1]	;[366]
		 TLO	P2,FT.SLH	;[366] SET FLAG SLASH SEEN
		 POPJ	P,]		;[366] RETURN TO LSTDR%
	TLZ	P2,FT.NUL	;[325] THIS ITEM IS NOT NUL
	CAIN	T0,"'"		;STRING MARKER
	JRST	[PUSHJ	P,NLIS	;YES, PROCESS THE STRING
;**; [576] Change in literal @ LSDSCN+14L, JMT, 3-SEP-76
		TLNE	P2,FT.LSD	;[576] LIST DIRECTED ?
		JRST	NLISC5		;[576] YES--PROCEED
		AOBJN	G1,NLISCN	;[465] ANYTHING LEFT
		SUB	P,[XWD 1,1]	;REDUDE THE STACK FOR THE RETURN
		POPJ	P,]		;RETURN TO LSTDR%
	POPJ	P,		;RETURN


;**; [576] New label and code @ LSDSCN+18L, JMT, 3-SEP-76
NLISC5:	ADD	G1,DAT.TP+1(P4)	;[576] ADD INCREMENT
	JUMPL	G1,NLISCN	;[576] LOOP IF STILL NEGATIVE
	SUB	P,[XWD 1,1]	;[576] FIX STACK FOR RETURN
	POPJ	P,		;[576] RETURN

NLIEQU:				;EARCH FOR AN EQUAL SIGN
	CAIN	T0,"="		;IS THIS AN EQUAL
	POPJ	P,		;YES, RETURN
	TLNE	P3,IO.EOL	;AT END OF LINE
	PUSHJ	P,NXTLN.	;YES, READ NEXT RECORD
	JSP	P1,IBYTE.	;GET A CHARACTER
	CAIL	T0,"A"		;IS IT ALPHA
	CAILE	T0,"Z"		;A-Z
	JRST	NLIEQU		;NO, TRY =
	PUSHJ	P,NLINA0	;GET THE SYMBOL NAME
	JRST	NLIVA0		;MUSTBE A VARIABLE NAME
NLIDLM:				;CHECK THE DELIMITER FOR A REPEAT
	LDB	T0,DD