;
;
;COPYRIGHT (C) 1975,1981,1982 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;
;
;SUBTTL CODE GENERATION ROUTINES PART 1

; WRITTEN BY H. VAN ZOEREN, C.M.U.
; EDITED BY R. M. DE MORGAN AND Andrew J. Skinner

	HISEG

	SEARCH ALGPRM,ALGMAC	; SEARCH PARAMETER FILES
	MODULE MCOD;
	$PLEVEL=2;
BEGIN

EXPROC CHECKARITH
EXPROC CLOSE
EXPROC COMBASSIGN
EXPROC COMBLEX
EXPROC CONVERT
EXPROC EMITCODE
EXPROC ERRLEX
EXPROC FAIL
EXPROC GLOAD
EXPROC IPLUNK
EXPROC LOAD
EXPROC MARRY
EXPROC MERGEPORTIONS
EXPROC PLUNK
EXPROC REOPEN
EXPROC REVORDER
EXPROC SETUP
EXPROC STOCON
EXPROC TOCT1
EXPROC TOCT2

EXTERN CTILR,CTLRI,CTLRR	;COMPILE-TIME CONVERSION SR'S;
EXTERN POWC1,POWC2,POWC3			;COMPILE-TIME POWER SR'S;

INTERN OPUMIN,OPABS,OPENT1,OPENT2,OPENT3,OPJSPX,OPMVMS	; OPS USED IN CGFUN
INTERN OPPSJP,OPSGN1,OPSGN2,OPSGN3,OPSETO
INTERN OPADDB,OPAOS,OPSOS,OPMVSM
INTERN OPJMPE,OPJMPG,OPJRST,OPMVLP
INTERN OPCONC,OPCONV,OPMOVE,OPABS1,OPLNEG
INTERN OPENT4,OPENT5,KIOPS


; * * * * TABLE OF INSTRUCTIONS (ACTUAL AND PSEUDO)
;	    TO BE GENERATED IN CGEN AND CGFUN

OPCODE:
OPPOW:	POWR1	0,$R !7		; 3 BY 4 TABLE OF "^" SUBROUTINES
	POWR4	0,$R !0		;
	POWR5	0,$LR!0		;
OPTDZA:	TDZA				; USED IN RELATIONS
	POWR2	0,$R !7		;
	POWR4	0,$R !1		;
	POWR5	0,$LR!1		;
OPSETO:	SETO				; USED IN RELATIONS
	POWR3	0,$LR!7		;
	POWR5	0,$LR!2		;
	POWR5	0,$LR!3		;

OPTIMES:IMUL			; INTEGER "*"
	FMPR			; REAL "*"
	LFMP			; LONG REAL "*" (PSEUDO OPN)
	DFMP	A0,A3

OPDIV:	IDIV			; INTEGER "DIV"
OPSLASH:NOOP
OPREM:	FDVR			; REAL "/"
	LFDV			; LONG REAL "/" (PSEUDO OPN)
	DFDV	A0,A3
	RLFDV			; REVERSED LONG REAL "/" (PSEUDO OPN)

OPUMIN:	MOVN			; INTEGER NEGATE
OPUPLUS:MOVN			; REAL NEGATE
OPLNEG:	LMOVN	0,0		; LONG REAL NEGATE PSEUDO-OP
OPPLUS:	ADD			; INTEGER "+"
	FADR			; REAL "+"
	LFAD			; LONG REAL "+" (PSEUDO OPN)
	DFAD	A0,A3		; LFADC

OPMINUS:SUB			; INTEGER "-"
OPFSBR:	FSBR			; REAL "-"
OPLFSB:	LFSB			; LONG REAL "-" (PSEUDO OPN)
	DFSB	A0,A3
	RLFSB			; REVERSED LONG REAL "-" (PSEUDO OPN)

OPLSS:	CAML			; INTEGER OR REAL "<"
	CAIL			; LONG REAL "<"
OPGTR:	CAMG			; ">" (AND REVERSED "<")
	CAIG
OPRGTR:	CAML			;   REVERSED ">"
	CAIL

OPLEQ:	CAMLE			; INTEGER OR REAL "<="
	CAILE			; LONG REAL "<="
OPGTE:	CAMGE			; ">=" (AND REVERSED "<=")
	CAIGE
OPRGTE:	CAMLE			;   REVERSED ">="
	CAILE

OPEQ:	CAME			; INTEGER OR REAL "="
	CAIE			; LONG REAL "="
OPNE:	CAMN			; INTEGER OR REAL "#"
	CAIN			; LONG REAL "#"

OPNOT:	SETCM			; BOOLEAN "NOT"
OPAND:	AND			; BOOLEAN "AND"
OPOR:	OR			; BOOLEAN "OR"
OPIMP:	ORCA			; BOOLEAN "IMP"
OPEQV:	EQV			; BOOLEAN "EQV"
OPRIMP:	ORCM			; REVERSED "IMP"

OPASS:	MOVEM			; INTEGER ":="
	MOVEM			; REAL ":="
	LMOVEM			; LONG REAL ":=" (PSEUDO OPN)
	LMOVEM			; STRING ":=" (PSEUDO OPN)
OPTCSF:	TCSF			; FORMAL ":=" (PSEUDO OPN)

OPCONV:	CIR			; 3 BY 4 TABLE OF CONVERSION CALLS
	CIL			;
OPPUSH:	PUSH				; USED IN "^"CALL
	CRI			;
OPMVI1:	MOVEI	1,0			; USED IN "^" CALL
	CRL			;
OPLPSH:	LPUSH				; LONG REAL PUSH PSEUDO (USED IN "^" CALL)
	CLI			;
	CLR			;
OPJSPX:	ELI			; LONG ENTIER
OPMOVE:	MOVE			; INTEGER MOVE
	MOVE			; REAL MOVE
	LMOVE			; LONG REAL MOVE (PSEUDO OPN)

OPCONC:	FLTR	A0,A0		; 3 BY 4 TABLE OF COMPILE-TIME
	PUSHJ	SP,CTILR	;   CONVERSIONS FOR CONSTANTS
OPPSJP:	PUSHJ	SP,0		; USED TO CALL LIBRARY FUNCTIONS
	FIXR	A0,A0		;
OPABS:	MOVM			; IN-LINE "ABS"
	SETZ	A1,		;
OPMVMS:	MOVM	0,(SYM)		; CONSTANT TO LOAD ABS(SYM)
	PUSHJ	SP,CTLRI	;
	PUSHJ	SP,CTLRR	;
OPABS1:					;..AND IN .CGFTEST (ALGFUN)
	EXP	<JUMPGE 0,2>!$RA_22	;USED IN IN-LINE LONG "ABS"

OPPOWC:	PUSHJ	SP,POWC1	; COMPILE-TIME INTEGER "^" INTEGER
	PUSHJ	SP,POWC2	; COMPILE-TIME REAL "^" INTEGER
	PUSHJ	SP,POWC3	; COMPILE-TIME LONG REAL "^" INTEGER

OPMVLP:	MOVE	0,(LOP)			; CONSTANT FOR GLOAD OF LOP
OPMVSM:	MOVE	0,(SYM)			; CONSTANT FOR GLOAD OF SYM

OPENT1:	MULI	0,400			; IN-LINE REAL "ENTIER"
OPENT2:	TSC
OPENT3:	EXP	<ASH 0,-243>!$NEXT_22

OPSGN1:	EXP	<JUMPE 0,3>!$RA_22	; IN-LINE "SIGN"
OPSGN2:	ASH	0,-43
OPSGN3:	IORI	0,1

OPADDB:	ADDB				; USED IN "FOR" INCREMENT
	FADRB
OPAOS:	AOS
OPSOS:	SOS

OPJMPE:	JUMPE				; USED IN "FOR" TEST
OPJMPG:	JUMPG
OPJRST:	JRST

OPBYT3:	EXP	<DPB 0,0>!$ACC_22
OPSTRA:	TCADDF	STRASS			; CALL ON STRING ASSIGNMENT

OPCMPR:	TCADDF	COMPAR			; CALL ON STRING COMPARE SR
OPSTZB:	SETZB	0,(LOP)			; ASSIGN A ZERO
OPSTOB:	SETOB	0,(LOP)			; ASSIGN ALL ONES
OPASHL:	ASH	0,21			; MULTIPLY BY POWER OF 2
OPASHR:	ASH	0,-21			; DIVIDE BY POWER OF 2

OPENT4:	FSBRI	0,(0.5)		; IN LINE ENTIER FOR KI10

OPENT5:	FIXR	0,0

;	REAL KI10 OPERATORS

KIOPS:	DMOVE			; 700
	DPUSH
	DMOVEM
	TCTHEN
	TCELSE
	TCFI
	TCTO
	TCOT
	DMOVN				; 710
	TCTYDES
	DMOVNM
	TCSF
	DMOVEM
	715
	DFAD
	DFSB
	DFMP			; 720
	DFDV

	SUBTTL	CODE GENERATION ROUTINES	* CGASS *

PROCEDURE CGASS

	;..GENERATE CODE TO PERFORM AN ASSIGNMENT;
	    ;  ON ENTRY, LEXEME FOR RIGHT HAND SIDE IS IN SYM
	    ;  LEXEME FOR LEFT PART IS IN LOP
	;  IF TYPES ARE ARITHMETIC AND DO NOT MATCH, SYM WILL BE
	    ;  CONVERTED TO THE TYPE OF LOP.
	;  SPECIAL CASES FOR NON-FORMAL ASSIGNMENTS:
	    ;  LOP _ 0		("SETZB" GENERATED)
	    ;  LOP _ -1		("SETOB" GENERATED)
	;  RESULT IS A CLOSED PORTION WHOSE LEXEME IS IN SYM;

