Google
 

Trailing-Edge - PDP-10 Archives - ALGOL-20_1-29-82 - algol-sources/algfun.mac
There are 8 other files named algfun.mac in the archive. Click here to see a list.
;
;
;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 2

; 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 MFUN;
$PLEVEL=2;

BEGIN

EXPROC CGBIN
EXPROC CLOSE
EXPROC EMITCODE
EXPROC ERRLEX
EXPROC FAIL
EXPROC GLOAD
EXPROC IPLUNK
EXPROC LOAD
EXPROC MERGEPORTIONS
EXPROC PLUNK
EXPROC REOPEN
EXPROC REVORDER
EXPROC TOCT1
EXPROC TOCT2
EXPROC UNSTACK

INTERN CTILR,CTLRI,CTLRR
INTERN POWC1,POWC2,POWC3

EXTERN PRASE,ZABS,ZBOOL,ZENTIER,ZINT,ZSIGN
EXTERN OPABS,OPENT1,OPENT2,OPENT3,OPJSPX,OPMVMS,OPUMIN
EXTERN OPPSJP,OPSGN1,OPSGN2,OPSGN3,OPSETO
EXTERN OPADDB,OPAOS,OPSOS,OPMVSM
EXTERN OPJMPE,OPJMPG,OPJRST,OPMVLP
EXTERN OPCONC,OPCONV,OPMOVE,OPABS1,OPLNEG
EXTERN OPENT4,OPENT5
	SUBTTL COMPILE-TIME TYPE-CONVERSION ROUTINES

;*CTIR	INTEGER TO REAL
; CTILR	INTEGER TO LONG REAL
;*CTRI	REAL TO INTEGER
;*CTRLR	REAL TO LONG REAL
; CTLRI	LONG REAL TO INTEGER
; CTLRR	LONG REAL TO REAL

; ON ENTRY, THE ARGUMENT IS IN A0 OR A0,A1
; THE LINK IS ON THE STACK

; ON EXIT, THE RESULT IS IN A0 OR A0,A1


CTLRI:	DFAD	A0,[
	EXP	0.5,0.0]
	HLRZ	A2,A0
	LSH	A2,-11
	ANDI	A2,000377	; EXTRACT HIGH ORDER EXPONENT
	TLZ	A0,377000	; AND CLEAR IT OUT
	JUMPGE	A0,.+3		; NUMBER POSITIVE?
	TRC	A2,000377	; NO -- COMPLEMENT EXTRACTED EXPONENT
	TLO	A0,377000	; AND SET ALL ONES
	SUBI	A2,243		; ADJUST EXPONENT
	JUMPG	A2,.+3		; TOO BIG - OVERFLOW
EDIT(006); CORRECT SHIFT
	ASHC	A0,10(A2)	; [E006] SHIFT MANTISSA TO INTEGER
	POPJ	SP,
	FAIL(128,SOFT,SYM,INTEGER TOO LARGE)
	JUMPL	A0,CTLRI5	; NEG ?
	HRLOI	A0,377777	; SET LARGEST POSITIVE NUMBER
	POPJ	SP,

CTLRI5:	MOVSI	A0,(400000,,0)	; LARGEST NEGATIVE
	POPJ	SP,


CTILR:	ASHC	A0,-^D35	; SHIFT SIGNIFICANCE TO A1
	TLC	A0,276000	; JUGGLE THE EXPONENT
	DFAD	A0,[
	EXP	0.0,0.0]	; NORMALIZE
	POPJ	SP,		; AND RETURN
CTLRR:	JUMPGE	A0,.+3		; ARGUMENT POSITIVE?
	DMOVN	A0,A0		; NO - NEGATE IT
CTLRRD:	TLZA	A1,400000	; AND CLEAR BIT 0 FLAG
CTLRRC:	TLO	A1,400000	; YES - SET BIT 0 FLAG
	TLNN	A1,200000	; ROUNDING REQUIRED?
	JRST	CTLRRA		; NO
	CAMN	A0,[
	XWD	377777,777777]	; YES - HIGH WORD TOO LARGE?
	JRST	CTLRRA		; YES - FORGET IT
	ADDI	A0,1		; NO
	TLO	A0,400		; CARRY

CTLRRA:	JUMPL	A1,.+2		; EXIT IF POSITIVE
	MOVN	A0,A0		; OTHERWISE NEGATE
	POPJ	SP,
SUBTTL	POWC1 -- INTEGER TO INTEGER EXPONENTIATION ROUTINE


; ON ENTRY:
; THE BASE IS IN A0
; THE EXPONENT IS IN A2
; THE LINK IS ON THE STACK

; ON EXIT, THE RESULT (INTEGER OR REAL) IS IN A0


POWC1:	JUMPN	A0,POWC11	; BASE = 0?
	JUMPLE	A2,POWCER	; YES. ERROR IF EXPONENT <= 0
POWC10:	POPJ	SP,		; RESULT = 0 FOR ZERO BASE AND POS. EXP.
	
POWC11:	JUMPL	A2,POWC13	; NEG. EXP. YIELDS REAL RECIPROCAL
	MOVE	A1,A0		; COPY BASE
	MOVEI	A0,1		; PREPARE FOR MULTIPLICATION
	JUMPE	A2,POWC10	; IF EXP. = 0 THEN I^0 = 1

POWC12:	TRZE	A2,000001	; BIT SET IN EXPONENT?
	IMUL	A0,A1		; YES -- MULTIPLY
	JUMPE	A2,POWC25	; EXIT IF FINISHED
	IMUL	A1,A1		; OTHERWISE SQUARE MULTIPLIER
	LSH	A2,-1		; SHIFT BIT OUT OF EXPONENT
	JRST	POWC12		; AND CARRY ON

POWC13:	FLTR	A0,A0		; CONVERT INTEGER BASE TO REAL
	JRST	POWC22		; COMPUTE REAL POWER
SUBTTL	POWC2 -- REAL TO INTEGER EXPONENTIATION ROUTINE

; ON ENTRY:
; THE BASE IS IN A0
; THE EXPONENT IS IN A2
; THE LINK IS ON THE STACK

; ON EXIT, THE RESULT IS IN A0


POWC2:	JUMPE	A0,POWC24	; BASE = 0?
	JUMPN	A2,POWC21	; NO. EXPONENT = 0?
	MOVSI	A0,(1.0)	; YES.  R^0 = 1.0
POWC20:	POPJ	SP,		; EXIT

POWC21:	CAIG	A2,0		; EXPONENT POSITIVE?
POWC22:	TDZA	A3,A3		; NO. CLEAR POSITIVE FLAG AND SKIP
	MOVEI	A3,1		; YES. SET POSITIVE FLAG
	MOVM	A2,A2		; GET MAGNITUDE OF EXPONENT
	MOVE	A1,A0		; COPY BASE
	MOVSI	A0,(1.0)	; PREPARE FOR "*" (OR "/")

POWC23:	TRZE	A2,000001	; BIT SET IN EXPONENT?
	XCT	[
	FDVR	A0,A1
	FMPR	A0,A1](A3)	; YES -- MULTIPLY/DIVIDE
	JUMPE	A2,POWC25	; EXIT IF FINISHED
	FMPR	A1,A1		; OTHERWISE SQUARE MULTIPLIER
	LSH	A2,-1		; SHIFT BIT OUT OF EXPONENT
	JRST	POWC23		; AND CARRY ON

POWC24:	JUMPG	A2,POWC20	; BASE = 0 -- EXIT IF EXPONENT > 0
POWCER:
	FAIL(76,FRIED,SYM,OVERFLOW OR UNDEFINED RESULT FOR "CONSTANT ^ CONSTANT");
	POPJ	SP,		; ERROR EXIT

POWC25:	JFOVO	POWCER		; ERROR IF OVERFLOW FLAG ON
	POPJ	SP,		; NORMAL EXIT
SUBTTL	POWC3 -- LONG REAL TO INTEGER EXPONENTIATION ROUTINE

; ON ENTRY:
; THE BASE IS IN (A0,A1)
; THE EXPONENT IS IN A2
; THE LINK IS ON THE STACK

; ON EXIT, THE RESULT (TYPE LONG REAL) IS IN A0,A1


POWC3:	JUMPN	A0,.+3		; BASE = 0?
	JUMPLE	A2,POWCER	; YES - ERROR IF EXP LEQ 0
	POPJ	SP,
	MOVE	A3,A0		; NO -- COPY BASE
	MOVE	A4,A1
	MOVSI	A0,(1.0)	; INITIALIZE RESULT TO 1.0&&0
	MOVEI	A1,0
	JUMPN	A2,POWC31	; EXPONENT = 0?
	POPJ	SP,0		; YES -- RESULT = 1.0&&0

POWC31:	PUSH	SP,A6		; SAVE REGISTERS
	PUSH	SP,A7
	MOVM	A7,A2		; COPY MAGNITUDE OF EXPONENT
	JUMPG	A2,POWC32	; EXPONENT POSITIVE?
	TDZA	A6,A6		; NO -- CLEAR POSITIVE FLAG
POWC32:	MOVEI	A6,1		; YES -- SET POSITIVE FLAG

