Google
 

Trailing-Edge - PDP-10 Archives - BB-4157F-BM_1983 - fortran/compiler/cgexpr.bli
There are 26 other files named cgexpr.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: S. MURPHY/HPW/DCE/TFV/EDS/RVM/AHM/CDM

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

GLOBAL BIND CGEXPV = 7^24 + 0^18 + #1607;	! Version Date: 4-Aug-82

%(

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

63	-----	-----	DECLARE CODE GENERATORS FOR DABS IN LINE
			EXTERNAL
64	-----	-----	MAKE IN LINE EXPONEN TO MEMORY WORK

65	-----	-----	MAKE IN LINE EXPONEN OF DP AND OF IMMED
			LOOP INDEX WORK
66	-----	-----	REMOVE ALL REFERENCES TO SQUARE,CUBE,P4
67	-----	-----	IN "CGVBOOL", SHOULD NOT SKIP THE CALL
				TO CGOPGEN TO GET THE VAL OF ARG1
			IF A1NOTFLG OR A1NEGFLG IS SET
68	-----	-----	CLEAN UP "CGCBOOL"
69	-----	-----	FIX BUG IN EDIT 68
70	-----	-----	IN CGVBOOL, WHEN ARG1 IS A MASK, ARG2 OF TYPE
			CONTROL, SHOULD NOT GENERATE CODE TO STORE
			THE VALUE OF ARG1 INTO A TMP IF "A1SAMEFLG"
			IS SET (INDICATING THAT ITS ALREADY THERE)
71	337	17305	IN CGOPGEN, ROUND UP REAL IMMEDIATE CONSTANTS
			BEFORE SENDING TO LISTING, (DCE)
72	554	22324	FIX CODE GEN FOR AND NODE WITH A1NOTFLG SET, (DCE)

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

73	761	TFV	1-Mar-80	-----
	Choose index fo code generation based on /GFLOATING

74	1006	TFV	1-Jul-80	------
	Move KISNGL to UTIL.BLI. (It was also in OUTMOD.BLI.)
	Fix listings of immediate mode constants.

75	1037	EDS	29-Dec-80	10-30396
	Fix initialization of logical assignment variable.

76	1064	EDS	28-Apr-81	Q20-01483
	Remove Edit 1037.  The fix is in ALCTVBOOL.

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

77	1251	CKS	7-Aug-81
	Handle character ARRAYREF nodes

78	1411	RVM	31-Oct-81
	Edit 1272 caused the macro code listed for files compiled
	with GFLOATING to be bad, but only if there was no object
	file requested.  This occured because the compiler knew
	that ALCCON did not convert constants if there was to be no
	REL file, and so would convert the constants when producing
	the list file.  Edit 1272 caused constants to be converted
	twice, and thus equal zero.

79	1431	CKS	15-Dec-81
	Add CGSUBSTR to generate code for substring nodes

1474	TFV	12-Feb-82
	Add CGCONCAT  to generate  code  for concatenation  nodes.   For
	CONCTF  nodes  (fixed  length  result),  a  call  to  CONCT.  is
	generated.  For  CONCTM nodes  (known maximum  length result)  a
	call to CONCM. is generated.   For CONCTV nodes (dynamic  length
	result) an internal compiler error occurs for now.

1533	TFV	17-May-82
	Modify CGCONCAT for  CONCTV nodes.   Generate a  call to  CONCD.
	which allocates run-time  space for the  concatenation node  and
	does the concatenation.  Write  CGCHMRK and CGCHUNW to  generate
	calls to CHMRK. and CHUNW..

1551	AHM	4-Jun-82
	Remove code in CGCONCAT which set the psect index of STEs  for
	COMCM. and CONCF. to PSCODE because external references  don't
	need psect indices.

1567	CDM	24-Jun-82
	Correct MRFARREF to handle character arrays.

1607	TFV	4-Aug-82
	Fix CGCHMRK to reuse one argument block for many IOLST. calls in
	a single statement.

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

)%

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


FORWARD
	OBUFF,
	OBUFFA,
	CGEXCIOP,
	CGETVAL,
	MRFDATA,
	MRFARREF,
	MRFEXPR,
	MRFCSB,
	CGOPGEN , 
	CGARGEVAL,
	CGILF,
	CGSUBSTR,	![1431] New
	CGCONCAT,
%1533%	CGCHMRK(1),
%1533%	CGCHUNW(1),
	CGVBOOL,
	CGCBOOL(2),
	CGREL1(1),
	CGJMPC(2),
	DEFLAB(1);

EXTERNAL
	A1LABEL,
	A1NODE,
	A2LABEL,
	A2NODE,
	A3LABEL,
	ADDLAB,
%1533%	ARGLINKPT,
	C1H,
%1533%	CALLER,
	CGARREF, 
	CGERR,
	CGSBPRGM,
	CSTMNT,
	E193,
	FATLERR,
	GBYSREGS,
	GENLAB,
	ISN,
	NEWENTRY,
%1251%	OPCHIX,
%761%	OPCMGET,
%761%	OPCUBI,
	OPDSPIX,	! Index for code generation
	OPGALT,
%761%	OPGARG,		! Indices for /GFLOATING code generation
%761%	OPGARI,
	OPGBOO,
%1533%	OPGCHM,		! Index for CHMRK. call
%1533%	OPGCHU,		! Index for CHUNW. call
	OPGDB1,		! For DABS in line
	OPGDBF,		! For DABS in line
%1251%	OPGENDISP,
%761%	OPGETI,
	OPGEX,
	OPGEXM,
	OPGEXS,
%761%	OPGIL1,
%761%	OPGILF,
%761%	OPGILI,
%1474%	OPGLD2,		! Index for DMOVE ac,loc
%761%	OPGN1I,
%761%	OPGN2I,
	OPGREL,
	OPGSET,
%761%	OPGSPG,		! Indices for /GFLOATING code generation
%761%	OPGSPI,
%761%	OPGSPM,
%1251%	OPGST1,
%1474%	OPGST2,		! Index for DMOVEM ac,loc
%761%	OPGSTC,
	OPGSTD,
%761%	OPGSTI,
%761%	OPGTCG,		! Indices for /GFLOATING code generation
	OPGTCI,
	OPGVTS,
%761%	OPGXG,		! Indices for /GFLOATING code generation
%761%	OPGXGM,		! Indices for /GFLOATING code generation
%761%	OPGXGS,		! Indices for /GFLOATING code generation
	OPGXPI,
%761%	OPP21I,
%1251%	OPSSEP,
	OUTMDA,
	OUTMOD,
	PBFPTR,
	PBOPWD,
	PBUFF,
	PC,
	PEEPOPTIMZ,
	PEEPPTR,
	PROPNEG,	! Routine to propagate a neg over arithmetic and
			! typecnv nodes
	PSYMPTR,
	REGFORCOMP,
	RESNAME,
%1474%	TBLSEARCH,	! Routine to lookup a symbol table entry
	TREEPTR;

OWN	PEXPRNODE REFNODE;	! Indicates   which   expression    node
				! specifies the memref field to be  used
				! (may be arg1, arg2, or parent)

	! Map structures onto the  global pointers used  to look at  the
	! current node in the tree and its two subnodes

MAP
	PEXPRNODE A1NODE,
	PEXPRNODE A2NODE,
	BASE CSTMNT,
	PEXPRNODE TREEPTR;

	! Set up peephole buffer

MAP
	VECTOR PBUFF,
	PEEPFRAME PBUFF,
	PPEEPFRAME PBFPTR;	! Pointer  to  next  available  word  in
				! peephole buffer  (when the  buffer  is
				! full, this  points  to an  extra  word
				! after the  end of  the buffer).   This
				! word  will  often   contain  a   label
				! corresponding to the next  instruction
				! to be generated

	! Setup pointer to the word after  the end of the last entry  in
	! the peephole buffer

BIND	PBFEND = PBUFF + PBFENTSIZE * PBFENTCT;
GLOBAL ROUTINE OBUFF=
%(***************************************************************************
	ROUTINE TO OUTPUT INSTRUCTIONS TO THE PEEPHOLE BUFFER.
	CALLED WITH THE GLOBALS
		PBOPWD - THE INSTRUCTION WORD TO GO INTO THE PEEPHOLE BUFFER
		PSYMPTR - PTR TO THE SYMBOL TABLE ENTRY CORRESPONDING
			TO THE ADDRESS FIELD OF THE INSTRUCTION TO BE GENERATED
			(OR  0 IF ADDR FIELD IS A LABEL, 1 IF ADDR FIELD
			IS NOT A SYMBOL - EG IS A REGISTER)
	PUTS THE INSTR IN THE PEEPHOLE BUFFER AND CALLS THE PEEPHOLER
***************************************************************************)%
BEGIN
	%(****IF PEEPHOLE-BUFFER IS FULL, OUTPUT THE TOP BLOCK
		OF INSTRUCTIONS. THE NUMBER OF INSTRS PROCESSED AT A TIME
		IS SPECIFIED BY "PBFOUTCT" WHICH IS BOUND IN "TABLES.BLI".
		MOVE  UP THE REST OF THE INSTRS IN THE BUFFER (MUST LEAVE
		ENOUGH INSTRS IN THE BUFFER TO USE IN PEEPHOLING NEW INSTRS
		THAT WILL BE ADDED).*********)%
	IF .PBFPTR GEQ PBFEND
	THEN
	BEGIN
		OUTMOD(PBUFF,PBFOUTCT);
		BLOCKTR((PBUFF+PBFOUTSIZ),PBUFF,(PBFSIZE-PBFOUTSIZ));
		PBFPTR_PBUFF+(PBFENTCT-PBFOUTCT)*PBFENTSIZE;	!PTR TO THE START OF
						! OF THE FIRST ENTRY AFTER THE SET OF ENTRIES
						! THAT WERE MOVED UP IN THE BUFFER
	END;
	%(****WRITE THE NEW INSTR IN THE FIRST AVAILABLE SLOT****)%
	PBFPTR[PBFSYMPTR]_.PSYMPTR;
	PBFPTR[PBFINSTR]_.PBOPWD;
	PBFPTR_.PBFPTR+PBFENTSIZE;

	%(***INIT THE LABEL FIELD OF THE NEXT INSTR TO 0*****)%
	PBFPTR[PBFLABEL]_0;

	%(***INIT THE ISN (SEQ NUMBER FOR STMNT) FIELD OF THE NEXT INSTR TO CODE FOR
		"NO ISN ON THIS INSTR" ***)%
	PBFPTR[PBFISN]_NOISN;




	%(****PERFORM ANY PEEPHOLE OPTIMIZATIONS TRIGGERED BY THIS INSTRUCTION****)%

	%(***IF THERE ARE FEWER THAN 5 INSTRS IN THE BUFFER, DO NOT
		PEEPHOLE OPTIMIZE YET***)%
	IF (.PBFPTR-PBUFF) GEQ 5*PBFENTSIZE
	THEN
	BEGIN
		PEEPPTR_.PBFPTR-3*PBFENTSIZE;		!PTR TO WD OFF WHICH PEEPHOLES WILL
							! BE KEYED

		PEEPOPTIMZ();
	END;

