Google
 

Trailing-Edge - PDP-10 Archives - BB-D480F-SB_FORTRAN10_V10 - fornml.mac
There are 9 other files named fornml.mac in the archive. Click here to see a list.
	SEARCH	MTHPRM,FORPRM
	TV	FORNML	NAMELIST AND LIST-DIRECTED I/O 7(4153)
	SUBTTL	NAME LIST SEQUENTIAL ACCESS CALLING SEQUENCES - 28-Oct-81


;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 *****

3056	JLC	23-Mar-82
	Created from FORCNV.MAC. Changed some global refs.

3057	JLC	25-Mar-82
	List-directed and namelist output must clear both encoded
	words to get free format.

3063	BL	26-Mar-82
	Insert NAMELIST character I/O code.

3074	BL	31-Mar-82
	Cleanup NAMELIST character I/O stuff[3063].

3106	BL	12-Apr-82
	Enable us to handle substrings of character scalars.

3112	BL	15-Apr-82
	Change SKIPN to SKIPE.

3120	BL	19-May-82
	Ensure no delimiters after LD character output.

3131	JLC	11-Jun-82
	Make more delimiters, namely "=" and "(", legal for
	NAMELIST I/O, since they can be obtained by abortive
	call to %LINT (e.g. A(1)=3,TRUE=3).

3133	BL	16-Jun-82
	Code review changes for LD/NM character stuff.

3136	JLC	26-Jun-82
	Fix G-float bug - namelist and list-directed I/O were
	requesting input of a value of type DP%DPR, so got
	overflow when outside the normal range but legal for
	GFLOAT.

3150	JLC	13-Jul-82
	Fix output of integer 0, was calling %INTO, should have been
	calling %GINTO.

3154	JLC	20-Jul-82
	Fix G-floating list-directed input.

3164	BL	27-Aug-82
	NAMELIST bug...DECRP was not resetting input string count
	(NLSWRD). Sometimes resulted in incorrect input string byte
	pointers (NLSPTR/NLCPTR).

3250	JLC	7-Jan-83
	Support list-directed output of Hollerith literals.

***** End V7 Development *****

3272	BL	17-Feb-83
	Change SOSGE to SOSG at NLCSTR. we were checking for one-too-many
	character strings in NAMELIST output. sometimes caused infinite
	looping.

3307	TGS	15-Apr-83	SPR:20-19101
	LDELEM must check for line overflow before calling %OMBYT.  Other-
	wise the count of free bytes may go negative, causing MOVSLJ to
	die with an ?Illegal instruction, or the output may be prematurely
	truncated. Also save a few more ACs around LDCHLP's call to SPCEOL.


***** Begin Version 10 *****

4005	JLC	25-Feb-83
	Remove references to D%IO.

4010	JLC	19-Apr-83
	Clear temp flags for formatted I/O here instead of in FORIO.

4033	JLC	18-Jul-83
	Clear %SPFLG here so that we won't get plus signs in front of
	positive numbers after SP format has been used.

4044	JLC	27-Sep-83
	Changed code for setting default (free-format) parameters
	for routines now in MTHLIB.

4052	JLC	12-Oct-83
	Code changes necessary for minor performance enhancements
	to formatted I/O.

4054	JLC	25-Oct-83
	Save TP%INT as data type before output of repeat count,
	as integer output now deciphers the data type.

4111	JLC	16-Mar-84
	Modify the calling sequence for error calls.

4131	JLC	12-Jun-84
	Give %GTBLK calls a non-skip error return to properly report
	memory full diagnostics.

4153	JLC	27-Sep-84
	Modify the error message given if the character at the start
	of a data element is totally illegal if the target variable
	is of type character, from "illegal character in data" to
	"must be in single quotes".

***** End V10 Development *****

***** End Revision History *****
\

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

     MOVEI 16,ARGBLK   0       89 12 14 1718             35
     PUSHJ 17,NLI.     ------------------------------------
                       !   3   !TYP!I! X ! u -unit#       !
                       ------------------------------------
                       !   4   !TYP!I!   !     END=c      !
                       ------------------------------------
                       !   5   !TYP!I!   !     ERR=d      !
                       ------------------------------------
                       !   6   !TYP!I! X !    IOSTAT=i    !
                       ------------------------------------
                       !  10   !TYP!I! X ! NAMELIST addr  !
                       ------------------------------------

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

     MOVEI 16,ARGBLK   0       89 12 14 1718             35
     PUSHJ 17,NLO.     ------------------------------------
                       !   3   !TYP!I! X ! u -unit#       !
                       ------------------------------------
                       !   4   !TYP!I!   !     END=c      !
                       ------------------------------------
                       !   5   !TYP!I!   !     ERR=d      !
                       ------------------------------------
                       !   6   !TYP!I! X !    IOSTAT=i    !
                       ------------------------------------
                       !  10   !TYP!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

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

     ARRAY ENTRIES  differ in that blocks generated by V6 and earlier
	compilers have ARRAY SIZE and OFFSET as halfwords in the
	third word of the block. This is signaled by the first bit
	of word 2 being zero. V7 and later versions will set the first
	bit in word 2 and place ARRAY SIZE in word 3 and ARRAY OFFSET
	in word 4 of the block.

V6 and earlier:        012     89 12 14 1718             35
                       ------------------------------------
                       ! SIXBIT /ARRAY NAME/              !
                       ------------------------------------
                       !00!#DIM! T !I! X ! BASE ADDR      !
                       ------------------------------------
                       !       SIZE      ! OFFSET         !
                       ------------------------------------
                       !       !   !I! X ! FACTOR 1       !
                       ------------------------------------
                       !       !   !I! X ! FACTOR 2       !
                       ------------------------------------
                       !       !   !I! X ! FACTOR 3       !
                       ------------------------------------
                       !       !   !I! X ! FACTOR N       !
                       ------------------------------------



V7:                    012     89 12 14 1718             35
                       ------------------------------------
                       ! SIXBIT /ARRAY NAME/              !
                       ------------------------------------
                       !10!#DIM! T !I! X ! BASE ADDR      !
                       ------------------------------------
		       !	NUMBER OF ENTRIES	  !
		       ------------------------------------
                       !       	     OFFSET	          !
                       ------------------------------------
                       !       !   !I! X ! FACTOR 1       !
                       ------------------------------------
                       !       !   !I! X ! FACTOR 2       !
                       ------------------------------------
                       !       !   !I! X ! FACTOR 3       !
                       ------------------------------------
                       !       !   !I! X ! FACTOR N       !
                       ------------------------------------
$
	SUBTTL	JON CAMPBELL /JLC/EDS/AHM


	ENTRY	%NLI,%NLO,%LDI,%LDO,%LDIST,%LDOST
	EXTERN	%IBYTE,%IBYTC,%OBYTE,%IRECS,%ORECS,%SAVE4,%IBACK
	EXTERN	%RIPOS,%SIPOS,%ROPOS,%SOPOS,%GTBLK,%PUSHT,%POPT
	EXTERN	IO.ADR,IO.INC,IO.NUM,IO.TYP,%FLINF,A.NML,%SCLFC,IO.SIZ
	EXTERN	%FLRFR,%FLRBX,%FLFSG,%FTSLB,%SPFLG
	EXTERN	%FLSPR,%FLDPR,%FLGPR
	EXTERN	%FWVAL,%DWVAL,%XPVAL
	EXTERN	%GRIN,%GROUT,%INTI,%GINTO,%LINT,%LOUT,%OCTI,%OCTO,%SIZTB
	EXTERN	%IOERR,%POPJ,%POPJ1,%SETAV,%UDBAD,%MVBLK,%OMBYT

	SEGMENT	DATA


%ALASZ==10			;SIZE OF ARRAYS FOR STRING INFO
%ALISZ==100			;INITIAL SIZE FOR STRING CORE ALLOCATION
NLSGN1:	BLOCK	1		;LOCAL REAL PART SIGN
NLSGN2:	BLOCK	1		;LOCAL IMAGINARY PART SIGN
NLSGN.:	BLOCK	1		;SIGN OF ENTIRE VALUE
NLFLG.:	BLOCK	1		;-1=END OF DATA, 0=NULL, 1=NON-NULL
CHRLST:	BLOCK	1		;Last LD output was character (no delimiters)
DLFLG.:	BLOCK	1		;FLAG TO SCAN FOR END DATA DELIM
NLRFR:	BLOCK	2		;RAW FRACTION FROM FLIRT
NLRBX:	BLOCK	1		;RAW BINARY EXPONENT TO MATCH
NLRFR2:	BLOCK	2		;RAW FRACTION OF IMAGINARY PART
NLRBX2:	BLOCK	1		;RAW BINARY EXPONENT OF IMAGINARY PART
NLINFO:	BLOCK	1		;INFO ABOUT FLIRT NUMBER (REAL PART)
NLVAL.:	BLOCK	2		;VALUE FOUND
NLVL2.:	BLOCK	2		;2ND VALUE FOR COMPLEX
NLRP.:	BLOCK	1		;REPEAT COUNT
NLDIM.:	BLOCK	1		;# OF DIMENSIONS
NLVAR.:	BLOCK	1		;PNTR TO VARIABLE IN ARG LIST
NLNAM.:	BLOCK	1		;NAME OF NAMELIST/VARIABLE
NLARG.:	BLOCK	1		;ADDRESS OF ARG LIST
NLCVL.:	BLOCK	2		;CONVERTED VALUE
NLADD.:	BLOCK	1		;ADDRESS OF USER'S VARIABLE
NLINC.:	BLOCK	1		;OFFSET BETWEEN USER'S ARRAY ENTRIES
NLSIZ.:	BLOCK	1		;SIZE OF USER'S ARRAY ENTRIES
NLOFF.:	BLOCK	1		;Offset for calculation of element address
NLFCT.:	BLOCK	1		;Address of array's first factor
NLEMS.:	BLOCK	1		;Elements in array
CNVTYP:	BLOCK	1		;CONVERTED VALUE TYPE
VALTYP:	BLOCK	1		;ORIGINAL VALUE TYPE
VARTYP:	BLOCK	1		;VARIABLE TYPE
TOTYPE:	BLOCK	1		;TYPE TO CONVERT TO
OSIZE:	BLOCK	1		;SIZE OF SUBSEQUENT OUTPUT DATA ELEMENT
NLBFLN:	BLOCK	1		;Byte size of LD/NL input string buffer
NLSBYT:	BLOCK	1		;Byte count of LD/NL input string
NLSWRD:	BLOCK	1		;Word count of LD/NL input string
NLCWRD:	BLOCK	1		;Current word count of LD/NL input string
NLSPTR:	BLOCK	1		;Pointer to beginning of LD/NL string buffer
NLCPTR:	BLOCK	1		;Current pointer to LD/NL input string
FINFLG:	BLOCK	1		;FLAGS FOR END OF DATA
LDLFLG:	BLOCK	1		;FLAGS FOR LEGAL DELIMITERS
NLNUM.:	BLOCK	1		;# OF USER'S ARRAY ENTRIES TO FILL
NLVFC.:	BLOCK	1		;FLAGS ALLOWED FOR 1ST CHAR OF VARIABLE
NLFV.:	BLOCK	1		;VARIABLE ENTRY HAS BEEN FILLED
TMPFLG:	BLOCK	1		; TEMP STORAGE FOR NAMELIST FLAG (P1)
;CHARACTER FLAGS - SET BY ROUTINE GETCHR
;IN ORDER TO TEST FOR MULTIPLE CHARACTERS (OF A CERTAIN TYPE, FOR INSTANCE),
;EACH CHARACTER HAS BEEN GIVEN AN ASSOCIATED FLAG (PICKED UP IN TABLE
;NLCFLG). ALL SPECIAL CHARACTERS (E.G. "*","$") HAVE THEIR OWN FLAGS, AND
;ALL ALPHABETIC CHARACTERS ARE GIVEN THE FLAG "ALFLAG". THIS TECHNIQUE
;COMPRESSES THE TESTING REQUIRED FOR DELIMITERS, ETC., AND MAKES IT MORE
;GENERAL.
COLFLG==0
SEMFLG==0
LSBFLG==0
RSBFLG==0
RABFLG==0
LABFLG==0
ATFLAG==0
NSFLAG==0
EOLFLG==2
DIGFLG==10
COMFLG==20
SPCFLG==40
ALFLAG==100
LPRFLG==200
RPRFLG==400
PNTFLG==1000
SQFLAG==2000
DQFLAG==4000
SGNFLG==10000
MINFLG==10000
PLSFLG==10000
NLSFLG==20000
NLEFLG==40000
AMPFLG==40000
DOLFLG==40000
NULFLG==100000
SLHFLG==200000
LOGFLG==400000
ASTFLG==1,,0
EQUFLG==2,,0

	SEGMENT	CODE

;LIST-DIRECTED INPUT & OUTPUT ROUTINES
;USES COMMON SUBROUTINES IN THE NAMELIST CODE TO PICK UP
;VALUES.

%LDIST:	MOVX	T1,SLHFLG		;SLASH OR ERROR ENDS DATA
	MOVEM	T1,FINFLG
	MOVX	T1,COMFLG+SPCFLG+SLHFLG+NULFLG+ASTFLG+EOLFLG
					;LEGAL DELIMITERS [3063]
	MOVEM	T1,LDLFLG		;FOR CHECKING AFTER A SCAN
	SETZM	NLVFC.			;NO VARIABLES ALLOWED
	PUSHJ	P,NLINIT		;INIT NMLST PARAMS
	MOVX	T0,D%LSD		;set for list-directed
	IORM	T0,FLAGS(D)
	MOVEM	P1,TMPFLG		; SAVE NAMELIST FLAG AC
	POPJ	P,			;

%LDI:	MOVE	P1,TMPFLG		; GET NAMELIST FLAG AC
	PUSHJ	P,LDSET			; SETUP VARIABLE PARAMS
	PUSHJ	P,NLMAIN		; DO MAIN LOOP
	MOVEM	P1,TMPFLG		; SAVE NAMELIST FLAG AC
	SKIPN	NLRP.			; IF REPEAT COUNT GONE
	 TDNN	P1,FINFLG		; CHECK IF FINISHED
	  POPJ	P,			; JUST RETURN FOR MORE

	SETZM	%UDBAD			; SETUP FOR NO MORE INPUT
	PJRST	%SETAV			; RETURN TO USER PROG

;LIST-DIRECTED OUTPUT
;GETS A VARIABLE ADDRESS AND TYPE AND OUTPUTS THE VALUE
;IN THE PROPER FORMAT. IN ORDER TO AVOID A TRAILING COMMA,
;THE COMMA IS OUTPUT FIRST, BUT ONLY AFTER THE 1ST VALUE HAS BEEN
;WRITTEN
;* Warning - smashes Perm acs *

%LDOST:	PUSHJ	P,NLINIT		;INITIALIZE STUFF
	MOVX	T0,D%LSD		;Set for list-directed
	IORM	T0,FLAGS(D)
	MOVEI	T1,1			;SET OUTPUT FOR 1PG
	MOVEM	T1,%SCLFC
	PJRST	CHKEND			; CHECK FOR COL 1

%LDO:	PUSHJ	P,LDSET			;SETUP VARIABLE PARAMS
	PJRST	NLMO			; OUTPUT IT