BEGIN
OWN CGATMP;		;..TEMPORARY TO HOLD LOP FOR FORMALS;
 IF LOP IS AN ERROR LEXEME
				JUMPGE	LOP,FALSE;$
 THEN;..SET RESULT LEXEME AND LEAVE;
   ERRLEX;
 ELSE;..NO ERRORS YET ..... GO ON;
 BEGIN
  ;..SET REV OFF;
				MOVNI	REV,SYM;$
  ;..INITIALIZE OP TO "_" (NEEDED IN REVORDER);
				MOVE	T,ZASS;$
				MOVEM	T,OP;$
  IF LOP<TYPE> NEQ SYM<TYPE>
				F.TYPE	(T3,LOP);
				F.TYPE	(T4,SYM);
				CAMN	T3,T4;$
				GOTO	FALSE;$
  THEN;..TYPES DO NOT MATCH;
    BEGIN
      IF LOP<TYPE> = ARITH AND SYM<TYPE> = ARITH
				TLNN	LOP,$ARC;$
				T.ARITH	(SYM);
      THEN;..UNMATCHED ARITHMETIC TYPES;
	;..CONVERT SYM TO THE TYPE OF LOP;
				MOVE	T,T3;$
	  CONVERT;
      ELSE;..TYPES ARE NOT BOTH ARITHMETIC;
	IF LOP<TYPE>=STRING!REGULAR
				T.S	(LOP);
				T.REG	(LOP);
	THEN;..BYTE ASSIGNMENT;
	  BEGIN
	    IF SYM<TYPE> = ARITHMETIC
				T.ARITH	(SYM);
	    THEN;..BYTE IS ARITHMETIC;
	      BEGIN
		IF SYM<TYPE> NEQ INTEGER
				TN.I	(SYM);
		THEN;..BYTE OPERAND MUST BE CONVERTED TO INTEGER;
		  ;..CONVERT SYM TO INTEGER TYPE;
				MOVEI	T,$I;$
		    CONVERT;
		FI
	      ENDD
	    ELSE;..ERROR -- MISMATCHED TYPES;
	      ;GO TO WRITE FAIL MESSAGE AND DIE;
				GOTO	LCGAS3;$
	    FI
	  ENDD
	ELSE;..TYPES CANNOT BE MATCHED;
	  BEGIN
	    LCGAS3:
	    FAIL(65,FRIED,SYM,UNMATCHED TYPE CLASSES FOR AN ASSIGNMENT);
	    ;GO TO LAST "ENDD";
				GOTO	LCGAS1;$
	  ENDD
        FI
      FI
    ENDD
  ELSE
    IF LOP<TYPE!STATUS>=STRING!REGULAR
				T.S	(LOP);
				T.REG	(LOP);
    THEN
      ;..STRING ASSIGNED TO A BYTE POINTER, GO TO WRITE
      ;..FAIL MESSAGE AND DIE;
				GOTO	LCGAS3;$
    FI
  FI;
EDIT(044); Dont force constants to D.P. unnecessarily
  IF SYM = PSEUDO-LONG REAL CONSTANT			; [E044]
				TLNN	SYM,$TYPE-$LR	; [E044]
				T.CONST	(SYM)		; [E044]
				TLNE	SYM,$CT-$IMM	; [E044]
				TLNN	SYM,$DEC	; [E044]
				GOTO	FALSE		; [E044]
				F.LOCN	(T2,SYM)	; [E044]
				ADD	T2,CONTAB	; [E044]
				SKIPL	T4,3(T2)	; [E044]
				GOTO	FALSE		; [E044]
  THEN;..CONVERT SYM TO A GENUINE LONG REAL CONSTANT	; [E044]
				MOVE	T3,2(T2)	; [E044]
				TLZ	T4,(1B0)	; [E044]
				TOCT	(2,SYM)		; [E044]
  FI							; [E044]
  IF LOP = FORMAL BY NAME
				T.FON	(LOP);
  THEN;..ASSIGNMENT TO A FORMAL;
    BEGIN
      ;..THE THUNK FOR STORING INTO A FORMAL NEEDS THE RIGHT-HAND
      ;  VALUE IN A0 AND THE FORMAL IN A2;
      IF SYM IS A POINTER
				T.PTR	(SYM);
      THEN;..PUT ITS VALUE INTO AC0;
				GOTO	LCGAS2;$
      FI
      IF VALUE OF SYM NOT IN AC0
				TN.AC0	(SYM);
      THEN;..PUT IT IN;
	LCGAS2:
	LOAD(SYM,A0);
      FI
      ;..SAVE LOP (LEXEME FOR FORMAL SYMBOL);
				MOVEM	LOP,CGATMP;$
      ;..FOOL MERGEPORTIONS. TELL IT THAT LOP IS AN INT. EXP. (IN A2);
				TLZ	LOP,$KIND!$TYPE!$STATUS!$AM;$
				TLO	LOP,$EXP!$I!$SIM!$ACC;$
				HRRI	LOP,A2;$
      MERGEPORTIONS;
      IF LOP IS IN THE STACK OR LOP<RHS>#A2
				TLNN	LOP,$STACK;$
				GOTO	TRUE;$
				MOVEI	LOP,(LOP);$
				CAIN	LOP,A2;$
				GOTO	FALSE;$
      THEN;..MERGEPORTIONS DID IT BECAUSE OF ACC CONFLICT;
	;..GET LOP BACK INTO A2 (NO CONFLICT POSSIBLE NOW);
	;PLUNK(MOVE,A2,LOP);
				MOVE	T,OPMOVE;$
				MOVEI	T1,A2;$
				PLUNK	(LOP);
      FI
      ;..RESTORE ORIGINAL LOP LEXEME;
				MOVE	LOP,CGATMP;$
      ;..EXECUTE THUNK (F[1]);
      ;PLUNK(TCSF,LOP);
      ;..TCSF IS A PSEUDO TO GENERATE THE XCT TO STORE INTO A FORMAL;
				MOVE	T,OPTCSF;$
				PLUNKI	(LOP);
    ENDD
  ELSE;..NON-FORMAL ASSIGNMENT;
    BEGIN
      IF SYM IS A POINTER
				T.PTR	(SYM);
      THEN;..LOAD VALUE OF SYM INTO SAME ACC USED BY PTR;
				F.LOCN	(T2,SYM);
	LOAD(SYM,@T2);
      ELSE;..SYM IS NOT A POINTER;
        IF SYM = SINGLE
				T.SINGLE(SYM);
        THEN;..THE VALUE OF SYM IS NOT YET IN AN ACC;
	  BEGIN
	    IF LOP<TYPE> NEQ STRING
				TLNN	LOP,$TYPE-$S;$
				GOTO	FALSE;$
	    THEN;..CHECK FOR SPECIAL CASES (SYM = 0 OR -1);
	      BEGIN
	        IF SYM = IMMEDIATE AND SYM<VALUE> = 0
				TRNN	SYM,777777;$
				T.IMM	(SYM);
	        THEN;..STORE A ZERO;
	          BEGIN
		    ;..GENERATE SETZB TO STORE ZERO IN LOP AND INTO A FREE ACC;
				MOVE	T1,OPSTZB;$
		    ;..GO AND GENERATE THE STORE INSTRUCTION;
				GOTO	LCGAS5;$
	          ENDD
	        FI
	        IF SYM IS A ONE WORD CONSTANT = -1 (ALL ONES)
				TLNE	SYM,$CT-$IMM;$
				TLNE	SYM,$VAR1!$CONST;$
				GOTO	FALSE;$
				F.LOCN	(T,SYM);
				ADD	T,CONTAB;$
				SETCM	T,1(T);$
				JUMPN	T,FALSE;$
	        THEN;..STORE ALL ONES;
	          BEGIN
		    ;..GENERATE SETOB TO STORE ONES IN LOP AND AN ACC;
				MOVE	T1,OPSTOB;$
		    LCGAS5:
		    ;..EMIT SETB COMMAND;
				HRRI	T1,ANYAC;$
				PUSHJ	SP,.LOAD;$
		    ;LEX(SYM) _ (EXPR,SAME,SIMPLE,LOP<LOCN>);
				TLZ	SYM,$KIND!$STATUS!$AM;$
				TLO	SYM,$EXP!$SIM!$ACC;$
				HRR	SYM,LOP;$
		    REOPEN(LOP);
		    ;..GO OUT TO COMBINE LEXEMES;
				GOTO	LCGAS4;$
	          ENDD
	        FI
	      ENDD
	    FI
	    ;..GET THE VALUE OF SYM INTO A FREE ACC;
	      LOAD(SYM,ANYAC);
	  ENDD
	FI
      FI
      IF LOP = BYTE POINTER
				HLRZ	T,LOP;$
				CAIE	T,$VAR!$S!$REG!$DECL!$PTR;$
				GOTO	FALSE;$
      THEN;..SET SWITCH ON;
				SETOM	0,CGATMP;$
      ELSE;..SET SWITCH OFF;
				SETZM	0,CGATMP;$
      FI
      IF LOP = SINGLE
				T.SINGLE(LOP);
      THEN;..NO PORTION NECESSARY FOR LOP;
	REOPEN(SYM);
      ELSE;..BOTH LOP AND SYM ARE PORTIONS;
	BEGIN
	  REVORDER;
	  MERGEPORTIONS;
	  IF REV
				T.REV;
	  THEN;..PORTIONS WERE REVERSED;
	    BEGIN
	      ;..RE-EXCHANGE LEXEMES;
				EXCH	LOP,SYM;$
	      ;..SET REV OFF;
				MOVNI	REV,SYM;$
	    ENDD
	  FI
	  IF SYM IS IN THE STACK
				T.STK	(SYM);
	  THEN;..VALUE WAS PUSHED DUE TO ACC CONFLICT;
	    ;..PUT IT BACK IN AN ACC;
				MOVE	T,OPMVSM;$
				MOVEI	T1,ANYAC;$
	      GLOAD;
	  ELSE;..MAYBE LOP WAS PUSHED;
	    IF LOP IS IN THE STACK
				T.STK	(LOP);
	    THEN;..PTR WAS PUSHED DUE TO ACC CONFLICT. OK UNLESS 2 WORD OPD;
	      BEGIN
		IF LOP<TYPE> = LONG REAL OR STRING
				T.TWO	(LOP);
		THEN;..WE MUST RETRIEVE THE POINTER FROM THE STACK;
		  BEGIN