END;	! of OBUFF
GLOBAL ROUTINE OBUFFA=
%(***************************************************************************
	ROUTINE TO OUTPUT ARGBLOCK ELEMENTS INTO THE PEEPHOLE BUFFER.
	CALLS THE OUTPUT MODULE FOR EVERY 25 ARGS.
	CALLED WITH THE GLOBALS
		PBOPWD - THE ARGUMENT WD TO BE OUTPUT
		PSYMPTR - PTR TO THE SYMBOL TABLE ENTRY FOR THE
			SYMBOL IN THE RIGHT HALF OF THE ARG-WD
			OR:
				"PBF2NOSYM" - IF BOTH HALVES OF THE WD ARE
						OCTAL CONSTANTS
				"PBF2LABREF" - IF BOTH HALVES OF THE WD ARE PTRS
						TO LABEL TABLE ENTRIES
				"PBFLABREF" - IF LEFT HALF IS AN OCTAL CONSTANT,
						RIGHT HALF IS A PTR TO A LABEL TABLE
						ENTRY
			IF PSYMPTR IS A PTR TO A SYMBOL TABLE ENTRY, THEN
			CAN ASSUME THAT THE LEFT HALF OF THE ARGWD IS AN OCTAL
			CONSTANT
***************************************************************************)%
BEGIN
	%(***ADD THIS WD TO THE BUFFER***)%
	PBFPTR[PBFSYMPTR]_.PSYMPTR;
	PBFPTR[PBFINSTR]_.PBOPWD;
	PBFPTR_.PBFPTR+PBFENTSIZE;

	%(***IF THE BUFFER IS FULL, OUTPUT ITS CONTENTS**)%
	IF .PBFPTR EQL PBFEND
	THEN
	BEGIN
		OUTMDA(PBUFF,PBFENTCT);
		PBFPTR_PBUFF;
	END;

	%(***INIT THE LABEL FIELD OF THE NEXT INSTR TO 0***)%
	PBFPTR[PBFLABEL]_0;

END;	! of OBUFFA
GLOBAL ROUTINE CGEXCIOP=
%(**********************************************************************

	ROUTINE TO GENERATE CODE FOR SPECOP EXCIOP
	CALLED WITH TREEPTR, A1NODE, A2NODE, REGFORCOMP
	SET UP

**********************************************************************)%
BEGIN
REGISTER CN[2];
LOCAL MULDPIX;
LOCAL EXPDPIX;
LOCAL MULMIX;	!TO MULTIPLY TO MEMORY
LOCAL TYP;	!VALTP1 OF THE OPERAND
MACHOP LSHC=#246;

TYP_.A1NODE[VALTP1];	!INTEGER,REAL,OR DP(DP ON KI ONLY)
IF .TREEPTR[MEMCMPFLG]	!IF THIS OP IS TO BE DONE TO MEMORY
THEN
BEGIN
![761] Indices for /GFLOATING code generation
%[761]%	IF .GFLOAT
%[761]%		THEN MULMIX_OPGXGM+.TYP
%[761]%		ELSE MULMIX_OPGEXM+.TYP;

	IF .A2NODE EQL 2		!SQUARE IS AN EXCEPTION IN THAT
	THEN				! IT CAN BE DONE TO MEMORY EVEN THO AN EVEN POWER
	BEGIN
		OPDSPIX_.MULMIX;
		CGOPGEN();		!GENERATE THE MULTIPLY TO MEMORY FORI=I**2
		RETURN
	END;
END;

IF .TREEPTR[A1IMMEDFLG]
	THEN MULDPIX_OPGXPI		! TO MULTIPLY AN IMMED LP INDEX
	ELSE				! TO MULTIPLY BY THE VAR
![761] Indices for /GFLOATING code generation
%[761]%		IF .GFLOAT
%[761]%			THEN MULDPIX_OPGXG+.TYP
%[761]%			ELSE MULDPIX_OPGEX+.TYP;

![761] Indices for /GFLOATING code generation
%[761]%	IF .GFLOAT			!TO MULTIPLY BY SELF
%[761]%		THEN EXPDPIX_OPGXGS+.TYP
%[761]%		ELSE EXPDPIX_OPGEXS+.TYP;


CN[0]_0;		!CLEAR GENERATOR
CN[1]<18,18>_.A2NODE;	!LOAD PATTERN
WHILE .CN[0] NEQ 1 DO LSHC(CN,1);	!JUSTIFY PATTERN
IF .CN[0] EQL .A2NODE THEN RETURN ELSE DO
BEGIN
	LSHC(CN,1);			!GET NEXT POWER
	OPDSPIX_.EXPDPIX;		!MULTIPLY BY SELF
	CGOPGEN();			!GENERATE MULTIPLY
	IF .CN THEN
	BEGIN
		IF .CN[0] EQL .A2NODE	!IF THIS IS THE LAST MULTIPLY
			AND .TREEPTR[MEMCMPFLG]	! AND RESULT IS TO GO TO MEMORY
		THEN OPDSPIX_.MULMIX
		ELSE
		OPDSPIX_.MULDPIX;	!MULTIPLY BY MEMORY
		CGOPGEN()		!GENERATE MULTIPLY
	END;
END
WHILE .CN[0] NEQ .A2NODE;

END;	! of CGEXCIOP
GLOBAL ROUTINE CGETVAL=
%(*****************************************************************
	ROUTINE TO GET THE VALUE ASSOCIATED WITH A GIVEN NODE WITHIN
	REACH OF ONE INSTRUCTION
	CALLED WITH THE GLOBAL TREEPTR POINTING TO THE NODE TO
	 BE EVALUATED
********************************************************************)%
BEGIN
	REGISTER PEXPRNODE CNODE;		!PTR TO NODE BEING PROCESSED

	CNODE_.TREEPTR;


	%(*****DISPATCH TO A ROUTINE TO PROCESS NODES OF THIS OPERATOR CLASS*****)%

	CASE .CNODE[OPRCLS] OF SET

		%(****FOR BOOLEANS****)%
		CGVBOOL();

		%(****FOR DATA ITEMS****)%
		RETURN;

		%(*****FOR RELATIONALS*****)%
		BEGIN

			%(***INIT VAL TO TRUE***)%
			REGFORCOMP_GETTAC(CNODE);
			OPDSPIX_SETLOGIX(CNODE,TRUE);
			CGOPGEN();

			%(***GENERATE CODE TO SKIP ON RELATIONAL TRUE***)%
			CGREL1(TRUE);

			%(***GENERATE 1 INSTR TO SET VAL FALSE***)%
			TREEPTR_.CNODE;
			REGFORCOMP_GETTAC(CNODE);
			OPDSPIX_SETLOGIX(CNODE,FALSE);
			CGOPGEN();
		END;


		%(*****FOR FUNCTION CALLS*****)%
		CGSBPRGM(.CNODE[ARG2PTR],.CNODE[ARG1PTR]);


		%(*****FOR ARITHMETIC OPERATIONS*****)%

		BEGIN
			%(***GET RID OF "A2NEGFLG" BY - 
				A+(-B)= A-B
				A-(-B)= A+B
				A*(-B)= (-A)*B
				A/(-B)= (-A)/B
			*******)%
			IF .CNODE[A2NEGFLG]
			THEN
			BEGIN
				IF ADDORSUB(CNODE)
				THEN
				BEGIN
					CMPLSP(CNODE);
					CNODE[A2NEGFLG]_0;
				END
				ELSE
				IF MULORDIV(CNODE)
				THEN
				BEGIN
					CNODE[A1NEGFLG]_NOT .CNODE[A1NEGFLG];
					CNODE[A2NEGFLG]_0;
				END;
			END;

			%(***IF A1NEGFLG IS NOW SET, AND ARG1 IS AN EXPRESSION, TRY TO
				PROPAGATE THE NEGATIVE OVER ARG1 (SO THAT WONT HAVE TO
				COMPUTE ARG1 AND THEN NEGATE IT)
			****)%
			IF .CNODE[A1NEGFLG] AND NOT .CNODE[A1VALFLG]
			THEN
			BEGIN
				IF PROPNEG(.CNODE[ARG1PTR])
				THEN CNODE[A1NEGFLG]_0;
			END;



			%(***EVALUATE THE ARGS UNDER THIS NODE - AND SET UP GLOBALS A1NODE AND A2NODE***)%
			CGARGEVAL();

			%(***GET ARG1 INTO LOC FOR COMPUTATION***)%
			REGFORCOMP_GETTAC(CNODE);
			OPDSPIX_GETA1OPIX(CNODE,A1NODE);
			CGOPGEN();

			%(***USE OPGENTABLE TO EVALUATE PARENT***)%
			OPDSPIX_ARITHOPIX(CNODE);
			CGOPGEN();
		END;


		%(*****FOR TYPE CONVERSION*****)%
		BEGIN
			%(***EVALUATE THE SINGLE ARGUMENT OF THIS NODE***)%
			IF NOT .CNODE[A2VALFLG]
			THEN
			%(**UNLESS ARG IS ALREADY EVALUATED***)%
			BEGIN
				TREEPTR_.CNODE[ARG2PTR];
				CGETVAL();
			END;

			%(***UNLESS NO CODE NEEDS TO BE GENERATED FOR THE "CONVERSION",
				GET THE VAL OF THE SUBNODE INTO A REG AND CONVERT IT***)%
			IF NOT NOCNV(CNODE)
			THEN
			BEGIN
				REGFORCOMP_GETTAC(CNODE);
				%(***GENERATE CODE TO GET ARG2 INTO A REGISTER***)%
				TREEPTR_.CNODE;
				A1NODE_.CNODE[ARG2PTR];
				OPDSPIX_GETA2OPIX(CNODE,A1NODE);
				CGOPGEN();

				%(***GENERATE CODE TO CONVERT THE VALUE***)%
				A2NODE_.CNODE[ARG2PTR];
				OPDSPIX_TPCNVIX(CNODE,A1NODE);
				CGOPGEN();
			END;

		END;


		%(****FOR AN ARRAY REFERENCE*******)%
		BEGIN
			%(***EVALUATE THE EXPRESSION FOR THE ADDRESS CALC***)%
			IF NOT .CNODE[A2VALFLG]
			THEN
			BEGIN
				TREEPTR_.CNODE[ARG2PTR];
				CGETVAL();
			END;

			%(***GET THE PART OF THE ADDRESS WHICH MUST BE COMPUTED AT RUN TIME
				INTO THE INDEX-REG USED IN ACCESSING THE VAL OF CNODE***)%
			IF .CNODE[ARG2PTR] NEQ 0	!UNLESS THE SUBSCRPIT CALC WAS
							!ENTIRELY A COMPILE-TIME CONSTANT
			THEN
			BEGIN