LDSET:	MOVE	T1,IO.ADR		;GET ADDRESS
	MOVEM	T1,NLADD.		;SAVE IT
	HRRZ	T1,IO.TYP		;GET VARIABLE TYPE
	MOVEM	T1,VARTYP		;SAVE IT
	MOVE	T1,IO.SIZ		; GET SIZE OF ENTRY
	MOVEM	T1,NLSIZ.		;SAVE IT
	MOVE	T1,IO.INC		;GET INCR WORD
	MOVEM	T1,NLINC.		;SAVE OFFSET
	MOVE	T1,IO.NUM		;GET # LOCS
	MOVEM	T1,NLNUM.		;SAVE POSITIVE
	POPJ	P,

;NAMELIST INPUT  -  After  finding the  proper  NAMELIST  "Begin  data"
;sequence ($  or &  in column  2), the  NAMELIST name  in the  data  is
;matched against the NAMELIST  required by the  user's program.  If  it
;does not match, the input is scanned to the next "Begin data" sequence
;and matched again.   Upon a match,  we grab a  variable name from  the
;data, and search  for it  in the NAMELIST  block to  get the  variable
;parameters. Then  we look  at  whether the  user has  specified  array
;indices in the data. If so, we calculate the array reference.  If  the
;variable is an  array but no  array indices are  given, the number  of
;elements in the  array is used  as the possible  number of entries  to
;fill, starting at the first array element.  Note that before the  data
;loop we clear NLNAM., which indicates to subroutine VARNAM to actually
;get a new variable name  from the data.  Under certain  circumstances,
;we can return from NLMAIN with the next variable name left in NLNAM.


%NLI:	PUSHJ	P,%SAVE4		;SAVE P1-P4
	PUSHJ	P,NLINIT		;INIT NMLST PARAMS
	MOVX	T0,D%NML		;MEANS "=" & "(" ARE LOGIC DELIMS
	IORM	T0,FLAGS(D)
	MOVX	T1,NLEFLG		;END OF DATA FLAGS
	MOVEM	T1,FINFLG
	MOVX	T1,COMFLG+SPCFLG+ALFLAG+NLEFLG+NULFLG+ASTFLG+EOLFLG+EQUFLG+LPRFLG
					;LEGAL DELIMITERS [3063]
	MOVEM	T1,LDLFLG		;FOR CHECKING AFTER A SCAN
	MOVX	T1,ALFLAG		;ALPHA CHAR ONLY BEGINS VARIABLE
	MOVEM	T1,NLVFC.		;SAVE FOR SCAN
	MOVE	T1,NLARG.		;GET NMLST PNTR
	MOVE	T1,(T1)			;GET NAMELIST NAME
	MOVEM	T1,NLVAL.		;SAVE IT
NLILP1:	PUSHJ	P,NLGETB		;GET BEG OF NAMELIST DATA
	PUSHJ	P,SKPCHR		;SKIP BEGIN CHAR
	PUSHJ	P,NLINAM		;GET NAMELIST NAME IN DATA
	MOVE	T2,NLNAM.		;GET NAME FOUND BY NLINAM
	CAME	T2,NLVAL.		;IS IT THE ONE WE WANT?
	 JRST	NLILP1			;NO
	SETZM	NLNAM.			;CLEAR VARIABLE NAME
NLILP2:	PUSHJ	P,VARNAM		;GET A VARIABLE NAME
	TDNE	P1,FINFLG		;END OF DATA?
	 JRST	NLEND			;YES. LEAVE
	SKIPN	NLNAM.			;FIND ANYTHING?
	 JRST	DOLFND			;NO. IT WAS AN ERROR, UNDOUBTEDLY
	TDNE	P1,FINFLG		;END OF DATA?
	 JRST	NLEND			;YES. GO FIND END-OF-LINE
	PUSHJ	P,NLVSRH		;SEARCH IN NAMELIST TABLE
	MOVE	T1,NLNAM.		;Get name incase error
	TXNN	P1,NLSFLG		;FOUND?
;	  IOERR	(VNN,799,309,?,Variable $S not in namelist,<T1>)
	 $ACALL	VNN			;?Variable $S is not in namelist
	PUSHJ	P,CALARR		;YES. CALC ADDR & # ENTRIES
	SETZM	NLRP.			;CLEAR REPEAT COUNT
	SETZM	NLNAM.			;CLEAR VARIABLE NAME
	SETZM	NLFV.			;STARTING NEW VARIABLE
	PUSHJ	P,NLMAIN		;DO MAIN CODE
	TDNN	P1,FINFLG		;END OF DATA?
	 JRST	NLILP2			;NO
	JRST	NLEND			;YES

DOLFND:	PUSHJ	P,GTCHRL		;GET NEXT CHAR
	TDNN	P1,FINFLG		;END OF DATA?
	 JRST	DOLFND			;NO. SCAN SOME MORE
NLEND:	PJRST	NLEOL		;LOOK FOR END OF LINE AND RETURN TO CALLER

;INITIALIZATION OF NAMELIST/LDIO PARAMETERS
NLINIT:	MOVX	T1,D%CLR		;CLEAR TEMP FLAGS
	ANDCAM	T1,FLAGS(D)
	XMOVEI	T1,@A.NML		;Get addr of arg block
	LDB	T2,[POINTR A.NML,ARGTYP] ;GET ARG TYPE
	JUMPN	T2,GOTNLA		;IF NON-ZERO, T1 HAS NAMELIST ADDR
	 MOVE	T1,(T1)			;OTHERWISE IT HAS PNTR TO NAMELIST ADDR
GOTNLA:	MOVEM	T1,NLARG.		;SAVE ARG LIST ADDR
	SETZM	NLSWRD			;Clear string count
	SKIPN	T1,NLSPTR		;Is there a string yet?
	 HRLZI	T1,(POINT 7,)		;NO. load a 7 bit pointer
	MOVEM	T1,NLCPTR		;Initialize current input string ptr
 	SETZ	P1,			;CLEAR FLAG WORD
	SETZM	NLRP.			;CLEAR REPEAT COUNT
	SETZM	NLFLG.			;CLEAR FLAG
	SETZM	CHRLST			;[3120]Clear flag
	SETZM	%FWVAL			;FREE FORMAT
	SETZM	%DWVAL
	SETZM	%XPVAL
	DSETZM	SS.ADR			;Reset substring words	[3063]
	SETZM	NLFV.			;SET NO VARIABLES FILLED
	SETZM	%SCLFC			;CLEAR SCALE FACTOR
	SETZM	VALTYP			;Clear input variable type [3063]
	POPJ	P,

;CALARR - CHECKS THE DIMENSIONALITY OF THE VARIABLE SPECIFIED
;IN THE DATA. IF IT IS AN ARRAY, IT CALLS CALADD, WHICH CHECKS FOR THE
;PRESENCE OF INDICES IN THE DATA. OTHERWISE IT JUST CHECKS FOR
;THE EQUAL-SIGN FOLLOWING THE VARIABLE NAME.
;SMASHES P2, P3, P4.
CALARR:	PUSHJ	P,VARSET		;SETUP VARIABLE PARAMS
	PUSHJ	P,NLNB			;SCAN FOR NON-BLANK
	MOVE	T0,VARTYP		;Get variable type	[3063]
	CAIE	T0,TP%CHR		;Character?		[3063]
	 JRST	CALAR1			;NO.			[3063]
	PUSHJ	P,CALCHR		;Do character processing[3063]
	JRST	CALAR2			;Skip non-char processing[3063]
CALAR1:	SKIPE	NLDIM.			;ARRAY?			[3112]
	 PUSHJ	P,CALADD		; YES. PROCESS INDICES IF ANY	[3063]
CALAR2:	TDNE	P1,FINFLG		;LEAVE IF DONE		[3063]
	 POPJ	P,
	CAIE	T1,"="			;DO WE HAVE =?
;	  IOERR	(NEQ,799,513,?,Found "$C" when expecting "=",<T1>)
	 $ACALL	NEQ
	PJRST	SKPCHR			;SKIP THE EQUAL SIGN
;VARSET - DOES ALL THE NECESSARY SETUP GIVEN THE POINTER
;INTO THE NAMELIST BLOCK FOR THE GIVEN VARIABLE (IN NLVAR.).

;[3063]	We now check for new(V7)-style NAMELIST blocks. Old(V6)-style
;	blocks had ARRAY-SIZE (number of elements) in the left-half
;	and ARRAY-OFFSET in the right half of the third word of the
;	block. New-style has ARRAY-SIZE in the third word and OFFSET
;	in the fourth word. New-style blocks are indicated by "1"
;	in bit zero of the second word, while old-style blocks
;	have zero in bit zero (see diagram at the beginning of NMLST).

;	To simplify things, ARRAY-SIZE and ARRAY-OFFSET are now stored
;	in NLEMS. and NLOFF., respectively, during initialization.

VARSET:	MOVEI	T1,1			;INITIALIZE # ENTRIES AT 1
	MOVEM	T1,NLNUM.
	MOVE	T2,NLVAR.		;GET THE ARG PNTR
	MOVE	T1,(T2)			;GET VARIABLE NAME
	MOVEM	T1,NLNAM.		;SAVE IT
	LDB	T1,[POINT 7,1(T2),8]	;GET # DIMS
	MOVEM	T1,NLDIM.		;SAVE # DIMS
	JUMPE	T1,VARST1		;IT'S A SCALAR
	SKIPL	1(T2)			;New style block?(ck 1st wd/ ARRAYNAME entry)
	 JRST	OLDBLK			;NO
	MOVE	T1,2(T2)		;Get # entries in array
	MOVEM	T1,NLNUM.		;Save # array entries left
	MOVEM	T1,NLEMS.		;Save # total array entries
	MOVE	T1,3(T2)		;Get offset
	MOVEM	T1,NLOFF.		;Save offset
	XMOVEI	T1,4(T2)		;Get address if first factor
	MOVEM	T1,NLFCT.		;Save address of first factor
	JRST	VARST1			;Back in line
OLDBLK:	HLRZ	T1,2(T2)		;GET # ENTRIES IN ARRAY
	MOVEM	T1,NLNUM.		;SAVE IT
	MOVEM	T1,NLEMS.		;Save # total array entries
	HRRZ	T1,2(T2)		;Get offset
	MOVEM	T1,NLOFF.		;Save offset
	XMOVEI	T1,3(T2)		;Address of first factor
	MOVEM	T1,NLFCT.		;Save address/first factor
VARST1:	LDB	T3,[POINT 4,1(T2),12]	;GET TYPE
	MOVEM	T3,VARTYP		;SAVE TYPE
NLTYP:	CAIN	T3,TP%CHR		;Character string?
	 JRST	NLICHR			;YES. Go initialize for characters
	XMOVEI	T1,@1(T2)		;Get base addr
	MOVEM	T1,NLADD.		;SAVE IT
	MOVE	T1,%SIZTB(T3)		;GET SIZE
	MOVEM	T1,NLSIZ.		;SAVE SIZE
	MOVEM	T1,NLINC.		;AND OFFSET
	POPJ	P,

NLICHR:	DMOVE	T2,@1(T2)		;Load pointer & count
	MOVEM	T2,NLADD.		;Store it
	MOVEM	T2,IO.ADR		;For string comparisons
	MOVEM	T3,NLSIZ.		;Save length
	MOVEM	T3,NLINC.		;Save increment
	POPJ	P,			;All done

;CALADD - PROCESSES THE INDICES OF AN ARRAY REFERENCE.
;IF THERE ARE NO INDICES, IT GRABS THE ARRAY SIZE DIVIDED
;BY THE ENTRY SIZE TO GET THE # OF ENTRIES. IF THERE ARE INDICES,
;IT ADDS THE OFFSET CALCULATED TO NLADD.
;SMASHES P2,P3,P4

CALADD:
	MOVE	P2,NLVAR.		;GET VARIABLE ENTRY PNTR
	CAIE	T1,"("			;LEFT PAREN?
	 POPJ	P,			;NO. Entire array(all done)
	MOVE	P3,NLDIM.		;P3= # dims left to process
	MOVE	P4,NLFCT.		;P4 points to factors	[3063]
	XMOVEI	T1,NLVAL.		;POINT TO VALUE
	MOVEM	T1,IO.ADR		;FOR %INTI
ADDLP1:	PUSHJ	P,%INTI			;GET AN INTEGER
	MOVE	T2,NLVAL.		;GET THE VALUE
	IMUL	T2,(P4)			;MULTIPLY BY A FACTOR
	IMUL	T2,NLSIZ.		;GET THE REAL OFFSET
	ADDM	T2,NLADD.		;ADD TO ADDRESS
	PUSHJ	P,NLSDEL		;GET THE NEXT DELIMITER
	SOJLE	P3,ADDLPD		;Go until no more dims
	AOJA	P4,ADDLP1		;. .

ADDLPD:	PUSHJ	P,GETDEL		;GET THE DELIM
	CAIE	T1,")"			;END OF INDICES?
;	  IOERR	(NRP,799,514,?,Missing right paren,)
	 $ACALL	NRP
	PUSHJ	P,SKPCHR		;SKIP THE RIGHT PAREN
	PUSHJ	P,NLNB			;AND GO TO NEXT DELIM
					;DON'T TOUCH T1 - CONTAINS DELIM
	MOVN	T2,NLOFF.		;Get negative offset	[3063]
	ADDB	T2,NLADD.		;ADD INTO ADDR
	XMOVEI	T3,@1(P2)		;GET ORIG BASE ADDR
	SUB	T3,T2			;GET NEG OFFSET TO DESIRED LOC
	JUMPLE	T3,OFFOK		;OK IF NEG OR ZERO
;	 IOERR	(ILS,799,516,?,Illegal subscript,)
	 $ACALL	ILS			;?Illegal subscript
OFFOK:	IDIV	T3,NLSIZ.		;GET NEG # ENTRIES IN OFFSET
	MOVE	T2,NLEMS.		;Get total entries in array	[3063]
	ADD	T2,T3			;GET # ENTRIES LEFT
	MOVEM	T2,NLNUM.		;SAVE IT
	JUMPG	T2,%POPJ		;OK IF .GT. ZERO
	 $ACALL	ILS			;?Illegal subscript

;[3063]
;CALCHR: is the analog of CALADD. We process the indices of a character
;	array reference, utilizing ADJBP to calculate the address of the
;	referenced element. If the element is out of bounds, by virtue
;	of beginning before the actual start of the array, or of being
;	the nth +1 or greater element of the array, a fatal error has
;	occurred. When we leave this routine, NLNUM. = the number of
;	elements left in the array, including the one just identified.
;	When all of the dimensions have been processed, and the element's
;	address is known, we look for a substring identifier. If one
;	is found, we process it and set SS.ADD = substring address,
;	and SS.SIZ = substring size, else SS.ADR and SS.SIZ = zero.

CALCHR:	DSETZM	SS.ADR			;Reset substring indicator
	SKIPN	P3,NLDIM.		;Array? (P3=dimensions to process)
	 JRST	ENDIMS			;NO. Go check for substring
	MOVE	P2,NLVAR.		;Get variable entry pointer


	CAIE	T1,"("			;LEFT PAREN?
	 POPJ	P,			;NO. ENTIRE ARRAY
	MOVE	P4,NLFCT.		;P4 points to factors
	XMOVEI	T1,NLVAL.		;POINT TO VALUE
	MOVEM	T1,IO.ADR		;FOR %INTI
	SETZM	IO.SIZ			;Initialize counter
ADCLP1:	PUSHJ	P,%INTI			;GET AN INTEGER
	MOVE	T2,NLVAL.		;Get value
	IMUL	T2,(P4)			;MULTIPLY BY A FACTOR
	ADDM	T2,IO.SIZ		;Count it
	PUSHJ	P,NLSDEL		;GET THE NEXT DELIMITER
	SOSLE	P3			;Done if no more dimensions
	 AOJA	P4,ADCLP1		;Go add in next factor

