Google
 

Trailing-Edge - PDP-10 Archives - BB-4157E-BM - fortran-compiler/cgdo.bli
There are 12 other files named cgdo.bli in the archive. Click here to see a list.
!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,1981 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR NORMA ABEL/HPW/MD/DCE/SJW/RDH/TFV

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

GLOBAL BIND CGDOV = 6^24 + 0^18 + 145;	! Version Date:	23-Jul-81


%(

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

119	-----	-----	MAKE ARGGEN A GLOBAL ROUTINE

120	-----	-----	IN "CGRETURN", WHEN LOOK FOR NEXT STMNT AFTER
			THE RETURN EQUAL TO END, SKIP OVER AN INTERVENING CONTINUE
121	-----	-----	IN "CGRETURN", WHEN CHECKING THE SRCID OF NXTSTMNT,
			MUST FIRST CHECK THE NXTSTMNT NEQ 0
122	-----	-----	IN "CGRETURN", GENERATE A RETURN WHEN THERE
			ARE LABEL ARGUMENTS IN ALL CASES
123	-----	-----	FIX ARGGEN TO PERMIT MULTIPLE LEVEL PASSING
			OF SUBPROGRAM NAMES
124	-----	-----	FIX 123 (I HOPE)
125	-----	-----	CHANGE REFERENCES TO PROEPITYP
126	-----	-----	PUT OUT TYPE CODE WITH LABEL ARGUMENTS
127	-----	-----	GIVE ERROR MESSAGES FOR MULTIPLE RETURN
					WHEN THERE WERE NO LABEL PARAMS; AND
			FOR VALUE OF A FN NEVER DEFINED
128	-----	-----	MESSAGE FOR VAL OF FN UNDEFINED SHOULD NOT
			BE GIVEN FOR A STMNT FN
129	-----	-----	MACRO SET1ZGEN MISSPELLED IN CGRETURN
130	-----	-----	FIX CALLS TO FATLERR TO INCLUDE .ISN
131	-----	-----	WHEN /DEB:TRACE WAS SPECIFIED, FOR STMNT FNS
			AND ENTRIES THE XCT FDDT. MUST BE GENERATED AFTER
			THE ENTRY NAME IS DEFINED.
132	-----	-----	IN "CGPROEPI", SHOULD CLEAR PBFISN FIELD
			BEFORE OUTPUT SIXBIT FOR ENTRY NAME; SET
			IT TO THE STMNT ISN BEFORE THE 1ST INSTRUCTION
133	-----	-----	GENERATE COMMON SUBS ON DO STMNTS
134	256	15493	DO NOT LOOK FOR LABEL DUMMIES IN STATEMENT FUNCTIONS,
			(JNT)
135	323	16729	USE .A00NN FOR NAME OF TEMPORARY USED  TO SAVE
			REGISTERS IN PROLOGUE OF A FUNCTION, (MD)
136	360	18243	FIX RETURN BEFORE CONTINUE, END STMNTS, (DCE)

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

137	607	22685	SET GLOBAL FLAG NEDZER IN CGSBPRGM TO INDICATE
			  ZERO-ARG-BLOCK NEEDED
140	613	QA2114	IGNORE INDIRECT BIT IN FORMAL FUNCTION TARGET
			  ON ENTRY PROLOGUE, (SJW)

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

141	674	11803	TEST FOR DOSTAK OVERFLOW AND GIVE ERROR MSG, (DCE)
142	677	25573	GENERATE CODE TO CHECK FOR CORRECT
			 NUMBER OF PARAMETERS IF DEBUG:PARAM SET, (DCE)

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

143	750	TFV	1-Jan-80	------
	remove Debug:parameters (edit 677)

144	761	TFV	1-Mar-80	-----
	Remove KA10FLG and add in /GFLOATING

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

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

)%

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

%*****
	CODE GENERATOR DRIVERS FOR DO LOOPS
*****%

GLOBAL ROUTINE CGDOLOOP=
BEGIN

	EXTERNAL CGCMNSUB;	!GEN CODE FOR COMMON SUBS
	EXTERNAL TREEPTR,A1NODE,A2NODE,OPDSPIX,REGFORCOMP,CGOPGEN,CSTMNT,DEFLAB,GENLAB;
	EXTERNAL CGERR,DOSTI;
%[761]%	EXTERNAL CGETVAL,OPGETI,DOSP,OPGSTI,DOSTC;
MAP BASE DOSP:A1NODE:CSTMNT:TREEPTR;
	EXTERNAL E144,FATLERR,DOSTAK; ![674]  ERROR MESSAGE DECLARATIONS
	OWN PEXPRNODE DOCEXPR;		!PTR TO EXPRESSION FOR CONTROL WD

LOCAL CTLREG,	!CONTROL WORD REGISTER
	IVALREG;	!INITIAL VALUE REGISTER


	IF .CSTMNT[SRCCOMNSUB] NEQ 0	!IF HAVE ANY COMMON SUBS
	THEN CGCMNSUB();		! GEN CODE FOR THEM


	!SET UP LOCAL VALUES
	CTLREG_.CSTMNT[DOCREG]^23;
	IVALREG_.CSTMNT[DOIREG]^23;

	%(***GET THE VAL OF THE CONTROL EXPRESSION INTO THE LOOP CTL REG***)%
	DOCEXPR_.CSTMNT[DOLPCTL];
	A1NODE_.DOCEXPR;

	%(***IF THE CTL EXPR NEEDS TO BE EVALUATED AT RUN TIME, GENERATE
		CODE TO EVALUATE IT***)%
	IF .DOCEXPR[OPRCLS] NEQ DATAOPR
	THEN
	BEGIN
		TREEPTR_.DOCEXPR;
		CGETVAL();
	END;

	%(***GET THE VALUE OF THE CTL EXPRESSION INTO THE LOOP CTL REG***)%
	IF NOT .CSTMNT[CTLSAMEFLG]
	THEN
	BEGIN
		REGFORCOMP_.CTLREG;
		A1NODE_.DOCEXPR;

		IF .CSTMNT[FLCWD] THEN	!IF THE CTL IS IN AN AOBJN WD
%[761]%			OPDSPIX_OPGETI
		ELSE
			OPDSPIX_DOGETAOPIX(.CSTMNT[CTLIMMED],
						.A1NODE[VALTP1],.CSTMNT[CTLNEG]);
		CGOPGEN();
	END;