%1251%				IF .CNODE[VALTYPE] EQL CHARACTER
%1251%				THEN REGFORCOMP_GETTAC(CNODE)
				ELSE REGFORCOMP_GETTXF(CNODE);
				A1NODE_.CNODE[ARG2PTR];
				TREEPTR_.CNODE;
				OPDSPIX_GETA2OPIX(CNODE,A1NODE);
				CGOPGEN();
			END;

			%(***FOR CHARACTER ARRAY REFERENCE, GENERATE
			     ADJBP TO DO THE INDEXING AND MOVE/MOVEM TO COPY
			     LENGTH WORD***)%

%1251%			IF .CNODE[VALTYPE] EQL CHARACTER
%1251%			THEN
%1251%			BEGIN
%1251%				A1NODE _ .CNODE[ARG1PTR];
%1251%				A2NODE _ .CNODE[TARGADDR];
%1251%				TREEPTR _ .CNODE;
%1251%				OPDSPIX _ OPCHIX;
%1251%				CGOPGEN();
%1251%			END;

		END;

		%(***FOR A COMMON SUBEXPRESSION - SHOULD NEVER WALK DOWN HERE***)%
		RETURN;

		%(***FOR NEG/NOT NODE (A FEW OF THEM WILL BE LEFT)***)%
		BEGIN
			%(***IF ARG IS NOT A SIMPLE VAR, GENERATE CODE TO EVAL IT***)%
			IF NOT .CNODE[A2VALFLG]
			THEN
			BEGIN
				TREEPTR_.CNODE[ARG2PTR];
				CGETVAL();
			END;

			TREEPTR_.CNODE;
			REGFORCOMP_GETTAC(CNODE);
			A1NODE_.CNODE[ARG2PTR];
			A2NODE_.CNODE[ARG2PTR];

			%(***IF A2NEG,A2NOT,OR A2SAME FLAG IS SET, USE GETA2OPIX TO
				GET THE ARG  INTO REGFORCOMP***)%
			IF .CNODE[A2NEGFLG] OR .CNODE[A2NOTFLG] OR .CNODE[A2SAMEFLG]
			THEN
			BEGIN
				OPDSPIX_GETA2OPIX(CNODE,A1NODE);
				CGOPGEN();

				OPDSPIX_NEGNOT1IX(CNODE);
				CGOPGEN();
			END
			ELSE
			BEGIN
				OPDSPIX_NEGNOT2IX(CNODE);
				CGOPGEN();
			END;
		END;

		%(***FOR SPECIAL OPERATORS INTRODUCED BY PHASE 2 SKEL***)%
		BEGIN
			%(***COMPUTE THE VAL OF ARG1*******)%
			IF NOT .CNODE[A1VALFLG]
			THEN
			BEGIN
				TREEPTR_.CNODE[ARG1PTR];
				CGETVAL();
			END;


			TREEPTR_.CNODE;
			A1NODE_.CNODE[ARG1PTR];
			REGFORCOMP_GETTAC(CNODE);

			%(***GET ARG1 INTO THE REG FOR COMPUTATION OF THIS NODE***)%
			OPDSPIX_GETA1OPIX(CNODE,A1NODE);
			CGOPGEN();

			%(***GENERATE CODE TO PERFORM THE OPERATION*****)%
			IF .CNODE[OPERSP] NEQ EXPCIOP THEN
			BEGIN
				OPDSPIX_SPECOPIX(CNODE);
				CGOPGEN()
			END
			ELSE

			%(***GENERATE CODE FOR IN LINE EXPONENTIATION
			 ***)%
			BEGIN
				TREEPTR_.CNODE;
				A2NODE_.CNODE[ARG2PTR];
				CGEXCIOP()
			END;

		END;

		%(***FOR FIELDREF - NOT IMPLEMENTED IN RELEASE 1 OF FORTRAN***)%
		BEGIN
		END;

		%(***FOR STORECLS - THESE ARE NODES TO CAUSE A PTR
			TO AN ARRAY ELEMENT OR THE CONTENTS OF AN ARRAY ELEMENT
			TO BE STORED IN A TEMPORARY
		*********)%
		BEGIN
			%(***EVALUATE THE EXPRESSION TO BE STORED***)%
			TREEPTR_.CNODE[ARG2PTR];
			CGETVAL();

			TREEPTR_.CNODE;
			A2NODE_.CNODE[ARG2PTR];
			REGFORCOMP_GETTAC(CNODE);
			OPDSPIX_STCLSOPIX(CNODE);
			CGOPGEN();
		END;

		%(***FOR REGCONTENTS NODE - SHOULD RARELY WALK DOWN ON THEM***)%
		BEGIN END;

		%(***FOR LABOP - SHOULD ONLY GET HERE FOR LABELS USED AS ARGS***)%
		BEGIN END;

		%(***FOR STATEMENT - SHOULD NEVER GET HERE*********)%
		CGERR();

		%(***FOR AN IOLIST ELEMENT - SHOULD NEVER GET HERE***)%
		CGERR();

		%(***FOR AN IN-LINE FUNCTION*****************)%
		CGILF();

%1431%		%(***FOR SUBSTRING***)%
%1431%		CGSUBSTR();

%1474%		%(***FOR CONCATENATION***)%
%1474%		CGCONCAT();

		TES;

	%(****IF FLAG IS SET IN CNODE INDICATING THAT THE VALUE OF THIS
		NODE MUST BE STORED AFTER IT IS COMPUTED, DO SO***)%
	IF .CNODE[STOREFLG]
	THEN
	BEGIN
		TREEPTR_.CNODE;
		REGFORCOMP_(IF .CNODE[OPRCLS] EQL FNCALL
			THEN RETREG^23		!FOR FN CALL STORE RETURN REG
			ELSE GETTAC(CNODE));	!OTHERWISE, THE TARGET REG
		OPDSPIX_STOROPIX(CNODE);
		CGOPGEN();
	END;

END;	! of CGETVAL
ROUTINE MRFDATA=
BEGIN
	!***************************************************************
	! For  a   data  node,   target  field   specifies  memref   for
	! instruction, pointer to the node  is the symbol table  pointer
	! to output
	!***************************************************************

	PBOPWD = .PBOPWD + .REFNODE[IDTARGET];

	! Test for a formal parameter that is never copied to a local

	IF .REFNODE[OPERSP] EQL FORMLVAR AND .REFNODE[IDATTRIBUT(NOALLOC)]
	THEN PSYMPTR = PBFNOSYM
	ELSE PSYMPTR = .REFNODE;

END;	! of MRFDATA
ROUTINE MRFARREF=
BEGIN
	!***************************************************************
	! For a  numeric ARRAYREF  node, target  field specifies  MEMREF
	! field for instruction,  ARG1PTR under the  node points to  the
	! symbol table entry
	!
	! For a character array ref,  use the .Dnnn descriptor  pointing
	! to the result of the reference.
	!***************************************************************

	MAP OBJECTCODE PBOPWD;
	MAP BASE PSYMPTR;			! Ptr to symbol table entry

	REGISTER PEXPRNODE ARRSYMENTRY;		! Array name symbol table entry


%1567%	IF .REFNODE[VALTYPE] EQL CHARACTER
%1567%	THEN
%1567%	BEGIN	! Character array
%1567%
%1567%		PSYMPTR = .REFNODE[TARGADDR];		! .Dnnn for result
%1567%		PBOPWD = .PBOPWD + .PSYMPTR[IDADDR];	! of array ref
%1567%
%1567%	END	! Character array
%1567%	ELSE
%1567%	BEGIN	! Numeric array

		ARRSYMENTRY = .REFNODE[ARG1PTR];

		! Add the address and offset from the node to those from
		! the table.  Suppress overflow into the index field

		PBOPWD[OBJADDR] = .PBOPWD[OBJADDR]+.REFNODE[TARGADDR];

		! Add the  index and  indirect fields  from  the
		! node to those from the table

		PBOPWD[OBJIXF] = .PBOPWD[OBJIXF] + .REFNODE[TARGIXF];

		! If the array is a formal, address field of instruction
		! will not  be  relocated.  Otherwise,  use  the  symbol
		! table entry for the ARRAYNAME

		IF .ARRSYMENTRY[FORMLFLG]
		THEN PSYMPTR = PBFNOSYM
		ELSE PSYMPTR = .ARRSYMENTRY;

%1567%	END;	! Numeric array