POWL1:	TRZE	A7,1		; STRICTLY KI
	XCT	[
	DFDV	A0,A3		; IF BIT SET IN EXPT, THEN DIVIDE/MULTIPLY
	DFMP	A0,A3](A6)
	JUMPE	A7,POWLEX	; ELSE EXIT IF FINISHED
	DFMP	A3,A3		; OTHERWISE SQUARE MULTIPLIER
	LSH	A7,-1		; SHIFT BIT OUT OF EXPT
	JRST	POWL1		;  AND CONTINUE
POWLEX:	POP	SP,A7		; RESTORE REGISTERS
	POP	SP,A6
	JFOVO	POWCER		; ERROR RETURN IF OVERFLOW FLAG ON
	POPJ	SP,0		; NORMAL RETURN
	SUBTTL	CODE GENERATION ROUTINES	* CGFUN *

PROCEDURE CGFUN

	;..GENERATE CODE FOR CALLS ON STANDARD FUNCTIONS;
	    ;  ON ENTRY, FUNCTION LEXEME IS IN LOP;
	    ;  ARGUMENT LEXEME IS IN SYM;
	;  FOR LIBRARY FUNCTIONS, ARGUMENT WILL BE CONVERTED
	    ;  TO PROPER TYPE AND LOADED INTO A0.
	;  IN-LINE CODE WILL BE GENERATED FOR:
	    ;		INT
	    ;		BOOL
	    ;		ABS
	    ;		SIGN
	    ;		ENTIER
	;  RESULT IS A CLOSED PORTION WHOSE LEXEME IS IN SYM;

BEGIN
 IF SYM IS AN ERROR LEXEME
				JUMPGE	SYM,FALSE
 THEN;..SET ERROR LEXEME AND LEAVE;
   ERRLEX;
 ELSE;..NO ERRORS YET ..... GO ON;
 BEGIN
  ;..SET REV OFF;
				MOVNI	REV,SYM
  IF LOP IS A LIBRARY FUNCTION
				HRRZ	T,LOP
				CAIGE	T,PRASE
				GOTO	FALSE
  THEN;..WE MUST CALL A SUBROUTINE;
    BEGIN
      IF SYM<TYPE> NEQ ARITHMETIC
				TN.ARITH(SYM);
      THEN
	FAIL(77,FRIED,SYM,NON-ARITHMETIC ARGUMENT FOR STANDARD LIBRARY FUNCTION);
      ELSE;..ARGUMENT IS ARITHMETIC;
	BEGIN
	  IF LOP<TYPE> = REAL AND SYM<TYPE> NEQ REAL
				TLNN	LOP,$TYPE-$R
				TN.R	(SYM);
	  THEN;..ARGUMENT MUST BE CONVERTED TO REAL;
	    ;CONVERT(REAL,SYM);
				MOVEI	T,$R
	      CONVERT;
	  ELSE;..LOP HAD BETTER BE LONG REAL;
	    BEGIN					; [E044]
	      IF LOP<TYPE> = LONG REAL AND SYM<TYPE> NEQ LONG REAL
				TLNN	LOP,$TYPE-$LR
				TN.LR	(SYM);
	      THEN;..ARGUMENT MUST BE CONVERTED TO LONG REAL;
	        ;CONVERT(LONG REAL,SYM);
				MOVEI	T,$LR
		CONVERT;
	      FI;
EDIT(044); Dont force constants to D.P. unnecessarily
	      ;.SYM IS LONG REAL - CHECK IF GENUINE	; [E044]
	      IF SYM = PSEUDO-LONG 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;.MAKE IT A GENUINE LONG REAL CONSTANT; [E044]
				MOVE	T3,2(T2)	; [E044]
				TLZ	T4,(1B0)	; [E044]
				TOCT	(2,SYM)		; [E044]
	      FI;					; [E044]
	    ENDD;					; [E044]
	  FI
	  IF SYM IS A POINTER
				T.PTR	(SYM);
	  THEN;..PUT ITS VALUE INTO A0;
	    ;GO TO NEXT "THEN";
				GOTO	LCGFN1
	  FI
	  IF VALUE OF SYM NOT IN A0
				TN.AC0	(SYM);
	  THEN;..ARGUMENT FOR A LIBRARY FUNCTION MUST BE IN A0;
	    LCGFN1:
	    LOAD(SYM,A0);
	  FI
	  REOPEN(SYM);
	  ;..GENERATE CALL ON LIBRARY FUNCTION;
	  IF LOP<TYPE> = LONG REAL
				T.LR(LOP);
	  THEN
				MOVSI	T,7777
	  ELSE
				MOVSI	T,77
	  FI
				IORM	T,HANDLE
	  ;PLUNK(PUSHJ,SP,LOP);
				MOVE	T,OPPSJP
				PLUNKI	(LOP);
	  ;LEX(SYM) _ (EXPR,SAME,STATEMENT,ACC);
				TLZ	SYM,$KIND!$STATUS!$AM
				TLO	SYM,$EXP!$STMT!$ACC
	  CLOSE(SYM);
	ENDD
      FI
    ENDD
      ELSE;..NOT A LIBRARY FUNCTION - MUST BE IN-LINE;
	IF LOP = "INT"
				CAIE	T,ZINT
				GOTO	FALSE
	THEN;..BOOLEAN-TO-INTEGER TRANSFER FUNCTION -- NO CODE GENERATED;
	  BEGIN
	    IF SYM<TYPE> NEQ BOOLEAN
				TN.B	(SYM);
	    THEN
	      FAIL(78,FRIED,SYM,NON-BOOLEAN ARGUMENT FOR "INT" FUNCTION);
	    ELSE;..ARGUMENT IS BOOLEAN. MAKE IT AN INTEGER EXPR;
	      BEGIN
		IF SYM IS A POINTER
				T.PTR	(SYM);
		THEN;..LOAD VALUE INTO SAME ACC USED BY PTR;
				F.LOCN	(T2,SYM);
		  LOAD(SYM,@T2);
		ELSE;..NOT A POINTER;
		  IF SYM IS SINGLE
				T.SINGLE(SYM);
		  THEN;..MAKE IT A PORTION IN AN ACC;
		    LOAD(SYM,ANYAC);
		  FI
		FI
	        ;LEX(SYM) _ (SAME,INTEGER,STATEMENT,SAME);
				TLZ	SYM,$TYPE!$STATUS
				TLO	SYM,$I!$STMT
	      ENDD
	    FI
	  ENDD
	ELSE;..FUNCTION IS NOT "INT";
	  IF LOP = "BOOL"
				CAIE	T,ZBOOL
				GOTO	FALSE
	  THEN;..INTEGER-TO-BOOLEAN TRANSFER FUNCTION -- NO CODE GENERATED;
	    BEGIN
	      IF SYM<TYPE> NEQ INTEGER
				TN.I	(SYM);
	      THEN
		FAIL(79,FRIED,SYM,NON-INTEGER ARGUMENT FOR "BOOL" FUNCTION);
	      ELSE;..ARGUMENT IS INTEGER. MAKE IT A BOOLEAN EXPR;
		BEGIN
		  IF SYM IS A POINTER
				T.PTR	(SYM);
		  THEN;..LOAD VALUE INTO SAME ACC USED BY PTR;
				F.LOCN	(T2,SYM);
		    LOAD(SYM,@T2);
		  ELSE;..NOT A POINTER;
		    IF SYM IS SINGLE
				T.SINGLE(SYM);
		    THEN;..MAKE IT A PORTION IN AN ACC;
		      LOAD(SYM,ANYAC);
		    FI
		  FI
		  ;LEX(SYM) _ (SAME,BOOLEAN,STATEMENT,SAME);
				TLZ	SYM,$TYPE!$STATUS
				TLO	SYM,$B!$STMT
		ENDD
	      FI
	    ENDD
	  ELSE;..FUNCTION IS NOT "INT" OR "BOOL";
	   IF SYM<TYPE> NEQ ARITHMETIC
				TN.ARITH(SYM);
	   THEN
	     FAIL(80,FRIED,SYM,NON-ARITHMETIC ARGUMENT FOR BUILT-IN FUNCTION);
	   ELSE;..ARGUMENT IS ARITHMETIC;