!CONTROL WORD IS NOW IN A REGISTER
!GET THE INTIALIAL VALUE IN ONE IF NECESSARY

	IF NOT .CSTMNT[FLCWD] THEN
	BEGIN
		REGFORCOMP_.IVALREG;
		A1NODE_.CSTMNT[DOM1];	!INITIAL VALUE

		%(***IF THE INITIAL VAL IS NOT IN THE REG FOR THE DO INDEX, PUT IT THERE**)%
		IF .A1NODE[OPRCLS] EQL REGCONTENTS
			AND .A1NODE[TARGTAC] EQL .CSTMNT[DOIREG]
		THEN
		BEGIN END
		ELSE 
		BEGIN
			IF .CSTMNT[INITLIMMED] THEN
				OPDSPIX_DOGETAOPIX(1,.A1NODE[VALTP1],.CSTMNT[INITLNEG])
			ELSE
				OPDSPIX_DOGETAOPIX(0,.A1NODE[VALTP1],.CSTMNT[INITLNEG]);
			CGOPGEN();
		END
	END;

	%(***IF THIS LOOP MUST HAVE ITS COUNT-CTL VAR MATERIALIZED, GENERATE CODE TO
		STORE THE COUNT ***)%
	IF .CSTMNT[NEDSMATRLZ] OR .CSTMNT[MATRLZCTLONLY]
	THEN
	BEGIN
		%(***GENERATE CODE TO STORE THE COUNT***)%

		A1NODE_.CSTMNT[DOCTLVAR];
		REGFORCOMP_.CTLREG;
		OPDSPIX_DOSTC + .CSTMNT[FLCWD];
		CGOPGEN();
	END;

	%(***IF THIS LOOP MUST HAVE ITS INDEX MATERIALIZED, GENERATE CODE
		TO STORE THE INDEX***)%
	IF .CSTMNT[NEDSMATRLZ] OR .CSTMNT[MATRLZIXONLY]
	THEN
	BEGIN


		%(***GENERATE THE MATERIALIZATION LABEL***)%
		DOSP[LEFTP]_GENLAB();
		DEFLAB(.DOSP[LEFTP]);

		!NOW STORE INITIAL VALUE
		!USING OPGNTA TABLES TO GET DOUBLE PRECISION UNLESS ITS AN HRRM

		IF .CSTMNT[FLCWD] THEN
		BEGIN
			A1NODE_.CSTMNT[DOSYM];		!INDUCTION VARIABLE
			REGFORCOMP_.CTLREG;
			OPDSPIX_DOSTI;
			CGOPGEN();
		END ELSE
		BEGIN
			REGFORCOMP_.IVALREG;
			TREEPTR_.CSTMNT[DOSYM];
			OPDSPIX_STOROPIX(TREEPTR);
			CGOPGEN();
		END;
	END;


!NOW GENERATE NON-MATERIALIZATION LABELS

	DOSP[RIGHTP]_GENLAB();
	DEFLAB(.DOSP[RIGHTP]);
	DOSP_.DOSP+1;
![674] TEST FOR STACK OVERFLOW, AND ISSUE MESSAGE IF NECESSARY
%[674]%	IF (.DOSP-DOSTAK) GTR TDOSTSIZ THEN FATLERR(.ISN,E144<0,0>);
END;
GLOBAL ROUTINE CGDOEND(TLAB)=
BEGIN
	LABEL DODOER;
	EXTERNAL CGERR;
![761] OPGARG for /GFLOATING code generation
	EXTERNAL CGOPGEN,OPDSPIX,REGFORCOMP,TREEPTR,A1LABEL,A2LABEL,
%[761]%	A1NODE,A2NODE,DOSP,DOEND,OPGARG,OPGARI,OPGDOE;
%[761]%	EXTERNAL OPGETI,OPGDOS;
MAP BASE TLAB;
	MAP BASE A1NODE:DOSP:A2NODE:TREEPTR;

!TLAB POINTS TO LABEL TABLE ENTRY FOT LABEL TERMINATING THE SCOPE OF
!ONE OR MORE DO STATEMENTS.
!SNDOLNK POINTS TO A LINKED LIST OF THE DO STATEMENTS TERMINATING
!HERE
LOCAL CURDO,		!THE CURRENT DO LOOP
	NXTWD,		!WORD CONTAINING LINK AND DO POINTER
	NXTLNK,		!WORD CONTAINING LINK TO NEXT WORD
	TMP1;
MAP BASE CURDO:TMP1:NXTWD:NXTLNK;

	IF .TLAB[SNDOLVL] EQL 0 THEN RETURN;	!NO DO'S END HERE

	NXTWD_.TLAB[SNDOLNK];		!POINT AT FIRST OF LIST
	DODOER:
	WHILE 1 DO
	BEGIN
		CURDO_.NXTWD[LEFTP];
		!IF THE LOOP IS STILL THERE
		IF NOT .CURDO[DOREMOVED] THEN
		BEGIN

			DOSP_.DOSP-1;
			!LOOK AT THE CORRECT STACK ENTRY

			!DETERMINE WHICH LABEL TO TRANSFER TO AT LOOP ENDING
			! IF THE INDEX IS MATERIALIZED, TRANSFER TO MATERIALIZ LABEL
			IF .CURDO[NEDSMATRLZ] OR .CURDO[MATRLZIXONLY] THEN
			A1LABEL_.DOSP[LEFTP]
			ELSE
			A1LABEL_.DOSP[RIGHTP];

			IF .A1LABEL EQL 0 THEN CGERR();





			%(***FOR THE AOBJN CASE - THE CONTROL WD AND THE LOOP INDEX ARE INCREMENTED
				TOGETHER***)%
			IF .CURDO[FLCWD] AND NOT .CURDO[NEDSMATRLZ]
			THEN
			BEGIN
				A1NODE_.CURDO[DOCTLVAR];	!TEMP FOR CONTOL WORD
				REGFORCOMP_.CURDO[DOCREG]^23;
				OPDSPIX_OPGDOE;
				!GENERATE AOBJN CREG,A1LABEL
			END ELSE


			%(***FOR CASES OTHER THAN AOBJN - MUST GENERATE CODE TO INCREMENT
				THE LOOP INDEX AND CODE TO INCREMENT AND TEST THE CONTROL-WORD***)%
			BEGIN
				%(***GENERATE CODE TO ADD THE STEP SIZE TO THE LOOP INDEX***)%
				REGFORCOMP_.CURDO[DOIREG]^23;

				!IF THE LOOP INDEX IS NOT MATERIALIZED, WILL SIMPLY GENERATE
				! AN ADD OF THE INCR TO THE REG HOLDING THE INDEX
				IF NOT .CURDO[NEDSMATRLZ] AND NOT .CURDO[MATRLZIXONLY]
				THEN
				BEGIN
					A2NODE_.CURDO[DOSSIZE];	!PTR TO INCR
					OPDSPIX_(IF (.CURDO[SSIZONE] OR .CURDO[SSIZIMMED])
						AND .A2NODE[VALTYPE] NEQ DOUBLPREC
						THEN DOARITHOPIX(.A2NODE[VALTP1],0,1,.CURDO[SSIZNEGFLG])
						ELSE DOARITHOPIX(.A2NODE[VALTP1],0,0,.CURDO[SSIZNEGFLG]) );
					CGOPGEN();
				END

				!IF THE LOOP INDEX IS MATERIALIZED AND THE INCREMENT IS
				! 1, GENERATE AOS
				ELSE
				IF (.CURDO[SSIZONE] AND NOT .CURDO[REALARITH])
					OR .CURDO[FLCWD]
				THEN
				BEGIN
					A1LABEL_.DOSP[RIGHTP];
					!NON-MATRLIZE LABEL
					OPDSPIX_OPGDOS;
					A1NODE_.CURDO[DOSYM];
					CGOPGEN();
				END

				!IF THE LOOP INDEX NEEDS TO BE MATERIALIZED, PICK UP THE
				! INCREMENT AND THEM ADD IT TO MEMORY IF VALTYPE IS NOT DOUBLE-PREC
				ELSE
				BEGIN
					!TO LOAD THE INCREMENT
					A1NODE_.CURDO[DOSSIZE];
					OPDSPIX_(IF (.CURDO[SSIZONE] OR .CURDO[SSIZIMMED])
					AND .A1NODE[VALTYPE] NEQ DOUBLPREC
						THEN DOGETAOPIX(1,.A1NODE[VALTP1],.CURDO[SSIZNEGFLG])
						ELSE DOGETAOPIX(0,.A1NODE[VALTP1],.CURDO[SSIZNEGFLG]) );
					CGOPGEN();

					!UNLESS THE INDEX IS DOUBLE-PREC WILL ADD THE
					! INCREMENT TO IT IN BOTH THE REG USED AND MEMORY,
					! AND TRANSFER AT LOOP
					! END WILL BE TO THE CODE AFTER THE MATERIALIZATION CODE
					A2NODE_.CURDO[DOSYM];
					IF .A2NODE[DBLFLG]
					THEN OPDSPIX_DOARITHOPIX(.A2NODE[VALTP1],0,0,0)
					ELSE
					BEGIN
						A1LABEL_.DOSP[RIGHTP];
						OPDSPIX_DOARBOTHOPIX(.A2NODE[VALTP1]);	!INDEX TO GENERATE
										!ADD TO BOTH FOR REAL OR INTEGER
					END;
					CGOPGEN();
				END;


				!GENERATE CODE TO INCREMENT AND TEST THE CONTROL WORD
				!AOJL
				!OR
				!AOSGE
				!JRST
				!THE CONTROL REGISTER IS USED
				REGFORCOMP_.CURDO[DOCREG]^23;
				!CODE TO BE GENERATED DEPENDS ON WHETHER THE CTL-COUNT WD
				! IS MATERIALIZED
				OPDSPIX_OPGDOE+2+(.CURDO[NEDSMATRLZ] OR .CURDO[MATRLZCTLONLY]);
				A1NODE_.CURDO[DOCTLVAR];
			END;
			CGOPGEN();
		END;			!DO LOOP REALLY THERE TEST
		NXTLNK_.NXTWD[RIGHTP];
		IF .NXTLNK EQL 0 THEN LEAVE DODOER
		ELSE
			NXTWD_.NXTLNK;
	END;		!WHILE 1 LOOP