ADCLPD:	PUSHJ	P,GETDEL		;GET THE DELIM
	CAIE	T1,")"			;Proper delimiter of indices?
	 $ACALL	NRP			; "? Missing right paren"
	PUSHJ	P,SKPCHR		;SKIP THE RIGHT PAREN
	PUSHJ	P,NLNB			;AND GO TO NEXT DELIM
					;DON'T TOUCH T1 - CONTAINS DELIM
	MOVN	T2,NLOFF.		;Get negative offset
	ADDB	T2,IO.SIZ		;Calculate real offset
	SKIPGE	T2			;OK if positive
	 $ACALL	ILS			;"Illegal subscript"
	ADJBP	T2,NLADD.		;Adjust the pointer
	MOVEM	T2,NLADD.		;Store new pointer
	MOVN	T2,IO.SIZ		;Negative offset
	IDIV	T2,NLSIZ.		;Calc elements
	ADDB	T2,NLNUM.		;Calc elements left
	JUMPG	T2,ENDIMS		;OK if .GT. zero
	 $ACALL	ILS			;"? Illegal subscript"

ENDIMS:	TDNN	P1,FINFLG		;LEAVE IF DONE
	CAIE	T1,"("			;Is there sub-string info?
	 POPJ	P,			;NO
	PUSHJ	P,SKPCHR		;Skip "("

SUBSTR:
	XMOVEI	T1,NLVAL.		;Point to value
	MOVEM	T1,IO.ADR		;For %INTI
	MOVEI	T2,1			;Assume character position 1
	MOVEM	T2,NLVAL.		;Store default position
	PUSHJ	P,NLNB			;Get next non-blank
	CAIN	T1,":"			;Null value?
	 JRST	SUB1			;YES.
	PUSHJ	P,%IBACK		;Point to beginning
	PUSHJ	P,%INTI			;Get the 1st character position
	MOVE	T1,NLSIZ.		;Full element size
	EXCH	T1,NLVAL.		;Assume substring runs to last char
	CAMLE	T1,NLVAL.		;First character within element?
	 $ACALL	ISS			;"Illegal substring descriptor"
	SOSGE	T1			;Relative character position > zero?
	 $ACALL	ISS			;"Illegal substring descriptor"
	MOVNM	T1,SS.SIZ		;Save (NEG) 1ST char relative position
	ADJBP	T1,NLADD.		;Substring pointer
	MOVEM	T1,SS.ADR		;Store substring pointer
	PUSHJ	P,GETDEL		;Get the delimiter
	CAIE	T1,":"			;Is it the right one?
	 $ACALL	NEC			;"? Got $C when expecting ":""
SUB1:	PUSHJ	P,SKPCHR		;Skip ":"
	PUSHJ	P,NLNB			;Get the next delimiter
	CAIN	T1,")"			;End of substring descriptor?
	 JRST	SUB2			;YES.
	PUSHJ	P,%IBACK		;Backup for %INTI
	PUSHJ	P,%INTI			;Get ending character position
SUB2:	MOVE	T1,NLVAL.		;Load last character position
	CAMLE	T1,NLSIZ.		;Character position within element?
	 $ACALL	ISS			;"? Illegal substring descriptor"
	ADDB	T1,SS.SIZ		;Calculate substring length
	SKIPG	T1			;Positive length?
	 $ACALL	ISS			;"? Illegal substring descriptor"
	PUSHJ	P,GETDEL		;Get the delimiter
	CAIE	T1,")"			;Is it the right one?
	 $ACALL	NRP			;"? Missing right paren"
	PUSHJ	P,SKPCHR		;Skip right paren
	PJRST	NLNB			;Get next delimiter and return

	SEGMENT	DATA
SS.ADR:	BLOCK	1
SS.SIZ:	BLOCK	1
	SEGMENT	CODE

;VARNAM & NLINAM - ASSEMBLES A VARIABLE NAME OR NAMELIST
;NAME FROM THE DATA. IF A NAME ALREADY EXISTS IN NLNAM., JUST RETURNS
VARNAM:	SKIPE	NLNAM.			;IF IT WAS NON-ZER
	 POPJ	P,			;IT WAS A BAD LOGIC VALUE
NLINAM:	SETZM	NLNAM.			;CLEAR NAME
	SKIPE	DLFLG.			;ARE WE AT END OF PREVIOUS DATA SCAN?
	 PUSHJ	P,NLSDEL		;YES. SCAN FOR THE DELIMITER
	PUSHJ	P,NLNB			;GET NON-BLANK CHAR
	TDNE	P1,FINFLG		;END OF DATA?
	 POPJ	P,			;YUP
	SKIPE	NLFLG.			;ERROR IF NULL ENTRY (COMMA FOUND)
	 TDNN	P1,NLVFC.		;MUST BEGIN WITH ALPHA
;	  IOERR	(ILN,799,515,?,Variable or namelist does not start with letter,)
	 $ACALL	ILN
	MOVEI	P2,6			;6 CHARS TOTAL
	SKIPA	P3,[POINT 6,NLNAM.]	;SIXBIT PNTR, ALREADY GOT 1ST CHAR
NLINL1:	PUSHJ	P,GETCHR		;GET NEXT CHAR
	TXNN	P1,ALFLAG+DIGFLG	;ALPHA OR DIGIT?
	 POPJ	P,			;NO. RETURN
	CAIL	T1,140			;CONVERT TO SIXBIT
	 SUBI	T1,40
	SUBI	T1,40
	IDPB	T1,P3			;SAVE IT
	SOJG	P2,NLINL1		;MAX 6 CHARS
;	PJRST	NLNA			;THEN SCAN FOR NON-ALPHAMERIC

;SCAN FOR NON-ALPHAMERIC
NLNA:	PUSHJ	P,GETCHR		;GET A CHAR
	TXNE	P1,ALFLAG+DIGFLG	;ALPHA OR DIGIT?
	JRST	NLNA			;YES. SKIP IT
	POPJ	P,			;NO. RETURN

;NLVSRH - SEARCH FOR A VARIABLE NAME IN THE NAMELIST
;BLOCK. THE NUMBER OF ENTRIES TAKEN BY A VARIABLE IN THE NAMELIST
;BLOCK IS DEPENDENT ON ITS DIMENSIONALITY.
NLVSRH:	TXZ	P1,NLSFLG		;CLEAR SEARCH FOUND FLAG
	MOVE	T3,NLARG.		;GET THE ARG PNTR
	ADDI	T3,1			;POINT TO 1ST VARIABLE
NLVLP1:	SKIPE	T1,(T3)			;GET VARIABLE NAME
	CAMN	T1,FINCOD		;0 OR END CODE IS END
	 POPJ	P,			;RETURN IF END OF LIST
	CAMN	T1,NLNAM.		;VARIABLE WE WANT?
	 JRST	NLVFND			;YES!
	LDB	T2,[POINT 7,1(T3),8]	;NO, GET # DIMS
	ADDI	T3,2			;ASSUME SCALAR
	JUMPE	T2,NLVLP1		;BACK IF SCALAR
	SKIPGE	-1(T3)			;Size and offset in half-words?[3063]
	AOJ	T3,			;NO. block is one word longer  [3063]
	ADDI	T3,1(T2)		;MORE JUNK IF ARRAY
	JRST	NLVLP1

NLVFND:	TXO	P1,NLSFLG		;SET FOUND FLAG
	MOVEM	T3,NLVAR.		;SAVE PNTR
	POPJ	P,



;NLMAIN - THIS IS THE MAIN NAMELIST AND LIST-DIRECTED I/O
;ROUTINE. USING THE VARIABLE PARAMETERS SET UP FOR IT
;(NLADD.,NLSIZ.,NLINC.,NLNUM.) IT SCANS FOR A VALUE AND
;REPEAT COUNT IF THE REPEAT COUNT IS ZERO, DOES THE
;APPROPRIATE VALUE CONVERSION, STORES THE VALUE FOUND
;INTO THE USER'S VARIABLE (OR ARRAY ENTRY), AND DOES ALL
;THE APPROPRIATE INCREMENTING AND DECREMENTING OF THE
;VARIABLE PARAMETERS AND REPEAT COUNT.
;
;If the destination variable is of type character, jump to
;VARCHR to perform byte-string instructions, and to check
;whether pointers are set to beginning of repeated string.
;As before, non-character variables will be filled from
;Hollerith strings, with each loop through NLP picking up
;the next five (single precision) or ten (double precision)
;bytes from the input string. The string has been padded
;with sufficient spaces (maximum of 9) to allow creation
;of a single or double precision variable via a MOVE-MOVEM
;or DMOVE-DMOVEM instruction pair. These spaces are not
;included in the string count. When the string is
;exhausted, the pointers are reset to the beginning of the
;string, and if the repeat count is not zero, the next
;destination variable (if non-character) will be filled
;using the current string.

NLMAIN:
NLP:	SKIPN	NLRP.			;REPEAT COUNT?
NLVAL:	 PUSHJ	P,NLSCV			;NO. GET VALUE & REPEAT COUNT
	SKIPGE	T1,NLFLG.		;DID WE GET A VALUE?
	 POPJ	P,			;NO. LEAVE
	JUMPE	T1,FULVAL		;JUST DECR REPEAT COUNT IF NULL
	MOVE	T1,VARTYP		;GET VARIABLE TYPE
	CAIN	T1,TP%CHR		;Type character?
	 JRST	VARCHR			;YES. special processing
	CAME	T1,CNVTYP		;DID WE CONVERT YET?
	 PUSHJ	P,NLACNV		;NO. CONVERT TO DESIRED FORMAT
	DMOVE	T1,NLCVL.		;LOAD THE VALUE
	MOVE	T3,NLSIZ.		;MAKE SURE WE STORE IT RIGHT
	XCT	NLSTOR(T3)
FULVAL:	SETOM	NLFV.			;FILLED A VARIABLE
	PUSHJ	P,NLRPI			;PROCESS VALUE PNTR/COUNTS
	MOVE	T1,NLINC.		;INCR ARRAY POINTER
	ADDM	T1,NLADD.
	SOSLE	NLNUM.			;DECR COUNT
	 JRST	NLP			;LOOP IF MORE
	POPJ	P,


;NLSTOR - A LITTLE TABLE USED TO STORE THE FINAL VALUES
;INTO THE USER'S VARIABLES. IT IS INDEXED BY THE ENTRY SIZE
;(EITHER 1 OR 2) EXTRACTED FROM %SIZTB. THIS WILL ABSOLUTELY
;NOT WORK FOR A KA-10!!!
NLSTOR:	JFCL
	MOVEM	T1,@NLADD.
	DMOVEM	T1,@NLADD.
;VARCHR:
;Variables of type character, however, use one string per
;destination variable. VARCHR resets NLCPTR and NLCWRD,
;decrements NLRP. if the preceding variable did not exhaust
;the string, and if NLRP. is zero, loops back to NLVAL to
;get another value. When VARCHR has an appropriate value,
;it moves the string and jumps back in line. NLRPI has
;been taught to reset the pointers and decrement NLRP.
;for each destination variable of type character.

VARCHR:	MOVE	T1,NLSWRD		;Beginning word count
	CAME	T1,NLCWRD		;Are we in the middle of a string?
	 PUSHJ	P,RSTPTR		;YES. Reset ptr and decr repeat count
	SKIPN	NLRP.			;Still repeat count?
	 JRST	NLVAL			;NO. Go input another variable
	MOVE	T1,VALTYP		;Get input variable type
	CAIE	T1,TP%LIT		;Input type literal?
	 $ACALL	SNQ			;"? String not within single quotes"
	MOVE	T0,NLSBYT		;Source string count
	MOVE	T1,NLSPTR		;Source byte pointer
	SKIPN	T3,SS.SIZ		;Is it a substring?	[3063]
	 MOVE	T3,NLSIZ.		;NO.
	SKIPN	T4,SS.ADR		;Is it a substring?	[3063]
	 MOVE	T4,NLADD.		;NO.
	EXTEND	T0,[MOVSLJ
			" "]		;Move the string with space fill
	 TRNN				;Ignore truncation (NO-OP)
	SETOM	NLFV.			;FILLED A VARIABLE
	PUSHJ	P,NLRPI			;PROCESS VALUE PNTR/COUNTS
	SOSG	NLNUM.			;Any more elements?
	 POPJ	P,			;NO...quit
	DSETZM	SS.ADR			;Reset substring stuff	[3063]
	MOVE	T1,NLINC.		;Get array increment
	ADJBP	T1,NLADD.		;Adjust destination byte pointer
	MOVEM	T1,NLADD.		;Store new pointer
	 JRST	NLP			;Loop thru next element

;NLSCV - NAMELIST AND LDIO SCAN FOR A VALUE
;
;THIS ROUTINE SCANS FOR A VALUE AND REPEAT COUNT
;IT BEGINS ITS SCAN IN DOUBLE PRECISION, SO THAT NO
;PRECISION WILL BE LOST IF SOMEWHERE TOWARD THE END OF
;A LIST WE FIND A VARIABLE WHICH IS DOUBLE PRECISION
;WHICH IS STILL COVERED BY A DATA REPEAT COUNT.
;IF "*" FOUND AS DELIMITER, SET THE REPEAT COUNT,
;AND SCAN AGAIN IN DOUBLE PRECISION.
;IF "*" NOT FOUND, SET REPEAT COUNT TO 1 AND RETURN WITH
;VALUE=VALUE FOUND.

NLSCV:	SETZM	NLRP.			;CLEAR THE REPEAT COUNT
	SETZM	VALTYP			;Clear input variable type
	MOVEI	T1,TP%DPR		;SCAN FIRST FOR D.P.
	MOVEM	T1,TOTYPE
	MOVEI	T1,1			;SET REPEAT COUNT TO 1
	MOVEM	T1,NLRP.		;MIGHT FILL NLRP. IN SETNUL
	PUSHJ	P,NLSCAN		;SCAN FOR VALUE
	SKIPG	NLFLG.			;LEAVE IF END DATA OR NULL
	 POPJ	P,			;OH, WELL
	PUSHJ	P,NLSDER		;NO. GET THE DELIMITER
	CAIE	T1,"*"			;REPEAT COUNT?
	 POPJ	P,			;NO. LEAVE
	MOVE	T1,VALTYP		;GET THE VALUE TYPE
	CAIN	T1,TP%DPR		;DOUBLE REAL?
	 SKIPE	%FLINF			;YES. ANY "." OR EXPONENT
	  JRST	RPERR			;NOT REAL OR DOT/EXP FOUND
	MOVEI	T1,TP%INT		;YES. CONVERT TO INTEGER
	MOVEM	T1,TOTYPE
	PUSHJ	P,NLCNV			;DO THE CONVERSION
	MOVE	T1,NLCVL.		;GET THE CONVERTED VALUE
	JUMPL	T1,RPERR		;ERROR IF NEGATIVE
	MOVMM	T1,NLRP.		;SAVE THE REPEAT COUNT
	MOVEI	T1,TP%DPR		;D.P. AGAIN
	MOVEM	T1,TOTYPE		;Set acceptable input type
	PUSHJ	P,SKPCHR		;SKIP THE *
	SETZM	NLFV.			;DON'T SKIP A COMMA
	PJRST	NLSCAN			;GO GET NEXT VALUE