;[220] DON'T ASSUME ANY FREE REGISTER, ALLOCATE ONE USING GLOAD
		    PUSH	SP,LOP		;[220] SAVE LOP
	    ;LEX(LOP) _ (SAME,INTEGER,SAME,STACKED) ;[220]
		    TLZ		LOP,$TYPE!$AM	;[220]
		    TLO		LOP,$I!$SP	;[220]
;[220] LOAD LOP INTO NEXT FREE AC
		    MOVE	T,LAC		;[276] GET LAST AC USED BY GLOAD
		    SUBI	T,(SYM)		;[276] CALCULATE AC DISTANCE
		    JUMPLE	T,EDT276	;[276] DISTANCE IS NEG., OK
		    CAILE	T,2		;[276] IS AC > 2 AWAY FROM SYM?
		    JRST	EDT276		;[276] YES, OK - USE AS IS
		    MOVE	T1,LAC		;[276] NO, GET LAC AGAIN
		    SUB		T1,T		;[276] USE NEXT FREE AC
		    CAIG	T1,1		;[276] IS AC NUMBER OK?
		    MOVEI	T1,14		;[276] NO, TOO LOW - WRAP AROUND
		    MOVEM	T1,LAC		;[276] YES, STORE NEW LAC VALUE
EDT276:		    MOVE	T,OPMVLP	;[276][220] AND FOOL GLOAD
		    MOVEI	T1,ANYAC	;[276][262]
		    GLOAD			;[220]
;[220] LEX(LOP) _ (OLD,OLD,OLD,POINTER)
		    TLZ		LOP,$TYPE!$AM	;[220]
		    POP		SP,T4		;[220]
		    HLRZ	T4,T4		;[220]
		    ANDI	T4,$TYPE	;[220]
		    TLO		LOP,$PTR(T4)	;[220]
		  ENDD
		;..ELSE LOP IS NOT A 2 WORD OPERAND;
		FI
	      ENDD
	    ;..ELSE LOP WAS NOT STACKED;
	    FI
	  FI
	ENDD
      FI
      ;..ALL IS READY AND WE CAN PERFORM THE ASSIGNMENT;
      IF LOP IS A BYTE POINTER
				SKIPN	0,CGATMP;$
				GOTO	FALSE;$
      THEN;..GENERATE CODE FOR BYTE ASSIGNMENT;
	BEGIN
	  ;PLUNK(DPB,SYM,LOP);
				MOVE	T,OPBYT3;$
				F.LOCN	(T1,SYM);
				HRR	T,LOP;$
				PLUNK;
	  ;LEX(SYM) _ (EXPR,INTEGER,SIMPLE,ACC);
				TLZ	SYM,$KIND!$TYPE!$STATUS!$AM;$
				TLO	SYM,$EXP!$I!$SIM!$ACC;$
	ENDD
      ELSE;..DO A NORMAL MOVE TO MEMORY;
	IF SYM<TYPE> = STRING
				T.S	(SYM);$
	THEN;..PLANT CALL TO STRASS
	    BEGIN
				MOVE	T,OPLPSH;$
	 			MOVEI	T1,SP;$
	    ; PUSH SYM
	    PLUNK(SYM);$
EDIT(032) ; ALLOW FOR THE CASE OF LOP IN AC 0 OR 1 
		IF LOP IN AC 0 OR 1 ; [E032]
				HRLEI	T,-1(LOP)	; [E032]
				TLNN	LOP,$AMAC	; [E032]
				JUMPLE	T,TRUE		; [E032]
				GOTO	FALSE		; [E032]
		THEN ; [E032]
; WE HAVE NOW PUSHED SYM FROM SOME ACCS ONTO THE STACK. WE WILL NOT
;USE THESE ACCS ANY MORE, AS WE ARE ABOUT TO ELABORATE THE RESULT OF
;STRASS (WHICH WILL BE IN AC 0 & 1) INTO SYM. THEREFORE WE CAN USE ONE
;OF THE ACCS THAT SYM WAS IN WITHOUT ANY FEAR OF LATER ACC CONFLICT !!.
				MOVSI	T,(<MOVE>)	; [E032]
				HRRI	T,(LOP)		; [E032]
				HRRI	LOP,1(SYM)	; [E032]
				F.LOCN(T1,LOP)		; [E032]
		PLUNK; [E032]
		FI ; [E032]
	    ; PUSH LOP
				MOVE	T,OPLPSH;$
				MOVEI	T1,SP;$
	    PLUNK(LOP);$
				MOVE	T,OPSTRA;$
	    PLUNKI;
	    ;..SYM<LEX> _ (EXPR,SIM,AC0)
				TLZ	SYM,$KIND!$STATUS!$AM;$
				TLO	SYM,$EXP!$SIM!$ACC;$
				TRZ	SYM,777777;$
EDIT(200); REMEMBER THAT CALL TO STRASS WILL USE AC0 AND AC1
	    ;HANDLE := HANDLE OR <AC0,AC1>	;[200]
				MOVSI	T,3	;[200] MARK REGISTERS 0 AND 1 AS USED
	    			IORM	T,HANDLE	;[200] IN HANDLE
	    ENDD;
	FI;
        ;PLUNK(ASSIGN,LOP,SYM);
				F.TRANK	(T,SYM);
				MOVE	T,OPASS(T);$
				F.LOCN	(T1,SYM);
				PLUNK	(LOP);
      FI
    ENDD;
  FI
  LCGAS4:
  CLOSE(SYM);
  ;..COMBINE LEXEXES AND COMPOSITE NAMES;
    COMBASSIGN;
 ENDD
 FI
LCGAS1:
ENDD	; CGASS

	SUBTTL	CODE GENERATION ROUTINES	* CGBIN *

PROCEDURE CGBIN

	;..GENERATE CODE TO PERFORM A BINARY OPERATION;
	    ;  ON ENTRY, OPERATION LEXEME IS IN OP;
	    ;  OPERAND LEXEMES ARE IN LOP AND SYM;
	;  IF BOTH OPERANDS ARE CONSTANTS, THE OPERATION IS USUALLY
	    ;  DONE AT COMPILE TIME, A NEW CONSTANT IS GENERATED,
	    ;  AND NO CODE IS PRODUCED.
	;  OPERANDS WILL BE REVERSED IF POSSIBLE, AND OPERATIONS
	    ;  MAY ALSO BE REVERSED (E.G., "<" BECOMES ">").
	;  ARITHMETIC TYPES WILL BE MATCHED BY CONVERTING ONE
	    ;  OPERAND TO THE TYPE OF THE OTHER
	    ;  (IN THE ORDERING INTEGER => REAL => LONG REAL).
	;  SPECIAL CASES FOR BINARY OPERATIONS:
	    ;  LOP ^ 2		(GENERATES "MULTIPLY  LOP,LOP")
	    ;  LOP DIV (2^N)	(GENERATES "ASH  -N")
	    ;  LOP * (2^N)	(GENERATES "ASH   N")
	    ;  LOP + (-CONST)	(CHANGED TO (LOP - CONST))
	;  RESULT IS A CLOSED PORTION WHOSE LEXEME IS IN SYM;