EDIT(044); Dont force constants to D.P. unnecessarily
	    BEGIN;					; [E044]
	    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 IT TO A REAL			; [E044]
				MOVE	T3,A0		; [E044]
				MOVE	A0,2(T2)	; [E044]
				MOVE	A1,3(T2)	; [E044]
				TLZ	A1,(1B0)	; [E044]
				PUSHJ	SP,CTLRR	; [E044]
				EXCH	T3,A0		; [E044]
				TLZ	SYM,$TYPE
				TLO	SYM,$R
	    STOCON;					; [E044]
				HRRZ	T,LOP		; [E044]
	    FI;						; [E044]
	    IF LOP = "ABS"
				CAIE	T,ZABS
				GOTO	FALSE
	    THEN;..ABSOLUTE VALUE FUNCTION;
	      BEGIN
	       ;..RESULT WILL HAVE SAME TYPE AS ARGUMENT
	       ;  (TECHNICALLY NOT CORRECT ALGOL 60);
	       IF SYM<TYPE> = LONG REAL
				T.LR	(SYM);
	       THEN;..WE MUST LOAD THE VALUE AND TEST IT;
		BEGIN
		  IF SYM IS A POINTER
				T.PTR	(SYM);
		  THEN;..LOAD VALUE INTO SAME ACC USED BY PTR;
				F.LOCN	(T2,SYM);
		    LOAD(SYM,@T2);
		  ELSE;..NOT A POINTER;
		    IF SYM IS SINGLE
				T.SINGLE(SYM);
		    THEN;..MAKE A PORTION TO LOAD SYM IN AN ACC;
		      LOAD(SYM,ANYAC);
		    FI
		  FI
		  REOPEN(SYM);
		  ;..EMIT IN-LINE CODE TO TEST SIGN AND NEGATE NEG. VALUE;
		  ;..SKIP THE NEGATION FOR POSITIVE VALUES;
		  ;PLUNK(JUMPGE,SYM,.+2);
				MOVE	T,OPABS1
				F.LOCN	(T1,SYM);
				PLUNK;
		  ;..NEGATE THE NEGATIVE VALUE;
		  ;PLUNK(LONG NEGATE,SYM,SYM+1);
				MOVE	T,OPLNEG
				F.LOCN	(T1,SYM);
				MOVE	T2,SYM
				TLZ	T2,777777-$AM
				ADD	T,T2
				PLUNK;
		  CLOSE(SYM);
		ENDD
	       ELSE;..SYM IS INTEGER OR REAL;
		IF SYM IS AN EXPR OR A POINTER IN ACC
				T.ACC	(SYM);
		THEN;..WE ALREADY HAVE A PORTION FOR SYM;
		  BEGIN
		    ;..APPEND CODE TO GET MAGNITUDE OF SYM;
		    REOPEN(SYM);
		    ;PLUNK(MABS,SYM,SYM);
				MOVE	T,OPABS
				F.LOCN	(T1,SYM);
				PLUNK	(SYM);
		    CLOSE(SYM);
		  ENDD
		ELSE;..NO PORTION YET. LOAD MAGNITUDE OF SINGLE ARGUMENT;
		  ;LOADM(SYM,ANYAC);
				MOVEI	T1,ANYAC
				HLL	T1,OPMVMS
				PUSHJ	SP,.LOAD
		FI
	       FI
	       ;LEX(SYM) _ (EXPR,SAME,STATEMENT,ACC);
				TLZ	SYM,$KIND!$STATUS!$AM
				TLO	SYM,$EXP!$STMT!$ACC
	      ENDD
	    ELSE;..FUNCTION IS NOT "INT" OR "BOOL" OR "ABS";
	      IF LOP = "SIGN"
				CAIE	T,ZSIGN
				GOTO	FALSE
	      THEN;..SIGN FUNCTION;
		BEGIN
		  IF SYM IS A POINTER
				T.PTR	(SYM);
		  THEN;..LOAD VALUE INTO SAME ACC USED BY POINTER;
				F.LOCN	(T2,SYM);
		    LOAD(SYM,@T2);
		  ELSE;..NOT A POINTER;
		    IF SYM IS SINGLE
				T.SINGLE(SYM);
		    THEN;..MAKE A PORTION TO LOAD SYM INTO AN ACC;
		      LOAD(SYM,ANYAC);
		    FI
		  FI
		  REOPEN(SYM);
		  ;..EMIT IN-LINE CODE TO COMPUTE "SIGN" FUNCTION;
		  ;..IF ARGUMENT = 0 THEN SIGN(ARG) = 0;
		  ;PLUNK(JUMPE,SYM,.+3);
				MOVE	T,OPSGN1
				F.LOCN	(T1,SYM);
				PLUNK;
		  ;..SHIFT OUT ALL BUT SIGN BITS (YIELDS 0 OR -1);
		  ;PLUNK(ASH,SYM,-43);
				MOVE	T,OPSGN2
				F.LOCN	(T1,SYM);
				PLUNK;
		  ;..SET LOW-ORDER BIT TO 1 (YIELDS 1 OR -1);
		  ;PLUNK(TRO,SYM,1);
				MOVE	T,OPSGN3
				F.LOCN	(T1,SYM);
				PLUNK;
		  ;LEX(SYM) _ (EXPR,INTEGER,STATEMENT,ACC);
				TLZ	SYM,$KIND!$TYPE!$STATUS!$AM
				TLO	SYM,$EXP!$I!$STMT!$ACC
		  CLOSE(SYM);
		ENDD
	      ELSE;..FUNCTION IS NOT "INT" OR "BOOL" OR "ABS" OR "SIGN";
		IF LOP = "ENTIER"
				CAIE	T,ZENTIER
				GOTO	FALSE
		THEN;..LARGEST-INTEGER FUNCTION;
		  BEGIN
		    IF SYM<TYPE> = INTEGER
				T.I	(SYM);
		    THEN
		      ;CONVERT(REAL,SYM);
				MOVEI	T,$R
			CONVERT;
		    FI
			IF SYM<TYPE> = LONG REAL
				T.LR	(SYM);
			THEN;..LONG REAL ENTIER. CALL SUBROUTINE;
			  BEGIN
			    IF SYM IS A POINTER
				T.PTR	(SYM);
			    THEN;..MUST GET ITS VALUE;
			      ;GO TO NEXT "THEN";
				GOTO	LCGFN2
			    FI
			    IF VALUE OF SYM NOT IN A0
				TN.AC0	(SYM);
			    THEN;..LOAD IT INTO A0;
			      LCGFN2:
			      LOAD(SYM,A0);
			    FI
			    REOPEN(SYM);
			    ;..GENERATE INST. TO CALL LONG REAL ENTIER SR;
			    ;PLUNK(JSP,AX,ENTIEL);
				MOVE	T,OPJSPX
				PLUNKI;
			    ;LEX(SYM) _ (EXPR,INTEGER,STATEMENT,ACC);
				TLZ	SYM,$KIND!$TYPE!$STATUS!$AM
				TLO	SYM,$EXP!$I!$STMT!$ACC
			    CLOSE(SYM);
			  ENDD
			ELSE;..ARGUMENT IS REAL. EMIT IN-LINE REAL ENTIER;
			  BEGIN
			    ;..GIVE SYM SPECIAL TYPE SO LOAD WILL USE 2 ACS;
				TLZ	SYM,$TYPE
				TLO	SYM,$IDI
			    IF SYM IS A POINTER
				T.PTR	(SYM);
			    THEN;..MUST GET VALUE OF PTR INTO AN AC;
			      ;..LOAD INTO SAME AC USED FOR PTR;
				F.LOCN	(T2,SYM);
				LOAD	(SYM,@T2);
			    ELSE;..NOT A POINTER;
			      BEGIN
				IF SYM IS SINGLE OR IN LAST AC <AC13>
				TLNN	SYM,$SINGLE
				GOTO	TRUE
				F.LOCN	(T,SYM);
				CAIE	T,A13
				GOTO	FALSE
				THEN;..MUST MOVE SYM TO A FREE AC PAIR;
				  LOAD(SYM,ANYAC);
				FI
			      ENDD
			    FI
			    IF LAST GENERATED INST. WAS "MOVEI"
				MOVE	T,INDEX
				HLRZ	T2,-2(T)
				ANDI	T2,777000
				CAIE	T2,<MOVEI 0,0>_-22
				GOTO	FALSE
			    THEN;..SYM WAS AN IMMEDIATE REAL CONSTANT;
			      ;..   BUT "LOAD" THOUGHT IT WAS INTEGER;
			      ;..CHANGE INSTRUCTION TO "HRLZI";
				MOVE	T2,-2(T)
				TLZ	T2,777000
				TLO	T2,<HRLZI 0,0>_-22
				MOVEM	T2,-2(T)
			    FI
			    REOPEN(SYM);
			    ;..EMIT IN-LINE CODE TO COMPUTE "ENTIER";
EDIT(031); CAN'T USE FIX OR FIXR, SO DO IT THE HARD WAY
		;......SPLIT OFF EXPONENT;
			    ;EMITCODE(MULI,SYM,400,2);
				MOVE	T,OPENT1
				F.LOCN	(T1,SYM);
				HRLI	T1,2
				EMITCODE;
			    ;..COMPLEMENT EXPONENT FOR NEGATIVE ARGUMENT;
			    ;PLUNK(TSC,SYM,SYM);
				MOVE	T,OPENT2
				F.LOCN	(T1,SYM);
				PLUNK	(SYM);
			    ;EXCHANGE EXPONENT AND FRACTION;
			    ;PLUNK(EXCH,SYM+1,SYM);
				HRLZI	T,<EXCH 0,0>_-22
				F.LOCN	(T1,SYM);
				ADDI	T1,1
				PLUNK	(SYM);
			    ;..SHIFT ARGUMENT TO ZERO EXPONENT;
			    ;PLUNK(ASH,SYM<LOCN>,-243(SYM<LOCN>+1));
				MOVE	T,OPENT3
				F.LOCN	(T1,SYM);
				PLUNK;
			    ;LEX(SYM)_(EXPR,INTEGER,STATEMENT,SYM<LOCN>);
				TLZ	SYM,$KIND!$TYPE!$STATUS!$AM
				TLO	SYM,$EXP!$I!$STMT!$ACC
			    CLOSE(SYM);
			  ENDD
			FI
		  ENDD
		;..ELSE NOT ENTIER;
		FI;..IF LOP = ENTIER
	      FI;..IF LOP = SIGN
	    FI;..IF LOP = ABS
	    ENDD;
	   FI;..IF SYM<TYPE> NEQ ARITHMETIC
	  FI;..IF LOP = BOOL
	FI;.. IF LOP = INT
      FI;..IF LOP IS A LIBRARY FUNCTION
    ENDD;
  FI;..IF SYM IS AN ERROR LEXEME
