Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/comp/cgob.mac
There are 2 other files named cgob.mac in the archive. Click here to see a list.
00100		SUBTTL	Written by Olof Bjorner Sep-73
00200	
00300	COMMENT ;
00400	
00500	Version:	4A [10,174,321,327]
00600	
00700	Purpose:	To compile an assignment statement
00800	
00900	Contents:	The subroutine CGAS which is called externally
01000			The following local subroutines:
01100			 CGASTX	for text assignment
01200			 CGASFP	for assignment to formal parameter
01300			 CGASRI	for assignment to remote identifier
01400			 CGASAR	for assignment to array element
01500			 CGASEQ	which compares two ZID-nodes and skips if they represent
01600				the same identifier
01700	;
01800	
01900		SEARCH	SIMMAC,SIMMC2,SIMMCR
02000		sall
02100		CTITLE 	CGOB
02200		TWOSEG
02300		RELOC	400K
02400		MACINIT
02500		CGINIT
02600	
02700		INTERN	CGAS
02800	
02900		EXTERN	YZHBXC,YCGACT,YLXIAC
03000		EXTERN	YO2ADI,YOPCOD,YTAC	;LOW SEGMENT VARIABLES
03100				edit(321)
03200		EXTERN	YFORSI	;[321]
03300		EXTERN	O2GA,O2GR,O2GI,O2AD	;Output routines
03400		EXTERN	O2CF,O2DF,O2GF,O2GW,O2GWD,O2IV
03500		EXTERN	CGRD,CGG4,CGR4,CGMO,CGMO1,CGVA,CGAD,CADS,CGAA
03600		EXTERN	CGCA,CGCC,CGCO,CGG2,CGG3,CGIM,CGIM1,CGLO,CGLO1,CGR2,CGR3
03700				edit(174)
03800		EXTERN	ORTXCH	;[174]
03900						;Code generation routines
04000	
04100		OPDEF	EXITAS		[GOTO	CGASEXIT]
04200		OPDEF	IFNOTSAME	[PUSHJ	XPDP,CGASEQ]
04300	
04400		DSW	CGSWAP,0,35,XL2	;This switch is on if RHS can be compiled first
04500	
04600	IFN QDEBUG,<
04700	CGASER:	ASCIZ/ILL ZNNCOD DURING ASSIGNMENT COMPILATION/>
     
00100		SUBTTL	CGAS	Assignment compilation
00200	
00300	comment ;
00400	
00500	Method:	1. Inspect lhs(left hand side node), if it is text assignment
00600		   execute CGASTX and exit.
00700		2. If rhs(right hand side node) is a
00800		   memory operand or else if there are no side-effects
00900		   in rhs or lhs go to step 4.
01000		3. Compile lhs before rhs and exit.
01100		4. If rhs is of kind simple go to step 6.
01200		5. Compile rhs before lhs and exit.
01300		6. Look for optimizable cases and compile special code if
01400		   possible else go to step 5.
01500	
01600	Entry conditions:
01700		X1 points at lhs
01800		X2 points at rhs.
01900		XCUR points at their  parent
02000	
02100	Exit conditions:
02200		@YTAC contains value of rhs.
02300	;
02400	
02500	CGAS:
02600		PROC
02700		SAVE	<X6,X7,XP1,XP2,XL1,XL2,XV1,XV2,XCUR>
02800		LD	XP1,X1		;NOW XP1 -> LHS AND XP2 -> RHS
02900	
03000		;Take care of text assignment first
03100		LF	X6,ZNNTYP(XP1)
03200		IF	;Text assignment
03300			CAIE	X6,QTEXT
03400			GOTO	FALSE
03500			LF	,ZNSGEN(XCUR)
03600			CAIN	%BECOM
03700			GOTO	TRUE
03800				edit(321)
03900			CAIE %FORSI	;[321]
04000			GOTO .+4	;[321]
04100			MOVN YFORSI	;[321]
04200			CAIN 1		;[321]
04300			GOTO TRUE	;[321]
04400	edit(174)
04500	;[174]		WHENNOT	X2,ZCN
04600	;[174]		GOTO	FALSE
04700	;[174]		HRRZ	OFFSET(ZCNVAL)(X2)
04800	;[174]		SKIPE
04900			L	X0,X2	;[174]
05000			EXEC	ORTXCH	;[174]
05100			GOTO	FALSE	;[174]
05200			ERROR2	51,TEXT STRING AFTER DENOTES
05300			GOTO	FALSE
05400		THEN	EXEC	CGASTX
05500			EXITAS
05600		FI
05700	
05800		;Then check if RHS can be compiled first
05900		IFMEMO			;LHS memory opnd?
06000		GOTO	CGASSW		;Yes!
06100		IFOFF	ZNSSEF(XCUR)	;side-effects in RHS or LHS?
06200		GOTO	CGASSW	;No!
06300		WHEN	(XP2,ZCN)	; RHS constant
06400		GOTO	CGASSW
06500	
     