END;	! of MRFARREF
ROUTINE MRFEXPR=
BEGIN
	!**************************************************************
	! For BOOLEAN, RELATIONAL, ARITHMETIC, FNCALL, TYPECNV, NEG/NOT,
	! and special-case nodes, the value may be either in a  register
	! or a temporary.  If in a register, that register is the memref
	! field and PSYMPTR field is 1.   If in a temporary, the  target
	! field of the  node points  to the temporary  table entry  from
	! which the  address  must be  retrieved.   The pointer  to  the
	! temporary table entry becomes the PSYMPTR.
	!**************************************************************

	MAP BASE PSYMPTR;	! Pointer to symbol table entry

	! Set index and indirect fields of instruction from those of target

	PBOPWD = .PBOPWD + GETTXFI(REFNODE);

	! If the  target  memref  field  is using  an  ac  as  a  memory
	! location, then there is no symbolic representation

	IF .REFNODE[INREGFLG]
	THEN
	BEGIN
		PBOPWD = .PBOPWD + .REFNODE[TARGTAC];
		PSYMPTR = PBFNOSYM;
	END
	ELSE
	BEGIN
		PSYMPTR = .REFNODE[TARGADDR];
		PBOPWD = .PBOPWD + .PSYMPTR[IDADDR];
	END;

END;	! of MRFEXPR
ROUTINE MRFCSB=
BEGIN
	!***************************************************************
	! For a common subexpression node - always use the right half of
	! the target (even if  INREGFLG is set -  this is necessary  for
	! double precision operations on KA10 where the second  argument
	! for the double precision routine must not be in a register)
	!***************************************************************

	MAP BASE PSYMPTR;	! Pointer to symbol table entry

	IF .REFNODE[TARGADDR] LEQ #17
	THEN
	BEGIN	! Common sub is in a register

		PBOPWD = .PBOPWD + .REFNODE[TARGADDR];
		PSYMPTR = PBFNOSYM;

	END	! Common sub is in a register
	ELSE
	BEGIN	! Common sub is in a temporary

		PSYMPTR = .REFNODE[TARGADDR];
		PBOPWD = .PBOPWD + .PSYMPTR[IDADDR];

	END	! Common sub is in a temporary

END;	! of MRFCSB
GLOBAL ROUTINE CGOPGEN= 
%(**********************************************************************
	THIS ROUTINE IS CALLED TO GENERATE THE CODE SPECIFIED BY
	SOME SPECIFIED OPGENTABLE ENTRY FOR SOME SPECIFIED NODE

	CALLED WITH THE GLOBALS
	TREEPTR - PTR TO THE NODE FOR WHICH CODE IS BEING GENERATED
	A1NODE - PTR TO THE 1ST ARG NODE UNDER THAT NODE
	A2NODE - PTR TO THE 2ND ARG NODE UNDER THAT NODE
	OPDSPIX - CONTAINS PTR INTO THE OPGENTABLE-DISPATCH-TABLE
		FOR THE OPGENTABLE ENTRY TO BE USED IN INTERPRETING
		THIS NODE
	REGFORCOMP - BITS 9-12 OF THIS WD IDICATE REGISTER (OR REGISTER-PAIR) TO BE USED
			IN THE COMPUTATION FOR WHICH CODE IS BEING GENERATED


**********************************************************************)%

