Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/ftncsr/cgstmn.bli
There are 12 other files named cgstmn.bli in the archive. Click here to see a list.
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1972, 1987
!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.

!AUTHOR: S. MURPHY,N. ABEL/HPW/DCE/SJW/TFV/EGM/AHM/CKS/RVM/TJK/MEM/CDM

MODULE CGSTMN(SREG=#17,VREG=#15,FREG=#16,DREGS=4,RESERVE(0,1,2,3)) =
BEGIN

GLOBAL BIND CGSTMV = #11^24 + 0^18 + #4535;	! Version Date:	13-May-86

%(

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

105	-----	-----	ADD CODE GENERATION ROUTINES FOR E1LISTCALL AND
			E2LISTCALL NODES
106	-----	-----	GENERATE ZERO INCREMENT FOR E1 OR E2 LISTCALL
			NODES OUT OF LINE
107	-----	-----	GENERATE CODE FOR COMMON SUBS ON CALL STMNTS

108	-----	-----	FOR A REFERENCE TO A FORMAT STMNT, MAKE THE
			PEEPHOLE BUFFER ENTRY POINT TO THE FORMAT STMNT RATHER
			THAN SIMPLY CONTAINING THE RELATIVE ADDRESS OF THE STRING
109	-----	-----	FIX CAE1LIST AND CAE2LIST TO CALL IOPTR INSTEAD 
			OF ARGGEN
110	-----	-----	ADD CODE TO HANDLE ARBITRARY EXPRESSION AS THE VAL
			OF AN ARG TO OPEN; ADD CODE TO HANDLE ARBITRARY EXPRESSION
			AS A UNIT NUMBER

111	-----	-----	FIX BUG IN 110 (HAD LEFT OUT "FIND" AND "OPEN/CLOSE"
			FOR EXPRESSIONS AS UNIT NOS)
112	-----	-----	COMMENT OUT THE ROUTINE "CGRELS" - WE CALL
			"CGMTOP" FOR RELEASE STMNTS
113	-----	-----	FIX ERROR CALLS
114	-----	-----	FIX REFERENCES TO PROEPITYP AND PROGNAME
115	-----	-----	FIX CGDCALL TO SET INDIRECT BIT OVER FORMAL
			ARRAYS UNDER DATACALL NODES
116	-----	-----	FIX CALLS TO IOPTR IN CAE1LIST AND CAE2LIST TO
			CLEAR PBOPWD FIRST
117	-----	-----	CHANGE IOIMMED AS FOLLOWS:
			FOROTS WILL NOW PERFORM THE INDIRECT
			FOR ALL ARGUMENTS NOT IMMEDIATE MODE
			CONSTANTS
			DISTINGUISH IMMEDIATE MODE CONSTANTS FROM
			IMMEDIATE MODE ARGUMENTS IN MEMORY
			AS FOLLOWS:
				CONSTANTS HAVE AN EMPTY LEFT HALF
				OTHER VARIABLES HAVE TYPE FIELD SET
				ONLY AN ARGUMENT PASSED IN THE FIRST
					ELEMENT OF A FORMAL ARRAY
					WILL HAVE THE INDIRECT BIT
					SET
			FOROTS WILL PERFORM AN EXTRA OPERATION
			TO LOAD THE RIGHT HALF OF THE ARGUMENT
			IN MEMORY

118	-----	-----	DO NOT CALL "IOENDERR" FOR FIND STMNTS,
			SIMPLY PUT OUT 2 WDS OF 0 (THE STMNT NODE DOES NOT HAVE END/ERR FIELDS)
119	-----	-----	IN CGSTMN, IF THE FLAG "DBGTRAC" IS SET CALL
			XCTFDDT TO GENERATE "XCT FDDT."
120	-----	-----	TAKE OUT CALLS TO FIN. FOR NAMELIST READ/WRITE
122	-----	-----	DONT CALL "XCTFDDT" FOR STMNT FNS AND ENTRIES
			UNTIL AFTER THE LABELS ON THEM ARE DEFINED
123	-----	-----	FIX CODE GEN FOR "DIALOG" IN AN OPEN STMNT
124	306	16156	FIX OPEN/CLOSE TO GIVE FOROTS FORMAL ARRAYS RIGHT, (JNT)
125	367	18239	MAKE WRITE(3) GENERATE CORRECT CODE
126	376	18398	PREVENT CGRECNUM FROM CHANGING A1LABEL, (DCE)

***** Begin Version 5A *****

127	532	20323	SET INDIRECT BIT IN ARG BLOCK FOR ARRAY
			REF AS ASSOCIATE VARIABLE, (DCE)
130	564	-----	MAKE CGREAD AND CGWRIT SYMMETRICAL:
			  MAKE CGREAD CHECK FOR NAMELIST ONLY IF IONAME
			  PTR NEQ 0;
			  MAKE CGWRIT GENERATE FIN CALL IF UNFORMATTED
131	607	22685	SET GLOBAL FLAG NEDZER IN CGEND, CGSTOP & CGPAUS
			  TO INDICATE ZERO-ARG-BLOCK NEEDED

***** Begin Version 5B *****

132	711	26754	PUT OUT FIN CALL WITH ENCODE/DECODE, (DCE)

***** Begin Version 6 *****

133	760	TFV	1-Oct-79	------
	Generate new argument blocks for I/O and OPEN/CLOSE statements
	Arg blocks are now keyword based not positional

134	761	TFV	1-Mar-80	-----
	Choose arg type based on /GFLOATING

135	1002	TFV	1-Jul-80	------
	MAP EVALU onto EVALTAB to get the argtype for argblock entries

136	1035	DCE	10-Dec-80	-----
	For .IOLST calls, put out the correct argument count (add COUNTARGS).

138	1076	TFV	8-Jun-81
	Allow list-directed I/O without an iolist.

140	1123	AHM	18-Sep-81	Q20-01650
	Make CGIOENDERR and OPNFARGS work for IOSTAT=arrayref and IOSTAT=reg

142	1134	EGM	1-Oct-81	10-31654
	For READ/WRITE/FIND, generate code for the record number, then the
	unit number, since registers were allocated in that order. Also,
	preserve the desired value of A1LABEL for FIND (more of edit 376).

***** Begin Version 7 *****

137	1206	DCE	20-Mar-81	-----
	For F77 ELISTS, generate code for final implied loop values.

139	1223	DCE	9-Jun-81	-----
	Put out special code for F77 SLISTs and ELISTs so FOROTS can tell.

141	1265	CKS	28-Sep-81
	Allow character variables in IO lists

143	1401	AHM	5-Oct-81
	Rewrite all code which outputs argument block entries so that extended
	addressing and CHARACTER variable support will be easier to implement.
	Make all FOROTS  args go  through IOPTR and  IOIMMED.  Delete  routine
	BLDIOIMWD.  Create  new  routine  ELISTINCR  to  merge  two  identical
	streams  of  thought  about   ELIST  increments.   Remove   superflous
	declarations from routine level so that this module will CREF.

144	1432	RVM	8-Dec-81
	Implement assigned formats.  Fix IOFORMAT to not generate
	an I/O arg block word for the format size, except when the format
	is an array.  Make IOFORMAT lie to FOROTS when an INTEGER variable
	is used as a format:  IOFORMAT sets the indirect bit in the format
	address word and sets the type of the word to ADDRESS.  This way
	FOROTS does not need to distinguish between the case of the FMT=
	keyword being the label of a format statement or being an INTEGER
	variable that has been assigned a format label.  Teach routine
	CNTKEYS that the FMT= keyword generates only one word in the I/O
	arg block for INTEGER variables, CHARACTER variables, and FORMAT
	statements used as formats, and two words in the I/O arg block for
	arrays used as formats.

145	1435	RVM	14-Dec-81
	CNTKEYS is now smart enough to handle namelists correctly, so do
	not subtract one from its count in REDORWRIT.

146	1471	RVM	5-Feb-82
	Implement internal files.  Modify CGREAD and CGWRIT to generate the
	calls to the proper FOROTS routines to do internal file I/O.  In
	REDORWRIT, generate the OTSKEDSIZ keyword if the internal file is a
	character array to tell FOROTS how many characters are in the file.
	Note that the pointer in the I/O statement node to the number of
	characters is stored in the half-word that normally holds the value
	of the REC= keyword (random access I/O record number).  This is OK
	since random access I/O to internal files is illegal.  Make IOIMMED
	be not so fussy about what it considers to be a legal argument, since
	it really can handle almost anything since it calls IOPTR.

147	1472	AHM	7-Feb-82
	Make REDORWRIT generate an OTSKREC keyword for all the  possible
	cases that the REC= variable was not a CHARACTER array.

1502	AHM	26-Feb-82
	Make NAMGEN divide the size of  a character array by the  size
	of a  character array  element so  that the  size field  in  a
	NAMELIST block is in number  of array elements.  Also make  it
	not divide character  array factors by  anything so that  they
	are in units of bytes.  NAMGEN was dividing by 2 in both cases
	because DBLFLG was  set.  Finally, change  the array size  and
	offset fields to occupy separate  words of the NAMELIST  block
	for extended addressing.

1507	AHM	14-Mar-82
	Make all  I/O  list calls  to  IOIMMED use  IOPTR  instead  to
	eliminate immediate I/O list arguments.  Also delete ELISTINCR
	and make all its calls go to IOPTR since the problem with zero
	immediate words looking like an I/O list end cannot occur.

1516	CKS	22-Mar-82
	Reorder code in IOFORMAT to correctly generate code for character
	expressions as FMT= specifiers.  Also add CGFMT routine to call
	CGETVAL when necessary to generate code for nontrivial format
	expression.

1533	TFV	17-May-82
	Modify code generation  for I/O, OPEN  and CLOSE statements  and
	iolists to  generate  calls to  CHMRK.  and CHUNW.  for  dynamic
	character concatenations.   Add the  routine CGIOUNW  to do  the
	code generation.  It also generates special error handling  code
	to unwind before an  END or ERR branch.   Also generate a  dummy
	ERR branch if IOSTAT is specified but ERR is not.

1545	CKS	28-May-81	Q10-103
	Fix check for namelist IO in CGREAD and CGWRITE to not detect
	constants as namelists.  Character constants are now possible
	format specifiers.

1574	AHM	3-Jul-82
	Make REDORWRIT  supply a  type code  of 7  (TYPLABEL) for  the
	pointer to the namelist block in argument blocks for calls  to
	NLI. and NLO.  It used to be a type 0 (immediate) argument.


1625	RVM	30-Aug-82
	Don't output a format size keyword was for list-directed I/O.

1622	CKS/AHM	8-Sep-82
	Or together indirect bits in IOPTR, don't add them.  (Actually or
	together whole index/indirect field, but the index field of one
	operand must be zero.)

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

2003	TJK	27-Sep-83
	Add check to IOFORMAT to allow a format specifier to be
	a REAL or LOGICAL variable (instead of just INTEGER).

2040	TJK	23-Feb-84
	Reorder calls for  complexity, register  allocation, and  code
	generation of I/O keywords.  Most of this was already done  in
	V10 in edit  2201, although register  allocation for FIND  was
	still incorrect.

2056	TJK/MEM		4-Jun-84
	Fix CGCGO to  generate correct  code for  computed GOTOs  when
	they are the terminal statements of DO-loops.  Previously,  if
	the index value was out of range, control would be transferred
	to the next statement and out of the loop.

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

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

2201	TFV	30-Mar-83
	INQUIRE implementation.   Add  case  to  CGSTMNT  and  CGIOARGS.
	Write CGINQUIRE  to  do the  work.   Modify OPNFARGS  to  handle
	FILE=.

2314	AHM	26-Feb-84
	Eliminate immediate arguments for OTSKFSIZ (format size)
	FOROTS arguments because size of large arrays don't fit in 18
	bits.  Make IOFORMAT use ARACONSIZ field of dimension table
	entries for size of non-adjustably dimensioned arrays.

2317	AHM	4-Mar-84
	Make IOPTR and IOFORMAT use GENREF to construct memory
	references instead of doing it themselves.  Delete vestiges of
	support for unimplemented IOREPEAT argument for MTOP. calls
	from CGIOARGS (it used immediate arguments).  Make CGDECARGS
	generate a non-immediate OTSKEDSIZ argument for ENCODE/DECODE
	record sizes.

2400	TJK	18-Jun-84
	Have CAE1LIST and CAE2LIST use  the new FOROTS argument  types
	OTSNSLIST, OTSNELIST, OTSNSLIST77, and OTSNELIST77.  Note that
	CGSLIST still uses OTSSLIST.

2462	AHM	2-Oct-84
	Use execrable TRUE/FALSE/TRUTH/FALSITY miasma for booleans in
	calls to GENREF to satisfy programming conventions.

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

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

***** Begin Version 11 *****

4500	MEM	22-Jan-85
	Added routine CGOPKEY to generate code for the expressions pointed to
	by IOKEY, and added routine to control the generation of the secondary
	argument block for the KEY= specifier in OPEN statements.

4501	MEM	22-Jan-85
	Added CGRDKEY to generate code for the expression pointed to by IOKEY
	for READ statements, and modified REDORWRIT to generate the FOROTS
	arguments for the KEYID= specifier, the key relational value and the
	key relation indicator.

4502	MEM	22-Jan-85
	Add CGDELE to perform code generation for the DELETE statement.
	Modify CGIOARGS to generate the arglist for the DELETE statement.

4503	MEM	22-Jan-85
	Add CGREWR to perform code generation for the REWRITE statement.
	Modify CGIOARGS to generate the arglist for the REWRITE statement.

4504	MEM	22-Jan-85
	Add CGUNLCK to perform code generation for the UNLOCKstatement.
	Modify CGIOARGS to generate the arglist for the UNLOCK statement.

4517	MEM	4-Oct-85
	Modify CGASMNT to handle 1-char asmnt.

4525	CDM	22-Nov-85
	Simple change to IOFORM in CGSTMN.  A DO index in a format
	specifier can be a regcontents node by code generation.  A
	definite error, but not worth an internal compiler error.
	For this particular case, tone it down, and give something
	a little less severe.

4527	CDM	1-Jan-86
	VMS Long symbols phase II.  Convert all internal symbols from
	one word of Sixbit to [length,,pointer].

4532	MEM	19-Feb-86
	Add long symbol support: For namelists put out pointer to sixbitz
	symbol names instead of symbol name.

4533	CDM	1-Apr-86
	Fix for long symbols with NAMELIST.  TBLSEARCH is being called
	later in the compiler than has been before.  SNADDR and SNREF
	are shared in memory for labels.  They are used for different
	purposes in code generation and previous to code generation.
	Fix TESTENTRY to not change SNREF if SNADDR has been set for
	code generation.
	Don't put out a word of zero for NAMELIST names unless its 
	really needed.
	Set NAME for TBLSEARCH.

4535	CDM	13-May-86
	Make Link do a 30 bit fixup for a one word pointer to a label
	/EXTEND.  This shows up in NAMELIST processing, since we have
	labels pointing to Sixbit for the names.

ENDV11

)%

SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE REQREL.BLI;	;[4532]
SWITCHES LIST;

FORWARD
	CGSTMNT,
	CGASMNT,
	CGASSI,
	CGAGO,
	CGCGO,
	CGLOGIF,
	CGEND,
	CGSTOP,
	CGPAUSE,
	CGARIF,
	CGCMNSUB,
	CGIOLST,
	CGE1LIST(1),
	CGE2LIST(1),
	CGIOCALL(1),
	COUNTARGS,
	OIFIW,
	CGIOLARGS,
	CGDCALL,
	CGSLIST,
	CAE1LIST,
	CAE2LIST,
	CGSTPAUARGS,
%1533%	CGIOUNW,	! Routine to generate calls to CHUNW.
	CGMTOP,
	CGENCO,
	CGDECO,
	CGRERE,
	CGUNIT,
%1516%	CGFMT,
	CGRECNUM,
%1123%	CGIOSTAT,
%4501%	CGRDKEY,	!Evaluate expresssions pointed to by IOKEY for read stm
	CGREAD,
	CGWRIT,
%4503%	CGREWR,
%4504%	CGUNLCK,	!UNLOCK
	CGOPLST,
%4500%	CGOPKEY,
	CGOPEN,
	CGFIND,
%4502%	CGDELE,		!DELETE
	CGCLOS,
%2201%	CGINQUIRE,	! INQUIRE
	CGDECARGS,
	IO1ARG(1),
	OPNFARGS,
%760%	CNTKEYS,
%1401%	IOENDERR,
%1401%	IOFORMAT,
	IOPTR(1),
%1401%	IOIMMED(1),
%4500%	OPNKEYS,	!Generate secondary arg block for keys for open stm
	CGOPARGS,
	CGIOARGS,
%1401%	REDORWRIT,
	NAMGEN;

EXTERNAL
	A1LABEL,
	PEXPRNODE A1NODE,
	A2LABEL,
	PEXPRNODE A2NODE,
	A3LABEL,
	C1H,
	CGARGEVAL,
	CGARGS,
	CGARREF, 
	CGCBOOL,
%1533%	CGCHMRK,	! Routine to generate a call to CHMRK.
%1533%	CGCHUNW,	! Routine to generate a call to CHUNW.
	CGDOEND,
	CGDOLOOP,
	CGEPILOGUE,
	CGERR,
	CGETVAL,
	CGFNCALL,
	CGOPGEN,
	CGPROEPI,
	CGREL1,
	CGRETURN,
	CGSBPRGM,
	CGSFN,
%1401%	BASE CSTMNT,		! Points to the statement being looked at
	DEFLAB,
	E91,
%4525%	E211,
%1002%	EVALTAB EVALU,		! Table of  value-type codes
	FATLERR,
%2317%	GENREF,			! Constructs memory references
	GENLAB,
%4532%	ILABIX,			! Counter for GENLAB
	MTOPFUN,
	NAMLPTR,
	NEDZER,		! Flag to indicate if zero-arg-block needed
	OBUFF,
	OBUFFA,
	ONEPLIT,		! Points to the constant 1
%761%	OPASIN,
%761%	OPCMGET,
	OPDSPIX,
	OPGAI1,
	OPGAI2,
	OPGAIF,
%761%	OPGARI,
%761%	OPGASI,
	OPGASR,
	OPGBOOL,
	OPGCGI,
	OPGCGO,
	OPGCLO,
%711%	OPGDEC,
%4502%	OPGDEL,		! DELETE
%711%	OPGENC,
	OPGENDISP,
%761%	OPGETI,
	OPGEXI,
%1401%	OPGFIN,		! OPGNTA table entry for PUSHJ P,FIN.
	OPGFND,
%1471%	OPGIFI,
%1471%	OPGIFO,
%1471%	OPGIN,
%2001%	OPGINF,		! INQUIRE by file
%2001%	OPGINU,		! INQUIRE by unit
	OPGIOL,
	OPGMTO,
%1471%	OPGNLI,
%1471%	OPGNLO,
	OPGOPE,
%1471%	OPGOUT,
	OPGPAU,
	OPGREL,
%4503%	OPGRWF,		!formatted REWRITE
%4503%	OPGRWU,		!unformatted REWRITE
%1471%	OPGRTB,
%761%	OPGSTI,
	OPGSTP,
	OPGVTS,
%4504%	OPGULC,
%1471%	OPGWTB,
	OUTMOD,
	PPEEPFRAME PBFPTR,
