Google
 

Trailing-Edge - PDP-10 Archives - FORTRAN-10_V7wLink_Feb83 - 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) DIGITAL EQUIPMENT CORPORATION 1972, 1983
!AUTHOR NORMA ABEL/HPW/MD/DCE/SJW/RDH/TFV/CKS/AHM/CDM/RVM

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

GLOBAL BIND CGDOV = 7^24 + 0^18 + #1562;	! Version Date:	18-Jun-82


%(

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

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

146	1206	DCE	20-Mar-81	-----
	For real DO loops, put out potential jump around (zero trip F77)
	together with a label for it, and be sure to make "final" loop value
	available at end of loop.

147	1227	CKS	22-Jun-81
	Use CONST2L instead of CW4L to access LH of constant AOBJN pointer.

148	1253	CKS	11-Aug-81
	When ARGGEN is doing a character arrayref node, point symbol table
	pointer at the .Q temp (from TARGADDR) not the array name
	(from ARG1PTR).

149	1266	TFV	5-Oct-81	------
	Add code to copy 1 or 2 words of descriptor for character formal
	at subroutine entrance.  Don't copy it back on subroutine exit.
	Fix up lots of code and comments to look nice.

150	1276	DCE	21-Oct-81	-----
	Only materialize loop variable at normal exit if /F77 given.

151	1400	CKS	21-Oct-81
	In CGSBPRGM, check for function call with zero arguments and use ZERBLK

152	1401	AHM	2-Oct-81
	Make ARGGEN emit arg block entries that are IFIWs.  Do the  same
	in CGPROEPI  for  the vector  of  addresses that  point  into  a
	subroutine's arg  block used  for  multiple returns.   Delete  a
	macro that  fudged over  misspellings  of ENTLIST  in  CGPROEPI.
	Rework and pretty up ARGGEN and CGARGS.  Put form feeds  between
	all routines in this module.

153	1422	TFV	12-Nov-81	------
	Fix CGEPILOGUE  to handle  character functions.   The result  of
	character functions is  not returned in  AC0, AC1.  Instead  the
	first argument has the descriptor for the result.

154	1437	CDM	16-Dec-81	------
	Save address call in CGARGS to a subprogram for argument checking
	processing.

155	1455	TFV	5-Jan-82	------
	Modify CGSFN  for  character statement  function.   A  statement
	function is turned into either a call to CHSFN.  (the subroutine
	form of CHASN.)  or  a call to CHSFC.   (the subroutine form  of
	CONCA.).  CHSFC.   is  used  if  the  character  expression  has
	concatenations at its top  level, CHSFN. is  used for all  other
	character expressions.  Modify  CGSBPRGM so it  doesn't set  the
	indirect bit for character statement function names.

156	1466	CDM	2-Feb-82
	Modified CGARGS to allow zero argument blocks to be allocated if
	/DEBUG:ARGUMENTS is specified.

1505	AHM	9-Mar-82
	Set the IDPSECT field in symbol table enties for .A00nn  temps
	to .DATA.  Also optimize macro TNAME by removing a LSH and two
	adds.

1524	RVM	31-Mar-82
	Don't turn on the indirect bit of an argument block entry for
	an argument of type dummy character function.

1526	AHM	27-Apr-82
	Don't subtract HIORIGIN from  the address of subroutine  calls
	when saving them for argument checking in CGARGS, since we now
	never add it in in the first place.

1533	TFV	17-May-82
	Modify CGSBPRGM for dynamic concatenations.  Call CHMRK.  before
	the subprogram  call  and  call  CHUNW.  after.   If  there  are
	multiple returns, generate error handling code to do the  CHUNW.
	call and then JRST to the user label.

1562	TFV	18-Jun-82
	Fix CGSBPRGM to only check ARGMARK if there is an argument list.

1613	CDM	13-Aug-82
	Change /DEBUG:PARAMETERS to /DEBUG:ARGUMENTS.

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

)%

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

OWN
	JUMPABOUT,
	JMPVECT,
	LABARGCT,
	JMPSFN,
%1505%	BASE EPILAB;	! Holds pointer to labels  of epilogue code  and
			! STE of  temp that  holds  the address  of  the
			! proper epilogue at runtime

FORWARD
	CGDOLOOP,
	CGDOEND(1),
	CGPROEPI ,
	CGEPILOGUE(1),
	CGRETURN(1),
	CGSFN,
	CGSBPRGM(2),	! Generate code for a subroutine call
	ARGGEN(1),
	CGARGS;

EXTERNAL 
	A1LABEL,
	A2LABEL,
	ARGLINKPT,	! Points to linked list of arg blocks
	CGASMNT,
%1533%	CGCHMRK,	! Generate code for a CHMRK. call
%1533%	CGCHUNW,	! Generate code for a CHUNW. call
	CGCMNSUB,	! Generate code for common subs
	CGERR,
	CGOPGEN,	! Code generation routine
	CLOBBREGS,
	CSTMNT,
	DEFLAB,		! Defines a label
%674%	DOSTAK,
	E131,
%674%	E144,	! Error message declarations
	GENLAB,
	FATLERR,
	LASTONE,
%1533%	OBUFF,
	OBUFFA,		! Outputs a word