00100		;Must compile LHS first!
00200		SETOFA	CGSWAP		;Flag LHS first
00300		COMPAD			;Compute address to LHS
00400		L	XL1,@YTAC
00500		AOS	YTAC
00600		LF	XV1,ZNNCOD(XP1)
00700		IF	CAIN	XV1,QCODAR
00800			GOTO	TRUE
00900			CAIE	XV1,QCODCA
01000			GOTO	FALSE
01100			LF	,ZNNTYP(XP1)
01200			CAIE	QREF
01300			GOTO	FALSE
01400		THEN
01500			AOS	YTAC	; LHS is two words
01600		FI
01700		EXCH	XP1,XP2
01800		COMPVAL			;Compute value of RHS
01900		EXCH	XP1,XP2
02000		L	XV2,@YTAC	;Save value of ac that holds RHS value
02100	
02200		;Now check type of LHS. Valid types are remote identifier,
02300		;array element and formal parameter and they are tried in that order
02400		IF	;Remote identifier
02500			CAIE	XV1,QCODRA
02600			GOTO	FALSE
02700		THEN	L	XV1,XL1		;Load base address ac
02800			EXEC	CGASRI
02900		ELSE
03000		IF	;Array element
03100			CAIE	XV1,QCODAR
03200			GOTO	FALSE
03300		THEN	L	XV1,XL1		;Load array address ac to XV1
03400			ADDI	XL1,1
03500						;Ac with offset already in XL1
03600			EXEC	CGASAR
03700		ELSE
03800		IF	;Formal parameter
03900			CAIE	XV1,QCODCA
04000			GOTO	FALSE
04100		THEN	L	XV1,XL1		;Load dynamic address ac
04200			EXEC	CGASFP
04300		ASSERT<
04400		ELSE	;Illegal result descriptor!
04500			RFAIL	CGASER
04600		>
04700		FI FI FI
04800		SOS	YTAC
04900	
05000	CGASEXIT:		;Common termination point for CGAS
05100		RETURN
05200	
     