%1401%	OBJECTCODE PBOPWD,	! Gets the word to  be output for  calls
				! to the routines OBUFF and OBUFFA
	PEEPOPTIMZ,
%1401%	PEXPRNODE PSYMPTR,	! Points to the STE (or constant table
				! entry) to provide relocation info
	REGFORCOMP,
%4532%	TBLSEARCH,
	PEXPRNODE TREEPTR,
	XCTFDDT,		! Routine to generate "XCT FDDT."
	ZERBLK;

OWN BASE TOPSTMNT;	! This  variable   points  to   the  top   level
			! statement  node  when  there  is  a  statement
			! embedded inside another (e.g. in logical IFs).
GLOBAL ROUTINE CGSTMNT=
BEGIN
	!***************************************************************
	! Perform code  generation for  a  statement.  Called  with  the
	! global CSTMNT pointing to the  statement for which code is  to
	! be generated.  The complexity walk, allocation walk, and  code
	! generation walk must do the  fields for each statement in  the
	! same order.
	!***************************************************************

	! If there is a  label on this  statement, associate that  label
	! with the current location

	IF .CSTMNT[SRCLBL] NEQ 0
	THEN DEFLAB(.CSTMNT[SRCLBL]);

	! Set ISN field for next instruction to be generated

	PBFPTR[PBFISN] = .CSTMNT[SRCISN];

	IF .FLGREG<DBGTRAC>	! If user specified /DEB:TRACE
	THEN	IF .CSTMNT[SRCID] NEQ ENTRID AND .CSTMNT[SRCID] NEQ SFNID
	THEN	XCTFDDT();	! Generate XCT FDDT.

	! Generate code for the statement

	CASE .CSTMNT[SRCID] OF SET

	CGASMNT();		! ASSIGNMENT
	CGASSI();		! ASSIGN

	BEGIN			! CALL
		IF .CSTMNT[SRCCOMNSUB] NEQ 0
		THEN CGCMNSUB();	! Generate code for common subs

		CGSBPRGM(.CSTMNT[CALLIST],.CSTMNT[CALSYM]);	
	END;

	BEGIN END;		! CONTINUE
	CGDOLOOP();		! DO
	CGPROEPI();		! ENTRY
	CGASMNT();		! COMMON SUBEXPR - SAME AS ASSIGNMENT
	JRSTGEN(.CSTMNT[GOTOLBL]);	! GOTO
	CGAGO();		! ASSIGNED GOTO
	CGCGO();		! COMPUTED GOTO
	CGARIF();		! ARITHMETIC IF
	CGLOGIF();		! LOGICAL IF
	CGRETURN(.CSTMNT[RETEXPR]);	! RETURN
	CGSTOP();		! STOP

	CGREAD();		! READ
	CGWRIT();		! WRITE
	CGDECO();		! DECODE
	CGENCO();		! ENCODE
	CGRERE();		! REREAD
	CGFIND();		! FIND
	CGCLOS();		! CLOSE
%4502%	CGDELE();		! DELETE
%4503%	CGREWR();		! REWRITE

	CGMTOP();		! BACKSPACE
	CGMTOP();		! BACKFILE
	CGMTOP();		! REWIND
	CGMTOP();		! SKIP FILE
	CGMTOP();		! SKIP RECORD
	CGMTOP();		! UNLOAD
%4504%	CGUNLCK();		! UNLOCK
	CGMTOP();		! ENDFILE

	CGEND();		! END
	CGPAUSE();		! PAUSE
	CGOPEN();		! OPEN
	CGSFN();		! STATEMENT FN
	BEGIN END;		! FORMAT - NO CODE GENERATED
	BEGIN END;		! BLT (NOT IN RELEASE 1)
	BEGIN END;		! OVERLAY ID
%2201%	CGINQUIRE();		! INQUIRE
	TES;

	! If this statement has a label, check for whether it ends a DO loop

	IF .CSTMNT[SRCLBL] NEQ 0
	THEN CGDOEND(.CSTMNT[SRCLBL]);

END;	! of CGSTMNT
GLOBAL ROUTINE CGASMNT=
BEGIN
	!***************************************************************
	! Generate code  for  assignment statements.   Called  with  the
	! global CSTMNT pointing to the  statement for which code is  to
	! be generated.
	!***************************************************************

	%(***COMPUTE THE VALUES OF ANY COMMON SUBEXPRS ASSOCIATED WITH THIS STATEMENT***)%
	IF .CSTMNT[SRCCOMNSUB] NEQ 0 THEN CGCMNSUB();

			
	%(***GET THE VALUE OF THE LEFT HAND SIDE OF THE STATEMENT AND THE ADDRESS
		OF THE RIGHT HAND SIDE WITHIN REACH OF ONE INSTRUCTION***)%

%4517%	TREEPTR = .CSTMNT[LHEXP];

	IF .CSTMNT[A1VALFLG]
		OR (.CSTMNT[MEMCMPFLG] AND .CSTMNT[RVRSFLG]
%4517%		    AND .TREEPTR[OPR1] NEQ CHARFNFL) 
						!IF RHS IS COMPUTED DIRECTLY TO
						! MEMORY LOC OF LHS AND VAL OF LHS NEEDNT BE PRELOADED

	THEN
	BEGIN
		IF NOT .CSTMNT[A2VALFLG]
		THEN
		BEGIN
			TREEPTR_.CSTMNT[RHEXP];
			CGETVAL();
		END;
	END
	ELSE
	IF .CSTMNT[A2VALFLG]
	THEN
	BEGIN
		TREEPTR_.CSTMNT[LHEXP];	
		CGETVAL();
	END
	ELSE
	IF .CSTMNT[RVRSFLG]
	THEN
	%(***IF RIGHT-HAND SIDE SHOULD BE EVALUATED FIRST***)%
	BEGIN
		TREEPTR_.CSTMNT[RHEXP];
		CGETVAL();
		TREEPTR_.CSTMNT[LHEXP];
		CGETVAL();
	END
	ELSE
	%(***IF LEFT-HAND SIDE SHOULD BE EVALUATED FIRST***)%
	BEGIN
		TREEPTR_.CSTMNT[LHEXP];
		CGETVAL();
		TREEPTR_.CSTMNT[RHEXP];
		CGETVAL();
	END;





	%(***IF THE RHS WAS NOT COMPUTED DIRECTLY INTO THE MEMORY LOC FOR THE LHS, PICK UP THE
		RHS AND STORE IT INTO THE LHS*******)%
	IF NOT .CSTMNT[MEMCMPFLG]
	THEN
	BEGIN
		REGFORCOMP_GETASMNREG(CSTMNT);
		%(***GET VAL OF RIGHT-HAND SIDE INTO REG FOR COMPUTATION OF THE STMNT***)%
		A1NODE_.CSTMNT[RHEXP];
		TREEPTR_.CSTMNT;
		OPDSPIX_GETA2OPIX(CSTMNT,A1NODE);
		CGOPGEN();

		%(***STORE THE VALUE FROM REG-FOR-COMPUTATION INTO THE ADDRESS
			SPECIFIED BY THE LEFT-HAND-SIDE***)%
		IF NOT .CSTMNT[A1SAMEFLG]
		THEN
		BEGIN
			TREEPTR_.CSTMNT[LHEXP];
			OPDSPIX_ASNOPIX(CSTMNT,TREEPTR);
			CGOPGEN();
		END;
	END;

END;	! of CGASMNT
GLOBAL ROUTINE CGASSI=
BEGIN
	!***************************************************************
	! Generate code for an ASSIGN statement.  Note that the variable
	! will always be loaded into register 1.
	!***************************************************************

	%(***IF THE ASSIGNED VAR IS AN ARRAYREF, GENERATE CODE TO COMPUTE ITS ADDR***)%
	TREEPTR_.CSTMNT[ASISYM];
	IF .TREEPTR[OPRCLS] EQL ARRAYREF
	THEN
	CGETVAL();

	%(***COMPUTE THE ASSIGN*******)%
	A1NODE_.CSTMNT[ASISYM];
	A1LABEL_.CSTMNT[ASILBL];
	OPDSPIX_OPASIN;
	CGOPGEN();

END;	! of CGASSI
GLOBAL ROUTINE CGAGO=
BEGIN
	!***************************************************************
	! Generates code  for  ASSIGNed  GOTO  statement.   Called  with
	! CSTMNT pointing to the statement  to be processed.  If a  list
	! of labels was specified for this statement, code generated is:
	!
	!	HRRZ	1,VAR		; Get the local address
	!	CAIN	1,LAB1
	!	JRST	LAB1
	!	CAIN	1,LAB2
	!	JRST	LAB2
	!	....
	!
	! If not, the code generated is:
	!
	!	SKIPE	1,VAR
	!	JRST	0(1)
	!***************************************************************

! Opcodes needed for code for ASSIGNed GOTO

BIND	HRRZOC=#550^27,
	CAINOC=#306^27,
	SKIPEOC=#332^27;

! Always use register 1 to hold the assigned var

BIND	AGOREG=1^23,
	AGORGIX=1^18;

OWN	AGOLSTPTR,
	PEXPRNODE AGOVAR;

! Set up the globals  PBOPWD and PSYMPTR used  by the output routine  to
! indicate an address reference to the assigned variable

	AGOVAR_.CSTMNT[AGOTOLBL];

	IF .AGOVAR[OPRCLS] EQL ARRAYREF
	THEN	! Assigned var is an array reference
	BEGIN
		TREEPTR_.AGOVAR;
		CGETVAL();

		PSYMPTR_.AGOVAR[ARG1PTR];	! STE for the array
		PBOPWD_.AGOVAR[TARGET];		! Address field to reference
						!  the array element desired
	END
	ELSE	! Assigned var is a scalar
	BEGIN
		PSYMPTR_.AGOVAR;
		PBOPWD_.AGOVAR[IDADDR];
	END;

	IF .CSTMNT[GOTOLIST] EQL 0
	THEN	! No list of labels was specified
	BEGIN
		PBOPWD_.PBOPWD OR SKIPEOC OR AGOREG;	! Generate SKIPE 1,VAR
		OBUFF();

		PSYMPTR_PBFNOSYM;
		PBOPWD_JRSTOC OR AGORGIX;		! Generate JRST 0(1)
		OBUFF();
	END
	ELSE	! A list of labels was specified
	BEGIN
		PBOPWD_.PBOPWD OR HRRZOC OR AGOREG;	! Generate HRRZ 1,VAR
		OBUFF();

! For each label in the list, compare  reg 1 with the label and if  it
! is equal, transfer to the label

		AGOLSTPTR_.CSTMNT[GOTOLIST];
		DECR CT FROM .CSTMNT[GOTONUM] TO 1
		DO
		BEGIN
			PBOPWD_CAINOC OR AGOREG OR @.AGOLSTPTR;
			PSYMPTR_PBFLABREF;
			OBUFF();
			JRSTGEN(@.AGOLSTPTR);
			AGOLSTPTR_.AGOLSTPTR+1;
		END;
	END;

END;	! of CGAGO
GLOBAL ROUTINE CGCGO=
BEGIN
	!***************************************************************
	! Generates code for the  computed GOTO statement.  Called  with
	! the global CSTMNT  pointing to the  statement.  The  generated
	! code is:
	!		SKIPLE	01,VAL
	!		CAILE	01,CT
	!		JRST	Y
	!		JRST	@.(1)
	!		IFIW	L1
	!		IFIW	L2
	!		....
	!
%2056%	!	   Y:	First instruction after computed GOTO code
%2056%	!		(note -- Y may precede DO-loop code for a DO-loop
%2056%	!		ending on the computed GOTO).
	!***************************************************************

BIND	SKIPLEOC=#333^27,	! Define opcodes used for computed GOTO
	CAILEOC=#303^27,
	SKIPAOC=#334^27;

BIND	CGOREG=1^23,		! Use register 1 to hold the computed val
	CGORGIX=1^18;

	OWN PEXPRNODE CGOEXP;
	OWN CLOC;
	OWN CGOLSTPTR;

%2056%	REGISTER BASE YLAB;	! Holds pointer to label Y (see comment at
%2056%				! beginning of routine)

	! Compute the values of any common subexprs associated with this stmnt

	IF .CSTMNT[SRCCOMNSUB] NEQ 0 THEN CGCMNSUB();

	! If the expression is not a scalar or a common sub, evaluate it

	CGOEXP=.CSTMNT[CGOTOLBL];
	IF .CGOEXP[OPRCLS] NEQ DATAOPR AND .CGOEXP[OPRCLS] NEQ CMNSUB
	THEN
	BEGIN
		TREEPTR=.CGOEXP;
		CGETVAL();
	END;

	! Generate the SKIPLE, CAILE, JRST sequence

%2056%	! Create label Y (see comment at beginning of routine)
%2056%
%2056%	A1LABEL = YLAB = GENLAB();

	A1NODE=.CGOEXP;
	C1H=.CSTMNT[GOTONUM];

	! Have a special case when the expression is the loop index of a loop in
	! which the index is stored  in the right half of  an AC.  In this  case
	! generate:

	!		MOVEI	1,0(LOOPAC)
	!		JUMPLE	1,Y
	!		CAILE	1,CT
	!		JRST	Y

	IF .CSTMNT[A1IMMEDFLG] AND .CGOEXP[OPRCLS] EQL REGCONTENTS
	THEN OPDSPIX=OPGCGI
	ELSE OPDSPIX=OPGCGO;
	CGOPGEN();


	! Associate a label with the current loc

	CLOC=GENLAB();
	DEFLAB(.CLOC);

! Generate JRST @CLOC(1)

	PBOPWD=JRSTOC OR INDBIT OR CGORGIX OR .CLOC;
	PSYMPTR=PBFLABREF;
	OBUFF();

! For each label listed, generate "IFIW label"

	PSYMPTR=PBFLABREF;
	CGOLSTPTR=.CSTMNT[GOTOLIST];
	DECR CT FROM .CSTMNT[GOTONUM] TO 1
	DO
	BEGIN
		PBOPWD=@.CGOLSTPTR;
%1401%		PBOPWD[OTSIFIW]=1;		! Make this an IFIW
		OBUFF();
		CGOLSTPTR=.CGOLSTPTR+1
	END;

%2056%	! Output label Y to peephole buffer (see comment at beginning of
%2056%	! routine).
%2056%
%2056%	DEFLAB(.YLAB);

END;	! of CGCGO
GLOBAL ROUTINE CGLOGIF=
%(***************************************************************************
	ROUTINE TO GENERATE CODE FOR LOGICAL IF STATEMENTS.
	CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT FOR
	WHICH CODE IS TO BE GENERATED.
	A LOGICAL IF STATEMENT NODE MAY HAVE THE FLAG "A1NOTFLG" SET, WHICH
	MEANS TO TAKE THE "NOT" (COMPLEMENT) OF THE CONDITION SPECIFIED.
	BECAUSE "NOT" PROPAGATES OVER BOTH BOOLEANS AND RELATIONALS, IT IS ASSUMED
	THAT THIS FLAG WILL NEVER BE SET WHEN THE CONDITION IS A BOOLEAN OR RELATIONAL.
***************************************************************************)%
BEGIN
	OWN THENLAB,ELSELAB;		!NEW LABEL TABLE ENTRIES
					!WHICH WILL BE CREATED TO PROCESS
					! THIS STMNT
	OWN BASE SUBSTATMNT;		!STATEMENT TO BE EXECUTED IF CONDITION HOLDS
	OWN BASE SAVSTMNT;		!SAVE PTR TO THE LOG IF  STATEMENT
	OWN PEXPRNODE CONDEXPR;		!CONDITIONAL EXPRESSION TO BE TESTED

	%(***EVALUATE ANY COMMON SUBEXPRESSIONS UNDER THIS STATEMENT***)%
	IF .CSTMNT[SRCCOMNSUB] NEQ 0 THEN CGCMNSUB();


	SUBSTATMNT_.CSTMNT[LIFSTATE];
	CONDEXPR_.CSTMNT[LIFEXPR];
	TREEPTR_.CSTMNT[LIFEXPR];

	%(*****WHEN THE STATEMENT TO BE EXECUTED IF  CONDITION IS TRUE IS A GOTO***)%
	IF .SUBSTATMNT[SRCID] EQL GOTOID
	THEN
	BEGIN
		%(****IF THE CONDITION TO BE TESTED IS A RELATIONAL***)%
		IF .CONDEXPR[OPRCLS] EQL  RELATIONAL
		THEN
		BEGIN
			CGREL1(FALSE);		!SKIP NEXT INSTR IF REL IS FALSE
			%(***GENERATE A JRST TO THE GOTO-LABEL***)%
			JRSTGEN(.SUBSTATMNT[GOTOLBL]);
		END

		%(***IF THE CONDITION TO BE TESTED IS A BOOLEAN***)%
		ELSE
		IF .CONDEXPR[OPRCLS] EQL BOOLEAN
		THEN
		BEGIN
			ELSELAB_GENLAB();	!CREATE LABEL TABLE ENTRY FOR LABEL
						! TO GO TO IF CONDITION IS FALSE
			CGCBOOL(.SUBSTATMNT[GOTOLBL],.ELSELAB);
			DEFLAB(.ELSELAB);
		END


		ELSE
		%(***IF CONDITION IS NOT A RELATIONAL OR BOOLEAN, EVALUATE THE CONDEXPR AND
			TEST WHETHER IS IS TRUE (SIGN BIT EQUAL 1) OR FALSE(SIGN=0) ***)%
		BEGIN
			CGETVAL();

			%(***TEST VAL OF CONDEXPR,
				IF "A1NOTFLG" IS SET, TRANSFER TO GOTO-LABEL IF ARG IS
				FALSE, OTHERWISE TRANSFER TO GOTOLABEL IF ARG IS TRUE***)%
			OPDSPIX_CNDVTRIX(CONDEXPR,(IF .CSTMNT[A1NOTFLG] THEN FALSE ELSE TRUE));
			A1LABEL_.SUBSTATMNT[GOTOLBL];
			TREEPTR_.CONDEXPR;
			REGFORCOMP_GETTAC(TREEPTR);
			CGOPGEN();
		END;

	END


	%(****WHEN STATEMENT TO BE EXECUTED ON TRUE CONDITION IS NOT A GOTO***)%
	ELSE
	BEGIN
		ELSELAB_GENLAB();		!CREATE LABEL TABLE ENTRY FOR LABEL
						! TO GO TO WHEN CONDITION IS FALSE

		%(***IF CONDITION TO BE TESTED IS A RELATIONAL***)%
		IF .CONDEXPR[OPRCLS] EQL RELATIONAL
		THEN
		BEGIN
			CGREL1(TRUE);		!SKIP NEXT INSTR IF REL IS TRUE
			%(***GENERTAE CODE TO GO TO THE LABEL ON THE CODE FOLLOWING THAT
				FOR THE SUBSTATMNT OF THE IF STMNT***)%
			JRSTGEN(.ELSELAB);
		END

		%(***IF THE CONDITION TO BE TESTED IS A BOOLEAN*****)%
		ELSE
		IF .CONDEXPR[OPRCLS] EQL BOOLEAN
		THEN
		BEGIN
			THENLAB_GENLAB();	!CREATE LABEL TABLE ENTRY FOR LABEL TO
						! GO TO WHEN CONDITION IS TRUE
			CGCBOOL(.THENLAB,.ELSELAB);
			DEFLAB(.THENLAB);	!ASSOCIATE THIS LOC WITH THENLAB
		END

		%(***IF CONDITIONAL EXPRESSION IS NOT A REL OR BOOLEAN, EVALUATE IT AND
			TEST WHETHER ITS VAL IS TRUE (SIGN=1) OR FALSE (SIGN=0)***)%
		ELSE
		BEGIN
			CGETVAL();

			%(***TEST VAL OF CONDEXPR,
				IF "A1NOTFLG" IS SET, TRANSFER TO ELSELAB IF VAL IS TRUE
				OTHERWISE TRANSFER TO ELSELAB IF VAL IS FALSE***)%
			OPDSPIX_CNDVTRIX(CONDEXPR,(IF .CSTMNT[A1NOTFLG] THEN TRUE ELSE FALSE));
			A1LABEL_.ELSELAB;
			TREEPTR_.CONDEXPR;
			REGFORCOMP_GETTAC(TREEPTR);
			CGOPGEN();
		END;

		%(****GENERATE CODE FOR THE STATEMENT TO BE EXECUTED WHEN THE CONDITION IS TRUE***)%
		TOPSTMNT_.CSTMNT;	!SAVE A PTR TO THIS "TOP-LEVEL" STMNT 
		SAVSTMNT_.CSTMNT;
		CSTMNT_.SUBSTATMNT;
		CGSTMNT();
		CSTMNT_.SAVSTMNT;		!RESTORE THE GLOBAL CSTMNT

		%(***ASSOCIATE THIS LOC WITH THE LABEL TRANSFERED TO WHEN THE CONDITION
			IS FALSE****)%
		DEFLAB(.ELSELAB);

	END;