BEGIN
	MAP BASE PSYMPTR;			!PTR TO SYMBOL TABLE ENTRY
	REGISTER OPGENTRY OPGENPTR;		!PTR TO WD IN OPGENTABLE BEING PROCESSES


	OPGENPTR_@.OPDSPIX;		!GET AOBJN PTR TO SET OF OPGENTABLE INSTRUCTIONS

	%(****IF THIS PTR IS 0, NO INSTRUCTIONS NEED TO BE GENERATED***)%
	IF .OPGENPTR EQL 0
	THEN RETURN
	%(***IF THIS PTR IS 1 - THEN HAVE AN ILLEGAL COMBINATION OF FLAGS***)%
	ELSE 
	IF .OPGENPTR EQL 1
	THEN
	BEGIN
		CGERR();
		RETURN;
	END;


	%(*****REPEAT THE FOLLOWING BLOCK FOR ALL INSTRUCTIONS TO BE OUTPUT*******)%
	%(********CT OF INSTRUCTIONS TO BE OUTPUT IS IN LEFT HALF OF THE
			PTR OPGENPTR*********)%
	DO
	BEGIN
		PBOPWD_.OPGENPTR[PATTERN];
		%(***IF THE PATTERN WD DOES NOT SPECIFY THE REGISTER
			FIELD TO BE USED, THEN THE GLOBAL "REGFORCOMP"
			SPECIFIES A FIELD-VAL TO BE ADDED IN TO THAT SPECIFIED
			BY THE PATTERN WD*****)%
		IF .OPGENPTR[REGSPEC] NEQ FRPTN
		THEN
		PBOPWD_.PBOPWD+.REGFORCOMP;


		%(***DETERMINE THE MEMREF FIELD  (IE BITS 13-35) OF THE INSTRUCTION *****)%

		CASE .OPGENPTR[MEMSPEC] OF SET
		%(**0 MEANS USE FIELD IN WD 0 OF OPGENTABLE ENTRY***)%
		PSYMPTR_PBFNOSYM;
		%(***1 MEANS USE THE "REGFORCOMP" AS A MEMORY ADDRESS***)%
		BEGIN
			PBOPWD_.PBOPWD+(.REGFORCOMP^(-23));
			PSYMPTR_PBFNOSYM;
		END;

		%(***2 MEANS USE THE IMPLICIT FN-NAME POINTED TO BY TREEPTR***)%
		BEGIN
			PSYMPTR_PBFIMFN;
			PBOPWD_.PBOPWD+.TREEPTR;
		END;

		%(***3 MEANS USE THE IMPLICIT FN-NAME POINTED TO BY THE PATTERN WD***)%
		PSYMPTR_PBFIMFN;

		%(***4 MEANS USE THE IMPLICIT FN NAME POINTED TO BY THE PATTERN WD INDEXED
			BY THE "REGFORCOMP" - (E.G. A DIFFERENT LIBRARY ROUTINE IS USED
			BY THE "REGFORCOMP" - (E.G. THE LIBRARY ROUTINE TO BE USED FOR
			A DOUBLE-PREC OP DEPENDS ON THE REG IN WHICH THE ARG WAS LEFT***)%
		BEGIN
			PBOPWD_.PBOPWD+.REGFORCOMP^(-23);
			PSYMPTR_PBFIMFN;
		END;

		%(***5 MEANS USE A1NODE IN IMMEDIATE MODE - EITHER AS AN IMMED CONSTANT OR
			IF ITS A "REGCONTENTS", THEN AS 0(R)****)%
		BEGIN
			PSYMPTR_PBFNOSYM;

			IF .A1NODE[OPR1] EQL CONSTFL
			THEN
![1411]	Delete conversion from GFLOATING
			PBOPWD_.PBOPWD +
			      ( IF .A1NODE[VALTP1] EQL INTEG1
				THEN (.A1NODE[CONST2] AND #777777)
				!REAL IMMEDIATE CONSTANT
%1411%				ELSE .A1NODE[CONST1]^(-18)  )


			ELSE
			IF .A1NODE[OPRCLS] EQL REGCONTENTS
			THEN
			PBOPWD_.PBOPWD+.A1NODE[TARGTAC]^18;
		END;

		%(***6 MEANS USE A2NODE IN IMMEDIATE MODE - EITHER AS AN IMMED CONSTANT OR
			IF ITS A "REGCONTENTS", THEN AS 0(R)****)%
		BEGIN
			PSYMPTR_PBFNOSYM;

			IF .A2NODE[OPR1] EQL CONSTFL
			THEN
![1411]	Delete conversion from GFLOATING
			PBOPWD_.PBOPWD +
			      ( IF .A2NODE[VALTP1] EQL INTEG1
				THEN (.A2NODE[CONST2] AND #777777)
%1411%				ELSE .A2NODE[CONST1]^(-18)  )
			ELSE
			IF .A2NODE[OPRCLS] EQL REGCONTENTS
			THEN
			PBOPWD_.PBOPWD+.A2NODE[TARGTAC]^18;
		END;

		%(***7 MEANS USE THE NEG OF THE IMMED CNST A1NODE***)%
		BEGIN
![1411]	Delete conversion from GFLOATING
			PBOPWD_.PBOPWD +
			( IF .A1NODE[VALTP1] EQL INTEG1
			  THEN (-.A1NODE[CONST2]) AND #777777
%1411%			  ELSE (-.A1NODE[CONST1])^(-18) );

			PSYMPTR_PBFNOSYM;
		END;

		%(***8 (#10) MEANS USE THE NEG OF THE IMMED CNST A2NODE***)%
		BEGIN
![1411]	Delete conversion from GFLOATING
			PBOPWD_.PBOPWD +
			( IF .A2NODE[VALTP1] EQL INTEG1
			  THEN (-.A2NODE[CONST2]) AND #777777
%1411%			  ELSE (-.A2NODE[CONST1])^(-18)  );

			PSYMPTR_PBFNOSYM;
		END;


		%(***9 (#11) MEANS USE THE "ARG2PTR" FIELD FROM THE PARENT***)%
		BEGIN
			PBOPWD_.PBOPWD+.TREEPTR[ARG2PTR];
			PSYMPTR_PBFNOSYM;
		END;

		%(***10 (#12) MEANS USE THE NEG OF THE ARG2PTR FIELD OF THE PARENT***)%
		BEGIN
			PBOPWD_.PBOPWD+(-.TREEPTR[ARG2PTR] AND #777777);
			PSYMPTR_PBFNOSYM;
		END;

		%(***11 (#13) MEANS USE 2**(VAL OF ARG2PTR) MINUS 1. (THIS IS USED
			FOR P2DIV)****)%
		BEGIN
			PBOPWD_.PBOPWD+(( (1^.TREEPTR[ARG2PTR]) - 1) AND #777777);
			PSYMPTR_PBFNOSYM;
		END;


		%(***12 (#14) MEANS USE THE LABEL SPECIFIED BY A1LABEL***)%
		BEGIN
			PBOPWD_.PBOPWD+.A1LABEL;
			PSYMPTR_PBFLABREF;
		END;

		%(***13 (#15) MEANS USE THE LABEL SPECIFIED BY A2LABEL***)%
		BEGIN
			PBOPWD_.PBOPWD+.A2LABEL;
			PSYMPTR_PBFLABREF;
		END;

		%(***14 (#16) MEANS USE THE LABEL SPECIFIED BY A3LABEL***)%
		BEGIN
			PBOPWD_.PBOPWD+.A3LABEL;
			PSYMPTR_PBFLABREF;
		END;
		%(***15 (#17) MEANS USE THE VALUE IN THE GLOBAL C1H, NO SYMBOLIC REPRESENTATION***)%
		BEGIN
			PBOPWD_.PBOPWD+.C1H;
			PSYMPTR_PBFNOSYM;
		END;


		%(***16 (#20) MEANS USE THE TEMPORARY POINTED TO BY THE TARGET WD OF THE PARENT -
			IGNORE THE INDIRECT AND INDEX BITS IN THAT TARGET WD***)%
		BEGIN
			PSYMPTR_.TREEPTR[TARGADDR];
			PBOPWD_.PBOPWD+.PSYMPTR[IDADDR];
		END;

		%(***17 (#21) MEANS USE MEMREF FIELD FROM A1NODE***)%
		REFNODE_.A1NODE;
		%(***18 (#22) MEANS USE MEMREF FIELD FROM A2NODE**)%
		REFNODE_.A2NODE;
		%(***19 (#23) MEANS USE MEMREF FIELD FROM PARENT NODE (IE NODE PTED TO BY TREEPTR)***)%
		REFNODE_.TREEPTR

		TES;

		%(***IF THE MEMREF FIELD MUST BE RETRIEVED FROM THE NODE SPECIFIED BY
			REFNODE, DO SO***)%

		IF .OPGENPTR[MEMSPEC] GEQ FROMA1
		THEN
		BEGIN
			%(***IF REFNODE IS A TYPE-CONVERSION NODE THAT GENERATES NO CODE (IS ONLY
				TO SPECIFY VALTYPE), MOVE DOWN TO THE ARG UNDER REFNODE***)%
			IF .REFNODE[OPRCLS] EQL TYPECNV
			THEN
			BEGIN
				IF NOCNV(REFNODE)
				THEN
				BEGIN
					REFNODE_.REFNODE[ARG2PTR];
					WHILE .REFNODE[OPRCLS] EQL TYPECNV AND NOCNV(REFNODE)
					DO REFNODE_.REFNODE[ARG2PTR];
				END;
			END;

			CASE .REFNODE[OPRCLS] OF SET
			MRFEXPR();		!GET MEMREF FROM A BOOLEAN NODE
			MRFDATA();		! FROM A SYMBOL TABLES ENTRY
			MRFEXPR();		! FROM A RELATIONAL
			MRFEXPR();		! FROM A FN CAL
			MRFEXPR();		! FROM AN ARITH NODE
			MRFEXPR();		! FROM A TYPECNV NODE
			MRFARREF();		! FROM AN ARRAYREF NODE
			MRFCSB();		! FROM A COMMON SUB NODE
			MRFEXPR();		! FROM A NEG/NOT NODE
			MRFEXPR();		! FROM A SPECIAL-CASE NODE
			BEGIN END;		! FROM A FIELD-REF NODE (NOT IMPLEMENTED
						! IN RELEASE 1)
			MRFEXPR();		! FROM A STORECLS NODE
			( PBOPWD_.PBOPWD+.REFNODE[TARGTAC];
			 PSYMPTR_PBFNOSYM);	!FROM A REGCONTENTS NODE
			CGERR();		!REFNODE SHOULD NEVER BE A LABEL
			CGERR();		!REFNODE SHOULD NEVER BE A STMNT
			CGERR();		!REFNODE SHOULD NEVER BE AN IOLIST ELEM
			MRFEXPR();		!FOR AN IN-LINE-FN
%1431%			MRFEXPR();		!SUBSTRING
%1474%			MRFEXPR();		!CONCATENATION
			TES;
		END;



		%(****OUTPUT THE INSTR FORMED TO THE PEEPHOLE BUFFER***)%
		OBUFF();


		%(***INCREMENT AOBJN PTR INTO THE OPGEN TABLE****)%
		OPGENPTR_.OPGENPTR+1;
		OPGENPTR_.OPGENPTR+AOBINCR;	!ADD 1,,1

	END
	WHILE .OPGENPTR LSS 0;

END;	! of CGOPGEN
GLOBAL ROUTINE CGARGEVAL=
%(************************************************************
	ROUTINE TO EVALUATE THE 2 ARGUMENT NODES OF SOME EXPRESSION
	NODE AND PUT THE VAL OF THE 1ST INTO THE LOC SPECIFIED FOR THE
	COMPUTATION
************************************************************)%

BEGIN
	REGISTER PEXPRNODE CNODE;			!PTR TO PARENT NODE
	CNODE_.TREEPTR;

	IF NOT .CNODE[RVRSFLG]

	THEN
	%(*****IF 1ST ARG SHOULD BE EVALUATED FIRST, EVALUATE IT******)%
	BEGIN
		IF NOT .CNODE[A1VALFLG]

		THEN
		%(****UNLESS THIS ARG IS ALREADY EVALUATED SOMEWHERE EVALUATE IT*****)%
		BEGIN
			TREEPTR_.CNODE[ARG1PTR];
			CGETVAL();
		END
	END;

	%(**************EVALUATE 2ND ARG********************)%
	IF NOT .CNODE[A2VALFLG]

	THEN
	%(*****UNLESS ARG2 IS ALREADY EVALUATED SOMEWHERE OR IS
		AN IMMED CONSTANT, EVALUATE IT**********)%
	BEGIN
		IF (TREEPTR_.CNODE[ARG2PTR]) NEQ 0 THEN
		CGETVAL();
	END;

	IF .CNODE[RVRSFLG]

	THEN
	%(*****IF ARG1 SHOULD BE EVALUATED 2ND, EVALUATE IT******)%
	BEGIN
		IF NOT .CNODE[A1VALFLG]

		THEN
		%(****UNLESS THIS ARG IS ALREADY EVALUATED SOMEWHERE  EVALUATE IT*****)%
		BEGIN
			TREEPTR_.CNODE[ARG1PTR];
			CGETVAL();
		END
	END;


	%(********SET UP GLOBALS FOR OPGENTABLE INTERPRETATION********)%
	TREEPTR_.CNODE;				!TREEPTR MAY HAVE BEEN DESTROYED BY CGETVAL
	A1NODE_.CNODE[ARG1PTR];
	A2NODE_.CNODE[ARG2PTR];

END;	! of CGARGEVAL
GLOBAL ROUTINE CGILF=
%(***************************************************************************
	ROUTINE TO GENERATE CODE FOR IN-LINE FUNCTIONS.
	CALLED WITH TREEPTR POINTING TO THE NODE FOR THE IN-LINE-FUNCTION-CALL
***************************************************************************)%
BEGIN
	LOCAL PEXPRNODE CNODE;
	LOCAL PEXPRNODE ARG1NODE:ARG2NODE;

	%(***EVALUATE ARGUMENTS***)%

	CGARGEVAL();

	%(***SET UP THE GLOBALS USED BY CGOPGEN (CODE TABLE DRIVER)***)%

	CNODE_.TREEPTR;
	A1NODE_.CNODE[ARG1PTR];
	A2NODE_.CNODE[ARG2PTR];
	REGFORCOMP_GETTAC(CNODE);

	%(***COMPLETE CODE GENERATION FOR CMPLX***)%

	IF .CNODE[OPERSP] EQL CMPLXFN THEN
	BEGIN
		OPDSPIX_GETA1OPIX(CNODE,A1NODE);
		CGOPGEN();
		REGFORCOMP_.REGFORCOMP+1^23;
		SWAPARGS(CNODE);
		A1NODE_.CNODE[ARG1PTR];
		OPDSPIX_GETA1OPIX(CNODE,A1NODE);
		RETURN CGOPGEN()
	END;

	%(***FOR ABS,IABS, AND SIGN - UNLESS A1SAMEFLG OR A1IMMEDFLG IS SET,
		WILL PICK UP ARG1 BY A MOVM. HENCE DO NOT GET IT INTO A REG TO
		START. OTHERWISE WILL GET ARG1 INTO REGFORCOMP***)%
	IF ILFINRFC(.CNODE[OPERSP]) OR .CNODE[A1IMMEDFLG] OR .CNODE[A1SAMEFLG]
	THEN
	BEGIN
		OPDSPIX_GETA1OPIX(CNODE,A1NODE);
		CGOPGEN();

		OPDSPIX_ILFIX(CNODE);
		CGOPGEN();
	END
	ELSE
	BEGIN
		OPDSPIX_ILF1IX(CNODE);		!FOR ABS,IABS,SIGN WHEN IMMEDFLG=0
		CGOPGEN();
	END;

END;	! of CGILF
GLOBAL ROUTINE CGSUBSTR=			![1431] New
BEGIN
	REGISTER PEXPRNODE CNODE:ANODE;

	CNODE = .TREEPTR;		! CNODE points to substring node

	! Evaluate ARG1 (upper bound) and ARG2 (lower bound-1) nodes.
	! Substring nodes always have RVRSFLG set, so the evaluation will be
	! done in the order ARG2,ARG1.  Also set up the globals A1NODE and
	! A2NODE pointing to the subnodes.

	CGARGEVAL();

	! Generate   MOVE TARGTAC, upper-bound-expression

	REGFORCOMP = GETTAC(CNODE);
	OPDSPIX = GETA1OPIX(CNODE,A1NODE);
	CGOPGEN();

	! Generate   SUB  TARGTAC, lower-bound-expression

	OPDSPIX = SSSUBOPIX(CNODE);
	CGOPGEN();

	! Generate   MOVEM TARGTAC, descriptor +1

	OPDSPIX = OPGST1;
	CGOPGEN();


	! Different cases for subscripted and scalar variables

	ANODE = .CNODE[ARG4PTR];    ! Get pointer to DATAOPR or ARRAYREF node
	IF .ANODE[OPRCLS] EQL ARRAYREF
	THEN
	BEGIN	! arrayref node

		! For arrayrefs, the byte pointer is calculated in the
		! register specified by ANODE[TARGTAC].  Let RFC be this
		! register.

		! Evaluate subscript expression

		TREEPTR = .ANODE[ARG2PTR];
		CGETVAL();

		! Generate  MOVE RFC, subscript-expression

		REGFORCOMP = GETTAC(ANODE);
		A1NODE = .ANODE[ARG2PTR];
		OPDSPIX = GETA2OPIX(ANODE,A1NODE);
		CGOPGEN();

		! Generate  ADD RFC, lower-bound-expression

		A2NODE = .CNODE[ARG2PTR];
		OPDSPIX = SSADDOPIX(CNODE);

		CGOPGEN();

		ANODE = .ANODE[ARG1PTR]; ! Point ANODE to the ID table entry
					 ! of the array name
	END	! arrayref
	ELSE
	BEGIN	! dataopr

		! For scalars, the byte pointer is calculated in the
		! register specified by CNODE[TARGAUX].  Let RFC be this
		! register.

		! Generate  MOVE RFC, lower-bound

		REGFORCOMP = GETTAUX(CNODE);
		A1NODE = .A2NODE;
		OPDSPIX = GETA2OPIX(CNODE,A2NODE);
		CGOPGEN();

		ANODE = .CNODE[ARG4PTR]; ! Point ANODE at the ID table entry
					 ! of the scalar
	END;	! dataopr

	! Generate  ADJBP RFC, ANODE
	!	    MOVEM RFC, descriptor

	A1NODE = .ANODE;
	TREEPTR = .CNODE;
	OPDSPIX = OPSSEP;
	CGOPGEN();

END;	! of CGSUBSTR
GLOBAL ROUTINE CGCONCAT=
BEGIN
	!***************************************************************
	! Generate code for a character concatenation expression.  First
	! evaluate all the arguments.  For CONCTF nodes, generate a call
	! to CONCF.  For CONCTM nodes, move the .Dnnnn variable with the
	! maximum length  descriptor  to  the .Qnnnn  variable  for  the
	! actual result.  Then call CONCM.  For CONCTV nodes, generate a
	! call to CONCD. to allocate  run-time space for the result  and
	! to do the concatenation.
	!***************************************************************

%1474%	! Written by TFV on 18-Feb-82

	REGISTER
		PEXPRNODE CNODE,	! Pointer to  the  concatenation
					! node
		BASE FNID;		! Pointer to  the  concatenation
					! library routine

	CNODE = .TREEPTR;

	! Do the setup for the call to the concatenation routine.   Then
	! generate the call.

	IF .CNODE[OPERSP] EQL CONCTF
	THEN
	BEGIN	! Fixed length result

		ENTRY = SIXBIT 'CONCF.';

	END	! Fixed length result
	ELSE	IF .CNODE[OPERSP] EQL CONCTM
	THEN
	BEGIN	! Known maximum length result

		! Copy the  .Dnnnn  maximum  length  descriptor  to  the
		! .Qnnnn variable for the actual descriptor

		REGFORCOMP = 0;

		! Generate DMOVE  0,.Dnnnn

		A1NODE = .CNODE[ARG1PTR];
		OPDSPIX = OPGLD2;
		CGOPGEN();

		! Generate DMOVEM 0,.Qnnnn

		TREEPTR = .CNODE[TARGADDR];
		OPDSPIX = OPGST2;
		CGOPGEN();

		ENTRY = SIXBIT 'CONCM.';

	END	! Known maximum length result
	ELSE	IF .CNODE[OPERSP] EQL CONCTV
	THEN
	BEGIN	! Dynamic length result

%1533%		ENTRY = SIXBIT 'CONCD.';

	END;	! Dynamic length result


	NAME = IDTAB;		! Get the symbol  table  entry  for  the
				! routine to call

	FNID = TBLSEARCH();	! Lookup the entry

	! If this was the first reference, set up the symbol table entry
	! as a library function

	IF NOT .FLAG
	THEN
	BEGIN
		FNID[OPERSP] = FNNAME;
		FNID[IDLIBFNFLG] = 1
	END;

	! Generate the code for the arguments and then generate the call

	CGSBPRGM(.CNODE[ARG2PTR],.FNID);

END;	! of CGCONCAT
GLOBAL ROUTINE CGCHMRK(ARGL)=
BEGIN
	!***************************************************************
	! Perform code generation for a CHMRK. call.  ARGL is a  pointer
	! to an argument list with a single argument which is the .Qnnnn
	! variable which holds the mark in character dynamic space.
	!***************************************************************

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

	MAP ARGUMENTLIST ARGL;		! Argument list for the CHMRK. call

	! If ARGLABEL is zero, thread the argument list onto the  linked
	! list.  Otherwise, the  argument list was  already threaded  by
	! the last CHMRK. call.

	IF .ARGL[ARGLABEL] EQL 0
	THEN
	BEGIN	! Thread argument list onto linked list

		ARGL[ARGLINK] = .ARGLINKPT;
		ARGLINKPT = .ARGL;
%1607%		ARGL[ARGLABEL] = GENLAB();	! Create ARGLABEL

	END;	! Thread argument list onto linked list

	! Generate:
	!	XMOVEI	16,A1LABEL
	!	PUSHJ	17,CHMRK.

%1607%	A1LABEL = .ARGL[ARGLABEL];
	OPDSPIX = OPGCHM;
	CGOPGEN();

END;	! of CGCHMRK
GLOBAL ROUTINE CGCHUNW(ARGL)=
BEGIN
	!***************************************************************
	! Perform code generation for a CHUNW. call.  ARGL is a  pointer
	! to an argument list with a single argument which is the .Qnnnn
	! variable which holds the mark in character dynamic space.
	!***************************************************************

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

	MAP ARGUMENTLIST ARGL;		! Argument list for the CHUNW. call

	A1LABEL = .ARGL[ARGLABEL];	! For XMOVEI 16,A1LABEL
	
	IF .A1LABEL EQL 0 THEN CGERR();	! Error if CHMRK. was not called	

	! Generate:
	!	XMOVEI	16,A1LABEL
	!	PUSHJ	17,CHUNW.

	OPDSPIX = OPGCHU;
	CGOPGEN();

END;	! of CGCHUNW
GLOBAL ROUTINE CGVBOOL=
%(**********************************************************************
	ROUTINE TO GENERATE CODE TO COMPUTE THE VALUE FOR AND, 
	OR, XOR, AND EQV NODES
	USES THE GLOBAL
		TREEPTR:  POINTS TO THE NODE IN THE TREE BEING PROCESSED

************************************************************************)%
BEGIN


	REGISTER PEXPRNODE CNODE;			!PTR TO THE EXPRESSION NODE BEING PROCESSED
	REGISTER PEXPRNODE ARG1NODE;			!PTR TO 1ST ARG NODE
	REGISTER PEXPRNODE ARG2NODE;			!PTR TO 2ND ARG NODE
	LOCAL NXLAB1,NXLAB2;				!INDICATE LABELS TO BE GENERATED
							!HEREIN (PTRS INTO LABEL TABLE)
	MACRO
		USEMSKLB=NXLAB1$,
		USEBLLB=NXLAB2$;
	LOCAL THENP,ELSEP;				!INDICATE LOCS FOR "TRUE-TRANSFER"
							!AND "FALSE-TRANSFER" FOR
							!SUBNODES WHICH ARE ALSO BOOLEANS

	LOCAL USEBLCND;					!INDICATES WHICH VAL OF A CONTROL-TYPE SUBNODE (TRUE
							! OR FALSE) SHOULD BECOME VAL OF PARENT

	CNODE_.TREEPTR;
	ARG1NODE_.CNODE[ARG1PTR];
	ARG2NODE_.CNODE[ARG2PTR];

	IF .CNODE[BOOLCLS] NEQ ANDORCLS OR
		.ARG2NODE[VALTYPE] NEQ CONTROL		!IF EITHER ARG IS OF TYPE CONTROL,
							! ARG2 WILL BE (CMPLEX SWAPS THE
							! ARGS IF ARG1 IS CONTROL, ARG2 NOT)


	THEN

	%(***FOR EQV AND XOR, AND FOR AND AND OR WHEN NEITHER ARG IS OF TYPE CONTROL***)%
	%(*******USE OPGENTABLE TO GENERATE CODE TO COMPUTE THE VALUE OF THE PARENT FROM VALS OF ARGS***)%

	BEGIN
		CGARGEVAL();
		%(***GET ARG1 INTO LOC FOR COMPUTATION***)%
		REGFORCOMP_GETTAC(CNODE);
		OPDSPIX_GETA1OPIX(CNODE,ARG1NODE);
		CGOPGEN();
		OPDSPIX_BOOLOPIX(CNODE);
		CGOPGEN();
		RETURN
	END;



	IF .CNODE[VALTYPE] EQL CONTROL

	THEN

	%(*****FOR AND NODES AND OR NODES WHICH ONLY HAVE BOOLEAN-VALUED ARGS (NO MASKS),*******)%
	%(*******INIT THE VALUE TO FALSE FOR AN AND NODE, TO TRUE FOR AN OR NODE, THEN CHANGE IT IF INCORRECT***)%

	BEGIN
		NXLAB1_GENLAB();				!GENERATE 2 NEW LABEL ENTRIES
		NXLAB2_GENLAB();
		IF .CNODE[BOPRFLG] EQL ANDOPF 
			THEN
			%(****FOR AN AND NODE****)%
			BEGIN
				REGFORCOMP_GETTAC(CNODE);
				OPDSPIX_SETLOGIX(CNODE,FALSE);
				CGOPGEN();
				CGCBOOL(.NXLAB1, .NXLAB2);	!GENERATE CODE TO TRANSFER TO
								!NXLAB1 IF VAL IS TRUE, NXLAB2 IF FALSE
				DEFLAB(.NXLAB1);		!ASSOC THIS LOC WITH NXLAB1
				TREEPTR_.CNODE;
				REGFORCOMP_GETTAC(CNODE);
				OPDSPIX_SETLOGIX(CNODE,TRUE);
				CGOPGEN();
			END

			ELSE
			%(****FOR AN OR NODE****)%
			BEGIN
				REGFORCOMP_GETTAC(CNODE);
				OPDSPIX_SETLOGIX(CNODE,TRUE);
				CGOPGEN();
				CGCBOOL(.NXLAB2,.NXLAB1);	!GENERATE CODE TO TRANSFER TO NXLAB2
								! IF VALUE IS TRUE, NXLAB1 IF FALSE
				DEFLAB(.NXLAB1);		!ASSOC THIS LOC WITH NXLAB1
				TREEPTR_.CNODE;
				REGFORCOMP_GETTAC(CNODE);
				OPDSPIX_SETLOGIX(CNODE,FALSE);
				CGOPGEN();
			END;

		DEFLAB(.NXLAB2);				!ASSOC THIS LOC WITH NXLAB2
		RETURN
	END;



	%(*****FOR AND AND OR NODES ON WHICH  ARG2 IS OF TYPE CONTROL, ARG1 IS A MASK****)%


	IF .CNODE[BOPRFLG] EQL ANDOPF
		THEN
		%(**********IF OPERATOR IS  AND*********)%
		BEGIN
			USEBLCND_FALSE;			!IF THE "CONTROL" TYPE ARG
							! IS FALSE THAT IS THE VAL OF THE PARENT
							! OTHERWISE THE PARENT HAS THE VAL OF
							! THE ARG WHICH IS A MASK
			THENP_USEMSKLB;
			ELSEP_USEBLLB;
		END

		ELSE
		%(**********IF OPERATOR IS  OR*********)%
		BEGIN
			USEBLCND_TRUE;			!IF THE "CONTROL" TYPE ARG
							! IS TRUE THAT IS THE VAL OF THE PARENT
							! OTHERWISE THE PARENT HAS THE VAL OF
							! THE ARG WHICH IS A MASK
			THENP_USEBLLB;
			ELSEP_USEMSKLB;
		END;


	%(***GENERATE CODE TO SET VAL OF PARENT TO VAL OF 1ST ARG***)%

	TREEPTR_.ARG1NODE;
	CGETVAL();
		TREEPTR_.CNODE;
		A1NODE_.CNODE[ARG1PTR];
		REGFORCOMP_GETTAC(CNODE);
		%(***IF THE VAL IS BEING COMPUTED TO MEMORY AND THE ARG WAS IN A REG
			CAN ALWAYS COUNT ON THAT REG BEING THE TARGTAC OF PARENT (EVEN
			THO DO NOT SET "A1SAMEFLG" (BECAUSE ARG1 IS NOT IN THE TMP TO BE USED)***)%
		IF .CNODE[INREGFLG] OR NOT .ARG1NODE[INREGFLG]
		!IF THE A1NOTFLG IS SET, MUST GENERATE CODE TO COMPLEMENT
		! THE VALUE OF A1NODE - THIS IS THE PLACE!
			OR .CNODE[A1NOTFLG]
		THEN
		BEGIN
			OPDSPIX_GETA1OPIX(CNODE,ARG1NODE);
			CGOPGEN();
		END;

		%(***IF VAL IS COMPUTED TO MEMORY, STORE IT***)%
		IF NOT .CNODE[INREGFLG]
		AND NOT .CNODE[A1SAMEFLG]	!IF ARG1 WAS NOT ALREADY IN THE TEMPORARY
		THEN
		BEGIN
			OPDSPIX_STOROPIX(CNODE);
			CGOPGEN();
		END;


	%(***GENERATE CODE FOR 2ND ARG - JUMP TO END IF VAL OF ARG2
		IS TRUE FOR AND, FALSE FOR OR***)%
	USEMSKLB_GENLAB();
	TREEPTR_.ARG2NODE;
	IF .ARG2NODE[OPRCLS] EQL RELATIONAL
	THEN CGJMPC(NOT .USEBLCND,.USEMSKLB)

	ELSE
	BEGIN
		IF .ARG2NODE[OPRCLS] EQL BOOLEAN
		THEN
		BEGIN
			USEBLLB_GENLAB();
			CGCBOOL(@@THENP,@@ELSEP);
			DEFLAB(.USEBLLB);
		END

		ELSE CGERR(5);		!ONLY RELATIONALS AND BOOLEANS CAN
					! HAVE VALUE TYPE CONTROL
	END;


	%(***GENERATE CODE TO INIT VAL OF PARENT TO FALSE FOR AND, TRUE FOR OR**)%
	REGFORCOMP_GETTAC(CNODE);
	OPDSPIX_SETLOGIX(CNODE,.USEBLCND);
	TREEPTR_.CNODE;
	CGOPGEN();

	DEFLAB(.USEMSKLB);

END;	! of CGVBOOL
GLOBAL ROUTINE CGCBOOL(THENLAB,ELSELAB)=


%(******************************************************************************************
	ROUTINE TO GENERATE CODE FOR BOOLEAN NODES WHICH ARE USED FOR CONTROL PURPOSES ONLY

	CALLED WITH THE ARGUMENTS
		THENLAB:  INDICATES LABEL TO TRANSFER TO ON A TRUE VALUE
		ELSELAB:  INDICATES LABEL TO TRANSFER TO ON A FALSE VALUE
	USES THE GLOBAL
		TREEPTR:  POINTS TO THE NODE IN THE TREE BEING PROCESSED

********************************************************************************************)%

BEGIN


	REGISTER PEXPRNODE CNODE;			!PTR TO THE EXPRESSION NODE BEING PROCESSED
	REGISTER PEXPRNODE ARG1NODE;			! PTR TO 1ST ARG
	REGISTER PEXPRNODE ARG2NODE;			!PTR TO 2ND ARG NODE
	REGISTER PEXPRNODE SUB2NODE;		!PTR TO ARG2 UNDER THE FIRST ARG
	LOCAL NXLAB1;					!INDICATES LABEL TO BE GENERATED
							!HEREIN (PTR INTO LABEL TABLE)
	LOCAL THENP,ELSEP;				!INDICATE LOCS FOR "TRUE-TRANSFER"
							!AND "FALSE-TRANSFER" FOR
							!SUBNODES WHICH ARE ALSO BOOLEANS
	LOCAL FINJMP;					!ADDR (THENLAB FOR AND, ELSELAB FOR OR) TO
							! TRANSFER TO IF DO NOT EXIT AT ANY SUBNODE
	LOCAL JMPCND;					!INDICATES WHICH VALUE (TRUE OR FALSE)
							!OF A SUBNODE WHICH IS A RELATIONAL
							!OR A DATA ITEM SHOULD FORCE
							!A TRANSFER
	LOCAL JMADDR;					!INDICATES WHERE TO TRANSFER TO


	%(************************
		DEFINE MACRO TO GENERATE CODE THAT WILL COMPUTE THE VALUE
		OF THIS NODE AND THEN TEST IT.
	**************************)%
	MACRO EVALANDTST=
	BEGIN
		CGVBOOL();
		TREEPTR_.CNODE;
		REGFORCOMP_GETTAC(CNODE);
		A1LABEL_.THENLAB;
		A2LABEL_.ELSELAB;
		OPDSPIX_ALTTRIX(CNODE);
		CGOPGEN();
	END$;

	%(***DEFINE MACRO THAT TESTS WHETHER A NODE IS A BOOLEAN
		IN WHICH ARG2 IS OF TYPE CONTROL (IF ONLY ONE ARG
		IS OF TYPE CONTROL, THAT ARG WILL ALWAYS BE ARG2)**)%
	MACRO CTLMBOOL(NODE)=
	BEGIN
		IF .NODE[OPRCLS] EQL BOOLEAN
		THEN
		BEGIN
			SUB2NODE_.NODE[ARG2PTR];
			IF .SUB2NODE[VALTYPE] EQL CONTROL 
			THEN TRUE
			ELSE FALSE
		END
		ELSE FALSE
	END$;



	CNODE_.TREEPTR;

	%(**********
		FOR PURPOSES OF CODE GENERATION WE DIVIDE BOOLEANS INTO
		TWO CLASSES-
		FOR AND AND OR THE VALUES OF ALL SUBNODES DO NOT ALWAYS
		HAVE TO BE COMPUTED; FOR XOR AND EQV THEY DO
	**********)%

	IF .CNODE[BOOLCLS] EQL ANDORCLS
	THEN
	%(**********FOR AN AND NODE OR AN OR NODE*********)%
	BEGIN

		%(*****DETERMINE WHAT THE VALUE OF EACH SUBNODE WILL IMPLY*****)%
		IF .CNODE[BOPRFLG] EQL ANDOPF
			THEN
			%(*****IF PARENT NODE IS AND*****)%
			BEGIN
				JMPCND_FALSE;		!IF SUBNODE IS FALSE
				JMADDR_.ELSELAB;	! TRANSFER OUT TO ELSELAB
				ELSEP_ELSELAB;
				THENP_NXLAB1;		!IF TRUE, GO ONTO NEXT
							! SUBNODE
				FINJMP_.THENLAB;	!IF LAST SUBNODE IS TRUE,
							! TRANSFER TO THENLAB
			END

			ELSE
			%(*****IF PARENT NODE IS OR*****)%
			BEGIN
				JMPCND_TRUE;		!IF SUBNODE IS TRUE
				JMADDR_.THENLAB;	! TRANSFER OUT TO THENLAB
				THENP_THENLAB;
				ELSEP_NXLAB1;		!IF FALSE, GO ONTO NEXT
							! SUBNODE
				FINJMP_.ELSELAB;	!IF LAST SUBNODE IS FALSE,
							! TRANSFER TO ELSELAB
			END;


		ARG1NODE_.CNODE[ARG1PTR];
		ARG2NODE_.CNODE[ARG2PTR];


		%(***IF BOTH ARGS ARE MASKS - (IF ARG2 IS A MASK, CAN
			ASSUME THAT ARG1 IS A MASK. THIS REORDERING
			WAS DONE IN  "CMPVBOOL" IN THE COMPLEXITY PASS) ***)%
		IF .ARG2NODE[VALTYPE] NEQ CONTROL	!IF BOTH ARGS ARE MASKS
		THEN
		(EVALANDTST; RETURN);	!EVALUATE THE BOOLEAN, THEM TEST THE VALUE



		%(***IF THE 2ND ARG IS OF TYPE CONTROL, BUT THE 1ST ARG IS A MASK***)%
		IF .ARG1NODE[VALTYPE] NEQ CONTROL	!IF ARG1 IS NOT A RELATIONAL 
						! NOR A BOOLEAN MADE UP OF RELATIONALS
			AND NOT (CTLMBOOL(ARG1NODE))	! NOR A BOOLEAN IN WHICH
				 	! ONE OF THE ARGS IS A REL OR A
					! BOOLEAN MADE UP OF RELS
		THEN

		BEGIN
			OWN OJMPCND;	!INDICATES WHETHER WISH TO JUMP ON
					! VARIABLE TRUE OR ON FALSE
			TREEPTR_.ARG1NODE;
			CGETVAL();

			OJMPCND_(IF .CNODE[A1NOTFLG]	!IF WANT "NOT" OF THE VAR
				THEN NOT .JMPCND	! THEN JUMP ON OPPOSITE CONDITION
							! FROM THAT FOR THE WHOLE EXPRESSION
				ELSE .JMPCND);
			TREEPTR_.ARG1NODE;
			REGFORCOMP_GETTAC(CNODE);
			A1LABEL_.JMADDR;
			OPDSPIX_TSTARGTRIX(CNODE,.OJMPCND);
			CGOPGEN();
		END

		ELSE
		%(****IF 1ST ARG IS OF TYPE CONTROL, CODE FOR THAT ARG
			SHOULD BE GENERATED TO TRANSFER TO LOCS SPECIFIED
			FOR PARENT************)%
		BEGIN
			TREEPTR_.ARG1NODE;

			IF .ARG1NODE[OPRCLS] EQL BOOLEAN
			THEN
			%(**********IF THIS ARGUMENT IS A BOOLEAN OPERATION******)%
			BEGIN
				NXLAB1_GENLAB();
				CGCBOOL(@@THENP,@@ELSEP);
				DEFLAB(.NXLAB1);	!ASSOCIATE THE CURRENT
							!LOCATION WITH THE LABEL
							!ENTRY .NXLAB1
			END

			ELSE
			IF .ARG1NODE[OPRCLS] EQL RELATIONAL
			THEN
			%(**********IF THIS ARGUMENT IS A RELATIONAL*********)%
			CGJMPC(.JMPCND,.JMADDR)

			%(***IF ARG IS NOT  A BOOLEAN OR RELATIONAL, COMPILER MADE AN ERROR***)%
			ELSE CGERR();



		END;

		%(*****ONLY FALL THRU HERE IF ARG2NODE IS OF TYPE CONTROL****)%

		%(****GENERATE CODE FOR 2ND ARG TO TRANSFER TO LOCS SPECIFIED BY PARENT****)%

		TREEPTR_.ARG2NODE;
		IF .ARG2NODE[OPRCLS] EQL BOOLEAN
		THEN

		%(****IF ARG2 IS A BOOLEAN OPERATION****)%
		CGCBOOL(.THENLAB,.ELSELAB)
		ELSE
		IF .ARG2NODE[OPRCLS] EQL RELATIONAL
		THEN
		%(****IF ARG2 IS A RELATIONAL*****)%
		BEGIN
			CGJMPC(.JMPCND,.JMADDR);
			JRSTGEN(.FINJMP);
		END

		ELSE CGERR();

	END


	ELSE
	%(**********FOR AN XOR OR EQV NODE**********)%
	%(***********EVALUATE THE BOOLEAN, THEN TEST IT*******)%
	EVALANDTST;

END;	! of CGCBOOL
GLOBAL ROUTINE CGREL1(SKCND)=

%(**********************************************************************
	ROUTINE TO GENERATE CODE FOR RELATIONALS
	THIS ROUTINE IS CALLED WITH A SINGLE ARGUMENT "SKCND"
		1. IF SKCND=TRUE:
			THE CODE GENERATED SKIPS THE NEXT INSTRUCTION IF
			THE RELATIONAL IS TRUE
		2. IF SKCND=FALSE:
			THE CODE GENERAPED SKIPS THE NEXT INSTRUCTION IFF THE
			RELATIONAL IS FALSE
	THE ROUTINE USES THE GLOBAL:
		TREEPTR-POINTER TO THE NODE IN THE TREE CURRENTLY BEING
			PROCESSED

	THIS ROUTINE IS NEVER CALLED IF EITHER SUBNODE IS THE CONSTANT ZERO

**********************************************************************)%

BEGIN

	LOCAL PEXPRNODE CNODE:ARG1NODE:ARG2NODE;

	CNODE_.TREEPTR;
	ARG1NODE_.CNODE[ARG1PTR];
	ARG2NODE_.CNODE[ARG2PTR];


	%(***CANNOT HANDLE NEGATE ON ARG2 OF A RELATIONAL. IF THERE
		WAS AN A2NEGFLG, IT SHOULD HAVE BEEN REMOVED IN CMPLREL. IF THERE
		IS ONE, HAVE AN INTERNAL COMPILER ERROR***)%
	IF .CNODE[A2NEGFLG] THEN CGERR();


	%(***GENERATE CODE TO EVALUATE THE 2 ARGS AND GET THE FIRST ARG
		INTO POSITION TO APPLY THE COMPARISON*****)%
	CGARGEVAL();
	%(***GET ARG1 INTO LOC FOR COMPUTATION***)%
	REGFORCOMP_GETTAUX(CNODE);
	OPDSPIX_GETA1OPIX(CNODE,ARG1NODE);
	CGOPGEN();

	%(***WHEN COMPARING A DOUBLE-PREC TO 0, CAN USE THE SAME CODE
		SEQUENCE AS IS USED FOR COMPARING A REAL TO 0 (SINCE CAN TELL BY
		THE FIRST WORD WHETHER HAVE 0,POS OR NEG)***)%
	IF .ARG2NODE[OPERATOR] EQL DOUBLCONST
	THEN
	BEGIN
		IF .ARG2NODE[CONST1] EQL 0 AND .ARG2NODE[CONST2] EQL 0
		THEN OPDSPIX_DPIMMRELOPIX(CNODE,.SKCND)
		ELSE OPDSPIX_RELOPIX(CNODE,ARG1NODE,.SKCND)
	END
	ELSE OPDSPIX_RELOPIX(CNODE,ARG1NODE,.SKCND);
	CGOPGEN();

END;	! of CGREL1
GLOBAL ROUTINE CGJMPC(JMCND,ADDR)=

%(**********************************************************************
	ROUTINE TO GENERATE A CONDITIONAL JUMP ON A RELATIONAL TO A SPECIFIED LOCATION
	CALLED WITH TWO ARGUMENTS:
		1. JMCND:
			IF JMCND=TRUE THE CODE GENERATED JUMPS IFF THE RELATIONAL
			REPRESENTED BY THE NODE BEING PROCESSED IS TRUE.
			IF JMCND=FALSE THE CODE GENERATED JUMPS IFF IT IS FALSE.
		2. ADDR:
			THE ADDRESS TO JUMP TO
	THIS ROUTINE USES THE GLOBAL:
		TREEPTR - PTR TO THE NODE IN THE TREE CURRENTLY BEING PROCESSED
			(THIS NODE WILL ALWAYS BE A RELATIONAL)

**********************************************************************)%

BEGIN
	CGREL1(NOT .JMCND);		!GENERATE CODE TO SKIP IF CONDITION FOR JUMP DOES 
					! NOT HOLD
	JRSTGEN(.ADDR);			!GENERATE A "JRST .ADDR"

END;	! of CGJMPC
GLOBAL ROUTINE DEFLAB(LABPTR)=
%(*******************************************************************
	ROUTINE TO IDENTIFY THE CURRENT LOCATION WITH THE LABEL ENTRY
	SPECIFIED BY THE ARG LABPTR
***********************************************************************)%
BEGIN
	MAP BASE LABPTR;		!PTR TO THE LABEL ENTRY THAT
						! WE WANT TO ASSOCIATE WITH
						! THE CURRENT LOCATION
	OWN BASE LAB1;

	IF .PBFPTR[PBFLABEL] EQL NOLABEL
	THEN
	%(*****IF THIS IS THE 1ST LABEL TO BE ASSOCIATED WITH THIS LOC****)%
	BEGIN
		PBFPTR[PBFLABEL]_.LABPTR;	!SET 1ST LABEL ASSOCIATED
						! WITH THIS LOC TO THIS ONE
		LABPTR[SNSTATUS]_INPBUFF;	!FLAG IN LABEL ENTRY INDICATING
						! THAT THE LOC ASSOCIATED WITH
						! THIS LABEL IS CURRENTLY IN THE
						! PEEPHOLE BUFFER
		LABPTR[SN1STLAB]_.LABPTR;	!FOR THIS LABEL, SET THE FIELD INDICATING
						! "1ST LABEL ASSOC WITH SAME LOC"
						! TO BE THIS LABEL ITSELF
		%(***IF THERE ARE ANY LABELS CHAINED TO LABPTR (IE PEEPHOLER HAS
			DETERMINED THEM TO BE EQUAL TO LABPTR EVEN THO UNRESOLVED)
			SET THE "SNCADDRWD" (WORD INCLUDING STATUS AND PTR TO 1ST 
			LABEL WITH THE SAME ADDR) TO BE EQUAL TO THOSE OF LABPTR ***)%
		LAB1_.LABPTR[SNNXTLAB];
		UNTIL .LAB1 EQL LBTBENDMK
		DO
		BEGIN
			LAB1[SNCADDRWD]_.LABPTR[SNCADDRWD];
			LAB1_.LAB1[SNNXTLAB];
		END;

	END

	%(***IF SOME OTHER LABEL(S) ARE ALREADY ASSOCIATED WITH THIS INSTR, ADD THIS
		LABEL TO THE SET OF LABELS ASSOCIATED WITH THIS INSTR***)%
	ELSE
	ADDLAB(.LABPTR,.PBFPTR[PBFLABEL]);

END;	! of DEFLAB

END
ELUDOM