BEGIN
 LOCAL LACSAV;
 IF LOP IS AN ERROR LEXEME
				JUMPGE	LOP,FALSE;$
 THEN;..SET RESULT LEXEME AND LEAVE;
   ERRLEX;
 ELSE;..NO ERRORS YET ..... GO ON;
 BEGIN
  ;..SET REV OFF;
				MOVNI	REV,SYM;$
  IF OP IS ARITHMETIC
				F.DISC	(T);
				CAILE	T,OPMINUS-OPCODE;$
				GOTO	FALSE;$
  THEN;..ARITHMETIC OPERATION;
    BEGIN
      IF LOP<TYPE> = ARITH AND SYM<TYPE> = ARITH
				TLNN	LOP,$ARC;$
				T.ARITH	(SYM);
      THEN;..OPERANDS ARE ARITHMETIC;
        BEGIN
	  IF OP = "REM" OR "DIV"
				MOVE	T,OP;$
				CAMN	T,ZREM;$
				GOTO	TRUE;$
				CAME	T,ZDIV;$
				GOTO	FALSE;$
	  THEN;..MUST DO AN INTEGER DIVIDE;
	    BEGIN
	      IF LOP<TYPE> = INTEGER AND SYM<TYPE> = INTEGER
				TLNN	LOP,$TYPE-$I;$
				T.I	(SYM);
	      THEN;..OPERANDS ARE INTEGERS;
		BEGIN
		  IF NOT TREATCONST
				TREATCONST;
				JUMPN	T,FALSE;$
		  THEN;..OPERANDS ARE NOT BOTH CONSTANTS;
		    BEGIN
		      ;..GIVE LOP SPECIAL TYPE SO LOAD WILL USE 2 AC'S;
				TLZ	LOP,$TYPE;$
				TLO	LOP,$IDI;$
		      IF VALUE OF LOP IN LAST AC <AC13> OR NOT IN AC
				TLNE	LOP,$AM-$ACC;$
				GOTO	TRUE;$
				F.LOCN	(T,LOP);
				CAIE	T,A13;$
				GOTO	FALSE;$
		      THEN;..MUST MOVE LOP TO AN AC PAIR;
			BEGIN
			  LOAD(LOP,ANYAC);
			ENDD
		      FI
		      SETUP;
		      ;..RESET TYPE TO INTEGER;
				TLZ	LOP,$TYPE;$
				TLO	LOP,$I;$
		        ;EMITCODE(IDIV,LOP,SYM,2);
				MOVE	T,OPDIV;$
				F.LOCN	(T1,LOP);
				HRLI	T1,2;$
				EMITCODE(SYM);
		      ;LEX(SYM) _ (EXPR,INTEGER,SIMPLE,LOP);
				TLZ	SYM,$KIND!$TYPE!$STATUS!$AM;$
				TLO	SYM,$EXP!$I!$SIM!$ACC;$
				HRR	SYM,LOP;$
		      IF OP = "REM"
				T.OPER	(ZREM);
		      THEN;..RESULT WILL BE IN AC+1;
			;SYM<LOCN> _ SYM<LOCN> + 1;
				HRRZ	T,SYM;$
				ADDI	T,1;$
				HRR	SYM,T;$
		      FI
		      CLOSE(SYM);
		      COMBLEX;
		    ENDD
		  FI
		ENDD
	      ELSE;..OPERANDS ARE NOT INTEGERS;
		FAIL(67,FRIED,SYM,NON-INTEGER OPERAND FOR "REM" OR "DIV");
	      FI
	    ENDD
	  ELSE;..OP NEQ "REM" AND OP NEQ "DIV";
	    IF OP = "^"
				T.OPER	(ZPOW);
	    THEN;..POWER OPERATION;
	      BEGIN
		IF NOT TREATCONST
				TREATCONST;
				JUMPN	T,FALSE;$
		THEN;..OPERANDS ARE NOT BOTH CONSTANTS;
		  BEGIN
		    IF SYM = IMMEDIATE AND SYM<VALUE> = 2
				F.LOCN	(T,SYM);
				CAIN	T,2;$
				T.IMM	(SYM);
		    THEN;..WE CAN USE MULTIPLY INSTEAD OF POWER;
			;..( LOP ^ 2 = LOP * LOP );
		      BEGIN
			IF LOP IS A POINTER
				T.PTR	(LOP);
			THEN;..LOAD VALUE INTO SAME ACC USED BY PTR;
				F.LOCN	(T2,LOP);
			  LOAD(LOP,@T2);
			ELSE;..NOT A POINTER;
			  IF LOP IS SINGLE
				T.SINGLE(LOP);
			  THEN;..MAKE A PORTION TO LOAD LOP INTO AN ACC;
			    LOAD(LOP,ANYAC);
			  FI
			FI
			REOPEN(LOP);
			;..GENERATE (MULTIPLY,LOP,LOP);
			;SYM _ LOP;
				MOVE	SYM,LOP;$
			;OP _ "*";
				MOVE	T,ZTIMES;$
				MOVEM	T,OP;$
			;GO AND EMIT THE "*" OPERATION;
				GOTO	LCGBI3;$
		      ENDD
		    FI
		    ;..COMBINE PORTIONS;
		      MARRY;
		    IF REV
				T.REV;
		    THEN;..PORTIONS WERE REVERSED;
		      BEGIN
			;..EXCHANGE THE LEXEMES AGAIN;
				EXCH	LOP,SYM;$
			;..SET REV OFF;
				MOVNI	REV,SYM;$
		      ENDD
		    FI
		    ;..WE MUST NOW STACK BOTH OPERANDS FOR THE POWER SR;
		    EDIT(044);Don't force all constants to D.P.
		    IF SYM<TYPE> = LONG REAL		; [E044]
				T.LR	(SYM)		; [E044]
		    THEN;				; [E044]
		      BEGIN;				; [E044]
			IF SYM = PSEUDO-LONG CONSTANT	; [E044]
				T.CONST	(SYM)		; [E044]
				TLNE	SYM,$CT-$IMM	; [E044]
				TLNN	SYM,$DEC	; [E044]
				GOTO	FALSE		; [E044]
				F.LOCN	(T2,SYM)	; [E044]
				ADD	T2,CONTAB	; [E044]
				SKIPL	A1,3(T2)	; [E044]
				GOTO	FALSE		; [E044]
			THEN;				; [E044]
			  BEGIN;			; [E044]
			    IF LOP # GENUINE LONG REAL	; [E044]
				TLNE	LOP,$TYPE-$LR	; [E044]
				GOTO	TRUE		; [E044]
				T.CONST	(LOP)		; [E044]
				TLNE	LOP,$CT-$IMM	; [E044]
				TLNN	LOP,$DEC	; [E044]
				GOTO	FALSE		; [E044]
				F.LOCN	(T1,LOP)	; [E044]
				ADD	T1,CONTAB	; [E044]
				SKIPL	3(T1)		; [E044]
				GOTO	FALSE		; [E044]
			    THEN;SYM SHOULD BE REAL	; [E044]
				MOVE	T3,A0		; [E044]
				MOVE	A0,2(T2)	; [E044]
				TLZ	A1,(1B0)	; [E044]
				PUSHJ	SP,CTLRR	; [E044]
				EXCH	T3,A0		; [E044]
				TOCT	(1,SYM)		; [E044]
				TLZ	SYM,$TYPE	; [E044]
				TLO	SYM,$R		; [E044]
				GOTO	LCPOW1		; [E044]
			    ELSE;SYM SHOULD BE LONG	; [E044]
				MOVE	T3,2(T2)	; [E044]
				MOVE	T4,3(T2)	; [E044]
				TLZ	T4,(1B0)	; [E044]
				TOCT	(2,SYM)		; [E044]
			    FI;				; [E044]
			  ENDD;				; [E044]
			ELSE; SYM IS GENUINE LONG REAL	; [E044]
			  IF LOP = PSEUDO-LONG REAL	; [E044]
				TLNN	LOP,$TYPE-$LR	; [E044]
				T.CONST	(LOP)		; [E044]
				TLNE	LOP,$CT-$IMM	; [E044]
				TLNN	LOP,$DEC	; [E044]
				GOTO	FALSE		; [E044]
				F.LOCN	(T2,LOP)	; [E044]
				ADD	T2,CONTAB	; [E044]
				SKIPL	T4,3(T2)	; [E044]
				GOTO	FALSE		; [E044]
			  THEN;MAKE LOP GENUINE LONG	; [E044]
				MOVE	T3,2(T2)	; [E044]
				TLZ	T4,(1B0)	; [E044]
				TOCT	(2,LOP)		; [E044]
			  FI;				; [E044]
			FI;				; [E044]
		      ENDD;				; [E044]
		    ELSE;SYM IS NOT LONG REAL		; [E044]
		    LCPOW1:				; [E044]
		      IF LOP = PSEUDO-LONG REAL		; [E044]
				TLNN	LOP,$TYPE-$LR	; [E044]
				T.CONST	(LOP)		; [E044]
				TLNE	LOP,$CT-$IMM	; [E044]
				TLNN	LOP,$DEC	; [E044]
				GOTO	FALSE		; [E044]
				F.LOCN	(T2,LOP)	; [E044]
				ADD	T2,CONTAB	; [E044]
				SKIPL	A1,3(T2)	; [E044]
				GOTO	FALSE		; [E044]
		      THEN;CONVERT LOP TO REAL		; [E044]
				MOVE	T3,A0		; [E044]
				MOVE	A0,2(T2)	; [E044]
				TLZ	A1,(1B0)	; [E044]
				PUSHJ	SP,CTLRR	; [E044]
				EXCH	T3,A0		; [E044]
				TOCT	(1,LOP)		; [E044]
				TLZ	LOP,$TYPE	; [E044]
				TLO	LOP,$R		; [E044]
		      FI;				; [E044]
		    FI;					; [E044]