ENDD	; CGFUN
	SUBTTL	CODE GENERATION ROUTINES	* CGDOT *

PROCEDURE CGDOT

	;..GENERATE CODE TO LOAD OPERANDS FOR "DOT" OPERATOR;
	    ;  ON ENTRY, LEXEME FOR STRING POINTER IS IN LOP;
	    ;  LEXEME FOR INDEX IS IN SYM;
	;  CODE WILL BE GENERATED TO PUT STRING POINTER INTO A2
	    ;  AND INDEX INTO A1;
	;  RESULT IS A SINGLE CLOSED PORTION WHOSE LEXEME IS IN SYM;

BEGIN
  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 SYM = SINGLE
				T.SINGLE(SYM);
      THEN;..NO PORTION YET FOR SYM;
	REOPEN(LOP);
      ELSE;..BOTH LOP AND SYM ARE PORTIONS -- JOIN THEM;
	BEGIN
	  REVER;
	  MERGEPORTIONS;
	  COMBLEX;
	ENDD
      FI
      IF SYM IN AC2
				TLNN	SYM,$AMAC
				TRNN	SYM,2
				JRST	FALSE
				TRNE	SYM,-3
				JRST	FALSE
	THEN
	  BEGIN;..PUSH IT
				HRLZI	T,(<PUSH SP,0>)
	    PLUNKI(SYM)
	    ;..SYM<AM> _ SP
				TLZ	SYM,$AM
				TLO	SYM,$SP
	    ;..SYM<RHS> _ 0
				TRZ	SYM,-1
	    ;..SYM<SA> _ SYM<SA> + 1
				HRLZI	T,1
				ADDM	T,LEXEX
	    IF LOP IS ON STACK
				T.STK	(LOP)
	      THEN;..ADJUST STACK OFFSET
				SUBI	LOP,1
	    FI;
	  ENDD;
      FI;
      IF LOP NOT IN AC2
				TLNE	LOP,$AMAC
				GOTO	TRUE
				HRRZ	T,LOP
	EDIT(225)		;DELETE IN PROC. CGDOT IN ALGFUN [JBS 4/11/80]
      ; N.B. IF LOP IS IN AC0, ADDRESS IS IN AC2;
				CAIN	T,A2
				GOTO	FALSE
      THEN;..PUT IT INTO AC2;
        BEGIN
          ;..FUDGE MODE TO MOVE POINTER ITSELF (NOT @PTR);
          IF LOP IS ON THE STACK
				T.STK	(LOP);
          THEN;..FUDGE AS STACKED EXPRESSION;
				TLZ	LOP,$AM
				TLO	LOP,$SP
          ELSE;..FUDGE AS EXPRESSION IN ACC;
				TLZ	LOP,$AM
				TLO	LOP,$ACC
          FI
	  ;PLUNK(MOVE,AC2,LOP);
				MOVE	T,OPMOVE
				MOVEI	T1,A2
				PLUNK	(LOP);
        ENDD
      FI
      IF SYM NOT IN AC1
				TLNE	SYM,$AMAC
				GOTO	TRUE
				HRRZ	T,SYM
				CAIN	T,A1
				GOTO	FALSE
      THEN;..PUT IT INTO AC1;
				MOVE	T,OPMVSM
				MOVEI	T1,A1
	GLOAD;
      FI
      ;LEX(SYM) _ (VAR,STRING,REGULAR,PTR,AC2);
				TLZ	SYM,$KIND!$TYPE!$STATUS!$AM
				TLO	SYM,$VAR!$S!$REG!$PTR
				HRRI	SYM,A2
      CLOSE(SYM);
    ENDD
  FI
ENDD	; CGDOT
	SUBTTL	CODE GENERATION ROUTINES	* CGFTEST *

PROCEDURE CGFTEST

	;..GENERATE CODE FOR THE "STEP-UNTIL" TEST IN A "FOR" STATEMENT
	    ;  ON ENTRY, LEXEME FOR CONTROLLED VARIABLE IS IN LOP;
	    ;  LEXEME FOR FINAL VALUE IS IN SYM;
	    ;  LEXEME FOR INCREMENT IS IN FBSYMSAVE;
	;  IF INCREMENT = CONSTANT, ITS SIGN WILL NOT BE
	    ;  TESTED AT RUN TIME.
	;  IF INCREMENT NEQ CONSTANT, THE GENERAL ALGOL TEST
	    ;  SEQUENCE WILL BE GENERATED;
	;  RESULT IS A CLOSED PORTION WHOSE LEXEME IS IN SYM;

BEGIN
  IF LOP IS AN ERROR LEXEME
				JUMPGE	LOP,FALSE
  THEN;..SET ERROR LEXEME AND LEAVE;
    ERRLEX;
  ELSE;..LOP IS OK;
    IF INCREMENT IS AN ERROR LEXEME
				MOVE	T,FBSYMSAVE
				JUMPGE	T,FALSE
    THEN;..SET ERROR LEXEME AND LEAVE;
      ERRLEX;
    ELSE;..NO ERRORS YET ..... GO ON;
      BEGIN
	;..SET REV OFF;
				MOVNI	REV,SYM
	;..PUT INCREMENT LEXEME INTO A REGISTER;
				MOVE	T2,FBSYMSAVE
	IF INCREMENT IS CONSTANT
				T.CONST	(T2);
	THEN;..CONSTANT INCREMENT. NO NEED TO TEST IT ON EACH CYCLE;
	  BEGIN
	    ;..PUT VALUE OF INCREMENT IN T3;
	    IF INCREMENT = IMMEDIATE CONSTANT
				T.IMM	(T2);
	    THEN;..IMMEDIATE CONSTANT;
	      BEGIN
		IF INCREMENT<TYPE> = INTEGER
				T.I	(T2);
		THEN;..IMMEDIATE INTEGER CONSTANT;
		  ;..RH(T3) _ INCREMENT<LOCN>;
				HRRZ	T3,T2
		ELSE;..IMMEDIATE REAL CONSTANT;
		  ;..LH(T3) _ INCREMENT<LOCN>;
				HRLZ	T3,T2
		FI
	      ENDD
	    ELSE;..NON-IMMEDIATE CONSTANT;
	      BEGIN
		;T1 _ INCREMENT<LOCN> + CONSTANT TABLE BASE;
				F.LOCN	(T1,T2);
				ADD	T1,CONTAB
		IF INCREMENT<TYPE> = LONG REAL
				T.LR	(T2);
		THEN;..GET FIRST WORD OF LONG REAL CONSTANT;
				MOVE	T3,2(T1)
		ELSE;..GET REAL OR INTEGER CONSTANT;
				MOVE	T3,1(T1)
		FI
	      ENDD
	    FI
	    ;..VALUE OF CONSTANT IS NOW IN T3. TEST ITS SIGN;