END;	! of CGLOGIF
GLOBAL ROUTINE CGEND=
%(*********************************************************
	TO GENERATE CODE FOR AN END STATEMENT
**********************************************************)%
BEGIN

	!AN END TRIGGERS A CALL TO EXIT ONLY IN A MAIN
	!PROGRAM, NOT FOR A SUBPROGRAM
	!IN A SUBPROGRAM THE END TRIGGERS A RETURN.

	IF .FLGREG<PROGTYP> EQL MAPROG
	THEN
	BEGIN
		NEDZER _ 1;		! FLAG ZERO-ARG-BLOCK NEEDED
		A1LABEL_.ZERBLK;	!ARGLIST FOR CALL TO EXIT IS ALWAYS
					! 0 FOR THE END STMNT
		OPDSPIX_OPGEXI;
		CGOPGEN();
	END
	ELSE
	!ALSO CHECK FOR A BLOCK DATA SUBPROGRAM
	IF .FLGREG<PROGTYP> NEQ BKPROG 
	THEN
	BEGIN
		!IF THERE ARE MULTIPLE ENTRIES OR LABELS AS ARGS
		IF .FLGREG<MULTENT> OR .FLGREG<LABLDUM>
						! HAS MULTIPLE ENTRIES
		THEN CGRETURN(0);		! GENERATE CODE TO "RETURN"

		!FOR A SINGLE ENTRY SUBPROGRAM GENERATE THE
		!EPILOGUE

		IF NOT .FLGREG<MULTENT>
		THEN
		BEGIN
			REGISTER BASE TSTMNT;
			TSTMNT_.SORCPTR<LEFT>;	!PTR TO 1ST STMNT IN PROG
			WHILE .TSTMNT[SRCID] NEQ ENTRID
			DO
			BEGIN
				TSTMNT_.TSTMNT[CLINK];	!(SKIP  DUMMY CONTINUES)
				IF .TSTMNT EQL 0 THEN CGERR()	!IF NEVER FIND THE ENTRY
			END;
			CGEPILOGUE(.TSTMNT);	!GENERATE THE EPILOGUE CORRESPONDING TO THIS ENTRY
		END;

	END

END;	! of CGEND
GLOBAL ROUTINE CGSTOP=
%(***************************************************************************
	TO GENERATE CODE FOR A STOP STMNT
***************************************************************************)%
BEGIN

	%(***USE THE ZERO-ARG-BLOCK AS THE ARG BLOCK FOR THIS CALL TO FOROTS***)%
	A1LABEL_(IF .CSTMNT[STOPIDENT] EQL 0	!IF DO NOT HAVE A CNST
						! TO PRINT OUT, THEN ARGLIST
						! FOR EXIT WILL BE 0
			THEN (NEDZER _ 1; .ZERBLK)	! FLAG ZERO-ARG-BLOCK NEEDED
			ELSE GENLAB() );	!IF HAVE AN ARG TO
						! PASS TO EXIT, ASSOCIATE A LABEL
						! WITH THE ARGLIST TO BE GENERATED
	CSTMNT[STOPLBL]_.A1LABEL;	!SAVE LABEL TO BE USED

	OPDSPIX_OPGSTP;
	CGOPGEN();

END;	! of CGSTOP
GLOBAL ROUTINE CGPAUSE=
%(***************************************************************************
	ROUTINE TO GENERATE CODE FOR PAUSE
***************************************************************************)%
BEGIN

	A1LABEL_(IF .CSTMNT[PAUSIDENT] EQL 0	!IF DO NOT HAVE A CNST
						! TO PRINT OUT, THEN ARGLIST
						! FOR FOROTS "PAUSE" ROUTINE WILL BE 0
			THEN (NEDZER _ 1; .ZERBLK)	! FLAG ZERO-ARG-BLOCK NEEDED
			ELSE GENLAB() );	!IF HAVE AN ARG TO
						! PASS TO FOROTS, ASSOCIATE A LABEL
						! WITH THE ARGLIST TO BE GENERATED
	CSTMNT[PAUSLBL]_.A1LABEL;


	OPDSPIX_OPGPAU;
	CGOPGEN();