;THE FOLLOWING CODE SHOULD BE SUBSTITUTED FOR
;	PUSHJ	P,SKPCHR
;	PJRST	NLSCAN
;ABOVE, IFTHE ANSI COMMITTEE DECIDES EVENTUALLY THAT 3*<BLANK>4 SHOULD
;BE READ AS 3*,4 (3 NULL VALUES, THEN A 4). AS OF NOW, THE
;COMMITTEE'S PRELIMINARY DECISION HAS BEEN TO ALLOW BOTH
;INTERPRETATIONS. MUCH OF THE INDUSTRY, AS WELL AS
;PDP-11 AND VAX FORTRAN-77, READ THE BLANK AS A VALUE SEPARATOR,
;AND, THEREFORE, AS 3*,4.
REPEAT 0,<
	PUSHJ	P,GETCHR		;GET THE NEXT CHAR
	PUSHJ	P,CHKDLM		;CHECK FOR NON-BLANK CHAR
	PJRST	NLSCAR			;AND GET THE VALUE
>;END REPEAT 0

RPERR:	;IOERR	(RPE,799,521,?,Illegal repeat count,)
	$ACALL	RPE
;NLSCAN - SCAN FOR AN INDIVIDUAL VALUE
;CNVTYP IS SET FOR NO CONVERSION DONE YET, SO THAT THE TEST IN
;NLMAIN WILL FORCE A CONVERSION TO THE APPROPRIATE TYPE.
;THE FIRST CHARACTER OF DATA IS CHECKED FOR ITS VALIDITY
;BY MATCHING ITS ASSOCIATED FLAG (IN P1) AGAINST THE "VALID FIRST CHARACTER
;FLAG LIST" (NLFLST). IF THERE IS NO MATCH, IT IS EITHER A BAD CHARACTER
;IN DATA OR THE BEGINNING OF THE NEXT VARIABLE NAME (NAMELIST ONLY).
;THAT TEST IS DONE BY SETNUL.
NLSCAN:	SKIPE	DLFLG.			;ARE WE AT END OF PREVIOUS DATA SCAN?
	 PUSHJ	P,NLSDEL		;YES. SCAN FOR THE DELIMITER
	PUSHJ	P,NLNB			;GET NEXT NON-BLANK CHAR
NLSCAR:	SETOM	CNVTYP			;SET NO CONVERSION DONE YET
	SKIPG	NLFLG.			;NON-NULL VALUE FOUND?
	 POPJ	P,			;NO. LEAVE
NLSCN1:	PUSHJ	P,SGNTST		;TEST FOR SIGN
	MOVEI	T2,NLFLST		;GET FLAG LIST FOR SCAN
	PUSHJ	P,NLFSRH		;SCAN THE LIST
	TXNN	P1,NLSFLG		;FOUND?
	 JRST	SETNUL			;NO. TRY FOR NEW VARIABLE
	MOVEI	P2,(T2)			;COPY INDEX TO TABLES
	PUSHJ	P,%IBACK		;MOVE PNTR BACK TO 1ST CHAR
	DSETZM	NLVAL.			;INIT LOW VALUE WORDS
	SETOM	DLFLG.			;SET FLAG TO SCAN FOR DELIM
	XMOVEI	T1,NLVAL.		;GET ADDR TO STORE RESULT
	MOVEM	T1,IO.ADR		;SAVE IT
	MOVE	T1,NLTYPE(P2)		;GET TYPE
	MOVEM	T1,VALTYP		;SAVE IT
	CAIN	T1,TP%DPR		;IS IT DOUBLE REAL?
	 SETZ	T1,			;YES. GIVE 0 SO FLIRT WON'T CONVERT
	MOVEM	T1,IO.TYP		;SAVE TYPE FOR I/O ROUTINE
	XCT	T1,NLSUB(P2)		;DO READ
	PUSHJ	P,GETDEL		;GET THE DELIMITER, SET FLAGS
	TDNE	P1,LDLFLG		;LEGAL DELIMITER AT END OF SCAN?
	 POPJ	P,			;YES
	$ACALL	ILC			;NO. ILLEGAL CHAR

;CHECK FOR THE VALIDITY OF THE PRESENCE OF A VARIABLE NAME.
;THIS IS THE ONLY PLACE IN THE CODE WHERE WE HAVE TO CHECK EXPLICITLY
;WHETHER WE ARE DOING NAMELIST OR LIST-DIRECTED I/O. A VARIABLE NAME
;IN THE DATA IS CLEARLY ILLEGAL IN LIST-DIRECTED I/O, AND IS ILLEGAL
;IF IT FOLLOWS DIRECTLY AFTER THE LAST "VARIABLE=" SEQUENCE, THAT IS,
;BEFORE A VARIBLE HAS BEEN FILLED WITH ANY DATA.
;WE USE A SPECIAL LOCATION - NLVFC. (NAMELIST VARIABLE 1ST CHAR)
;WHICH HAS THE FLAGS ALLOWED FOR THE FIRST CHARACTER OF A VARIABLE.
;FOR NAMELIST, THIS IS SET TO "ALFLAG" TO INDICATE THAT VARIABLE
;NAMES MUST START WITH ALPHABETIC CHARACTERS. IT IS SET TO
;ZERO FOR LIST-DIRECTED I/O TO INDICATE THAT VARIABLE NAMES ARE
;NOT ALLOWED FOR LIST-DIRECTED I/O.
;IF EVERYTHING IS LEGAL, THE REST OF THE DATA IS SET TO NULL,
;THAT IS, THE DATA FLAG IS SET TO ZERO (INDICATING A NULL) AND THE
;DATA REPEAT COUNT IS SET TO THE LEFTOVER ARRAY ENTRY COUNT.

SETNUL:	TDNE	P1,NLVFC.		;THIS CHARACTER ALLOWED?
SETNL1:	 SKIPN	NLFV.			;VARIABLE FILLED YET?
	  JRST	CHKCV			;[4153] NOT ALLOWED, OR VAR NOT FILLED
	SETZM	NLFLG.			;SET FLAG FOR NULL VALUE
	SETZM	NLNUM.			;[2037] NO ELEMENTS LEFT
	SETZM	NLRP.			;[2037] NO REPEAT COUNT YET.
	POPJ	P,

CHKCV:	MOVE	T1,VARTYP		;[4153] GET DESIRED VARIABLE TYPE
	CAIE	T1,TP%CHR		;[4153] CHARACTER?
	 $ACALL ILC			;[4153] NO. "ILLEGAL CHARACTER IN DATA"
	$ACALL	SNQ			;[4153] YES. MUST BE IN SINGLE QUOTES

;SIGN TEST - ACCUMULATES THE SIGN IN FRONT OF A DATA ELEMENT
;AND STUFFS IT AWAY IN NLSGN. ALTHOUGH THE ANSI STANDARD DOESN'T
;ALLOW IT, WE HERE ALLOW MULTIPLE SIGNS (AND DO THE "APPROPRIATE"
;THING, SO THAT --++--- COMES OUT JUST A SINGLE MINUS).
;HOWEVER, IS IS QUITE IMPORTANT THAT A TEST BE PERFORMED AFTER
;A SIGN IS FOUND - THAT A VALID CHARACTER IS FOUND AFTER IT
;FOR THE FIRST CHARACTER OF DATA. SO WE CALL NLFSRH WITH
;THE VALID CHARACTER FLAG LIST, AND GIVE AN ERROR IF THERE IS
;NO CHARACTER FLAG MATCH.
SGNTST:	SETZM	NLSGN.			;+=0, -=-1
	TXNN	P1,SGNFLG		;IS THE CHAR A SIGN?
	 JRST	SGNEND			;NO. MOVE BACK PNTR
SGNLP:	CAIN	T1,"-"			;IS IT A MINUS?
	 SETCMM	NLSGN.			;YES. NEGATE THE SIGN
	PUSHJ	P,GETCHR		;SKIP THE CHAR
	PUSHJ	P,NLNBER		;GET THE NEXT NON-BLANK
	SKIPG	NLFLG.			;NULL VALUE?
;	 IOERR	(SNV,799,522,?,Sign with null value,)
	 $ACALL	SNV
	TXNE	P1,SGNFLG		;ANOTHER SIGN?
	 JRST	SGNLP			;YES. GO TEST IT
	MOVEI	T2,NLFLST		;NO. CHECK IN VALID DATA LIST
	PUSHJ	P,NLFSRH
	TXNN	P1,NLSFLG		;MATCH?
	 $ACALL	SNV			;Sign with null value
SGNEND:	POPJ	P,

;NLFSRH - FLAG MATCH SEARCH - THIS SEARCHES A LIST OF
;FLAGS (ADDR SPECIFIED IN T2) FOR A MATCH (LOGICAL
;INTERSECTION) WITH THE FLAGS IN P1, AND PROVIDES THE MATCHING
;INDEX.
NLFSRH:	MOVEI	T3,(T2)			;SAVE THE LIST PNTR
NLFLP:	SKIPN	(T2)			;DONE WITH LIST?
	 JRST	NLNFND			;YES. LEAVE
	TDNN	P1,(T2)			;NO. FLAG MATCH?
	 AOJA	T2,NLFLP		;NO. TRY AGAIN
	TXO	P1,NLSFLG		;YES. SET FOUND FLAG
NLNFND:	SUBI	T2,(T3)			;GET RELATIVE INDEX
	POPJ	P,
;NLCNV - VALUE CONVERSION ROUTINE
;DECIDES WHICH CONVERSION TO DO BY RETRIEVING A CONVERSION
;TABLE ADDR INDEXED BY THE VALUE TYPE, THEN SEARCHES IN THE
;TABLE FOR THE VARIABLE TYPE, AND CALLS THE CORRESPONDING
;CONVERSION ROUTINE.
;NOTE THAT FOR MOST OF THE VALUE/VARIABLE TYPES, WE SIGNAL
;THAT THE CONVERSION HAS BEEN DONE BY PLACING THE CONVERTED TYPE
;IN CNVTYP. FOR ALPHAMERIC CONSTANTS, THIS CANNOT BE DONE, SINCE
;STRING DATA HAS A DIFFERENT SOURCE/REPEAT COUNT MECHANISM THAN
;THE THE OTHER DATA TYPES.

NLACNV:	SKIPN	T1,VARTYP		;RECORD VARIABLE TYPE
	 MOVEI	T1,TP%INT		;DEFAULT IS INTEGER
	MOVEM	T1,TOTYPE
NLCNV:	MOVE	T2,TOTYPE		;GET TYPE DESIRED
	CAMN	T2,CNVTYP		;SAME AS LAST CONV?
	 POPJ	P,			;YES. FORGET IT
	DSETZM	NLCVL.			;INIT CONVERTED VALUES
	MOVE	T3,VALTYP		;GET VALUE TYPE
	CAIE	T3,TP%LIT		;DON'T SIGNAL CONV IF ALPHA
	 MOVEM	T2,CNVTYP		;BUT DO IF ANYTHING ELSE
	MOVE	T1,CNVLST(T3)		;GET CONVERSION LIST ADDR/COUNT
	JUMPGE	T1,BADCNV		;NO CONVERSION!
CNVLP:	HLRE	T2,(T1)			;GET A "TO" TYPE
	JUMPL	T2,GOTCNV		;A MATCH IF NEGATIVE
	CAME	T2,TOTYPE		;DESIRED TYPE?
	 AOBJN	T1,CNVLP		;NO. TRY AGAIN
	JUMPGE	T1,BADCNV		;A LOSER IF TABLE GONE
GOTCNV:	HRRZ	T1,(T1)			;GET THE CONV ADDR
	PUSHJ	P,(T1)			;DO THE CONVERSION
	SKIPL	NLSGN.			;WAS IT MINUS?
	 POPJ	P,			;NO
	DMOVN	T1,NLCVL.
	DMOVEM	T1,NLCVL.		;YES. SAVE IT NEGATIVE
	POPJ	P,

;NLNB - SCAN FOR NON-BLANK
;SKIPS BLANK-TYPE CHARS, RETURNS ON ANY OTHER CHARACTER
;(EXCEPT SKIPS END-OF-LINE ALTOGETHER)
;RETURNS -1 IF END OF DATA, 0 IF NULL, & 1 IF
;NON-NULL

NLNB:	PUSHJ	P,GETDEL		;GET CURRENT CHAR
	SKIPE	NLFV.			;DON'T SKIP FIRST COMMA
	TXNN	P1,COMFLG		;COMMA TO SKIP?
	TXNE	P1,EOLFLG		;ARE WE AT EOL?
	 PUSHJ	P,SKPCHR		;YES. SKIP IT
	SETZM	DLFLG.			;CLEAR SCAN FOR DELIM FLAG
	SETOM	NLFLG.			;SET FLAG FOR EOF
	JRST	NLNB1			;Go to loop, got first character

NLNB0:	PUSHJ	P,GTCHRL		;Get next char, skip eor
NLNB1:	PUSHJ	P,BERSCN		;Process character
	 POPJ	P,			;Done, return
	JRST	NLNB0			;Loop until done.

;NLNBER - SPECIAL SCAN FOR USE WITH THE REPEAT COUNT.
;THIS SCAN IS LIKE NLNB, BUT IT STOPS
;AT END OF RECORD (THAT IS, IT USES GETCHR INSTEAD OF GTCHRL).
NLNBER:	SETZM	DLFLG.			;CLEAR THE SCAN FOR DELIM FLAG
	SETOM	NLFLG.			;SET FLAG FOR EOF
	PUSHJ	P,GETDEL		;GET LAST DELIM
	JRST	NLNBR1			;Already got first char.

NLNBR0:	PUSHJ	P,GETCHR		;Get character, possibly EOL
NLNBR1:	PUSHJ	P,BERSCN		;Process character
	 POPJ	P,			;Done, return
	JRST	NLNBR0			;Loop

;Return .+1 if done, .+2 if need more characters.
BERSCN:	TDNE	P1,FINFLG		;EOF OR END OF DATA?
	 POPJ	P,			;YES. LEAVE
	TXNN	P1,COMFLG+EOLFLG	;COMMA OR EOL?
	 JRST	NOTCEL			;NO
	SETZM	NLFLG.			;SET FOR COMMA OR EOR
	POPJ	P,
NOTCEL:	TXNE	P1,SPCFLG+NULFLG	;SPACE OR TAB OR NULL?
	 JRST	%POPJ1			;Yes, skip them
	MOVEI	T2,1			;NO. SET FLAG FOR DATA
	MOVEM	T2,NLFLG.
	POPJ	P,

;NLEOL - SCAN FOR END OF RECORD (OR END OF FILE)
NLEOL:	PUSHJ	P,GETCHR		;GET A CHAR
	TXNN	P1,EOLFLG		;GO UNTIL EOL
	 JRST	NLEOL
	JRST	%SETAV			;Reset & return

;CHKDLM - CHECKS THE DELIMITER WE ARE CURRENTLY LOOKING AT
;AND TREATS IT LIKE WE WERE DOING A FULL SCAN, SETTING NLFLG.
;TO -1 IF END DATA, ZERO IF NULL, SPACE, EOL, OR COMMA, AND
;+1 IF OTHER CHAR
CHKDLM:	SETOM	NLFLG.			;INIT FOR END OF DATA
	TDNE	P1,FINFLG		;END OF DATA?
	 POPJ	P,			;YES. LEAVE
	SETZM	NLFLG.			;NO. PREPARE FOR NULL ITEM
	TXNN	P1,COMFLG+SPCFLG+NULFLG	;NULL ITEM?
	 AOS	NLFLG.			;NO. SET FOR NON-NULL
	POPJ	P,