%1401%	OIFIW,		! Makes the word in PBOPWD into an IFIW
			!  and writes it out with OBUFFA
	OPDSPIX,
	PBOPWD,		! Holds data word to output
	PROGNAME,
	PSYMPTR;	! Holds relocation info for OBUFFA



GLOBAL ROUTINE CGDOLOOP=
BEGIN
	! Code generator drivers for DO loops

%1206%	EXTERNAL DOZJMP,A1LABEL;
	EXTERNAL TREEPTR,A1NODE,A2NODE,REGFORCOMP,CSTMNT;
	EXTERNAL DOSTI;
%761%	EXTERNAL CGETVAL,OPGETI,DOSP,OPGSTI,DOSTC;

	MAP BASE DOSP:A1NODE:CSTMNT:TREEPTR;
	OWN PEXPRNODE DOCEXPR;	! Ptr to expression for control wd
	LOCAL	CTLREG,		! Control word register
		IVALREG;	! Initial value register

	IF .CSTMNT[SRCCOMNSUB] NEQ 0	! Gen code for any common subs
	THEN CGCMNSUB();

	CTLREG = .CSTMNT[DOCREG]^23;	! Set up local values
	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]	! If the ctl is in an AOBJN wd
%761%		THEN	OPDSPIX = OPGETI
		ELSE	OPDSPIX = DOGETAOPIX(.CSTMNT[CTLIMMED], .A1NODE[VALTP1],.CSTMNT[CTLNEG]);
		CGOPGEN();
	END;

	! Control word is now in a register
	! Get the initial 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;

%1206%	! If this is a potential zero trip loop, we need a label to
%1206%	! jump to at the end of the loop...
%1206%	! Also code to jump around the loop if appropriate.

%1206%	IF F77 THEN
%1206%	IF .CSTMNT[MAYBEZTRIP] NEQ 0 THEN
%1206%	BEGIN
%1206%		EXTERNAL PBOPWD,PSYMPTR,OBUFF;
%1206%		CSTMNT[DOZTRLABEL] = A1LABEL = GENLAB();
%1206%		REGFORCOMP = .CTLREG;

%1206%		IF .CSTMNT[FLCWD] AND NOT .CSTMNT[NEDSMATRLZ] ! Trip count constant
%1227%		AND .DOCEXPR[CONST2L] EQL 0	! Trip count zero
%1206%		THEN	JRSTGEN(.A1LABEL)	! Too late to delete the loop,
%1206%						! but we can still jump around it!
%1206%		ELSE
%1206%		BEGIN	! Put out a JUMPGE on negative count
%1206%			OPDSPIX = DOZJMP;
%1206%			CGOPGEN()
%1206%		END
%1206%	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;	! CGDOLOOP

GLOBAL ROUTINE CGDOEND(TLAB)=
BEGIN

![761] OPGARG for /GFLOATING code generation
	EXTERNAL REGFORCOMP,TREEPTR,
%761%	A1NODE,A2NODE,DOSP,DOEND,OPGARG,OPGARI,OPGDOE;

%1206%	EXTERNAL OPGETI,OPGDOS,OPGSTI,DOSTI;
	MAP BASE TLAB;
	MAP BASE A1NODE:DOSP:A2NODE:TREEPTR;

	! TLAB points to label table entry for 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

	WHILE .NXTWD NEQ 0 DO
	BEGIN
		CURDO = .NXTWD[LEFTP];

		! If the loop is still there

%1206%		IF .CURDO NEQ 0 THEN
		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 materialize 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	! Generate AOBJN CREG,A1LABEL

				A1NODE = .CURDO[DOCTLVAR];	! Temp for contol word
				REGFORCOMP = .CURDO[DOCREG]^23;
				OPDSPIX = OPGDOE;
			END
			ELSE
			BEGIN

				! For cases other than AOBJN - must generate
				! code to increment the loop index and code to
				! increment and test the control-word

				REGFORCOMP = .CURDO[DOIREG]^23;

				IF NOT .CURDO[NEDSMATRLZ] AND NOT .CURDO[MATRLZIXONLY]
				THEN
				BEGIN
					! If the loop index is not materialized
					! simply generate an add of the incr to
					! the reg holding the index

					A2NODE = .CURDO[DOSSIZE];	! ptr to incr

					IF (.CURDO[SSIZONE] OR .CURDO[SSIZIMMED])
					AND .A2NODE[VALTYPE] NEQ DOUBLPREC
					THEN	OPDSPIX = DOARITHOPIX(.A2NODE[VALTP1],0,1,.CURDO[SSIZNEGFLG])
					ELSE	OPDSPIX = DOARITHOPIX(.A2NODE[VALTP1],0,0,.CURDO[SSIZNEGFLG]);
					CGOPGEN();
				END
				ELSE
				IF (.CURDO[SSIZONE] AND NOT .CURDO[REALARITH])
	 				OR .CURDO[FLCWD]
				THEN
				BEGIN
					! If the loop index is materialized and
					! the increment is 1, generate AOS

					A1LABEL = .DOSP[RIGHTP];
					OPDSPIX = OPGDOS;	! Non-matrlize label

					A1NODE = .CURDO[DOSYM];
					CGOPGEN();
				END
				ELSE
				BEGIN
					! If the loop index needs to be materialized
					! pick up the increment and them add it
					! to memory if valtype is not double-prec
					A1NODE = .CURDO[DOSSIZE];
					IF (.CURDO[SSIZONE] OR .CURDO[SSIZIMMED])
					AND .A1NODE[VALTYPE] NEQ DOUBLPREC
					THEN OPDSPIX = DOGETAOPIX(1,.A1NODE[VALTP1],.CURDO[SSIZNEGFLG])
					ELSE OPDSPIX = 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]