00100		;This code takes care of the case when RHS can be compiled first
00200	
00300	CGASSW:
00400			;Now XP1 -> LHS and XP2 -> RHS
00500		SETONA	CGSWAP		;Flag RHS first
00600		LF	,ZIDZHE(XP1)
00700		IF	;We have a ZHE for this ZQU
00800			JUMPN	FALSE
00900		THEN	;It is an assignment to a procedure identifier
01000			EXCH	XP1,XP2
01100			COMPVAL
01200			L	X2,[MOVEM 2(XCB)]
01300			L	X1,XP1
01400			IFLONG
01500			 OP	X2,(DMOVEM (XCB))
01600			L	X2
01700			ADD	YCGACT
01800		; Check if assignment is in procedure block at outer level
01900			LF	X1,ZIDZQU(XP2)
02000			LF	X1,ZQUZB(X1)
02100			LF	X1,ZHEDLV(X1)
02200			L	X2,YZHBXC
02300			LF	X2,ZHEDLV(X2)
02400			IF	;Not declared at same block level
02500				CAMN	X1,X2
02600				GOTO	FALSE
02700			THEN	;Cannot use XCB as base
02800				L	X2,	; Save store instr.
02900				L	X1	; Display block offset
03000						edit(327)
03100				ST X1,YLXIAC	;[327] Remember dlv (as in O2AD)
03200				OP	(L	XIAC,(XCB))
03300				GENABS
03400				ADD	X2,[Z	(XIAC-XCB)]
03500				L	X2	; Restore modified instr
03600			FI
03700			GENABS
03800			EXITAS
03900		FI
04000		IF	WHENNOT	XP1,ZNS
04100			GOTO	TRUE	;LHS terminal
04200			WHENNOT	XP2,ZNS
04300			GOTO	TRUE	;RHS terminal
04400			LF	,ZNSGEN(XP2)
04500			CAIN	%THIS
04600			GOTO	FALSE	; Do not try to optimize 
04700		THEN
04800			IF	IFON	ZNSSEF(XCUR)
04900				GOTO	FALSE	; No optimization
05000			THEN
05100				GOTO	CGASOP
05200			FI
05300		FI
05400		EXCH	XP1,XP2		;XP1 -> RHS now
05500	
05600	L1():!	;Return here from CGASOP when we could not optimize
05700		COMPVAL			;Compile RHS
05800		STACK	YTAC
05900		L	XV2,@YTAC	;Load ac with result
06000		AOS	YTAC
06100		HLRZ	X1,XV2
06200		IFLONG
06300		AOS	YTAC
06400		EXCH	XP1,XP2		;XP1 -> LHS
06500		COMPAD			;Compute address to LHS
06600	
06700		;Type of left hand side may now be either of
06800		;local identifier, remote identifier, array element
06900		;or formal parameter and they are tried in that order.
07000	
07100		LF	X6,ZNNCOD(XP1)
07200		IF	;Local identifier
07300			CAIE	X6,QCODVA
07400			GOTO	FALSE
07500		THEN	LF	X1,ZNNZQU(XP1)
07600			UNSTK	YTAC
07700			GETAD
07800			OPZ	X2,(ST)
07900			HLRZ	X1,XV2
08000			IFLONG
08100			OPZ	X2,(STD)
08200			ST	X2,YOPCOD
08300			GENOP
08400		ELSE
08500		L	XV1,@YTAC	;Load ac with target address
08600					;(array, base or dynamic)
08700		IF	;Remote identifier
08800			CAIE	X6,QCODRA
08900			GOTO	FALSE
09000		THEN	EXEC	CGASRI
09100		ELSE
09200		IF	;Array element
09300			CAIE	X6,QCODAR
09400			GOTO	FALSE
09500		THEN	L	XL1,XV1		;Ac with offset
09600			ADDI	XL1,1
09700			EXEC	CGASAR
09800		ELSE
09900		IF	;Formal parameter
10000			CAIE	X6,QCODCA
10100			GOTO	FALSE
10200		THEN	EXEC	CGASFP
10300		ASSERT<
10400		ELSE	;ERROR!
10500			RFAIL	CGASER
10600		>
10700		FI FI FI
10800		UNSTK	YTAC
10900		FI
11000		EXITAS
11100	
     