;NLSDEL - SCAN FOR A DELIMITER
;STARTS SCANNING WITH THE CURRENT CHAR (VIA GETDEL).
NLSDEL:	PUSHJ	P,GETDEL		;GET CURRENT CHAR
	TXNE	P1,EOLFLG		;ARE WE AT EOL?
	 PUSHJ	P,SKPCHR		;YES. SKIP TO NEXT LINE
	SETZM	DLFLG.			;CLEAR SCAN FOR DELIM FLAG
	JRST	NLSDL1			;Go start loop

NLSDL0:	PUSHJ	P,GTCHRL		;Get a character	[3063]
NLSDL1:	TDNN	P1,FINFLG		;EOF OR END OF DATA?
	TXNE	P1,COMFLG		;OR COMMA
	 POPJ	P,			;YES. LEAVE
	TXNE	P1,SPCFLG+NULFLG	;SPACE OR TAB OR NULL?
	 JRST	NLSDL0			;YES. SKIP IT
	POPJ	P,

;NLSDER - SCANS FOR A DELIMITER, BUT STOPS AT END OF RECORD
NLSDER:	PUSHJ	P,GETDEL		;GET THE LAST DELIM
NLSDRL:	TDNN	P1,FINFLG		;EOF OR END OF DATA?
	TXNE	P1,EOLFLG		;END OF RECORD?
	 POPJ	P,			;YES. LEAVE
	TXNE	P1,COMFLG+EOLFLG	;OR, COMMA OR EOL?
	 JRST	DELOFF			;YES. GOT DELIM
	TXNN	P1,SPCFLG+NULFLG	;SPACE OR TAB OR NULL?
	 JRST	DELOFF			;NO. GOT DELIM
	PUSHJ	P,GETCHR		;Get character, (could get eol)
	JRST	NLSDRL			;Loop

DELOFF:	SETZM	DLFLG.			;CLEAR SCAN FOR DELIM FLAG
	POPJ	P,

;NLGETB - GET THE BEGINNING OF THE NAMELIST - ALL
;NAMELIST DATA SHOULD BEGIN WITH A "$" OR "&" IN COLUMN 2
;OF THE "CARD" (IBM STRIKES AGAIN!).
NLGETB:	PUSHJ	P,%RIPOS			;GET CURRENT POSITION
	CAILE	T1,2			;WILL NEXT CHAR BE COL 2 OR LESS?
	 JRST	GTNREC			;NO. GET NEXT RECORD
	MOVEI	T1,2			;GET FROM POSITION 2
	PUSHJ	P,%SIPOS		;SET IT
	PUSHJ	P,GETCHR		;GET IT
	TXNE	P1,NLEFLG		;NAMELIST BEG/END FLAG?
	  POPJ	  P,			;  YUP
GTNREC:	PUSHJ	P,%IRECS		;NO. GO TO NEXT LINE
	 JRST	NLGETB			;NO

;GETDEL - GETS THE CURRENT CHARACTER AND GOES TO SET THE FLAGS
;ASSOCIATED WITH THAT CHARACTER.
;
;GETCHR - GETS THE NEXT CHARACTER AND GOES TO SET FLAGS.

GETDEL:	PUSHJ	P,%RIPOS		;GET INPUT POSITION
	CAIG	T1,1			;AT COLUMN 1?
	 JRST	GETCHR			;YES. THERE IS NO PREVIOUS CHAR
	PUSHJ	P,%IBYTC		;GET CURRENT CHAR
	JRST	NLTST			;GO TEST IT
GETCHR:
IFN FTNLC1,<
	MOVE	T0,FLAGS(D)
	TXNN	T0,D%NML		;THIS TEST ONLY IF NMLST
	 JRST	GTCLSD			;NOT
	PUSHJ	P,%RIPOS			;GET CHAR POS
	CAIGE	T1,2			;SKIP IF .GE. 2
	PUSHJ	P,%IBYTE		;GET A CHAR
> ;END FTNLC1
GTCLSD:	PUSHJ	P,%IBYTE		;GET A CHAR
NLTST:	SETZ	P1,			;CLEAR FLAGS
	SKIPGE	IRCNT(D)		;END OF LINE?
	 TXO	P1,EOLFLG		;YES. SET FLAG
NLNEOF:	JUMPE	T1,NULFST		;SET NULL FLAG IF NULL
	CAIN	T1,11			;TAB CHAR?
	TXO	P1,SPCFLG		;YES. SET SPACE FLAG
	CAIGE	T1,40			;CONTROL CHAR?
	POPJ	P,			;YES. LEAVE
	CAIG	T1,100			;COULD IT BE ALPHA?
	JRST	NOTALP			;NO
	CAIG	T1,"z"			;UPPER OR LOWER ALPHA?
	CAIGE	T1,"a"
	CAIG	T1,"Z"
	CAIGE	T1,"A"
	POPJ	P,			;NO
	TXO	P1,ALFLAG		;YES. SET FLAG
	CAIE	T1,"T"			;T OR F SETS LOGFLG
	CAIN	T1,"t"
	TXO	P1,LOGFLG
	CAIE	T1,"F"
	CAIN	T1,"f"
	TXO	P1,LOGFLG
	POPJ	P,

NOTALP:	TDOA	P1,NLCFLG-40(T1)	;SET CHAR FLAG
NULFST:	TXO	P1,NULFLG		;SET NULL FLAG
	POPJ	P,

;GTCHRL - GETS THE NEXT CHARACTER, AUTOMATICALLY GOING ON
;TO THE NEXT RECORD IF END-OF-RECORD IS REACHED.
;
;SKPCHR - IDENTICAL ENTRY TO GTCHRL, USED FOR ITS MNEMONIC VALUE
SKPCHR:
GTCHRL:	SKIPLE	IRCNT(D)		;END OF RECORD ALREADY?
	 JRST	GTCHR1			;NO. Go get a character
	PUSHJ	P,%IRECS		;YES. GET NEXT LINE
	MOVE	T0,FLAGS(D)		;Get flags
	TXNN	T0,D%NML		;Is this a NAMELIST request?
	 JRST	GTCHR1			;NO
	MOVE	T0,VALTYP		;Get input value type
	CAIE	T0,TP%LIT		;Are we in a character string?
	 JRST	GTCHR1			;NO. Proceed as always

;	IS NEXT CHECK REALLY NECESSARY?

	PUSHJ	P,GETCHR		;Get the first character
	TDNE	P1,FINFLG		;SAME
	 POPJ	P,			;  CHECKS
	TXNE	P1,EOLFLG		;    AS AT
	 JRST	NULCHR			;	"TESTL"
	CAIE	T1," "			;Real character; is it a space?
	 POPJ	P,			;NO, return with this character
GTCHR1:	PUSHJ	P,GETCHR		;GET A CHAR
TESTL:	TDNE	P1,FINFLG		;END OF DATA?
	POPJ	P,			;YES. LEAVE
	TXNE	P1,EOLFLG		;END OF LINE?
	JRST	NULCHR			;Yes, return a null char
	JUMPE	T1,GTCHRL		;SKIP IT IF NULL
	POPJ	P,

NULCHR:	MOVX	P1,NULFLG		;CREATE A NULL
	SETZ	T1,			;RETURN A NULL
	POPJ	P,
;NLRPI - REPEAT COUNT INCREMENT ROUTINE
;IF THE DATA IS AN ASCII STRING, THERE IS A COUNT AND PNTR ARRAY
;ASSOCIATED WITH THAT STRING.
;IF THERE IS A REPEAT COUNT IN ADDITION, WE ONLY DECREMENT IT
;WHEN THE STRING IS EXHAUSTED, THAT IS, WHEN THE COUNT IS 0.

;NLRPI now checks for destination variable of type character.
;If YES, the pointers are reset and NLRP. is decremented,
;since the there is a one-to-one correspondence between
;input and destination variables of type character.

NLRPI:	SKIPN	NLSWRD			;Is there a string?
	 JRST	DECRP			;NO. go decr repeat count
	MOVEI	T1,TP%CHR		;Type character
	CAMN	T1,VARTYP		;Is it?
	 JRST	RSTPTR			;YES. go reset pointers & return
	MOVE	T1,NLSIZ.		;Words used from string
	ADDM	T1,NLCPTR		;Update current pointer
	MOVN	T1,T1			;Negative
	ADDB	T1,NLCWRD		;Compute words left
	JUMPLE	T1,RSTPTR		;String exhausted?
	 POPJ	P,			;NO

;RSTPTR is an entry point from VARCHR to allow reset and
;decrement when a destination variable of type character
;follows one which is not, and the pointers have not yet
;been reset to the beginning of the string.

RSTPTR:	MOVE	T1,NLSPTR		;Pointer to beginning of string
	MOVEM	T1,NLCPTR		;Current pointer
	MOVE	T1,NLSWRD		;String count
	MOVEM	T1,NLCWRD		;Current count
DECRP:	SOSLE	NLRP.			;[3164]DECR REPEAT COUNT
	 POPJ	P,			;[3164]Leave if positive
	SETZM	NLSBYT			;[3164]Reset string byte count
	SETZM	NLSWRD			;[3164]Reset string word count
	POPJ	P,

;NLFLST IS THE LIST OF FLAGS ASSOCIATED WITH THE CHARACTERS
;WHICH ARE LEGAL FOR THE FIRST CHARACTER OF A DATA STRING.
;THE SUBROUTINE NLFSRH CHECKS THE FLAGS ASSOCIATED WITH
;THE FIRST CHARACTER OF A DATA STRING AND MATCHES THEM
;AGAINST THE FLAGS IN THIS LIST. THE MATCH LOCATION PROVIDES
;AN INDEX INTO NLTYPE, WHICH PROVIDES A TYPE SPECIFICATION
;(AT LEAST A GUESS...) FOR THE DATA STRING, AND INTO
;NLSUB, WHICH PROVIDES THE SUBROUTINE ADDRESS FOR PROCESSING
;THE DATA STRING. TWO OF THE SUBROUTINES (TDBL AND LOGI) ARE
;ACTUALLY "TRIAL" SUBROUTINES - THEY TRY TO DO THE ACTION
;INDICATED BY THE CHARACTER, BUT MAY END UP DOING SOMETHING
;VERY DIFFERENT INDEED. (FOR GREATER DETAIL, SEE COMMENTS ATTACHED
;TO THOSE SUBROUTINES).

NLFLST:	DIGFLG		;DIGIT
	PNTFLG		;PERIOD
	LOGFLG		;LOGICAL CHAR (T OR F)
	SQFLAG		;SINGLE QUOTE
	DQFLAG		;DOUBLE QUOTE
	LPRFLG		;LEFT PAREN
	0

NLTYPE:	TP%DPR
	TP%DPR		;INITIALLY ASSUME PERIOD IS D.P.
	TP%LOG		;INITIALLY ASSUME T OR F IS LOGICAL
	TP%LIT
	TP%DPO
	TP%CPX

NLSUB:	PUSHJ	P,%GRIN
	PUSHJ	P,TDBL
	PUSHJ	P,LOGI
	PUSHJ	P,ALPHI
	PUSHJ	P,OCTI
	PUSHJ	P,CPXI

;THIS IS THE CONVERSION TABLE LIST.
;THE ENTRY POSITION IS DETERMINED BY THE VALUE TYPE. THE LEFT HALF GIVES THE
;NEGATIVE # OF ENTRIES IN THE APPROPRIATE CONVERSION TABLE
;AND THE RIGHT HALF CONTAINS THE ADDRESS OF THE CONVERSION TABLE
CNVLST:	0				;0 - NO TYPE
	LOGCNV-LOGEND,,LOGCNV		;1 - LOGICAL
	0				;2 - INTEGER
	0				;3 -
	0				;4 - SINGLE REAL
	0				;5 -
	OCTCNV-OCTEND,,OCTCNV		;6 - SINGLE OCTAL
	0				;7 - LABEL
	DRCNV-DREND,,DRCNV		;10 - DOUBLE REAL
	0				;11 - DOUBLE INTEGER
	OCTCNV-OCTEND,,OCTCNV		;12 - DOUBLE OCTAL
	0				;13 - EXTENDED DOUBLE REAL
	CPXCNV-CPXEND,,CPXCNV		;14 - COMPLEX
	0				;15 - COBOL BYTE STRING
	0				;16 - CHARACTER
	ALPCNV-ALPEND,,ALPCNV		;17 - ASCIZ

;NLCFLG IS THE TABLE OF CHARACTER FLAGS. IF A CHARACTER IS WITHIN
;THE RANGE 40-100, THE CHARACTER TESTING ROUTINE NLTST GETS
;THE FLAG ASSOCIATED WITH THAT CHARACTER BY USING THE CHARACTER AS
;AN INDEX INTO THIS TABLE.
NLCFLG:	SPCFLG		;SPACE:40
	0		;!:41
	DQFLAG		;":42
	NSFLAG		;#:43
	DOLFLG		;$:44
	0		;%:45
	AMPFLG		;&:46
	SQFLAG		;':47
	LPRFLG		;(:50
	RPRFLG		;):51
	ASTFLG		;*:52
	PLSFLG		;+:53
	COMFLG		;COMMA:54
	MINFLG		;-:55
	PNTFLG		;PERIOD:56
	SLHFLG		;/:57
	DIGFLG		;0:60
	DIGFLG		;1:61
	DIGFLG		;2:62
	DIGFLG		;3:63
	DIGFLG		;4:64
	DIGFLG		;5:65
	DIGFLG		;6:66
	DIGFLG		;7:67
	DIGFLG		;8:70
	DIGFLG		;9:71
	COLFLG		;COLON:72
	SEMFLG		;SEMI:73
	LABFLG		;<:74
	EQUFLG		;=:75
	RABFLG		;>:76
	0		;?:77
	ATFLAG		;@:100
;THESE ARE THE CONVERSION TABLES. FOR EACH TYPE OF VALUE
;(OCT, LOG, DR, CPX, ALP) THERE IS AN ASSOCIATED TABLE WHICH
;GIVES, FOR EACH TYPE OF VARIABLE, THE APPROPRIATE CONVERSION
;ROUTINE ADDRESS. IN EACH TABLE THE VARIABLE TYPE IS IN THE LEFT
;HALF OF THE WORD AND THE APPROPRIATE CONVERSION ROUTINE ADDRESS
;IS IN THE RIGHT HALF. -1 IN THE LEFT HALF MEANS THAT THE ADDRESS
;IN THE RIGHT HALF IS THE ONE FOR THE
;CONVERSION ROUTINE FOR ALL VARIABLE TYPES (THIS IS TRUE FOR OCTAL
;AND LOGICAL DATA, FOR WHICH THERE IS REALLY NO CONVERSION).

LOGCNV:	-1,,OCTLOG
LOGEND==.

DRCNV:	TP%LOG,,DRLOG
	TP%INT,,DRINT
	TP%SPR,,DRSR
	TP%DPR,,DRDR
	TP%DPX,,DRDPX
	TP%CPX,,DRCPX
DREND==.

CPXCNV:	TP%LOG,,CPXLOG
	TP%INT,,CPXINT
	TP%SPR,,CPXSR
	TP%DPR,,CPXDR
	TP%DPX,,CPXDPX
	TP%CPX,,CPXCPX
CPXEND==.

ALPCNV:	TP%LOG,,ALPLOG
	TP%INT,,ALPINT
	TP%SPR,,ALPSR
	TP%DPR,,ALPDR
	TP%DPX,,ALPDR
	TP%CPX,,ALPCPX
ALPEND==.