EDIT(110); Check for variables already on the stack
		    IF SYM IS IN THE STACK		; [E110]
				T.STK	(SYM)		; [E110]
		      THEN; PUT IT BACK IN AN ACC	; [E110]
				MOVE	T,OPMVSM	; [E110]
				MOVEI	T1,ANYAC	; [E110]
			GLOAD;				; [E110]
		      FI;				; [E110]
		    IF LOP<TYPE> = LONG REAL
				T.LR	(LOP);
		    THEN
		      ;OPN IS LPUSH;
				MOVE	T,OPLPSH;$
		    ELSE;..SHORT OPERAND;
		      BEGIN
			IF LOP IS IMMEDIATE
				T.IMM	(LOP);
			THEN;..PUT CONSTANT IN TABLE SO IT CAN BE PUSHED;
			  BEGIN
			    IF LOP<TYPE> = INTEGER
				T.I	(LOP);
			    THEN;..IMMED. CONST. GOES TO RIGHT HALF OF T3;
				HRRZ	T3,LOP;$
			    ELSE;..IMMED. CONST. GOES TO LEFT HALF OF T3;
				HRLZ	T3,LOP;$
			    FI
			    ;..PUT CONSTANT INTO TABLE;
			      TOCT(1,LOP);
			  ENDD
			FI
			;..OPN IS "PUSH";
				MOVE	T,OPPUSH;$
		      ENDD
		    FI
		    ;..PUSH LOP;
		    ;PLUNK(OPN,SP,LOP);
				MOVEI	T1,SP;$
				PLUNK	(LOP);
		    IF SYM<TYPE> = LONG REAL
				T.LR	(SYM);
		    THEN
		      ;OPN IS LPUSH;
				MOVE	T,OPLPSH;$
		    ELSE;..SHORT OPERAND;
		      BEGIN
			IF SYM IS IMMEDIATE
				T.IMM	(SYM);
			THEN;..PUT CONSTANT IN TABLE SO IT CAN BE PUSHED;
			  BEGIN
			    IF SYM<TYPE> = INTEGER
				T.I	(SYM);
			    THEN;..IMMED. CONST. GOES TO RIGHT HALF OF T3;
				HRRZ	T3,SYM;$
			    ELSE;..REAL IMM. CONST. GOES TO LEFT OF T3;
				HRLZ	T3,SYM;$
			    FI
			    ;..PUT CONSTANT INTO TABLE;
			      TOCT(1,SYM);
			  ENDD
			FI
			;..OPN IS "PUSH";
				MOVE	T,OPPUSH;$
		      ENDD
		    FI
		    ;..PUSH SYM;
		    ;PLUNK(OPN,SP,SYM);
				MOVEI	T1,SP;$
				PLUNK	(SYM);
		    ;..GET POWER INFORMATION WORD;
				F.TRANK	(T3,LOP);
				LSH	T3,2;$
				F.TRANK	(T,SYM);
				OR	T3,T;$
				MOVE	T3,OPPOW(T3);$
		    IF SYM<TYPE> NEQ INTEGER
				TN.I	(SYM);
		    THEN;..PUT CODE VALUE IN AC1;
		      BEGIN
		        ;PLUNK(MOVEI,AC1,POWER CODE);
				MOVE	T,T3;$
				ANDI	T,3;$
				HLL	T,OPMVI1;$
				PLUNKI;
			;..BOOK AC1 USED;
				MOVSI	T,2;$
				IORM	T,HANDLE;$
		      ENDD
		    ELSE;..EXPONENT IS AN INTEGER;
		      BEGIN
			IF LOP<TYPE> = INTEGER
				T.I	(LOP);
			THEN;..INTEGER ^ INTEGER. RESULT MAY BE INT. OR REAL;
			  BEGIN
			    IF SYM = CONSTANT GEQ ZERO
				T.CONST	(SYM);
				F.LOCN	(T,SYM);
				ADD	T,CONTAB;$
				SKIPGE	0,1(T);$
				GOTO	FALSE;$
			    THEN;..CODE _ 0 AND RESULT WILL BE INTEGER;
			      BEGIN
				;POWER CODE _ 0;
				MOVEI	T,0;$
				;RESULT.TYPE _ INTEGER;
				TRZ	T3,$TYPE;$
				TRO	T3,$I;$
			      ENDD
			    ELSE;..CODE _ 1 AND RESULT WILL BE REAL;
			      ;POWER CODE _ 1;
				MOVEI	T,1;$
			    FI
			    ;..PUT CODE VALUE IN AC1;
			    ;PLUNK(MOVEI,AC1,POWER CODE);
				HLL	T,OPMVI1;$
				PLUNKI;
			    ;..BOOK AC0-AC5 USED;
				MOVSI	T,77;$
				IORM	T,HANDLE;$
			  ENDD
			FI
		      ENDD
		    FI
		    ;..CALL POWER SUBROUTINE;
		    ;PLUNK(POWER NAME);
				HLLZ	T,T3;$
				PLUNKI;
		    IF RESULT.TYPE = LONG REAL
				ANDI	T3,$TYPE;$
				CAIE	T3,$LR;$
				GOTO	FALSE;$
		    THEN;..BOOK AC0-AC13 USED;
				MOVSI	T,7777;$
		    ELSE;..BOOK AC0-4 USED;
				MOVSI	T,37;$
		    FI
				IORM	T,HANDLE;$
		    ;LEX(SYM) _ (EXPR,RESULT.TYPE,SIMPLE,AC0);
				TLZ	SYM,$KIND!$TYPE!$STATUS!$AM;$
				TLO	SYM,$EXP!$SIM!$ACC;$
				TSO	SYM,T3;$
				HRRI	SYM,0;$
		    CLOSE(SYM);
		    COMBLEX;
		  ENDD
		;..ELSE BOTH OPDS WERE CONSTS AND A NEW CONST WAS GENERATED;
		FI
	      ENDD
	    ELSE;..OP NEQ "^" OR "REM" OR "DIV";
	      BEGIN
		IF OP = SLASH AND LOP = INTEGER AND SYM = INTEGER
				T.OPER	(ZSLASH);
				TLNN	LOP,$TYPE-$I;$
				T.I	(SYM);
		THEN;..SLASH OPERATION REQUIRES REAL OPERANDS;
		  ;CONVERT(REAL,SYM);
				MOVEI	T,$R;$
		    CONVERT;
		FI
		IF NOT CHECKARITH
				CHECKARITH;
				JUMPN	T,FALSE;$
		THEN;..OPERANDS NOW HAVE MATCHING ARITHMETIC TYPES;
		  BEGIN
		    IF NOT TREATCONST
				TREATCONST;
				JUMPN	T,FALSE;$
		    THEN;..OPERANDS ARE NOT BOTH CONSTANTS;
		      BEGIN
			SETUP;
			IF OP = "*" AND SYM = IMMED. INT. = 2^N (0 LEQ N LSS 18)
				MOVE	T,OP;$
				CAMN	T,ZTIMES;$
				TLNE	SYM,$AM-$IMM+$TYPE-$I;$
				GOTO	FALSE;$
				HRLZ	T,SYM;$
				JFFO	T,.+2;$
				GOTO	FALSE;$
				LSH	T,1(T1);$
				JUMPN	T,FALSE;$
			THEN;..WE CAN SHIFT RATHER THAN MULTIPLY;
			  BEGIN
			    ;PLUNK(ASH,LOP,N);
				MOVE	T,OPASHL;$
				SUB	T,T1;$
				F.LOCN	(T1,LOP);
				PLUNK;
			    ;GO AND SET UP THE LEXEME;
				GOTO	LCGBI4;$
			  ENDD
			FI
			IF OP = "+" AND SYM = NEGATED IMM. INT. CONSTANT
				T.OPER	(ZPLUS);
				TLNN	SYM,$CONST+$TYPE-$I;$
				TLNN	SYM,$CT-$IMM;$
				GOTO	FALSE;$
				F.LOCN	(T,SYM);
				ADD	T,CONTAB;$
				MOVN	T1,1(T);$
				JUMPL	T1,FALSE;$
				CAILE	T1,-1;$
				GOTO	FALSE;$
			THEN;..CHANGE "A + (- CONSTANT)" TO "A - CONSTANT";
			  BEGIN
			    ;OP _ "-";
				MOVE	T,ZMINUS;$
				MOVEM	T,OP;$
			    ;LEX(SYM) _ (IMMED.,SAME,SAME,-(VALUE(SYM)));
				TLZ	SYM,$AM;$
				TLO	SYM,$IMM;$
				HRR	SYM,T1;$
			  ENDD
			FI
			LCGBI3:
		        ;..GENERATE THE INSTRUCTION TO PERFORM "OP";
			;EMITCODE(OPN,LOP,SYM,LENGTH);
				F.TRANK	(T,SYM);
				F.DISC	(T1);
				ADD	T,T1;$
				MOVE	T,OPCODE(T);$
				F.LOCN	(T1,LOP);
			IF LOP IS LONG REAL
				T.LR	(LOP);
			THEN
			  BEGIN
				HLRZ	T1,T
				LSH	T1,-11
				TRZ	T1,700
				CAIGE	T1,22
				MOVE	T,KIOPS(T1)
			; LENGTH _ 2;
				HRLI	T1,2
			  ENDD
			ELSE
			; LENGTH _ 1 (TYPE # LONG REAL)
				HRLI	T1,1;$
			FI
EDIT(026); DONT DESTROY LENGTH CODE CAREFULLY SET UP IN L.H. OF T1
				HRR	T1,LOP	; [E026]
				EMITCODE(SYM);
			LCGBI4:
			;LEX(SYM) _ (EXPR,SAME,SIMPLE,LOP);
				TLZ	SYM,$KIND!$STATUS!$AM;$
				TLO	SYM,$EXP!$SIM!$ACC;$
				HRR	SYM,LOP;$
			CLOSE(SYM);
			COMBLEX;
		      ENDD
		    ;..ELSE BOTH OPDS WERE CONSTS AND A NEW CONST WAS GENERATED;
		    FI
		  ENDD
		ELSE;..TYPE OF AN OPERAND IS NOT INTEGER, REAL, OR LONG REAL;
		  FAIL(68,FRIED,SYM,COMPLEX OPERAND FOR ARITH OPERATOR);
		FI
	      ENDD
	    FI
	  FI
	ENDD
      ELSE;..AN OPERAND IS NOT ARITHMETIC;
	FAIL(69,FRIED,SYM,NON-ARITH OPERAND FOR ARITH OPERATOR);
      FI
    ENDD
  ELSE;..OP IS NOT ARITHMETIC;
    IF OP = RELATIONAL
				T.RELATION(T);
    THEN;..WE HAVE A RELATION;
      BEGIN
	IF NOT CHECKARITH
				CHECKARITH;
				JUMPN	T,FALSE;$
        THEN;..OPERANDS NOW HAVE MATCHING ARITHMETIC TYPES;
	  BEGIN
	    IF NOT TREATCONST
				TREATCONST;
				JUMPN	T,FALSE;$
	    THEN;..OPERANDS ARE NOT BOTH CONSTANTS;
	      BEGIN
	        SETUP;
		IF SYM<TYPE> = LONG REAL
				T.LR	(SYM);
		THEN;..OPERANDS ARE BOTH LONG REAL;
		  BEGIN
		    ;..SUBTRACT SYM FROM LOP;
		    ;EMITCODE(LFSB,LOP,SYM,3);
				MOVE	T,OPLFSB;$
				F.LOCN	(T1,LOP);
				HRLI	T1,3;$
				EMITCODE(SYM);
		    ;..TEST RESULT VS. ZERO;
		    ;PLUNK(OPN+1,LOP,ZERO);
				F.DISC	(T);
				MOVE	T,OPCODE+1(T);$
				F.LOCN	(T1,LOP);
				PLUNK;
		  ENDD
	        ELSE;..OPERANDS ARE INTEGER OR REAL;
		  ;..COMPARE THE OPERANDS;
		  IF SYM<AM> = IMMEDIATE
				T.IMM	(SYM);
		  THEN;..IMMEDIATE CONSTANT;
		    BEGIN
		      IF SYM<TYPE> = REAL
				T.R	(SYM);
		      THEN;..REAL IMMEDIATE CONSTANT;
			BEGIN
			  ;..SUBTRACT SYM FROM LOP;
			  ;EMITCODE(FSBR,LOP,SYM,1);
				MOVE	T,OPFSBR;$
				F.LOCN	(T1,LOP);
				HRLI	T1,1;$
				EMITCODE(SYM);
			  ;..TEST RESULT VS. ZERO;
			  ;PLUNK(OPN+1,LOP,0);
				F.DISC	(T);
				MOVE	T,OPCODE+1(T);$
				F.LOCN	(T1,LOP);
				PLUNK;
			ENDD
		      ELSE;..INTEGER IMMEDIATE CONSTANT;
			;EMITCODE(OPN+1,LOP,SYM,1);
				F.DISC	(T);
				MOVE	T,OPCODE+1(T);$
				F.LOCN	(T1,LOP);
				HRLI	T1,1;$
				EMITCODE(SYM);
		      FI
		    ENDD
		  ELSE;..NON-IMMEDIATE OPERAND;
		    ;EMITCODE(OPN,LOP,SYM,1);
				F.DISC	(T);
				MOVE	T,OPCODE(T);$
				F.LOCN	(T1,LOP);
				HRLI	T1,1;$
				EMITCODE(SYM);
		  FI
		FI
		LCGBI2:
		;..RESULT MUST BE "TRUE" OR "FALSE". GENERATE IT;
		;PLUNK(TDZA,LOP,LOP);
				MOVE	T,OPTDZA;$
				F.LOCN	(T1,LOP);
				PLUNK	(LOP);
		;PLUNK(SETO,LOP,0);
				MOVE	T,OPSETO;$
				F.LOCN	(T1,LOP);
				PLUNK;
		;LEX(SYM) _ (EXPR,BOOLEAN,SIMPLE,LOP);
				TLZ	SYM,$KIND!$TYPE!$STATUS!$AM;$
				TLO	SYM,$EXP!$B!$SIM!$ACC;$
				HRR	SYM,LOP;$
		CLOSE(SYM);
		COMBLEX;
	      ENDD
	    ;..ELSE BOTH OPDS WERE CONSTS AND A NEW CONST WAS GENERATED;
	    FI
	  ENDD
	ELSE;..A RELATIONAL OPERAND IS NOT INTEGER OR REAL OR LONG REAL;
	  IF LOP<TYPE> = STRING AND SYM<TYPE> = STRING
				TLNN	LOP,$TYPE-$S;$
				T.S	(SYM);
	  THEN;..RELATION BETWEEN STRINGS;
	    BEGIN
	      ;..PUT OPERANDS IN A0-1 AND A2-3 FOR THE COMPARE SR;
	      IF VALUE OF LOP IS NOT IN AC0
				TN.AC0	(LOP);
	      THEN;..MUST PUT IT INTO AC0 AND AC1;
		LOAD(LOP,A0);
	      FI
	      IF VALUE OF SYM IS NOT IN AC2
				TLNE	SYM,$AM-$ACC;$
				GOTO	TRUE;$
				F.LOCN	(T,SYM);
				CAIN	T,A2;$
				GOTO	FALSE;$
	      THEN;..MUST PUT IT INTO AC2 AND AC3;
		;..FUDGE LAC=A4 TO MAKE LOAD WORK;
				MOVEI	T,A4;$
				EXCH	T,LAC;$
				MOVEM	T,LACSAV;$
		LOAD(SYM,A2);
		;..RESTORE LAC;
				MOVE	T,LACSAV;$
				MOVEM	T,LAC;$
	      FI
	      MERGEPORTIONS;
	      IF LOP NOT IN AC0
				TN.AC0	(LOP);
	      THEN;..IT WAS MOVED DUE TO ACC CONFLICT. PUT IT BACK IN AC0;
				MOVE	T,OPMVLP;$
				MOVEI	T1,A0;$
		GLOAD;
	      FI
	      ;..GENERATE CALL ON COMPARE SUBROUTINE;
				MOVE	T,OPCMPR;$
				PLUNKI;
	      ;..RESULT IS -1, 0, OR +1 IN REGISTER AC0;
				HRRI	LOP,A0;$
	      ;..GENERATE THE INST. TO TEST RESULT OF COMPAR VS. ZERO;
	      ;EMITCODE(OPN+1,AC0,0,1);
				F.DISC	(T);
				MOVE	T,OPCODE+1(T);$
				HRLZI	T1,1;$
				EMITCODE;
	      ;..NOW GO GENERATE THE BOOLEAN RESULT;
				GOTO	LCGBI2;$
	    ENDD
	  ELSE;..TYPES CANNOT BE CORRECT;
	    FAIL(70,HARD,NSYM,NON-ARITH OPERAND FOR RELATIONAL OPERATOR);
	  FI
        FI
      ENDD
    ELSE;..OP IS NOT ARITHMETIC OR RELATIONAL. IT MUST BE BOOLEAN;
      BEGIN
        IF LOP<TYPE> = BOOLEAN AND SYM<TYPE> = BOOLEAN
				TLNN	LOP,$TYPE-$B;$
				T.B	(SYM);
        THEN;..OPERANDS ARE BOTH BOOLEAN;
	  BEGIN
	    IF NOT TREATCONST
				TREATCONST;
				JUMPN	T,FALSE;$
	    THEN;..OPERANDS ARE NOT BOTH CONSTANTS;
	      BEGIN
	        SETUP;
	        ;..GENERATE THE INSTRUCTION TO PERFORM "OP";
	        ;EMITCODE(OPN,LOP,SYM,1);
				F.DISC	(T);
				MOVE	T,OPCODE(T);$
				F.LOCN	(T1,LOP);
				HRLI	T1,1;$
				EMITCODE(SYM);
		;LEX(SYM) _ (EXPR,SAME,SIMPLE,LOP);
				TLZ	SYM,$KIND!$STATUS!$AM;$
				TLO	SYM,$EXP!$SIM!$ACC;$
				HRR	SYM,LOP;$
		CLOSE(SYM);
		COMBLEX;
	      ENDD
	    ;..ELSE BOTH OPDS WERE CONSTS AND A NEW CONST WAS GENERATED;
	    FI
	  ENDD
	ELSE;..AN OPERAND IS NOT BOOLEAN;
	  FAIL(71,FRIED,SYM,NON-BOOLEAN OPERAND FOR BOOLEAN OPERATOR);
	FI
      ENDD
    FI
  FI
 ENDD
 FI
ENDD	; CGBIN
	SUBTTL	CODE GENERATION ROUTINES	* CGUNA *

PROCEDURE CGUNA

	;..PROCESS UNARY OPERATORS;
	    ;  GENERATE CODE TO PERFORM UNARY "+", "-", AND "NOT".
	;  ON ENTRY, OPERATION LEXEME IS IN OP;
	    ;  OPERAND IS IN SYM;
	;  RESULT IS A CLOSED PORTION WHOSE LEXEME IS IN SYM;

BEGIN
  ;..SET REV OFF;
				MOVNI	REV,SYM;$
  IF OP = "NOT"
				T.OPER	(ZNOT);
  THEN;..LOGICAL COMPLEMENT;
    BEGIN
      IF SYM<TYPE> NEQ BOOLEAN
				TN.B	(SYM);
      THEN
	FAIL(72,FRIED,SYM,NON-BOOLEAN OPERAND FOR "NOT");
      ELSE;..OPERAND IS BOOLEAN;
        BEGIN
	  IF NOT TRUNACONST
				TRUNACONST;
				JUMPN	T,FALSE;$
          THEN;..OPERAND IS NOT CONSTANT;
            BEGIN
	      IF SYM IS AN EXPR OR A POINTER IN AN ACC
				T.ACC	(SYM);
              THEN;..OPERAND OR ITS POINTER IS ALREADY IN AN AC;
		BEGIN
		  REOPEN(SYM);
		  ;..COMPLEMENT THE OPERAND;
		  ;PLUNK(NOT,SYM,SYM);
				MOVE	T,OPNOT;$
				F.LOCN	(T1,SYM);
				PLUNK	(SYM);
		  ;LEX(SYM) _ (EXPR,SAME,SIMPLE,ACC);
				TLZ	SYM,$KIND!$STATUS!$AM;$
				TLO	SYM,$EXP!$SIM!$ACC;$
		  CLOSE(SYM);
		ENDD
	      ELSE;..OPERAND IS NOT IN AN AC. LOAD ITS COMPLEMENT;
		LOADC(SYM,ANYAC);
	      FI
            ENDD
	  ;..ELSE OPERAND WAS CONSTANT AND A NEW CONST WAS GENERATED;
          FI
        ENDD
      FI
    ENDD
  ELSE;..OP NEQ "NOT".  IT MUST BE "+" OR "-";
    BEGIN
      IF SYM<TYPE> NEQ ARITH
				TN.ARITH(SYM);
      THEN
        FAIL(73,FRIED,SYM,NON-ARITH OPERAND FOR UNARY "+" OR "-");
      ELSE;..OPERAND IS ARITHMETIC;
        BEGIN
          IF OP = UNARY "-"
				T.OPER	(ZUMINUS);
	  THEN;..OP = NEGATE;
	    BEGIN
	      IF NOT TRUNACONST
				TRUNACONST;
				JUMPN	T,FALSE;$
	      THEN;..OPERAND IS NOT CONSTANT;
		BEGIN
		  IF SYM IS A LONG REAL POINTER IN AN ACC
				TLNN	SYM,$AMAC+$TYPE-$LR;$
				TLNN	SYM,$INDC;$
				GOTO	FALSE;$
		  THEN;..VALUE OF OPERAND NOT IN ACC. LOAD ITS NEGATIVE;
				GOTO	LCGUN1;$
		  FI
		  IF SYM IS AN EXPR IN ACC
				T.ACC	(SYM);
		  THEN;..OPERAND OR ITS POINTER IS ALREADY IN AN ACC;
		    BEGIN
		      REOPEN(SYM);
		      ;..NEGATE THE OPERAND;
		      ;PLUNK(MOVN,SYM,SYM) OR PLUNK(DFN,SYM,SYM+1);
				F.TRANK	(T,SYM);
				MOVE	T,OPUMIN(T);
				F.LOCN	(T1,SYM);
				MOVE	T2,SYM;$
				TLZ	T2,777777-$AM;$
				ADD	T,T2;$
				PLUNK;
		      ;LEX(SYM) _ (EXPR,SAME,SIMPLE,ACC);
				TLZ	SYM,$KIND!$STATUS!$AM;$
				TLO	SYM,$EXP!$SIM!$ACC;$
		      CLOSE(SYM);
		    ENDD
		  ELSE;..OPERAND IS NOT IN AN AC. LOAD ITS NEGATIVE;
		    LCGUN1:
		    LOADN(SYM,ANYAC);
		  FI
		ENDD
	      ;..ELSE OPD WAS CONST AND NEGATED CONST WAS GENERATED;
	      FI
	    ENDD
	  ;..ELSE OPERATION IS UNARY "+".  NO ACTION NEEDED;
	  FI
	ENDD
      FI
    ENDD
  FI
ENDD	; CGUNA
	SUBTTL	CODE GENERATION ROUTINES	* TREATCONST *

PROCEDURE TREATCONST

	;..PERFORM BINARY OP AT COMPILE-TIME WHEN BOTH OPDS ARE CONSTANTS.
	    ;  IF AT LEAST ONE OPERAND IS NON-CONSTANT,
	    ;  FLAG (T) IS SET TO "FALSE" (ALL ZEROS);
	    ;  IF BOTH ARE CONSTANT, NEW CONSTANT IS PRODUCED 
	    ;  AND FLAG IS SET TO "TRUE" (ALL ONES).
	;  ON ENTRY, OPERAND LEXEMES ARE IN LOP AND SYM,
	    ;  OPERATION LEXEME IS IN OP.
	;  IF OPERATION = "^", NEW CONSTANT IS PRODUCED ONLY IF
	    ;  EXPONENT IS AN INTEGER.
	;  RESULT LEXEME GOES TO SYM.
	    ;  NEW CONSTANT IS PUT INTO LEXEME IF IT IS IMMEDIATE,
	    ;  OTHERWISE IT IS PUT INTO THE CONSTANT TABLE.

BEGIN
OWN TA0,DPFLAG; TA0 = TEMPORARY TO HOLD A0 (GBREG)	; [E044]
		;DPFLAG SET IF EXPLICIT DOUBLE PRECISION; [E044]
 IF LOP = CONSTANT AND SYM = CONSTANT
				TLNN	LOP,$CONST;$
				T.CONST	(SYM);
 THEN;..WE MUST PRODUCE A NEW CONSTANT;
 BEGIN
  ;..MAKE SURE OVERFLOW FLAGS ARE OFF;
				JFCL	11,LTC2;$
  LTC2:
  IF OP NEQ "^"
				TN.OPER	(ZPOW);
  THEN;..OP IS NOT POWER AND TYPES OF LOP AND SYM MATCH;
  BEGIN
   IF SYM<TYPE> NEQ LONG REAL
				TN.LR	(SYM);
   THEN;..TYPES OF LOP AND SYM ARE NOT LONG REAL;
    BEGIN
      ;T2 _ LOP<LOCN>;
				F.LOCN	(T2,LOP);
      ;..PUT VALUE OF LOP INTO T3;
      IF LOP = IMMEDIATE
				T.IMM	(LOP);
      THEN;..IMMEDIATE LEFT OPERAND;
	IF SYM<TYPE> = REAL
				T.R	(SYM);
	THEN
	  ;FETCH IMMEDIATE REAL CONSTANT;
				HRLZ	T3,T2;$
	ELSE
	  ;FETCH IMMEDIATE INTEGER OR BOOLEAN CONSTANT;
				HRRZ	T3,T2;$
	FI
      ELSE;..LEFT OPERAND IS IN CONSTANT TABLE;
	;FETCH CONSTANT FROM TABLE;
				ADD	T2,CONTAB;$
				MOVE	T3,1(T2);$
      FI
      ;..NOW GENERATE INSTRUCTION  <OPN  T3,SYM>;
      ;..FIRST COMPUTE INCREMENT FOR OPCODE TABLE INDEX;
      IF OP = RELATIONAL
				T.RELATION(T);
      THEN
        ;T1 _ 0;
				SETZ	T1,0;$
      ELSE
	IF SYM<TYPE> = BOOLEAN
				T.B	(SYM);
	THEN
	  ;T1 _ 0;
				SETZ	T1,0;$
        ELSE
	  IF OP="REM"
				T.OPER	(ZREM);
	  THEN; FUDGE INDEX TO GET AN IDIV;
	    ;T1_-2;
				MOVNI	T1,2;$
	  ELSE; USE THE RANK AS AN INDEX;
	    ;T1 _ SYM<RANK>;
				F.TRANK	(T1,SYM);
	  FI
	FI
      FI
      ;T1 _ <OPN T3,0>;
				F.DISC	(T);
				ADD	T,T1;$
				MOVE	T1,OPCODE(T);$
				TLO	T1,T3_5;$
      ;..T2 _ SYM<LOCN>;
				F.LOCN	(T2,SYM);
      IF SYM = IMMEDIATE
				T.IMM	(SYM);
      THEN;..IMMEDIATE RIGHT OPERAND;
	BEGIN
	  IF OP = RELATIONAL
				T.RELATION(T);
	  THEN;..IMMEDIATE RIGHT OPERAND IN A RELATION;
	    BEGIN
	      IF SYM<TYPE> = REAL
				T.R	(SYM);
	      THEN;..REAL IMMEDIATE CONSTANT IN A RELATION;
		BEGIN
		  ;..LOAD CONSTANT INTO T2;
				HRLZ	T2,T2;$
		  ;..ADDRESS OF OPERAND IS T2;
				HRRI	T1,T2;$
		ENDD
	      ELSE;..INTEGER IMMED. CONST. IN A RELATION;
		BEGIN
		  ;..SUBTRACT 10 FROM INST. CODE TO GET IMMED. (I) VARIANT;
		  ;T1<OPCODE> _ T1<OPCODE> - 10;
				TLZ	T1,010000;$
		  ;..LOAD IMMEDIATE CONSTANT;
				HRR	T1,T2;$
		ENDD
	      FI
	    ENDD
	  ELSE;..OP IS NOT A RELATION;
	    BEGIN
	      ;..ADD 1 TO PDP-10 INST. CODE TO GET IMMEDIATE (I) VARIANT;
	      ;T1<OPCODE> _ T1<OPCODE> + 1;
				TLO	T1,001000;$
	      ;..LOAD IMMEDIATE CONSTANT;
				HRR	T1,T2;$
	    ENDD
	  FI
	ENDD
      ELSE;..RIGHT OPERAND IS IN CONSTANT TABLE;
	;LOAD ADDRESS OF CONSTANT;
				ADD	T2,CONTAB;$
				HRRI	T1,1(T2);$
      FI
      ;..INSTRUCTION IS NOW READY;
      IF OP = RELATIONAL
				T.RELATION(T);
      THEN;..WE HAVE A RELATION;
	BEGIN
	  ;..EXECUTE THE INSTRUCTION IN T1;
				XCT	T1;$
	  ;..GENERATE "FALSE" OR "TRUE" CONSTANT;
				TDZA	T3,T3;$
				SETO	T3,0;$
	  ;SYM<TYPE> _ BOOLEAN;
				TLZ	SYM,$TYPE;$
				TLO	SYM,$B;$
        ENDD
      ELSE;..OP IS NOT A RELATION;
	BEGIN
	  ;..EXECUTE THE INSTRUCTION IN T1;
				XCT	T1;$
	  IF OP = "REM"
				T.OPER	(ZREM);
	  THEN;..QUOTIENT IS IN T3, REMAINDER IS IN T4;
	    ;RESULT CONSTANT IS REMAINDER(IDIV);
				MOVE	T3,T4;$
	  FI
	ENDD
      FI
      IF NO OVERFLOW FLAGS SET
				JFCL	11,FALSE;$
      THEN;..NO OVERFLOW.  VALID RESULT WAS PRODUCED;
	STOCON;
      ELSE;..OVERFLOW IN OPERATION ON CONSTANTS. RESULT IS INVALID;
	BEGIN
	  FAIL(74,FRIED,SYM,OVERFLOW WHILE COMBINING CONSTANTS);
	  ERRLEX;
	ENDD
      FI
    ENDD
   ELSE;..OPERANDS ARE LONG REAL;
    BEGIN
     ;..SAVE A0 (GBREG);
				MOVEM	A0,TA0;$
     ;..ASSUME SINGLE PRECISION FOR NOW			; [E044]
				SETOM	DPFLAG		; [E044]
     ;..PUT LEFT VALUE INTO (A0,A1);
     ;.. * * * NOTE THAT A1 IS THE SAME REGISTER AS T;
				F.LOCN	(T4,LOP);
				ADD	T4,CONTAB;$
				MOVE	A0,2(T4);$
				MOVE	A1,3(T4);$
				TLZN	A1,(1B0)	; [E044]
				SETZM	DPFLAG		; [E044]
     ;..PUT RIGHT VALUE INTO (A3,A4);
				F.LOCN	(T4,SYM);
				ADD	T4,CONTAB;$
				MOVE	A3,2(T4);$
				MOVE	A4,3(T4);$
				TLZN	A4,(1B0)	; [E044]
				SETZM	DPFLAG		; [E044]
     IF OP = RELATIONAL
				T.RELATION(T4);
     THEN;..WE HAVE A RELATION. RESULT WILL BE A BOOLEAN CONSTANT;
      BEGIN
	;..SUBTRACT (LONG REAL) SYM FROM LOP;
	;..NOTE THAT A2 (T1) WILL BE CLOBBERED;
        ;EXECUTE <PUSHJ  SP,LFSBC>;
				DFSB	A0,A3;$
	;..COMPARE RESULT WITH ZERO;
	;EXECUTE <OPCODE[OP<DISC>+1]  A0,0>;
				F.DISC	(T4);
				HLLZ	T4,OPCODE+1(T4);$
				XCT	T4;$
	;GENERATE "FALSE" OR "TRUE" CONSTANT IN T3;
				TDZA	T3,T3;$
				SETO	T3,0;$
	;SYM<TYPE> _ BOOLEAN;
				TLZ	SYM,$TYPE;$
				TLO	SYM,$B;$
	;..RESTORE A0;
				MOVE	A0,TA0;$
	;..PUT BOOLEAN CONSTANT AWAY;
	  STOCON;
      ENDD
     ELSE;..NOT A RELATION. RESULT IS A LONG REAL CONSTANT;
      BEGIN
        ;..PERFORM THE OPERATION;
	;.. * * * NOTE THAT A2 (T1) WILL BE CLOBBERED;
	;EXECUTE  <OPCODE[OP<DISC>+3]>;
				F.DISC	(T4);
				XCT	OPCODE+3(T4);$
	;..MOVE RESULT TO (T3,T4);
				MOVE	T3,A0;$
				MOVE	T4,A1;$
	;..RESTORE A0;
				MOVE	A0,TA0;$
	IF NO OVERFLOW IN LONG REAL MULTIPLY OR DIVIDE
				JUMPL	SYM,FALSE;$
EDIT (221); INSERT IN CONSTANT FOLDING ROUTINE IN .CGBIN
				JFOV	FALSE;		;[221]
	THEN;..STORE LONG REAL CONSTANT RESULT;
		;..IF NEITHER OPERAND WAS EXPLICIT DOUBLE PRECISION,
		;..THEN NEITHER IS THE RESULTING CONSTANT.
				SKIPE	DPFLAG		; [E044]
				TLOA	T4,(1B0)	; [E044]
				TLZ	T4,(1B0)	; [E044]
	  TOCT(2,SYM);
	ELSE;..WE HAD AN OVERFLOW IN LONG REAL "*" OR "/";
	  ;..SET UP ERROR LEXEME;
	  FAIL(74,FRIED,SYM,OVERFLOW WHILE COMBINGING CONSTANTS);	;[221]
	  ERRLEX;
	FI
      ENDD
     FI
    ENDD
   FI
  ENDD
  ELSE;..OP IS "^";
  BEGIN
    IF SYM NEQ INTEGER
				TN.I	(SYM);
    THEN;..COMPUTE POWER AT RUN-TIME;
      ;SET T TO "FALSE" AND EXIT;
				GOTO	LTC1;$
    FI
    ;..LOAD BASE (LOP) INTO A0 (AND A1);
    ;T2 _ LOP<LOCN>;
				F.LOCN	(T2,LOP);
    ;..SAVE GBREG (A0);
				MOVEM	A0,TA0;$
    IF LOP<TYPE> = LONG REAL
				T.LR	(LOP);
    THEN;..BASE IS LONG REAL;
      BEGIN;						; [E044]
      ;..PUT LONG CONSTANT INTO REGISTERS A0 AND A1;
				ADD	T2,CONTAB;$
				MOVE	A0,2(T2);$
	IF PSEUDO-LONG REAL CONVERT IT TO A REAL	; [E044]
				SKIPL	A1,3(T2)	; [E044]
				GOTO	FALSE		; [E044]
	THEN;						; [E044]
				TLZ	A1,(1B0)	; [E044]
				PUSHJ	SP,CTLRR	; [E044]
				TLZ	LOP,$TYPE	; [E044]
				TLO	LOP,$R		; [E044]
	FI;						; [E044]
      ENDD;						; [E044]
    ELSE;..BASE IS INTEGER OR REAL;
      BEGIN
   	IF LOP = IMMEDIATE
				T.IMM	(LOP);
	THEN;..IMMEDIATE VALUE MUST BE LOADED INTO A0;
	  BEGIN
	    IF LOP<TYPE> = INTEGER
				T.I	(LOP);
	    THEN
	      ;LOAD IMMEDIATE INTEGER CONSTANT;
				HRRZ	A0,T2;$
	    ELSE
	      ;LOAD IMMEDIATE REAL CONSTANT;
				HRLZ	A0,T2;$
	    FI
  	  ENDD
	ELSE;..LOP HAS A FULLWORD VALUE;
	  ;;..LOAD CONSTANT FROM TABLE;
				ADD	T2,CONTAB;$
				MOVE	A0,1(T2);$
	FI
      ENDD
    FI
    ;..PUT EXPONENT (SYM) INTO A2;
    ;T2 _ SYM<LOCN>;
				F.LOCN	(T2,SYM);
    IF SYM = IMMEDIATE
				T.IMM	(SYM);
    THEN;..IMMEDIATE VALUE MUST BE LOADED INTO A2;
      ;..LOAD IMMEDIATE INTEGER CONSTANT;
				HRRZ	A2,T2;$
    ELSE;..SYM HAS A FULLWORD VALUE;
       ;..LOAD CONSTANT FROM TABLE;
				ADD	T2,CONTAB;$
				MOVE	A2,1(T2);$
    FI
    ;..COPY EXPONENT FOR SIGN CHECK;
				MOVE	T4,A2;$
    ;..EXECUTE THE CALL.  RESULT IN A0 (AND A1);
				F.TRANK	(T2,LOP);
				XCT	OPPOWC(T2);$
    ;..MOVE FIRST WORD OF RESULT TO T3;
				MOVE	T3,A0;$
    ;..RESTORE GBREG (A0);
				MOVE	A0,TA0;$
    IF SYM IS AN ERROR LEXEME
				JUMPGE	SYM,FALSE;$
    THEN;..SET RESULT LEXEME;
      ERRLEX;
    ELSE;..RESULT IS VALID. PUT IT AWAY;
      BEGIN
        IF LOP<TYPE> = LONG REAL
				T.LR	(LOP);
        THEN;..RESULT IS LONG REAL;
          BEGIN
	    ;..MOVE SECOND WORD OF RESULT TO T4;
				MOVE	T4,A1;$
            ;..PUT LONG CONSTANT IN TABLE;
	      TOCT(2,SYM);
            ;LEX(SYM) _ (SAME,LONG REAL,SAME,SAME);
				TLZ	SYM,$TYPE;$
				TLO	SYM,$LR;$
          ENDD
        ELSE;..PUT SHORT CONSTANT AWAY;
          BEGIN
	    IF LOP<TYPE> = INTEGER AND EXPONENT GTE 0
				JUMPL	T4,FALSE;$
				T.I	(LOP);
	    THEN;..TYPE OF SYM SHOULD BE INTEGER (IT ALREADY IS);
	    ELSE;..TYPE OF RESULT SHOULD BE REAL;
	      ;LEX(SYM) _ (SAME,REAL,SAME,SAME);
				TLZ	SYM,$TYPE;$
				TLO	SYM,$R;$
	    FI
	    STOCON;
	  ENDD
	FI
      ENDD
    FI
  ENDD
  FI
  ;..RESULT HAS BEEN COMPUTED. SET FLAG TO TRUE;
  ;T _ "TRUE";
				SETO	T,0;$
 ENDD
 ELSE;..OPERANDS ARE NOT BOTH CONSTANTS AND RESULT CANNOT BE COMPUTED NOW;
   LTC1:
   ;..SET FLAG TO FALSE;
   ;T _ "FALSE";
				SETZ	T,0;$
 FI
ENDD	; TREATCONST
	SUBTTL	CODE GENERATION ROUTINES	* TRUNACONST *

PROCEDURE TRUNACONST;

	;..PERFORM UNARY OP AT COMPILE-TIME IF OPERAND IS A CONSTANT.
	    ;  IF OPERAND IS NOT A CONSTANT, FLAG (T) IS SET TO
	    ;  "FALSE" (ALL ZEROS);
	    ;  IF IT IS A CONSTANT, NEW CONSTANT IS PRODUCED
	    ;  AND FLAG IS SET TO "TRUE" (ALL ONES);
	;  ON ENTRY, OPD LEXEME IS IN SYM AND OPN LEXEME IS IN OP;
	;  RESULT LEXEME GOES TO SYM.
	    ;  NEW CONSTANT IS PUT INTO LEXEME IF IT IS IMMEDIATE,
	    ;  OTHERWISE IT IS PUT INTO THE CONSTANT TABLE;

BEGIN
  IF SYM = CONSTANT
				T.CONST	(SYM);
  THEN;..WE MUST DO SOMETHING;
    BEGIN
      ;T2 _ SYM<LOCN>;
				F.LOCN	(T2,SYM);
      IF SYM<TYPE> = LONG REAL
				T.LR	(SYM);
      THEN;..LONG REAL OPERAND POSSIBLE ONLY FOR UNARY "-";
	BEGIN
	  ;NEGATE LONG CONSTANT INTO T3 AND T4;
				ADD	T2,CONTAB;$
				DMOVN	T3,2(T2)
				TLZ	T4,(1B0)	; [E044]
				SKIPL	3(T2)		; [E044]
				TLZA	T4,(1B0)	; [E044]
				TLO	T4,(1B0)	; [E044]
	  ;..PUT NEW CONSTANT IN TABLE;
	    TOCT(2,SYM);
        ENDD
      ELSE;..SHORT CONSTANT;
        BEGIN
	  IF OP = "NOT"
				T.OPER	(ZNOT);
	  THEN;..COMPLEMENT THE CONSTANT;
	    BEGIN
	      IF SYM = IMMEDIATE
				T.IMM	(SYM);
	      THEN;..PUT COMPLEMENT OF IMMED. CONSTANT INTO T3;
				SETCM	T3,T2;$
	      ELSE;..GET COMPLEMENT OF TABLED CONST. INTO T3;
				ADD	T2,CONTAB;$
				SETCM	T3,1(T2);$
	      FI
	    ENDD
	  ELSE;..OP MUST BE UNARY "-";
	    BEGIN
	      IF SYM = IMMEDIATE
				T.IMM	(SYM);
	      THEN;..CONSTANT IS IN A HALFWORD;
		BEGIN
		  IF SYM<TYPE> = INTEGER
				T.I	(SYM);
		  THEN;..NEGATE IMMED. INTEGER CONST. INTO T3;
				MOVN	T3,T2;$
		  ELSE;..NEGATE IMMED. REAL CONSTANT INTO T3;
				HRLZ	T3,T2;$
				MOVN	T3,T3;$
		  FI
		ENDD
	      ELSE;..CONSTANT TAKES A FULL WORD;
		;NEGATE CONSTANT FROM TABLE INTO T3;
				ADD	T2,CONTAB;$
				MOVN	T3,1(T2);$
	      FI
	    ENDD
	  FI
	  ;..SET UP LEXEME AND STORE IN CONSTANT TABLE;
	  STOCON;
	ENDD
      FI
      ;..UNARY OPERATION IS COMPLETE;
      ;T _ TRUE;
				SETO	T,0;$
    ENDD
  ELSE;..OPERAND IS NOT A CONSTANT. UNARY OP MUST BE GENERATED;
    ;T _ FALSE;
				SETZ	T,0;$
  FI
ENDD	; TRUNACONST
ENDD; OF MODULE MCOD

LIT
END