EDIT(046); Do the correct thing for a zero increment
	    IF CONSTANT GEQ 0
				JUMPL	T3,FALSE	; [E046]
	    THEN;..CONSTANT >= 0. NORMAL TEST		; [E046]
				MOVE	T,ZLEQ
	    ELSE;..CONSTANT < 0. REVERSE THE TEST	; [E046]
				MOVE	T,ZGTE
	    FI
				MOVEM	T,OP
	    ;..GENERATE CODE FOR THE RELATION. IF THE INCREMENT
	    ;..   IS GREATER THAN 0, THE TEST WILL BE:
	    ;..        IF CONT.VAR. > FINAL VAL. THEN GO TO ELM.-EXH.;
	    ;..   OTHERWISE THE TEST WILL BE
	    ;..        IF CONT.VAR. < FINAL VAL. THEN GO TO ELM.-EXH.;
	      CGBIN;
	    ;..NOW BACK UP THE STACK POINTER;
	      UNSTACK;
	    ;..NOW PUT IN THE JUMP TO "ELEMENT-EXHAUSTED";
	    REOPEN(SYM);
	    IF THE LAST GENERATED INSTRUCTION = "SETO"
				MOVE	T,INDEX
				HLLZ	T1,-1(T)
				TLZ	T1,000777
				CAME	T1,OPSETO
				GOTO	FALSE
	    THEN;..NOTHING WAS STACKED. NO NEED TO GENERATE "TRUE" OR "FALSE";
	      BEGIN
		;..REPLACE THE "TDZA" AND "SETO" BY A "JRST";
		;INDEX _ INDEX - 2;
				SUBI	T,2
				MOVEM	T,INDEX
		;PLUNK(JRST,0,0);
				MOVE	T,OPJRST
				PLUNKI;
	      ENDD
	    ELSE;..CAN'T BACK UP - "UNSTACK" PUT IN AN INSTRUCTION;
	      ;..APPEND A JUMPE;
	      ;PLUNK(JUMPE,SYM,0);
				HLLZ	T,-2(T)
				TLZ	T,777000
				TDO	T,OPJMPE
				F.LOCN	(T1,SYM);
				PLUNKI;
	    FI
	  ENDD
	ELSE;..INCREMENT IS NOT CONSTANT. MUST GENERATE THE GENERAL TEST;
	  BEGIN
	    ;..TEST WILL BE
	    ;..    IF (CONTR. VAR. - FINAL VALUE)*SIGN(INCREMENT) > 0
	    ;..          THEN GO TO ELEMENT-EXHAUSTED;
	    ;..
	    ;..GENERATE CODE FOR (CONTR. VAR. - FINAL VALUE);
				MOVE	T,ZMINUS
				MOVEM	T,OP
	      CGBIN;
	    ;..LOP _ LEXEME AND LEXEX FOR (CONT. VAR. - FINAL VALUE);
				MOVE	LOP,SYM
				MOVE	T,LEXEX
				MOVEM	T,LLEXEX
				MOVE	T,LEXEX+1
				MOVEM	T,LLEXEX+1
	    ;..SYM _ LEXEME AND LEXEX FOR INCREMENT;
				MOVE	SYM,FBSYMSAVE
				MOVE	T,FBLEXSAVE
				MOVEM	T,LEXEX
				MOVE	T,FBCOMPSAVE
				MOVEM	T,LEXEX+1
	    ;..GENERATE CODE FOR MULTIPLICATION BY SIGN OF INCREMENT;
	    ;..SET OP THOROUGHLY NON-REVERSIBLE;
				MOVEI	T,0
				MOVEM	T,OP
	    SETUP
	    ;PLANT <SKIPGE SYM>
				HRLZI	T,(<SKIPGE>)
				PLUNKI(SYM)
	    IF LOP<TYPE> IS LONG.REAL;
				T.LR	(LOP)
	      THEN;..PLANT(LMOVN,LOP);
				MOVE	T,OPLNEG
	    ELSE;..PLANT(MOVN,LOP);
				MOVE	T,OPUMIN
	    FI;
				F.LOCN	(T1,LOP)
				PLUNK(LOP)
	    CLOSE(SYM);
	    COMBLEX;
	    ;..MAKE SURE THE STACK POINTER IS RESET;
	    UNSTACK;
	    ;..NOW APPEND THE TEST WHICH JUMPS TO "ELEMENT-EXHAUSTED";
	    REOPEN(SYM);
	    ;PLUNK(JUMPG,LOP,0);
				MOVE	T1,INDEX
				HLLZ	T,-1(T1)
				TLZ	T,000037
				CAMN	T,[SUB	SP,0]
				HLLZ	T,-2(T1)
				TLZ	T,777037
				TDO	T,OPJMPG
				F.LOCN	(T1,LOP);
				PLUNK;
	  ENDD
	FI
	CLOSE(SYM);
      ENDD
    FI
  FI
ENDD	; CGFTEST
	SUBTTL	CODE GENERATION ROUTINES	* CGINCR *

PROCEDURE CGINCR

	;..GENERATE EFFICIENT CODE FOR INCREMENTING A CONTROLLED VARIABLE;
	    ;  ON ENTRY, LEXEME FOR CONTROLLED VARIABLE IS IN LOP;
	    ;  LEXEME FOR INCREMENT IS IN SYM;
	    ;  NUMBER OF PREFERRED ACC IS IN PREFACC;
	;  IF INCREMENT = 1 THEN CODE IS "AOS" 
	    ;  ELSE IF INCREMENT = -1 THEN CODE IS "SOS" 
	    ;  ELSE IF INCREMENT = 0 THEN CODE IS "MOVE"
	    ;  ELSE CODE IS "ADDB";
	;  CLOSED PORTION FOR ASSIGNMENT OF INCREMENTED VALUE
	    ;  IS GENERATED AND ITS RESULT LEXEME IS PUT IN SYM;

BEGIN
  IF LOP IS AN ERROR LEXEME
				JUMPGE	LOP,FALSE
  THEN;..SET ERROR LEXEME AND LEAVE;
    ERRLEX;
  ELSE;..LOP IS OK;
    IF INCREMENT IS AN ERROR LEXEME
				JUMPGE	SYM,FALSE
    THEN;..SET ERROR LEXEME AND LEAVE;
      ERRLEX;
    ELSE;..NO ERRORS YET ..... GO ON;
      BEGIN
	;..SET REV OFF;
				MOVNI	REV,SYM
	EDIT(046); Don't generate an "ADDB" for a zero increment !
	IF SYM IS A CONSTANT WITH VALUE ZERO		; [E046]
				T.CONST	(SYM)		; [E046]
				F.LOCN	(T,SYM)		; [E046]
				TLNN	SYM,$AM-$IMM	; [E046]
				JRST	.+3		; [E046]
				ADD	T,CONTAB	; [E046]
				MOVE	T,1(T)		; [E046]
				JUMPN	T,FALSE		; [E046]
	THEN;..NO NEED TO GENERATE AN ADDB		; [E046]
				MOVE	T4,OPMOVE	; [E046]
				GOTO	LCGIN0		; [E046]
	FI;						; [E046]
	IF LOP<TYPE> = INTEGER
				T.I	(LOP);
	THEN;..LOP AND SYM ARE BOTH OF TYPE INTEGER;
	  BEGIN
	    IF VALUE OF INCREMENT = 1
				F.LOCN	(T,SYM);
				CAIN	T,1
				TLNE	SYM,$AM-$IMM
				GOTO	FALSE
	    THEN;..INCREMENT = 1. DO THE INCREMENT WITH AN "AOS";
	      ;OPN _ "AOS";
				MOVE	T4,OPAOS
	    ELSE;..INCREMENT IS NOT 1;
	      IF VALUE OF INCREMENT = -1
				TLNN	SYM,$AM-$CT
				TLNN	SYM,$CT-$IMM
				GOTO	FALSE
				F.LOCN	(T2,SYM);
				ADD	T2,CONTAB
				MOVN	T,1(T2)
				CAIE	T,1
				GOTO	FALSE
	      THEN;..INCREMENT = -1. DO THE INCREMENT WITH A "SOS";
	        ;OPN _ "SOS";
				MOVE	T4,OPSOS
	      ELSE;..INCREMENT IS NOT 1;
		;..GO TO CODE WHICH LOADS INCREMENT INTO AN ACC;
				GOTO	LCGIN1
	      FI
	    FI
	    LCGIN0:	; [E046] LABEL ADDED FOR ZERO CONSTANTS
	    IF LOP IS NOT SINGLE
				TN.SINGLE(LOP);
	    THEN;..WE ALREADY HAVE A PORTION FOR LOP;
	      REOPEN(LOP);
	    FI
	    IF PREFACC = 0
				SKIPE	0,PREFACC
				GOTO	FALSE
	    THEN;..CAN'T AOS OR SOS INTO AC0. CHANGE IT TO AC1
		; [E046] UNLESS OPCODE = MOVE, WHEN AC0 IS O.K.
				TLNE	T4,174000	; [E046]
				AOS	0,PREFACC
	    FI
	    ;EMITCODE(OPN,PREFACC,LOP);
				MOVE	T,T4
				MOVE	T1,PREFACC
				HRLI	T1,1
				EMITCODE(LOP);
	    ;LEX(SYM) _ (EXPR,SAME,SIMPLE,PREFACC);
				TLZ	SYM,$KIND!$STATUS!$AM
				TLO	SYM,$EXP!$SIM!$ACC
				HRR	SYM,PREFACC
	  ENDD
	ELSE;..LOP<TYPE> MUST BE REAL;
	  BEGIN
	    IF SYM<TYPE> = INTEGER
				T.I	(SYM);
	    THEN;..CONVERT SYM TO REAL;
	      ;CONVERT(REAL,SYM);
				MOVEI	T,$R
		CONVERT;
	    FI
		LCGIN1:
		IF SYM IS A POINTER
				T.PTR	(SYM);
		THEN;..MUST LOAD ITS VALUE;
		  ;GO TO NEXT "THEN";
				GOTO	LCGIN2
		FI
		IF SYM = SINGLE
				T.SINGLE(SYM);
		THEN;..INCREMENT IS NOT YET IN AN ACC. LOAD IT;
		  LCGIN2:
		  ;..LOAD INCREMENT INTO PREFERRED REGISTER (GIVEN BY PREFACC);
				MOVE	T2,PREFACC
		    LOAD(SYM,@T2);
		ELSE;..VALUE OF INCREMENT IS ALREADY IN AN ACC;
		  IF SYM<LOCN> = LOP<LOCN>
				F.LOCN	(T,SYM);
				F.LOCN	(T1,LOP);
				CAMN	T,T1
				TLNE	LOP,$AMAC
				GOTO	FALSE
		  THEN;..ACC CONFLICT. RELOAD INCREMENT INTO PREFERRED ACC;
				GOTO	LCGIN2
		  FI
		FI
	    IF LOP = SINGLE
				T.SINGLE(LOP);
	    THEN;..NO PORTION NEEDED FOR LOP;
	      REOPEN(SYM);
	    ELSE;..BOTH LOP AND SYM ARE PORTIONS;
	      MERGEPORTIONS;
	    FI
	    ;..GENERATE AN ADD-TO-BOTH;
				F.TRANK	(T,SYM);
				MOVE	T,OPADDB(T)
				F.LOCN	(T1,SYM);
				PLUNK	(LOP);
	    ;LEX(SYM) _ (EXPR,SAME,SIMPLE,ACC);
				TLZ	SYM,$KIND!$STATUS!$AM
				TLO	SYM,$EXP!$SIM!$ACC
	  ENDD
	FI
	CLOSE(SYM);
	COMBASSIGN;
      ENDD
    FI
  FI