OCTCNV:	TP%LOG,,OCTLOG
	TP%INT,,OCTINT
	TP%SPR,,OCTSR
	TP%DPR,,OCTDR
	TP%DPX,,OCTDR
	TP%CPX,,OCTDR
OCTEND==.
;THESE ARE THE ACTUAL DATA CONVERSION ROUTINES (BINARY TO
;BINARY FORM). NOTE THAT A "CONVERSION" NEVER DESTROYS
;THE ORIGINAL DATA OR ITS TYPE, BUT MERELY PUTS THE CONVERTED
;VALUE INTO NLCVL. THESE ROUTINES ASSUME THAT
;NLCVL/NLCVL.+1 HAVE BEEN INITIALIZED TO 0 AND THAT NLVAL./NLVAL.+1
;WERE INITIALIZED TO 0 BEFORE DATA WAS READ, SO THAT SINGLE
;PRECISION DATA (LOGIC) WILL YIELD 0 IN NLVAL.+1.

OCTDR:
OCTLOG:
OCTINT:
OCTSR:	DMOVE	T1,NLVAL.	;TRANSFER BOTH WORDS
	DMOVEM	T1,NLCVL.	;IT CAN'T HURT
	POPJ	P,

CPXDR:	DMOVE	T1,NLRFR		;GET REAL RAW FRACTION
	DMOVEM	T1,%FLRFR		;SAVE IT
	MOVE	T1,NLRBX		;GET REAL PART RAW EXPONENT
	MOVEM	T1,%FLRBX		;SAVE IT
	XMOVEI	T1,NLCVL.		;POINT TO CONVERTED VALUE
	MOVEM	T1,IO.ADR
	PJRST	%FLDPR			;CONVERT IT

DRDR:	XMOVEI	T1,NLCVL.		;POINT TO CONVERTED VALUE
	MOVEM	T1,IO.ADR
	PJRST	%FLDPR			;CONVERT IT

CPXLOG:
CPXSR:	DMOVE	T1,NLRFR		;GET REAL PART RAW FRACTION
	DMOVEM	T1,%FLRFR		;SAVE FOR CONVERT
	MOVE	T1,NLRBX		;GET REAL PART RAW EXPONENT
	MOVEM	T1,%FLRBX		;SAVE FOR CONVERT
	MOVE	T1,NLSGN1		;GET REAL PART SIGN
	MOVEM	T1,%FLFSG		;SAVE IT
	XMOVEI	T1,NLCVL.		;POINT TO CONVERTED VALUE
	MOVEM	T1,IO.ADR		;SAVE IT
	PJRST	%FLSPR			;GO CONVERT IT

DRLOG:
DRCPX:
DRSR:
	XMOVEI	T1,NLCVL.		;POINT TO CONVERTED VALUE
	MOVEM	T1,IO.ADR
	PJRST	%FLSPR			;CONVERT TO SINGLE PRECISION

CPXINT:	DMOVE	T2,NLRFR		;GET SAVED RAW FRACTION
	MOVE	T4,NLRBX		;AND BINARY EXPONENT
	MOVE	T1,NLSGN1		;GET SIGN OF REAL PART
	MOVEM	T1,%FLFSG		;SAVE IT
	JRST	XINT			;JOIN DRINT CODE

DRINT:
	DMOVE	T2,%FLRFR		;GET LEFT-JUSTIFIED FRACTION
	MOVE	T4,%FLRBX		;GET BINARY EXPONENT
	JUMPLE	T4,NOINT		;ZERO IF EXP .LE. 0
XINT:	SETZ	T1,			;CLEAR INTEGER
	TLNN	T3,(1B1)		;HI BIT IN LOW WORD ON?
	JRST	NORND			;NO
	CAME	T2,[377777,,777777]	;ABOUT TO OVERFLOW?
	AOJA	T2,NORND		;NO, ROUND UP
	MOVSI	T2,200000		;YES. LOAD A HIGH BIT
	ADDI	T4,1			;AND INCR BINARY EXPONENT

NORND:	CAILE	T4,^D35			;WILL WE SHIFT TO OBLIVION?
	JRST	INTOVL			;YES. RETURN OVERFLOW
	LSHC	T1,1(T4)		;SHIFT INTO INTEGER
	SKIPGE	%FLFSG			;LOCAL MINUS?
	 MOVN	T1,T1			;YES. NEGATE IT
	MOVEM	T1,NLCVL.		;STORE IT
NOINT:	POPJ	P,

INTOVL:	HRLOI	T1,377777		;RETURN LARGEST NUMBER
	SKIPGE	%FLFSG			;LOCAL MINUS?
	 MOVN	T1,T1			;YES. NEGATE IT
	MOVEM	T1,NLCVL.
	$ECALL	IOV			;%integer overflow
	POPJ	P,
CPXCPX:	DMOVE	T1,NLRFR		;GET REAL PART RAW FRACTION
	DMOVEM	T1,%FLRFR		;SAVE FOR CONVERT
	MOVE	T1,NLRBX		;GET RAW FRACTION
	MOVEM	T1,%FLRBX		;SAV FOR CONVERT
	MOVE	T1,NLSGN1		;GET REAL PART LOCAL SIGN
	MOVEM	T1,%FLFSG		;SAVE FOR CONVERT
	XMOVEI	T1,NLCVL.		;POINT TO REAL PART OF CONVERTED VALUE
	MOVEM	T1,IO.ADR
	PUSHJ	P,%FLSPR		;CONVERT TO SINGLE PRECISION
	DMOVE	T1,NLRFR2		;NOW THE SAME FOR IMAGINARY PART
	DMOVEM	T1,%FLRFR
	MOVE	T1,NLRBX2
	MOVEM	T1,%FLRBX
	MOVE	T1,NLSGN2
	MOVEM	T1,%FLFSG
	XMOVEI	T1,NLCVL.+1		;POINT TO IMAG PART OF CONVERTED VALUE
	MOVEM	T1,IO.ADR
	PJRST	%FLSPR			;CONVERT TO SINGLE PRECISION

ALPINT:
ALPLOG:
ALPSR:	MOVE	T1,NLCPTR		;Get address of word
	MOVE	T1,(T1)			;Get the word
	MOVEM	T1,NLCVL.		;Store it
	POPJ	P,

CPXDPX:	DMOVE	T1,NLRFR		;GET REAL PART RAW FRACTION
	MOVEM	T1,%FLRFR		;SAVE FOR CONVERT
	MOVE	T1,NLRBX		;SAME FOR RAW EXPONENT
	MOVEM	T1,%FLRBX
	MOVE	T1,NLSGN1		;GET REAL PART LOCAL SIGN
	MOVEM	T1,%FLFSG		;SAVE FOR CONVERT
DRDPX:	XMOVEI	T1,NLCVL.		;POINT TO CONVERTED VALUE
	MOVEM	T1,IO.ADR		;SAVE FOR CONVERSION ROUTINE
	PJRST	%FLGPR			;GO CONVERT IT TO G-FLOATING

ALPDR:
ALPCPX:
	MOVE	T1,NLCPTR		;Get address of value
	DMOVE	T1,(T1)			;Get 2 words
	DMOVEM	T1,NLCVL.		;Save them
	POPJ	P,