00100	comment /
00200	
00300	This code takes care of certain optimizable cases:
00400	(The value of Xtop is found in YTAC)
00500	1. LHS is BOOLEAN:	b:=TRUE  is compiled as	SETOB	Xtop,b(XCB)
00600				b:=FALSE	"		SETZB	Xtop,b(XCB)
00700	2. LHS is REAL:		a:=a		"		L	Xtop,a(XCB)
00800				a:=0		"		SETZB	Xtop,a(XCB)
00900				a:=a+<EXPR.>	"		FADRB	Xtop,a(XCB)
01000				a:=a*<EXPR.>	"		FMPRB	Xtop,a(XCB)
01100	3. LHS is INTEGER:	i:=i		"		L	Xtop,i(XCB)
01200				i:=0		"		SETZB	Xtop,i(XCB)
01300				i:=-1		"		SETOB	Xtop,i(XCB)
01400				i:=i+1		"		AOS	Xtop,i(XCB)
01500				i:=i-1		"		SOS	Xtop,i(XCB)
01600				i:=i+<EXPR.>	"		ADDB	Xtop,i(XCB)
01700				i:=i*<EXPR.>	"		IMULB	Xtop,i(XCB)
01800	/
01900	
02000	CGASOP:
02100		LF	XL1,ZNNTYP(XP1)
02200		EXCH	XP1,XP2		;XP1 -> RHS
02300	
02400		IF	CONST
02500			GOTO	FALSE
02600			CAIN	XL1,QTEXT
02700			GOTO	FALSE	; Constant optimization not appl. to NOTEXT
02800		THEN
02900			LF	X0,ZCNVAL(XP1)
03000			CAME	X0,[-1]
03100			JUMPN	X0,L1		;Compile as usual if not const. 0 or -1
03200			OPZ	XL1,(SETOB)
03300			CAIN	X0,0
03400			OPZ	XL1,(SETZB)	;IF NOT b
03500		
03600	L3():!	;This code is used for all optimizable cases
03700			EXCH	XP1,XP2		;XP1 -> LHS
03800			IF	WHENNOT	XP1,ZID
03900				GOTO	FALSE
04000			THEN
04100				LF	X1,ZIDZQU(XP1)
04200				GETAD			;Address to simple variable
04300				ST	XL1,YOPCOD
04400				GENOP
04500			ELSE
04600				AOS	YTAC
04700				AOS	YTAC
04800				COMPAD
04900				HRRZ	X0,@YTAC
05000				LF	X1,ZNNCOD(XP1)
05100				CAIN	X1,QCODAR
05200				AOS	; This saves a L Xtop,Xtop+1 instruction
05300					; in array accesses
05400				L	X1,YTAC
05500				DPB	[INDEXFIELD	XL1]
05600				EXEC	CGAA
05700				HLLZ	XL1
05800				ADD	YCGACT
05900				GENABS
06000			FI
06100			EXITAS
06200		FI
     
00100		;Now see if LHS is integer or real
00200	
00300		CAIL	XL1,QINTEGER
00400		CAILE	XL1,QREAL
00500		GOTO	L1
00600	
00700		IF	IFNOTSAME
00800			GOTO	FALSE		;No it was not
00900		THEN
01000			OPZ	XL1,(L)
01100			GOTO	L3
01200		FI
01300		IFMEMOP
01400		GOTO	L1	;RHS memory operand
01500	
01600		;Here if RHS is an expression
01700		LF	XV1,ZNSZNO(XP1)
01800		LI	XV2,2(XV1)
01900	
02000		;Now	XP1 -> RHS
02100		;	XP2 -> LHS
02200		;	XV1 -> first opnd
02300		;	XV2 -> last node
02400		;	XL1 contains type of LHS (integer or real)
     