END;		!CGDOEND;




!MACRO CREATES 3 SIXBIT CHARACTERS OF SUBROUTINE NAME TO
!BE USED IN FORMING TEMPORARY NAMES.  THE NAMES ARE PREFIXED WITH
!A . AND SUFFIXED WITH THE NUMBERS 2-17.
!2-16 ARE FOR REGISTER SAVES.
!17 IS FOR THE EPILOGUE ADDRESS IF THERE ARE MULTIPLE ENTRIES

!MACRO GETXXX=
!	(.PROGNAME<30,6>^24
!	+(IF .PROGNAME<24,6> EQL 0 THEN 16
!	  ELSE .PROGNAME<24,6>)^18
!	+(IF .PROGNAME<18,6> EQL 0 THEN 16
!	  ELSE .PROGNAME<18,6>)^12)$;

!ADD THE DOT AND NUMBER WITH THE MACRO TNAME

!MACRO TNAME DEFINES .A00NN TEMP NAMES TO SAVE THE REGISTERS
!USED IN THE FUNCTION. THE USE OF .XXXNN WHERE XXX IS THE
!FIRST THREE CHARS OF THE FUNCTION NAME IS DELETED
!BECAUSE IT HAD CONFLICTS WITH FUNCTIONS NAMED F OR Q
!OR ANY OTHER TEMP NAMES USED BY THE COMPILER.