ENDD	; CGINCR
	SUBTTL	CODE GENERATION ROUTINES	* CHECKARITH *

PROCEDURE CHECKARITH;

	;..FORCE BINARY OPERANDS TO HAVE MATCHING ARITHMETIC TYPES;
	    ;  ERROR FLAG (T) IS SET IF TYPES ARE NOT ARITHMETIC
	    ;  (INTEGER OR REAL OR LONG REAL);
	;  ON ENTRY, OPERAND LEXEMES ARE IN LOP AND SYM.
	;  IF TYPES OF OPERANDS ARE NOT ALIKE, CODE IS GENERATED TO
	    ;  CONVERT ONE OPERAND TO THE TYPE OF THE OTHER
	    ;  (IN THE ORDER INTEGER => REAL => LONG REAL).
	;  OPERAND PORTIONS ARE LEFT CLOSED WITH LEXEMES 
	    ;  IN LOP AND SYM.

BEGIN
  IF SYM<TYPE> IS INT OR REAL OR LONG REAL
	; AND LOP<TYPE> IS INT OR REAL OR LONG REAL;
				TLNE	SYM,$IRLR
				T.IRLR	(LOP);
  THEN;..OPERANDS HAVE TYPES WHICH CAN BE MATCHED;
    BEGIN
      IF SYM<TYPE> NEQ LOP<TYPE>
				F.TYPE	(T,SYM);
				F.TYPE	(T1,LOP);
				CAMN	T,T1
				GOTO	FALSE
      THEN;..TYPES DO NOT MATCH -- GENERATE CODE TO MATCH THEM;
        BEGIN
          IF SYM<TYPE> LSS LOP<TYPE>
				CAML	T,T1
				GOTO	FALSE
          THEN
	  ;..CONVERT SYM TO THE TYPE OF LOP;
				PUSHJ	SP,TCHECK	; [E044]
          ELSE
	  ;..CONVERT LOP TO THE TYPE OF SYM;
	  ;..MUST REVERSE LEXEMES AND LEXEXES BECAUSE CONVERT WORKS ON SYM;
				EXCH	LOP,SYM
				MOVNI	REV,SYM+LOP(REV)
				PUSHJ	SP,TCHECK	; [E044]
				EXCH	SYM,LOP
				MOVNI	REV,SYM+LOP(REV)
          FI;
	ENDD;
      FI;
      EDIT(044);Don't force constants to D.P. unnecessarily
      ; TYPES MATCH - CHECK FOR PSEUDO-LONG REAL	; [E044]
      IF TYPE = LONG REAL				; [E044]
				T.LR	(SYM)		; [E044]
      THEN;						; [E044]
	BEGIN;						; [E044]
	  IF SYM = PSEUDO-LONG REAL CONSTANT & LOP # CONSTANT
				TLNE	LOP,$CONST	; [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
				MOVE	T3,2(T2)	; [E044]
				TLZ	T4,(1B0)	; [E044]
				TOCT	(2,SYM)		; [E044]
	  ELSE;						; [E044]
	    BEGIN;					; [E044]
	      IF LOP = PSEUDO-LONG REAL CONSTANT & SYM # CONSTANT
				TLNE	SYM,$CONST	; [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;..CONVERT LOP TO A GENUINE LONG REAL CONSTANT
				MOVE	T3,2(T2)	; [E044]
				TLZ	T4,(1B0)	; [E044]
				TOCT	(2,LOP)		; [E044]
	      FI;					; [E044]
	    ENDD;					; [E044]
	  FI;						; [E044]
	ENDD;						; [E044]
      FI;						; [E044]
    ;T_FALSE	; TURN ERROR FLAG OFF
				SETZ	T,0
    ENDD;
  ELSE;..TYPES CANNOT BE MATCHED;
  ;T_TRUE	; SET ERROR FLAG ON
				SETO	T,0
  FI;
ENDD	; CHECKARITH
TCHECK:	Edit(044)  ;New routine to match type of SYM to LOP
BEGIN;							; [E044]
  IF LOP = PSEUDO-LONG CONSTANT & SYM # CONSTANT	; [E044]
				TLNN	LOP,<$TYPE-$LR>!$CONST;
				TLNN	SYM,$CONST	; [E044]
				GOTO	FALSE		; [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;  FIRST WE MUST TRUNCATE LOP TO A REAL		; [E044]
				MOVE	T3,A0		; [E044]
				MOVE	A0,2(T2)	; [E044]
				TLZ	A1,(1B0)	; [E044]
				PUSHJ	SP,CTLRR	; [E044]
				EXCH	T3,A0		; [E044]
				TLZ	LOP,$TYPE	; [E044]
				TLO	LOP,$R		; [E044]
				EXCH	LOP,SYM		; [E044]
				PUSHJ	SP,.STOCON	; [E044]
				EXCH	LOP,SYM		; [E044]
  ;  IF SYM<TYPE> # REAL, SKIP INTO THE "ELSE" CLAUSE	; [E044]
				TLNN	SYM,$TYPE-$R	; [E044]
  ELSE;  WE NEED TO CONVERT SYM TO THE TYPE OF LOP	; [E044]
				HLRZ	T,LOP		; [E044]
				ANDI	T,$TYPE		; [E044]
				PUSHJ	SP,.CONVERT	; [E044]
  FI;							; [E044]
				POPJ	SP,		; [E044]
ENDD;	TCHECK						; [E044]
	SUBTTL	CODE GENERATION ROUTINES	* COMBASSIGN *

PROCEDURE COMBASSIGN;

	;..GENERATE THE NEW LEXEX RESULTING FROM AN ASSIGNMENT;
	    ;  NEW LEXEX COMES FROM THOSE FOR SYM AND LOP.
	;  COMPUTES EXTYPE, BLOCK LEVEL, STACK ADDRESS, AND
	    ;  COMPOSITE NAME FOR THE ASSIGNMENT EXPRESSION.
	;  RESULT LEXEX IS ALWAYS THAT BELONGING TO SYM;

BEGIN
  IF LEXEX(SYM) GEQ 0
				F.BL	(T1,SYM);
				JUMPL	T1,FALSE
  THEN;..SYM HAS EXTYPE "V".  SET IT TO "P" AND SET C.N. _ 0;
    BEGIN
      ;SYM<BLOCK LEVEL> _ -1  (I.E., EXTYPE _ "P");
				HRLZI	T2,777000
				S.BL	(T2);
      ;SYM<COMPOSITE NAME> _ 0;
				SETZ	T2,0
				S.CN	(T2);
    ENDD
  FI
  ;SYM<COMPOSITE NAME> _ SYM<C. NAME> OR LOP<C. NAME>;
				F.CN	(T2,LOP);
				F.CN	(T1,SYM);
				OR	T2,T1
				S.CN	(T2);
  ;..BLOCK LEVEL _ MIN(BLOCK LEVELS); .... (SETS EXTYPE ALSO);
  IF LOP<BLOCK LEVEL> LSS SYM<BLOCK LEVEL>
				F.BL	(T3,LOP);
				F.BL	(T2,SYM);
				CAML	T3,T2
				GOTO	FALSE
  THEN
    ;SYM<BLOCK LEVEL> _ LOP<BLOCK LEVEL>;
				S.BL	(T3);
  FI
  ;..STACK ADDRESS _ SUM OF STACK ADDRESSES;
  ;T2 _ LOP<STACK ADDRESS> + SYM<STACK ADDRESS>;
				F.SA	(T2,LOP);
				F.SA	(T1,SYM);
				ADD	T2,T1
  IF STACK ADDRESS GEQ 2^9 (512)
				TLNN	T2,$LEXBL
				GOTO	FALSE
  THEN;..STACK OVERFLOW ERROR;
    FAIL(66,FRIED,SYM,STACK-ADDRESS OVERFLOW);
  ELSE;..SYM<STACK ADDRESS> _ T2;
				S.SA	(T2);
  FI
ENDD	; COMBASSIGN
	SUBTTL	CODE GENERATION ROUTINES	* COMBLEX *

PROCEDURE COMBLEX

	;..GENERATE THE NEW LEXEX RESULTING FROM A BINARY OPERATION;
	;  NEW LEXEX COMES FROM THOSE FOR SYM AND LOP.
	;  COMPUTES EXTYPE, BLOCK LEVEL, STACK ADDRESS, AND
	    ;  COMPOSITE NAME FOR THE RESULT EXPRESSION.
	;  RESULT LEXEX IS ALWAYS THAT BELONGING TO SYM;

BEGIN
  IF EXTYPE(LOP) = EXTYPE(SYM)
				F.BL	(T3,LOP);
				F.BL	(T2,SYM);
				MOVE	T,T2
				XOR	T,T3
				JUMPL	T,FALSE
  THEN;..EXTYPES MATCH  (BOTH "P" OR BOTH "V");
    ;SYM<COMPOSITE NAME> _ LOP<C. NAME> OR SYM<C. NAME>;
				F.CN	(T1,LOP);
				F.CN	(T,SYM);
				OR	T,T1
				S.CN	(T);
  ELSE;..EXTYPES DO NOT MATCH. RESULT GETS C.N. OF TYPE "P" LEXEME;
    IF LOP<LEXEX> LSS 0
				JUMPGE	T3,FALSE
    THEN;..LOP HAS EXTYPE "P". GRAB ITS C. NAME FOR THE RESULT;
      ;SYM<COMPOSITE NAME> _ LOP<C. NAME>;
				F.CN	(T,LOP);
				S.CN	(T);
    ;..ELSE SYM HAS EXTYPE "P" AND ITS C.N. IS THAT OF THE RESULT;
    FI
  FI
  ;..BLOCK LEVEL _ MIN(BLOCK LEVELS); .... (SETS EXTYPE ALSO);
  IF LOP<BLOCK LEVEL> LSS SYM<BLOCK LEVEL>
				CAML	T3,T2
				GOTO	FALSE
  THEN
    ;SYM<BLOCK LEVEL> _ LOP<BLOCK LEVEL>;
				S.BL	(T3);
  FI

  ;..STACK ADDRESS _ SUM OF STACK ADDRESSES;
  ;T2 _ LOP<STACK ADDRESS> + SYM<STACK ADDRESS>;
				F.SA	(T2,LOP);
				F.SA	(T1,SYM);
				ADD	T2,T1
  IF STACK ADDRESS GEQ 2^9 (512)
				TLNN	T2,$LEXBL
				GOTO	FALSE
  THEN;..STACK OVERFLOW ERROR;
    FAIL(66,FRIED,SYM,STACK-ADDRESS OVERFLOW);
  ELSE;..SYM<STACK ADDRESS> _ T2;
				S.SA	(T2);
  FI
ENDD	; COMBLEX
	SUBTTL	CODE GENERATION ROUTINES	* CONVERT *

PROCEDURE CONVERT

	;..GENERATES CODE TO CONVERT AN OPERAND TO A GIVEN TYPE;
	    ;  ON ENTRY, OPERAND LEXEME IS IN SYM;
	    ;  DESIRED TYPE IS IN T;
	;  IF OPERAND IS A CONSTANT, A NEW CONSTANT WILL BE GENERATED
	    ;  (AND NO CODE WILL BE PRODUCED).
	;  RESULT IS A CLOSED PORTION WHOSE LEXEME IS IN SYM;

BEGIN
OWN RESTYPE;	;..TEMP FOR THE DESIRED TYPE BITS;
  ;RESTYPE _ T;
				MOVEM	T,RESTYPE
  IF SYM = CONSTANT
				T.CONST	(SYM);
  THEN;..OPERAND IS A CONSTANT. WE CAN DO THE CONVERSION RIGHT NOW;
    BEGIN
      ;..SAVE A0 (GBREG);
				MOVE	T3,A0
      IF SYM = IMMEDIATE
				T.IMM	(SYM);
      THEN;..IMMEDIATE CONSTANT.  PUT VALUE INTO A0;
        BEGIN
	  IF SYM<TYPE> = INTEGER
				T.I	(SYM);
	  THEN
	    ;RH(A0) _ SYM<LOCN>;
				HRRZ	A0,SYM
	  ELSE;..IMMEDIATE REAL CONSTANT;
	    ;LH(A0) _ SYM<LOCN>;
				HRLZ	A0,SYM
	  FI
	ENDD
      ELSE;..NON-IMMEDIATE CONSTANT;
	BEGIN
	  ;T2 _ SYM<LOCN> + CONSTANT TABLE BASE;
				F.LOCN	(T2,SYM);
				ADD	T2,CONTAB
	  IF SYM<TYPE> = LONG REAL
				T.LR	(SYM);
	  THEN;..LONG CONSTANT;
	    ;..PUT CONSTANT INTO A0 AND A1;
	    ;.. * * * NOTE THAT A1 IS THE SAME REGISTER AS T;
				DMOVE	A0,2(T2)
				TLZ	A1,(1B0)	; [E044]
	  ELSE;..SHORT CONSTANT;
	    ;..PUT CONSTANT INTO A0;
				MOVE	A0,1(T2)
	  FI
	ENDD
      FI
      ;..EXECUTE APPROPRIATE CONVERSION ROUTINE (RESULT GOES TO A0 (AND A1));
      ;.. * * * NOTE THAT A2 (T1) MAY BE CLOBBERED HERE;
				MOVE	T2,RESTYPE
				LSH	T2,-14
				F.TRANK	(T1,SYM);
				LSH	T1,2
				OR	T2,T1
				XCT	OPCONC-1(T2)
      ;LEX(SYM) _ (SAME,RESTYPE,SAME,SAME);
				TLZ	SYM,$TYPE
				TSO	SYM,RESTYPE
      ;..WE NOW HAVE A NEW OPERAND. IT MUST BE PUT IN THE CONSTANT TABLE;
      ;..MOVE HIGH ORDER WORD OF CONSTANT TO T3 AND RESTORE A0;
				EXCH	T3,A0
      IF SYM<TYPE> = LONG REAL
				T.LR	(SYM);
      THEN;..LONG REAL CONSTANT;
	BEGIN
	  ;..MOVE LOW ORDER WORD OF CONSTANT TO T4;
				MOVE	T4,A1
				TLO	T4,(1B0)	; [E044]
	  ;..PUT IN CONSTANT TABLE (T3,T4);
	    TOCT(2,SYM);
	ENDD
      ELSE;..SHORT CONSTANT;
	STOCON;
      FI
    ENDD
  ELSE;..OPERAND IS NOT A CONSTANT;
    BEGIN
      ;..OPERAND MUST BE IN AC0 (AND 1) FOR THE CONVERSION ROUTINES;
      IF SYM IS A POINTER
				T.PTR	(SYM);
      THEN;..LOAD ITS VALUE INTO AC0;
				GOTO	LCONV1
      FI
      IF VALUE OF SYM NOT IN AC0
				TN.AC0	(SYM);
      THEN;..PUT IT IN;
	LCONV1:
	;..GENERATE CODE TO MOVE OPERAND TO AC0 (AND 1);
	  LOAD(SYM,A0);
      FI
      REOPEN(SYM);
      ;..GENERATE CALL ON CONVERSION SUBROUTINE;
      ;PLUNKI(CONVERTOP);
				MOVE	T1,RESTYPE
				LSH	T1,-14
				F.TRANK	(T,SYM);
				LSH	T,2
				OR	T,T1
				MOVE	T,OPCONV-1(T)
				PLUNKI;
      ;..BOOK A1 IN HANDLE
				HRLZI	T,2
				IORM	T,HANDLE
      ;LEX(SYM) _ (EXPR,RESTYPE,SIMPLE,AC0);
				TLZ	SYM,$KIND!$TYPE!$STATUS!$AM
				TSO	SYM,RESTYPE
				TLO	SYM,$EXP!$SIM!$ACC
				HRRI	SYM,0
      CLOSE(SYM);
    ENDD
  FI
ENDD	; CONVERT
	SUBTTL	CODE GENERATION ROUTINES	* MARRY *

PROCEDURE MARRY

	;..MAKE A SINGLE OPEN PORTION FOR TWO BINARY OPERANDS,
	    ;  REVERSING THE ORDER IF POSSIBLE;
	;  ON ENTRY, LEXEMES FOR THE OPERANDS ARE IN LOP AND SYM;
	;  UNLESS THE OPERATION = "^", MARRY WILL MAKE SURE THAT
	    ;  THE RESULT PORTION INCLUDES CODE TO LOAD 
	    ;  THE "LEFT" OPERAND INTO AN AC;

BEGIN
  IF SYM = SINGLE
				T.SINGLE(SYM);
  THEN;..SYM IS NOT A PORTION;
    BEGIN
      IF LOP NEQ SINGLE
				TN.SINGLE(LOP);
      THEN;..LOP IS A PORTION AND SYM IS NOT;
	REOPEN(LOP);
      ELSE;..BOTH LOP AND SYM ARE SINGLE;
	BEGIN
	  IF OP NEQ "^"
				TN.OPER	(ZPOW);
	  THEN;..MAKE A PORTION TO PUT A VALUE IN AN ACC;
	    BEGIN
	      IF LOP = ONE-WORD CONSTANT AND OP IS REVERSIBLE
				TLNN	LOP,$VAR1
				T.CONST	(LOP);
				TRNN	T,$ODROP
				GOTO	FALSE
	      THEN;..REVERSE THE ORDER SO VARIABLE IS LOADED FIRST;
		BEGIN
		  ;..EXCHANGE THE LEXEMES;
				EXCH	LOP,SYM
		  ;..SET REV ON;
				MOVNI	REV,LOP
		ENDD
	      FI
	      LOAD(LOP,ANYAC);
	      REOPEN(LOP);
	    ENDD
	  ;..ELSE NO PORTIONS ARE NECESSARY FOR POWERS;
	  FI
	ENDD
      FI
    ENDD
  ELSE;..SYM IS A PORTION;
    BEGIN
      REVORDER;
      IF LOP = SINGLE
				T.SINGLE(LOP);
      THEN;..AFTER REORDERING, LOP IS STILL NOT A PORTION.
		;..MAKE IT ONE AND MERGE WITH SYM;
        BEGIN
	  LOAD(LOP,ANYAC);
          MERGEPORTIONS;
        ENDD
      ELSE;..LOP IS A PORTION AFTER REORDERING;
        IF SYM = SINGLE
				T.SINGLE(SYM);
        THEN;..THERE IS ONLY ONE PORTION;
          REOPEN(LOP);
        ELSE;..TWO PORTIONS;
	  BEGIN
	    IF LOP IS A POINTER
				T.PTR	(LOP);
	    THEN;..WE MAY HAVE TO EVALUATE LOP BEFORE MERGING;
	      BEGIN
		IF REVERSAL NOT ALLOWED OR LOP IS A ONE WORD OPERAND
				JUMPN	T3,TRUE
		  ;..(T3 IS A SWITCH WHICH IS SET BY REVORDER);
				T.ONE	(LOP);
		THEN;..EVALUATE LOP NOW;
		  ;..LOAD VALUE OF LOP INTO SAME ACC USED BY POINTER;
				F.LOCN	(T2,LOP);
		    LOAD(LOP,@T2);
		FI
	      ENDD
	    FI
	    MERGEPORTIONS;
	  ENDD
        FI
      FI
    ENDD
  FI
ENDD	; MARRY
	SUBTTL	CODE GENERATION ROUTINES	* SETUP *

PROCEDURE SETUP

	;..SET UP THE OPERANDS FOR A BINARY OPERATION BY
	    ;  MAKING A SINGLE OPEN PORTION, REORDERED IF POSSIBLE,
	    ;  WITH THE VALUE OF THE (REORDERED) LEFT OPD (LOP) IN AN AC;
	;  ON ENTRY, OPERAND LEXEMES ARE IN LOP AND SYM;
	;  SETUP MAY CHANGE THE OPERATOR IF THE OPERATION
	    ;  IS REVERSIBLE, (E.G., "<" => ">", LFDV => RLFDV).

BEGIN
  ;..FIRST MAKE A SINGLE OPEN PORTION FOR THE OPERANDS;
    MARRY;
  IF REV
				T.REV;
  THEN;..PORTIONS WERE REVERSED BY MARRY;
    BEGIN
      ;..EXCHANGE THE LEXEMES AGAIN;
				EXCH	LOP,SYM
      ;..SET REV OFF;
				MOVNI	REV,SYM
    ENDD
  FI
  IF LOP NOT AN EXPRESSION IN ACC
				TN.ACC	(LOP);
  THEN;..VALUE OF LOP IS NOT NOW IN AN AC;
    BEGIN
      IF VALUE OF SYM IN AN ACC
				TLNE	SYM,$AM-$ACC
				GOTO	FALSE
      THEN;..WE MAY BE ABLE TO DO AN OPERATOR REVERSAL;
	BEGIN
	  IF OP IS NOT REVERSIBLE
				MOVE	T,OP
				TRNE	T,$ODROP
				GOTO	FALSE
	  THEN;..OP IS NOT USUALLY REVERSIBLE;
	    BEGIN
	      IF SYM<TYPE> = LONG REAL
				T.LR	(SYM);
	      THEN;..OPERANDS ARE LONG REAL;
		BEGIN
		  IF OP = SLASH
				T.OPER	(ZSLASH);
		  THEN;..WE CAN CALL A REVERSE DIVIDE SR;
				GOTO	LSETU1
		  FI
		  IF OP = "-"
				T.OPER	(ZMINUS);
		  THEN;..WE CAN CALL A REVERSE SUBTRACT SR;
				GOTO	LSETU1
		  FI
		ENDD
	      FI
	      ;..NO CHANCE OF OPERATOR REVERSAL.  LOAD VALUE OF LOP INTO AN AC;
				GOTO	LSETU2
	    ENDD
	  ELSE;..OP IS REVERSIBLE;
	    BEGIN
	      LSETU3:
	      IF OP IS NOT COMMUTATIVE
				MOVE	T,OP
				TRNE	T,$ODCOP
				GOTO	FALSE
	      THEN;..MAKE OP INTO ITS REVERSE;
		LSETU1:
		;..OP _ REVERSE(OP);
				MOVE	T,OP
				ADDI	T,2_^D8
				MOVEM	T,OP
	      ;..ELSE COMMUTATIVE OP IS ITS OWN REVERSE;
	      FI
	      ;..REVERSE THE OPERANDS BY EXCHANGING LEXEMES AND LEXEXES;
				MOVE	T,LEXEX
				EXCH	T,LEXEX+2
				MOVEM	T,LEXEX
				MOVE	T,LEXEX+1
				EXCH	T,LEXEX+3
				MOVEM	T,LEXEX+1
				EXCH	LOP,SYM
	    ENDD
	  FI
	ENDD
      ELSE;..NEITHER SYM NOR LOP HAS A LOADED VALUE;
	BEGIN
	  IF LOP = SINGLE AND SYM = POINTER AND OP IS REVERSIBLE
				T.PTR	(SYM);
				MOVE	T,OP
				TRNE	T,$ODROP
				TLNE	LOP,$SINGLE
				GOTO	FALSE
	  THEN;..WE SHOULD LOAD THE VALUE OF SYM NOW;
	    BEGIN
	      ;..LOAD VALUE OF SYM INTO SAME ACC, LEAVING PORTION OPEN;
				MOVE	T,OPMVSM
				F.LOCN	(T1,SYM);
		GLOAD;
	      ;..GO BACK TO REVERSE THE LEXEMES;
				GOTO	LSETU3
	    ENDD
	  FI
	  LSETU2:
	  ;..PUT THE VALUE OF LOP IN AN AC;
	  IF LOP IS A POINTER
				T.PTR	(LOP);
	  THEN;..USE SAME ACC FOR VALUE AS FOR POINTER;
				F.LOCN	(T1,LOP);
	  ELSE;..USE NEXT FREE ACC;
				MOVEI	T1,ANYAC
	  FI
	  IF OP = "DIV" OR "REM"
				MOVE	T,OP
				CAMN	T,ZDIV
				GOTO	TRUE
				CAME	T,ZREM
				GOTO	FALSE
	  THEN;..GIVE LOP SPECIAL TYPE SO LOAD WILL USE 2 AC'S;
				TLZ	LOP,$TYPE
				TLO	LOP,$IDI
	  FI
	  ;..LOAD THE VALUE, LEAVING THE PORTION OPEN;
				MOVE	T,OPMVLP
	    GLOAD;
	ENDD
      FI
    ENDD;
  FI
ENDD	; SETUP
	SUBTTL	CODE GENERATION ROUTINES	* STOCON *

PROCEDURE STOCON

	;..FIX UP LEXEME AND CONSTANT TABLE (IF NECESSARY)
	    ;  FOR A NEWLY GENERATED ONE WORD CONSTANT;
	;  ON ENTRY, VALUE OF CONSTANT IS IN T3;
	    ;  PARTIAL LEXEME FOR CONSTANT IS IN SYM;
	;  IF CONSTANT CAN BE IMMEDIATE, IT WILL BE STORED IN THE LEXEME;
	    ;  IF NOT IT WILL BE PUT INTO THE CONSTANT TABLE;
	;  COMPLETED LEXEME WILL BE PUT INTO SYM;

BEGIN
  IF LEFT HALF OF CONSTANT = 0 AND SYM<TYPE> NEQ REAL
				TLNN	T3,777777
				TN.R	(SYM);
  THEN;..WE HAVE A BOOLEAN OR INTEGER IMMEDIATE CONSTANT;
    ;LEX(SYM) _ (IMMED,SAME,SIMPLE,RH(T3));
				TLZ	SYM,$STATUS!$AM
				TLO	SYM,$SIM!$IMM
				HRR	SYM,T3
  ELSE;..IT MAY BE REAL IMMEDIATE;
    IF RIGHT HALF OF CONSTANT = 0 AND SYM<TYPE> = REAL
				TRNN	T3,777777
				T.R	(SYM);
    THEN;..WE HAVE A REAL IMMEDIATE CONSTANT;
      ;LEX(SYM) _ (IMMED,SAME,SIMPLE,LH(T3));
				TLZ	SYM,$STATUS!$AM
				TLO	SYM,$SIM!$IMM
				HLR	SYM,T3
    ELSE;..CONSTANT CANNOT BE IMMEDIATE;
      ;..PUT CONSTANT IN TABLE;
	TOCT(1,SYM);
    FI
  FI
ENDD	; STOCON
ENDD; END OF MODULE MFUN

LIT
END