00100	
00200		;Now see if first node <=> LHS
00300		EXCH	XP1,XV1		;XP1 -> First node XP2=>LHS
00400			IF
00500				CONST
00600				GOTO	FALSE
00700			THEN
00800				EXCH	XP1,XV1		;XP1 -> RHS
00900				GOTO	L1
01000			FI
01100			IF
01200			    IFNOTSAME
01300			    GOTO	FALSE
01400			THEN
01500				;SEE IF LAST NODE IS A CONSTANT = 1
01600			    EXCH	XP1,XV2		;XP1 -> LAST OPERAND
01700							;XV2 -> FIRST  -"-
01800			    IF
01900				CONST
02000				GOTO  FALSE
02100			    THEN
02200				LF	X6,ZCNVAL(XP1)
02300				IF
02400				    CAIE	X6,1
02500				    GOTO  FALSE
02600				    CAIE  XL1,QINTEGER
02700				    GOTO  FALSE
02800				THEN
02900					;SEE IF IT IS I:=I+1; OR I:=I-1;
03000				    EXCH  XP1,XV1	;XP1 -> RHS
03100							;XV1 -> LAST OPERAND
03200				    LF    X6,ZNSGEN(XP1)
03300				    IF
03400					CAIE	X6,%PLUS
03500					GOTO	FALSE
03600				    THEN
03700					OPZ	XL1,(AOS)
03800				    ELSE
03900					IF
04000					    CAIE  X6,%MINUS
04100					    GOTO  FALSE
04200					THEN
04300					    OPZ   XL1,(SOS)
04400					ELSE
04500					    GOTO  L1
04600					FI
04700				    FI
04800				    GOTO  L3	;FIND ADDRESS TO LHS
04900				FI
05000			    FI
05100			    EXCH  XV1,XV2	;XV1 -> FIRST OPERAND
05200			    EXCH  XP1,XV2	;XP1 -> RHS
05300			    GOTO  L4		;XV2 -> LAST OPERAND
05400			FI
05500	
05600	
05700			;NOW SEE IF LAST NODE <=> LHS
05800		EXCH	XP1,XV2				;XP1 -> LAST OPERAND
05900							;XV2 -> FIRST  -"-
06000							;XV1 -> RHS
06100			IF
06200				CONST
06300				GOTO	FALSE
06400			THEN
06500				EXCH	XP1,XV1		;XP1 -> RHS
06600				GOTO	L1
06700			FI
06800			IF
06900				IFNOTSAME
07000				GOTO	FALSE
07100			THEN
07200				;SEE IF IT IS X:=X+<EXP> OR X:=X*<EXP>
07300				; WHERE X COULD BE INTEGER OR REAL
07400	
07500				EXCH	XP1,XV1		;XP1 -> RHS
07600							;XV1 -> LAST OPERAND
07700	L4():			LF	X6,ZNSGEN(XP1)
07800				IF
07900					CAIE	X6,%PLUS
08000					GOTO	FALSE
08100				THEN
08200					IF
08300						CAIE	XL1,QINTEGER
08400						GOTO	FALSE
08500					THEN
08600						OPZ	XL1,(ADDB)
08700					ELSE
08800						OPZ	XL1,(FADRB)
08900					FI
09000				ELSE
09100					IF
09200						CAIE	X6,%MULT
09300						GOTO	FALSE
09400					THEN
09500						IF
09600							CAIE	XL1,QINTEGER
09700							GOTO	FALSE
09800						THEN
09900							OPZ	XL1,(IMULB)
10000						ELSE
10100							OPZ	XL1,(FMPRB)
10200						FI
10300					ELSE
10400						GOTO	L1
10500					FI
10600				FI
10700				EXCH	XP1,XV2		;XP1 -> FIRST OR LAST OPERAND
10800							;XV2 -> RHS
10900				COMPVAL		;COMPILE EXPRESSION
11000				GOTO	L3	;FIND ADDRESS TO LHS
11100			FI
11200		EXCH	XP1,XV1			;XP1 -> RHS
11300						;XV1 -> LAST OPERAND
11400						;XV2 -> FIRST  -"-
11500		GOTO	L1	;COMPILE AS USUAL
11600		EPROC
     