MACRO TNAME(INDX)=
!MAKE IT .A00NN WHERE NN IS THE REGISTER NUMBER
	(SIXBIT '.A00'
	+((INDX AND #70)^(-3)+16)^6
	+((INDX AND #7)+16))$;



!GENERATE A MOVE 1,SRCE

MACRO MOV1GEN(SRCE)=
BEGIN
	EXTERNAL C1H;
	OPDSPIX_MOVRET;
	C1H_SRCE;
	CGOPGEN();
END$;

!GENERATE THE VALUE TO ADD TO THE VALUE OF THE PARAMETER LIST
!BASE FOR A RETURN I

MACRO DATAGEN(NUMB)=
BEGIN
	PSYMPTR_PBF2NOSYM;
	!THE WORD WILL HAVE 16 IN THE REGISTER FIELD
	PBOPWD_#16^18 OR NUMB;
	OBUFFA();
END$;



MACRO ENTLST=ENTLIST$;	!TO CORRECT TYPING ERROR

!OWN VARIABLE
OWN EPILAB,JUMPABOUT,JMPVECT,LABARGCT,JMPSFN;


EXTERNAL LASTONE;

GLOBAL ROUTINE CGPROEPI =
BEGIN
	OWN PEXPRNODE ENTNAME;
%(*********************************
	SUBROUTINE PROLOGUE
	AND EPILOGUE
*********************************)%
	!TEMPORARY NAMES ARE OF THE FORM
	!.XXXNN, WHERE:
	!	1.  XXX IS THE FIRST 3 LETTERS OF THE SUBROUTINE NAME
	!	2.  NN IS 2-16 (DECIMAL)
	LABEL FNLOK;
	LOCAL ARGLSTPT,NEDTOSAV;
	EXTERNAL OPGADJ,A2LABEL;
	EXTERNAL OPGMVL;
%[761]%	EXTERNAL A1LABEL,OPGPHR,OPGPPR,DVALU,OPINSI,CLOBBREGS;
	EXTERNAL OUTMOD,PBFPTR,PBUFF,PBOPWD,OBUFF,OBUFFA,PSYMPTR,C1H;
	EXTERNAL CSTMNT,NAME,TBLSEARCH,ENTRY,GENLAB,DEFLAB,POPRET,CRETN,PROGNAME;
%[761]%	EXTERNAL CGOPGEN,OPDSPIX,REGFORCOMP,TREEPTR, A1NODE,  OPINDI,OPGETI,OPGSTI;
	EXTERNAL XCTFDDT;
	MAP PPEEPFRAME PBFPTR;
	EXTERNAL ARGLINKPT;
	MAP PEXPRNODE CSTMNT:A1NODE;
	MAP ARGUMENTLIST ARGLSTPT;
	MAP PEEPFRAME PBUFF;
	EXTERNAL OUTMDA,OPGIIN;
	EXTERNAL CGEPILOGUE;	!ROUTINE TO GENERATE EPILOGUE CODE


	PBFPTR[PBFISN]_NOISN;	!REMOVE THE SEQ NUMBER FROM THE NEXT INSTR (INSTEAD IT
				! WILL GO ON THE 1ST INSTR AFTER THE ENTRY PT)


	JUMPABOUT_0;
	!IF AN ENTRY THEN JRST AROUND PROLOGUE
	!AND EPILOQUE


	IF .CSTMNT[SRCID] EQL SFNID THEN
	BEGIN
		JMPSFN_GENLAB();
		JRSTGEN(.JMPSFN);
		!USE A1NODE AS A TEMP 
		!TO MAKE AND SAVE THE LABEL FOR THE SFN THAT
		!WILL BE USED IN THE PUSHJ AT REFERENCE TIME

		A1NODE_.CSTMNT[SFNNAME];
		A1NODE[IDSFNLAB]_GENLAB();
	END;

	IF .CSTMNT[ENTNUM] NEQ 0 AND .CSTMNT[SRCID] NEQ SFNID  THEN
	BEGIN
		JUMPABOUT_GENLAB();
		JRSTGEN(.JUMPABOUT);
	END;



	%(***OUTPUT ANY INSTRS REMAINING IN THE PEEPHOLE BUFFER (AND INITIALIZE
		THE PTR TO NEX AVAILABLE  WD IN BUFFER TO THE 1ST WD OF BUFFER)***)%
	IF .PBFPTR NEQ PBUFF
	THEN
	BEGIN
		OUTMOD(PBUFF,(.PBFPTR-PBUFF)/PBFENTSIZE);
		PBUFF[PBFLABEL]_NOLABEL;	!INIT LABEL FIELD OF 1ST INSTR

		PBFPTR_PBUFF;
	END;


	%(***CLEAR "ISN" FIELD IN PEEPHOLE BUFFER - WANT THE ISN ON
		THE 1ST INSTR, NOT ON THE SIXBIT***)%
	PBFPTR[PBFISN]_NOISN;



	%(***OUTPUT SIXBIT FOR THE ENTRY NAME. USE THE OUTPUT ROUTINE "OBUFFA" TO
		BYPASS THE PEEPHOLE OPTIMIZER***)%
	ENTNAME_.CSTMNT[ENTSYM];
	PBOPWD_.ENTNAME[IDSYMBOL];
	PSYMPTR_PBF2NOSYM;
	OBUFFA();


	%(***MUST NOW CLEAR THE PEEPHOLE BUFFER AGAIN BEFORE START PEEPHOLING***)%
	IF .PBFPTR NEQ PBUFF
	THEN
	BEGIN
		OUTMDA(PBUFF,(.PBFPTR-PBUFF)/PBFENTSIZE);
		PBFPTR_PBUFF;
		PBUFF[PBFLABEL]_NOLABEL;
	END;


	!THERE SHOULD BE ONLY ONE SUBROUTINE OR FUNCTION PER
	!COMPILATION UNIT

	!SAVE THE EPILOGUE ADDRESS IF NECESSARY
	!MAKE THE ENTRY NAME A GLOBAL FOR THE LOADER
	IF .CSTMNT[SRCID] NEQ SFNID THEN
	BEGIN
		PBOPWD_.CSTMNT[ENTSYM];
		PSYMPTR_PBFENTRY;
		OBUFF();
	END
		ELSE
		BEGIN
			A1NODE_.CSTMNT[SFNNAME];
			DEFLAB(.A1NODE[IDSFNLAB]);
		END;


	PBFPTR[PBFISN]_.CSTMNT[SRCISN];		!INTERNAL SEQ NUMBER OF
					! THE ENTRY STMNT GOES ON THE 1ST INSTRUCTION
				! OF THE ENTRY SEQUENCE


	!IF THE USER SPECIFIED /DEB:TRACE, GENERATE "XCT FDDT."
	IF .FLGREG<DBGTRAC> THEN XCTFDDT();


	!DEFINE THE EPILOGUE LABEL
	EPILAB_GENLAB();
	!IF MULTIPLE ENTRIES
	IF .FLGREG<MULTENT> THEN
	BEGIN
		REGFORCOMP_1^23;				!HOPE TO GENERATE
		A1LABEL_.EPILAB;			!MOVEM 1, XXX17
		OPDSPIX_OPGMVL;
		NAME_IDTAB;
		ENTRY_TNAME(#17);
		A1NODE_TBLSEARCH();
		CGOPGEN();
	END;
	!REGISTER SAVE
	!SAVE REGISTER 16 EXCEPT IF ITS A STATEMENT FUNCTION
	! OR A FUNCTION THAT DOES NOT CALL FOROTS OR ANY OTHER FUNCTIONS
	!USE PUSHES FOR SFN,S MOVEMS OTHERWISE
	IF .CSTMNT[SRCID] EQL SFNID THEN
		OPDSPIX_OPGPHR	!STORE THE OTHER REGS USING "PUSH"
	ELSE
	IF NOT (.BTTMSTFNFLG AND .IOFIRST EQL 0 AND NOT .LIBARITHFLG)
	THEN
	BEGIN
%[761]%		OPDSPIX_OPGSTI;
		NAME_IDTAB;
		ENTRY_TNAME(#16);
		TREEPTR_TBLSEARCH();
		REGFORCOMP_#16^23;
		CGOPGEN();
	END
%[761]%	ELSE OPDSPIX_OPGSTI;	!WILL STORE ANY OTHER REGS USING "MOVEM"


	!NOW IF IT IS A FUNCTION

	FNLOK:
	IF .FLGREG<PROGTYP> EQL FNPROG THEN
	BEGIN
			NEDTOSAV_LASTONE(.CLOBBREGS);
			IF .NEDTOSAV LSS 0 THEN LEAVE FNLOK;

			DECR I FROM .NEDTOSAV TO 2 DO
			BEGIN
				IF .CSTMNT[SRCID] EQL ENTRID THEN
				BEGIN
					NAME_IDTAB;
					ENTRY_TNAME(.I);
					TREEPTR_TBLSEARCH();
				END;
				REGFORCOMP_.I^23;
				CGOPGEN();
			END;
	END;
	!MOVE ARGS TO TEMPS
	!ADDRESS OF TEMP IS IN SYMBOL TABLE FOR ARGUMENT
	REGFORCOMP_0;
	IF .CSTMNT[ENTLST] NEQ 0 THEN
	BEGIN
		ARGLSTPT_.CSTMNT[ENTLST];
		INCR I FROM 1 TO .ARGLSTPT[ARGCOUNT] DO
		BEGIN
			TREEPTR_
			A1NODE_.ARGLSTPT[.I,ARGNPTR];
			IF .A1NODE EQL 0 THEN			!ZERO MEANS LABEL
			ELSE
			IF .ARGLSTPT[.I,ENTNOCOPYFLG]	!IF NO LOCAL COPY IS TO BE MADE OF THIS PARAM
			THEN BEGIN END		! DO NOTHING
			ELSE
			BEGIN
				IF .A1NODE[OPR1] EQL OPR1C(DATAOPR,FORMLVAR) THEN
					!MOVE VALUE OF SCALAR TO REGISTER
				BEGIN
%[761]%					OPDSPIX_.A1NODE[VALTP1]+OPINDI;
%[761]%					C1H _ INDBIT OR (.I-1);
				END ELSE
					BEGIN
						OPDSPIX_OPGIIN;
						C1H_INDBIT OR (.I-1);
					END;
				!PICK UP REGISTER FROM ENTAC FIELD
				REGFORCOMP_.ARGLSTPT[.I,ENTAC]^23;
				CGOPGEN();		!VALUE NOW IN A REGISTER
				!NOW STORE VALUE OR POINTER IN TEMP
				IF .A1NODE[OPR1] EQL OPR1C(DATAOPR,FORMLVAR) THEN
%[761]%					OPDSPIX_.A1NODE[DBLFLG]+OPGSTI
				ELSE
%[761]%					OPDSPIX_OPGSTI;
				!ONLY DO STORE IF NOT GLOBALLY ALLOCATED
				IF NOT .ARGLSTPT [.I, ENTGALLOCFLG]
				  THEN BEGIN
				    NEDTOSAV _ .A1NODE [IDTARGET] AND INDBIT;			! SAVE CURRENT INDIRECT FLAG OF FORMAL
				    A1NODE [IDTARGET] _ .A1NODE [IDTARGET] AND (NOT INDBIT);	! TURN OFF INDIRECT FLAG
				    CGOPGEN ();							! GENERATE STORE CODE
				    A1NODE [IDTARGET] _ .A1NODE [IDTARGET] OR .NEDTOSAV;	! RESTORE INDIRECT FLAG
				  END;
			END;
		END;
	END;
	!NOW GENERATE JRST TO FIRST EXECUTABLE STATEMENT

	!*************************************************
	!*************************************************
	!THIS JRST IS SPECIAL
	!IF WE ARE GOING TO CREATE A JUMP VECTOR FOR MULTIPLE
	!RETURNS, WE MUST OUTPUT THE PEEPHOLE BUFFER BEFORE
	!GENERATING THE JRST. ELSE, IT WOULD BE A LABELED
	!JRST AND RECEIVE CROSS-JUMPING OPTIMIZATION. SINCE
	!THE PEEPHOLE OPTIMIZER ALWAYS LOOKS AT THE THIRD FROM LAST
	!INSTRUCTION, MAKING IT THE FIRST INSTRUCTION WILL
	!INHIBIT THE PEEPHOLE.
	!****************************************************
	!*********************************************************
	IF .JUMPABOUT EQL 0 THEN			!ALREADY HAVE LABEL IF
							!JUMPABOUT IS SET
		JUMPABOUT_GENLAB();

	!IF THERE WERE LABEL DUMMY ARGS
	IF .FLGREG<LABLDUM> THEN
							!MAKE THIS JRST THE BASE OF THE JUMP VECTOR
	BEGIN						!SO WE DONT WASTE A SPACE
		!*************************
		!HERE IS THE SPECIAL OUTPUT OF THE BUFFER
		!****************************

		OUTMOD(PBUFF,(.PBFPTR-PBUFF)/PBFENTSIZE);
		PBFPTR_PBUFF;
		PBUFF[PBFLABEL]_NOLABEL;

		JMPVECT_GENLAB();
		DEFLAB(.JMPVECT);
	END;
	!NOW JRST TO FIRST EXECUTABLE
	!IF THERE ARE LABEL ARGS AND HENCE A JUMP VECTOR
	IF .FLGREG<LABLDUM>
		OR .FLGREG<MULTENT>	!OR MULTIPLE ENTRIES
					! THIS ENTRY FOLLOWS THE PROLOGUE)
	THEN
	JRSTGEN(.JUMPABOUT);	! GENERATE A "JRST" TO THE 1ST EXECUTABLE INSTR

	!NOW THE REST OF THE JUMP VECTOR IF NEEDED
	IF .CSTMNT[SRCID] NEQ SFNID	!DON'T NEED IT IF
	THEN	!IT'S AN ARITHMETIC STATEMENT FUNCTION
	BEGIN
		LABARGCT_0;
		IF .FLGREG<LABLDUM> THEN
		BEGIN
			!FIRST OUTPUT THE JRST, IT MUST GO THRU
			!OUTMOD.
	
			OUTMOD(PBUFF,1);
			PBFPTR_PBUFF;
			PBUFF[PBFLABEL]_NOLABEL;
	
			IF .CSTMNT[ENTLST] NEQ 0 THEN
			BEGIN
				ARGLSTPT_.CSTMNT[ENTLST];
				INCR I FROM 1 TO .ARGLSTPT[ARGCOUNT] DO
				BEGIN
					IF .ARGLSTPT[.I,ARGNPTR] EQL 0 THEN	!ITS A LABEL
					BEGIN
						LABARGCT_.LABARGCT+1;
						DATAGEN(.I-1);
					END;
				END;
			END;
			!NOW OUTPUT THE JUMP VECTOR THROUGH OUTMDA
	
			OUTMDA(PBUFF,.LABARGCT);
			PBFPTR_PBUFF;
	
		END;
	END;	!END OF IF STATEMENT FUNCTION


	%(**FOR MULTIPLE ENTRY SUBROUTINES, GENERATE THE EPILOGUE RIGHT AFTER
		THE PROLOGUE FOR EACH ENTRY**)%
	IF .FLGREG<MULTENT>
	THEN CGEPILOGUE(.CSTMNT);

		!DEFINE FIRST EXECUTABLE
		DEFLAB(.JUMPABOUT);			!DEFINE LABEL OF FIRST EXECUTABLE
	!IF THERE ARE MULTIPLE ENTRIES (THE RETURN WILL BE AN
	!INDIRECT JRST) THEN MAKE EPILAB POINT TO THE TEMP
	!IN WHICH THE EPILOGUE ADDRESS IS STORED

	IF .FLGREG<MULTENT> THEN
	BEGIN
		NAME_IDTAB;
		ENTRY_TNAME(#17);
		EPILAB_TBLSEARCH();
	END;
END;	!END OF ROUTINE "CGPROEPI"


GLOBAL ROUTINE CGEPILOGUE(ENTSTMN)=
%(***************************************************************************
	ROUTINE TO GENERATE CODE FOR FUNCTION/SUBROUTINE EPILOGUE.
	"ENTSTMN" POINTS TO THE ENTRY STATEMENT TO WHICH
	THIS EPILOGUE CORRESPONDS
***************************************************************************)%
BEGIN
	EXTERNAL FATLERR,E131;
	EXTERNAL A1NODE,A1LABEL,A2LABEL,C1H,
		OPDSPIX,REGFORCOMP,CGOPGEN;	!BASIC CODE GEN ROUTINE AND THE GLOBALS IN WHICH IT
				! TAKES ITS PARAMETERS
	EXTERNAL PROGNAME;
	MAP PEXPRNODE A1NODE;
%[761]%	EXTERNAL OPGETI,POPRET,CRETN,
%[761]%		 OPINSI,OPGPPR;	!INDICES INTO THE CODE GENERATION TABLE
	EXTERNAL GENLAB,DEFLAB,CLOBBREGS,TBLSEARCH;
	EXTERNAL NAME;
	MAP BASE ENTSTMN;
	REGISTER ARGUMENTLIST ARGLSTPT;

	!DEFINE THE EPILOGUE LABEL DEFINED BY THE GLOBAL "EPILAB"
	DEFLAB(.EPILAB);

	!RESTORE REGISTER 16
	!STATEMENT FUNCTIONS AND BOTTOMMOST FUNCTIONS WONT RESTORE 16 
	IF .ENTSTMN[SRCID] EQL SFNID OR 
		(.BTTMSTFNFLG AND .IOFIRST EQL 0 AND NOT .LIBARITHFLG)
  THEN
	ELSE
	BEGIN
		NAME_IDTAB;
		ENTRY_TNAME(#16);
		A1NODE_TBLSEARCH();
%[761]%		OPDSPIX_OPGETI;
		REGFORCOMP_#16^23;
		CGOPGEN();
	END;

	!FOR LABELS AS PARAMETERS GENERATE THE COMPLEX RETURN
	IF .FLGREG<LABLDUM> THEN
	BEGIN
		A2LABEL_.JMPVECT;
		A1LABEL_GENLAB();		!LABEL FOR OUT OF BOUNDS
		C1H_.LABARGCT;
		OPDSPIX_CRETN;
		CGOPGEN();
		DEFLAB(.A1LABEL);
	END;

	!NOW MOVE SCALARS BACK
	!NOT NECESSARY FOR  STATEMENT FUNCTIONS
	IF .ENTSTMN[ENTLST] NEQ 0 AND .ENTSTMN[SRCID] NEQ SFNID  THEN
	BEGIN
		REGFORCOMP_0;
		ARGLSTPT_.ENTSTMN[ENTLST];
		INCR I FROM 1 TO .ARGLSTPT[ARGCOUNT] DO
		BEGIN
			A1NODE_.ARGLSTPT[.I,ARGNPTR];
			IF .A1NODE EQL 0 THEN
			ELSE IF .ARGLSTPT[.I,ENTNOCOPYFLG]	!IF NO LOCAL COPY WAS MADE
								! OF THIS ARG
			THEN BEGIN END
			ELSE
			!ONLY MOVE THEM BACK IF THEY WERE
			!STORED INTO, ELSE WE ARE IN TROUBLE
			!WITH GENERATING HISEG STORES

			IF .A1NODE[IDATTRIBUT(STORD)] THEN
			IF .A1NODE[OPR1] EQL OPR1C(DATAOPR,FORMLVAR) THEN
			BEGIN
				!THINGS ARE DIFFERENT IF GLOBAL
				!ALLOCATION OF AN ARGIMENT HAS
				!OCCURRED
				IF NOT .ARGLSTPT[.I,ENTGALLOCFLG] THEN
				BEGIN
					!LOCAL CASE
					!SET REGFORCOMP
					REGFORCOMP_(IF .ENTSTMN[VALINR0] THEN
					1^23 ELSE 0);
					C1H_INDBIT OR (.I-1);
%[761]%					OPDSPIX_.A1NODE[VALTP1]+OPGETI;
					CGOPGEN();
%[761]%					OPDSPIX_.A1NODE[DBLFLG]+OPINSI;
					CGOPGEN();
				END ELSE
				BEGIN
					!GLOBALLY ALLOCATED
					REGFORCOMP_.ARGLSTPT[.I,ENTAC]^23;
					C1H_INDBIT OR (.I-1);
%[761]%					OPDSPIX_.A1NODE[DBLFLG]+OPINSI;
					CGOPGEN();
				END;
			END;
		END;
	END;

	!RESTORE REGISTERS IF NEED BE
	IF .ENTSTMN[SRCID] EQL SFNID THEN
		OPDSPIX_OPGPPR
	ELSE
%[761]%		OPDSPIX_OPGETI;
	NAME_IDTAB;
	IF .FLGREG<PROGTYP> EQL FNPROG THEN
	BEGIN
		!***********************************
		!NOTE:
		!SINCE STATEMENT FUNCTIONS PUSH AND POP
		!FOR REGISTER SVAE RESTORE THESE MUST
		!BE SYMETRICALLY REVERSE TO THE SAVE
		!CODE IN THE PROLOGUE
		!************************************

			INCR I FROM 2 TO LASTONE(.CLOBBREGS) DO
			BEGIN
				IF .ENTSTMN[SRCID] EQL ENTRID THEN
				BEGIN
					ENTRY_TNAME(.I);
					A1NODE_TBLSEARCH();
				END;
				REGFORCOMP_.I^23;
				CGOPGEN();
			END;

		A1NODE_.ENTSTMN[ENTSYM];	!NAME OF FN

		IF NOT .A1NODE[IDATTRIBUT(STORD)]	!IF THE FN VALUE IS NEVER STORED
			AND NOT .ENTSTMN[SRCID] EQL SFNID
		THEN FATLERR(.ISN,E131<0,0>);


		!PICK UP RETURN FUNCTION VALUE
		!IF NOT ALREADY PUT THERE BY GLOBAL ALLOCATOR
		IF NOT .ENTSTMN[VALINR0] THEN
		BEGIN
			REGFORCOMP_0;
%[761]%			OPDSPIX_.A1NODE[VALTP1]+ OPGETI;
			CGOPGEN();
		END;
	END;
	OPDSPIX_POPRET;
	CGOPGEN();
END;	!END OF ROUTINE "CGEPILOGUE"


	!MACRO TO GENERATE AN INDIRECT JRST THROUGH A VRIABLE
	!DIFFERS FROM JRSTIGEN IN THE SETTING OF PSYMPTR

	MACRO JRSTIVAR(ADDR)=
	BEGIN
		PBOPWD_JRSTOC OR INDBIT OR ADDR[IDADDR];
		PSYMPTR_ADDR;
		OBUFF();
	END$;

GLOBAL ROUTINE CGRETURN(EXPR)=
BEGIN
%(******************************************
		RETURN STATEMENT
		EXPR POINTS TO THE RETURN EXPRESSION
******************************************)%


!GENERATE SETZ 1 FOR PLAIN RETURN WHEN THERE ARE LABELS AS PARAMETERS

MACRO SET1ZGEN=
BEGIN
	REGFORCOMP_1^23;
	OPDSPIX_OPGSET+1;
	CGOPGEN();
END$;

	EXTERNAL FATLERR,E130;
	EXTERNAL MOVRET,CGETVAL;
	EXTERNAL PBOPWD,OPDSPIX,PSYMPTR,OBUFF,OPGSET,CGOPGEN,REGFORCOMP;
%[761]%	EXTERNAL TREEPTR,A1NODE,CSTMNT,OPGETI,PROGNAME,CGEND;

	REGISTER BASE NXTSTMNT;	!PTR TO NEXT STMNT
	MAP PEXPRNODE TREEPTR:A1NODE:CSTMNT;
	MAP BASE EPILAB;
	MAP PEXPRNODE EXPR;



	%(***IF THIS IS A MULTIPLE RETURN AND THERE WERE NO LABEL ARGS,
		GIVE AN ERROR MESSAGE**)%
	IF .EXPR NEQ 0 AND NOT .FLGREG<LABLDUM> THEN FATLERR(.ISN,E130<0,0>);

	IF (NXTSTMNT_.CSTMNT[CLINK]) NEQ 0	!STMNT FOLLOWING THE RETURN
	THEN				! (IF THE RETURN WAS NOT THE BRANCH OF A LOG IF)
	BEGIN
		IF .NXTSTMNT[SRCID] EQL CONTID	!SKIP THE "CONTINUE" INSERTED
						! BY THE OPTIMIZER
		!MAKE SURE IT IS A DUMMY CONTINUE STATEMENT BY
		! CHECKING FOR ZERO SOURCE STATEMENT NUMBER
		THEN IF .NXTSTMNT[SRCISN] EQL 0
		THEN NXTSTMNT_.NXTSTMNT[CLINK];

		!IF THERE ARE NOT LABEL ARGUMENTS AND THE NEXT STATEMENT
		!IS IS THE END STATEMENT THEN DO NOT GENERATE
		!THE RETURN. IT WILL BE PART OF THE END CODE

		IF NOT .FLGREG<LABLDUM> THEN
			IF .NXTSTMNT[SRCID] EQL ENDID
				THEN RETURN;

	END;


	!A RETURN THAT APPEARS IN A MAIN PROGRAM SHOULD BE
	!TREATED LIKE A CALL EXIT. THIS IS  ACCOMPLISHED BY CALLING CGEND

	IF .FLGREG<PROGTYP> EQL MAPROG THEN
		(CGEND(); RETURN);



	!SINGLE ENTRY
	IF NOT .FLGREG<MULTENT> THEN
	BEGIN
		!LABELS OR NOT
		IF  NOT .FLGREG<LABLDUM> THEN
			JRSTGEN(.EPILAB)
		ELSE
		!LABELS ARE ARGS
		BEGIN
			IF .EXPR EQL 0 THEN		!PLAIN VANILLA  RETURN
			BEGIN					!RETURN THRU A LABEL
				SET1ZGEN;
			END ELSE
			BEGIN
				TREEPTR_.EXPR;
				IF .TREEPTR[OPRCLS] EQL DATAOPR THEN	!EXPRESSION IS DATAITEM
				BEGIN
					REGFORCOMP_1^23;
					A1NODE_.TREEPTR;
%[761]%					OPDSPIX_.A1NODE[VALTP1] + OPGETI;
					CGOPGEN();
				END ELSE
				BEGIN
					CGETVAL();
					!IF THE REGISTER ALLOCATOR DIDNT PUT IT IN 1
					!WHICH IT NEVER WILL DO. THEN MOVE IT TO 1
					IF .EXPR[TARGTAC] NEQ 1 THEN MOV1GEN(.EXPR[TARGTAC]);
				END;
			END;
			JRSTGEN(.EPILAB);
		END;
	END ELSE
	!MULTIPLE ENTRIES
	BEGIN
		!LABELS OR NOT
		IF NOT .FLGREG<LABLDUM> THEN
			JRSTIVAR(.EPILAB)
		ELSE
		!LABELS AS ARGS WITH MULTIPLE ENTRIES
		BEGIN
			IF .EXPR EQL 0 THEN		!PLAIN VANILLA RETURN
			BEGIN
				SET1ZGEN;
			END ELSE
			BEGIN					!RETURN THRU A LABEL
				TREEPTR_.EXPR;
				IF .TREEPTR[OPRCLS] EQL DATAOPR THEN	!EXPRESSION IS DATAITEM
				BEGIN
					REGFORCOMP_1^23;
					A1NODE_.TREEPTR;
%[761]%					OPDSPIX_.A1NODE[VALTP1] + OPGETI;
					CGOPGEN();
				END ELSE
				BEGIN
					CGETVAL();
					!IF IT SI NOT ALREADY IN AC1 MOVE IT THERE
					IF .EXPR[TARGTAC] NEQ 1 THEN MOV1GEN(.EXPR[TARGTAC]);
				END;
			END;
			JRSTIVAR(.EPILAB);
		END;
	END;
END;



GLOBAL ROUTINE CGSFN=
BEGIN
	!CODE GENERATION FOR STATEMENT FUNCTION
	OWN OCSTMNT,OCLOBB,OPRGM,OPE,SFNSYM,OEPILB;
	EXTERNAL CSTMNT,CLOBBREGS,PROGNAME,CGASMNT;
	MAP BASE CSTMNT:SFNSYM;
	EXTERNAL CGPROEPI,CGRETURN,DEFLAB;
	!SAVE AWAY PERTINENT GLOBALS

	OCLOBB_.CLOBBREGS;
	OPRGM_.PROGNAME;
	OPE_.FLGREG<0,36>;
	OCSTMNT_.CSTMNT;
	OEPILB_.EPILAB;

	!ADJUST FLGREG
	FLGREG<PROGTYP>_FNPROG;
	FLGREG<MULTENT>_0;
	FLGREG<LABLDUM>_0;
	CLOBBREGS<LEFT>_.CSTMNT[SFNCLBREG];
	SFNSYM_.CSTMNT[SFNNAME];
	PROGNAME_.SFNSYM[IDSYMBOL];
	CGPROEPI();				!GENERATE PROLOGUE & EPILOGUE
	CSTMNT_.CSTMNT[SFNEXPR];
	CGASMNT();				!GENERATE CODE FOR STATEMENT
	CGEPILOGUE(.OCSTMNT);		!GENERATE THE EPILOGUE CODE
	!PUT SAVED VALUES BACK
	CLOBBREGS_.OCLOBB;
	PROGNAME_.OPRGM;
	FLGREG<0,36>_.OPE;
	CSTMNT_.OCSTMNT;
	EPILAB_.OEPILB;
	DEFLAB(.JMPSFN);
END;
GLOBAL ROUTINE CGSBPRGM(ARLISTT,NAMEP)=
BEGIN
	%(******************************
		PERFORM VITAL CODE GENERATION
		FOR CALLS, FUNCTION REFERENCES
		AND STATEMENT FUNCTION REFERENCES
		AND LIBRARY FUNCTION REFERENCES
	******************************)%
	EXTERNAL ARGLINKPT,GENLAB,CGOPGEN,OPDSPIX,A1LABEL,A2LABEL;
	EXTERNAL TREEPTR,CGETVAL,OPGSFN,ZERBLK;
	EXTERNAL NEDZER;	! FLAG TO INDICATE IF ZERO-ARG-BLOCK NEEDED
%[761]%	EXTERNAL A1NODE,CALLER,TBLSEARCH,REGFORCOMP,OPGSTI;
	MAP BASE NAMEP;
	MAP ARGUMENTLIST ARLISTT;
	!ARLISTT IS A POINTER TO THE ARGUMENT LIST.
	!NAMEP IS A POINTER TO THE SYMBOL TABLE
	!	ENTRY FOR THE ROUTINE NAME.
	!LINK INTO ARGLIST

	!FIRST CHECK FOR THE PRESENCE OF ARGUMENTS
	IF .ARLISTT NEQ  0 THEN
	BEGIN
	IF .ARGLINKPT NEQ 0 THEN ARLISTT[ARGLINK]_.ARGLINKPT;
	ARGLINKPT_.ARLISTT;

	!GENERATE CODE TO EVALUATE ARGUMENTS, IF NEEDED
	INCR I FROM 1 TO .ARLISTT[ARGCOUNT] DO
	BEGIN
		REGISTER BASE T;
		T_.ARLISTT[.I,ARGNPTR];	!PICK UP ARG PTR
		IF NOT .ARLISTT[.I,AVALFLG]
		THEN
		BEGIN
			TREEPTR_.T;
			CGETVAL();
		END ELSE
		BEGIN
			!IF ITS A REGISTER AND A LIBRARY FUNCTION
			!STASH IT AWAY IN MEMORY. IF ITS A REGISTER
			!AND NOT A LIBRARY FUNCTION THEN YOU LOSE
			IF .T[OPRCLS] EQL REGCONTENTS THEN
				BEGIN
					MAP PEXPRNODE TREEPTR;
					TREEPTR_.T[ARG2PTR];
					REGFORCOMP_.T[TARGTAC]^23;
					OPDSPIX_STOROPIX(TREEPTR);
					CGOPGEN();
					!TAKE THE REGCONTENTS NODE OUT
					!SO THE ARG LIST WILL BE RIGHT
					ARLISTT[.I,ARGNPTR]_.T[ARG2PTR];
				END;
		END;
	END;
	!SHOULD TEST FOR THIS BEING A LIBRARY FUNCTION
	!TO GENERATE A DIFFERENT NAME. NOT IN RELEASE 1.
	!**********************************
	A1LABEL_ARLISTT[ARGLABEL]_GENLAB();
	END ELSE			!FOR ARGUMENTS ONLY
	!IN THE CASE OF NO ARGS REFERENCE A 2 WORD, DEFINED ONLY ONCE
	!ZERO ARG BLOCK
		(NEDZER _ 1; A1LABEL_.ZERBLK;);	! FLAG ZERO-ARG-BLOCK NEEDED

	!FOR A FORMAL FUNCTION SET THE INDIRECT BIT IN TH SYMBOL TABLE
	IF .NAMEP[IDATTRIBUT(DUMMY)] THEN
		NAMEP[TARGET]_.NAMEP[TARGET] OR INDBIT;

	IF .NAMEP[IDATTRIBUT(SFN)] THEN
	BEGIN
		A2LABEL_.NAMEP[IDSFNLAB];
		OPDSPIX_OPGSFN;
	END ELSE
	BEGIN
		A1NODE_.NAMEP;
		OPDSPIX_CALLER;
	END;
	CGOPGEN();
END;

GLOBAL ROUTINE ARGGEN(PTR)=
BEGIN
	MAP PEXPRNODE PTR;
	EXTERNAL EVALU,OBUFFA,PSYMPTR,PBOPWD,CGERR;
%[1002]%	MAP EVALTAB EVALU;
	MAP OBJECTCODE PBOPWD;
	!FOR A FORMAL ARRAY TURN ON THE INDIRECT BIT
	IF .PTR[OPR1] EQL OPR1C(DATAOPR,FORMLARRAY) THEN
	BEGIN
		PSYMPTR_.PTR;
![1002] fold in /GFLOATING to get arg type
%[1002]%		PBOPWD_.EVALU[.PTR[VALTYPE]]^23+.PTR[IDADDR]+INDBIT;
	END ELSE


	IF .PTR[OPRCLS] EQL DATAOPR THEN
	BEGIN
		!IF IT IS A FORMAL AND ALSO DECLARED EXTERNAL WE WANT
		!TO SET THE INDIRECT BIT ON THE ARGLIST. IT MAY ALREADY
		!HAVE BEEN SET IF IT WAS PREVIOUSLY REFERENCED AS A
		!FORMAL FUNCTION. THAT IS WAY THERE IS AN OR INSTEAD
		!OF A +.

		IF .PTR[FORMLFLG] AND .PTR[IDATTRIBUT(INEXTERN)] THEN
		BEGIN
![1002] fold in /GFLOATING to get arg type
%[1002]%			PBOPWD_.EVALU[.PTR[VALTYPE]]^23 + .PTR[TARGTMEM]
				OR INDBIT;
			PSYMPTR_.PTR;
		END ELSE
		BEGIN
![1002] fold in /GFLOATING to get arg type
%[1002]%		PBOPWD_.EVALU[.PTR[VALTYPE]]^23 + .PTR[TARGTMEM];
		PSYMPTR_.PTR;
		END;
	END ELSE
	IF .PTR[OPRCLS] EQL LABOP THEN
	BEGIN
		PBOPWD_ADDRTYPE^23+.PTR;
		PSYMPTR_PBFLABREF;
	END ELSE
	IF .PTR[OPRCLS] EQL ARRAYREF
	THEN
	BEGIN
		%(***FOR AN ARRAYREF, THE TARGET FIELD OF THE EXPRESSION NODE CONTAINS
			THE RELATIVE ADDRESS. ARG1PTR POINTS TO THE SYMBOL
			TABLE ENTRY***)%
![1002] fold in /GFLOATING to get arg type
%[1002]%		PBOPWD_.EVALU[.PTR[VALTYPE]]^23 + .PTR[TARGADDR];
		PSYMPTR_.PTR[ARG1PTR];

		%(***AN ARRAYREF-NODE IS FOUND DIRECTLY UNDER AN EXPRESSION NODE
			ONLY IF THE ADDRESS CALCULATION IS ENTIRELY CONSTANT.
			(IF THERE IS A VARIABLE PART, WILL HAVE INSERTED A NODE
			TO STORE A PTR TO THE ELEMENT INTO A TEMPORARY)***)%
		IF .PTR[ARG2PTR] NEQ 0 THEN CGERR();

	END
	ELSE
	BEGIN
		REGISTER BASE T;	!A TEMP
		!PICK UP THE TEMP IN WHICH THE RESULT VALUE WILL
		!WILL BE STORED. THIS IS THE *REAL* ARG
		T_.PTR[TARGADDR];
		PSYMPTR_.T;
![1002] fold in /GFLOATING to get arg type
%[1002]%		PBOPWD_.EVALU[.PTR[VALTYPE]]^23+.T[IDADDR];
		PBOPWD[OTSIND]_.PTR[TARGIF];
	END;
	OBUFFA();
END;
GLOBAL ROUTINE CGARGS=
BEGIN
	%(******************************
		AT THE END OF A BLOCK
		GENERATE ARGUMENT LISTS AND
		CONSTANTS NOT ALREADY GENERATED
	******************************)%
	EXTERNAL CGOPGEN,DVALU,OPDSPIX,C1H;
	LABEL ARGBLK;
	EXTERNAL ARGLINKPT,DEFLAB,PBOPWD;
	LOCAL ARGLSTPT,ARGCT,ARGS;
	MAP BASE ARGLINKPT:ARGS;
	EXTERNAL PSYMPTR,OBUFFA;
	MAP ARGUMENTLIST ARGLSTPT;
	!INSERT TEST FOR REALLY END OF
	!PROGRAM AND OTHERWISE GENERATE A
	!JRST AROUND
	WHILE .ARGLINKPT NEQ 0 DO
	ARGBLK:
	BEGIN
		ARGLSTPT_.ARGLINKPT;
		!WATCH OUT FOR STATEMENTS THAT MAY HAVE
		!BEEN DELETED BY FOLDING. ARGLABEL IS 0 FOR
		!THESE STATEMENTS.
		IF .ARGLSTPT[ARGLABEL] NEQ 0 THEN
		BEGIN
			ARGCT_.ARGLSTPT[ARGCOUNT];
			PBOPWD_-.ARGCT^18;
			PSYMPTR_PBF2NOSYM;
			OBUFFA();
			PBOPWD_0;
			DEFLAB(.ARGLSTPT[ARGLABEL]);
			INCR I FROM 1 TO .ARGCT DO
			BEGIN
				ARGS_.ARGLSTPT[.I,ARGNPTR];
				ARGGEN(.ARGS);
				PBOPWD_0;
			END;
		END;
		ARGLINKPT_.ARGLINKPT[CLINK];	!WHEN DONE THIS WILL BE
						!REINITIALIZED TO 0
	END;
END;
END
ELUDOM