%1206%					THEN	OPDSPIX = DOARITHOPIX(.A2NODE[VALTP1],1,1,0)
					ELSE
					BEGIN
						! Index to generate ADD to both
						! for REAL or INTEGER

						A1LABEL = .DOSP[RIGHTP];
						OPDSPIX = DOARBOTHOPIX(.A2NODE[VALTP1]);
					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 word is materialized

				OPDSPIX = OPGDOE+2+(.CURDO[NEDSMATRLZ] OR .CURDO[MATRLZCTLONLY]);
				A1NODE = .CURDO[DOCTLVAR];
			END;
			CGOPGEN();

%1206%			! If a zero trip label is required, put one out.
%1206%			! Also make sure that the final loop value gets
%1206% 			! generated - handle all the various cases.

%1206%			IF .CURDO[DOZTRLABEL] NEQ 0 
%1206%			THEN DEFLAB(.CURDO[DOZTRLABEL]);

!**;[1276], CGDOEND, DCE, 21-Oct-81
%1276%			IF F77 THEN	! Need to get final value to variable
%1206%			IF NOT .CURDO[MAYBEZTRIP]
%1206%			AND (.CURDO[NEDSMATRLZ] OR .CURDO[MATRLZIXONLY])
%1206%			THEN BEGIN END ! Already got the index materialized
%1206%			ELSE	IF .CURDO[FLCWD] 	! Need to get the final value for loop variable 
%1206%				THEN
%1206%				BEGIN
%1206%					A1NODE = .CURDO[DOSYM];
%1206%					REGFORCOMP = .CURDO[DOCREG]^23;
%1206%					OPDSPIX = DOSTI;
%1206%					CGOPGEN();
%1206%				END
%1206%				ELSE
%1206%				BEGIN
%1206%					REGFORCOMP = .CURDO[DOIREG]^23;
%1206%					TREEPTR = .CURDO[DOSYM];
%1206%					OPDSPIX = STOROPIX(TREEPTR);
%1206%					CGOPGEN();
%1206%				END;
		END;	! Do loop really there test

		NXTLNK = .NXTWD[RIGHTP];
		NXTWD = .NXTLNK;

	END;	! WHILE .NXTWD NEQ 0 DO
END;	! CGDOEND;

MACRO TNAME(INDX)=

	! Defines .A00nn temp names to save the registers used in  the
	! function.  .A0002 to .A0016  are for register saves,  .A0017
	! holds the epilogue address if there are multiple entries.