00100		SUBTTL	CGASTX - Text assignment
00200	
00300	comment ;
00400	Purpose:	To compile code for text assignment.
00500			The following code is generated:
00600	
00700				LI	XSAC+1,@YTAC
00800				PUSHJ XPDP,TXVA
00900	
01000			Before the execution of these statements Xtop
01100			and Xtop+2 contain the values of the text
01200			expressions in the LHS and RHS respectively.
01300			[10] Check if LHS is a text procedure identifier
01400			and do not use COMPVAL in this case to compile
01500			LHS to @YTAC.
01600	;
01700	
01800	CGASTX:
01900		edit(10)	;[10]	Check if LHS is a procedure identifier
02000		LF	,ZIDZHE(XP1)
02100		IF	;There was a ZHE for this ZQU
02200			JUMPN	FALSE
02300		THEN	;Assignment to procedure id.
02400			;Fetch the text variable from the procedure block
02500			HRLM	XP1,@YTAC	;Fix the accumulator table entry
02600			L	X2,[DMOVE 2(XCB)]
02700			L	X1,XP1
02800			L	X2
02900			ADD	YCGACT
03000		; Check if assignment is at outer level in procedure block
03100			LF	X1,ZIDZQU(XP1)
03200			LF	X1,ZQUZB(X1)
03300			LF	X1,ZHEDLV(X1)
03400			L	X2,YZHBXC	;ZHB for current XCB
03500			LF	X2,ZHEDLV(X2)
03600			IF	;Not at XCB level
03700				CAMN	X1,X2
03800				GOTO	FALSE
03900			THEN	;Cannot use XCB for reference to the proc id
04000				L	X2,	; Save store instr.
04100				L	X1	; Display block offset
04200				ST X1,YLXIAC	;[327] Remember dlv as in O2AD
04300						;[327] Could be used in RHS.
04400				OP (L XIAC,(XCB))
04500				GENABS
04600				ADD X2,[Z (XIAC-XCB)]
04700				L X2		; Restore modified instr
04800			FI
04900			GENABS
05000		ELSE
05100			COMPVAL			;Compute value of LHS
05200		FI
05300			;[10[ End of check for procedure id.
05400		EXCH	XP1,XP2
05500		AOS	YTAC
05600		AOS	YTAC
05700		COMPVAL			;Compute value of RHS
05800		SOS 	YTAC
05900		SOS	YTAC
06000		OP	(LI	XSAC+1,)
06100		HRR	@YTAC
06200		GENABS			;LI	XSAC+1,@YTAC
06300		GPUSHJ	TXVA		;EXEC	TXVA
06400	;[327]	SETZM	YLXIAC		;Already done by GPUSHJ macro
06500		RETURN
     
00100		SUBTTL	CGASRI - Remote identifier
00200	
00300	comment /
00400	Purpose:	To compile code for remote assignment
00500	Entry conditions:
00600			XP1 -> LHS
00700			XP2 -> RHS
00800			XV1 contains base address ac number
00900			XV2 contains ac number of RHS value
01000	Generated code:
01100			(D)MOVEM @XV2,ZQUIND(@XV1)
01200			ST(D)	@XV2,@XV1	;Only when LHS is compiled first
01300	/
01400	
01500	CGASRI:
01600		OP	XL1,(MOVEM)
01700		L	X1,XP2
01800		IFLONG
01900		 OP	XL1,(STD)		;Double word result
02000		LF	X1,ZNNZNO(XP1)		;Fetch ZQUIND
02100		STEP	X1,ZID
02200		LF	X1,ZIDZQU(X1)
02300		L	XL1
02400		HRR	OFFSET(ZQUIND)(X1)	;Offset to RH
02500		DPB	XV1,[INDEXFIELD]
02600		DPB	XV2,[ACFIELD]
02700		GENABS
02800		IFONA	CGSWAP
02900		 RET			;If RHS compiled first
03000		L	X1,YLINK
03100		SKIPN	(X1)
03200		 RET			; If not multiple assignment
03300		L	XL1
03400		DPB	XV2,[ACFIELD]
03500		HRR	XV1
03600		GENABS
03700		RETURN
     
00100		SUBTTL	CGASAR - Array element assignment
00200	
00300	comment /
00400	Purpose:	To compile code for assignment to array element
00500	Entry conditions:
00600			XP1 -> LHS
00700			XP2 -> RHS
00800			XV1 contains array address ac number
00900			XL1 contains offset to base
01000			XV2 contains ac number of value of RHS
01100	Generated code:
01200			ADD	@XL1,OFFSET(ZARBAD)(@XV1)
01300			(D)MOVEM @XV2,@XL1
01400			(D)MOVEM @XV2,@XV1	;Only if LHS compiled first
01500	/
01600	
01700	CGASAR:
01800		L	[ADD OFFSET(ZARBAD)]
01900		DPB	XV1,[INDEXFIELD]
02000		DPB	XL1,[ACFIELD]
02100		GENABS			;ADD-INSTR.
02200		OPZ	X2,(MOVEM)
02300		L	X1,XP2
02400		IFLONG
02500		 OPZ	X2,(DMOVEM)
02600		L	X2
02700		DPB	XL1,[INDEXFIELD]
02800		DPB	XV2,[ACFIELD]
02900		GENABS			;STORE-INSTR.
03000		IFONA	CGSWAP
03100		 RET			;If RHS compiled first
03200		L	X1,YLINK
03300		SKIPN	(X1)
03400		 RET			; If not multiple assignment
03500		L	X2		; DMOVEM or MOVEM
03600		DPB	XV2,[ACFIELD]
03700		HRR	XV1
03800		GENABS			;LOAD-INSTRUCTION
03900		RETURN
     
00100		SUBTTL	CGASFP - Formal parameter assignment
00200	
00300	comment /
00400	Purpose:	To compile code for assignment to formal parameter
00500	Entry condition:
00600			XP1 -> LHS
00700			XV1 contains dynamic address ac number
00800			XV2 contains number of ac holding RHS value
00900	Generated code:
01000			HLLZ	p(XVB)	;Load left half of first formal location
01100			PUSHJ XPDP,PHFS
01200			XWD	@XV2,@XV1
01300			(D)MOVE @XV1,@XV2	;Only when LHS is compiled first
01400	/
01500	
01600	CGASFP:
01700		LF	XP2,ZIDZQU(XP1)
01800		L	X1,XP2
01900		GETAD
02000		LI	X0
02100		DPB	[ACFIELD YO2ADI]
02200		OP	(HLLZ)
02300		ST	YOPCOD
02400		GENOP			;HLLZ instr.
02500		GPUSHJ	PHFS		;PUSHJ instr
02600		HRL	XV2
02700		HRR	XV1
02800		GENABS			;XWD
02900		IFONA	CGSWAP
03000		 RET			;If RHS compiled first
03100		; Check if in multiple assignment
03200		L	X2,YLINK
03300		SKIPN	(X2)
03400		 RET			; Not multiple assignment
03500		OPZ	X2,(MOVE)
03600		L	X1,XP2
03700		IFLONG
03800		 OPZ	X2,(DMOVE)
03900		L	X2
04000		DPB	XV1,[ACFIELD]
04100		HRR	XV2
04200		GENABS
04300		RETURN
     
00100		SUBTTL	CGASEQ Compare expression nodes
00200	
00300	comment ;
00400	Purpose:	To compare the expressions that are represented
00500			by two expression nodes and return with skip if
00600			they are identical
00700	Entry condition:
00800			XP1 and XP2 should point at two expression nodes.
00900	;
01000	
01100	CGASEQ:	L	1(XP1)
01200		CAME	1(XP2)		;Compare second words
01300		 RET			;Not equal
01400		n==0	;Stack size
01500		IF	WHENNOT	XP1,ZNS
01600			GOTO	TRUE
01700			LF	,ZNSGEN(XP1)
01800			CAIE	%THIS
01900			GOTO	FALSE
02000		THEN	; Terminal nodes
02100			L	(XP1)
02200			XOR	(XP2)
02300			TLZN	577777	; Compare first halfwords
02400			 AOS	-n(XPDP)
02500			RET
02600		ELSE	; Non-terminal nodes, compare recursively
02700			STACK	XP1
02800			STACK	XP2
02900			n==2
03000			LF	XP1,ZNSZNO(XP1)
03100			LF	XP2,ZNSZNO(XP2)
03200			LOOP
03300				EXEC	CGASEQ
03400				 GOTO	NOTEQUAL
03500			AS
03600				IFON	ZNOLST(XP1)
03700				GOTO	FALSE	;That was last node
03800				STEP	XP1,ZNS
03900				STEP	XP2,ZNS
04000				GOTO	TRUE
04100			SA
04200			; EQUAL
04300			AOS	-n(XPDP)
04400		NOTEQUAL:UNSTK	XP2
04500			UNSTK	XP1
04600			n==0
04700			RET
04800		FI
04900		PURGE n
05000	
05100		LIT
05200		END