BADCNV:	;IOERR	(CCC,799,519,?,Can't convert constant to correct type,)
	$ACALL	CCC

;NAMELIST/LDIO has its own alphameric input routine because
;we need to have the entire string available when the repeat
;count is greater than one. We input one byte at a time,
;checking only for single quotation marks ('). The first
;quotation mark denotes the beginning of the string, and
;has already been found; we skip it here. All ASCII
;characters are permissible. Two single quotation marks ('')
;in the input stream signify one input quote ('). The input
;stream is searched until only one single quote is found
;(<CRLF>) is legal within a character string. Null strings
;are illegal. If there is not room in the string buffer for
;the current byte, NLXIRB is called to double the string buffer,
;and the byte is then deposited in the new buffer. NLXIRB
;returns: T1=pointer to beginning of new buffer
;	  T2=pointer to byte last-deposited in new buffer
;	  T3=free bytes remaining in new buffer.
;When the string is complete, it is padded with from five
;to nine spaces in order to allow a MOVE-MOVEM or DMOVE-DMOVEM
;combination to fill a single or double precision variable from
;the end of the string. These spaces are not included in the
;string byte length (NLSBYT) or word length (NLSWRD).

ALPHI:	
	SETZM	NLSBYT			;Reset byte count
	PUSHJ	P,SKPCHR		;Skip the initial quote
	MOVE	P2,NLBFLN		;Buffer-length equals bytes left
ALPLP1:	PUSHJ	P,GTCHRL		;Get a character
	CAIE	T1,"'"			;Another quote?
	JRST	ALPDPB			;NO. OK to deposit byte
	PUSHJ	P,GETCHR		;Get next character, don't call %IREC
	CAIE	T1,"'"			;2 quotes in a row?
	JRST	ALPFIN			;NO, string is complete
ALPDPB:	SOJGE	P2,ADPBOK		;If bytes left, OK to deposit byte
	PUSH	P,T1			;Buffer empty, save character
	SETZ	T3,			;No minimum size
	PUSHJ	P,NLXIRB	 	;Expand buffer
	MOVEI	P2,(T3)			;Bytes left
	POP	P,T1			;Restore character
	JRST	ALPDPB			;Go count this byte
ADPBOK:	IDPB	T1,NLCPTR		;Deposit the character in string
	JRST	ALPLP1			;Loop for more
ALPFIN:	MOVE	T1,NLBFLN		;Buffer byte length
	SUB	T1,P2			;Minus bytes remaining=string length
	SKIPN	T1			;Null string?
	 $ACALL	NLS			;YES. "Null string illegal"
	MOVEM	T1,NLSBYT		;save string length in bytes
	IDIV	T1,BPW(D)		;Get remainder in T2
	MOVEM	T1,NLSWRD		;Save string length in words
	JUMPE	T2,FILWRD		;If end on boundary, go space next word
	AOS	NLSWRD			;Remainder means partial word
	SUB	T2,BPW(D)		;Negative # of spaces (partial word)
FILWRD:	SUB	T2,BPW(D)		;Fill (another) word full of spaces
	ADD	P2,T2			;Is there enough room in buffer?
	JUMPGE	P2,PUTSPC		;YES. Go do it
	PUSH	P,T2			;Save negative count
	MOVN	T3,T2			;Minimum expansion count
	PUSHJ	P,NLXIRB		;Expand buffer
	POP	P,T2			;Restore negative count
PUTSPC:	MOVEI	T1," "			;Pad with spaces
DPBSPC:	IDPB	T1,NLCPTR		;Deposit the space
	AOJL	T2,DPBSPC		;Loop if more spaces
	MOVE	T1,NLSPTR		;Get beginning-of-buffer pointer
	MOVEM	T1,NLCPTR		;Set current pointer
	MOVE	T1,NLSWRD		;Words in string
	MOVEM	T1,NLCWRD		;Set current words (left)=string length
	POPJ	P,
;NLXIRB:	Routine to expand the NAMELIST input string buffer.
;
;	Doubles old buffer length, adds value in T3, rounds up to
;	word boundary, and calls %MVBLK to create new buffer and
;	move old buffer to beginning of new buffer. Computes the
;	pointer to the last used byte in the new buffer by using
;	the pointer from the old buffer and the difference between
;	the pointers to the beginnings of the old and new buffers.
;
;	If there is no old buffer, adds value in T3 to NLBFLN,
;	rounds to word boundary, and calls %GTBLK to create the
;	desired buffer.
;RETURN: T1 = pointer to beginning of (new) buffer
;	 T2 = pointer to last used byte in (new) buffer
;	 T3 = free bytes in (new) buffer
;	NLBFLN, NLSPTR, & NLCPTR are updated to reflect new values.

NLXIRB:	MOVE	T2,NLBFLN	;Old buffer length in bytes
	HRRZ	T1,NLSPTR	;Old buffer address
	PUSHJ	P,XPNLBF	;Expand and move
	HRRZ	T2,NLSPTR	;Address of old buffer
	MOVEM	T1,NLSPTR	;Pointer to start of new buffer
	HRRZI	T1,(T1)		;Strip pointer stuff
	SUBI	T2,(T1)		;Difference between old & new addresses
	MOVN	T2,T2		;Negative difference between addresses
	ADDM	T2,NLCPTR	;Pointer to current (first free) byte
	MOVE	T4,NLBFLN	;Old byte size
	MOVEM	T3,NLBFLN	;Store new byte size
	SUBI	T3,(T4)		;Return free bytes in T3
	POPJ	P,

XPNLBF:	JUMPE	T1,GTNLBF	;If none yet, go get one
	MOVEI	T4,(T2)		;Byte size of current buffer
	LSH	T4,1		;Doubled
	ADDI	T4,(T3)		;(Current buffer*2)+mininum size
	IDIV	T2,BPW(D)	;Buffer size in words
	MOVEI	T3,(T4)		;Desired buffer length
	ADDI	T3,4		;Round to word boundary
	IDIV	T3,BPW(D)	;New size in words
	PUSHJ	P,%MVBLK	;Expand buffer
	 $ACALL	MFU		;[4131] CAN'T
	IMUL	T3,BPW(D)	;New size in bytes
	HRLI	T1,(POINT 7)	;Pointer to beginning of buffer
	HRLI	T2,(POINT 7)	;Pointer to first free byte
	POPJ	P,		;RETURN

GTNLBF:	ADDI	T3,NLDIBF+4	;Round (initial byte size + minimum)to boundary
	IDIV	T3,BPW(D)	;Word size
	MOVEI	T1,(T3)		;Move where needed by %GTBLK
	IMUL	T3,BPW(D)	;Bytes that will be in buffer
	PUSH	P,T3		;Destroyed by %GTBLK
	PUSHJ	P,%GTBLK	;Create buffer
	 $ACALL	MFU		;[4131] CAN'T
	POP	P,T3		;Restore buffer length in bytes
	HRLI	T1,(POINT 7)	;Pointer to beginning of buffer
	MOVE	T2,T1		;Current pointer=beginning pointer
	POPJ	P,


;SINCE THERE IS OFFICIALLY NO DIRECT WAY TO READ COMPLEX DATA,
;IT HAS TO BE INVENTED HERE. COMPLEX DATA FOR LIST-DIRECTED I/O
;AND NAMELIST I/O IS DEFINED AS A PARENTHESIZED EXPRESSION
;CONTAINING 2 REAL CONSTANTS, DELIMITED BY A SINGLE COMMA.
CPXI:	PUSHJ	P,SKPCHR		;THROW AWAY "("
	PUSHJ	P,GETCHR		;GET NEXT CHAR, don't bump record
	TXNE	P1,DQFLAG		;DOUBLE QUOTE?
	JRST	OCTONE			;YES. GET OCTAL REAL PART
	PUSHJ	P,%IBACK		;THE CHAR BELONGS TO NUMBER
	PUSHJ	P,%GRIN			;GET ONE REAL NUMBER
	JRST	CPXI1
OCTONE:	PUSHJ	P,OCPXI			;GET OCTAL NUMBER
CPXI1:	DMOVE	T1,%FLRFR		;SAVE RAW FRACTION
	MOVEM	T1,NLRFR
	MOVE	T1,%FLRBX		;AND RAW BINARY EXPONENT
	MOVEM	T1,NLRBX
	MOVE	T1,%FLFSG		;GET LOCAL SIGN
	XOR	T1,NLSGN.		;COMBINE WITH GLOBAL SIGN
	MOVEM	T1,NLSGN1		;SAVE IT
	PUSHJ	P,NLSDEL		;SCAN FOR DELIM
	CAIE	T1,","			;WAS IT A COMMA?
	$ACALL	ILC			;"ILLEGAL CHARACTER IN DATA"
	SETOM	NLFV.			;SET TO IGNORE THE COMMA
	XMOVEI	T1,NLVL2.		;GET 2ND DEPOSIT ADDR
	MOVEM	T1,IO.ADR		;SAVE IT
	PUSHJ	P,NLNB			;SCAN FOR NEXT DELIM
	TXNE	P1,DQFLAG		;WAS DELIM DOUBLE QUOTE?
	JRST	OCTTWO			;YES. GET OCTAL IMAG PART
	PUSHJ	P,%IBACK		;NO. BACK UP PNTR FOR GRIN
	PUSHJ	P,%GRIN			;GET 2ND REAL #
	JRST	CPXI2
OCTTWO:	PUSHJ	P,OCPXI			;GET OCTAL NUMBER
CPXI2:	PUSHJ	P,NLSDEL		;GET 2ND DELIM
	CAIE	T1,")"			;MUST BE A RIGHT PAREN
	$ACALL	ILC			;"ILLEGAL CHARACTER IN DATA"
	PUSHJ	P,GETCHR		;THROW AWAY ")", do not get next record
	DMOVE	T1,%FLRFR		;SAVE AWAY THE RAW COMPONENTS
	DMOVEM	T1,NLRFR2		;LOCALLY
	MOVE	T1,%FLRBX
	MOVEM	T1,NLRBX2
	MOVE	T1,%FLFSG		;GET LOCAL SIGN
	XOR	T1,NLSGN.		;COMBINE WITH GLOBAL ONE
	MOVEM	T1,NLSGN2		;FOR THE IMAGINARY PART
	SETZM	NLSGN.			;NO GLOBAL SIGN ANYMORE
					;MUST DO THIS TO PREVENT DMOVN
					;OF COMPLEX VALUE, WHICH WOULD
					;YIELD TRASH
	POPJ	P,

OCPXI:	PUSHJ	P,%OCTI			;GET OCTAL NUMBER
	SETZM	%FLFSG			;ASSUME LOCAL POSITIVE VALUE
	DMOVE	T1,@IO.ADR		;GET VALUE
	JUMPGE	T1,CPXNN		;NEGATE IF NEGATIVE
	DMOVN	T1,T1
	SETOM	%FLFSG			;GIVE LOCAL SIGN NEGATIVE
CPXNN:	LDB	T3,[POINT 9,T1,8]	;GET BINARY EXPONENT
	MOVEM	T3,%FLRBX		;SAVE AS RAW VALUE
	TLZ	T1,777000		;WIPE OUT EXPONENT
	ASHC	T1,8			;LEFT-JUSTIFY FRACTION
	DMOVEM	T1,%FLRFR		;SAVE AS RAW FRACTION
	POPJ	P,
;LOGI - LOCAL LOGIC INPUT ROUTINE.
;FOR NAMELIST INPUT, IF THE FIRST CHARACTER OF DATA IS A "T"
;OR "F", WE CANNOT BE SURE IF IT IS DATA OR THE
;NAME OF A NEW VARIABLE OR ARRAY TO FILL. SO WE CALL THE LOGIC
;SCANNER AND GET THE DELIMITER FOUND. IF THE DELIMITER IS
;A "=" OR "(" (WHICH ARE CONSIDERED DELIMITERS ONLY FOR NAMELIST,
;NOT FOR LIST-DIRECTED INPUT, IN THE LOGIC SCANNER), WE CALL
;SETNUL, WHICH CHECKS IF SUCH A SITUATION IS LEGAL AND SETS THE
;REST OF THE DATA DESIRED IN THE CURRENT ARRAY TO NULL ITEMS.
;THEN WE STORE THE 1ST SIX CHARACTERS FOUND BY THE LOGIC SCANNER
;FOR USE AS THE NEXT VARIABLE NAME IN THE NAMELIST.
LOGI:	PUSHJ	P,%LINT			;GET LOGICAL DATA
	MOVE	T0,FLAGS(D)
	TXNE	T0,D%LSD		;LIST-DIRECTED INPUT?
	 POPJ	P,			;NO. DON'T SCAN FOR DELIM
	PUSHJ	P,NLSDEL		;GET THE DELIM
	CAIE	T1,"("			;LEFT PAREN OR
	CAIN	T1,"="			;EQUAL SIGN?
	JRST	NOTLOG			;OOPS - IT WAS A NEW VARIABLE
	POPJ	P,			;NO. IT REALLY WAS LOGIC
NOTLOG:	PUSHJ	P,SETNL1		;SET REST OF DATA NULL
	MOVE	T1,%FLINF		;GET DATA ACCUMULATED
	MOVEM	T1,NLNAM.		;USE FOR NEW VARIABLE NAME
	POPJ	P,

;OCTAL INPUT HAS TO THROW AWAY THE INITIAL DOUBLE QUOTE BEFORE
;CALLING THE STANDARD %OCTI ROUTINE
OCTI:	PUSHJ	P,SKPCHR		;SKIP THE QUOTE
	PJRST	%OCTI			;AND GO TO STANDARD ROUTINE
;TDBL - TEST FOR DOUBLE REAL - THIS IS CALLED WHEN WE ENCOUNTER
;A PERIOD AS THE FIRST CHARACTER IN THE DATA. SINCE THE DATA
;FOLLOWING CAN BE EITHER REAL (WE ASSUME DOUBLE REAL) OR LOGIC
;(.TRUE., ETC.), WE TRY CALLING %GRIN. IF THE INFORMATION WORD
;REVEALS THAT THERE WERE NO DIGITS AFTER THE PERIOD (IT WILL STOP
;ON THE NEXT CHARACTER IF IT IS NOT A DIGIT), WE MUST ASSUME THAT
;IT IS LOGIC DATA INSTEAD. THEREFORE WE SET THE DATA TYPE TO LOGIC
;AND CALL THE LOGIC INPUT ROUTINE, WHICH WILL BARF APPROPRIATELY
;IF GARBAGE IS FOUND.
TDBL:	PUSHJ	P,%GRIN			;GET A REAL NUMBER
	HRRZ	T1,%FLINF		;ANY DIGITS AFTER DOT?
	JUMPG	T1,%POPJ		;OK IF YES
	DSETZM	NLVAL.			;NO. RESET VALUE REG
	PUSHJ	P,%IBACK		;MOVE PNTR TO AFTER DOT
	MOVEI	T1,TP%LOG		;AND ASSUME IT'S LOGICAL
	MOVEM	T1,VALTYP
	PJRST	%LINT

;NAMELIST OUTPUT - OUTPUTS ALL VARIABLES AND ARRAYS IN THE
;NAMELIST IN THE ORDER IN WHICH THEY APPEAR IN THE NAMELIST.
;BOTH VARIABLES AND NAMELIST NAMES ARE DELIMITED WITH
;COMMAS. THERE IS NO TRAILING COMMA!
%NLO:	PUSHJ	P,NLINIT		;INITIALIZE STUFF
	MOVX	T0,D%NML		;SET FOR NMLST OUTPUT
	IORM	T0,FLAGS(D)
	MOVEI	T1,1			;SET FOR 1PG OUTPUT
	MOVEM	T1,%SCLFC
	PUSHJ	P,CHKEND		;MAKE SURE COL 1
	PUSHJ	P,SPCOUT		;ADVANCE TO COL 2
	MOVEI	T1,"$"			;OUTPUT $
	PUSHJ	P,PUTCHR
	MOVE	T1,NLARG.		;GET NMLST ADDR
	MOVEM	T1,NLVAR.		;SAVE IT
	MOVE	T1,(T1)			;GET NAMELIST NAME
	MOVEM	T1,NLNAM.		;SAVE FOR OUTPUT
	PUSHJ	P,NLONAM		;OUTPUT IT
	PUSHJ	P,%ORECS		;EOL
	MOVEI	T1,1			;ADD 1 TO NMLST ADDR
	ADDM	T1,NLVAR.		;TO GET 1ST VARIABLE PNTR
NLOLP:	SKIPE	T1,@NLVAR.		;ANY MORE VARS?
	CAMN	T1,FINCOD		;OR END CODE?
	JRST	NLOEND			;END OF LIST
	PUSHJ	P,VARSET		;SETUP VARIABLE PARAMS
	MOVEI	T1,^D8			;MAKE ROOM FOR NAME AND "="
	MOVEM	T1,OSIZE
	PUSHJ	P,PUTCOM		;OUTPUT COMMA, CHECK LINE
	PUSHJ	P,NLONAM		;OUTPUT VARIABLE NAME
	MOVEI	T1,"="			;OUTPUT =
	PUSHJ	P,PUTCHR
	SETZM	NLFLG.			;AVOID COMMA BEFORE 1ST DATA
	PUSHJ	P,NLMO			;MAIN OUTPUT ROUTINE
	SETOM	NLFLG.			;SET FLAG FOR OUTPUT STARTED
	MOVEI	T1,2			;ASSUME SCALAR
	ADDB	T1,NLVAR.		;FOR INCR TO NEXT VARIABLE
	MOVE	T2,NLDIM.		;GET # DIMS
	JUMPE	T2,NLOLP		;CORRECT IF SCALAR
	SKIPGE	-1(T1)			;Array size/offset in halfwords?
	AOJ	T1,			;NO. One extra word
	ADDI	T1,1(T2)		;ADD # DIMS +1 IF ARRAY
	MOVEM	T1,NLVAR.		;Set to next variable
	JRST	NLOLP			;BACK FOR MORE

NLOEND:	PUSHJ	P,CHKEND		;EOL
	PUSHJ	P,SPCOUT		;OUTPUT SPACE
	MOVEI	T1,"$"			;OUTPUT $
	PUSHJ	P,PUTCHR
	MOVEI	T1,"E"			;OUTPUT E
	PUSHJ	P,PUTCHR
	MOVEI	T1,"N"			;OUTPUT N
	PUSHJ	P,PUTCHR
	MOVEI	T1,"D"			;OUTPUT D
	PUSHJ	P,PUTCHR
	PUSHJ	P,%ORECS		;EOL AGAIN
	JRST	%SETAV			;Reset & return

FINCOD:	4000,,0				;NAMELIST END CODE
					;FOR F10 VERSION 2 AND UP
;NLMO - NAMELIST AND LIST-DIRECTED MAIN OUTPUT ROUTINE.
;OUTPUTS A VARIABLE BY ITS TYPE; CHECKS FOR A REPEATED VALUE;
;IF THE REPEAT COUNT IS 1 IT IS NOT PRINTED. IF THE REMAINING
;NLNUM. IS NON-ZERO, A COMMA IS PRINTED AND THE PROCESS IS
;REPEATED.

NLMO:	SKIPN	NLNUM.			;MAKE SURE THERE'S DATA
	 POPJ	P,			;LEAVE IF NONE
	SETOM	%FTSLB			;SUPPRESS LEADING BLANKS ON OUTPUT
	SETZM	%SPFLG			;SUPPRESS LEADING PLUS SIGN
NLMOLP:	MOVE	T1,VARTYP		;GET VARIABLE TYPE
	CAIN	T1,TP%CHR		;Character?
	 JRST	NLDCHR			;YES. Go put out a string
	MOVE	T1,OSIZTB(T1)		;GET SIZE OF DATA
	MOVEM	T1,OSIZE		;MAKE ROOM FOR IT
	SKIPE	CHRLST			;[3120]Last output character string?
	 PUSHJ	P,PUTCHK		;[3120]YES. Chk fit, RET +1 if NO, +2 if YES
	  PUSHJ	P,PUTCOM		;[3120]CHECKS CUR POS AND DATA SIZE
	SETZM	CHRLST			;[3120]This is not a string
	PUSHJ	P,NLCRP			;CHECK FOR A REPEATED VALUE
	MOVE	T1,NLRP.		;GET THE REPEAT COUNT
	CAILE	T1,1			;IS IT 1?
	PUSHJ	P,NLORP			;.GT.1. OUTPUT WITH *
	XMOVEI	T1,NLVAL.		;POINT TO VALUE
	MOVEM	T1,IO.ADR		;SAVE ADDR
	MOVE	T1,VARTYP		;GET VARIABLE TYPE
	MOVEM	T1,IO.TYP		;SAVE IT
	PUSHJ	P,@OUTSUB(T1)		;OUTPUT THE VALUE
	SETOM	NLFLG.			;SET DATA OUTPUT DONE
	SKIPE	NLNUM.			;ANY MORE?
	JRST	NLMOLP			;YES. BACK FOR MORE
	POPJ	P,			;NO

;HOLLERITH OUTPUT - A SIDE-EFFECT OF ALLOWING EXPRESSIONS IN I/O LISTS
;IS THAT THIS CAN NOW APPEAR, WHEREAS IT COULD NOT BEFORE. WE FAKE UP
;A CHARACTER DESCRIPTOR FOR THE HOLLERITH STRING BY (YOU GUESSED IT)
;READING THE STRING TO THE END.
HOLOUT:	MOVE	T1,IO.ADR		;GET ADDRESS
	$BLDBP	T1			;BUILD BYTE POINTER
	MOVEM	T1,IO.ADR		;SAVE BYTE POINTER BACK
	SETZ	T2,			;CLEAR COUNT
HOLP:	ILDB	T3,T1			;GET A CHAR
	JUMPE	T3,HOLEND		;END IS A NULL CHAR
	AOJA	T2,HOLP			;INCR COUNT, LOOP

HOLEND:	MOVEM	T2,IO.SIZ		;SAVE SIZE
	JRST	NLDCHR			;GO DO CHARACTER OUTPUT

;	NLDCHR:
;	Here from NLMOLP when VARTYP is found to be 15(CHARACTER-
;	STRING), bypassing repeat-count checking. Now we simply
;	move the string to the output buffer via 'MOVSLJ' IN
;	%OMBYT. The STANDARD mandates NO value separators
;	before or after character-strings, so we reset .NLFLG
;	to pretend that the next value output is the 'first'.
;	
;	We must move the source string with no truncation or fill,
;	filling the entire record where possible. First calculate
;	space left in record. If source string remaining will not
;	fit into available record, move available record length to
;	source count, call %OMBYT to fill the record, call %SPCEOL
;	to output the record and a leading space, and loop until
;	the remaining source string will fit in available record.
;	Then move the source count to destination count, call
;	%OMBYT and return.

NLDCHR:	MOVE	T0,FLAGS(D)	;Get flags
	TXNE	T0,D%NML	;NAMELIST?
	 JRST	NLCHR		;YES.
LDELEM:	SETOM	CHRLST		;[3120]to prevent value separator after this string
	SETZM	NLFLG.
	PUSHJ	P,%ROPOS	;[3307] get first free byte number in buffer
	SUBI	T1,1		;[3307] adjust to last byte used
	LOAD	T3,TTYW(D)	;record size
	SUB	T3,T1		;bytes left in record
	JUMPLE	T3,LDEOL	;[3307] At or beyond EOL, output a record
	JUMPN	T1,LDSRCE	;At start of buffer?
	MOVEI	T1," "		;YES. Load a space
	PUSHJ	P,PUTCHR	;Store at beginning of record
	SUBI	T3,1		;[3307] Subtract leading space

LDSRCE:	MOVE	T1,IO.ADR	;source
	MOVE	T5,IO.SIZ	;bytes to be put out
LDCHLP:	MOVE	T0,T5		;bytes-to-go
	SUB	T5,T3		;minus bytes left in record
	SKIPGE	T5		;overflow?
	 MOVE	T3,T0		; no, destination count = source
	MOVEI	T0,(T3)		;source count always = destination count
	MOVEM	T5,IO.EXT	;T5 crunched by %OMBYT
	PUSHJ	P,%OMBYT	;do it
	SKIPG	T5,IO.EXT	;Anything left in source string?
	 JRST	LDNUMS		; NO. go check for more strings
	PUSHJ	P,%PUSHT	;[3307] Save ACs
	PUSHJ	P,SPCEOL	;Put record & leading space
	PUSHJ	P,%POPT		;[3307] Restore ACs
	LOAD	T3,TTYW(D)	;Record size
	SUBI	T3,1		;[3307] Subtract leading space from free bytes
	JRST	LDCHLP		;Go around again
LDNUMS:	SOSG	IO.NUM		;More items in IOLST?
	 POPJ	P,		;NO
	MOVE	T1,IO.INC	;Get increment
	ADJBP	T1,IO.ADR	;Next element address
	MOVEM	T1,IO.ADR	;Set the address
	JRST	LDELEM		;Go put it out

LDEOL:	PUSHJ	P,SPCEOL	;[3307] Output record and leading space
	LOAD	T3,TTYW(D)	;[3307] Get line width again
	SUBI	T3,1		;[3307] Adjust for leading space
	JRST	LDSRCE		;[3307] Go back for more

NLCHR:
	PUSHJ	P,%ROPOS	;Find out where we are (T1 points to free byte)
	SOS	T1		;Bytes actually put out so far
	MOVEM	T1,NLBYT	;initialize byte counter

NCHRLP:	SKIPN	NLFLG.		;Have we put out any values yet?
	 JRST	NLCHR1		;NO, skip comma
	MOVEI	T1,","
	PUSHJ	P,PTNLCH	;Put out a comma
NLCHR1:	MOVE	T1,NLBYT	;Find out where we are
	CAIN	T1,1		;Beginning of record?
	 JRST	NLCHR2		;YES. Don't need separator or size check
	MOVE	T2,NLSIZ.	;String length(assume no internal quotes)
	ADDI	T2,3		;Add two quotes & separator
	LOAD	T3,TTYW(D)	;Maximum record size
	CAILE	T2,(T3)		;Can a quoted string & space possibly fit?
	 JRST	NLSEP		;NO. don't bother
	ADD	T1,T2		;
	CAIG	T1,(T3)		;Will it run past end of current record?
	 JRST	NLSEP		;Hope not
	PUSHJ	P,%ORECS	;Output the record & leading space
	SETZM	NLBYT		;Reset NAMELIST byte-count
NLSEP:	MOVEI	T1," "
	PUSHJ	P,PTNLCH	;Put out a space
NLCHR2:	PUSHJ	P,NLCRP		;CHECK FOR A REPEATED VALUE
	MOVE	T1,NLRP.	;GET THE REPEAT COUNT
	CAIG	T1,1		;IS IT 1?
	 JRST	NLCHR3		;YES
	PUSHJ	P,NLORP		;.GT.1. OUTPUT WITH *
	PUSHJ	P,%ROPOS	;Get byte position of first free byte
	SOS	T1		;Convert to byte count
	MOVEM	T1,NLBYT	;Set current byte count
NLCHR3:	MOVEI	T1,"'"		;Initial quotation mark
	PUSHJ	P,PTNLCH	;Put it out
	MOVE	T5,NLSIZ.	;String length
NLCHLP:	ILDB	T1,NLADD.	;Load next byte
	CAIE	T1,"'"		;Is it a quote?
	 JRST	NCHLP1		; NO.
	PUSHJ	P,%ROPOS	;Get byte position of next free byte
	LOAD	T2,TTYW(D)	;Get position of last byte in record
	CAIL	T1,(T2)		;Is it the last byte?
	 PUSHJ	P,SPCEOL	; YES
	MOVEI	T1,"'"		;Reload the quote
	PUSHJ	P,PTNLCH	;Put out leading quote
NCHLP1:	PUSHJ	P,PTNLCH	;Put out the character
	SOJG	T5,NLCHLP	;Loop thru string
	MOVEI	T1,"'"		;Load a quote
	PUSHJ	P,PTNLCH	;Put it out
	SETOM	NLFLG.		;Flag that we did it
	SKIPN	NLNUM.		;Any more strings?
	 POPJ	P,		;NO.
	MOVE	T1,NLRP.	;Repeat count
	SOS	T1		;We just put one out
	IMUL	T1,NLINC.	;Calculate offset to next variable
	ADJBP	T1,NLADD.	;Adjust to address/next variable
	MOVEM	T1,NLADD.	;Store address/next variable
	MOVEM	T1,IO.ADR	;Store for NLCSTR
	JRST	NCHRLP		;Loop thru IOLST

	SEGMENT	DATA
IO.EXT:	BLOCK	1		;
	SEGMENT CODE

;NLCRP - ROUTINE TO CHECK FOR A REPEATED VALUE
;PLACES THE (SINGLE OR DOUBLE WORD) VALUE POINTED TO BY
;NLVAL. AND THEN INCREMENTS A LOCAL POINTER AND CHECKS
;THE NEXT ENTRY FOR AN IDENTICAL VALUE; THIS PROCESS IS
;CONTINUED UNTIL A NON-MATCH IS FOUND. THE ADDRESS OF THE
;NON-MATCHING ENTRY IS SAVED IN NLADD., THE NUMBER OF
;REPEATED VALUES IS PLACED IN NLRP., AND NLNUM. IS
;DECREMENTED APPROPRIATELY.
;NOTE THAT THERE IS NO WAY FOR THIS ROUTINE TO CHECK FOR
;VALUES THAT DIFFER BEYOND THE OUTPUT ACCURACY (AND THEREFORE
;PRINT THE SAME), NOR DOES THIS ROUTINE CHECK FOR IDENTICAL
;VALUES ACROSS DIFFERENT VARIABLES.

NLCRP:	MOVEI	T1,1			;ASSUME REPEAT COUNT OF 1
	MOVEM	T1,NLRP.
	MOVE	T0,VARTYP		;GET VARIABLE TYPE
	CAIN	T0,TP%CHR		;CHARACTER?
	 JRST	NLCSTR			;YES. GO DO BYTE STRING COMPARISONS
	SETZ	T2,			;CLEAR 2ND VALUE WORD
	MOVE	T3,NLSIZ.		;GET SIZE
	XCT	NLGET(T3)		;GET THE VALUE
	DMOVEM	T1,NLVAL.		;SAVE IT
NLCLP:	MOVE	T1,NLINC.		;INCR ADDR
	ADDM	T1,NLADD.
	SOSG	NLNUM.			;ANY MORE ENTRIES?
	POPJ	P,			;NO. LEAVE
	SETZ	T2,			;CLEAR 2ND VALUE WORD
	XCT	NLGET(T3)		;GET NEXT ENTRY
	CAMN	T1,NLVAL.		;COMPARE
	CAME	T2,NLVAL.+1
	POPJ	P,			;THEY DIDN'T MATCH
	AOS	NLRP.			;THEY DID. INCR RPT COUNT
	JRST	NLCLP			;AND TRY AGAIN
;NLCSTR:
;	Compares strings for repeated values.

NLCSTR:	SOSG	NLNUM.			;[3272]Any more elements?
	 POPJ	P,			;NO
	MOVE	T1,NLINC.		;Byte size
	MOVEI	T3,(T1)			;Save byte size for comparison
	MOVE	T4,NLADD.		;Current string
	ADJBP	T1,IO.ADR		;Point to next element
	MOVEM	T1,IO.ADR		;Store the pointer
	MOVEI	T0,(T3)			;String counts are the same
	EXTEND	T0,[CMPSE
			" "
			" "]		;Strings identical?
	 POPJ	P,			;NO
	AOS	NLRP.			;Count repeated string
	JRST	NLCSTR			;Loop thru iolst

;NLONAM - OUTPUT A SIXBIT NAME

NLONAM:	MOVE	T1,[POINT 6,NLNAM.]	;GET PNTR
	MOVEM	T1,NLVAL.		;SAVE IT
	MOVEI	T1,6			;MAX COUNT
	MOVEM	T1,NLRP.		;SAVE IT
NLONLP:	ILDB	T1,NLVAL.		;GET CHAR
	JUMPE	T1,NLONF		;DONE IS 0
	ADDI	T1,40			;CONVERT TO ASCII
	PUSHJ	P,PUTCHR		;OUTPUT IT
	SOSLE	NLRP.			;DECR COUNT
	JRST	NLONLP			;BACK FOR MORE
NLONF:	POPJ	P,

;NLORP - OUTPUT REPEAT COUNT AND *

NLORP:	XMOVEI	T1,NLRP.		;GET REPEAT COUNT ADDR
	MOVEM	T1,IO.ADR		;SAVE IT
	MOVEI	T1,TP%INT		;USE SINGLE INTEGER
	MOVEM	T1,IO.TYP		;FOR DATA TYPE FOR %GINTO
	PUSHJ	P,%GINTO		;OUTPUT IT
	MOVEI	T1,"*"			;OUTPUT *
	PJRST	PUTCHR

;PUTCHK - CHECK LINE - USED FOR DELIMITING DATA ITEMS
;AND VARIABLE NAMES IN THE OUTPUT STREAM. IF THE LINE OF OUTPUT
;IS ABOUT TO BE "TOO LONG" (DEFINED BY TTYW MINUS DATA SIZE
;FOR THE NEXT ITEM) A NEW LINE IS STARTED.
PUTCHK:	PUSHJ	P,%ROPOS			;GET CURRENT POSITION
	ADD	T1,OSIZE		;ALLOW ROOM FOR VALUE
	LOAD	T2,TTYW(D)		;GET WIDTH
	CAIG	T1,(T2)			;WOULD IT OVERFLOW WIDTH?
	 AOS	(P)			;NO. SKIP RETURN
	POPJ	P,

;PUTCOM - OUTPUT COMMA IF PREV OUTPUT, CHECK FOR LINE-TOO-LONG, AND
;OUTPUT SPACE.
PUTCOM:	MOVEI	T1,","			;OUTPUT COMMA
	SKIPE	NLFLG.			;ONLY IF PREVIOUS DATA
	 PUSHJ	P,PUTCHR
	PUSHJ	P,PUTCHK		;WILL WE OVERFLOW LINE?
SPCEOL:	 PUSHJ	P,%ORECS			;YES. OUTPUT EOL
SPCOUT:	MOVEI	T1," "			;PLUS A SPACE
	PJRST	PUTCHR

;CHKEND - TO MAKE SURE THAT WE ARE AT THE BEGINNING OF THE LINE
;WHEN WE OUTPUT THE NAMELIST "BEGIN  STRING" - A SPACE
;AND DOLLAR SIGN.
;PUTEND - FORCES OUTPUT OF LAST RECORD AND STARTS NEW LINE
CHKEND:	PUSHJ	P,%ROPOS			;GET CURRENT POSITION
	CAIN	T1,1			;NEW LINE?
	  POPJ	  P,			;  YES, QUIT
	PJRST	%ORECS			;NO, FORCE EOL

;WE HAVE FUNNELED ALL OUTPUT CHARACTER CALLS THROUGH HERE, SO THAT IF SOMEDAY
;SOMEONE WANTS SOMETHING SPECIAL DONE WHICH IS NOT PART OF %OBYTE, IT CAN BE
;DONE HERE AND BE GLOBAL FOR ALL OF NAMELIST OUTPUT.

	SEGMENT	DATA
NLBYT:	BLOCK	1
	SEGMENT	CODE

PTNLCH:	AOS	NLBYT			;Count this byte
	LOAD	T2,TTYW(D)		;Record size
	CAML	T2,NLBYT		;Will we overflow the line?
	JRST	PUTCHR			;NO
	PUSH	P,T1			;Save the character
	PUSHJ	P,SPCEOL		;Output record & a leading space
	MOVEI	T1,1			;Count the space
	MOVEM	T1,NLBYT		;Reset output count
	POP	P,T1			;Get the character
	JRST	PTNLCH			;It better go out this time!!!

PUTCHR==%OBYTE
;THIS IS THE TABLE OF "OUTPUT SUBROUTINES BY TYPE". THE VARIABLE
;TYPE IS USED AS THE INDEX INTO THE TABLE.
OUTSUB:	IFIW	%GINTO			;0  NOT SPECIFIED
	IFIW	%LOUT			;1  LOGICAL
	IFIW	%GINTO			;2  INTEGER
	IFIW	NONO			;3
	IFIW	%GROUT			;4  SINGLE REAL
	IFIW	NONO			;5
	IFIW	%OCTO			;6  SINGLE OCTAL
	IFIW	NONO			;7  STATEMENT LABEL
	IFIW	%GROUT			;10 DOUBLE REAL
	IFIW	NONO			;11 DOUBLE INTEGER
	IFIW	%OCTO			;12 DOUBLE OCTAL
	IFIW	%GROUT			;13 EE DOUBLE REAL
	IFIW	CPXO			;14 COMPLEX
	IFIW	NONO			;15 COBOL BYTE STRING
	IFIW	NONO			;16
	IFIW	HOLOUT			;17 ASCIZ

NLGET:	JFCL
	MOVE	T1,@NLADD.
	DMOVE	T1,@NLADD.

;OUTPUT DATA ELEMENT SIZE TABLE - GIVES MAXIMUM SIZE OF A DATA ELEMENT
;BASED ON ITS DATA TYPE
OSIZTB:	^D14		;0 (BADLY SPECIFIED INTEGER)
	3		;1 LOGICAL
	^D14		;2 INTEGER
	0		;3
	^D16		;4  REAL
	0		;5
	0		;6
	0		;7
	^D16		;10 DOUBLE REAL
	0		;11
	0		;12
	^D16		;13 EE DOUBLE REAL
	^D32		;14 COMPLEX
	0		;15
	0		;16
	0		;17

;CPXO - SIMILAR TO CPXI - SINCE THERE IS NO OFFICIAL ROUTINE
;FOR COMPLEX VARIABLE OUTPUT, WE HAVE TO DO IT HERE, SENDING
;EACH PART OUT THROUGH %GROUT (WHICH MUST BE FOOLED INTO
;THINKING THE VARIABLE TYPE IS SINGLE REAL...).
CPXO:	MOVEI	T1,TP%SPR		;MAKE THE TYPE SINGLE REAL
	MOVEM	T1,IO.TYP
	MOVEI	T1,"("			;OUTPUT LEFT PAREN
	PUSHJ	P,PUTCHR
	PUSHJ	P,%GROUT		;OUTPUT REAL PART
	MOVEI	T1,TP%SPR		;USE REAL DATA SIZE
	MOVE	T1,OSIZTB(T1)		;FROM SIZE TABLE
	MOVEM	T1,OSIZE		;TO CHECK FOR ENOUGH ROOM
	MOVEI	T1,","			;OUTPUT COMMA
	PUSHJ	P,PUTCHR
	PUSHJ	P,PUTCHK		;AND CHECK FOR LINE-TOO-LONG
	PUSHJ	P,SPCEOL		;IN WHICH CASE OUTPUT EOL
	XMOVEI	T1,NLVAL.+1		;OUTPUT IMAGINARY PART
	MOVEM	T1,IO.ADR		;SAVE FOR OUTPUT
	PUSHJ	P,%GROUT
	MOVEI	T1,")"			;OUTPUT RIGHT PAREN
	PJRST	PUTCHR

NONO:	$SNH				;NONEXISTENT OUTPUT ROUTINE

	PURGE	$SEG$
	END