END;	! of CGPAUSE
GLOBAL ROUTINE CGARIF=
%(***************************************************************************
	ROUTINE TO GENERATE CODE FOR AN ARITHMETIC IF STATEMENT.
	CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT
	FOR WHICH CODE IS TO BE GENERATED.
***************************************************************************)%
BEGIN

	OWN BASE NXTSTMNT;
	OWN PEXPRNODE CONDEXPR;		!THE ARITHMETIC EXPRESSION UNDER THIS STMNT

	%(***COMPUTE ANY COMMON SUBEXPRESSIONS UNDER THIS NODE***)%
	IF .CSTMNT[SRCCOMNSUB] NEQ 0 THEN CGCMNSUB();


	%(***DETERMINE WHICH (IF ANY) OF THE 3 LABELS ASSOCIATED WITH
		THIS NODE ARE EQUAL TO THE LABEL ON THE FOLLOWING STMNT***)%
	NXTSTMNT_.CSTMNT[SRCLINK];
	CSTMNT[AIFLBNXT]_
	BEGIN
		IF .CSTMNT[AIFLESS] EQL .NXTSTMNT[SRCLBL]
		THEN LLBNXT
		ELSE
		IF .CSTMNT[AIFEQL] EQL .NXTSTMNT[SRCLBL]
		THEN ELBNXT
		ELSE
		IF .CSTMNT[AIFGTR] EQL .NXTSTMNT[SRCLBL]
		THEN GLBNXT
		ELSE NOLBNXT
	END;


	%(***GET PTR TO THE CONDITIONAL EXPRESSION***)%
	CONDEXPR_.CSTMNT[AIFEXPR];
	TREEPTR_.CONDEXPR;
	%(***COMPUTE THE VAL OF THE ARITH EXPR, THEN TEST IT****)%

	%(***COMPUTE THE VAL OF THE ARITH EXPR***)%
	IF NOT .CSTMNT[A1VALFLG]
	THEN CGETVAL();

	%(***IF THERE IS A NEG ON THE VALUE, EXCHANGE THE GTR AND LESS LABELS***)%
	IF .CSTMNT[A1NEGFLG]
	THEN
	BEGIN
		A1LABEL_.CSTMNT[AIFGTR];
		A3LABEL_.CSTMNT[AIFLESS];
		A2LABEL_.CSTMNT[AIFEQL];

		%(***MODIFY THE "AIFLBNXT" FIELD WHICH INDICATED WHICH OF
			THE 3 LABELS IS ON THE NEXT STMNT (CHANGE "GTR LABEL NEXT"
			TO "LESS LABEL NEXT", "LESS LABEL NEXT" TO
			"GTR LABEL NXT" LEAVE OTHERS UNCHANGED
			MODIFY THE "AIFLBEQV" FIELD SO THAT "GTR LABEL SAME
			AS EQL LABEL" BECOMES "LESS LABEL SAME AS EQL LABEL"
			AND VICE-VERSA
		****)%
		SWPAIFFLGS(CSTMNT);
	END
	ELSE
	BEGIN
		A1LABEL_.CSTMNT[AIFLESS];
		A3LABEL_.CSTMNT[AIFGTR];
		A2LABEL_.CSTMNT[AIFEQL];
	END;

	%(***USE THE TABLE-DRIVER TO GENERATE CODE TO TEST THE VAL AND TRANSFER***)%
	REGFORCOMP_GETAIFREG(CSTMNT);
	OPDSPIX_AIFIX(CSTMNT,CONDEXPR);
	A1NODE_.CONDEXPR;
	CGOPGEN();

END;	! of CGARIF
GLOBAL ROUTINE CGCMNSUB=
%(***************************************************************************
	GENERATE CODE TO EVLUATE ANY COMMON SUBEXPRESSIONS THAT OCCUR UNDER
	THE STATEMENT NODE POINTED TO BY "CSTMNT"
***************************************************************************)%
BEGIN
	OWN PEXPRNODE CCMNSUB;

	%(***COMPUTE THE VALUES OF ANY COMMON SUBEXPRS ASSOCIATED WITH THIS STATEMENT***)%
	CCMNSUB_.CSTMNT[SRCCOMNSUB];
	UNTIL .CCMNSUB EQL 0
	DO
	BEGIN
		IF NOT .CCMNSUB[A2VALFLG]
		THEN
		BEGIN
			TREEPTR_.CCMNSUB[ARG2PTR];
			CGETVAL();
		END;

		%(***IF THE COMMON SUBEXPR IS TO BE LEFT IN A DIFFERENT PLACE THAN
			THAT INTO WHICH IT WAS COMPUTED, PUT IT THERE.
			NOT THAT THIS CAN ONLY OCCUR WHEN THE PLACE IN WHICH
			IT IS TO BE LEFT IS A REGISTER.
		*******)%
		IF NOT .CCMNSUB[A2SAMEFLG]
		THEN
		BEGIN
			A1NODE_.CCMNSUB[ARG2PTR];
			OPDSPIX_GETA2OPIX(CCMNSUB,A1NODE);
			REGFORCOMP_GETTAC(CCMNSUB);
			CGOPGEN();
		END;


		%(***IF THE VAL OF THIS COMMON SUB MUST BE STORED INTO A TMP, GENERATE
			CODE TO DO SO***)%
		IF .CCMNSUB[STOREFLG]
		THEN
		BEGIN
			TREEPTR_.CCMNSUB;
			REGFORCOMP_GETTAC(CCMNSUB);
			OPDSPIX_STOROPIX(CCMNSUB);
			CGOPGEN();
		END;


		CCMNSUB_.CCMNSUB[CLINK];
	END;

END;	! of CGCMNSUB
GLOBAL ROUTINE CGIOLST=
BEGIN
	!***************************************************************
	! Perform code generation for an iolist.  Called with the global
	! CSTMNT pointing to the statement for which an iolist is to  be
	! processed.  For each element in the iolist:
	!		
	!    1.	If the element is a  statement (either a DO, a  CONTINUE
	!	which terminates a DO  loop, or an assignment),  perform
	!	usual code generation for that type of statement.
	!    2. Otherwise, the  element  is  an IOLSCLS  node  (i.e.   a
	!	DATACALL,   SLISTCALL,    IOLSTCALL,   E1LISTCALL,    or
	!	E2LISTCALL).
	!    3. If the  IOLSCLS  node contains  dynamic  concatenations,
	!	generate the call to CHMRK.
	!    4. Perform code  generation  for  all  elements  under  the
	!	IOLSCLS node.
	!    5. Then generate:
	!
	!		XMOVEI	16,ARGBLKP
	!		PUSHJ	17,IOLST.
	!
	!	where ARGBLKP is a pointer to the argument list for this
	!	element.
	!    6. If the  IOLSCLS  node contains  dynamic  concatenations,
	!	generate the call to CHUNW.
	!***************************************************************

	REGISTER
		BASE SAVCSTMNT,
%1533%		BASE SAVSTMNT,
		BASE IOLELEM;

	IOLELEM = .CSTMNT[IOLIST];	! Pointer to first element of IOLIST

	! Save pointer  to current  statement  (CSTMNT is  clobbered  if
	! there are implied Do loops in the IOLIST

	SAVSTMNT = .CSTMNT;

	WHILE .IOLELEM NEQ 0
	DO
	BEGIN	! Walk down the iolist

		IF .IOLELEM[OPRCLS] EQL STATEMENT
		THEN
		BEGIN	! Statement

			CSTMNT = .IOLELEM;
			CGSTMNT();

			! If the  last element  of  the iolist  for  the
			! statement is not an  IOLSCLS node, generate:
			!	PUSHJ P,FIN.

			IF .IOLELEM[CLINK] EQL 0
			THEN
			BEGIN
				OPDSPIX = OPGFIN;
				CGOPGEN();
			END;
		END	! Statement
		ELSE 	IF .IOLELEM[OPRCLS] EQL IOLSCLS
		THEN
		BEGIN	! IOLSCLS node

%1533%			! If the IOLSCLS has dynamic concatenations under it
%1533%			! generate a call to CHMRK.

%1533%			IF .IOLELEM[IOLDYNFLG]
%1533%			THEN CGCHMRK(.SAVSTMNT[IOLMARK]);

			! Evaluate all expressions under this element

			CASE .IOLELEM[OPERSP] OF SET

			BEGIN	! DATACALL

				! Evaluate the expression under the node

				TREEPTR = .IOLELEM[DCALLELEM];

				IF .TREEPTR[OPRCLS] NEQ DATAOPR
				THEN CGETVAL();

			END;	! DATACALL

			BEGIN	! SLISTCALL

				! Evaluate the expression for the number
				! of elements

				TREEPTR = .IOLELEM[SCALLCT];

				IF .TREEPTR[OPRCLS] NEQ DATAOPR
				THEN CGETVAL();

			END;	! SLISTCALL

			! IOLSTCALL - evaluate all expressions under it

			CGIOCALL(.IOLELEM);

			BEGIN	! E1LISTCALL - optimized code only

				SAVCSTMNT = .CSTMNT;
				CSTMNT = .IOLELEM;
				CGCMNSUB();		! Evaluate common subs
				CSTMNT = .SAVCSTMNT;
				CGE1LIST(.IOLELEM)

			END;	! E1LISTCALL - optimized code only

			BEGIN	! E2LISTCALL - optimized code only

				SAVCSTMNT = .CSTMNT;
				CSTMNT = .IOLELEM;
				CGCMNSUB();		! Evaluate common subs
				CSTMNT = .SAVCSTMNT;
				CGE2LIST(.IOLELEM)

			END	! E2LISTCALL - optimized code only

			TES;

			! Create a  label  table  entry  for  the  label
			! associated with  the  argument list  for  this
			! node

			A1LABEL = GENLAB();
			IOLELEM[IOLSTLBL] = .A1LABEL;

			OPDSPIX = OPGIOL;
			CGOPGEN();		! Generate call to IOLST.

%1533%			! If the IOLSCLS has dynamic concatenations under it
%1533%			! generate a call to CHUNW.

%1533%			IF .IOLELEM[IOLDYNFLG]
%1533%			THEN CGCHUNW(.SAVSTMNT[IOLMARK]);

		END	! IOLSCLS node
		ELSE CGERR();

		IOLELEM = .IOLELEM[CLINK];

	END;	! Walk down the iolist

	CSTMNT = .SAVSTMNT;

END;	! of CGIOLST
GLOBAL ROUTINE CGE1LIST(IOLELEM)=
%(**********************************************************************
	ROUTINE TO GENERATE IN LINE CODE FOR
	AN E1LISTCALL NODE
**********************************************************************)%
BEGIN
	MAP BASE IOLELEM;
	LOCAL BASE IOARRAY;
	TREEPTR_.IOLELEM[ECNTPTR];
	IF .TREEPTR[OPRCLS] NEQ DATAOPR
	 THEN CGETVAL();
	TREEPTR_.IOLELEM[E1INCR];
	IF .TREEPTR[OPRCLS] NEQ DATAOPR
	 THEN CGETVAL();
	IOARRAY_.IOLELEM[ELSTPTR];
	WHILE .IOARRAY NEQ 0 DO
	BEGIN
		TREEPTR_.IOARRAY[E2ARREFPTR];
		IF .TREEPTR[OPRCLS] NEQ DATAOPR
		 THEN CGETVAL();
		IOARRAY_.IOARRAY[CLINK]
	END;

!**;[1206], CGE1LIST @4177, DCE, 20-Mar-81
!**;[1206], Output code for assignment statements to set final loop value(s)
%[1206]%
%[1206]%	CSTMNT_.IOLELEM[ELPFVLCHAIN];	! Get head of chain
%[1206]%
%[1206]%	WHILE .CSTMNT NEQ 0 DO
%[1206]%	BEGIN
%[1206]%		CGASMNT();	! Code for assignment statement
%[1206]%		CSTMNT_.CSTMNT[CLINK] ! On to the next...
%[1206]%	END;

END;	! of CGE1LIST
GLOBAL ROUTINE CGE2LIST(IOLELEM)=
%(**********************************************************************
	ROUTINE TO GENERATE INLINE CODE FOR
	AN E2LISTCALL NODE
**********************************************************************)%
BEGIN
	MAP BASE IOLELEM;
	LOCAL BASE IOARRAY;
	TREEPTR_.IOLELEM[ECNTPTR];
	IF .TREEPTR[OPRCLS] NEQ DATAOPR
	 THEN CGETVAL();
	IOARRAY_.IOLELEM[ELSTPTR];
	WHILE .IOARRAY NEQ 0 DO
	BEGIN
		TREEPTR_.IOARRAY[E2INCR];
		IF .TREEPTR[OPRCLS] NEQ DATAOPR
		 THEN CGETVAL();
		IOARRAY_.IOARRAY[CLINK]
	END;
	IOARRAY_.IOLELEM[ELSTPTR];
	WHILE .IOARRAY NEQ 0 DO
	BEGIN
		TREEPTR_.IOARRAY[E2ARREFPTR];
		IF .TREEPTR[OPRCLS] NEQ DATAOPR
		 THEN CGETVAL();
		IOARRAY_.IOARRAY[CLINK]
	END;

!**;[1206], CGE2LIST @4211, DCE, 20-Mar-81
!**;[1206], Output code for assignment statements to set final loop value(s)
%[1206]%
%[1206]%	CSTMNT_.IOLELEM[ELPFVLCHAIN];	! Get head of chain
%[1206]%
%[1206]%	WHILE .CSTMNT NEQ 0 DO
%[1206]%	BEGIN
%[1206]%		CGASMNT();	! Code for assignment statement
%[1206]%		CSTMNT_.CSTMNT[CLINK] ! On to the next...
%[1206]%	END;

END;	! of CGE2LIST
GLOBAL ROUTINE CGIOCALL(IOLSNODE)=
%(***************************************************************************
	ROUTINE TO GENERATE THE CODE FOR AN IOLSTCALL NODE.
	GENERATES CODE TO EVALUATE ALL EXPRESSIONS UNDER THE
	IOLSTCALL.
***************************************************************************)%
BEGIN
	MAP BASE IOLSNODE;
	OWN BASE IOLELEM;
	OWN SAVSTMNT;

	%(***SAVE THE GLOBAL CSTMNT***)%
	SAVSTMNT_.CSTMNT;

	%(***GENERATE CODE FOR ANY COMMON SUBEXPRS UNDER THIS NODE***)%
	CSTMNT_.IOLSNODE;
	CGCMNSUB();

	%(***WALK THRU THE ELEMS UNDER THIS IOLSTCALL***)%
	IOLELEM_.IOLSNODE[IOLSTPTR];
	UNTIL .IOLELEM EQL 0
	DO
	BEGIN
		CASE .IOLELEM[OPERSP] OF SET

		%(***FOR A DATACALL****)%
		BEGIN
			TREEPTR_.IOLELEM[DCALLELEM];
			IF .TREEPTR[OPRCLS] NEQ DATAOPR
			THEN CGETVAL();
		END;

		%(***FOR AN SLISTCALL (AN SLIST THAT HAS ONLY ONE ARRAYREF, AND
			THAT ARRAYREF STARTS AT THE BASE OF THE ARRAY, AND THE
			INCREMENT IS A CONSTANT) ***)%
		BEGIN
			TREEPTR_.IOLELEM[SCALLCT];
			IF .TREEPTR[OPRCLS] NEQ DATAOPR
			THEN CGETVAL();
		END;

		%(***AN IOLSTCALL NODE UNDER ANOTHER IOLSTCALL NODE IS ILLEGAL***)%
		CGERR();

		%(***FOR AN E1LISTCALL - OPTIMIZED CODE ONLY***)%
		BEGIN
		CGE1LIST(.IOLELEM)
		END;

		%(***FOR AN E2LISTCALL - OPTIMIZED CODE ONLY***)%
		BEGIN
		CGE2LIST(.IOLELEM)
		END

		TES;

		IOLELEM_.IOLELEM[CLINK];
	END;

	%(***RESTORE CSTMNT***)%
	CSTMNT_.SAVSTMNT;

END;	! of CGIOCALL
GLOBAL ROUTINE COUNTARGS=
BEGIN

! This routine walks an IOLSCLS node together with all its components to
! count  the  number  of  words  which  are  to  be  generated  for  the
! corresponding argument  list.  It  then puts  out the  -COUNT,,0  word
! which  precedes  the  arguments.   This  routine  is  necessary  since
! optimization may have performed transformations on the argument  list,
! thereby changing  the resulting  argument list(s),  and there  are  no
! fields to preserve  the size  of various IOLSCLS  pieces.  This  would
! also consume a fair amount of space.  Hence this routine.  This entire
! routine is added by edit 1035.

	LOCAL PEXPRNODE IOARRAY;
	LOCAL SAVTREEPTR;
%1401%	REGISTER ACNT;	! For counting the words in the argument list

	ACNT_1;		! Initialize the count - block is always terminated
			! by a zero word or a FIN call.
			! The last shall be first...

	CASE.TREEPTR[OPERSP] OF SET

	%DATACALL%
	ACNT_.ACNT+1;	! Only one item in a DATACALL node

	%SLISTCALL%
	ACNT_.ACNT+3;	! Count, increment, base address

	%IOLSTCALL%
	BEGIN
		SAVTREEPTR_.TREEPTR;
		TREEPTR_.TREEPTR[IOLSTPTR];

		! Walk through the list, counting elements of each list item

		UNTIL .TREEPTR EQL 0 DO
		BEGIN
			CASE .TREEPTR[OPERSP] OF SET

			%DATACALL%
			ACNT_.ACNT+1;	! Only one item in a DATACALL node
		
			%SLISTCALL%
			ACNT_.ACNT+3;	! Count, increment, base address
		
			%IOLSTCALL%
			CGERR();	! IOLSTCALL under IOLSTCALL is illegal
		
			%E1LISTCALL%
			BEGIN
				ACNT_.ACNT+2;	! Count, increment
		
				IOARRAY_.TREEPTR[ELSTPTR];
				WHILE .IOARRAY NEQ 0 DO
				BEGIN
					ACNT_.ACNT+1;	! Add one for each array
					IOARRAY_.IOARRAY[CLINK] ! Get next array
				END
			END;
		
			%E2LISTCALL%
			BEGIN
				ACNT_.ACNT+1;	! ELIST,,count
		
				IOARRAY_.TREEPTR[ELSTPTR];
				WHILE .IOARRAY NEQ 0 DO
				BEGIN
					ACNT_.ACNT+2; ! Increment and base address words
					IOARRAY_.IOARRAY[CLINK]
				END
			END;
		
			TES;

			TREEPTR_.TREEPTR[CLINK]
		END;

		TREEPTR_.SAVTREEPTR;
	END;

	%E1LISTCALL%
	BEGIN
		ACNT_.ACNT+2;	! Count, increment

		IOARRAY_.TREEPTR[ELSTPTR];
		WHILE .IOARRAY NEQ 0 DO
		BEGIN
			ACNT_.ACNT+1;	! Add one for each array
			IOARRAY_.IOARRAY[CLINK] ! Get next array
		END
	END;

	%E2LISTCALL%
	BEGIN
		ACNT_.ACNT+1;	! ELIST,,count

		IOARRAY_.TREEPTR[ELSTPTR];
		WHILE .IOARRAY NEQ 0 DO
		BEGIN
			ACNT_.ACNT+2; ! Increment and base address words
			IOARRAY_.IOARRAY[CLINK]
		END
	END;

	TES;

	! ACNT should now contain the count of argument words - put it out.

	PBOPWD_ (-.ACNT)^18;	! Count to left half
	PSYMPTR_PBF2NOSYM;
	OBUFFA();		! Put out -ACNT,,0

END;	! of COUNTARGS
GLOBAL ROUTINE OIFIW=
BEGIN

![1401] Created to support extended addressing

! Routine to turn a  word into an  IFIW and then  output it via  OBUFFA.
! Takes one implicit argument called  PBOPWD which contains the word  to
! be altered.

	PBOPWD[OTSIFIW]=1;		! Make this an IFIW
	OBUFFA()			! Put the word in the arg block buffer

END;	! of OIFIW
GLOBAL ROUTINE CGIOLARGS=

! Generates the arg blocks for an IOLIST.  Called with the  global
! TREEPTR pointing to the IOLIST.

BEGIN
	OWN SAVTREEPTR;

! Walk thru all the elements on the IOLIST

	UNTIL .TREEPTR EQL 0
	DO
	BEGIN

! Only generate arg blocks for nodes of OPRCLS IOLSCLS (ignore statement nodes)

		IF .TREEPTR[OPRCLS] EQL IOLSCLS
		THEN
		BEGIN
			![1035] Put out the -COUNT,,0 word for argument list
			COUNTARGS();	![1035]

			%(***ASSOCIATE CURRENT LOC WITH THE LABEL ON THIS ARGBLOCK***)%
			DEFLAB(.TREEPTR[IOLSTLBL]);


			%(********GENERATE THE ARG BLOCK************************)%
			CASE .TREEPTR[OPERSP] OF SET

			%(***FOR DATACALL***)%
			CGDCALL();

			%(***FOR SLISTCALL***)%
			CGSLIST();

			%(***FOR IOLSTCALL***)%
			BEGIN
				%(***SAVE VAL OF TREEPTR***)%
				SAVTREEPTR_.TREEPTR;

				%(***WALK THRU THE ELEMENTS UNDER THIS NODE, GENERATING
					ARG BLOCKS FOR THEM***)%
				TREEPTR_.TREEPTR[IOLSTPTR];
				UNTIL .TREEPTR EQL 0
				DO
				BEGIN
					CASE .TREEPTR[OPERSP] OF SET
					CGDCALL();	!FOR A DATACALL
					CGSLIST();	!FOR AN SLIST
					CGERR();	!IOLSTCALL IS ILLEGAL UNDER
							! ANOTHER IOLSTCALL
					CAE1LIST();	!E1LISTCALL NODE
					CAE2LIST()	!E2LISTCALL NODE
					TES;

					TREEPTR_.TREEPTR[CLINK];
				END;

				%(***RESTORE TREEPTR***)%
				TREEPTR_.SAVTREEPTR;
			END;

			%(***FOR AN E1LISTCALL - OPTIMIZED CODE ONLY***)%
			CAE1LIST();

			%(***FOR AN E2LISTCALL - OPTIMIZED CODE ONLY***)%
			CAE2LIST()

			TES;


			%(***IF THIS IS THE LAST ARG-BLOCK FOR THIS STMNT, GENERATE A FIN-BLOCK
				AFTER IT; OTHERWISE GENERATE A ZERO-BLOCK AFTER IT***)%
			PBOPWD_(IF .TREEPTR[CLINK] EQL 0 THEN OTSFINWD ELSE OTSZERWD);
			PSYMPTR_PBF2NOSYM;
			OBUFFA()
		END;

		%(***GO ON TO NEXT ELEMENT***)%
		TREEPTR_.TREEPTR[CLINK];
	END;

END;	! of CGIOLARGS
GLOBAL ROUTINE CGDCALL=
BEGIN

![1401] Rewritten to support extended addressing

! Generates an arg block  for a DATACALL element  in an IOLIST.   Called
! with the global TREEPTR  pointing to the DATACALL  node for which  the
! block is to be generated.

! !=========================================================================!
! !1!0!   OTSDATA   ! Type  !I! Index  !              Address               !
! !=========================================================================!

	PBOPWD=0;			! Init output word to 0
	PBOPWD[OTSIDN]=OTSDATA;		! Set id field to indicate DATA
	IOPTR(.TREEPTR[DCALLELEM])	! Write out the right addr & relocation

END;	! of CGDCALL	
GLOBAL ROUTINE CGSLIST=
BEGIN

![1401] Rewritten to support extended addressing

! Routine to generate an argument block for an SLIST call in an  IOLIST.
! Called with the global TREEPTR  pointing to the SLISTCALL node.   This
! routine is  used  only  for  the  SLISTs  generated  by  phase  1  for
! statements of the form:
!
! 	READ 11,A
!
! where A is an array.  Phase 2 skeleton recognizes IOLISTs that can  be
! transformed into SLISTs and forms E1LISTCALL and E2LISTCALL nodes  for
! these SLISTs (which may have more than one array and increments  other
! than 1).


! !=========================================================================!
! !1!0!   OTSSLIST  !                         Count                         !
! !-------------------------------------------------------------------------!
! !1!0!      0      !                           1                           !
! !-------------------------------------------------------------------------!
! !1!0!      0      ! Type  !I! Index  !              Address               !
! !=========================================================================!


	! Output first word of argblock (contains code for SLIST and count)

	PBOPWD=0;			! Init output word to 0
	PBOPWD[OTSIDN]=OTSSLIST;	! Set IDN field to code for SLIST
%1507%	IOPTR(.TREEPTR[SCALLCT]);	! Emit the count word

	! Output the 2nd word of argblock (points to an increment of 1)

%1507%	PBOPWD=0;
	IOPTR(.ONEPLIT);

	! Output the 3rd word (which contains a ptr to the array to be used)

	PBOPWD=0;
	IOPTR(.TREEPTR[SCALLELEM])

END;	! of CGSLIST
GLOBAL ROUTINE CAE1LIST=
BEGIN

! Generates code  for  an argblk  for  an E1LISTCALL  node.   The  block
! consists of  a count,  an increment  and a  sequence of  addresses  of
! elements.  Called with global TREEPTR pointing to E1LISTCALL node.

! !=========================================================================!
! !1!0!   OTSNSLIST !                         Count                         !
! !-------------------------------------------------------------------------!
! !1!0!      0      !                       Increment                       !
! !=========================================================================!
! !1!0!      0      ! Type  !I! Index  !              Address               !
! !-------------------------------------------------------------------------!
! \                                                                         \
! \                                                                         \
! \                                                                         \
! !=========================================================================!

	REGISTER PEXPRNODE IOARRAY;	! Goes down the list of ELIST elements

! Output first word - contains "SLIST" and count

	PBOPWD=0;			! Initialize word to 0
%1223%	PBOPWD[OTSIDN]=(IF F77		! Set ID field to proper SLIST
%2400%		THEN OTSNSLIST77	! New zero-trip
%2400%		ELSE OTSNSLIST);	! New one-trip
%1507%	IOPTR(.TREEPTR[ECNTPTR]);	! Fill in the count

! Output second word - contains increment

%1507%	PBOPWD=0;
%1401%	IOPTR(.TREEPTR[E1INCR]);

! Output one word for each ARRAYREF under ELSTPTR

	IOARRAY=.TREEPTR[ELSTPTR];		! Get the first
	WHILE .IOARRAY NEQ 0 DO
	BEGIN
		PBOPWD=0;			! Clear target
		IOPTR(.IOARRAY[E2ARREFPTR]);	! Generate argument
		IOARRAY=.IOARRAY[CLINK]		! Go on to the next
	END

END;	! of CAE1LIST
GLOBAL ROUTINE CAE2LIST=
BEGIN

! Routine to generate code  for an argblk for  an E2LISTCALL node.   The
! block consists of a  count and a sequence  of pairs of increments  and
! addresses  of  elements.   Called  with  GLOBAL  TREEPTR  pointing  to
! E2LISTCALL node.

! !=========================================================================!
! !1!0!   OTSNELIST !                         Count                         !
! !=========================================================================!
! !1!0!      0      !                       Increment                       !
! !-------------------------------------------------------------------------!
! !1!0!      0      ! Type  !I! Index  !              Address               !
! !-------------------------------------------------------------------------!
! \                                                                         \
! \                                                                         \
! \                                                                         \
! !=========================================================================!

	REGISTER PEXPRNODE IOARRAY;	! Goes down the list of ELIST elements

! Output first word - contains "ELIST" and count

	PBOPWD=0;			! Initialize word to 0
%1223%	PBOPWD[OTSIDN]=(IF F77		! Set ID field to proper ELIST
%2400%		THEN OTSNELIST77	! New zero-trip
%2400%		ELSE OTSNELIST);	! New one-trip
%1507%	IOPTR(.TREEPTR[ECNTPTR]);	! Fill in the count

! Output two words for each ARRAYREF under ELSTPTR

	IOARRAY=.TREEPTR[ELSTPTR];		! Get the first list entry
	WHILE .IOARRAY NEQ 0 DO
	BEGIN

! Output the word containing the increment

%1507%		PBOPWD=0;
%1401%		IOPTR(.IOARRAY[E2INCR]);

! Output the word containing the array address

		PBOPWD=0;			! Clear target
		IOPTR(.IOARRAY[E2ARREFPTR]);	! Generate argument
		IOARRAY=.IOARRAY[CLINK]		! Get the next list entry
	END

END;	! of CAE2LIST
GLOBAL ROUTINE CGSTPAUARGS=
BEGIN

! Routine to generate the  arg block for  a STOP/PAUSE statement.   This
! block will have the form:

!	---------------------------------
!	!   ARGCT	!    0		!
!	---------------------------------
!LABEL:	!     !TYPE !	!  ARGPTR	!
!	---------------------------------

! where LABEL  is the  arg-block label,  ARGCT is  the negative  of  the
! argument count and will always be -1  or 0, TYPE is the value type  of
! the arg (LITERAL,OCTAL,INTEGER,REAL DOUBLE PREC, OR COMPLEX) and is in
! bits 9-12, and ARGPTR points to  the arg this routine is called  with.
! The global "CSTMNT" pointing to the STOP or PAUSE statement for  which
! an arg-block is to be generated.

! If the  STOP/PAUSE  had  no  arg, will  have  used  "ZERBLK"  for  the
! arg-block, so don't have to generate anything.

	IF .CSTMNT[PAUSIDENT] EQL 0
	THEN RETURN;

! If this statement  was eliminated (by  folding a logical  IF), do  not
! want to generate an arg list

	IF .CSTMNT[PAUSLBL] EQL 0
	THEN RETURN;

! Output the arg-count word

	PSYMPTR_PBF2NOSYM;
	PBOPWD_(-1)^18;
	OBUFFA();

	%(***ASSOCIATE THE LABEL FOR THIS ARG-LIST WITH THE 2ND WD***)%
	DEFLAB(.CSTMNT[PAUSLBL]);

	%(***OUTPUT THE PTR WD***)%
	PSYMPTR_.CSTMNT[PAUSIDENT];
	PBOPWD_0;				!INIT WD TO BE OUTPUT TO 0
![1002] Choose arg type based on /GFLOATING
%1002%	PBOPWD[OTSTYPE]_.EVALU[.PSYMPTR[VALTYPE]];	!SET TYPE FIELD OF WD
	PBOPWD[OTSADDR]_.PSYMPTR[IDADDR];	! Address of var, constant
						!  or literal to be output
%1401%	OIFIW()

END;	! of CGSTPAUARGS
GLOBAL ROUTINE CGIOUNW=
BEGIN
	!***************************************************************
	! Generate code to call CHUNW. at the end of code generation for
	! I/O,  OPEN  and  CLOSE  statements.   Generate  special  error
	! handling to UNWIND and JRST to the user END or ERR branch.
	!***************************************************************

%1533%	! Written by TFV on 17-May-82

	REGISTER
		AFTERLAB,	! Label after the error handling code
		ENDLAB,		! User specified END label
		ERRLAB;		! User specified ERR label

	IF .CSTMNT[IOIOSTAT] NEQ 0
	THEN IF .CSTMNT[IOERR] EQL 0
	THEN
	BEGIN	! User specified IOSTAT but not ERR

		! Make the argument list for the IN./OUT. call have ERR=CERR.
		! After the last IOLST. or FIN. call generate:
		!
		! CERR:	XMOVEI	L,MARK
		!	PUSHJ	P,CHUNW.
		!
		! If the user specified END=UEND, make the argument list for
		! the IN./OUT. call have END=CEND and generate:
		!
		!	JRST	AFTER
		! CEND:	XMOVEI	L,MARK
		!	PUSHJ	P,CHUNW.
		!	JRST	UEND
		! AFTER:

		! Generate an ERR label which is the same as the code to
		! unwind at the end of the statement.

		CSTMNT[IOERR] = GENLAB();	! Generate an ERR branch
		DEFLAB(.CSTMNT[IOERR]);		! Make it the current location

		! Generate  the  CHUNW.  call  to  unwind  the   dynamic
		! concatenations under this statement

		CGCHUNW(.CSTMNT[IOMARK]);

		IF .CSTMNT[IOEND] NEQ 0
		THEN
		BEGIN	! Generate error handling code for END branch

			! Create  a  label  for  location  after   error
			! handling code

			AFTERLAB = GENLAB();

			JRSTGEN(.AFTERLAB);	! Generate JRST AFTERLAB

			! Save the user's END label and replace it  with
			! a compiler generate label which points to  the
			! current location

			ENDLAB = .CSTMNT[IOEND];
			CSTMNT[IOEND] = GENLAB();
			DEFLAB(.CSTMNT[IOEND]);

			! Generate  the  CHUNW.   call  to  unwind   the
			! dynamic concatenations under this statement

			CGCHUNW(.CSTMNT[IOMARK]);

			JRSTGEN(.ENDLAB);	! Generate JSRT ENDLAB

			! Associate the current location with the  label
			! after the error handling code

			DEFLAB(.AFTERLAB);

		END;	! Generate error handling code for END branch

		RETURN;

	END;	! User specified IOSTAT but not ERR - generate ERR branch

	! Generate the CHUNW.  call to unwind the dynamic concatenations
	! under this statement

	CGCHUNW(.CSTMNT[IOMARK]);

	IF .CSTMNT[IOEND] NEQ 0 OR .CSTMNT[IOERR] NEQ 0
	THEN
	BEGIN	! Generate error handling code for END or ERR

		! After the last IOLST. or FIN. call generate:
		!
		!	XMOVEI	L,MARK
		!	PUSHJ	P,CHUNW.
		!	JRST	AFTER
		!
		! If the user specified END=UEND, make the argument list for
		! the IN./OUT. call have END=CEND and generate:
		!
		! CEND:	XMOVEI	L,MARK
		!	PUSHJ	P,CHUNW.
		!	JRST	UEND
		!
		! If the user specified ERR=UERR, make the argument list for
		! the IN./OUT. call have ERR=CERR and generate:
		!
		! CERR:	XMOVEI	L,MARK
		!	PUSHJ	P,CHUNW.
		!	JRST	UERR
		!
		! Finally define the label after:
		!
		! AFTER:

		! Create a label for location after error handling code

		AFTERLAB = GENLAB();

		JRSTGEN(.AFTERLAB);	! Generate JRST AFTERLAB

		IF .CSTMNT[IOEND] NEQ 0
		THEN
		BEGIN	! Generate error handling code for END branch

			! Save the user's END label and replace it  with
			! a compiler generate label which points to  the
			! current location

			ENDLAB = .CSTMNT[IOEND];
			CSTMNT[IOEND] = GENLAB();
			DEFLAB(.CSTMNT[IOEND]);

			! Generate  the  CHUNW.   call  to  unwind   the
			! dynamic concatenations under this statement

			CGCHUNW(.CSTMNT[IOMARK]);

			JRSTGEN(.ENDLAB);	! Generate JSRT ENDLAB

		END;	! Generate error handling code for END branch

		IF .CSTMNT[IOERR] NEQ 0
		THEN
		BEGIN	! Generate error handling code for ERR branch

			! Save the user's ERR label and replace it  with
			! a compiler generate label which points to  the
			! current location

			ERRLAB = .CSTMNT[IOERR];
			CSTMNT[IOERR] = GENLAB();
			DEFLAB(.CSTMNT[IOERR]);

			! Generate  the  CHUNW.   call  to  unwind   the
			! dynamic concatenations under this statement

			CGCHUNW(.CSTMNT[IOMARK]);

			! Generate JSRT ERRLAB

			JRSTGEN(.ERRLAB);

		END;	! Generate error handling code for ERR branch

		! Associate the current  location with  the label  after
		! the error handling code

		DEFLAB(.AFTERLAB);

	END;	! Generate error handling code for END or ERR

END;	! of CGIOUNW
GLOBAL ROUTINE CGMTOP=
BEGIN

! Calls to MTOP for all statements BACKID thru ENDFID


	CGUNIT();	!GENERATE CODE TO EVAL UNIT NUMBER (IF AN EXPRESSION)
%1123%	CGIOSTAT();	! Generate code for subscripted IOSTAT variables

	!FILL IN IOARGLBL FIELD
	A1LABEL_CSTMNT[IOARGLBL]_GENLAB();
	OPDSPIX_OPGMTO;
	CGOPGEN();

END;	! of CGMTOP
GLOBAL ROUTINE CGENCO=
BEGIN
	!***************************************************************
	! Code generation for ENCODE
	!***************************************************************

%1533%	! If  the  FMT  specifier  or  an  iolist  item  is  a   dynamic
%1533%	! concatenation, generate a call to CHMRK.

%1533%	IF .CSTMNT[IOMARK] NEQ 0
%1533%	THEN CGCHMRK(.CSTMNT[IOMARK]);

%1516%	CGFMT();	! Generate code to eval the format (if an expr)
%1123%	CGIOSTAT();	! Generate code for subscripted IOSTAT variables

	! If the count field is an expression, evaluate it

	TREEPTR_.CSTMNT[IOCNT];
	CGETVAL();

	%(***IF THE ENCODE VAR IS AN ARRAY-REF, GENERATE CODE FOR THE
		SS CALCULATION***)%
	TREEPTR_.CSTMNT[IOVAR];
	CGETVAL();

	!FILL IN IOARGLBL FIELD
	A1LABEL_CSTMNT[IOARGLBL]_GENLAB();
	OPDSPIX_OPGENC;
	CGOPGEN();
![711] IF THE IOLIST IS NOT PRESENT, BE SURE TO PUT OUT A FIN CALL
![711] OTHERWISE ONE CAN END UP USING EXCESSIVE AMOUNTS OF CORE...
%[711]%	IF .CSTMNT[IOLIST] EQL 0
%[711]%	THEN (OPDSPIX_OPGFIN; CGOPGEN()) ! PUT OUT A FIN CALL
%[711]%	ELSE CGIOLST();

%1533%	! If there  are  dynamic concatenations  under  this  statement,
%1533%	! generate calls to CHUNW. and  special error handling code  for
%1533%	! END and ERR branches.  If there is no unwinding to be done but
%1533%	! the user specified IOSTAT and not ERR, generate an ERR branch.

%1533%	IF .CSTMNT[IOMARK] NEQ 0
%1533%	THEN	CGIOUNW()
%1533%	ELSE	IF .CSTMNT[IOIOSTAT] NEQ 0
%1533%		THEN IF .CSTMNT[IOERR] EQL 0
%1533%		THEN
%1533%		BEGIN	! User specified IOSTAT - generate an ERR branch

%1533%			CSTMNT[IOERR] = GENLAB();
%1533%			DEFLAB(.CSTMNT[IOERR]);

%1533%		END;	! User specified IOSTAT - generate an ERR branch

END;	! of CGENCO
GLOBAL ROUTINE CGDECO=
BEGIN
	!***************************************************************
	! Generate code for decode
	!***************************************************************

%1533%	! If  the  FMT  specifier  or  an  iolist  item  is  a   dynamic
%1533%	! concatenation, generate a call to CHMRK.

%1533%	IF .CSTMNT[IOMARK] NEQ 0
%1533%	THEN CGCHMRK(.CSTMNT[IOMARK]);

%1516%	CGFMT();	! Generate code to eval the format (if an expr)
%1123%	CGIOSTAT();	! Generate code for subscripted IOSTAT variables

	%(***IF THE COUNT FIELD IS AN EXPRESSION, EVALUATE IT***)%
	TREEPTR_.CSTMNT[IOCNT];
	CGETVAL();


	%(***IF THE DECODE ARRAY IS AN ARRAYREF - CALCULATE THE
		OFFSET***)%
	TREEPTR_.CSTMNT[IOVAR];
	CGETVAL();

	!FILL IN IOARGLBL FIELD
	A1LABEL_CSTMNT[IOARGLBL]_GENLAB();
	OPDSPIX_OPGDEC;
	CGOPGEN();
![711] IF THE IOLIST IS EMPTY, BE SURE TO PUT OUT A FIN CALL
%[711]%	IF .CSTMNT[IOLIST] EQL 0
%[711]%	THEN (OPDSPIX_OPGFIN; CGOPGEN()) ! PUT OUT A FIN CALL
%[711]%	ELSE CGIOLST();

%1533%	! If there  are  dynamic concatenations  under  this  statement,
%1533%	! generate calls to CHUNW. and  special error handling code  for
%1533%	! END and ERR branches.  If there is no unwinding to be done but
%1533%	! the user specified IOSTAT and not ERR, generate an ERR branch.

%1533%	IF .CSTMNT[IOMARK] NEQ 0
%1533%	THEN	CGIOUNW()
%1533%	ELSE	IF .CSTMNT[IOIOSTAT] NEQ 0
%1533%		THEN IF .CSTMNT[IOERR] EQL 0
%1533%		THEN
%1533%		BEGIN	! User specified IOSTAT - generate an ERR branch

%1533%			CSTMNT[IOERR] = GENLAB();
%1533%			DEFLAB(.CSTMNT[IOERR]);

%1533%		END;	! User specified IOSTAT - generate an ERR branch

END;	! of CGDECO
GLOBAL ROUTINE CGRERE=
BEGIN
	!***************************************************************
	!CODE GENERATION FOR REREAD
	!***************************************************************

%1533%	! If  the  FMT  specifier  or  an  iolist  item  is  a   dynamic
%1533%	! concatenation, generate a call to CHMRK.

%1533%	IF .CSTMNT[IOMARK] NEQ 0
%1533%	THEN CGCHMRK(.CSTMNT[IOMARK]);

	CGUNIT();	!GENERATE CODE TO EVAL THE UNIT NUMBER (IF AN EXPRESSION)
%1516%	CGFMT();	! Generate code to eval the format (if an expr)
%1123%	CGIOSTAT();	! Generate code for subscripted IOSTAT variables

	!FILL IN IOARGLBL FIELD
	A1LABEL_CSTMNT[IOARGLBL]_GENLAB();
	OPDSPIX_OPGIN;
	CGOPGEN();
	IF .CSTMNT[IOLIST]EQL 0
	THEN
	BEGIN
		%(***IF HAVE NO IOLIST GENERATE A CALL TO FIN***)%
		OPDSPIX_OPGFIN;
		CGOPGEN();
	END
	ELSE
	CGIOLST();

%1533%	! If there  are  dynamic concatenations  under  this  statement,
%1533%	! generate calls to CHUNW. and  special error handling code  for
%1533%	! END and ERR branches.  If there is no unwinding to be done but
%1533%	! the user specified IOSTAT and not ERR, generate an ERR branch.

%1533%	IF .CSTMNT[IOMARK] NEQ 0
%1533%	THEN	CGIOUNW()
%1533%	ELSE	IF .CSTMNT[IOIOSTAT] NEQ 0
%1533%		THEN IF .CSTMNT[IOERR] EQL 0
%1533%		THEN
%1533%		BEGIN	! User specified IOSTAT - generate an ERR branch

%1533%			CSTMNT[IOERR] = GENLAB();
%1533%			DEFLAB(.CSTMNT[IOERR]);

%1533%		END;	! User specified IOSTAT - generate an ERR branch

END;	! of CGRERE
GLOBAL ROUTINE CGUNIT=
BEGIN
	!***************************************************************
	! Generate code to evaluate the unit number in an I/O statement.
	! Called with CSTMNT pointing to an I/O statement.
	!***************************************************************

%2201%	! only do UNIT= if specified
%2201%	IF (TREEPTR = .CSTMNT[IOUNIT]) NEQ 0
%2201%	THEN IF .TREEPTR[OPRCLS] NEQ DATAOPR
	THEN CGETVAL()

END;	! of CGUNIT
GLOBAL ROUTINE CGFILE=
BEGIN
	!***************************************************************
	! Generate code to evaluate the unit number in an I/O statement.
	! Called with CSTMNT pointing to an I/O statement.
	!***************************************************************

%2201%	! Written by TFV on 30-Mar-83

	! only do FILE= if specified
	IF (TREEPTR = .CSTMNT[IOFILE]) NEQ 0
	THEN IF .TREEPTR[OPRCLS] NEQ DATAOPR
	THEN CGETVAL()

END;	! of CGFILE
GLOBAL ROUTINE CGFMT=			! [1516] New

%(***************************************************************************
	GENERATE CODE TO EVALUATE THE FORMAT EXPRESSION IN AN IO STMNT
	CALLED WITH CSTMNT POINTING TO AN IO STMNT
***************************************************************************)%

BEGIN

	TREEPTR_.CSTMNT[IOFORM];	!PTR TO EXPRESSION NODE FOR FMT

	IF .TREEPTR NEQ 0		! IF FMT= WAS SPECIFIED
	THEN IF EXTSIGN(.TREEPTR) NEQ -1 ! AND NOT FMT=*
	THEN IF .TREEPTR[OPRCLS] NEQ DATAOPR ! AND FMT= IS A NONTRIVIAL EXPR
	THEN CGETVAL()			! GENERATE CODE TO EVALUATE THE EXPR

END;	! CGFMT
GLOBAL ROUTINE CGRECNUM=
%(***************************************************************************
	TO GENERATE THE CODE TO COMPUTE THE RECORD NUMBER FOR AN IO STMNT
	THAT HAS AN EXPRESSION FOR A RECORD NUMBER (UGH!!!)
***************************************************************************)%
BEGIN
	REGISTER PEXPRNODE RECNUM;

	IF (RECNUM_.CSTMNT[IORECORD]) NEQ 0
	THEN
	BEGIN
		IF .RECNUM[OPRCLS] NEQ DATAOPR
		THEN
		BEGIN
			TREEPTR_.RECNUM;
			CGETVAL()
		END
	END

END;	! of CGRECNUM
GLOBAL ROUTINE CGIOSTAT=	%1123%
BEGIN	! Generate code to compute subscripts for an I/O statement that has
	! an array reference for an IOSTAT specifier

REGISTER PEXPRNODE IOREF;

	IOREF=.CSTMNT[IOIOSTAT];
	IF .IOREF NEQ 0
	THEN
	BEGIN
		TREEPTR_.IOREF;
		CGETVAL()
	END

END;	! of CGIOSTAT			%1123%
GLOBAL ROUTINE CGRDKEY=
!++
! FUNCTIONAL DESCRIPTION:
!
!	Routine to generate code to evaluate the expression pointed to by IOKEY
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	CSTMNT		PTR TO READ STATEMENT NODE
!
! IMPLICIT OUTPUTS:
!
!	TREEPTR		changed
!
! ROUTINE VALUE:
!
!	None
!				
! SIDE EFFECTS:
!
!	None
!
!--

BEGIN	! [4501]	New
	! only do IOKEY= if specified
	IF (TREEPTR = .CSTMNT[IOKEY]) NEQ 0
	THEN IF .TREEPTR[OPRCLS] NEQ DATAOPR
	THEN CGETVAL()

END;	! of CGRDKEY
GLOBAL ROUTINE CGREAD=
BEGIN
	!***************************************************************
	!CODE GENERATION FOR ALL TYPES OF READ
	!***************************************************************

%1471%	REGISTER BASE UNIT, BASE FORMAT;

%1533%	! If  the  FMT  specifier  or  an  iolist  item  is  a   dynamic
%1533%	! concatenation, generate a call to CHMRK.

%1533%	IF .CSTMNT[IOMARK] NEQ 0
%1533%	THEN CGCHMRK(.CSTMNT[IOMARK]);

%1134%	CGUNIT();	! Generate code to eval the unit number (if an expr)
%1516%	CGFMT();	! Generate code to eval the format (if an expr)
%1134%	CGRECNUM();	! Generate code to eval the record number (if an expr)
%1123%	CGIOSTAT();	! Generate code to evaluate ARRAYREF subscripts, etc
%4501%	CGRDKEY();	! Generate code to eval the IOKEY expression

	A1LABEL_CSTMNT[IOARGLBL]_GENLAB();	! Fill in IOARGLBL field

%1471%	UNIT = .CSTMNT[IOUNIT];
%1471%	FORMAT = .CSTMNT[IOFORM];
%1471%	IF .UNIT[VALTYPE] EQL CHARACTER
%1471%	THEN
%1471%	BEGIN	! Internal file READ
%1471%		IF .FORMAT EQL 0 THEN CGERR();
%1545%		IF .FORMAT[OPR1] EQL VARFL
%1471%		THEN IF .FORMAT[IDATTRIBUT(NAMNAM)] THEN CGERR();
%1471%		OPDSPIX = OPGIFI;
%1471%		CGOPGEN();
%1471%		IF  .CSTMNT[IOLIST] NEQ 0 THEN CGIOLST()
%1471%	END	! of internal file READ
%1471%	ELSE
%1471%	BEGIN	! External file READ
		!MAKE CGREAD AND CGWRIT SYMMETRICAL: DON'T MAKE A NAMELIST
		!   CHECK WITHOUT CHECKING FOR IONAME PTR = 0
		IF .CSTMNT[IOLIST] EQL 0	! NO IOLIST (BEWARE NAMELIST)
		  THEN
		    IF .FORMAT EQL 0		! NO FORMAT
		      THEN BEGIN
			OPDSPIX _ OPGRTB;	! UNFORMATTED READ
			CGOPGEN ();
			OPDSPIX _ OPGFIN;	! FIN CALL SINCE NO IOLIST
			CGOPGEN ()
		      END
		      ELSE
%1545%		    IF .FORMAT [OPR1] EQL VARFL 	! CHECK FOR NAMELIST
		       AND .FORMAT [IDATTRIBUT (NAMNAM)]
		      THEN BEGIN
			OPDSPIX _ OPGNLI;		! NAMELIST READ
			CGOPGEN ()
		      END
		      ELSE BEGIN
			OPDSPIX _ OPGIN;		! FORMATTED READ
			CGOPGEN ();
			OPDSPIX _ OPGFIN;		! FIN CALL SINCE NO IOLIST
			CGOPGEN ()
		      END
		  ELSE BEGIN				! THERE IS AN IOLIST
		    IF .FORMAT EQL 0			! CHECK FOR FORMAT
		      THEN OPDSPIX _ OPGRTB		! UNFORMATTED READ
		      ELSE OPDSPIX _ OPGIN;		! FORMATTED READ
		    CGOPGEN ();
		    CGIOLST ()				! PROCESS IOLIST
		END
%1471%	  END;	! of external file READ

%1533%	! If there  are  dynamic concatenations  under  this  statement,
%1533%	! generate calls to CHUNW. and  special error handling code  for
%1533%	! END and ERR branches.  If there is no unwinding to be done but
%1533%	! the user specified IOSTAT and not ERR, generate an ERR branch.

%1533%	IF .CSTMNT[IOMARK] NEQ 0
%1533%	THEN	CGIOUNW()
%1533%	ELSE	IF .CSTMNT[IOIOSTAT] NEQ 0
%1533%		THEN IF .CSTMNT[IOERR] EQL 0
%1533%		THEN
%1533%		BEGIN	! User specified IOSTAT - generate an ERR branch

%1533%			CSTMNT[IOERR] = GENLAB();
%1533%			DEFLAB(.CSTMNT[IOERR]);

%1533%		END;	! User specified IOSTAT - generate an ERR branch

END;	! of CGREAD
GLOBAL ROUTINE CGWRIT=
BEGIN
	!***************************************************************
	! Code generation for WRITE statements of all forms
	!***************************************************************

%1471%	LOCAL BASE UNIT, BASE FORMAT;

%1533%	! If  the  FMT  specifier  or  an  iolist  item  is  a   dynamic
%1533%	! concatenation, generate a call to CHMRK.

%1533%	IF .CSTMNT[IOMARK] NEQ 0
%1533%	THEN CGCHMRK(.CSTMNT[IOMARK]);

! Order things so that the call to CGREGNUM does not overwrite A1LABEL
! causing bad code fill in IOARGLBL field.

%1134%	CGUNIT();	! Generate code to eval the unit number (if an expr)
%1516%	CGFMT();	! Generate code to eval the format (if an expr)
%1134%	CGRECNUM();	! Generate code to eval the unit number (if an expr)
%1123%	CGIOSTAT();	! Generate code to evaluate ARRAYREF subscripts, etc

	A1LABEL_CSTMNT[IOARGLBL]_GENLAB();

%1471%	UNIT = .CSTMNT[IOUNIT];
%1471%	FORMAT = .CSTMNT[IOFORM];
%1471%	IF .UNIT[VALTYPE] EQL CHARACTER
%1471%	THEN
%1471%	BEGIN	! Internal file WRITE
%1471%		IF .FORMAT EQL 0 THEN CGERR();
%1545%		IF .FORMAT[OPR1] EQL VARFL
%1471%		THEN IF .FORMAT[IDATTRIBUT(NAMNAM)] THEN CGERR();
%1471%		OPDSPIX = OPGIFO;
%1471%		CGOPGEN();
%1471%		IF  .CSTMNT[IOLIST] NEQ 0 
%1471%		THEN CGIOLST()
%1471%		ELSE
%1471%		BEGIN
%1471%			OPDSPIX = OPGFIN;
%1471%			CGOPGEN();
%1471%		END;
%1471%	END	! of internal file WRITE
%1471%	ELSE
%1471%	BEGIN	! External file WRITE
		!MAKE CGREAD AND CGWRIT SYMMETRICAL: GENERATE A FIN CALL
		!   AFTER AN UNFORMATTED WRITE; REPLACE EDIT
		IF .CSTMNT [IOLIST] EQL 0	! NO IOLIST (BEWARE NAMELIST)
		  THEN
		    IF .FORMAT EQL 0		! NO FORMAT
		      THEN BEGIN
			OPDSPIX _ OPGWTB;	! UNFORMATTED WRITE
			CGOPGEN ();
			OPDSPIX _ OPGFIN;	! FIN CALL SINCE NO IOLIST
			CGOPGEN ()
		      END
		    ELSE
%1545%		    IF .FORMAT [OPR1] EQL VARFL  ! CHECK FOR NAMELIST
		      AND .FORMAT [IDATTRIBUT (NAMNAM)]
		      THEN BEGIN
			OPDSPIX _ OPGNLO;	! NAMELIST WRITE
			CGOPGEN ()
		      END
		      ELSE BEGIN
			OPDSPIX _ OPGOUT;	! FORMATTED WRITE
			CGOPGEN ();
			OPDSPIX _ OPGFIN;	! FIN CALL SINCE NO IOLIST
			CGOPGEN ()
		      END
		  ELSE BEGIN			! THERE IS AN IOLIST
		    IF .FORMAT EQL 0		! CHECK FOR FORMAT
		      THEN OPDSPIX _ OPGWTB	! UNFORMATTED WRITE
		      ELSE OPDSPIX _ OPGOUT;	! FORMATTED WRITE
		    CGOPGEN ();
		    CGIOLST ()			! PROCESS IOLIST
		  END

%1471%	END;	 ! of external file WRITE

%1533%	! If there  are  dynamic concatenations  under  this  statement,
%1533%	! generate calls to CHUNW. and  special error handling code  for
%1533%	! END and ERR branches.  If there is no unwinding to be done but
%1533%	! the user specified IOSTAT and not ERR, generate an ERR branch.

%1533%	IF .CSTMNT[IOMARK] NEQ 0
%1533%	THEN	CGIOUNW()
%1533%	ELSE	IF .CSTMNT[IOIOSTAT] NEQ 0
%1533%		THEN IF .CSTMNT[IOERR] EQL 0
%1533%		THEN
%1533%		BEGIN	! User specified IOSTAT - generate an ERR branch

%1533%			CSTMNT[IOERR] = GENLAB();
%1533%			DEFLAB(.CSTMNT[IOERR]);

%1533%		END;	! User specified IOSTAT - generate an ERR branch

END;	! of CGWRIT
GLOBAL ROUTINE CGREWR=

!++
! FUNCTIONAL DESCRIPTION:
!
!	Generate code for the REWRITE statement
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	CSTMNT		Pointer to REWRITE statement node
!	OPGRWF		Code pattern for formatted REWRITE
!	OPGRWU		Code pattern for unformatted REWRITE
!	OPGFIN		Code pattern for FIN. call
!
! IMPLICIT OUTPUTS:
!
!	A1LABEL		changed
!	OPDSPIX		changed
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	May flush the peephole buffer into the object and listing files
!
!--

BEGIN	![4503]	New

	!***************************************************************
	! Code generation for REWRITE statements of all forms
	!***************************************************************

	! If  the  FMT  specifier  or  an  iolist  item  is  a   dynamic
	! concatenation, generate a call to CHMRK.

	IF .CSTMNT[IOMARK] NEQ 0
	THEN CGCHMRK(.CSTMNT[IOMARK]);

	! Order things so that the call to CGRECNUM does not overwrite A1LABEL
	! causing bad code fill in IOARGLBL field.

	CGUNIT();	! Generate code to eval the unit number (if an expr)
	CGFMT();	! Generate code to eval the format (if an expr)
	CGIOSTAT();	! Generate code to evaluate ARRAYREF subscripts, etc

	A1LABEL=CSTMNT[IOARGLBL]=GENLAB();

	IF .CSTMNT[IOFORM] EQL 0
	THEN OPDSPIX = OPGRWU		! UNFORMATTED REWRITE
	ELSE OPDSPIX = OPGRWF;		! FORMATTED REWRITE
	CGOPGEN ();

	IF .CSTMNT [IOLIST] EQL 0	! NO IOLIST 
	THEN 
	BEGIN
		OPDSPIX = OPGFIN;	! FIN CALL SINCE NO IOLIST
		CGOPGEN ()
	END
	ELSE 	! THERE IS AN IOLIST
	BEGIN	
		CGIOLST ()		! PROCESS IOLIST
	END;

	! If there  are  dynamic concatenations  under  this  statement,
	! generate calls to CHUNW. and  special error handling code  for
	! END and ERR branches.  If there is no unwinding to be done but
	! the user specified IOSTAT and not ERR, generate an ERR branch.

	IF .CSTMNT[IOMARK] NEQ 0
	THEN	CGIOUNW()
	ELSE	IF (.CSTMNT[IOIOSTAT] NEQ 0)
		AND (.CSTMNT[IOERR] EQL 0)
		THEN
		BEGIN	! User specified IOSTAT - generate an ERR branch

			CSTMNT[IOERR] = GENLAB();
			DEFLAB(.CSTMNT[IOERR]);

		END;	! User specified IOSTAT - generate an ERR branch

END;	! of CGREWR
GLOBAL ROUTINE CGUNLCK=

!++
! FUNCTIONAL DESCRIPTION:
!
!	Generate code for the UNLOCK statement
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	CSTMNT		Pointer to REWRITE statement node
!	OPGULC		Code pattern for call to UNLCK.
!
! IMPLICIT OUTPUTS:
!
!	A1LABEL		CHANGED
!	OPDSPIX		CHANGED
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	May flush the peephole buffer into the object and listing files
!
!--

BEGIN	![4504]	New
	CGUNIT();	! Generate code for unit number
	CGIOSTAT();	! Generate code for iostat variables
	
	A1LABEL=CSTMNT[IOARGLBL]=GENLAB();	! Fill in IOARGLBL field
	OPDSPIX=OPGULC;
	CGOPGEN();
END;	! of CGUNLCK
GLOBAL ROUTINE CGOPLST=
%(***************************************************************************
	ROUTINE TO GENERATE CODE TO EVALUATE ANY EXPRESSIONS THAT
	OCCUR AS VALS OF ARGS UNDER AN OPEN/CLOSE STMNT
***************************************************************************)%
BEGIN
	REGISTER OPENLIST ARVALLST;	! List of args and their vals

	CGUNIT();	! Generate code for UNIT= that is an expression
%2201%	CGFILE();	! Generate code for FILE= that is an expression
%1123%	CGIOSTAT();	! Generate code for IOSTAT= arrayref

	ARVALLST_.CSTMNT[OPLST];

	INCR I FROM 0 TO (.CSTMNT[OPSIZ]-1)	!LOOK AT EACH ARG
	DO
	BEGIN
		TREEPTR_.ARVALLST[.I,OPENLPTR];	!PTR TO THE EXPRESSION NODE FOR THE VAL OF THIS ARG
		IF .TREEPTR EQL 0	!FOR "DIALOG", CAN HAVE  NULL VAL
		THEN BEGIN END
		ELSE
		IF .TREEPTR[OPRCLS] NEQ DATAOPR THEN CGETVAL()
	END

END;	! of CGOPLST
GLOBAL ROUTINE CGOPKEY=

!++
! FUNCTIONAL DESCRIPTION:
!
!	Routine to generate code to evaluate any expressions pointed 
!	to by IOKEY
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	CSTMNT		PTR TO OPEN STATEMENT NODE
!
! IMPLICIT OUTPUTS:
!
!	TREEPTR		CHANGED
!
! ROUTINE VALUE:
!
!	None
!				
! SIDE EFFECTS:
!
!	None
!
!--

BEGIN 	! New [4500]
	REGISTER OPNKEYLIST KVALLST;	! List of keys and their vals

	KVALLST=.CSTMNT[IOKEY];

	INCR I FROM 1 TO .KVALLST[NUMKEYS]	!LOOK AT EACH KEY
	DO
	BEGIN
		TREEPTR=.KVALLST[.I,KEYLOW];	!PTR TO THE EXPRESSION NODE FOR THE VAL OF LOWER BOUND OF THIS KEY
		IF .TREEPTR[OPRCLS] NEQ DATAOPR THEN CGETVAL();

		TREEPTR=.KVALLST[.I,KEYHIGH];	!PTR TO THE EXPRESSION NODE FOR THE VAL OF UPPER BOUND OF THIS KEY
		IF .TREEPTR[OPRCLS] NEQ DATAOPR THEN CGETVAL();
	END
END;	! of CGOPKEY
GLOBAL ROUTINE CGOPEN=
BEGIN
	!***************************************************************
	!CODE GENERATION FOR THE CALL TO OPEN.
	!***************************************************************

%1533%	! If an argument is a dynamic concatenation, generate a call  to
%1533%	! CHMRK.

%1533%	IF .CSTMNT[IOMARK] NEQ 0
%1533%	THEN CGCHMRK(.CSTMNT[IOMARK]);

%4500%	!Generate code to eval any expressions that occur as vals of keys
%4500%	IF .CSTMNT[IOKEY] NEQ 0 THEN CGOPKEY();

	CGOPLST();	!GENERATE CODE TO EVAL ANY EXPRESSIONS THAT OCCUR AS VALS OF ARGS

	!FILL IN IOARGLBL FIELD

	A1LABEL_CSTMNT[IOARGLBL]_GENLAB();

	OPDSPIX_OPGOPE;
	CGOPGEN();

%1533%	! If there  are  dynamic concatenations  under  this  statement,
%1533%	! generate calls to CHUNW. and  special error handling code  for
%1533%	! END and ERR branches.  If there is no unwinding to be done but
%1533%	! the user specified IOSTAT and not ERR, generate an ERR branch.

%1533%	IF .CSTMNT[IOMARK] NEQ 0
%1533%	THEN	CGIOUNW()
%1533%	ELSE	IF .CSTMNT[IOIOSTAT] NEQ 0
%1533%		THEN IF .CSTMNT[IOERR] EQL 0
%1533%		THEN
%1533%		BEGIN	! User specified IOSTAT - generate an ERR branch

%1533%			CSTMNT[IOERR] = GENLAB();
%1533%			DEFLAB(.CSTMNT[IOERR]);

%1533%		END;	! User specified IOSTAT - generate an ERR branch

END;	! of CGOPEN
GLOBAL ROUTINE CGFIND=
BEGIN

! Code generation for FIND


%1134%	CGUNIT();	! Generate code for unit number
%1134%	CGRECNUM();	! Generate code for record number expressions
%1123%	CGIOSTAT();	! Generate code for subscripted IOSTAT variables

	A1LABEL_CSTMNT[IOARGLBL]_GENLAB();	! Fill in IOARGLBL field
	OPDSPIX_OPGFND;
	CGOPGEN()

END;	! of CGFIND
GLOBAL ROUTINE CGDELE=

!++
! FUNCTIONAL DESCRIPTION:
!
!	Generate code for the DELETE statement
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	CSTMNT		Pointer to REWRITE statement node
!	OPGDEL		Code pattern for call to DELET.
!
! IMPLICIT OUTPUTS:
!
!	A1LABEL		CHANGED
!	OPDSPIX		CHANGED
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	May flush the peephole buffer into the object and listing files
!
!--

BEGIN	! [4502] New

! Code generation for DELETE

	CGUNIT();	! Generate code for unit number
	CGRECNUM();	! Generate code for record number expressions
	CGIOSTAT();	! Generate code for subscripted IOSTAT variables

	A1LABEL=CSTMNT[IOARGLBL]=GENLAB();	! Fill in IOARGLBL field
	OPDSPIX=OPGDEL;
	CGOPGEN()

END;	! of CGDELE
GLOBAL ROUTINE CGCLOS=
BEGIN
	!***************************************************************
	! CODE GENERATION FOR CLOSE STATEMENT
	!***************************************************************

%1533%	! If an argument is a dynamic concatenation, generate a call  to
%1533%	! CHMRK.

%1533%	IF .CSTMNT[IOMARK] NEQ 0
%1533%	THEN CGCHMRK(.CSTMNT[IOMARK]);

	CGOPLST();	!GENERATE CODE TO EVAL ANY EXPRESSIONS THAT OCCUR AS VALS OF ARGS

	!FILL IN IOARGLBL FIELD

	A1LABEL_CSTMNT[IOARGLBL]_GENLAB();

	OPDSPIX_OPGCLO;
	CGOPGEN();

%1533%	! If there  are  dynamic concatenations  under  this  statement,
%1533%	! generate calls to CHUNW. and  special error handling code  for
%1533%	! END and ERR branches.  If there is no unwinding to be done but
%1533%	! the user specified IOSTAT and not ERR, generate an ERR branch.

%1533%	IF .CSTMNT[IOMARK] NEQ 0
%1533%	THEN	CGIOUNW()
%1533%	ELSE	IF .CSTMNT[IOIOSTAT] NEQ 0
%1533%		THEN IF .CSTMNT[IOERR] EQL 0
%1533%		THEN
%1533%		BEGIN	! User specified IOSTAT - generate an ERR branch

%1533%			CSTMNT[IOERR] = GENLAB();
%1533%			DEFLAB(.CSTMNT[IOERR]);

%1533%		END;	! User specified IOSTAT - generate an ERR branch

END;	! of CGCLOS
GLOBAL ROUTINE CGINQUIRE=
BEGIN
	!***************************************************************
	! CODE GENERATION FOR INQUIRE STATEMENT
	!***************************************************************

%2201%	! Written by TFV, on 30-Mar-83

	! If an argument is a dynamic concatenation, generate a call  to
	! CHMRK.

	IF .CSTMNT[IOMARK] NEQ 0
	THEN CGCHMRK(.CSTMNT[IOMARK]);

%4500%	!Generate code to eval any expressions that occur as vals of keys
%4500%	IF .CSTMNT[IOKEY] NEQ 0 THEN CGOPKEY();

	! Generate code to eval any expressions that occur as vals of args
	CGOPLST();

	! fill in ioarglbl field

	A1LABEL = CSTMNT[IOARGLBL] = GENLAB();

	! Choose call to INQU. (by unit) or INQF. (by file)

	IF .CSTMNT[IOUNIT] NEQ 0
	THEN OPDSPIX = OPGINU	! INQUIRE by unit
	ELSE OPDSPIX = OPGINF;	! INQUIRE by file

	CGOPGEN();

	! If there  are  dynamic concatenations  under  this  statement,
	! generate calls to CHUNW. and  special error handling code  for
	! END and ERR branches.  If there is no unwinding to be done but
	! the user specified IOSTAT and not ERR, generate an ERR branch.

	IF .CSTMNT[IOMARK] NEQ 0
	THEN	CGIOUNW()
	ELSE	IF .CSTMNT[IOIOSTAT] NEQ 0
		THEN IF .CSTMNT[IOERR] EQL 0
		THEN
		BEGIN	! User specified IOSTAT - generate an ERR branch

			CSTMNT[IOERR] = GENLAB();
			DEFLAB(.CSTMNT[IOERR]);

		END;	! User specified IOSTAT - generate an ERR branch

END;	! of CGINQUIRE
GLOBAL ROUTINE CGDECARGS=
BEGIN

! Generates the arg block for an ENCODE or DECODE statement.  Arg  block
! has the form:
!		--------------------------------------------------
!		!	-CT		!		0	!
!		--------------------------------------------------
!	LAB:	!  13	!TYPE	!I! X	! CHAR CT 		!
!		--------------------------------------------------
!		!   4	!TYPE	!I! X	!  END=			!
!		--------------------------------------------------
!		!   5	!TYPE	!I! X	!  ERR=			!
!		--------------------------------------------------
!		!   6   !TYPE	!I! X	!  IOSTAT=		!
!		--------------------------------------------------
!		!   2	!TYPE	!I! X	!  FORMAT ADDR		!
!		--------------------------------------------------
!		!   3	!TYPE	!I! X	!  FORMAT SIZE		!
!		--------------------------------------------------
!		!  12	!TYPE	!I! X	!   VAR ARRAY ADDR	!
!		--------------------------------------------------
! where the arglist ptr  points to the word  containing the char  count.
! END/ERR/IOSTAT/FORMAT SIZE are optional ( 3 <= CT <= 7 ).

! Output word containing the count of words in the arglist
%[760]%	PBOPWD=(-CNTKEYS())^18;		! Count in left half word
	PSYMPTR=PBF2NOSYM;
	OBUFFA();

! Associate the label on the arglist with this loc

	DEFLAB(.CSTMNT[IOARGLBL]);

! Set up the count of chars to be processed in the 1st word of the arg block
![760] Set up keyword value
%[760]%	PBOPWD=0;			! Clear word
%[760]%	PBOPWD[OTSKEY]=OTSKEDSIZ;	! Output the char count
%2317%	IOPTR(.CSTMNT[IOCNT]);

	IOENDERR();			! Output the END/ERR/IOSTAT args

	IOFORMAT();			! Output the FORMAT args

! Output a ptr to the array
![760] Set up keyword value
%[760]%	PBOPWD=0;			! clear word
%[760]%	PBOPWD[OTSKEY]=OTSKEDARR;	! output the array address
	IOPTR(.CSTMNT[IOVAR])

END;	! of CGDECARGS
ROUTINE IO1ARG(NUMB)=
BEGIN

! Routine to output 2 words of the form:
!		-------------------------------------------------
!		!	-CT		!			!
!		-------------------------------------------------
!	 LAB:	! "UNIT"! TYPE	!I! X	!    UNIT #(Immediate)	!
!		-------------------------------------------------

	%(***OUTPUT MINUS THE CT OF WDS IN THE ARG BLOCK***)%
	PBOPWD_(-.NUMB)^18;	!CT IN LEFT HALF WD
	PSYMPTR_PBF2NOSYM;
	OBUFFA();

! Associate the label on the arg block with this loc
	DEFLAB(.CSTMNT[IOARGLBL]);

! Output an "immediate" mode arg for the unit
![760] Set up keyword value
%[760]%	PBOPWD_0;			! clear word
%[760]%	PBOPWD[OTSKEY]_OTSKUNIT;	! output the unit
	IOIMMED(.CSTMNT[IOUNIT])

END;	! of IO1ARG
ROUTINE OPNFARGS=
BEGIN
%2201%	! rewritten by TFV, on 30-Mar-83

! Output first words of OPEN/CLOSE/INQUIRE arg block.  Note that ERR and
! IOSTAT are optional.  UNIT is required  for OPEN and CLOSE while  FILE
! is optional.  For INQUIRE, one and only  one of UNIT and FILE must  be
! specified.
!
!		-------------------------------------------------
!		!	-CT		!			!
!		-------------------------------------------------
!	 LAB:	!  36	! TYPE	!I! X	!	UNIT		!
!		-------------------------------------------------
!	 	!   6	! TYPE	!I! X	!	FILE		!
!		-------------------------------------------------
!		!  37	! TYPE	!I! X	!	ERR		!
!		-------------------------------------------------
!		!  21	! TYPE	!I! X	!	IOSTAT		!
!		-------------------------------------------------
!		!	! TYPE  !I! X	!	KEY		!
!		-------------------------------------------------
	REGISTER CT;

	! Output minus the count of words in the arg block
	CT = .CSTMNT[OPSIZ];			! Number of args on stack
	IF .CSTMNT[IOUNIT] NEQ 0 THEN CT = .CT+1;	! Add in UNIT=
	IF .CSTMNT[IOFILE] NEQ 0 THEN CT = .CT+1;	! Add in FILE=
	IF .CSTMNT[IOERR] NEQ 0 THEN CT = .CT+1;	! Add in ERR=
	IF .CSTMNT[IOIOSTAT] NEQ 0 THEN CT = .CT+1;	! Add in IOSTAT=
%4500%	IF .CSTMNT[IOKEY] NEQ 0 THEN CT = .CT+1;	! Add in KEY=

	PBOPWD = (-.CT)^18;			! Count in left half word
	PSYMPTR = PBF2NOSYM;
	OBUFFA();

	! Associate the label on the arg block with this loc
	DEFLAB(.CSTMNT[IOARGLBL]);

	IF .CSTMNT[IOUNIT] NEQ 0
	THEN
	BEGIN	! Output the UNIT= word if non zero - must be first arg
		PBOPWD = 0;			! clear word
		PBOPWD[OTSKEY] = OPNCUNIT;	! output the unit
		IOPTR(.CSTMNT[IOUNIT]);
	END;	! Output the UNIT= word if non zero - must be first arg

	IF .CSTMNT[IOFILE] NEQ 0
	THEN
	BEGIN	! Output the FILE= word if non zero - must be first or second
		PBOPWD = 0;			! clear word
		PBOPWD[OTSKEY] = OPNCFILE;	! output the unit
		IOPTR(.CSTMNT[IOFILE]);
	END;	! Output the FILE=  word if non zero - must be first or second

	IF .CSTMNT[IOERR] NEQ 0
	THEN
	BEGIN	! Output the ERR= word if non zero

		PBOPWD = 0;			! Clear the word
		PBOPWD[OTSKEY] = OPNCERREQ;	! ERR=
		PBOPWD[OTSTYPE] = ADDRTYPE;	! Type is "address"
		PBOPWD[OTSADDR] = .CSTMNT[IOERR];
		PSYMPTR = PBFLABREF;		! It's a statement label
%1401%		OIFIW()
	END;	! Output the ERR= word if non zero


	IF .CSTMNT[IOIOSTAT] NEQ 0
	THEN
	BEGIN	! Output the IOSTAT=  word if non zero
		PBOPWD = 0;			! Clear the word
		PBOPWD[OTSKEY] = OPNCIOSTAT;	! The IOSTAT= word
%1123%		IOPTR(.CSTMNT[IOIOSTAT])
	END;	! Output the IOSTAT= word if non zero

END;	! of OPNFARGS
GLOBAL ROUTINE CNTKEYS=
%(***********************
	Count up the number of words in arg block to use for keywords.
	Note that FMT= may use two words (address and optional size).
*************************)%
BEGIN
%1432%	REGISTER COUNT, BASE FORMAT;
%[760]%
%[760]%	COUNT=0;
%[760]%
%[760]%	IF .CSTMNT[IOUNIT] NEQ 0 THEN COUNT=.COUNT+1;

%1432%	IF .CSTMNT[IOFORM] NEQ 0	!If there is a format
%1432%	THEN
%1432%	BEGIN
%1625%		IF EXTSIGN(.CSTMNT[IOFORM]) EQL -1
%1625%		THEN COUNT = .COUNT + 1
%1625%		ELSE
%1625%		BEGIN
%1432%			!(*** Get pointer to format statement. ***)
%1432%			FORMAT = .CSTMNT[IOFORM];
%1432%			! Only an array used as a format has a format size word
%1432%			IF .FORMAT[DATOPS1] EQL ARRAYNM1
%1432%			THEN COUNT=.COUNT+2	! address and size
%1432%			ELSE COUNT=.COUNT+1;	! address only
%1432%		END
%1625%	END;

%[760]%	IF .CSTMNT[IOEND]  NEQ 0 THEN COUNT=.COUNT+1;
%[760]%	IF .CSTMNT[IOERR]  NEQ 0 THEN COUNT=.COUNT+1;
%[760]%	IF .CSTMNT[IOIOSTAT] NEQ 0 THEN COUNT=.COUNT+1;
%[760]%	IF .CSTMNT[IORECORD] NEQ 0 THEN COUNT=.COUNT+1;
%4501%	IF .CSTMNT[SRCID] EQL READID
%4501%  THEN IF .CSTMNT[IOKEY] NEQ 0 THEN COUNT=.COUNT+2;   ! for IOKEY and IOKEYREL
%[760]%
%[760]%	RETURN .COUNT;

END;	! of CNTKEYS
GLOBAL ROUTINE IOENDERR=
BEGIN

! Output the  END=,  ERR= and  IOSTAT=  words of  an  I/O arg  block  if
! nonzero.  These words have the form:

!		---------------------------------------------------------
!		!   4	! TYPE	!I! X	!	IOEND			!
!		---------------------------------------------------------
!		!   5	! TYPE	!I! X	!	IOERR			!
!		---------------------------------------------------------
!		!   6	! TYPE	!I! X	!	IOIOSTAT		!
!		---------------------------------------------------------

! Output the END word if non zero

%[760]%	IF .CSTMNT[IOEND] NEQ 0
%[760]%	THEN
%[760]%	BEGIN
%[760]%		PBOPWD=0;
%[760]%		PBOPWD[OTSKEY]=OTSKEND;
%[760]%		PBOPWD[OTSTYPE]=ADDRTYPE;	!TYPE IS "ADDRESS"
%[760]%		PBOPWD[OTSADDR]=.CSTMNT[IOEND];
%[760]%		PSYMPTR=PBFLABREF;
%1401%		OIFIW()
%[760]%	END;

! Output the ERR= word if non zero

%[760]%	IF .CSTMNT[IOERR] NEQ 0
%[760]%	THEN
%[760]%	BEGIN
%[760]%		PBOPWD=0;
%[760]%		PBOPWD[OTSKEY]=OTSKERR;
%[760]%		PBOPWD[OTSTYPE]=ADDRTYPE;	!TYPE IS "ADDRESS"
%[760]%		PBOPWD[OTSADDR]=.CSTMNT[IOERR];
%[760]%		PSYMPTR=PBFLABREF;
%1401%		OIFIW()
%[760]%	END;

%[760]%	! Output the IOSTAT= word if non zero
%[760]%	IF .CSTMNT[IOIOSTAT] NEQ 0
%[760]%	THEN
%[760]%	BEGIN
%[760]%		PBOPWD=0;
%[760]%		PBOPWD[OTSKEY]=OTSKIOS;
%1123%		IOPTR(.CSTMNT[IOIOSTAT])
%[760]%	END

END;	! of IOENDERR
ROUTINE IOFORMAT=

! Routine to output the 1 or 2 FORMAT words of an I/O arg block.  Format
! statements, integer vars, real vars, logical vars, and character  vars
! used as a format have only a  FORMAT ADDRESS word in an I/O  argblock.
! Arrays used as formats  have both a FORMAT  ADDRESS word and a  FORMAT
! SIZE word.  These words have the form:

!   !=========================================================================!
!   !1!0!      2      ! TYPE  !I!   X    !           Format address           !
!   !-------------------------------------------------------------------------!
!   !1!0!      3      ! TYPE  !I!   X    !            Format size             !
!   !=========================================================================!

BEGIN

	REGISTER BASE FORMATP;		! Pointer to label or array
	REGISTER BASE AUX;		! Pointer to stmnt or dim table entry

	FORMATP=.CSTMNT[IOFORM];	! I/O statement contains pointer to
					!  label table or variable

![760]	Only output words if FORMAT exists
%[760]%	IF .FORMATP EQL 0 THEN RETURN;	! Nothing to do


%1432%	! Set key field in FORMAT ADDRESS WORD to OTSKFMT.
%1432%	PBOPWD = 0;
%1432%	PBOPWD[OTSKEY]=OTSKFMT;


	! Check for what we got in the way of a format.  If its
	! not x, check y, etc..  If its "none of the above", then
	! we got ourselves an error.

	IF .FORMATP[OPRCLS] EQL LABOP
	THEN
	BEGIN	! Format is label

		! If FORMAT is a stmnt - have a ptr to the label table
		! entry for its label
		AUX=.FORMATP[SNHDR];

		! If the stmnt referenced is not a FORMAT stmnt, give
		! an error message.
		IF .AUX[SRCID] NEQ FORMID
		THEN
		BEGIN
			FATLERR(.AUX[SRCISN],E91<0,0>);
			RETURN
		END;

		! Output the FORMAT address word
		PBOPWD[OTSADDR]=.AUX;
		PBOPWD[OTSTYPE]=ADDRTYPE;	! Type field is address
						!  (Indicates that FORMAT
						!  is not an array)
		PSYMPTR=PBFFORMAT;
%1401%		OIFIW();

	END	! Format is label

	ELSE					
	IF .FORMATP[DATOPS1] EQL ARRAYNM1
	THEN
	BEGIN	! ARRAY

		! Use IOPTR to output the FORMAT address word - if the
		! array is a formal IOPTR will set the indirect bit

		IOPTR(.FORMATP);

		![2314]	Output the FORMAT size word.

![760]		Set up keyword value
%[760]%		PBOPWD=0;
%[760]%		PBOPWD[OTSKEY]=OTSKFSIZ;

		! Get pointer to dimension table entry
		AUX=.FORMATP[IDDIM];

%2314%		IF .AUX[ADJDIMFLG]		! Adjustably dimensioned?
%2314%		THEN IOPTR(.AUX[ARASIZ])	! Yes, use .Q temp in ARASIZ
%2314%		ELSE IOPTR(.AUX[ARACONSIZ]);	! No, use constant in ARACONSIZ

	END	! ARRAY

%1516%	ELSE
%1432%	IF .FORMATP[VALTYPE] EQL CHARACTER
%1432%	THEN IOPTR(.FORMATP)		!Format is a character expression

%1516%	ELSE
%1432%	IF .FORMATP[DATOPS1] EQL VARIABL1
%1432%	THEN
%2003%	BEGIN	! Format must be an integer, real, or logical var
%2003%		IF .FORMATP[VALTYPE] EQL INTEGER
%2003%			OR .FORMATP[VALTYPE] EQL REAL
%2003%			OR .FORMATP[VALTYPE] EQL LOGICAL
%2003%		THEN
%2003%		BEGIN	!Format is an integer, real, or logical var.
%1432%			!Lie to FOROTS.  Set indirect bit and type the
%1432%			!format as an address (normal format stmt).
%1432%			PBOPWD[OTSIND]  = 1;
%1432%			PBOPWD[OTSTYPE] = ADDRTYPE;
%2317%			PBOPWD[OTSIFIW] = 1;	! Make this an IFIW
%2462%			GENREF(.FORMATP,TRUE);	! Construct memory reference
						!  and buffer the argument word
%2003%		END	!Format is an integer, real, or logical var.
%1432%		ELSE
%1516%		CGERR()	!Format is a variable, but not integer
%1432%	END	! Format was an integer or character var

%4525%	ELSE
%4525%	BEGIN	! Format is none of label, array name, char expr, or int var
%4525%
%4525%		! Accidental DO loop indicies can be regcontents.  (Such
%4525%		! things that project leaders are known to do.)  Other
%4525%		! things imply a corrupted tree in which case YELL!
%4525%
%4525%		IF .FORMATP[OPRCLS] EQL REGCONTENTS
%4525%		THEN FATLERR(.ISN,E211<0,0>)	! DO loop index (maybe)
%4525%		ELSE CGERR();			! Bad tree
%4525%
%4525%	END;	! Format is none of label, array name, char expr, or int var

END;	! of IOFORMAT
GLOBAL ROUTINE IOPTR(EXPR)=
BEGIN

!++
! FUNCTIONAL DESCRIPTION:
!
!	Generate an arg block entry for an expression node.
!
! FORMAL PARAMETERS:
!
!	EXPR		Points to expression node for argument.
!
! IMPLICIT INPUTS:
!
!	EVALU		Used to map PTR[VALTYPE] into argument type code.
!
!	PBOPWD[OTSKEY]	FOROTS argument keyword filled in by caller.
!
! IMPLICIT OUTPUTS:
!
!	PBOPWD		Destroyed.
!
!	PBUFF		Peephole buffer gets the finished arg block word.
!
!	PSYMPTR		Destroyed.
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	Could flush the peephole buffer into the object and listing files.
!
!--



![1401] Reworked for extended addressing

! Output a word of the form:

!=========================================================================!
!1!0! FOROTS func ! Type  !I! Index  !              Address               !
!=========================================================================!

! Note that the FOROTS function field (bits 2-8) are filled in by the caller

	MAP BASE EXPR;			! Expression node to emit an arg for

	%(***FILL IN TYPE-CODE FIELD OF WD TO BE OUTPUT***)%
![1002]	Choose arg type based on /GFLOATING
%1002%	PBOPWD[OTSTYPE] = .EVALU[.EXPR[VALTYPE]];
%2317%	PBOPWD[OTSIFIW] = 1;		! Make this an IFIW
%2462%	GENREF(.EXPR,TRUE);		! Generate the memory reference
					!  and buffer the argument word
END;	! of IOPTR
GLOBAL ROUTINE IOIMMED(EXPR)=	![1401] Reworked for extended addressing
%(***************************************************************************
	Output an immediate mode FOROTS arg for the value of EXPR.
	EXPR may be any integer expression.
	Note that PBOPWD must be cleared and then PBOPWD[OTSKEY] must be
	set by the caller
***************************************************************************)%
BEGIN

	MAP PEXPRNODE EXPR;

![1471]	This routine is called for somethings that can not be made into
![1471]	immediate mode arguments for FOROTS.  If this routine is called
![1471]	with a EXPR that is not a constant, then it calls IOPTR to make
![1471]	a normal non-immediate mode argument pointer.  This edit moved
![1471]	two consistency checks into the if statement that decides if the
![1471]	EXPR is a constant.  This allows UNIT=character to pass through.

! How the ptr is to be built depends on the operator of the expression
! If the expression is an integer constant

	IF .EXPR[OPR1] EQL CONSTFL
	THEN	! Put the constant directly in the arg list
	BEGIN

%1471%		! If the arg is not type integer or if the arg already must
%1471%		! be referenced indirectly, then there is a compiler bug

%1471%		IF .EXPR [VALTP1] NEQ INTEG1
%1471%		THEN CGERR();

%1471%		IF .EXPR[TARGIF] NEQ 0
%1471%		THEN CGERR();

		PBOPWD[OTSTYPE]_IMMEDTYPE;	! Immediate constant
		PBOPWD[OTSADDR]_.EXPR[CONST2];
		PSYMPTR_PBF2NOSYM;
		OIFIW()
	END
	ELSE IOPTR(.EXPR)

END;	! of IOIMMED
ROUTINE OPNKEYS=

!++
! FUNCTIONAL DESCRIPTION:
!
!	Generate the secondary arg block for keys
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	CSTMNT		PTR TO OPEN STATEMENT NODE	
!
! IMPLICIT OUTPUTS:
!
!	PBOPWD - THE ARGUMENT WD TO BE OUTPUT
!	PSYMPTR - PTR TO THE SYMBOL TABLE ENTRY FOR THE SYMBOL IN THE
!			RIGHT HALF OF THE ARG-WD
!		OR:
!		"PBF2NOSYM" - IF BOTH HALVES OF THE WD ARE OCTAL CONSTANTS
!		"PBF2LABREF" - IF BOTH HALVES OF THE WD ARE PTRS TO LABEL 
!				TABLE ENTRIES
!		"PBFLABREF" - IF LEFT HALF IS AN OCTAL CONSTANT,
!				RIGHT HALF IS A PTR TO A LABEL TABLE ENTRY
!
!	IF PSYMPTR IS A PTR TO A SYMBOL TABLE ENTRY, THEN CAN ASSUME THAT THE 
!	  LEFT HALF OF THE ARGWD IS AN OCTAL CONSTANT
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	May flush the peephole buffer into the object and listing files.
!
!--



BEGIN 	! New [4500]
	LOCAL OPNKEYLIST KVALLST;	! List of keys pointed to by IOKEY for this OPEN stmnt
	LOCAL LAB;			! label to secondary arg block for KEY=


	! Output forots code for KEY= with ptr to its arg block

	LAB=GENLAB();
	PBOPWD = 0;
	PBOPWD[OPENGFIELD] = OPNCKEY;
	PBOPWD[OTSTYPE] = ADDRTYPE;
	PBOPWD[OTSADDR] = .LAB;
	PSYMPTR = PBFLABREF;
	OIFIW();

	! Output minus the (count of words * 3)

	KVALLST=.CSTMNT[IOKEY];
	PBOPWD<LEFT> = 3*(-.KVALLST[NUMKEYS]);	! Count in left half word
	PBOPWD<RIGHT> = 0;
	PSYMPTR = PBF2NOSYM; ! both halves of PBOPWD are octal constants
	OBUFFA();

	! Associate the label on the arg block with this loc
	DEFLAB(.LAB);

	! Walk thru the list of keys, generating code for them
	INCR I FROM 1 TO .KVALLST[NUMKEYS] DO
	BEGIN
		! generate code for lower bound of Ith key

		PBOPWD = 0;
		IOPTR(.KVALLST[.I,KEYLOW]);

		! generate code for upper bound of Ith key
		
		PBOPWD = 0;
		IOPTR(.KVALLST[.I,KEYHIGH]);

		! generate code for type of key (integer or character)

		PBOPWD = 0;
		PBOPWD[OTSTYPE] = .EVALU[.KVALLST[.I,KEYTYPE]];
		PBOPWD[OTSIFIW] = 1;
		PSYMPTR = PBF2NOSYM;
		OBUFFA();
	END;
END;	! of OPNKEYS
ROUTINE CGOPARGS=
BEGIN

! Generate an OPEN type argument

	LOCAL OPENLIST ARVALLST;	! List of args under this OPEN stmnt
	LOCAL PEXPRNODE ARGVAL;		! Ptr to  STE  or  constant  table
					! entry for the value to be passed
					! to FOROTS for a given arg.

	ARVALLST_.CSTMNT[OPLST];

! Walk thru the list of args, generating code for them

	INCR I FROM 0 TO .CSTMNT[OPSIZ]-1 DO
	BEGIN
		PBOPWD_0;
		PBOPWD[OPENGFIELD]_.ARVALLST[.I,OPENLCODE];

		ARGVAL_.ARVALLST[.I,OPENLPTR];	! EXPR node for val of this arg

		IF .ARGVAL EQL 0		! DIALOG can have a null value
		THEN
		BEGIN
			PSYMPTR_PBFNOSYM;
			PBOPWD[OTSADDR]_0;
%1401%			OIFIW()
		END
		ELSE
		BEGIN

! Set the indirect bit for an array reference as an associate variable

			IF .PBOPWD[OPENGFIELD] EQL OPNCASSOCIATE
			THEN	IF .ARGVAL[OPRCLS] NEQ DATAOPR
					AND .ARGVAL[OPRCLS] NEQ ARRAYREF
				THEN PBOPWD[OTSIND]=1;

%1401%			IOPTR(.ARGVAL)
		END
%4500%	END;
%4500%	IF .CSTMNT[IOKEY] NEQ 0
%4500%	THEN OPNKEYS();	! generate secondary argument block for KEY= specifier
END;	! of CGOPARGS
GLOBAL ROUTINE CGIOARGS=
BEGIN

! Code generation for argument blocks for I/O statements themselves.  It
! is assumed that  CSTMNT points  to the statement.   This implies  that
! there is a  driver routine that  is following the  linked list of  I/O
! statements and calling this routine and then CGIOLARGS to generate the
! argument block for the I/O list.

MACRO
	UTILLOW=BACKID$,
	UTILHI=ENDFID$,
	IOSRCIDBAS=READID$;

! To output a word for zeros. This word distinguishes binary WRITEs from
! list directed WRITEs (READs too).


! If this stmnt was  removed from the program  by P2SKEL, then  IOARGLBL
! field will never have been filled  in.  Do not generate an arglist  in
! this case.
!			*****WARNING****
! Will have problems if  IOARGLBL field is ever  used for anything  else
! and so is non-zero.

	IF .CSTMNT[IOARGLBL] EQL 0 THEN RETURN;

	IF .CSTMNT[SRCID] EQL OPENID OR
%2201%	   .CSTMNT[SRCID] EQL INQUID
	THEN
	BEGIN	! Special case OPEN and INQUIRE statements
%760%		OPNFARGS(); 	! Output the first args for OPEN/CLOSE
		CGOPARGS();	! Output the other arguments
		RETURN		! Do not want to look at the IOLIST
	END	! Special case OPEN and INQUIRE statements
	ELSE
	IF .CSTMNT[SRCID] GEQ UTILLOW AND .CSTMNT[SRCID] LEQ UTILHI
	THEN
	BEGIN	! MTOP.
%4504%		IF .CSTMNT[SRCID] NEQ UNLCKID	! UNLOCK is not a magtape utility
%4504%		THEN
%4504%		BEGIN

%760%			IO1ARG(CNTKEYS()+1);	! One extra for function code

			IOENDERR();

! Output a word that contains a code indicating the function to be performed

			PBOPWD_0;
![760] Set up keyword value
%[760]%			PBOPWD[OTSKEY]_OTSKMTOP;
			PBOPWD[OTSTYPE]_IMMEDTYPE;
			PBOPWD[OTSADDR]_.MTOPFUN[.CSTMNT[SRCID]-UTILLOW];
			PSYMPTR_PBF2NOSYM;
%1401%			OIFIW();
%4504%		END
%4504%		ELSE	! UNLOCK
%4504%		BEGIN
%4504%			IO1ARG(CNTKEYS());
%4504%			IOENDERR();
%4504%		END;
	END	! MTOP.
	ELSE
	BEGIN	! other I/O statements
		CASE (.CSTMNT[SRCID]-IOSRCIDBAS) OF SET
	%READID%	REDORWRIT();
	%WRITID%	REDORWRIT();
	%DECOID%	CGDECARGS();
	%ENCOID%	CGDECARGS();
	%REREDID%	BEGIN
![760] Output first words of arg block
%[760]%				IO1ARG(CNTKEYS());
				IOENDERR();
				IOFORMAT();
			END;
	%FINDID%	BEGIN
![760] Output first words of arg block
![760] Set up keyword value
%[760]%			IO1ARG(CNTKEYS());
%[760]%			IOENDERR();
			PBOPWD=0;
%[760]%			PBOPWD[OTSKEY]_OTSKREC;
			IOPTR(.CSTMNT[IORECORD])
			END;
	%CLOSID%	BEGIN
![760] Output the first args for OPEN/CLOSE
%[760]%			OPNFARGS();
			CGOPARGS();
			RETURN		! Do not want to look at the IOLIST
		END;
%4502%	%DELEID%	BEGIN
%4502%				IO1ARG(CNTKEYS());
%4502%				IOENDERR();
%4502%				IF .CSTMNT[IORECORD] NEQ 0
%4502%				THEN
%4502%				BEGIN
%4502%					PBOPWD=0;
%4502%					PBOPWD[OTSKEY]=OTSKREC;
%4502%					IOPTR(.CSTMNT[IORECORD])	
%4502%				END;
			END;
%4503%	%REWRID%	REDORWRIT();
		TES;
	END;	! other I/O statements
	IF .CSTMNT[IOLIST] NEQ 0 THEN
	BEGIN
		TREEPTR_.CSTMNT[IOLIST];
		CGIOLARGS()
	END

END;	! of CGIOARGS
GLOBAL ROUTINE REDORWRIT=
BEGIN

! Code generation for  a READ  or WRITE statement  including all  sizes,
! shapes, varieties and colors.

	REGISTER BASE T1;

		IF EXTSIGN(.CSTMNT[IOFORM]) EQL 0 THEN
		BEGIN					! Binary I/O
![760] Output first words of arg block
%760%			IO1ARG(CNTKEYS());
			IOENDERR();

			%(***BINARY WRITE WITH NO IOLIST IS ILLEGAL***)%
			!IF .CSTMNT[IOLIST] EQL 0 AND .CSTMNT[SRCID] EQL WRITID
			!THEN ERROUT(97);
		END ELSE
		IF EXTSIGN(.CSTMNT[IOFORM]) EQL -1 THEN
		BEGIN					! List directed I/O
![760] Output first words of arg block
%760%			IO1ARG(CNTKEYS());
			IOENDERR();

![760] Set up keyword value
%760%			PBOPWD=0;
%760%			PBOPWD[OTSKEY]=OTSKFMT;
%760%			PSYMPTR=PBF2NOSYM;
%1401%			OIFIW();

		END ELSE
		BEGIN
			T1=.CSTMNT[IONAME];
			IF .T1[OPRCLS] EQL DATAOPR
%1516%				AND .T1[OPERSP] NEQ CONSTANT
				AND .T1[IDATTRIBUT(NAMNAM)]
			THEN
			BEGIN	! NAMELIST I/O

%1435%				! CNTKEYS knows FMT=NAMELIST generates only
%1435%				!  one word in the FOROTS argblock

%1435%				IO1ARG(CNTKEYS());

				IOENDERR();	! Handle END=, ERR= and IOSTAT=

! Make a  label for  the NAMELIST  arg block  and tuck  it away  in  the
! IDCOMMON field  of the  symbol table.   Make it  only if  there  isn't
! already one there.

				IF .T1[IDCOMMON] EQL 0 THEN
					T1[IDCOMMON]=GENLAB();
				PSYMPTR=PBFLABREF;
				PBOPWD=.T1[IDCOMMON];
				PBOPWD[OTSKEY]=OTSKNAME;
%1574%				PBOPWD[OTSTYPE]=ADDRTYPE;
%1401%				OIFIW()
			END
			ELSE
			BEGIN				! Formatted READ
				IO1ARG(CNTKEYS());
				IOENDERR();
				IOFORMAT()
			END
		END;

%4501%		IF .CSTMNT[IOKEY] NEQ 0
%4501%		THEN
%4501%		BEGIN	
%4501%			PSYMPTR=PBF2NOSYM;
%4501%
%4501%			!FOROTS argument for IOKEY
%4501%			PBOPWD = 0;
%4501%			PBOPWD[OTSKEY] = OTSKKEY;
%4501%			IOPTR(.CSTMNT[IOKEY]);
%4501%
%4501%			!FOROTS argument for IOKEYREL
%4501%			PSYMPTR=PBF2NOSYM;
%4501%			PBOPWD = 0;
%4501%			PBOPWD[OTSKEY] = OTSKKREL;
%4501%			PBOPWD[OTSIFIW] = 1;
%4501%			PBOPWD<RIGHT> = .CSTMNT[IOKEYREL];
%4501%			OBUFFA();
%4501%
%4501%
%4501%			!FOROTS argument for IOKEYID
%4501%			IF .CSTMNT[IOKEYID] NEQ 0
%4501%			THEN
%4501%			BEGIN
%4501%				PBOPWD = 0;
%4501%				PBOPWD[OTSKEY] = OTSKKID;
%4501%				IOPTR(.CSTMNT[IOKEYID]);
%4501%			END
%4501%		END	
%4501%
%4501%		! Both IOKEY and IORECORD cannot exist together
%4501%		ELSE IF .CSTMNT[IORECORD] NEQ 0 
%4501%		THEN
		BEGIN
			! Since IORECORD is non-zero, there is either a REC=
			! record specifier for random access external I/O or
			! a character count for a multi-record internal file.
			! See if the UNIT is character to determine which
			! FOROTS key to generate.

%1471%			PBOPWD = 0;
%1472%			PBOPWD[OTSKEY] = OTSKREC;	! Assume external file
%1471%			T1 = .CSTMNT[IOUNIT];
%1471%			IF .T1[OPERATOR] EQL OPERC(CHARACTER,DATAOPR,ARRAYNAME)
%1471%			OR .T1[OPERATOR] EQL OPERC(CHARACTER,DATAOPR,FORMLARRAY)
%1472%			THEN PBOPWD[OTSKEY] = OTSKEDSIZ; ! Nope, internal file
%760%			IOPTR(.CSTMNT[IORECORD])
		END

END;	! of REDORWRIT
GLOBAL ROUTINE NAMGEN=	![1502] Reworked by AHM
BEGIN	! Generate NAMELIST blocks for FOROTS


OWN BASE
	MRNAMPTR:	! Master NAMELIST pointer
	NAMLENTRY;	! Pointer to each NAMELIST entry

LOCAL	SAVCNT;		![4532] SAVE INITIAL VALUE OF ILABIX

REGISTER BASE
	PTR:		! Points to various things
	DMETRY;		! Pointer to dimension table entry

	MRNAMPTR=.NAMLPTR<LEFT>;	! Get pointer to first NAMELIST block
	WHILE .MRNAMPTR NEQ 0		! Loop over all of them
	DO				!  in order to output them
	BEGIN

! If this NAMELIST is never referenced  in the program, then no  label
! will have been associated with it.  If so do not generate it.   Note
! that the "IDCOMMON" field is used to hold the label of a NAMELIST.

		PTR=.MRNAMPTR[NAMLID];	! Point to the STE for the NAMLIST

		IF .PTR[IDCOMMON] NEQ 0	! Is there a label ?
		THEN			! Yes
		BEGIN

%4532%			SAVCNT = .ILABIX; !Save counter used for generating labels
%4532%			DEFLAB(GENLAB()); !Define label for namelist name
%4532%			PSYMPTR=PBF2NOSYM;	! Don't relocate this word
%4532%			INCR J FROM 0 TO .PTR[IDSYMLENGTH] - 1
%4532%			DO	!Dump out namelist name
%4532%			BEGIN
%4532%				PBOPWD=@(.PTR[IDSYMPOINTER] +.J);
%4532%				OBUFFA();
%4532%			END;

%4533%			! Only output a word of zero if there isn't
%4533%			! a character of zero already out.
%4533%
%4533%			IF .PBOPWD<SYM6THCHAR> NEQ 0
%4533%			THEN
%4533%			BEGIN	! Not null terminated
%4532%				PBOPWD = 0; !followed by word of null
%4532%				OBUFFA();
%4533%			END;
%4532%
%4532%			INCR I FROM 0 TO .MRNAMPTR[NAMCNT]-1
%4532%			DO	! Now each entry in the NAMELIST
%4532%			BEGIN
%4532%				! Point to a NAMELIST entry
%4532%
%4532%				DEFLAB(GENLAB()); !Define a label
%4532%
%4532%				NAMLENTRY=@(.MRNAMPTR[NAMLIST]+.I);
%4532%				INCR J FROM 0 TO .NAMLENTRY[IDSYMLENGTH] - 1
%4532%				DO	!Dump out namelist entry name
%4532%				BEGIN
%4532%					PBOPWD=@(.NAMLENTRY[IDSYMPOINTER] +.J);
%4532%					OBUFFA();
%4532%				END;

%4533%				! Only output a word of zero if there isn't
%4533%				! a character of zero already out.
%4533%
%4533%				IF .PBOPWD<SYM6THCHAR> NEQ 0
%4533%				THEN
%4533%				BEGIN	! Not null terminated
%4532%					PBOPWD = 0; ! Word of null
%4532%					OBUFFA();
%4533%				END;
%4532%			END;
			DEFLAB(.PTR[IDCOMMON]);	! Define the arg block label
						!  that was stored in the
						!  IDCOMMON field of the
						!  NAMELIST name by REDORWRIT

!                              NAMELIST block

! !=========================================================================!
! !                         Pointer to SIXBIT NAMELIST name                 !
! !=========================================================================!
! !                          First NAMELIST entry                           !
! !-------------------------------------------------------------------------!
! \                                                                         \
! \                          More NAMELIST entries                          \
! \                                                                         \
! !=========================================================================!
! !                       4000,,0 (FOROTS FIN. word)                        !
! !=========================================================================!

%4532%			ENTRY = .SAVCNT;	!Given SAVCNT, look up label
%4532%			NAME = LABTAB;          ! Look for label
%4532%			PBOPWD = TBLSEARCH();	
%4532%			PSYMPTR = PBFLABREF;	!PBOPWD contains label table entry
%4532%			OBUFFA();		!Output this label

			INCR I FROM 0 TO .MRNAMPTR[NAMCNT]-1
			DO		! Loop for each entry in the NAMELIST
			BEGIN
				! Point to a NAMELIST entry

				NAMLENTRY=@(.MRNAMPTR[NAMLIST]+.I);

%4532%				ENTRY = SAVCNT = .SAVCNT+1;	!Output address of name
%4533%				NAME = LABTAB;          ! Look for label
%4532%				PBOPWD = TBLSEARCH();	!Output address of name
%4532%				PSYMPTR = PBFLABREF;	!PBOPWD contains label table entry
%4532%				OBUFFA();

				PBOPWD=0;	! Clear the output buffer word

				IF .NAMLENTRY[OPERSP] EQL ARRAYNAME
				THEN
				BEGIN	! Output ARRAYNAME entry

!                        Array NAMELIST block entry

! !=========================================================================!
! !1!0!  Dim count  ! Type  !I!   X    !      Pointer to Array name         !
! !-------------------------------------------------------------------------!
! !                           Array size in items                           !
! !-------------------------------------------------------------------------!
! !                             Offset in words                             !
! !=========================================================================!
! !                           First array factor                            !
! !-------------------------------------------------------------------------!
! \                                                                         \
! \                              More factors                               \
! \                                                                         \
! !=========================================================================!

					DMETRY=.NAMLENTRY [IDDIM];	! Point to dimension table

					PBOPWD[OTSCNT]=.DMETRY[DIMNUM];	! Set the number of dimensions
					IOPTR (.NAMLENTRY);		! Output the array base word

					! Get array size in items (ARASIZ  field is in words or bytes).   Note
					! that adjustably dimensioned arrays are illegal in NAMELISTS.

%1502%					IF .NAMLENTRY[VALTYPE] EQL CHARACTER
%1502%					THEN IF .NAMLENTRY[IDCHLEN] EQL LENSTAR
%1502%						THEN CGERR()
%1502%						ELSE PBOPWD=.DMETRY[ARASIZ]/.NAMLENTRY[IDCHLEN]
%1502%					ELSE PBOPWD=(IF .NAMLENTRY[DBLFLG]
						THEN .DMETRY[ARASIZ]/2
						ELSE .DMETRY[ARASIZ]);

%1502%					PSYMPTR=PBF2NOSYM;	! Don't relocate this word
%1502%					OBUFFA();		! Output the word

					PTR=.DMETRY[ARAOFFSET];	! Point to the constant entry
								!  for the offset

					! Compiler adds the offset - FOROTS
					! subtracts it.  Therefore we must
					! pass FOROTS the negative of the
					! offset used by the compiler

					IF .PTR[OPR1] EQL CONSTFL
%1502%					THEN PBOPWD=-.PTR[CONST2]
					ELSE CGERR();	!(ADJUSTABLY DIM ARRAY ILLEGAL)

					OBUFFA();		! Output the word (also not relocated)

					! Now for the factors

					PSYMPTR=PBF2NOSYM; ! Factors aren't relocatable

					INCR K FROM 1 TO .DMETRY[DIMNUM]	! Loop over all the factors
					DO
					BEGIN
						PTR=.DMETRY[DFACTOR ((.K-1))];	! Point to the constant table entry

						IF .PTR [OPR1] EQL CONSTFL	! Consistancy check
						THEN	! OK (must be constant)
						BEGIN	! Get factor in items or bytes (not words)
%1502%							IF .NAMLENTRY[VALTYPE] EQL CHARACTER
%1502%							THEN IF .NAMLENTRY[IDCHLEN] EQL LENSTAR
%1502%								THEN CGERR()
%1502%								ELSE PBOPWD=.PTR[CONST2]
%1502%							ELSE PBOPWD=(IF .NAMLENTRY[DBLFLG]
								THEN .PTR[CONST2]/2
								ELSE .PTR[CONST2]);

							OBUFFA()	! Output the factor
						END
						ELSE CGERR()	! Factor must be a constant
					END	! of factor output

				END	! of array output
				ELSE	! We have a scalar
					IOPTR(.NAMLENTRY);	! Output the scalar

!                        Scalar NAMELIST block entry

! !=========================================================================!
! !1!0!      0      ! Type  !I!   X    !         Address of scalar          !
! !=========================================================================!


			END;	! of INCR loop on entries in NAMELIST

			PBOPWD=OTSFINWD;	! FIN. terminating word
			PSYMPTR=PBF2NOSYM;	! Don't relocate it
			OBUFFA();		! Output the word
		END;	! of the IF for nonzero label

		MRNAMPTR=.MRNAMPTR[NAMLINK];	! Go on to the next NAMELIST

	END;	! of WHILE loop over NAMELISTs

END;	! of NAMGEN

END
ELUDOM