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

!COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: S. MURPHY/HPW/DCE/SJW
MODULE	CGSTMNT(SREG=#17,VREG=#15,FREG=#16,DREGS=4,RESERVE(0,1,2,3)) =
BEGIN

GLOBAL BIND CGSTV = 5^24 + 1^18 + 131;	!VERSION DATE: 14-AUG-77

%(
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
125	367	18239	MAKE WRITE(3) GENERATE CORRECT CODE
126	376	18398	PREVENT CGRECNUM FROM CHANGING A1LABEL

*********** BEGIN VERSION 5A *************

127	532	20323	SET INDIRECT BIT IN ARG BLOCK FOR ARRAY
			REF AS ASSOCIATE VARIABLE
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
)%

	FORWARD
		CGASMNT(0),CGAGO(0),CGCGO(0), CGLOGIF(0),CGARIF(0),CGASSI(0),CGCMNSUB(0),
		CGPAUSE(0),CGSTOP(0),
		CGIOLST(0),CGIOCALL(1),
		CGIOLARGS(0),CGDCALL(0),CGSLIST(0),
		CGE1LIST(1),CGE2LIST(1),
		CAE1LIST(0),CAE2LIST(0),
		BLDIOIMWD(1),
		CGMTOP(0),CGREAD(0),CGWRIT(0),CGDECO(0),CGENCO(0),CGRERE(0),
		CGUNIT(0),CGRECNUM(0),CGFIND(0),
		CGCLOS(0),CGOPEN(0),CGEND(0),
		IOPTR(1);


	EXTERNAL CGERR,OUTMOD, PEEPOPTIMZ,  CGFNCALL, CGARREF, 
		OPCMGET,OPGETA,OPGETI,OPGARI,OPGARA,OPGSTA,OPGSTI,
		OPGPAU,OPGSTP,OPGEXI,OPGIOL,OPGREL,OPGBOOL,OPGCGO,OPGCGI,
		OPGASR,OPGVTS,OPGAIF,ZERBLK,
%[607]%		NEDZER,	! FLAG TO INDICATE IF ZERO-ARG-BLOCK NEEDED
		OPGENDISP;

	EXTERNAL
		CGETVAL,CGOPGEN,
		CGARGEVAL,TREEPTR,A1NODE,A2NODE,A1LABEL,C1H,OPDSPIX,REGFORCOMP,CSTMNT;

	EXTERNAL
		CGCBOOL,GENLAB,DEFLAB,CGREL1;
	EXTERNAL CGDOLOOP,CGDOEND,CGPROEPI,CGSFN,CGSBPRGM,CGRETURN,CGARGS;
	EXTERNAL
		PBOPWD,PSYMPTR,OBUFF,OBUFFA;
EXTERNAL OPGASA,OPGASI,OPASIN;
EXTERNAL OPGAI1,OPGAI2;

SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;


MAP PEXPRNODE TREEPTR:A1NODE:A2NODE;

MAP BASE CSTMNT;

OWN BASE TOPSTMNT;	!WHEN HAVE A STATEMENT EMBEDDED INSIDE ANOTHER (EG IN 
			! LOGICAL IFS) THIS VAR PTS TO THE TOP LEVEL STMNT NODE

GLOBAL ROUTINE CGSTMNT=
%(***************************************************************************
	ROUTINE TO PERFORM CODE GENERATION FOR A STATEMENT.
	CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT FOR WHICH CODE
	IS TO BE GENERATED.
***************************************************************************)%
BEGIN
	EXTERNAL XCTFDDT;	!ROUTINE TO GENERATE "XCT FDDT."
	EXTERNAL PBFPTR;
	MAP PPEEPFRAME PBFPTR;

	%(***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 INSTR TO BE GENERATED TO ISN OF THIS STMNT***)%
	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();		!FOR AN ASSIGNMENT
	CGASSI();		! ASSIGN
	BEGIN			! CALL
		IF .CSTMNT[SRCCOMNSUB] NEQ 0
		THEN CGCMNSUB();		!IF HAVE ANY COMMON SUBS
						! GENERATE CODE FOR THEM
		CGSBPRGM(.CSTMNT[CALLIST],.CSTMNT[CALSYM]);	
	END;
	BEGIN END;		! CONTINUE
	CGDOLOOP();		! DO
	CGPROEPI();		! ENTRY
	CGASMNT();		! COMMON SUBEXPR - SAME AS ASMNT

	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
	BEGIN END;		! INPUT (NOT IN RELEASE 1)
	BEGIN END;		! OUTPUT (NOT IN RELEASE 1)

	CGMTOP();		! BACKSPACE
	CGMTOP();		! BACKFILE
	CGMTOP();		! REWIND
	CGMTOP();		! SKIP FILE
	CGMTOP();		! SKIP RECORD
	CGMTOP();		! UNLOAD
	CGMTOP();		! RELEASE
	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
	TES;

	%(***IF THIS STMNT HAS A LABEL, CHECK FOR WHETHER IT ENDS A DO STMNT***)%
	IF .CSTMNT[SRCLBL] NEQ 0
	THEN CGDOEND(.CSTMNT[SRCLBL]);

END;


GLOBAL ROUTINE CGASMNT=
%(***************************************************************************
	ROUTINE TO GENERATE CODE FOR ASSIGNMENT STATEMENTS.
	CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT FOR
	WHICH CODE IS TO BE GENERATED.
***************************************************************************)%
BEGIN

	%(***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***)%
	IF .CSTMNT[A1VALFLG]
		OR (.CSTMNT[MEMCMPFLG] AND .CSTMNT[RVRSFLG])	!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;

GLOBAL ROUTINE CGASSI=
%(***************************************************************************
	GENERATE CODE FOR AN ASSIGN STATEMENT.
	NOTE THAT THE VARIABLE WILL ALWAYS BE LOADED INTO REGISTER 1
***************************************************************************)%
BEGIN
	%(***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;

GLOBAL ROUTINE CGAGO=
%(***************************************************************************
	ROUTINE TO GENERATE CODE FOR ASSIGNED GOTO STATEMENT.
	CALLED WITH "CSTMNT" POINTING TO THE STATEMENT TO BE PROCESSED.
	IF A LIST OF LABELS WAS SPECIFIED FOR THIS STMNT,
	CODE GENERATED IS:
		MOVE	1,VAR
		CAIN	1,LAB1
		JRST	LAB1
		CAIN	1,LAB2
		JRST	LAB2
		.
		.
	IF NOT, THE CODE GENERATED IS
		SKIPE	1,VAR
		JRST	0(1)
***************************************************************************)%
BEGIN

	%(***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;
	BIND AGORGIX=1^18;

	OWN AGOLSTPTR;
	OWN 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 ASSIGNED VAR IS AN ARRAY REFERENCE*****)%
	IF .AGOVAR[OPRCLS] EQL ARRAYREF
	THEN
	BEGIN
		TREEPTR_.AGOVAR;
		CGETVAL();

		PSYMPTR_.AGOVAR[ARG1PTR];		!SYMBOL TABLE ENTRY FOR THE
							! ARRAY
		PBOPWD_.AGOVAR[TARGET];			!ADDRESS FIELD TO REF THE ARRAY
							! ELEMENT DESIRED
	END

	%(***IF ASSIGNED VAR IS A SCALAR***)%
	ELSE
	BEGIN
		PSYMPTR_.AGOVAR;
		PBOPWD_.AGOVAR[IDADDR];
	END;


	%(****IF NO LIST OF LABELS WAS SPECIFIED******)%
	IF .CSTMNT[GOTOLIST] EQL 0
	THEN
	BEGIN
		%(***GENERATE "SKIPE 1,VAR" ***)%
		PBOPWD_.PBOPWD OR SKIPEOC OR AGOREG;
		OBUFF();

		%(***GENERATE JRST 0(1)***)%
		PSYMPTR_PBFNOSYM;
		PBOPWD_JRSTOC OR AGORGIX;
		OBUFF();
	END

	%(***IF A LIST OF LABELS WAS SPECIFIED***)%
	ELSE
	BEGIN
		%(***GENERATE HRRZ 1,VAR****)%
		PBOPWD_.PBOPWD OR HRRZOC OR AGOREG;
		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]-1) TO 0
		DO
		BEGIN
			PBOPWD_CAINOC OR AGOREG OR @.AGOLSTPTR;
			PSYMPTR_PBFLABREF;
			OBUFF();
			JRSTGEN(@.AGOLSTPTR);
			AGOLSTPTR_.AGOLSTPTR+1;
		END;
	END;
END;