%1505%	(SIXBIT '.A0000'+(((INDX) AND #70)^3)+((INDX) AND #7))$;


MACRO MOV1GEN(SRCE)=
BEGIN
	! Generate a MOVE 1,SRCE

	EXTERNAL C1H;
	OPDSPIX = MOVRET;
	C1H = SRCE;
	CGOPGEN();
END$;

GLOBAL ROUTINE CGPROEPI =
BEGIN
	! Generate subroutine prologue and epilogue, using temps
	! .A0002 to .A0017

	OWN PEXPRNODE ENTNAME;
	LOCAL ARGLSTPT,NEDTOSAV;
	EXTERNAL OPGADJ,A2LABEL;
	EXTERNAL OPGMVL;
%761%	EXTERNAL OPGPHR,OPGPPR,DVALU,OPINSI,CLOBBREGS;
	EXTERNAL OUTMOD,PBFPTR,PBUFF,PBOPWD,OBUFF,OBUFFA,PSYMPTR,C1H;
	EXTERNAL CSTMNT,NAME,TBLSEARCH,ENTRY,POPRET,CRETN,PROGNAME;
%761%	EXTERNAL REGFORCOMP,A1NODE,OPINDI,OPGETI;
%1505%	EXTERNAL BASE TREEPTR;
%1266%	EXTERNAL OPIND2,OPGST2,OPGSTI;
	EXTERNAL XCTFDDT;
	MAP PPEEPFRAME PBFPTR;
	EXTERNAL ARGLINKPT;
	MAP PEXPRNODE CSTMNT:A1NODE;
	MAP ARGUMENTLIST ARGLSTPT;
	MAP PEEPFRAME PBUFF;
	EXTERNAL OUTMDA,OPGIIN;

	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 epilogue

	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 next 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 LINK

	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 .FLGREG<MULTENT>
	THEN
	BEGIN	! If multiple entries

		REGFORCOMP = 1^23;	! Hope to generate MOVEM 1, A0017
		A1LABEL = .EPILAB;
		OPDSPIX = OPGMVL;
		NAME = IDTAB;
		ENTRY = TNAME(#17);
		A1NODE = TBLSEARCH();
%1505%		A1NODE[IDPSECT] = PSDATA;	! .A0017 goes in .DATA.

		CGOPGEN();
	END;

	! Save register 16 except if its a statement function or a function
	! that does not call FOROTS or any other functions use PUSH for sfn
	! MOVEM 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();
%1505%			TREEPTR[IDPSECT] = PSDATA;	! .A0016 goes in .DATA.

			REGFORCOMP = #16^23;
			CGOPGEN();
		END
%761%		ELSE OPDSPIX = OPGSTI;	! Will store any other regs using MOVEM

	! Now if it is a function

	IF .FLGREG<PROGTYP> EQL FNPROG
	THEN	DECR I FROM LASTONE(.CLOBBREGS) TO 2 DO
		BEGIN
			IF .CSTMNT[SRCID] EQL ENTRID THEN
			BEGIN
				NAME = IDTAB;
				ENTRY = TNAME(.I);
				TREEPTR = TBLSEARCH();
%1505%				TREEPTR[IDPSECT] = PSDATA;	! In .DATA.
			END;
			REGFORCOMP = .I^23;
			CGOPGEN();
		END;

	! Move args to temps - address of temp is in symbol table for argument

	REGFORCOMP = 0;

%1401%	IF .CSTMNT[ENTLIST] NEQ 0 THEN
	BEGIN
%1401%		ARGLSTPT = .CSTMNT[ENTLIST];
		INCR I FROM 1 TO .ARGLSTPT[ARGCOUNT] DO
		BEGIN	! Walk down args

			TREEPTR = A1NODE = .ARGLSTPT[.I,ARGNPTR];

			IF .A1NODE NEQ 0 THEN		! Zero means label
			IF NOT .ARGLSTPT[.I,ENTNOCOPYFLG]
			THEN
			BEGIN	! Local copy is to be made of this param

%1266%				! For character formals copy the descriptor
%1266%				! Always copy the byte pointer, copy the length
%1266%				! if the formal is length *

%1266%				IF .A1NODE[VALTYPE] EQL CHARACTER
%1266%				THEN
%1266%				BEGIN
%1266%					IF .A1NODE[IDCHLEN] EQL LENSTAR
%1266%					THEN	OPDSPIX = OPIND2	! Copy BP and length
%1266%					ELSE	OPDSPIX = OPINDI;	! Copy BP only
%1266%					C1H = INDBIT OR (.I - 1);	! Set indirect bit and Y field
%1266%				END
%1266%				ELSE
%1266%				BEGIN	! Not character

					IF .A1NODE[OPR1] EQL OPR1C(DATAOPR,FORMLVAR)
					THEN
					BEGIN	! Move value of scalar to register

%761%						OPDSPIX = .A1NODE[VALTP1] + OPINDI;
%761%						C1H = INDBIT OR (.I-1);
					END
					ELSE
					BEGIN
						OPDSPIX = OPGIIN;
						C1H = INDBIT OR (.I-1);
					END
%1266%				END;	! Not character

				! Pick up register from entac field

				REGFORCOMP = .ARGLSTPT[.I,ENTAC]^23;
				CGOPGEN();	! Value now in a register

				! Now store value or pointer in temp

%1266%				IF .A1NODE[VALTYPE] EQL CHARACTER
%1266%				THEN	IF .A1NODE[IDCHLEN] EQL LENSTAR
%1266%					THEN	OPDSPIX = OPGST2	! Copy BP and length
%1266%					ELSE	OPDSPIX = OPGSTI	! Copy BP only
%1266%				ELSE	IF .A1NODE[OPR1] EQL OPR1C(DATAOPR,FORMLVAR)
%761%					THEN	OPDSPIX = .A1NODE[DBLFLG]+OPGSTI
%761%
					ELSE	OPDSPIX = OPGSTI;

				! Only do store if not globally allocated

				IF NOT .ARGLSTPT [.I, ENTGALLOCFLG]
				THEN
				BEGIN
					! Save current indirect flag of formal,
					! turn off indirect flag then generate
					! store code and restore indirect flag

					NEDTOSAV = .A1NODE[IDTARGET] AND INDBIT;
					A1NODE[IDTARGET] = .A1NODE[IDTARGET] AND (NOT INDBIT);
					CGOPGEN ();
					A1NODE[IDTARGET] = .A1NODE[IDTARGET] OR .NEDTOSAV;
				END;
			END;	! Local copy is to be made of this param
		END;	! Walk down args
	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 JUMPABOUT = GENLAB();	! Already have label if
							! jumpabout is set

	! If there were label dummy args

	IF .FLGREG<LABLDUM>
	THEN
	BEGIN	! Make this JRST the base of the jump vector 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) or multiple entries.  This entry follows the prologue

	IF .FLGREG<LABLDUM> OR .FLGREG<MULTENT> THEN JRSTGEN(.JUMPABOUT);

	! Now the rest of the jump vector if needed

	IF .CSTMNT[SRCID] NEQ SFNID	! Don't need it if it's an arithmetic statement function
	THEN	
	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;
	
%1401%			IF .CSTMNT[ENTLIST] NEQ 0 THEN
			BEGIN
%1401%				ARGLSTPT = .CSTMNT[ENTLIST];
				INCR I FROM 1 TO .ARGLSTPT[ARGCOUNT] DO
				BEGIN
					IF .ARGLSTPT[.I,ARGNPTR] EQL 0
					THEN	! It is a label
					BEGIN
						! Generate @N-1(16) (which is
						! added to the value of the
						! are list base by a RETURN N)

						LABARGCT = .LABARGCT+1;
%1401%						PSYMPTR = PBF2NOSYM;
%1401%						PBOPWD=(#36^18) OR (.I-1);
%1401%						OIFIW()
					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 label of first executable statement

	DEFLAB(.JUMPABOUT);

	! 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;	! CGPROEPI


GLOBAL ROUTINE CGEPILOGUE(ENTSTMN)=
BEGIN
	! Routine to generate code for function/subroutine epilogue. ENTSTMN
	! points to the entry statement to which this epilogue corresponds

	EXTERNAL A1NODE,C1H,REGFORCOMP;
	EXTERNAL PROGNAME;
	MAP PEXPRNODE A1NODE;
%761%	EXTERNAL OPGETI,POPRET,CRETN,OPINSI,OPGPPR;
	EXTERNAL CLOBBREGS,TBLSEARCH;
	EXTERNAL NAME;
	MAP BASE ENTSTMN;
	REGISTER ARGUMENTLIST ARGLSTPT;

	DEFLAB(.EPILAB);	! Define the epilogue label

	! Restore register 16. Statement functions and bottommost functions
	! won't restore 16 

	IF .ENTSTMN[SRCID] NEQ SFNID
		AND (NOT .BTTMSTFNFLG OR .IOFIRST NEQ 0 OR .LIBARITHFLG)
	THEN
	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

%1401%	IF .ENTSTMN[ENTLIST] NEQ 0 AND .ENTSTMN[SRCID] NEQ SFNID
	THEN
	BEGIN
		REGFORCOMP = 0;
%1401%		ARGLSTPT = .ENTSTMN[ENTLIST];
		INCR I FROM 1 TO .ARGLSTPT[ARGCOUNT] DO
		BEGIN	! Walk down args

			A1NODE = .ARGLSTPT[.I,ARGNPTR];

			IF .A1NODE NEQ 0 THEN
			IF NOT .ARGLSTPT[.I,ENTNOCOPYFLG]
			THEN
			BEGIN	! Local copy was made of this param

				! Only move them back if they were stored into,
				! else we are in trouble with generating hiseg
				! stores. Never copy back character descriptors

				IF .A1NODE[IDATTRIBUT(STORD)] THEN
%1266%				IF .A1NODE[VALTYPE] NEQ CHARACTER THEN
				IF .A1NODE[OPR1] EQL OPR1C(DATAOPR,FORMLVAR) THEN
				IF NOT .ARGLSTPT[.I,ENTGALLOCFLG] THEN
				BEGIN
					! Local case - set regforcomp.
					! Things are different if global
					! allocation of an argument has
					! occurred

					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;	! Local copy was made of this param
		END;	! Walk down args
	END;

	IF .ENTSTMN[SRCID] EQL SFNID	! Restore registers if need be
	THEN	OPDSPIX = OPGPPR
%761%	ELSE	OPDSPIX = OPGETI;

	NAME = IDTAB;

	IF .FLGREG<PROGTYP> EQL FNPROG
	THEN
	BEGIN
		!******************************************************
		! Since statement functions PUSH and POP for register
		! save and restore, these must be symetrically reversed
		! 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)]
			AND NOT .ENTSTMN[SRCID] EQL SFNID
		THEN FATLERR(.ISN,E131<0,0>);	! If the value is never stored

%1422%		! Pick up return function value  for if not already put  there
%1422%		! by global allocator.  Don't  do it for character  functions.
%1422%		! Character functions have  the descriptor for  the result  as
%1422%		! their first argument.

%1422%		IF NOT .ENTSTMN[VALINR0] THEN
%1422%		IF .A1NODE[VALTYPE] NEQ CHARACTER
		THEN
		BEGIN
			REGFORCOMP = 0;
%761%			OPDSPIX = .A1NODE[VALTP1]+ OPGETI;
			CGOPGEN();
		END;
	END;	! FNPROG

	OPDSPIX = POPRET;
	CGOPGEN();
END;	! CGEPILOGUE

MACRO JRSTIVAR(ADDR)=
BEGIN

	! Macro to generate an indirect JRST through a variable.
	! Differs from JRSTIGEN in the setting of PSYMPTR

	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 E130;
	EXTERNAL MOVRET,CGETVAL;
	EXTERNAL PBOPWD,PSYMPTR,OBUFF,OPGSET,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
	BEGIN	! If the return was not the branch of a log if skip the
		! CONTINUE inserted by the optimizer

		! Make sure it is a dummy continue statement by
		! checking for zero source statement number

		IF .NXTSTMNT[SRCID] EQL CONTID THEN
		IF .NXTSTMNT[SRCISN] EQL 0
		THEN NXTSTMNT = .NXTSTMNT[CLINK];

		! If there are not label arguments and the next statement 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
	BEGIN
		CGEND();
		RETURN
	END;

	IF NOT .FLGREG<MULTENT> THEN
	BEGIN	! Single entry

		IF  NOT .FLGREG<LABLDUM>
		THEN	JRSTGEN(.EPILAB)
		ELSE
		BEGIN	! Labels are args

			IF .EXPR EQL 0
			THEN	SET1ZGEN	! Plain vanilla return
			ELSE
			BEGIN	! Return thru a label

				TREEPTR = .EXPR;
				IF .TREEPTR[OPRCLS] EQL DATAOPR
				THEN
				BEGIN	! Expression is dataopr

					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;	! Labels are args
	END	! Single entry
	ELSE
	BEGIN	! Multiple entries

		IF NOT .FLGREG<LABLDUM>
		THEN	JRSTIVAR(.EPILAB)
		ELSE
		BEGIN	! Labels as args with multiple entries

			IF .EXPR EQL 0
			THEN	SET1ZGEN	! Plain vanilla return
			ELSE
			BEGIN	! Return thru a label

				TREEPTR = .EXPR;
				IF .TREEPTR[OPRCLS] EQL DATAOPR
				THEN
				BEGIN	! Expression is dataopr

					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;	! Labels as args with multiple entries
	END;	! Multiple entries
END;	! CGRETURN

GLOBAL ROUTINE CGSFN=
BEGIN

%1455%	! Rewritten by TFV on 5-Jan-82

	! Code generation for statement function

	OWN
		OCSTMNT,
		OCLOBB,
		OPRGM,
		OPE,
		SFNSYM,
		OEPILB;

	MAP
		BASE CSTMNT,
		BASE SFNSYM;

	! Save away pertinent globals

	OCLOBB = .CLOBBREGS;	! Current set of clobbered registers
	OPRGM = .PROGNAME;	! Program name for this unit
	OPE = .FLGREG<0,36>;	! Current flag register
	OCSTMNT = .CSTMNT;	! Current statement pointer
	OEPILB = .EPILAB;	! Current epilog label

	! Adjust flgreg

	FLGREG<PROGTYP> = FNPROG;	! This is a function subprogram
	FLGREG<MULTENT> = 0;		! Statement functions have one entry
	FLGREG<LABLDUM> = 0;		! No dummy labels

	! Setup clobbregs  with  registers clobbered  by  the  statement
	! function

	CLOBBREGS<LEFT> = .CSTMNT[SFNCLBREG];

	! Get the statement function name -  it is put out in SIXBIT  to
	! the .REL file for traceback

	SFNSYM = .CSTMNT[SFNNAME];
	PROGNAME = .SFNSYM[IDSYMBOL];	

	CGPROEPI();			! Generate prologue & epilogue
	CSTMNT = .CSTMNT[SFNEXPR];	! Get the assignment or call node

	IF .SFNSYM[VALTYPE] EQL CHARACTER
	THEN
	BEGIN	! Generate code for a call

		! Generate code for any common subs

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

		! Generate code for the call to CHSFN. or CHSFC.

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

	END	! Generate code for a call
	ELSE	CGASMNT();		! Generate code for an assignment

	CGEPILOGUE(.OCSTMNT);		! Generate the epilogue code

	! Restore the saved globals

	CLOBBREGS = .OCLOBB;		! Clobbered registers
	PROGNAME = .OPRGM;		! Program name
	FLGREG<0,36> = .OPE;		! Flag register
	CSTMNT = .OCSTMNT;		! Current statement
	EPILAB = .OEPILB;		! Epilog label

	DEFLAB(.JMPSFN);	! Define the label for the start of  the
				! statment function

END;	! CGSFN

GLOBAL ROUTINE CGSBPRGM(ARLISTT,NAMEP)=
BEGIN

	! Perform vital code generation for calls, function references
	! and statement function references and library function references

	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;
%1466%	LOCAL ARGFLG;		! Flag - Need an arg block
%1533%	LOCAL HASMULTRETS;	! Flag for has multiple returns
	REGISTER BASE ARGNODE;
%1533%	REGISTER MARK;		! The ARGMARK field
%1533%	REGISTER CURLBL;	! The label for the current location
%1533%	LOCAL JRSTPAST;		! The label for the instruction after the error
%1533%				! handling code

	! ARLISTT is a pointer to the argument list.  NAMEP is a pointer
	! to  the  symbol  table  entry   for  the  routine  name.    IF
	! /DEBUG:ARGUMENTS is  given, output  a  size zero  arglist  for
	! argument checking.
%1466%	ARGFLG _ 0;
%1533%	HASMULTRETS = FALSE;

	IF .ARLISTT NEQ 0
	THEN
%1562%	BEGIN	! Argument list present

%1613%		IF .ARLISTT[ARGCOUNT] NEQ 0  OR  .FLGREG<DBGARGMNTS>
%1466%		THEN ARGFLG _ 1;

%1533%		! If there  are  dynamic  concatenations  as  arguments,
%1533%		! generate the CHMRK. call

%1533%		MARK = .ARLISTT[ARGMARK];

%1562%	END	! Argument list present
%1562%	ELSE	MARK = 0;	! No argument list

%1533%	IF .MARK NEQ 0 THEN CGCHMRK(.MARK);

%1466%	IF .ARGFLG
	THEN
	BEGIN	! arguments present

		ARLISTT[ARGLINK] = .ARGLINKPT;
		ARGLINKPT = .ARLISTT;

		INCR I FROM 1 TO .ARLISTT[ARGCOUNT] DO
		BEGIN	! Generate code to evaluate arguments

			ARGNODE = .ARLISTT[.I,ARGNPTR];	! Pick up arg ptr

%1533%			! Set the flag if an argument is a label

%1533%			IF .ARGNODE[OPRCLS] EQL LABOP
%1533%			THEN HASMULTRETS = TRUE;

			IF NOT .ARLISTT[.I,AVALFLG]
			THEN
			BEGIN
				TREEPTR = .ARGNODE;
				CGETVAL();
			END
			ELSE
			BEGIN

				! If its a register and a library  function
				! stash  it  away  in  memory.  If  it's  a
				! register and not a library function  then
				! you lose

				IF .ARGNODE[OPRCLS] EQL REGCONTENTS THEN
				BEGIN
					MAP PEXPRNODE TREEPTR;
					TREEPTR = .ARGNODE[ARG2PTR];
					REGFORCOMP = .ARGNODE[TARGTAC]^23;
					OPDSPIX = STOROPIX(TREEPTR);
					CGOPGEN();

					! Take the regcontents node out
					! so the arg list will be right

					ARLISTT[.I,ARGNPTR] = .ARGNODE[ARG2PTR];
				END;
			END;
		END;	! Generate code to evaluate arguments

		! Should test for this being a library function to generate a
		! different name. Not in release 1.

		A1LABEL = ARLISTT[ARGLABEL] = GENLAB();

	END	! arguments present
	ELSE
	BEGIN	! No args reference a 2 word, zero arg block, defined once

		NEDZER  =  1;
		A1LABEL = .ZERBLK;	! Flag zero-arg-block needed
	END;

	! For a formal function set the indirect bit in the symbol table
%1455%	! Do not set the indirect bit for character statement functions

%1455%	IF (.NAMEP[IDATTRIBUT(DUMMY)] AND NOT .NAMEP[IDATTRIBUT(SFN)])
	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();	! Generate the subprogram call

%1533%	! If there are dynamic concatenations as arguments, generate the
%1533%	! CHUNW. call

%1533%	IF .MARK NEQ 0 THEN CGCHUNW(.MARK);

%1533%	! If there are multiple returns, generate special error handling
%1533%	! code

%1533%	IF .HASMULTRETS
%1533%	THEN 	IF .MARK NEQ 0
%1533%	THEN
%1533%	BEGIN	! Multiple returns

%1533%		! Generate a  label for  the  location after  the  error
%1533%		! handling code

%1533%		JRSTPAST = GENLAB();

%1533%		JRSTGEN(.JRSTPAST);	! Generate JRST JRSTPAST

%1533%		INCR I FROM 1 TO .ARLISTT[ARGCOUNT]
%1533%		DO
%1533%		BEGIN	! Walk down arguments to generate error handling code

%1533%			ARGNODE = .ARLISTT[.I,ARGNPTR];	! Pointer to argument

%1533%			IF .ARGNODE[OPRCLS] EQL LABOP
%1533%			THEN
%1533%			BEGIN	! Argument is a multiple return

%1533%				! Generate a label for the current address

%1533%				CURLBL = GENLAB();
%1533%				DEFLAB(.CURLBL);

%1533%				! Replace the user specified label with the
%1533%				! compiler generated one

%1533%				ARLISTT[.I,ARGNPTR] = .CURLBL;

%1533%				! Generate the CHUNW. call

%1533%				CGCHUNW(.MARK);

%1533%				! Generate JRST user_label

%1533%				JRSTGEN(.ARGNODE);

%1533%			END;	! Argument is a multiple return

%1533%		END;	! Walk down arguments to generate error handling code

%1533%		DEFLAB(.JRSTPAST);	! Define the label for the instruction
%1533%					! after the error handling code.

%1533%	END;

END;	! CGSBPRGM

GLOBAL ROUTINE ARGGEN(PTR)=
BEGIN

![1401] Rewritten to support extended addressing

! Generate an arg  block entry  for the  expression pointed  to by  PTR.
! Takes a pointer to  an expression node  and generates the  appropriate
! entry by placing  the data in  the global PBOPWD  and some  relocation
! information (often  a pointer  to  an STE)  into the  global  PSYMPTR.
! Unlike FOROTS arg block generation, this  routine fills in all of  the
! fields in PBOPWD itself.

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

! Uses EXTERNAL ROUTINE OIFIW ! NOVALUE

	MAP PEXPRNODE PTR;		! Points to the expression
	EXTERNAL BASE PSYMPTR;		! Holds relocation info
	EXTERNAL OBJECTCODE PBOPWD;	! Holds data word to output
%1002%	EXTERNAL EVALTAB EVALU;		! Maps internal type codes to external


	SELECT .PTR[OPRCLS] OF
	NSET

DATAOPR:	BEGIN
			PSYMPTR=.PTR;
			PBOPWD=.PTR[TARGTMEM];

%1524%			! If PTR is not character then we want to set the
			! indirect bit if it is a formal function name or
			! a formal array.

			! [Remark by RVM: I don't understand this comment.]
			! The indirect bit may already have been set if it
			! was previously referenced as a formal function.
			! Thus we set the bit explicitly.

%1524%			IF .PTR[VALTYPE] NEQ CHARACTER
			THEN IF (.PTR[FORMLFLG] AND .PTR[IDATTRIBUT(INEXTERN)])
			     OR .PTR[OPR1] EQL OPR1C(DATAOPR,FORMLARRAY)
			     THEN PBOPWD[OTSIND]=1
		END;

LABOP:		BEGIN
			PBOPWD=.PTR;
			PSYMPTR=PBFLABREF
		END;

ARRAYREF:	IF .PTR[VALTYPE] NEQ CHARACTER
%1253%		THEN
		BEGIN	! Non-CHARACTER ARRAYREF

			! For  an  ARRAYREF,   the  target   field  of   the
			! expression node  contains  the  relative  address.
			! ARG1PTR points to the symbol table entry.

%1002%			PBOPWD=.PTR[TARGADDR];
			PSYMPTR=.PTR[ARG1PTR];

			! An ARRAYREF node is found  as an argument only  if
			! the address calculation is constant.  If there  is
			! a variable part, there will be a STORECLS node  at
			! the top to store a  pointer to the element into  a
			! temporary.

			IF .PTR[ARG2PTR] NEQ 0
			THEN CGERR()
		END	! Non-CHARACTER ARRAYREF
%1253%		ELSE
%1253%		BEGIN	! CHARACTER ARRAYREF

			! TARGADDR points to the STE of the .Q temp which
			! has the descriptor

			PSYMPTR = .PTR[TARGADDR];
			PBOPWD = .PSYMPTR[IDADDR]	! Use addr of .Q temp
		END;	! [1253] CHARACTER ARRAYREF

OTHERWISE:	BEGIN
			! Pick up the  temp in which  the result value  will
			! will be stored.  This is the *REAL* arg.

			PSYMPTR=.PTR[TARGADDR];		! Get hold of the STE
			PBOPWD=.PSYMPTR[IDADDR];	! Store .Q temp addr
			PBOPWD[OTSIND]=.PTR[TARGIF]	! Move the indirect bit
		END;

	TESN;

	IF .PTR[OPRCLS] EQL LABOP
	THEN PBOPWD[OTSTYPE]=ADDRTYPE
%1002%	ELSE PBOPWD[OTSTYPE]=.EVALU[.PTR[VALTYPE]];

	OIFIW()			! Finally output the word
END;	! ARGGEN

GLOBAL ROUTINE CGARGS=
BEGIN

![1401] Rewritten to support extended addressing

! At the  end of  a block,  generate any  argument lists  that have  not
! already been  generated.  They  are on  a linked  list pointed  to  by
! ARGLINKPT.  The object code for an arg  list is a labeled vector of  n
! IFIWs to  arguments,  preceeded by  "-n,,0".   The routine  ARGGEN  is
! called to output words that point to the arguments.

	REGISTER ARGCT;			! Will hold number of args
%1437%	REGISTER BASE LABTAB;		! Label table entry
%1437%	REGISTER ARGUMENTLIST ARGLSTPT;	! Arg blocks pointed to by ARGLINKPT


%1437%	ARGLSTPT = .ARGLINKPT;		!The global pointer to all arguments

%1437%	WHILE .ARGLSTPT NEQ 0		! For all arg lists . . .
	DO
	BEGIN
		! 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;		! -n,,0
			PSYMPTR=PBF2NOSYM;
			OBUFFA();			! Write out count word

			! Save away  the  location  of the  call  using  the
			! label, which is the last reference.  Make sure the
			! label's been referenced, but not resolved.

%1437%			IF .FLGREG<OBJECT>
%1437%			THEN		!.REL file
%1437%			BEGIN
%1437%				LABTAB = .ARGLSTPT[ARGLABEL];
%1437%				IF .LABTAB[SNDEFINED] AND	!Referenced
%1437%				(.LABTAB[SNSTATUS] EQL UNRESOLVED)!Not resolved
%1526%				THEN	ARGLSTPT[ARGCALL] = .LABTAB[SNADDR]
%1437%				ELSE	CGERR();
%1437%			END;

%1437%			!** Here the label is defined***
			DEFLAB(.ARGLSTPT[ARGLABEL]);	! "nnnnnM:"

%1466%			IF .ARGCT NEQ 0	!No args?
%1466%			THEN	INCR I FROM 1 TO .ARGCT	! Write out each arg
				DO ARGGEN(.ARGLSTPT[.I,ARGNPTR])
%1466%			ELSE
%1466%			BEGIN	! Put out a word of 0 so that the label will
%1466%				! have something to refernce.
%1466%				PBOPWD = 0;
%1466%				PSYMPTR = PBF2NOSYM;
%1466%				OBUFFA();
%1466%			END;

		END;
%1437%		ARGLSTPT = .ARGLSTPT[ARGLINK]		! Move to next arg list
	END
END;	! of CGARGS
END
ELUDOM