GLOBAL ROUTINE CGCGO=
%(***************************************************************************
	ROUTINE TO GENERATE CODE FOR COMPUTED GOTO.
	CODE GENERATED IS:
		SKIPLE	01,VAL
		CAILE	01,CT
		JRST	Y
		JRST	@.(1)
		ARG	L1
		ARG	L2
		.
		.
	   Y:	1ST INSTR OF NEXT STMNT
	CALLED WITH THE GLOBAL CSTMNT POINTING TO THE COMPUTED GOTO STMNT
***************************************************************************)%
BEGIN
	OWN BASE NXTSTMNT;

	%(***DEFINE OPCODES USED FOR COMPUTED GOTO***)%
	BIND	SKIPLEOC=#333^27,
		CAILEOC=#303^27,
		SKIPAOC=#334^27,
		ARGOC=JUMPOCD^27;			!USE JUMP

	%(***ALWAYS USE REGISTER 1 TO HOLD THE COMPUTED VAL***)%
	BIND	CGOREG=1^23,
		CGORGIX=1^18;

	OWN PEXPRNODE CGOEXP;
	OWN CLOC;
	OWN CGOLSTPTR;

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


	CGOEXP_.CSTMNT[CGOTOLBL];

	%(***IF THE EXPRESSION IS NOT A SCALAR OR A COMMON SUB, EVALUATE IT***)%
	IF .CGOEXP[OPRCLS] NEQ DATAOPR AND .CGOEXP[OPRCLS] NEQ CMNSUB
	THEN
	BEGIN
		TREEPTR_.CGOEXP;
		CGETVAL();
	END;

	%(***GENERATE THE SKIPLE, CAILE, JRST SEQUENCE***)%

	%(******DETERMINE WHAT THE LABEL ON THE NEXT STMNT IS, IF THERE IS NONE, GENERATE ONE***)%
	%(*******(NOTE THAT IF THIS STMNT IS EMBEDDED INSIDE AN ARITH OR LOGICAL IF, MUST
		LOOK AT THE "TOP-LEVEL" STMNT NODE TO GET A PTR TO THE NEXT STMNT)***)%
	NXTSTMNT_(IF .CSTMNT[CLINK] NEQ 0 THEN .CSTMNT[CLINK] ELSE .TOPSTMNT[CLINK]);
	A1LABEL_(IF .NXTSTMNT[SRCLBL] NEQ 0 THEN .NXTSTMNT[SRCLBL]
		 ELSE (NXTSTMNT[SRCLBL]_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, GENERTAE "ARG LAB"***)%
	PSYMPTR_PBFLABREF;
	CGOLSTPTR_.CSTMNT[GOTOLIST];
	DECR CT FROM (.CSTMNT[GOTONUM]-1) TO 0
	DO
	BEGIN
		PBOPWD_ARGOC OR @.CGOLSTPTR;
		OBUFF();
		CGOLSTPTR_.CGOLSTPTR+1;
	END;

END;

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;


GLOBAL ROUTINE CGEND=
%(*********************************************************
	TO GENERATE CODE FOR AN END STATEMENT
**********************************************************)%
BEGIN
	EXTERNAL CGEPILOGUE;
%[607]%	EXTERNAL NEDZER;	! FLAG TO INDICATE IF ZERO-ARG-BLOCK NEEDED
	EXTERNAL ZERBLK;
	!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
%[607]%		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;
GLOBAL ROUTINE CGSTOP=
%(***************************************************************************
	TO GENERATE CODE FOR A STOP STMNT
***************************************************************************)%
BEGIN
%[607]%	EXTERNAL NEDZER;	! FLAG TO INDICATE IF ZERO-ARG-BLOCK NEEDED
	EXTERNAL ZERBLK;
	%(***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
%[607]%			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;


GLOBAL ROUTINE CGPAUSE=
%(***************************************************************************
	ROUTINE TO GENERATE CODE FOR PAUSE
***************************************************************************)%
BEGIN
%[607]%	EXTERNAL NEDZER;	! FLAG TO INDICATE IF ZERO-ARG-BLOCK NEEDED
	EXTERNAL ZERBLK;

	A1LABEL_(IF .CSTMNT[PAUSIDENT] EQL 0	!IF DO NOT HAVE A CNST
						! TO PRINT OUT, THEN ARGLIST
						! FOR FOROTS "PAUSE" ROUTINE WILL BE 0
%[607]%			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;
	

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
	EXTERNAL A1LABEL,A2LABEL,A3LABEL;	!GLOBALS USED BY THE CODE-GENERATION
	EXTERNAL REGFORCOMP,A1NODE,A2NODE;	! TABLE DRIVER
	EXTERNAL TREEPTR;

	MAP PEXPRNODE A1NODE:A2NODE:TREEPTR;

	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;

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;



GLOBAL ROUTINE CGIOLST=
%(***************************************************************************
	ROUTINE TO 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, OR A CONTINUE
			WHICH TERMINATES A DO-LOOP, OR AN ASSIGNMENT),  PERFORM
			USUAL CODE GENERATION FOR THAT TYPE OF STATEMENT
		2. IF THE ELEMENT IS AN "IOLSCLS" NODE (IE A DATACALL, SLISTCALL,
			IOLSTCALL,E1LISTCALL,OR E2LISTCALL), PERFORM CODE
			GENERATION FOR ALL ELEMENTS UNDER THE NODE AND
			ALSO GENERATE:
				MOVEI	16,ARGBLKP
				PUSHJ	17,IOLST.
			WHERE ARGBLKP IS A PTR TO THE ARGBLOCK FOR THIS ELEMENT
***************************************************************************)%
BEGIN
	LOCAL SAVSTMNT;
	LOCAL BASE IOLELEM;
	EXTERNAL GENLAB;
	EXTERNAL OPDSPIX,A1LABEL,CGOPGEN,OPGFIN;

	%(***GET PTR TO 1ST ELEMENT ON THE IOLIST TO BE PROCESSED***)%
	IOLELEM_.CSTMNT[IOLIST];

	%(***SAVE PTR TO CURRENT STATEMENT (IF THERE ARE DO-STMNTS IN THE IOLIST,
		WILL CLOBBER CSTMNT) *****)%
	SAVSTMNT_.CSTMNT;

	%(***WALK THUR THE IOLIST, PROCESSING ALL ELEMENTS***)%
	UNTIL .IOLELEM EQL 0
	DO
	BEGIN
		IF .IOLELEM[OPRCLS] EQL STATEMENT
		THEN
		BEGIN
			CSTMNT_.IOLELEM;
			CGSTMNT();

			%(***IF THE LAST ELEMENT IN AN IO-LIST FOR  A GIVEN STMNT IS
				NOT OF IOLSCLS (IE DOES NOT GENERATE AN ARG-LIST)
				THEN MUST GENERATE A "PUSHJ 17,FIN."
			********)%
			IF .IOLELEM[CLINK] EQL 0
			THEN
			BEGIN
				OPDSPIX_OPGFIN;
				CGOPGEN();
			END;
		END

		ELSE
		IF .IOLELEM[OPRCLS] EQL IOLSCLS
		THEN
		BEGIN
			%(***GENERATE CODE TO EVALUATE ALL EXPRESSIONS UNDER THIS ELEMENT***)%
			CASE .IOLELEM[OPERSP] OF SET

			%(***FOR A DATACALL NODE - EVAL THE EXPR UNDER THE NODE ***)%
			BEGIN
				TREEPTR_.IOLELEM[DCALLELEM];
				IF .TREEPTR[OPRCLS] NEQ DATAOPR
				THEN
				CGETVAL();
			END;

			%(***FOR AN SLISTCALL NODE - EVAL THE EXPR FOR THE NUMBER OF ELEMS***)%
			BEGIN
				TREEPTR_.IOLELEM[SCALLCT];
				IF .TREEPTR[OPRCLS] NEQ DATAOPR
				THEN
				CGETVAL();
			END;

			%(***FOR AN IOLSTCALL NODE - EVAL ALL EXPRS UNDER IT****)%
			CGIOCALL(.IOLELEM);

			%(***FOR AN E1LISTCALL NODE - OPTIMIZED CODE ONLY***)%
			BEGIN
				LOCAL BASE SAVCSTMNT;
				SAVCSTMNT_.CSTMNT;
				CSTMNT_.IOLELEM;
				CGCMNSUB();
				CSTMNT_.SAVCSTMNT;
				CGE1LIST(.IOLELEM)
			END;

			%(**FOR AN E2LISTCALL NODE - OPTIMIZED CODE ONLY***)%
			BEGIN
				LOCAL BASE SAVCSTMNT;
				SAVCSTMNT_.CSTMNT;
				CSTMNT_.IOLELEM;
				CGCMNSUB();
				CSTMNT_.SAVCSTMNT;
				CGE2LIST(.IOLELEM)
			END

			TES;


			%(***CREATE A LABEL TABLE ENTRY FOR THE LABEL ASSOCIATED WITH
				THE ARGBLOCK FOR THIS NODE***)%
			A1LABEL_GENLAB();
			IOLELEM[IOLSTLBL]_.A1LABEL;

			%(***GENERATE CALL TO IOLST.***)%
			OPDSPIX_OPGIOL;
			CGOPGEN();
		END
		ELSE CGERR();

		%(***GO ON TO NEXT ELEMENT***)%
		IOLELEM_.IOLELEM[CLINK];
	END;

	CSTMNT_.SAVSTMNT;
END;



GLOBAL ROUTINE CGE1LIST(IOLELEM)=
%(**********************************************************************
	ROUTINE TO GENERTE 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
END;






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




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;


MAP PEXPRNODE TREEPTR;





%(*********DEFINE MACRO TO OUTPUT A WD OF 0 IN AN ARG-BLOCK***)%
MACRO	ZIPOUT=
BEGIN
	EXTERNAL PBOPWD,PSYMPTR,OBUFFA;
	PBOPWD_0;
	PSYMPTR_PBF2NOSYM;
	OBUFFA()
END$;




GLOBAL ROUTINE CGIOLARGS=
%(***************************************************************************
	ROUTINE TO GENERATE THE ARG BLOCKS FOR AN IOLIST.
	CALLED WITH THE GLOBAL TREEPTR POINTING TO THE IOLIST.
***************************************************************************)%
BEGIN
	MAP OBJECTCODE PBOPWD;
	MAP PEXPRNODE PSYMPTR;
	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
			%(***OUTPUT A WORD OF 0 IN FRONT OF THE ARG-LIST
				SO THAT THE TRACE ROUTINE WONT PICK UP GARBAGE AS
				AN ARG-COUNT***)%
			ZIPOUT;
			%(***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;



GLOBAL ROUTINE CGDCALL=
%(***************************************************************************
	ROUTINE TO GENERATE 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.
***************************************************************************)%
BEGIN
	MAP OBJECTCODE PBOPWD;
	MAP PEXPRNODE PSYMPTR;
	OWN PEXPRNODE ARGNODE;
	EXTERNAL EVALU;

	%(***GET PTR TO THE EXPRESSION-NODE WHOSE VAL IS TO BE AN ARG***)%
	ARGNODE_.TREEPTR[DCALLELEM];


	%(***INIT OUTPUT WD TO 0****)%
	PBOPWD_0;

	%(***SET ID FIELD OF OUTPUT WD TO INDICATE DATA***)%
	PBOPWD[OTSIDN]_OTSDATA;

	%(***SET TYPE FIELD OF ARG BLOCK TO THE EXTERNAL-TYPE CODE CORRESPONDING
		TO THE VALTYPE INDICATED IN ARGNODE***)%
	PBOPWD[OTSTYPE]_.EVALU[.ARGNODE[VALTYPE]];

	%(***IF THE EXPRESSION IS A SCALER VARIABLE***)%
	IF .ARGNODE[OPRCLS] EQL DATAOPR
	THEN
	BEGIN
		PBOPWD[OTSADDR]_.ARGNODE[IDADDR];
		IF .ARGNODE[OPERSP] EQL FORMLARRAY THEN
			PBOPWD[OTSIND]_1;	!SET INDIRECT OVER FORMAL ARRAY
		PSYMPTR_.ARGNODE;		!PTR TO SYMBOL TABLE ENTRY
	END

	ELSE
	%(***IF THE EXPRESSION IS AN ARRAYREF****)%
	IF .ARGNODE[OPRCLS] EQL ARRAYREF
	THEN
	BEGIN
		PBOPWD[OTSMEMRF]_.ARGNODE[TARGTMEM];
		PSYMPTR_.ARGNODE[ARG1PTR];

		%(***FOR A FORMAL ARRAY, WILL NOT WANT TO RELOCATE THE ADDRESS
			FIELD OF THE ARGUMENT - SINCE WILL HAVE COMPUTED THE ARRAY BASE
			ADDRESS INTO THE SUBSCRIPT***)%
		IF .PSYMPTR[FORMLFLG] THEN PSYMPTR_PBF2NOSYM;
	END

	ELSE
	%(***IF THE VAL OF THE EXPRESSION IS IN A REG***)%
	IF .ARGNODE[INREGFLG]
	THEN
	BEGIN
		PBOPWD[OTSADDR]_.ARGNODE[TARGADDR];
		PSYMPTR_PBF2NOSYM;
	END

	ELSE
	%(***IF THE VAL OF THE EXPRESSION IS IN A TEMP***)%
	BEGIN
		PSYMPTR_.ARGNODE[TARGADDR];
		PBOPWD[OTSADDR]_.PSYMPTR[IDADDR];
		PBOPWD[OTSIND]_.ARGNODE[TARGIF];
	END;

	OBUFFA();
END;





GLOBAL ROUTINE CGSLIST=
%(***************************************************************************
	ROUTINE TO GENERATE AN ARGUMENT BLOCK FOR AN SLIST CALL
	IN AN IOLIST.
	CALLED WITH THE GLOBAL POINTING TO THE SLISTCALL NODE.
	THIS ROUTINE IS USED ONLY FOR THE SLISTS GENERATED BY
	PHASE 1 FOR STMNTS OF THE FORM:
		READ 11,A
	WHERE A IS AN ARRAY. 
	IN A LATER RELEASE, PHASE 2 SKELETON WILL RECOGNIZE 
	IOLISTS THAT CAN BE TRANSFORMED INTO SLISTS AND WILL FORM
	"S1LISTCALL" NODES FOR THESE SLISTS (WHICH MAY HAVE MORE THAN ONE ARRAY
	AND INCREMENTS OTHER THAN 1).
***************************************************************************)%
BEGIN
	MAP OBJECTCODE PBOPWD;
	MAP PEXPRNODE PSYMPTR;
	EXTERNAL EVALU;

	%(******OUTPUT FIRST WD OF ARGBLOCK (WD CONTAINING CODE FOR SLSIST AND COUNT)*****)%

	%(***INIT OUTPUT WD TO 0***)%
	PBOPWD_0;

	%(***SET IDN FIELD TO CODE FOR SLSIST**)%
	PBOPWD[OTSIDN]_OTSSLIST;

	%(***BUILD THE WD THAT CONTAINS THE CT***)%
	BLDIOIMWD(.TREEPTR[SCALLCT]);

	OBUFFA();

	%(****OUTPUT THE 2ND WD  OF ARGBLOCK (WHICH CONTAINS THE INCREMENT 1)***)%
	PBOPWD_1;
	PSYMPTR_PBF2NOSYM;
	OBUFFA();

	%(***OUTPUT THE 3RD WD (WHICH CONTAINS A PTR TO THE ARRAY TO BE USED)*******)%

	%(***GET PTR TO SYMBOL TABLE ENTRY FOR THE ARRAY***)%
	PSYMPTR_.TREEPTR[SCALLELEM];

	%(***ADDRESS FOR ARGBLOCK IS ADDRESS INDICATED BY THE SYMBOL TABLE ENTRY***)%
	PBOPWD[OTSADDR]_.PSYMPTR[IDADDR];
	PBOPWD[OTSTYPE]_.EVALU[.PSYMPTR[VALTYPE]];

	%(***SET INDIRECT BIT FOR A FORMAL ARRAY***)%
	IF .PSYMPTR[FORMLFLG]
	THEN
	PBOPWD[OTSIND]_1;

	OBUFFA();


END;



GLOBAL ROUTINE CAE1LIST=
%(**********************************************************************
	ROUTINE TO GENERATE CODE FOR AN ARGBLK FOR AN E1LISTCALL NODE
	CALLED WITH GLOBAL POINTING TO E1LISTCALL NODE
**********************************************************************)%
BEGIN
	LOCAL PEXPRNODE IOARRAY;
	MAP OBJECTCODE PBOPWD;
	MAP PEXPRNODE PSYMPTR;

	%(***OUTPUT FIRST WORD - CONTAINS "SLIST" AND COUNT***)%

	PBOPWD_0;			!INITIALIZE WORD TO 0
	PBOPWD[OTSIDN]_OTSSLIST;	!SET ID FIELD TO SLIST
	BLDIOIMWD(.TREEPTR[ECNTPTR]);	!FILL IN THE COUNT
	OBUFFA();			!OUTPUT THE WORD

	%(***OUTPUT SECOND WORD - CONTAINS INCREMENT***)%
	IOARRAY_.TREEPTR[E1INCR];
	IF
	BEGIN
		IF .IOARRAY[OPR1] NEQ CONSTFL THEN 0 ELSE
		IF .IOARRAY[CONST1] EQL 0 AND .IOARRAY[CONST2] EQL 0
		THEN 1 ELSE 0
	END
	THEN
	BEGIN
		PSYMPTR_.IOARRAY;	!MARK SYMBOL
		PBOPWD<LEFT>_#100;	!SET INTEGER
		PBOPWD<RIGHT>_.IOARRAY[IDADDR]
	END
	ELSE
	BEGIN
		PBOPWD_0;
		BLDIOIMWD(.TREEPTR[E1INCR])	!FILL IN THE INCREMENT
	END;
	OBUFFA();			!OUTPUT THE WORD

	%(***OUTPUT ONE WORD FOR EACH ARRAYREF UNDER ELSTPTR***)%

	IOARRAY_.TREEPTR[ELSTPTR];
	WHILE .IOARRAY NEQ 0 DO
	BEGIN
		PBOPWD_0;			!CLEAR TARGET
		IOPTR(.IOARRAY[E2ARREFPTR]);	!GENERATE ARGUMENT
		IOARRAY_.IOARRAY[CLINK]
	END

END;





GLOBAL ROUTINE CAE2LIST=
%(**********************************************************************
	ROUTINE TO GENERATE CODE FOR AN ARGBLK FOR AN E2LISTCALL NODE
	CALLED WITH GLOBAL POINTING TO E2LISTCALL NODE
**********************************************************************)%
BEGIN
	LOCAL PEXPRNODE IOARRAY;
	MAP OBJECTCODE PBOPWD;
	MAP PEXPRNODE PSYMPTR;

	%(***OUTPUT FIRST WORD - CONTAINS "ELIST" AND COUNT***)%

	PBOPWD_0;			!INITIALIZE WORD TO 0
	PBOPWD[OTSIDN]_OTSELIST;	!SET ID FIELD TO ELIST
	BLDIOIMWD(.TREEPTR[ECNTPTR]);	!FILL IN THE COUNT
	OBUFFA();			!OUTPUT THE WORD

	%(***OUTPUT TWO WORD FOR EACH ARRAYREF UNDER ELSTPTR***)%

	IOARRAY_.TREEPTR[ELSTPTR];
	WHILE .IOARRAY NEQ 0 DO
	BEGIN
		LOCAL PEXPRNODE E2ARG;

		%(***OUTPUT INCREMENT***)%

		E2ARG_.IOARRAY[E2INCR];
		IF
		BEGIN
			IF .E2ARG[OPR1] NEQ CONSTFL THEN 0 ELSE
			IF .E2ARG[CONST1] EQL 0 AND .E2ARG[CONST2] EQL 0
			THEN 1 ELSE 0
		END
		THEN
		BEGIN
			PSYMPTR_.E2ARG;
			PBOPWD<LEFT>_#100;
			PBOPWD<RIGHT>_.E2ARG[IDADDR]
		END
		ELSE
		BEGIN
			PBOPWD_0;
			BLDIOIMWD(.IOARRAY[E2INCR])	!FILL IN INCREMENT
		END;
		OBUFFA();			!OUTPUT INCREMENT

		%(***OUTPUT ARRAY ADDRESS***)%

		PBOPWD_0;			!CLEAR TARGET
		IOPTR(.IOARRAY[E2ARREFPTR]);	!GENERATE ARGUMENT
		IOARRAY_.IOARRAY[CLINK]
	END

END;






GLOBAL ROUTINE BLDIOIMWD(ARGNODE)=
%(***************************************************************************
	ROUTINE TO BUILD A WD OF AN ARGUMENT BLOCK FOR FOROTS WHEN
	THAT WORD IS TO HAVE EITHER THE FORM:
		1. INDIRECT BIT=0, IMMEDIATE CONSTANT IN RIGHT HALF
	  OR	2. INDIRECT BIT=1, PTR TO VAL IN RIGHT HALF
	CALLED WITH THE ARG:
		ARGNODE - PTR TO THE EXPRESSION NODE FOR THE VAL TO
				BE REPRESENTED
	CALLED WITH PBOPWD INITIALIZED SUCH THAT THE FIRST 9 BITS HAVE
	THE VALUE DESIRED,AND THE RIGHT 27 BITS ARE 0.
***************************************************************************)%
BEGIN
	EXTERNAL EVALU;
	MAP OBJECTCODE PBOPWD;
	MAP PEXPRNODE PSYMPTR;
	MAP PEXPRNODE ARGNODE;

	%(***SET TYPE TO INDICATE IMMEDIATE ARG IN MEMORY***)%

	PBOPWD[OTSTYPE]_.EVALU[.ARGNODE[VALTYPE]];

	%(***IF THE ARG IS A CONSTANT, USE THE IMMEDIATE FORM***)%
	IF .ARGNODE[OPR1] EQL CONSTFL
	THEN
	BEGIN
		PBOPWD[OTSTYPE]_IMMEDTYPE;
		PBOPWD[OTSADDR]_.ARGNODE[CONST2];
		PSYMPTR_PBF2NOSYM;		!FLAG TO OUTMOD THAT NO SYMBOLIC
						! REPRESENTATION CAN BE USED
	END

	ELSE
	%(***IF ARG IS A VARIABLE, USE INDIRECT THRU ITS ADDR***)%
	IF .ARGNODE[OPRCLS] EQL DATAOPR
	THEN
	BEGIN
		IF .ARGNODE[OPERSP] EQL FORMLARRAY THEN PBOPWD[OTSIND]_1;
		PBOPWD[OTSADDR]_.ARGNODE[IDADDR];
		PSYMPTR_.ARGNODE;		!PTR TO SYMBOL TABLE ENTRY
	END

	ELSE
	%(***IF ARG IS AN EXPRESSION,  USE THE TEMP IN WHICH THE VAL WAS STORED***)%
	BEGIN
		%(***IF VAL WAS LEFT IN AREG***)%
		IF .ARGNODE[INREGFLG]
		THEN
		BEGIN
			PBOPWD[OTSADDR]_.ARGNODE[TARGADDR];
			PSYMPTR_PBF2NOSYM;
		END

		ELSE
		%(***IF VAL WAS LEFT IN A TEMP***)%
		BEGIN
			%(***GET PTR TO TEMPORARY TABLE ENTRY***)%
			PSYMPTR_.ARGNODE[TARGADDR];
			PBOPWD[OTSADDR]_.PSYMPTR[IDADDR];
		END;
	END;

END;




GLOBAL ROUTINE CGSTPAUARGS=
%(***************************************************************************
	ROUTINE TO GENERATE THE ARG BLOCK FOR A STOP/PAUSE STMNT.
	THIS BLOCK WILL HAVE THE FORM:
		-------------------------------
		!   ARGCT	!    0		!
		---------------------------------
	LABEL:	!     !TYPE !	!  ARGPTR	!
		----------------------------------
	WHERE "LABEL" IS THE ARG-BLOCK LABEL, ARGCT IS NEG ARGCT 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 PTS TO THE ARG

	THIS ROUTINE IS CALLED WITH THE GLOBAL "CSTMNT" POINTING TO THE STOP OR
	PAUSE STMNT FOR WHICH AN ARG-BLOCK IS TO BE GENERATED.
***************************************************************************)%
BEGIN
	EXTERNAL EVALU;			!TABLE OF EXTERNAL VALUE-TYPE CODES
	MAP OBJECTCODE PBOPWD;		!GLOBAL IN WHICH THE WD TO
					! BE OUTPUT IS PASSED TO THE ROUTINE "OBUFFA"

	MAP PEXPRNODE PSYMPTR;		!WILL PT TO THE SYMBOL TABLE ENTRY (OR
					! CONSTANT TABLE ENTRY) FOR THE ARG OF THE STOP/PAUSE


	%(***IF THE STOP/PAUSE HAD NO ARG, WILL HAVE USED "ZERBLK" FOR THE
		ARG-BLOCK. SO DONT HAVE TO GENERATE ANYTHING.***)%
	IF .CSTMNT[PAUSIDENT] EQL 0
	THEN RETURN;


	%(***IF THIS STMNT WAS ELIMINATED (BY FOLDING A LOG IF), DO NOT WANT TO
		GENERATE AN ARG LIST***)%
	IF .CSTMNT[PAUSLBL] EQL 0 THEN RETURN;


	%(***OUTPUT THE ARG-CT WD*****)%
	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
	PBOPWD[OTSTYPE]_.EVALU[.PSYMPTR[VALTYPE]];	!SET TYPE FIELD OF WD TO BE OUTPUT
	PBOPWD[OTSADDR]_.PSYMPTR[IDADDR];		!ADDRESS OF VAR/CONSTANT/LITERAL
							! TO BE OUTPUT
	OBUFFA();

	RETURN
END;

!AUTHOR: NORMA ABEL


!THIS FILE CONTAINS THE ROUTINES NECESSARY TO GENERATE CODE
!FOR THE I/O STATEMENTS THEMSELVES. WHERE APPROPRIATE THE ROUTINE
!CGIOLST IS CALLED TO GENERATE THE CALLS TO IOLST.

GLOBAL ROUTINE CGMTOP=
BEGIN
	!CALLS TO MTOP FOR ALL STATEMENTS BACKID THRU ENDFID

	EXTERNAL CSTMNT,GENLAB,A1LABEL,CGOPGEN,OPDSPIX;
	MAP BASE CSTMNT;

	EXTERNAL OPGMTO;

	CGUNIT();	!GENERATE CODE TO EVAL THE UNIT NUMBER (IF AN EXPRESSION)
	!FILL IN IOARGLBL FIELD
	A1LABEL_CSTMNT[IOARGLBL]_GENLAB();
	OPDSPIX_OPGMTO;
	CGOPGEN();
END;

GLOBAL ROUTINE CGENCO=
BEGIN
	!CODE GENERATION FOR ENCODE

	EXTERNAL CSTMNT,GENLAB,A1LABEL,CGOPGEN,OPDSPIX;
	MAP BASE CSTMNT;

	EXTERNAL CGIOLST,OPGENC;
	EXTERNAL TREEPTR,CGETVAL;

	%(***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();
	CGIOLST();
END;

GLOBAL ROUTINE CGDECO=
BEGIN
	!CODE GENERATION FOR DECODE
	EXTERNAL CSTMNT,GENLAB,A1LABEL,CGOPGEN,OPDSPIX;
	MAP BASE CSTMNT;
	EXTERNAL OPGDEC,CGIOLST;

	%(***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();
	CGIOLST();
END;

GLOBAL ROUTINE CGRERE=
BEGIN
	!CODE GENERATION FOR REREAD

	EXTERNAL CSTMNT,GENLAB,A1LABEL,CGOPGEN,OPDSPIX;
	EXTERNAL OPGFIN;
	MAP BASE CSTMNT;
	EXTERNAL CGIOLST,OPGIN;
	CGUNIT();	!GENERATE CODE TO EVAL THE UNIT NUMBER (IF AN EXPRESSION)
	!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();
END;

GLOBAL ROUTINE CGUNIT=
%(***************************************************************************
	GENERATE CODE TO EVALUATE THE UNIT NUMBER  IN AN IO STMNT
	CALLED WITH CSTMNT POINTING TO AN IO STMNT
***************************************************************************)%
BEGIN
	TREEPTR_.CSTMNT[IOUNIT];	!PTR TO EXPRESSION NODE FOR UNIT
	IF .TREEPTR[OPRCLS] NEQ DATAOPR THEN CGETVAL()
END;



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
	EXTERNAL CSTMNT;
	MAP PEXPRNODE CSTMNT;
	OWN PEXPRNODE RECNUM;

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

GLOBAL ROUTINE CGREAD=
BEGIN
	!CODE GENERATION FOR ALL TYPES OF READ
	EXTERNAL CSTMNT,GENLAB,A1LABEL,CGOPGEN,OPDSPIX;
	MAP BASE CSTMNT;
	EXTERNAL CGIOLST,OPGNLI,OPGIN,OPGRTB,OPGFIN;
	LOCAL BASE T1;

	CGUNIT();	!GENERATE CODE TO EVAL THE UNIT NUMBER (IF AN EXPRESSION)

	%(***IF THERE AN EXPRESSION TO BE EVALUATED FOR THE RECORD NUMBER (UGH!!!)
		GENERATE CODE TO EVALUATE IT***)%
	CGRECNUM();

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

!**[564]  CGREAD @4846  SJW  29-APR-77
![564] MAKE CGREAD AND CGWRIT SYMMETRICAL: DON'T MAKE A NAMELIST
![564]   CHECK WITHOUT CHECKING FOR IONAME PTR = 0
%[564]%	T1 _ .CSTMNT [IOFORM];			! IOFORM == IONAME
%[564]%	IF .CSTMNT [IOLIST] EQL 0		! NO IOLIST (BEWARE NAMELIST)
%[564]%	  THEN
%[564]%	    IF .T1 EQL 0			! NO FORMAT
%[564]%	      THEN BEGIN
%[564]%		OPDSPIX _ OPGRTB;		! UNFORMATTED READ
%[564]%		CGOPGEN ();
%[564]%		OPDSPIX _ OPGFIN;		! FIN CALL SINCE NO IOLIST
%[564]%		CGOPGEN ();
%[564]%	      END
%[564]%	    ELSE
%[564]%	    IF .T1 [OPRCLS] NEQ STATEMENT  AND	! CHECK FOR NAMELIST
%[564]%	       .T1 [IDATTRIBUT (NAMNAM)]
%[564]%	      THEN BEGIN
%[564]%		OPDSPIX _ OPGNLI;		! NAMELIST READ
%[564]%		CGOPGEN ();
%[564]%	      END
%[564]%	      ELSE BEGIN
%[564]%		OPDSPIX _ OPGIN;		! FORMATTED READ
%[564]%		CGOPGEN ();
%[564]%		OPDSPIX _ OPGFIN;		! FIN CALL SINCE NO IOLIST
%[564]%		CGOPGEN ();
%[564]%	      END
%[564]%	  ELSE BEGIN				! THERE IS AN IOLIST
%[564]%	    IF .T1 EQL 0			! CHECK FOR FORMAT
%[564]%	      THEN OPDSPIX _ OPGRTB		! UNFORMATTED READ
%[564]%	      ELSE OPDSPIX _ OPGIN;		! FORMATTED READ
%[564]%	    CGOPGEN ();
%[564]%	    CGIOLST ();				! PROCESS IOLIST
%[564]%	  END;

END;


GLOBAL ROUTINE CGWRIT=
BEGIN
	!CODE GENERATION FOR WRITE STATEMENTS OF ALL FORMS

	EXTERNAL CGOPGEN,OPDSPIX,A1LABEL,OPGOUT,OPGNLO,OPGWTB,GENLAB,
		CGIOLST,CSTMNT,OPGFIN;

	MAP BASE CSTMNT;

	LOCAL BASE T1;

	CGUNIT();	!GENERATE CODE TO EVAL THE UNIT NUMBER (IF AN EXPRESSION)

	%(***IF THERE AN EXPRESSION TO BE EVALUATED FOR THE RECORD NUMBER (UGH!!!)
		GENERATE CODE TO EVALUATE IT***)%
	CGRECNUM();
	!**;[376], CGWRIT @4892, DCE, 28-APR-76
	!**;[376], REORDER THINGS SO THAT THE CALL TO CGREGNUM DOES
	!**;[376], NOT OVERWRITE A1LABEL CAUSING BAD CODE
		!FILL IN IOARGLBL FIELD[376]

		A1LABEL_CSTMNT[IOARGLBL]_GENLAB(); ![376]

!**[564]  CGWRIT @4907  SJW  29-APR-77
![564] MAKE CGREAD AND CGWRIT SYMMETRICAL: GENERATE A FIN CALL
![564]   AFTER AN UNFORMATTED WRITE; REPLACE EDIT [367]
%[564]%	T1 _ .CSTMNT [IOFORM];			! IOFORM == IONAME
%[564]%	IF .CSTMNT [IOLIST] EQL 0		! NO IOLIST (BEWARE NAMELIST)
%[564]%	  THEN
%[564]%	    IF .T1 EQL 0			! NO FORMAT
%[564]%	      THEN BEGIN
%[564]%		OPDSPIX _ OPGWTB;		! UNFORMATTED WRITE
%[564]%		CGOPGEN ();
%[564]%		OPDSPIX _ OPGFIN;		! FIN CALL SINCE NO IOLIST
%[564]%		CGOPGEN ();
%[564]%	      END
%[564]%	    ELSE
%[564]%	    IF .T1 [OPRCLS] NEQ STATEMENT  AND	! CHECK FOR NAMELIST
%[564]%	       .T1 [IDATTRIBUT (NAMNAM)]
%[564]%	      THEN BEGIN
%[564]%		OPDSPIX _ OPGNLO;		! NAMELIST WRITE
%[564]%		CGOPGEN ();
%[564]%	      END
%[564]%	      ELSE BEGIN
%[564]%		OPDSPIX _ OPGOUT;		! FORMATTED WRITE
%[564]%		CGOPGEN ();
%[564]%		OPDSPIX _ OPGFIN;		! FIN CALL SINCE NO IOLIST
%[564]%		CGOPGEN ();
%[564]%	      END
%[564]%	  ELSE BEGIN				! THERE IS AN IOLIST
%[564]%	    IF .T1 EQL 0			! CHECK FOR FORMAT
%[564]%	      THEN OPDSPIX _ OPGWTB		! UNFORMATTED WRITE
%[564]%	      ELSE OPDSPIX _ OPGOUT;		! FORMATTED WRITE
%[564]%	    CGOPGEN ();
%[564]%	    CGIOLST ();				! PROCESS IOLIST
%[564]%	  END;

END;


GLOBAL ROUTINE CGOPLST=
%(***************************************************************************
	ROUTINE TO GENERATE CODE TO EVALUATE ANY EXPRESSIONS THAT
	OCCUR AS VALS OF ARGS UNDER AN OPEN/CLOSE STMNT
***************************************************************************)%
BEGIN
	OWN OPENLIST ARVALLST;	!LIST OF ARGS AND THEIR VALS UNDER THIS STMNT

	CGUNIT();	!GENERATE CODE FOR UNIT NUMBER THAT IS AN EXPRESSION


	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;	!END OF ROUTINE "CGOPLST"

GLOBAL ROUTINE CGOPEN=
BEGIN
	!CODE GENERATION FOR THE CALL TO OPEN.

	EXTERNAL CGOPGEN,OPDSPIX,A1LABEL,GENLAB,OPGOPE;
	EXTERNAL CSTMNT;  MAP BASE CSTMNT;


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

	!FILL IN IOARGLBL FIELD

	A1LABEL_CSTMNT[IOARGLBL]_GENLAB();

	OPDSPIX_OPGOPE;
	CGOPGEN();
END;

!GLOBAL ROUTINE CGRELS=
!BEGIN
!	!CODE GENERATION FOR RELAEASE STATEMENT
!
!	EXTERNAL CSTMNT,CGOPGEN,OPDSPIX,A1LABEL,OPGREL,GENLAB;
!	MAP BASE CSTMNT;
!	!FILL IN IOARGLBL FIELD
!
!	A1LABEL_CSTMNT[IOARGLBL]_GENLAB();
!	OPDSPIX_OPGREL;
!	CGOPGEN();
!END;
!
GLOBAL ROUTINE CGFIND=
BEGIN
	!CODE GENERATION FOR FIND

	EXTERNAL CGOPGEN,CSTMNT,A1LABEL,GENLAB,OPDSPIX,OPGFND;

	MAP BASE CSTMNT;

	CGUNIT();	!GENERATE CODE FOR UNIT NUMBER

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

	%(***IF THERE AN EXPRESSION TO BE EVALUATED FOR THE RECORD NUMBER (UGH!!!)
		GENERATE CODE TO EVALUATE IT***)%
	CGRECNUM();

	OPDSPIX_OPGFND;
	CGOPGEN();
END;

GLOBAL ROUTINE CGCLOS=
BEGIN
	!CODE GENERATION FOR CLOSE STATEMENT

	EXTERNAL CSTMNT,GENLAB,A1LABEL,OPDSPIX,CGOPGEN,OPGCLO;

	MAP BASE CSTMNT;


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

	!FILL IN IOARGLBL FIELD

	A1LABEL_CSTMNT[IOARGLBL]_GENLAB();

	OPDSPIX_OPGCLO;
	CGOPGEN();
END;

MACRO
	IOWHOLE=0,7,0,36$,
	OPENFFIELD=0,33,3$,
	OPENGFIELD=0,27,5$,
	OPENCODE=0,0,18,18$,
	OPENARG=0,0,0,18$,
	UTILLOW=BACKID$,
	UTILHI=ENDFID$;
GLOBAL ROUTINE	CGDECARGS=
%(***************************************************************************
	TO GENERATE THE ARG BLOCK FOR AN ENCODE OR DECODE STATEMENT
	ARG BLOCK HAS THE FORM:
		--------------------------------------------------
		!	-6		!			!
		--------------------------------------------------
		!	!TYPE	!I! X	! CHAR CT (IMMED)	!
		--------------------------------------------------
		!	!TYPE	!I! X	!  END=			!
		--------------------------------------------------
		!	!TYPE	!I! X	!  ERR=			!
		--------------------------------------------------
		!	!TYPE	!I! X	!  FORMAT ADDR		!
		--------------------------------------------------
		!	!TYPE	!I! X	!  FORMAT SIZE(IMMED)	!
		--------------------------------------------------
		!	!TYPE	!I! X	!   VAR ARRAY ADDR	!
		--------------------------------------------------
	WHERE THE ARGLIST PTR POINTS TO THE WORD CONTAINING THE CHAR CT (IE
	THE -6 IS IN THE WD PRECEEDING THE ARG PTR)
***************************************************************************)%
BEGIN
	EXTERNAL IOIMMED,IOPTR;
	EXTERNAL PBOPWD,CSTMNT,PSYMPTR,OBUFF;
	EXTERNAL IOENDERR,IOFORMAT,EVALU;
	MAP PEXPRNODE CSTMNT;		!ENCODE OR DECODE STMNT FOR WHICH ARG BLOCK
					! IS TO BE GENERATED
	MAP OBJECTCODE PBOPWD;

	OWN PEXPRNODE ENCARRAY;		!ARRAY TO BE INPUT OR OUTPUT
	OWN PEXPRNODE CHARCT;		!NUMBER OF CHARS TO BE PROCESSED

	ENCARRAY_.CSTMNT[IOVAR];
	CHARCT_.CSTMNT[IOCNT];

	%(***OUTPUT WD CONTAINING THE CT OF WDS IN THE ARGLIST***)%
	PBOPWD_(-6)^18;		!CT IN LEFT HALF WD
	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 WD OF THE ARG BLOCK***)%
	IOIMMED(.CHARCT);

	IOENDERR();		!OUTPUT THE END/ERROR WORDS OF THE ARG BLOCK

	IOFORMAT();		!OUTPUT THE FORMAT WDS OF THE ARG BLOCK

	%(***OUTPUT A PTR TO THE ARRAY***)%
	IOPTR(.ENCARRAY);
END;



ROUTINE	IO1ARG(NUMB)=
%(*********************
	ROUTINE TO OUTPUT 2 WDS OF THE FORM:
		--------------------------------------------------
		!	-CT		!			!
		-------------------------------------------------
	 LAB:	!	! TYPE	!I! X	!	UNIT		!
		---------------------------------------------------
	WHERE "UNIT" IS IMMEDIATE
***********************)%
BEGIN
	EXTERNAL IOIMMED;
	EXTERNAL	PBOPWD,PSYMPTR,OBUFF,CSTMNT;
	MAP	BASE	CSTMNT;
	MAP OBJECTCODE	PBOPWD;

	%(***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]);


	IOIMMED(.CSTMNT[IOUNIT]);	!GENERATE AN "IMMEDIATE" MODE
				! ARG FOR THE UNIT NUMBER
	PBOPWD_0;
END;
GLOBAL ROUTINE IOENDERR=
%(***********************
	OUTPUT THE END= AND ERR-= WORDS OF AN IO ARG BLOCK.
	THESE 2 WDS HAVE THE FORM:
		---------------------------------------------------------
		!	! TYPE	!I! X	!	IOEND			!
		---------------------------------------------------------
		!	! TYPE	!I! X	!	IOERR			!
		---------------------------------------------------------
**************************)%
BEGIN
	EXTERNAL PBOPWD,OBUFFA,PSYMPTR,CSTMNT;
	MAP BASE CSTMNT;
	MAP OBJECTCODE PBOPWD;
	%(***OUTPUT THE "END" WD***)%
	PBOPWD_0;
	IF .CSTMNT[IOEND] EQL 0
	THEN PSYMPTR_PBF2NOSYM
	ELSE
	BEGIN
		PBOPWD[OTSTYPE]_ADDRTYPE;	!TYPE IS "ADDRESS"
		PBOPWD[OTSADDR]_.CSTMNT[IOEND];
		PSYMPTR_PBFLABREF;
	END;
	OBUFFA();

	%(***OUTPUT THE "ERROR" WD***)%
	PBOPWD_0;
	IF .CSTMNT[IOERR] EQL 0
	THEN PSYMPTR_PBF2NOSYM
	ELSE
	BEGIN
		PBOPWD[OTSTYPE]_ADDRTYPE;	!TYPE IS "ADDRESS"
		PBOPWD[OTSADDR]_.CSTMNT[IOERR];
		PSYMPTR_PBFLABREF;
	END;
	OBUFFA();

	PBOPWD_0;
END;


GLOBAL ROUTINE IOFORMAT=
%(********************
	ROUTINE TO OUTPUT THE 2 FORMAT WDS OF AN IO ARG-BLOCK
	THESE WDS HAVE THE FORM:
		----------------------------------------------------------
		!	! TYPE	!I! X	!	FORMAT ADDR		!
		----------------------------------------------------------
		!	! TYPE	!I! X!	!	FORMAT SIZE		!
		----------------------------------------------------------
************************)%
BEGIN
	EXTERNAL CSTMNT,PBOPWD,OBUFFA,PSYMPTR;
	EXTERNAL ISN,FATLERR,E91;
	EXTERNAL EVALU;
	MAP BASE CSTMNT;
	MAP OBJECTCODE PBOPWD;
	MAP PEXPRNODE PSYMPTR;
	OWN BASE T:FORMATP;
	FORMATP_.CSTMNT[IOFORM];
	!IOSTATEMENT CONTAINS POINTER TO LABEL TABLES
	!OR VARIABLE

	PBOPWD_0;

	IF .FORMATP[OPRCLS] EQL LABOP
	 THEN
	%(***IF FORMAT IS A STMNT- HAVE A PTR TO THE LABEL TABLE ENTRY FOR ITS LABEL***)%
	BEGIN
		FORMATP_.FORMATP[SNHDR];

		%(***IF THE STMNT REFERENCED IS NOT A FORMAT STMNT, GIVE AN ERROR MESSAGE.***)%
		IF .FORMATP[SRCID] NEQ FORMID
		THEN
		BEGIN
			FATLERR(.FORMATP[SRCISN],E91<0,0>);

			%(***PUT OUT 2 WDS OF 0 FOR THE FORMAT WDS***)%
			ZIPOUT;
			ZIPOUT;

			RETURN;
		END;


		%(***OUTPUT THE FORMAT ADDRESS WD***)%
		PBOPWD[OTSADDR]_.FORMATP;
		PBOPWD[OTSTYPE]_ADDRTYPE;		!TYPE FIELD EQL TO "ADDRESS"
							! INDICATES THAT FORMAT IS NOT 
							! AN ARRAY
		PSYMPTR_PBFFORMAT;
		OBUFFA();

		%(***OUTPUT THE FORMAT SIZE WD***)%
		PBOPWD_.FORMATP[FORSIZ];
		PBOPWD[OTSTYPE]_IMMEDTYPE;	!SIZE IS REFERENCED IMMED
		PSYMPTR_PBF2NOSYM;
		OBUFFA();
	END
	ELSE
	%(***IF FORMAT IS AN ARRAY, HAVE A PTR TO THE SYMBOL TABLE ENTRY FOR THE ARRAY NAME***)%
	BEGIN
		%(***OUTPUT THE FORMAT ADDRESS WD - IF THE ARRAY IS A FORMAL SHOULD
			SET THE INDIRECT BIT***)%
		PBOPWD[OTSADDR]_.FORMATP[IDADDR];	!ADDRESS OF THE ARRAY
		IF .FORMATP[FORMLFLG] THEN PBOPWD[OTSIND]_1;
		PBOPWD[OTSTYPE]_.EVALU[.FORMATP[VALTYPE]];	!TYPE OF THE ARRAY
		PSYMPTR_.FORMATP;			!PTR TO THE SYMBOL TABLE ENTRY
							! FOR THE ARRAY
		OBUFFA();

		%(***OUTPUT THE FORMAT SIZE WORD. IT WILL BE REFERENCED IMMED, HENCE IF
			THE ARRAY SIZE IS VARIABLE, SET THE INDIRECT BIT***)%
		PBOPWD_0;
		T_.FORMATP[IDDIM];		!GET PTR TO DIMENSION TABLE ENTRY

		IF .T[ADJDIMFLG]
		THEN
		%(***IF THE ARRAY IS ADJUSTABLY DIMENSIONED***)%
		BEGIN
			PSYMPTR_.T[ARASIZ];		!PTR TO THE SYM TAB ENTRY FOR THE
							! TMP THAT HOLDS THE ARRAY SIZE
			PBOPWD[OTSADDR]_.PSYMPTR[IDADDR];
			PBOPWD[OTSIND]_1;
		END
		ELSE
		BEGIN
			PBOPWD[OTSADDR]_.T[ARASIZ];	!THE CONSTANT FOR ARRAY SIZE
			PSYMPTR_PBF2NOSYM;
		END;
		PBOPWD[OTSTYPE]_IMMEDTYPE;	!IMDICATING TO REFERENCE IMMED
		OBUFFA();
	END;
	PBOPWD_0;
END;
GLOBAL ROUTINE IOPTR(EXPR)=
BEGIN
	!OUTPUT A WORD OF THE FORM
	!
	!
	!-----------------------------------------------!
	!		!TYPE !I!  X  !  ADDRESS	!
	!-----------------------------------------------!
	!
	!
	EXTERNAL CSTMNT,PBOPWD,OBUFFA,PSYMPTR,EVALU;
	MAP PEXPRNODE PSYMPTR;
	MAP BASE CSTMNT:EXPR;
	MAP OBJECTCODE PBOPWD;

	%(***FILL IN TYPE-CODE FIELD OF WD TO BE OUTPUT***)%
	PBOPWD[OTSTYPE]_.EVALU[.EXPR[VALTYPE]];


	%(***FILL IN PTR TO THE VALUE TO BE OUTPUT. THIS PTR IS BUILT DIFFERENTLY
		DEPENDING ON THE OPERATOR-CLASS OF THE EXPRESSION NODE***)%
	SELECT .EXPR[OPRCLS] OF NSET
DATAOPR:  BEGIN
		PBOPWD[OTSADDR]_.EXPR[IDADDR];
		IF .EXPR[OPERSP] EQL FORMLARRAY THEN
		PBOPWD_.PBOPWD OR INDBIT;
		PSYMPTR_.EXPR;
	END;
ARRAYREF:  BEGIN
		OWN PEXPRNODE ARRSYMENTRY;	!SYMBOL TABLE ENTRY FOR THE ARRAY NAME
		PBOPWD[OTSMEMRF]_.EXPR[TARGTMEM];	!INDEX,ADDR AND INDIRECT FIELDS
		ARRSYMENTRY_.EXPR[ARG1PTR];
		PSYMPTR_(IF .ARRSYMENTRY[FORMLFLG]	!IF ARRAY IS A FORMAL THEN
			THEN PBF2NOSYM			! ADDR WILL NOT BE RELOCATED
			ELSE .ARRSYMENTRY);
	END;
OTHERWISE:  BEGIN
		%(***SET INDEX AND INDIRECT BITS OF THE OUTPUT WD FROM THE TARGET OF THE EXPR***)%
		PBOPWD_.PBOPWD+GETTXFI(EXPR);

		%(***IF THE TARGET-MEMREF IS USING AN AC AS A CORE LOCATION THEN
			THERE IS NO SYMBOLIC REPRESENTATION***)%
		IF .EXPR[INREGFLG]
		THEN
		BEGIN
			PBOPWD[OTSADDR]_.EXPR[TARGTAC];
			PSYMPTR_PBF2NOSYM
		END
		ELSE
		%(***IF THE VAL HAS BEEN STORED IN A TEMPORARY***)%
		BEGIN
			PSYMPTR_.EXPR[TARGADDR];
			PBOPWD[OTSADDR]_.PSYMPTR[IDADDR]
		END;
	END;

	TESN;

	OBUFFA();
	PBOPWD_0;
END;


GLOBAL ROUTINE IOIMMED(EXPR)=
%(***************************************************************************
	OUTPUT AN IMMED-MODE FOROTS ARG FOR THE VAL OF "EXPR".
	EXPR MAY BE ANY INTEGER EXPRESSION.
	IF EXPR IS NOT A CONSTANT, THE INDIRECT BIT IN THE ARG WILL BE SET.
***************************************************************************)%
BEGIN
	EXTERNAL EVALU;
	EXTERNAL PBOPWD,OBUFFA,PSYMPTR;
	MAP PEXPRNODE PSYMPTR;
	MAP OBJECTCODE PBOPWD;
	MAP PEXPRNODE EXPR;

	PBOPWD_0;

	%(***IF THE ARG IS NOT TYPE INTEGER OR IF THE ARG ALREADY MUST BE REFERENCED
		INDIRECT, THEN HAVE AN INTERNAL COMPILER BUG***)%
	IF .EXPR [VALTP1] NEQ INTEG1
	THEN CGERR();

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

	%(***SET TYPE CODE TO INDICATE THAT ARG IS IN MEMORY***)%

	PBOPWD[OTSTYPE]_.EVALU[.EXPR[VALTYPE]];


	%(***HOW THE PTR IS TO BE BUILT DEPENDS ON THE OPERATOR OF THE EXPRESSION***)%
	SELECT .EXPR[OPRCLS] OF NSET
DATAOPR:  BEGIN
		%(***IF THE EXPRESSION IS AN INTEGER CONSTANT, PUT THE CONSTANT
			DIRECTLY IN THE ARG LIST***)%
		IF .EXPR[OPR1] EQL CONSTFL
		THEN
		BEGIN
			PBOPWD[OTSTYPE]_IMMEDTYPE;	!INDICATE IMMEDIATE MODE CONSTANT
			PBOPWD[OTSADDR]_.EXPR[CONST2];
			PSYMPTR_PBF2NOSYM
		END

		%(***IF THE EXPRESSION IS A FORMAL ARRAY - SET INDIRECT BIT***)%

		ELSE
		IF .EXPR[OPERSP] EQL FORMLARRAY THEN
		BEGIN
			PBOPWD[OTSADDR]_.EXPR[IDADDR];
			PBOPWD[OTSIND]_1;
			PSYMPTR_.EXPR
		END

		%(***IF THE EXPRESSION IS AN VARIABLE - USE A PTR TO IT***)%

		ELSE
		BEGIN
			PBOPWD[OTSADDR]_.EXPR[IDADDR];
			PSYMPTR_.EXPR
		END;
	END;
ARRAYREF:  BEGIN
		OWN PEXPRNODE ARRSYMENTRY;	!SYMBOL TABLE ENTRY FOR THE ARRAY NAME
		PBOPWD[OTSMEMRF]_.EXPR[TARGTMEM];	!INDEX AND BASE ADDR FOR THE ARRAYREF

		ARRSYMENTRY_.EXPR[ARG1PTR];
		PSYMPTR_(IF .ARRSYMENTRY[FORMLFLG]	!IF ARRAY IS A FORMAL THEN
			THEN PBF2NOSYM			! ADDR WILL NOT BE RELOCATED
			ELSE .ARRSYMENTRY);
	END;
OTHERWISE:  BEGIN
		%(***SET INDEX FIELD FROM THE TARGET OF THE EXPR***)%
		PBOPWD_.PBOPWD+GETTXFI(EXPR);

		%(***IF THE TARGET MEMREF IS USING AN AC AS A CORE LOCATION THEN
			THERE IS NO SYMBOLIC REPRESENTATION***)%
		IF .EXPR[INREGFLG]
		THEN
		BEGIN
			PBOPWD[OTSADDR]_.EXPR[TARGTAC];
			PSYMPTR_PBF2NOSYM
		END
		ELSE
		%(***IF THE VAL HAS BEEN STORED IN A TEMP***)%
		BEGIN
			PSYMPTR_.EXPR[TARGADDR];
			PBOPWD[OTSADDR]_.PSYMPTR[IDADDR];
		END;
	END;

	TESN;

	OBUFFA();

	PBOPWD_0;
END;


ROUTINE CGOPARGS=
BEGIN
	!GENERATE AN OPEN TYPE ARGUMENT


	EXTERNAL EVALU;

	EXTERNAL OBUFF,PBOPWD,PSYMPTR,CSTMNT;
	MAP BASE PSYMPTR;
	MAP BASE CSTMNT;
	MAP OBJECTCODE PBOPWD;

	LOCAL OPENLIST ARVALLST;	!LIST OF ARGS UNDER THIS OPEN STMNT
	LOCAL PEXPRNODE ARGVAL;		!PTR TO SYMBOL TABLE 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];	!PTR TO EXPRESSION NODE FPR VAL OF THIS ARG

		IF .ARGVAL EQL 0	!FOR "DIALOG", WHICH CAN HAVE A NULL VAL
		THEN
		BEGIN
			PSYMPTR_PBFNOSYM;
			 PBOPWD[OTSADDR]_0
		END
		ELSE
		BEGIN
			PBOPWD[OTSTYPE]_.EVALU[.ARGVAL[VALTYPE]];

			SELECT .ARGVAL[OPRCLS] OF NSET	!HOW TO GET THE ADDR OF THE VAL OF EACH ARG DEPENDS
							! ON THE OPERATOR-CLASS OF THE EXPRESSION
		DATAOPR:
			!FOR A VAR/CONST, GET THE ADDRESS FROM ITS SYM TABLE ENTRY
			BEGIN
					PBOPWD[OTSADDR]_.ARGVAL[IDADDR];
%**;[306],CGSTMN,JNT,20-JUN-75%
%**;[306],IN CGOPARGS @ 5447 AFTER DATAOPR:%
					IF .ARGVAL[OPERSP] EQL FORMLARRAY	![306] IF IT'S AN ARRAY FORMAL
					THEN PBOPWD[OTSIND]_1;	![306] SET INDIRECT BIT
					PSYMPTR_.ARGVAL;
			END;
		ARRAYREF:
			!AN ARRAYREF WILL ONLY OCCUR IN THIS CONTEXT
			! IF THE ADDRESS IS ENTIRELY CONSTANT (IE NO INDEXING OR
			! INDIRECTION NEED BE USED) - OTHERWISE A "STORECLS"
			! NODE WILL HAVE BEEN INSERTED ABOVE THE ARRAYREF TO
			! STORE THE VAL IN A TEMPORARY
			BEGIN
				PSYMPTR_.ARGVAL[ARG1PTR];	!PTR TO SYM TABLE ENTRY FOR THE ARRAY NAME
				PBOPWD[OTSADDR]_.ARGVAL[TARGADDR];	!THE 18 BIT ADDRESS OF THIS ARRAY ELEM
			END;

		OTHERWISE:
			!WE KNOW THAT ALL EXPRESSIONS IN THIS CONTEXT WILL BE EVALUATED
			! INTO TEMPORARIES. GET THE ADDR OF THE TEMP FROM ITS SYMBOL TABLE ENTRY
			BEGIN
				PSYMPTR_.ARGVAL[TARGADDR];	!PTR TO SYM TABLE ENTRY FOR THE TEMP
				PBOPWD[OTSADDR]_.PSYMPTR[IDADDR];
!**;[532], CGOPARGS @5475, DCE, 14-JAN-77
!**;[532], SET INDIRECT BIT FOR ARRAY REF USED AS ASSOCIATE VARIABLE
%[532]%				IF .PBOPWD[OPENGFIELD] EQL OPNCASSOCIATE
%[532]%				THEN PBOPWD[OTSIND]_1;
			END;

			TESN;


		END;

		OBUFFA();
	END;
END;

FORWARD REDORWRIT;
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 LINK LIST OF I/O
		STATEMENTS AND CALLING THIS ROUTINE
		AND THEN CGIOLARGS TO GENERATE THE ARGUMENT
		BLOCK FOR THE I/O LIST

	******************************)%
	MACRO IOSRCIDBAS=READID$;

	!TO OUTPUT A WORD FOR ZEROS. THIS WORD DISTINGUISHES
	!BINARY WRITES FROM LIST DIRECTED WRITES (READS TOO)


	LOCAL T;
	EXTERNAL DEFLAB,MTOPFUN,CGERR,TREEPTR;
	EXTERNAL CSTMNT,PBOPWD,PSYMPTR,OBUFF;
	MAP BASE CSTMNT;
	MAP OBJECTCODE PBOPWD;

	!INITIALIZE PBOPWD
	PBOPWD_0;


	!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 THEN
	BEGIN
		IO1ARG(.CSTMNT[OPSIZ]+3);
		IOENDERR();
		CGOPARGS();
		RETURN	!DO NOT WANT TO LOOK AT THE IOLIST
	END ELSE
	IF .CSTMNT[SRCID] EQL CLOSID THEN
	BEGIN
		IO1ARG(.CSTMNT[OPSIZ]+3);
		IOENDERR();
		CGOPARGS();
		RETURN		!DO NOT WANT TO LOOK AT THE IOLIST
	END ELSE
	IF .CSTMNT[SRCID] EQL RELSID THEN
		IO1ARG(1)
	ELSE

	!LOOK FOR CALLS TO MTOP.
	IF .CSTMNT[SRCID] GEQ UTILLOW
	AND .CSTMNT[SRCID] LEQ UTILHI THEN
	BEGIN
		IO1ARG(T_(IF .CSTMNT[IOREPT] NEQ 0 THEN 5 ELSE 4));
		IOENDERR();

		%(***OUTPUT A WD THAT CONTAINS A CODE INDICATING THE FUN TO BE PERFORMED***)%
		PBOPWD_0;
		PBOPWD[OTSTYPE]_IMMEDTYPE;
		PBOPWD[OTSADDR]_.MTOPFUN[.CSTMNT[SRCID]-UTILLOW];
		PSYMPTR_PBF2NOSYM;
		OBUFFA();

		%(***OUTPUT THE REPEAT WD IF THERE IS A REPEAT CT***)%
		IF .CSTMNT[IOREPT] NEQ 0 THEN
		BEGIN
			REGISTER BASE T1;
			PBOPWD_0;
			T1_.CSTMNT[IOREPT];
			IF .T1[OPR1] EQL CONSTFL THEN
			BEGIN
				PBOPWD[OTSADDR]_.T1[CONST2];
				PSYMPTR_PBF2NOSYM;
			END ELSE
			BEGIN
				PSYMPTR_.T1;
				PBOPWD[OTSADDR]_.T1[IDADDR];
				PBOPWD[OTSIND]_1;
			END;
			PBOPWD[OTSTYPE]_IMMEDTYPE;
			OBUFFA();
		END;
	END ELSE
	BEGIN
		CASE (.CSTMNT[SRCID]-IOSRCIDBAS) OF SET
!	READID:
		REDORWRIT();
!	WRITID:
		REDORWRIT();
!	DECOID:
		CGDECARGS();
!	ENCOID:
		CGDECARGS();
!	REREDID:
	BEGIN
		IO1ARG(5);
		IOENDERR();
		IOFORMAT();
	END;
!	FINDID:
	BEGIN
		REGISTER BASE T1;
		IO1ARG(6);
		ZIPOUT;	!END AND ERROR WORDS ARE 0
		ZIPOUT;
		ZIPOUT;
		ZIPOUT;
		IOPTR(.CSTMNT[IORECORD]);
	END;
!	CLOSID:
	BEGIN
		IO1ARG(.CSTMNT[OPSIZ]+3);
		IOENDERR();
		CGOPARGS();
		RETURN		!DO NOT WANT TO LOOK AT THE IOLIST
	END;
!	INPUID:	!NOT IN RELEASE 1
	BEGIN
	END;
!	OUTPID:	!NOT IN RELEASE 1
	BEGIN
	END;

	TES;
	END;
	IF .CSTMNT[IOLIST] NEQ 0 THEN
	BEGIN
		TREEPTR_.CSTMNT[IOLIST];
		CGIOLARGS();
	END;
END;
GLOBAL ROUTINE REDORWRIT=
BEGIN
	!CODE GENERATION FOR A READ OR WRITE STATEMENT
	!INCLUDING ALL SIZES,SHAPES, VARIETIES AND COLORS

	EXTERNAL ISN,FATLERR,E96;
	EXTERNAL CSTMNT,PBOPWD,OBUFFA,PSYMPTR,GENLAB;
	MAP BASE CSTMNT;
	MAP OBJECTCODE PBOPWD;
		REGISTER BASE T1;
		T1_(.CSTMNT[IORECORD] NEQ 0);
		IF EXTSIGN(.CSTMNT[IOFORM]) EQL 0 THEN
		BEGIN					!BINARY IO
			IO1ARG(IF .T1 THEN 6 ELSE 3);
			IOENDERR();
			IF .T1 THEN ( ZIPOUT; ZIPOUT);

			%(***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 IO
			IO1ARG(5+.T1);
			IOENDERR();
			ZIPOUT;
			ZIPOUT;

			%(***LIST DIRECTED IO WITH NO IOLIST IS AN ERROR***)%
			IF .CSTMNT[IOLIST] EQL 0 THEN FATLERR(.ISN,E96<0,0>);
		END ELSE
		BEGIN
			T1_.CSTMNT[IONAME];
			IF .T1[OPRCLS] EQL DATAOPR AND .T1[IDATTRIBUT(NAMNAM)] THEN
			BEGIN				!NAME LIST READ
				IO1ARG(4);
				IOENDERR();
				!MAKE A LABEL FOR THE NAME LIST ARG BLK
				!AND TUCK IT AWAY IN THE IDCOMMON FIELD
				!OF THE SYMBOL TABLE
				!MAKE IT ONLY IF THERE ISNT ALREADY ONE THERE
				IF .T1[IDCOMMON] EQL 0 THEN
					T1[IDCOMMON]_GENLAB();
				PSYMPTR_PBFLABREF;
				PBOPWD_ 0 OR .T1[IDCOMMON];
				OBUFFA();
			END ELSE
			BEGIN					!FORMATTER READ
				T1_(.CSTMNT[IORECORD] NEQ 0);
				IO1ARG(5+.T1);
				IOENDERR();
				IOFORMAT();
			END;
		END;
		IF .CSTMNT[IORECORD] NEQ 0 THEN
		IOPTR(.CSTMNT[IORECORD]);
END;
GLOBAL ROUTINE NAMGEN=
BEGIN
	!GENERATE NAMELIST BLOCKS FOR FORDTS
	EXTERNAL OBUFFA, PSYMPTR, PBOPWD,NAMLPTR;
	MAP OBJECTCODE PBOPWD;

	OWN	MRNAMPTR,		!MASTER NAME LIST POINTER
		NAMLENTRY,		!POINTER TO EACH NAMELIST ENTRY
		DMETRY;			!POINTER TO DIMENSION TABLE ENTRY

LOCAL BASE PTR;
MAP BASE MRNAMPTR: NAMLENTRY: DMETRY;


MRNAMPTR_.NAMLPTR<LEFT>;
WHILE .MRNAMPTR NEQ 0 DO

	BEGIN

		!SIXBIT NAMELIST NAME

		PSYMPTR _ PBF2NOSYM;
		PTR_.MRNAMPTR[NAMLID];

		%(***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)*******)%
		IF .PTR[IDCOMMON] NEQ 0
		THEN
		BEGIN


			!DEFINE THE ARG BLOCK LABEL THAT
			!WAS STORED IN THE IDCOMMON FIELD OF
			!THE NAMELIST NAME BY REDORWRIT

			DEFLAB(.PTR[IDCOMMON]);

			PBOPWD _ 0 OR .PTR[IDSYMBOL];

			OBUFFA();
			PBOPWD_0;

			!NOW EACH ENTRY IN THE NAMELIST

			INCR I FROM 0 TO .MRNAMPTR[NAMCNT]-1 DO

			BEGIN

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

				!OUTPUT 	SIXBIT NAME

				PBOPWD_.NAMLENTRY[IDSYMBOL];

				PSYMPTR_PBF2NOSYM;

				OBUFFA();
				PBOPWD_0;

				IF .NAMLENTRY[OPERSP] EQL ARRAYNAME THEN

				BEGIN		!OUTPUT ARRAYNAME ENTRY

					!------------------------------------------!
					!#DIMS !	T  !I!  X  !   BASE ADR    !
					!------------------------------------------!

					DMETRY _.NAMLENTRY [IDDIM];

					PBOPWD[OTSCNT]_.DMETRY[DIMNUM];
					IOPTR (.NAMLENTRY);

					!------------------------------------------!
					!	SIZE(ITEMS)   ! POS  OFFSET(WDS)   !
					!------------------------------------------!

					%(***GET ARRAY SIZE IN ITEMS (ARASIZ FIELD IS IN WDS)***)%
					PBOPWD[OTSFSIZ]_(IF .NAMLENTRY[DBLFLG]
							THEN .DMETRY[ARASIZ]/2
							ELSE .DMETRY[ARASIZ]);
					PTR_.DMETRY[ARAOFFSET];
					! (NOTE THAT ADJUSTABLY DIMENSIONED ARRAYS
					! ARE ILLEGAL IN NAMELISTS)
						%(***COMPILER ADDS THE OFFSET - FOROTS
							SUBTRACTS IT. THEREFORE MUST PASS
							FOROTS THE NEG OF THE OFFSET USED
							BY THE COMPILER***)%
					IF .PTR[OPR1] EQL CONSTFL THEN
						PBOPWD[OTSADDR]_-.PTR[CONST2]
					ELSE
					CGERR();	!(ADJUSTABLY DIM ARRAY ILLEGAL)

					PSYMPTR_PBF2NOSYM;
					OBUFFA();
					PBOPWD_0;

					!FACTORS

					!------------------------------------------!
					!			 !    FACTOR (IN ITEMS)!
					!------------------------------------------!

					!FACTORS NECESSARY

					INCR K FROM 1 TO .DMETRY[DIMNUM] DO

					BEGIN

						PTR_.DMETRY[DFACTOR ((.K-1))];

						IF .PTR [OPR1] EQL CONSTFL THEN

						BEGIN		!A CONSTANT

							PSYMPTR_PBF2NOSYM;
							%(***GET FACTOR IN ITEMS (NOT WDS)**)%
							PBOPWD_(IF .NAMLENTRY[DBLFLG]
								THEN .PTR[CONST2]/2
								ELSE .PTR[CONST2]);
							OBUFFA();

						END ELSE

						CGERR();
					END;		!FACTOR  OUTPUT

				END ELSE	!ARRAY  OUTPUT

				IOPTR(.NAMLENTRY);

			END;			!INCR LOOP ON ENTRIES IN NAMELIST

			PBOPWD_OTSFINWD;	!FIN. TERMINATING WD
			PSYMPTR_PBF2NOSYM;
			OBUFFA();
		END;

		MRNAMPTR_.MRNAMPTR[NAMLINK];

	END;			!WHILE LOOP;
END;				!NAMGEN
END
ELUDOM