;
;
;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 TEMPCODE SERVICE

; WRITTEN BY A. N. HABERMANN, C.M.U.
; EDITED BY R. M. DE MORGAN.

	HISEG

	SEARCH ALGPRM,ALGMAC	; SEARCH PARAMETER FILES

MODULE MSER;
$PLEVEL=1;
BEGIN
EXTERN PRASE;
EXTERN PRLIB;
EXTERN SYMHT;
EXTERN	KIOPS,OPMOVE;
EXPROC ERRLEX;
EXPROC CON1;
EXPROC CON2;
EXPROC COMBLEX;
EXPROC CONVERT;
EXPROC FAIL;
EXPROC MABS;
EXPROC MREL;
EXPROC MREL0; [E144]
EXPROC RAFIX;
EXPROC ADRFIX;
EXPROC ABSFIX;
EXPROC ADDFIX;
EXPROC TOFIX;
EXPROC EXTFIX;
EXPROC TYPE0,BHDR
SUBTTL	TEMPCODE SERVICE	* EVAL *

;EVAL TRANSFORMS A PROCEDURE IDENTIFIER USED IN A FUNCTION DESIGNATOR
;OR A FORMAL IDENTIFIER FROM AN OBJECT IN THE SYMBOL TABLE INTO A
;AN EXPRESSION IN AN ACCUMULATOR AND GENERATES THE APPROPRIATE
;INSTRUCTIONS .THE ONLY EXCEPTION IS THE FORMAL ARRAY IDENTIFIER
;SINCE ITS FORMAL LOCATIONS CONTAIN A COPY OF THE ARRAY DESCRIPTOR
;OF THE ACTUAL ARRAY IDENTIFIER,WHICH CAN NOT BE CHANGED ANYWAY.
;"SWITCH" IS CODED AS "LABEL PROCEDURE";A SWITCH IDENTIFIER CANNOT
;EVALUATE IN ITS OWN RIGHT INTO AN EXPRESSION.
;THE RESULT OF A FORMAL LABEL IS IN A2,OF EXPRESSIONS IN A0.

PROCEDURE EVAL;
BEGIN
IF  KIND =PROCEDURE
				T.PRO
THEN
  BEGIN
    IF STATUS = FORMAL BY NAME
				T.FON
    THEN
      ;T_'XCT 0,0'
				HRLZI	T,(XCT 0,0)
    ELSE
      ;T_'PUSHJ SP,0'
				HRLZI	T,(PUSHJ SP,0)
    FI;

      ;TC[IN+]_T,SYM<TAD>;..TAD IN SYM;
				PLUNKI(SYM);
      ;..BOOK ALL ACCS USED;
				HRROI	T,0
				HLLM	T,HANDLE
    IF TYPE NEQ LABEL
				TN.L
    THEN
    BEGIN
      ;TC[IN+]_'TCTYDES 0,0';
				HRLZI	T,(TCTYDES 0,0)
				PLUNKI
      ;TC[IN+]_TYPE,1;
				HLLZ	T,SYM
				TLZ	T,$AM
				ADDI	T,1
				PLUNKI
   CLOSE;

    IF  DEL NEQ PAROPEN
				CAMN	DEL,ZLPAR
				GOTO	FALSE
    THEN
	IF # OF FORMALS NEQ 0 NOR ARBITRARY
				MOVE	T3,STW1
				TLNN	T3,$AM-1
				GOTO	FALSE
	THEN
	  FAIL(61,FRIED,SYM,WRONG NUMBER OF PARAMETERS)
	FI;
    FI
       ;SYM<LHS>_'EXP,SAME,SIMPLE,ACC';
	TLZ	SYM,$KIND!$STATUS!$AM
	TLO	SYM,$EXP!$STMT!$ACC
      ;SYM<RHS>_A0
				HRRI	SYM,0
    ENDD
  ELSE
      FAIL(82,FRIED,SYM,SWITCH IDENTIFIER NOT PERMITTED HERE)
    FI
  ENDD
ELSE
  IF STATUS = FORMAL
				T.FORM
  THEN
    IF TYPE = LABEL OR SWITCH
				T.L
    THEN
      BEGIN
	  ;TC[IN+]_'XCT 0,SYM';
				HRLZI	T,(XCT 0,0)
				PLUNKI(SYM);
	CLOSE;
        ;SYM<RHS>_A2;
				HRRI	SYM,2
        ;SYM<LHS>_SIMPLE,PTR
				TLZ	SYM,$AM!$STATUS
				TLO	SYM,$PTR
      ENDD
    ELSE
          IF KIND=VAR  AND  STATUS = FORMAL BY NAME
				TLNE	SYM,$STATUS-$FOV
				T.VAR
          THEN
              IF DEL = ASSIGN
				CAME	DEL,ZASS
				GOTO	FALSE
              THEN
                BEGIN
		;TC[IN+]_'XCT 1,SYM';
				MOVSI	T,(XCT 1,0)
		PLUNKI(SYM);
		;..BOOK ALL REGS USED
				HRROI	T,0
				HLLM	T,HANDLE
		CLOSE
              ENDD
              ELSE
                BEGIN
		  ;TC[IN+]_'XCT 0,SYM';
				HRLZI	T,(XCT 0,0)
				PLUNKI(SYM);
		  ;..BOOK ALL ACCS USED;
				HRROI	T,0
				HLLM	T,HANDLE
		  ;SYM<LHS>_'EXPR,SAME,SIMPLE,ACC';
				TLZ	SYM,$KIND!$STATUS!$AM
				TLO	SYM,$EXP!$SIM!$ACC
		  ;SYM<RHS>_'A0';
				HRRI	SYM,0
		  CLOSE
                ENDD
              FI
	  FI
	FI
      FI
   FI
ENDD
SUBTTL	TEMPCODE SERVICE	* REOPEN *

;A PORTION ENDS WITH A PORTION POINTER WHICH CAN BE RECOGNIZED BY 77
;IN THE MOST SIGNIFICANT BITS.THE ADDRESS PART OF A POTION POINTER
;POINTS TO THE FIRST INSTRUCTION OF THE PORTION AND SO A PORTION IS
;IMPLEMENTED AS A CIRCULAR LIST.
;BITS 29 THROUGH 18 REPRESENT THE USED REGISTERS OF THIS PORTION.
;REOPEN PLACES THE PORTION POINTER BACK IN HANDLE AND RESETS
;INDEX TO POINT TO THE FIRST FREE LOCATION IN TEMPCODE WHERE
;THE PORTION CAN BE EXTENDED.



PROCEDURE REOPEN;
BEGIN
 ;T_ABS(T);
				ANDI  T,3
 ;T3_HANDLE(U);
				HRRZ  T3,LEXEX(T)

IF PORTION IN TEMPCODE AND PORTION POINTER
				JUMPE	T3,FALSE
				SETCM	T1,(T3)
				TLNE	T1,770000
				GOTO	FALSE
THEN
  BEGIN
    ;HANDLE_PORTION POINTER;
				SETCAM	T1,HANDLE
    ;INDEX_INDEX-1
				SOS	T1,INDEX
    IF HANDLE NOT EQL INDEX
				CAIN	T3,(T1)
				GOTO	FALSE
    THEN
      BEGIN
        ;INDEX_INDEX+1;
				AOS	T1,INDEX
	;PORTION PTR<RHS>_INDEX;
				HRRM	T1,(T3)
      ENDD
    FI
  ENDD
FI
ENDD
SUBTTL	TEMPCODE SERVICE	* CLOSE *

;WHILE A PORTION IS OPEN, THE CURRENT PORTION POINTER IS BEING BUILD
;UP IN HANDLE, AND INDEX POINTS TO THE FIRST FREE LOCATION IN TEMPCODE.
;TO CLOSE A PORTION , THE CONTENTS OF HANDLE ARE ADDED TO THE CURRENTLY
;OPEN PORTION, AND HANDLE AND INDEX ARE SET TO REPRESENT A NEW OPEN, BUT
;ENTIRELY EMPTY, PORTION.

PROCEDURE CLOSE;
  ;ASSUMES OFFSET IN T
BEGIN
  ;T_ABS(T);
				ANDI	T,3
  ;T3_INDEX;
				MOVE	T3,INDEX
  ;HANDLE(U)_INDEX;
				HRRM	T3,LEXEX(T)
  ;T2_HANDLE;
				MOVE	T2,HANDLE
  ;TC[IN+]_T2;
				MOVEM	T2,(T3)
				AOS	T3,INDEX
  IF  INDEX=TCMAX
				CAME	T3,TCMAX
				GOTO	FALSE
  THEN
    FAIL(83,FATAL,DEL,TEMPCODEOVERFLOW)
  FI;
  ;HANDLE<LHS>_0;
  ;HANDLE<RHS>_INDEX;..TO OPEN NEW PORTION;
				HRLI	T3,770000;$
				MOVEM	T3,HANDLE;$
ENDD
SUBTTL	TEMPCODE SERVICE	* EMITCODE *

;EMITCODE ADDS AN INSTRUCTION TO THE CURRENTLY OPEN PORTION. IT BOOKS
;IN HANDLE THE USED REGISTERS ACCORDING TO THE LENGTH OF THE OPERAND
;(ONE WORD FOR INTEGER,BOOLEAN AND REAL,TWO WORDS FOR STRING AND
;THREE WORDS FOR LONG REAL).
;EMITCODE TAKES CARE OF THE OPCODE MODIFICATION FOR IMMEDIATE CON-
;STANTS.
;A LONG REAL IS TREATED AS A THREE WORD OPERAND IN ORDER TO AVOID
;PROBLEMS WITH ARITHMETIC WHICH USES THREE ACCUMULATORS.HENCE, THERE
;ARE FOUR "FLOATING" ACCUMULATORS:
;	F0:	A0,A1,A2
;	F1:	A3,A4,A5
;	F3:	A6,A7,A10
;	F4:	A11,A12,A13
;THE OTHER REGISTERS ARE USED FOR SPECIAL PURPOSES (STACKPOINTER ETC).

 ;..T CONTAINS THE OPCODE LEFT ADJUSTED
 ;..T1 CONTAINS THE PAIR #,ACC ,BOTH RIGHT ADJUSTED
 ;..T2 CONTAINS TAD (TEMPADDRESS)
PROCEDURE EMITCODE;
BEGIN
IF  #=2 OR #=3
				TLNE	T1,2
				TLOE	T1,5
  ;T1_6 OR 7
				GOTO	FALSE
THEN
  ;T1_3
				HRLI	T1,3
FI;

 ;T3<LHS>_T1<LHS>;
				HLLZ	T3,T1
 ;T3^(T1);..SHIFT OVER 'ACC' BIT POSITIONS;
				ANDI	T1,SP
				LSH	T3,(T1)

 ;..BOOK USED REGS;
				IORM	T3,HANDLE

IF ADRMODE = IMMEDIATE
				TLNN	T2,36
				TLNN	T2,$IMM
				GOTO	FALSE
THEN
  IF OPCODE BEGINS WITH 1 OR 2 OR 4 OR 5
				TLNN	T,500000
				GOTO	TRUE
				TLNE	T,200000
				GOTO	FALSE
  THEN
    ;T_T+1;..IMMEDIATE MODIFICATION;
				TLO	T,1000
  ELSE
    ;IF  OPCODE = CAM THEN OPCODE_CAI;
				TLNN	T,460000
				TLZ	T,10000
  FI
FI;

XPLU:  ;T1^23;..SHIFT ACC IN ACCFIELD;
				ANDI	T1,SP
				ROT	T1,-15
 ;T_T OR T1;..COMBINE OPCODE AND ACC;
				IOR	T,T1
XIPL:  ;T2_T2<TAD>;
				TLZ	T2,777777-$AM
 ;T_T OR T2;..PLACE TEMPADDRESS;
				IOR	T,T2
 ;T1_INDEX;
 ;T[T1]_T;..PLACE INSTR. IN TEMPCODE;
				MOVE	T1,INDEX
				MOVEM	T,(T1)
 ;T1_INDEX_INDEX+1;
				AOS	T1,INDEX

IF T1=TCMAX
				CAME	T1,TCMAX
				GOTO	FALSE
THEN
    FAIL(83,FATAL,DEL, TEMPCODE OVERFLOW)
FI
ENDD



SUBTTL	TEMPCODE SERVICE	* PLUNK *	* IPLUNK *

;PLUNK IS A SIMPLIFIED VERSION OF EMITCODE. IT IS USED WHEN IT IS
;NOT NECESSARY TO BOOK THE USED ACCUMULATORS NOR TO MODIFY THE OPCODE
;FOR AN IMMEDIATE INSTRUCTION.

PROCEDURE PLUNK;
BEGIN
				GOTO	XPLU
ENDD



;IPLUNK IS USED WHEN THE INSTRUCTION IS READY IN T TO BE
;PLACED IN TEMPCODE.IF T2#0 , THE TEMPORARY ADDRESS OF THE SOURCE IS
;TAKEN FROM THERE.

PROCEDURE IPLUNK;
BEGIN
				GOTO	XIPL
ENDD
SUBTTL	TEMPCODE SERVICE	* LOAD *

;LOAD TRANSFORMS ITS INPUT OBJECT INTO A CLOSED PORTION IN TEMPCODE
;REPRESENTING AN EXPRESSION IN  AN ACCUMULATOR.IT USUALLY WILL GENERATE
;A MOVE (OR DMOVE) INSTRUCTION TO ACHIEVE THIS, BUT WHEN THE INPUT IS
;ALREADY AN EXPRESSION IN AN ACCUMULATOR IT WILL AVOID UNNECESSARY MOVE
;INSTRUCTIONS.AS A SIDE EFFECT LOAD KEEPS TRACK OF THE USE OF ACCUMU-
;LATORS.LAC POINTS TO THE LAST ALLOCATED ACCUMULATOR. ACCS ARE ALLOCATED
;TO START WITH A13 DOWN TO A1.

PROCEDURE LOAD;	;..T1 CONTAINS (KEY,ACC) PLACED BY MACRO;
BEGIN
  IF KEY = BLANK
				TLZN	T1,1
				GOTO	FALSE
  THEN
    ;REV_-ADR(SYM)
				MOVNI	REV,SYM
  FI;
  ;KA_T1;..SAVE (KEY,ACC)
				MOVEM	T1,KA
  ;T_2*(KEY+REV);
				HLRZ	T,T1
				ANDI	T,SYM
				ADD	T,REV
  ;REOPEN;
				PUSHJ	SP,.REOPEN
  ;T<LHS>_KA<LHS>;..OPCODE AND ADR(LEXEME) IN T;
				HLLZ	T,KA
  ;T1<RHS>_KA<RHS>;..ACC IN T1;
				HRRZ	T1,KA
XLOAD:  ;T2_LEXEME;
				HLRZ	T2,T
				ANDI	T2,SYM
				MOVE	T2,(T2)
  IF T2=ERROR LEXEME
				JUMPG	T2,FALSE
  THEN
    ERRLEX
  ELSE
  BEGIN
  IF TWO WORD OPERAND OR T2<TYPE>=INTDIV
				TLNN	T2,$TYPE-$IDI
				GOTO	TRUE
				T.TWO(T2)
  THEN
    ;T3_2
				MOVEI	T3,2		;T3 CONTAINS #
  ELSE
    IF ONE WORD OPERAND
				T.ONE(T2)
    THEN
      ;T3_1
				MOVEI	T3,1
    FI
  FI;

  IF LONG REAL OPERAND
				T.LR(T2)
  THEN
    ;T3_3
				MOVEI	T3,3
  FI;..T3 CONTAINS #;


IF T2<AM>=PTR OR ACC  AND  ACC=13 0R T2<RHS>
				CAIE	T1,(T2)
				CAIN	T1,15
				T.ACC(T2)
THEN
  IF  T3=1 OR T2<AM>=ACC AND T3#2
				TLNN	T2,$AM-$ACC
				CAIE	T3,2
				CAIE	T3,1
				GOTO FALSE
  THEN
    ;T1<RHS>_T2<RHS>
				HRRZ	T1,T2
  ELSE
    BEGIN
      IF T2<RHS>=LAC
				MOVE	T4,LAC
				CAIE	T4,(T2)
				GOTO FALSE
      THEN
	;IF #=3 THEN LAC+3 ELSE LAC+1;
				CAIE	T3,3
				AOSA	LAC
				ADDM	T3,LAC
      FI;
      IF ACC GEQ 2
				TRNN	T1,16
				GOTO FALSE
      THEN
	;T1<RHS>_13
				HRRZI	T1,15
      ELSE
	;T1<RHS>_0
				HRRZI	T1,0
      FI
    ENDD
  FI
FI;
  IF  ACC=13
				CAIE	T1,15		;T1 CONTAINS ACC
				GOTO	FALSE
  THEN
    BEGIN
    ;T1_(IF #GEQ LAC THEN 12 ELSE LAC)-#;
				MOVE	T1,LAC
				CAML	T3,LAC		;LAST ALLOC.ACC
				MOVEI	T1,14
				SUB	T1,T3

    IF #=3
				CAIE	T3,3
				GOTO	FALSE
    THEN
      BEGIN
	;T4<RHS>_T1<RHS>
				HRRZ	T4,T1
	WHILE T4GEQ 3
				CAIGE	T4,3
				GOTO	FALSE
	DO
	  ;T4_T4-3
				SUBI	T4,3
	OD;
	;T1_T1-T4
				SUB	T1,T4
      ENDD
    FI;
    ;LAC_T1
				MOVEM	T1,LAC
    ENDD
  FI;

 ;T1<LHS>_#;
				HRL	T1,T3
 ;T4<RHS>_ADR(LEXEME);
				HLRZ	T4,T
				ANDI	T4,SYM
  ;T<ADR(LEXME)>_0;
				TLZ	T,SYM
  ;LEXEME<RHS>_RESULTACC;
				HRRZM T1,(T4)
 ;T4<TYPE>_T2<TYPE>;
				HLL	T4,T2
 ;T4<LHS>_EPR,SAME,SIMPLE,ACC;
				TLZ	T4,$KIND!$STATUS!$AM
				TLO	T4,$EXP!$SIM!$ACC
  ;LEXEME<LHS>_T4<LHS>;
				HLLM	T4,(T4)
IF T2<TYPE>=REAL AND T2<AM>=IMM
				TLNN	T2,$TYPE+$AM-$R-$IMM
				TLNN	T2,10000
				GOTO	FALSE
THEN
  BEGIN
    IF OPCODE = MOVM AND CONSTANT IS NEGATIVE
				HLRZ	T4,T
				ANDI	T4,777000
				CAIN	T4,(MOVM 0,0)
				TRNN	T2,400000
				GOTO	FALSE
    THEN
    ; TAKE MAGNITUDE & CONVERT CONSTANT
				MOVNI	T4,(T2)
				HRRI	T2,(T4)
    FI
  ;OPCODE_HRLZI'
				TLZ	T,$KIND!$TYPE
				TLO	T,(HRLZI 0,0)
  ENDD
ELSE
IF # GTR 1   AND T2<TYPE> NEQ INTDIV
				TLNE	T2,$TYPE-$IDI
				CAIG	T3,1
				GOTO	FALSE
THEN
  ;DOUBLE THE OPCODE
				TLO	T,700000
ELSE
  IF T2=ONEWORD CONST IN CT WITH LEFTHANDSIDE=-1 AND OPCODE=MOVE
				TLNN	T2,$VAR!$CONST
				TLNN	T2,$CT-$IMM
				GOTO	FALSE
				HLRZ	T4,T
				ANDI	T4,777000
				CAIE	T4,(MOVE 0,0)
				GOTO	FALSE
				HRRZ	T4,T2
				ADD	T4,CONTAB
				SETCM	T4,1(T4)
				TLNE	T4,777777
				GOTO	FALSE
  THEN
    BEGIN
      ;T2<AM>_IMM;
				TLZ	T2,$CT-$IMM
      ;T2<RHS>_CONSTANT<RHS>;
				SETCA	T4,T4
				HRR	T2,T4
      ;OPCODE_'HRROI';
				TLZ	T,777000
				TLO	T,(HRROI 0,0)
    ENDD
  FI
FI
FI;

IF T2<AM> NEQ ACC  OR  T2<RHS> NEQ T1<RHS>
				HRRZ	T3,T2
				XORI	T3,(T1)
				TLNN	T2,$AM-$ACC
				JUMPE	T3,FALSE
THEN
 ;EMITCODE
				PUSHJ	SP,.EMITCODE
FI;

IF NOT GLOAD
				HRRO	T,KA
				AOJE	T,FALSE
THEN
  BEGIN
  ;T_2*(KEY+REV);
				HLRZ	T,KA
				ANDI	T,SYM
				ADD	T,REV
  ;CLOSE
				PUSHJ	SP,.CLOSE
  ENDD
FI
ENDD
FI;
ZERO(KA)
ENDD




;GLOAD IS A KLUDGE TO PLEASE FILE ALGCOD

PROCEDURE GLOAD;
BEGIN
  ;KA_T<LHS>,777777;..TO INDICATE GLOAD;
				HLLOM	T,KA
  GOTO XLOAD
ENDD

SUBTTL	TEMPCODE SERVICE	* TOCT1/2 *




;TOCT1 AND 2 TRANSFORM AN IMMEDIATE CONSTANT INTO A CONSTANT TABLE
;CONSTANT.

;..TOCT1 ASSUMES ONE WORD CONSTANT IN T3
;..TOCT2 ASSUMES TWO WORD CONSTANT IN (T3;T4)
;..RESULT 23-BIT TAD IN T2;REGISTERS T;T1;T5 ARE NOT AFFECTED
PROCEDURE TOCT1;
BEGIN
  ;SAVE(T,T5);
				PUSH	SP,T
				PUSH	SP,T5
  CON1;(T3);
  ;T2<AM>_$CT;
				HRRZI	T2,(T2)
				TLO	T2,$CT
  ;RESTORE(T,T5);..CONS1 DOES NOT AFFECT T1;
				POP	SP,T5
				POP	SP,T
ENDD




PROCEDURE TOCT2;
BEGIN
  ;SAVE(T,T5);
				PUSH	SP,T
				PUSH	SP,T5
  CON2;(T3,T4);
  ;T2<AM>_$CT;
				HRRZI	T2,(T2)
				TLO	T2,$CT
  ;RESTORE(T5,T);..T1 IS UNAFFECTED BY CONS2;
				POP	SP,T5
				POP	SP,T
ENDD

SUBTTL	TEMPCODE SERVICE	* UNSTACK *

;THE PURPOSE OF UNSTACK IS TO AVOID A SEQUENCE OF POP INSTRUCTIONS
;CORRESPONDING TO  PUSH INSTRUCTIONS GENERATED  TO SAVE INTERMEDIATE
;RESULTS.INSTEAD, THE STACK OPERANDS ARE USED AS STORAGE OPERANDS
;INDEXED BY  THE STACK POINTER AND WHEN NECESSARY THE STACK POINTER IS
;UPDATED WITH A SUB INSTRUCTION WHICH IS GENERATED BY UNSTACK.

PROCEDURE UNSTACK;
BEGIN
  ;T3<SA>_LEXEX<SA>;
				HLRZ	T3,LEXEX
				TRZ	T3,777000
  IF SOMETHING SAVED IN STACK
				JUMPL	SYM,FALSE
				JUMPE	T3,FALSE
  THEN
    BEGIN
      REOPEN;
      ;T3<SA>_LEXEX<SA>;
				HLRZ	T3,LEXEX
				TRZ	T3,777000
      ;LEXEX<SA>_0;
				HRLOI	T2,777000
				ANDM	T2,LEXEX
      ;T3<LHS_T3<RHS>
				HRL	T3,T3
      TOCT(1);
      ;TC[IN+]_'SUB  SP,T2';
				HRLZI	T,(SUB  SP,0)
				PUSHJ	SP,.IPLUNK
      CLOSE
    ENDD
  FI
ENDD
SUBTTL	TEMPCODE SERVICE	* FETCH *

;FETCH IS A VARIATION ON LOAD. IT IS USED TO LOAD AN OPERAND OF A
;BINARY OPERATION OF WHICH THE OTHER OPERAND IS PRESENT IN THE FORM OF
; A SUB EXPRESSION IN TEMPCODE.OTHER THAN LOAD, FETCH WILL FOR INSTANCE
;PUSH THE OPERAND IF IT FINDS THAT THE OTHER OPERAND USES ALL REGS.
;IT ALSO TRIES TO OPTIMIZE THE USE OF ACCUMULATORS  BY LOOKING AT
;ACCUMULATOR CONFLICTS IN THE OPERANDS.

PROCEDURE FETCH;
BEGIN
  REOPEN(LOP);
  IF ONE WORD OPERAND  AND LOP<TYPE> NEQ INTDIV
				TLNE	LOP,$TYPE-$IDI
				T.ONE(LOP)
  THEN
    ;T3_1
				MOVEI	T3,1
  ELSE
    IF LONG REAL
				T.LR(LOP)
    THEN
      ;T3_3
				MOVEI	T3,3
    ELSE
      ;T3_2
				MOVEI	T3,2
    FI
  FI;..T3 CONTAINS NOW #;

  ;T1_(IF  # GEQ LAC THEN 12 ELSE LAC)-#;..T1<RHS> CONTAINS NOW ACC;
				MOVE	T1,LAC
				CAML	T3,LAC
				MOVEI	T1,14
				SUB	T1,T3

IF #=3 
				CAIE	T3,3
				GOTO	FALSE
THEN
  BEGIN
    ;T4<RHS>_T1<RHS>;
				HRRZ	T4,T1
    WHILE T4 GEQ 3
				CAIGE	T4,3
				GOTO	FALSE
    DO
      ;T4_T4-3
				SUBI	T4,3
    OD;
    ;T1_T1-T4
				SUB	T1,T4
  ENDD
FI
  ;T1<LHS>_#;
				HRL	T1,T3

  IF #=2 OR #=3
				TRNE	T3,2
    ;T3_6 OR 7
				TROE	T3,5
				GOTO	FALSE
  THEN
    ;CHANGE 2 INTO 3
				HRRI	T3,3
  FI;..T3 CONTAINS NOW PATTERN;

  ;T3_IF LOP<TYPE>=INTDIV THEN 1 ELSE T3;
				TLNN	LOP,$TYPE-$IDI
				MOVEI	T3,1

  ;T3^(T1);..SHIFT PATTERN OVER 'ACC' BIT POSITIONS;
				LSH	T3,(T1)
  ;T4<RHS>_HANDLE(SYM);
				HRRZ	T4,LEXEX+SYM(REV)
  ;T4<RHS>_TC[HANDLE(SYM)]<LHS>;..USEDACCS(SYM);
				HLRZ	T4,(T4)
				MOVE	T2,LOP
  ;LOP<LHS>_LOP<TYPE>;
				TLZ	LOP,$KIND!$STATUS!$AM	;CLEAR

  ;..BOOK USED REGISTERS;			;
				HRLZ	T3,T3;$	;
				IORM	T3,HANDLE;$
  ;LAC_T1<RHS>;..LAC _ ACC;
				HRRM	T1,LAC;$;
  IF NO ACC CONFLICT
				TLNE	T3,(T4) ;
				GOTO	FALSE
  THEN
    BEGIN
      ;LOP<RHS>_T1<RHS>;..PUT RESULT ACC IN RESULT LEXEME;
				HRR	LOP,T1
      ;T_'MOVE ACC,0';
				LSH	T1,5
				HRLZI	T,<MOVE 0,0>_-22(T1)
            IF # GTR 1  AND LOP<TYPE> NEQ INTDIV
				TLNE	LOP,$TYPE-$IDI
				TLNN	T1,100
				GOTO	FALSE
            THEN
  	;DOUBLE THE OPCODE
				TLO	T,700000
            FI;
      ;LOP<LHS>_EXP,SAME,SIMPLE,ACC
				TLO	LOP,$EXP!$SIM!$ACC
    ENDD
  ELSE
    BEGIN
      ;LOP<LHS>_EXP,SAME,SIMPLE,SP;
				TLO	LOP,$EXP!$SIM!$SP
      ;T3_SA(SYM);
				HLRZ	T3,LEXEX+SYM(REV)
				TRZ	T3,777000
      ;T3_T3-(# LEQ 1 OR LOP<TYPE>=INTDIV);
				TLNE	LOP,$TYPE-$IDI
				TLNN	T1,2
				SUBI	T3,1

      ;LOP<RHS>_2^18-(T3+1);..OFFSET FROM STACKTOP IS RESULT ADDRESS;
				MOVNI	T3,(T3)
				ADDI	T3,777777
				HRR	LOP,T3
      ;T3<RHS>_SA(LOP);
				MOVNI	T,LOP(REV)
				HLRZ	T3,LEXEX(T)
EDIT(024); IF TYPE IS INTDIV, ONLY ALLOCATE ONE WORD !
      ;T3_T3+1+(# GEQ 2 AND LOP<TYPE> NEQ INTDIV); [E024]
				TLNE	LOP,$TYPE-$IDI	; [E024]
				TLNN	T1,2
				AOJA	T3,.+2
				ADDI	T3,2
      ;SA(LOP)_T3;
				HRLM	T3,LEXEX(T)
      ;T_'PUSH SP,0';
				HRLZI	T,(PUSH SP,0)

	IF # GTR 1 AND LOP<TYPE> NEQ INTDIV
				TLNE	LOP,$TYPE-$IDI
				TLNN	T1,2
				GOTO	FALSE
      THEN
        ;DOUBLE OPCODE
				TLO	T,700000
				TLZ	T,060000
      FI;

    ENDD
  FI;
  IF LAST INSTR OF LOP PORTION=MOVE OR DMOVE
				MOVNI	T1,LOP(REV)
				HRRZ	T1,LEXEX(T1)
				HLRZ	T4,-1(T1)
				TRNE	T4,577000
				SUBI	T4,500000
				TRNE	T4,577000
				GOTO	FALSE
  THEN
    ;LAST INSTR<OPCODE,ACC>_T<LHS>
				ANDI	T4,$AM
				TLO	T,(T4)
				HLLM	T,-1(T1)
  ELSE
    ;PLUNKI(LOP)
				PUSHJ	SP,.IPLUNK
  FI;
  CLOSE(LOP)
ENDD
SUBTTL	TEMPCODE SERVICE	* MERGEPORTIONS *

;MERGE PORTIONS GETS AS INPUT TWO PORTIONS IN TEMPCODE AND CONCATENATES
; THOSE INTO ONE AS IS DONE WITH TWO CIRCULAR LISTS.
;WHICH OF THE PORTIONS IS HEAD AND WHICH IS TAIL DEPENDS ON THE RESULT
;OF REVORDER WHICH RESULT IS REFLECTED IN THE VALUE OF REV.
;REV=SYM MEANS ORDER NOT REVERSED,REV=LOP MEANS ORDER REVERSED.
;IF THE RESULT REG OF THE HEAD IS USED IN THE TAIL, AN APPROPRIATE
;SAVE INSTRUCTION IS INSERTED.THE RESULT OF MERGEPORTIONS IS ONE OPEN
;PORTION WHICH CAN BE EXTENDED WITH THE BINARY OPERATION.
;THE MEMOS EXPLAIN THIS IN MORE DETAIL.

PROCEDURE MERGEPORTIONS;		;..DEPENDS ON THE VALUE OF REV;
  BEGIN
   IF ERROR LEXEME
				SKIPL	SYM
				JUMPG	LOP,FALSE
   THEN
     ERRLEX
   ELSE
    BEGIN
    IF  ONE WORD OPERAND OR POINTER
				TLNN	LOP,20000
				GOTO TRUE
				T.PTR(LOP)
    THEN
      ;T3_1;..PATTERN OF USED ACCS(LOP);
				HRLZI T3,1
    ELSE
      IF  LONGREAL OPERAND
				T.LR(LOP)
      THEN
	;T3_7;..3ACCS USED(LOP);
				HRLZI T3,7
      ELSE 
	;T3_3;..2 ACCS USED(LOP);
				HRLZI T3,3
      FI
    FI;
    IF  ADMODE(LOP)=ACC OR PTR
				T.ACC(LOP)
    THEN
      BEGIN
	;T3^(LOP);..SHIFT OVER 'ACC' BIT POSITIONS;
				LSH  T3,(LOP)
				TLZ  T3,770000
	;T1_HANDLE(SYM);
				HRRZ	T1,LEXEX+SYM(REV)
	IF ACC CONFLICT
				AND	T3,(T1)
				JUMPE	T3,FALSE
	THEN
	  BEGIN
	    IF ADMODE=PTR
				T.PTR(LOP)
	    THEN
	      BEGIN
		;..SAVE LOP<KIND,TYPE,STATUS>;
				TLZ	LOP,$AM
				HLLZM	LOP,KA
		;LOP<LHS>_EXPR,INT,SIM,ACC;
				HRLI	LOP,$EXP!$I!$SIM!$DECL!$ACC
		;FETCH;..PLACES RESULT LEXEME IN LOP;
				PUSHJ	SP,.FETCH
		  ; LOP<AM>_IF ACC THEN PTR ELSE ISP;
				TLO	LOP,30
		;..RESTORE LOP<KIND,TYPE,STATUS>;
				TLZ	LOP,777777-$AM
				IOR	LOP,KA
		 ZERO(KA)
	      ENDD
	    ELSE
	      ;FETCH
				PUSHJ	SP,.FETCH
	    FI;
	  ENDD
	FI
      ENDD
    FI;
				MOVNI	T,LOP(REV)
INTERCHANGE:  ;T1_HANDLE(LOP);
				HRRZ	T1,LEXEX(T)
    ;T2_HANDLE(SYM);
				HRRZ	T2,LEXEX+SYM(REV)
    ;T3_PORTION POINTER(LOP);
				MOVE	T3,(T1)
    ;T3#PORTION POINTER(SYM);
				EXCH	T3,(T2)
    ;T3#PORTION POINTER(LOP);
				EXCH	T3,(T1)
    ;T3<LHS>_USEDACCS(LOP) OR USEDACCS(SYM);
				IOR	T3,(T1)
				HRRI	T3,0
    ;PORTION POINTER(SYM)<LHS>_T3;
				HLLM	T3,(T2)
    REOPEN(SYM)
  ENDD
FI
ENDD

SUBTTL	TEMPCODE SERVICE	* CGELSE *

;CGELSE COMBINES THE THEN AND ELSE EXPRESSIONS INTO ONE AND INSERTS
;THE NECESSRAY TYPE CONVERSIONS.IT ALSO TAKES CARE OF UNEQUAL STACK
;LENGTHS AND DIFFERENT RESULT ACCUMULATORS. FURTHERMORE IT MODIFIES
;ONE OF THE EXPRESSIONS IF NECESSARY  SUCH THAT BOTH HAVE THE SAME
;ADDRESSMODE.FOR INSTANCE   IF BE THEN A ELSE A+1   WILL RESULT
;IN AN EXPRESSION IN AN ACCUMULATOR BECAUSE OF   A+1  AND SO CGELSE
;WILL INSERT A LOAD(A) INTO THE SAME REG AS IS USED BY A+1.

PROCEDURE CGELSE;
BEGIN
IF LOP=ERRLEX OR SYM=ERRLEX
				CAIL	LOP,0
				JUMPG	SYM,FALSE
THEN
  ERRLEX
ELSE
  BEGIN
;REV_-SYM;
				MOVNI	REV,SYM
;T3_LOP<TYPE>;
				HLRZ	T3,LOP
				ANDI	T3,$TYPE
;T4_SYM<TYPE>;
				HLRZ	T4,SYM
				ANDI	T4,$TYPE

IF LOP<TYPE> NEQ SYM<TYPE>
				CAIN	T3,(T4)
				GOTO	FALSE
THEN
  BEGIN
    IF LOP<TYPE> GTR SYM<TYPE>
				CAIG	T3,(T4)
				GOTO	FALSE
    THEN
      ;REVERSE;
				MOVNI	REV,SYM+LOP(REV)
				EXCH	LOP,SYM
				EXCH	T3,T4
    FI;
    IF SYM<TYPE> OR LOP<TYPE> NOT ARITHMETIC
				TRNE	T3,$ARC
				GOTO	TRUE
				TRNN	T4,$ARC
				GOTO	FALSE
    THEN
      FAIL(65,HARD,DEL,TYPES DO NOT MATCH)	;
    FI;
    ;LOAD(LOP,A0);
				HRLZI	T1,(<MOVE 0,(LOP)>)
				PUSHJ	SP,.LOAD
    REOPEN(LOP);
    ;T_JSP AX,0($ST)';
				HRLZI	T,(<JSP AX,($ST)>)
    KILLAX;


    IF SYM<TYPE>=REAL
				TLNE	SYM,$TYPE-$R
				GOTO	FALSE
    THEN
      BEGIN
	  ;T<RHS>_PRLIB+15;
				HRRI	T,PRLIB+17
	;LOP<LHS>_'EXP,REAL,SIMPLE,ACC';
	;LOP<RHS>_0;
				HRLZI	LOP,$EXP!$R!$SIM!$DECL!$ACC
      ENDD
    ELSE
      IF SYM<TYPE>=LONGREAL
				TLNE	SYM,$TYPE-$LR
				GOTO	FALSE
      THEN
	IF LOP<TYPE>=INTEGER
				TLNE	LOP,$TYPE-$I
				GOTO	FALSE
	THEN
	  BEGIN
	    ;T<RHS>_PRLIB+18;
				HRRI	T,PRLIB+22
	    ;LOP_'EXP,LR,SIM,ACC;
				HRLZI	LOP,$EXP!$LR!$SIM!$DECL!$ACC
	  ENDD
	ELSE
	  BEGIN
	    ;T<RHS>_PRLIB+24;
				HRRI	T,PRLIB+30
	    ;LOP_'EXP,LONGREAL,SIMPLE,ACC
				HRLZI	LOP,$EXP!$LR!$SIM!$DECL!$ACC
	  ENDD
	FI
      FI
    FI;
    PLUNKI;
    CLOSE(LOP)
  ENDD
FI;
;T3_LOP<AM>;
				HLRZ	T3,LOP
				ANDI	T3,$AM
;T4_SYM<AM>;
				HLRZ	T4,SYM
				ANDI	T4,$AM

IF T3 NEQ ACC
				CAIN	T3,$ACC
				GOTO	FALSE
THEN
  BEGIN
    IF T4=ACC OR T3 LESS T4
				CAIN	T4,$ACC
				GOTO	TRUE
				CAIL	T3,(T4)
				GOTO	FALSE
    THEN
      ;REVERSE
				MOVNI	REV,SYM+LOP(REV)
				EXCH	LOP,SYM
				EXCH	T3,T4
    FI;
    IF T4 NEQ PTR
				CAIN	T4,$PTR
				GOTO	FALSE
    THEN
	LOAD(LOP,15)
     FI
  ENDD
FI;
IF LOP<AM>=SYM<AM>
				HLLZ	T3,LOP
				XOR	T3,SYM
				TLNE	T3,$AM
				GOTO	FALSE
THEN
  IF LOP<RHS> NEQ SYM<RHS>
				HRRZ	T3,LOP
				CAIN	T3,(SYM)
				GOTO	FALSE
  THEN
    BEGIN
      IF  LOP<RHS>=0
				JUMPN	T3,FALSE
      THEN
	;REVERSE
				MOVNI	REV,LOP+SYM(REV)
				EXCH	LOP,SYM
      FI;
      ;SYM<AM>_ACC;
				TLZ	SYM,$AM
				TLO	SYM,$ACC
      ;T1_LOP<RHS>;
				HRRZ	T1,LOP
      LOAD(SYM, );
      ;SYM_LOP;
				MOVE	SYM,LOP
    ENDD
  FI
ELSE
  BEGIN
    ;T1_LOP<RHS>;
				HRRZ	T1,LOP
    LOAD(SYM, );
    ;SYM_LOP;
				MOVE	SYM,LOP
  ENDD
FI;

IF REV=-LOP
				TRNE	REV,2
				GOTO	FALSE
THEN
  ;REVERSE
				MOVNI	REV,LOP+SYM(REV)
				EXCH	LOP,SYM
FI;

REOPEN(LOP);

IF LEXEX<SA> NEQ LLEXEX<SA>
				HLRZ	T3,LEXEX+2
				ANDI	T3,777
				HLRZ	T4,LEXEX
				ANDI	T4,777
				CAIN	T4,(T3)
				GOTO FALSE
THEN
  ;UNSTACK(LOP)
				HRLOI	T2,777000
				ANDM	T2,LEXEX+2
				JUMPE	T3,.+5
				HRLI	T3,(T3)
				TOCT(1)
				HRLZI	T,(SUB SP,0)
				PUSHJ	SP,.IPLUNK
FI;
;TC[IN+]_'JRST 0,0';
				HRLZI	T,(JRST 0,0)
				PLUNKI
;TC[IN+]_'TCELSE 0,0';
				HRLZI	T,(TCELSE 0,0)
				PLUNKI
;TC[IN+]_'TCOT;
				HRLZI	T,(TCOT 0,0)
				PLUNKI

CLOSE(LOP);

IF LEXEX<SA> NEQ LLEXEX<SA>
				HLRZ	T3,LEXEX+2
				ANDI	T3,777
								HRLOI	T4,777000
				ANDM	T4,LEXEX+2
HLRZ	T4,LEXEX
				ANDI	T4,777
				CAIN	T4,(T3)
				GOTO FALSE
THEN 
UNSTACK
FI;

;LOP<AM>_SP;
				TLZ	LOP,$AM
				TLO	LOP,$SP
MERGEPORTIONS;
;LOP_SYM;
				TLO	SYM,$EXP!$DECL
				MOVE	LOP,SYM
;TC[IN+]_'TCFI 0,0';
				HRLZI	T,(TCFI 0,0)
				PLUNKI
CLOSE(SYM);
COMBLEX

ENDD
FI
ENDD
SUBTTL	TEMPCODE SERVICE	* REVORDER *

;THE GENERAL RULE FOR OPTIMIZATION IS: EVALUATE THE MORE COMPLI-
;CATED EXPRESSION FIRST. BUT THAT IS NOT ALWAYS ALLOWED BECAUSE OF THE
;LEFT TO RIGHT EVALUATION RULE.REVORDER INVESTIGATES IF IT IS DESIRABLE
;TO REVERSE, AND IF SO IT CHECKS THAT IT IS ALLOWED.
;IT IS DESIRABLE TO REVERSE IF LOP REPRESENTS A VARIABLE OR CONSTANT
;AND SYM A V-EXPR(I.E. AN EXPR WITHOUT ANY PROCIDENTIFIERS OR FORMALS)
;OR IF LOP IS A  VARIABLE OR V-EXPR AND SYM IS A P-EXPR (I.E. AN EXPR
;WHICH CONTAINS A PROC IDENTIFIER OR FORMAL.
;THE ROUTINE IS BASED ON SOME CAREFULLY ANALYZED DESIGN, WHICH IS 
;DESCRIBED COMPLETELY IN THE MEMOS

PROCEDURE REVORDER;
BEGIN
;T3_0;..T3 INDICATES WHETHER OR NOT REVERSE WAS ALLOWED;
				SETZ	T3,
IF SYM=ERRORLEX. OR LOP=ERRORLEX.
				CAIL	LOP,0
				JUMPG	SYM,FALSE
THEN
  ERRLEX
ELSE
  IF LOP<KIND>=ARRAY AND SYM<AM> NEQ SINGLE
				T.ARR(LOP)
				TN.SINGLE(SYM)
  THEN
    ;REVERSE ORDER
				MOVNI	REV,SYM+LOP(REV)
				EXCH	LOP,SYM
 ELSE
IF LOP<LEX>GEQ 0 AND SYM<AM> NEQ SINGLE
				MOVEI	T,LOP(REV)
				ANDI	T,2
				SKIPL	T1,LEXEX(T)
				T.COGE(SYM)
THEN
  IF SYM<LEXEX> GEQ 0 OR LOP<AM>=CONST
				TLNN	LOP,$AM-$CT
				GOTO	TRUE
				SKIPGE	T2,LEXEX+SYM(REV)
				GOTO	FALSE
THEN
    IF LOP<AM> = SINGLE
				T.SINGLE(LOP)
    THEN
      ;REVERSEORDER
				MOVNI	REV,SYM+LOP(REV)
				EXCH	LOP,SYM
    ELSE
      BEGIN
        IF LOP<AM>=ACC  AND  LOP<TYPE>TWO WORD OPERAND
				HLRZ	T,LOP
				ANDI	T,$AM
				CAIN	T,$ACC
				T.TWO(LOP)
        THEN
          ;T_3
				MOVEI	T,3
        ELSE
          ;T_1
				MOVEI	T,1
        FI;

        ;T^LOP<ACC>;..SHIFT OVER 'ACC' BIT POSITIONS;
				LSH	T,(LOP)
          IF LOP<ACC> AND SYM<USED ACCS> NEQ 0  OR  OP=ASSIGN
				MOVE	T2,(T2)			;..GET SYM<PORTION PTR>
				TLNE	T2,(T)
				GOTO TRUE
				MOVE	T,OP
				CAME	T,ZASS
				GOTO	FALSE
          THEN
            ;REVERSEORDER;
				MOVNI	REV,SYM+LOP(REV)
				EXCH	LOP,SYM
          FI
      ENDD
   FI
  ELSE
    IF LOP<BL>+SYM<BL> GEQ 0 AND (LOP<COMPNAME>AND SYM<COMPNAME>)=0
				TLZ	T1,777
				ADD	T1,T2
				JUMPL	T1,FALSE
				MOVE	T2,COMPNAME(T)
				XORI	T,2
				AND	T2,COMPNAME(T)
				JUMPN	T2,FALSE
    THEN
      ;REVERSEORDER
				MOVNI	REV,SYM+LOP(REV)
				EXCH	LOP,SYM
    ELSE
      ;T3_1;..INDICATE REVERSE WAS NOT ALLOWED;
				MOVEI	T3,1
    FI
  FI
 ELSE
    ;T3_SYM<LEXEX> LESS ZERO;
				SKIPGE	LEXEX+SYM(REV)
				MOVEI	T3,1
FI
FI
FI
ENDD
SUBTTL	TEMPCODE SERVICE	* CGINT *

;CGINT HANDLES THE INTEGRATION OF SUBSCRIPT EXPRESSIONS
PROCEDURE CGINT;	;..LEXEME IS IN SYM;
BEGIN
;REV_SYM;
				MOVEI	REV,SYM
IF SYM<TYPE> NEQ INTEGER
				TLNN	SYM,$TYPE-$I
				GOTO	FALSE
THEN
  BEGIN
    ;T_'INTEGER';
				HRRZI	T,$I
    CONVERT
  ENDD
FI
ENDD;
SUBTTL	OBCODE SERVICE	* MOB *



;MOB (MOVE TO OBCODE) TRANSFERS A PORTION TO THE OUTPUT BUFFER
;BY CALLING MPS (MOVE PSEUDO).SUCH A PORTION IS USUALLY THE RESULTING
;INSTRUCTION SEQUENCE OF A COMPLETE STATEMENT.
PROCEDURE MOB;
BEGIN
 REGISTER TX;
 OWN TCSTART,TCMIN,TOLINK;
FORMAL ISTHUNK;

IF NOT ERROR FOUND
				TNGB(ERRF)
THEN
BEGIN
IF THIS IS FIRST EXPR. PORTION SINCE THUNKS WERE PUT OUT
				HRRZ	T,ISTHUNK
				JUMPN	T,FALSE
				SKIPN	T,THUNK
				GOTO	FALSE
THEN
  BEGIN
    ;RESTORE NON LOCAL REGISTER AX TO WHAT IT WAS BEFORE JRST;
    ;CAX_THUNK<LHS>;
				HLRZM	T,CAX
    ;..FIX UP THE JRST OVER THE THUNKS;
    FIXREL;

    ZERO(THUNK);
  ENDD
FI;

 ;TCSTART_TX_SYM<HANDLE>;
				HRRZ	TX,LEXEX;$
				MOVEM	TX,TCSTART;$
 ;TCMIN_TC[TX]<RHS>;
				HRRZ	T,(TX);$
				MOVEM	T,TCMIN;$
 ;..LOOP IS ENTERED WITH TX POINTING TO THE PORTION POINTER;
 LOOP
  BEGIN
    ;..SET TX TO POINT TO TOP OF NEXT PORTION;
    ;INDEX_TX_TC[TX]<RHS>;
				HRRZ	TX,(TX);$
				HRRZM	TX,INDEX
    IF TX LSS TCMIN
				CAML	TX,TCMIN;$
				GOTO	FALSE;$
      THEN
	 ;TCMIN_TX;
				MOVEM	TX,TCMIN;$
    FI;
    ;..WHILE IS ENTERED POINTING AT THE TOP OF A PORTION AND WILL
    ;..PROCESS ONE ENTIRE PORTION;
    WHILE PORTION POINTER NE (T_TC[TX])
				MOVE	T,(TX);$
				SETCM	T1,T;$
				TLNN	T1,770000;$
				GOTO	FALSE;$
       DO
	 BEGIN
	   MPS;
	   ;TX_INDEX_TX+1;
				AOS	TX,INDEX;$
	 ENDD
       OD;
   ENDD;
 AS TCSTART NE TX
				CAME	TX,TCSTART;$
				GOTO	TRUE;$
 SA;
 ;INDEX_TCMIN;
 ;HANDLE_770000,TCMIN;
				MOVE	T,TCMIN;$
				MOVEM	T,INDEX;$
				HRLI	T,770000;$
				MOVEM	T,HANDLE;$
ENDD
FI;
 LACINIT
ENDD
SUBTTL	OBCODE SERVICE	* MPS *

;MPS HANDLES AN INSTRUCTION IN TWO STEPS.
;STEP 1: IF THE OPCODE IS A PSEUDO OPCODE, IT IS DECODE BY CALLING
;THE APPROPRIATE ROUTINE (FOR INSTANCE QDMOVE FOR A DOUBLE MOVE)
;STEP2: DEPENDING ON  ADDRESS MODE $AM,MPS CALLS A ROUTINE TO DECODE THE
;SYMBOLIC ADDRESS PART.
;THE TABLES FOLLOWING MPS REFLECT THE VARIOUS ADDRESS MODES AND
;PSEUDO OPCODES
PROCEDURE MPS;..INSTRUCTION IS IN T;
BEGIN
  IF  PSEUDOOPCODE
				SETCM	T1,T
				TLNE	T1,700000
				GOTO	FALSE
  THEN
	BEGIN
	; T1<RHS>_T<OPCODE>;
				HLRZ	T1,T
				LSH	T1,-11
				TRZ	T1,700
				CAIL	T1,22
	GOTO	@PSTABLE(T1)
				MOVE	T1,KIOPS(T1)
				DPB	T,[
				POINT	27,T1,35]
				MOVE	T,T1
				SETCM	T1,T
				TLNE	T1,700000
				GOTO	.+5
				HLRZ	T1,T
				LSH	T1,-11
				TRZ	T1,700
				GOTO	@PSTABLE(T1)
    ENDD
  FI;

.MTAD:    ;T4_0;..NO OFFSET;
				SETZ	T4,

.MOFF:      ;T4_T4+KA;
				ADD	T4,KA
   ; T1<RHS>_T<AM>;
				HLRZ	T1,T
				ANDI	T1,$AM
  ;..CLEAR INDIRECT BIT AND INDEX FIELD OF T;
				TLZ	T,$AM
  ; IF T<AM>=FIX OR IMM OR CT DO AMCT;
				CAIG	T1,$CT
				GOTO	.AMCT
  ; IF ADMODE GEQ 16 THEN COMPLEMENT;..THIS IS A PREPARATION FOR THE JUMPTABLE;
				CAIL	T1,20
				TRC	T1,$AM
  GOTO @AMSEL(T1)
ENDD
; AM HAS BEEN CLEARED;T4=OFFSET;
AMSEL:	XWD 0,.AMAX
	XWD 0,.AMRA
	XWD 0,.MREL
	XWD 0,.AMPTR
	XWD 0,.AMNEXT
	XWD 0,.AMISP
	XWD 0,.AMPVAL
	XWD 0,.AMST
	XWD 0,.AMSELF
	XWD 0,.AMPRV
	XWD 0,.AMOF2
	XWD 0,.AMOF3
	XWD 0,.AMACC
	XWD 0,.AMSP

PSTABLE:XWD 0,.QDMOVE	;700
	XWD 0,.QDPUSH	;701
	XWD 0,.QDMOVEM	;702
	XWD 0,.QTCTHEN	;703
	XWD 0,.QTCELSE	;704
	XWD 0,.QTCFI	;705
	XWD 0,0	;706
	XWD 0,0	;707
	XWD 0,.DMVN	;710
	XWD 0,.QTCTYDES ;711
	XWD 0,.DMVNM	;712
	XWD 0,.QTCSF	;713
	XWD 0,.QDMOVE	;714
	XWD 0,0       	;715
	XWD 0,.QLF	;716
	XWD 0,.QLF	;717
	XWD 0,.QLF	;720
	XWD 0,.QLF	;721
	XWD 0,.QLF	;722
	XWD 0,.QLF	;723
	XWD 0,.POWCONV	;724
	XWD 0,.POWCONV	;725
	XWD 0,.POWCONV	;726
	XWD 0,.POWCONV	;727
	XWD 0,.POWCONV	;730
	XWD 0,.POWCONV	;731
	XWD 0,.POWCONV	;732
	XWD 0,.POWCONV	;733
	XWD 0,.POWCONV	;734
	XWD 0,.POWCONV	;735
	XWD 0,.POWCONV	;736
	XWD 0,.POWCONV	;737
        XWD 0,.QTCAD    ;740
SUBTTL	OBCODE SERVICE	* QDPUSH *



;TO PUSH A DOUBLE WORD OPERAND. A LONG REAL IS HERE TREATED AS A
;TWO WORD OPERAND.SPECIAL CARE MUST BE TAKEN FOR THE CASE OF A
;POINTER IN A0 SINCE THIS REGISTER CANNOT BE USED AS AN INDEX REG.

PROCEDURE QDPUSH;
BEGIN
  OWN INSTR;
    ; T<OPCODE>_PUSH;
				TLZ	T,777000
				TLO	T,(PUSH	0,0)
    ; INSTR_T;
				MOVEM	T,INSTR
    ; MTAD;
				PUSHJ	SP,.MTAD
    ;
    Edit(154); Don't increase offset if source already in the stack.
    ;
    ; T4_1 ... OFFSET_1					;[E154]
				MOVEI	T4,1		;[E154]
    IF T<AM>=PTR AND T<RHS>=0				;[E154]
				HLRZ	T1,T		;[E154]
				ANDI	T1,$AM		;[E154]
				CAIN	T1,$PTR		;[E154]
				TRNE	T,777777	;[E154]
				GOTO	FALSE		;[E154]
    THEN						;[E154]
      BEGIN						;[E154]
	;T_ADDI A0,1;					;[E154]
				HRLZI	T,(ADDI 0,0)	;[E154]
				ADDI	T,1		;[E154]
	MABS						;[E154]
	;T4_0..NO OFFSET				;[E154]
				MOVEI	T4,0		;[E154]
      ENDD						;[E154]
    ELSE						;[E154]
     ;IF T<AM>=SP 					;[E154]
				CAIN	T1,SP		;[E154]
     ;THEN T4_0..NO OFFSET				;[E154]
				MOVEI	T4,0		;[E154]
    FI							;[E154]

    ;T_INSTR;
				MOVE	T,INSTR
    ;MOFF
				PUSHJ	SP,.MOFF

ENDD
SUBTTL	OBCODE SERVICE	* QDMOVE *

;DOUBLE MOVE MUST ALSO HANDLE A POINTER IN A0 IN A SPECIAL WAY
;BECAUSE A0 CANNOT BE USED AS INDEX REG.
;IF THE ADDRESS MODE IS SELF , THE NEXT REG MUST BE LOADED BEFORE
;THE REG ITSELF IN ORDER NOT TO OVERWRITE THE POINTER.

PROCEDURE QDMOVE;
BEGIN
  OWN INSTR;
  IF T<AM> NEQ ACC OR T<ACC> NEQ T<RHS>
				HLRZ	T1,T
				ANDI	T1,777-$AM
				LSH	T1,-5
				SUBI	T1,(T)
				TLNN	T,$AM-$ACC
				JUMPE	T1,FALSE
  THEN
    BEGIN
      ; T<OPCODE>_'MOVE';
				TLZ	T,500000
    IF T<AM>=PTR AND T<ACC>=T<RHS>
				HRLZI	T3,(T)
				LSH	T3,5
				XOR	T3,T
				HLRZ	T1,T
				ANDI	T1,$AM
				CAIN	T1,$PTR
				TLNE	T3,777-$AM
    				GOTO	FALSE
    THEN
      BEGIN
	;T<RHS>_0;
				HLLZ	T,T
	;T<AM>_SELF;
				MOVEI	T1,$SELF
				TLZ	T,$AM
				TLO	T,(T1)
      ENDD
    FI;

 ;   INSTR_T;..SAVE INSTRUCTION;
				MOVEM	T,INSTR

    IF T<AM> = SELF AND T<ACC> = 0
				CAIN	T1,$SELF
				TLNE	T,777-$AM
				GOTO	FALSE
    THEN
      BEGIN
	;T<AM>_NEXT
				TLZ	T,$AM
				MOVEI	T1,$NEXT
				TLO	T,(T1)
	;INSTR_T
				MOVEM	T,INSTR
	;T<LHS>_'MOVE A1,A0'
				HRLI	T,(MOVE A1,A0)
	MABS;
	;T_INSTR;..POINTER NOW IN A1;
				MOVE	T,INSTR
      ENDD
    FI;
    IF T<AM> NEQ SELF
				CAIN	T1,$SELF
				GOTO	FALSE
    THEN
      BEGIN
	;MTAD;
				PUSHJ	SP,.MTAD
	;T_INSTR;
				MOVE	T,INSTR
     ENDD
    FI;
  ; T<ACC>_ACC+1;
				HRLZI	T4,40
				ADD	T,T4
      ; OFFSET_1;
				HRRZI	T4,1
    IF T<AM>=NEXT
				HLRZ	T1,T
				ANDI	T1,$AM
				CAIE	T1,$NEXT
				GOTO	FALSE
    THEN
      ;T<AM>_SELF
				HRRZI	T1,$SELF
				TLZ	T,$AM
				TLO	T,(T1)
    ELSE
      IF T<AM>=SELF
				CAIE	T1,$SELF
				GOTO	FALSE
      THEN
	;T<AM>_PRV
        			HRRZI	T1,$PRV
				TLZ	T,$AM
				TLO	T,(T1)
      FI
    FI;
      ; MOFF;
				PUSHJ	SP,.MOFF
    ;T_INSTR;
				MOVE	T,INSTR
    IF T<AM>=SELF
				HLRZ	T1,T
				ANDI	T1,$AM
				CAIE	T1,$SELF
				GOTO	FALSE
    THEN
      ;MTAD
				PUSHJ	SP,.MTAD
    FI
    ENDD
  FI

ENDD
SUBTTL	OBCODE SERVICE	* QTCTHEN *

;THEN MUST PRESERVE THE LOCATION IN OBCODE (POINTED AT BY RA)
;WHICH CONTAINS THE JUMP INSTRUCTION OVER THE THEN PART.

PROCEDURE QTCTHEN;
BEGIN
  ;TC[INDEX]<RHS>_TOLINK;
				HRRZ	T,TOLINK
				HRRM	T,(TX)
  ;TOLINK_INDEX;
				HRRM	TX,TOLINK
  ;TX_INDEX_INDEX+1;
				AOS	TX,INDEX
  ;TC[INDEX]<LHS>_CAX;..SAVE CURRENT AX OF IFEXPR;
				HRLZ	T,CAX
				HLLM	T,(TX)
  ; TC[INDEX]<RHS>_RA-1;..THE LOC TO BE FIXED UP AT ELSE;
				HRRZ	T,RA
				SUBI	T,1
				HRRM	T,(TX)

ENDD
SUBTTL	OBCODE SERVICE	* QTCELSE *

;ELSE FIXES UP THE JUMP OVER THE THEN PART AND PRESERVES THE 
;LOCATION IN OBCODE THAT CONTAINS THE JUMP OVER THE ELSE PART

PROCEDURE QTCELSE;
BEGIN
  ; T3_TOLINK;
				HRRZ	T3,TOLINK
  ; TOLINK_INDEX;
				HRRZM	TX,TOLINK
  ;TC[INDEX]<RHS>_TC[T3]<RHS>;..TRANSFER OLD TOLINK;
				HRRZ	T2,(T3)
				HRRM	T2,(TX)
  ; INDEX_TX_INDEX+1;
				AOS	TX,INDEX
  ; TC[INDEX]<LHS>_CAX;..SAVE CURRENT AX OF THEN EXPR;
				HRLZ	T,CAX
				HLLM	T,(TX)
  ; CAX_TC[T3+1]<LHS>;..RESTORE CURRENT AX OF IF EXPR;
				HLRZ	T,1(T3)
				HRRZM	T,CAX
  ; TC[INDEX]<RHS>_RA-1;..THE LOC TO BE FIXED UP AT FI;
				HRRZ	T,RA
				SUBI	T,1
				HRRM	T,(TX)
  ; T_TC[T3+1]<RHS>;..THE LOC TO BE FIXED UP NOW;
				HRRZ	T,1(T3)
RAFIX
ENDD



SUBTTL	OBCODE SERVICE	* QTCFI *

;FI FIXES UP THE JUMP OVER THE ELSE PART

PROCEDURE QTCFI;
BEGIN
  ; T3_TOLINK;
				HRRZ	T3,TOLINK
  ; TOLINK_TC[T3]<RHS>;..RESTORE OLD TOLINK;
				HRRZ	T2,(T3)
				HRRM	T2,TOLINK
  ; T2_TC[T3+1]<LHS>;..GET CURRENT AX OF THEN EXPR;
				HRRZ	T2,1(T3)
IF  T2 NEQ CAX
				CAMN	T2,CAX
				GOTO	FALSE
THEN
  ; CAX_0;
				SETZM	CAX
FI;
  ; T_TC[T3+1]<RHS>;..THE LOC TO BE FIXED UP NOW;
				HRRZ	T,1(T3)
RAFIX

ENDD

SUBTTL	OBCODE SERVICE	* QTCTYDES *

;TYDES PROCESSES THE ACTUAL PARAMETER DESCRIPTORS THAT FOLLOW A
;PROCEDURE CALL. IT FILLS IN THE SYMBOLIC (P,Q)-ADDRESS FOR PARAM,
;MORE EXTENSIVELY DESCRIBED IN THE MEMOS

PROCEDURE QTCTYDES;
BEGIN
REGISTER TX;
OWN STOP;
  ;TX_INDEX;
				HRRZ	TX,INDEX;$
  ;STOP_T<RHS>+TX<RHS>;
				HRRZ	T2,1(TX)
				ADD	T2,TX
				HRRZM	T2,STOP

WHILE TX LESS STOP
			CAML	TX,STOP
			GOTO	FALSE
DO
BEGIN
  ;TX_ADDRESS(NEXT INSTR);
  ;T_TC[TX];
				MOVEI	T,1(TX)
				HRRZI	TX,(T)
				MOVE	T,(TX)
				TLC	T,770000
				TLCN	T,770000
				JRST	.-4
				MOVEM	TX,INDEX
  ;CLEAR DECL.BIT;
				TLZ	T,$DECL
  ;T<STATUS>_T<STATUS>*(T<STATUS> NEQ STMT);
				TLC	T,$STATUS
				TLNE	T,$STMT
				TLC	T,$STATUS

IF T<$X>=DYNAMIC
				TLNN	T,$X
				GOTO	FALSE
  THEN
    ;T<AM>_0;
				TLZ	T,$AM
    MREL
  ELSE
  IF T<AM> NEQ ST
				TLC	T,$ST
				TLNN	T,$AM
				GOTO	FALSE
				TLC	T,$ST
  THEN
    BEGIN
    IF T<AM>=CT
				TLNE	T,2
				T.CONST(T)
    THEN
      ;T<STATUS>_REGULAR;
				TLO	T,100
    FI;
    ;MTAD
				PUSHJ	SP,.MTAD
    ENDD
  ELSE
    BEGIN
      ;T<DECL,AM>_PROCLEV;
				HLRZ	T4,(T)
				ANDI	T4,$DECL!$AM
				CAIE	T4,0
				TLO	T,-1(T4)
      IF PROCLEV=1 AND T<KIND>=VAR OR ARRAY AND T<STATUS>=SIMPLE AND T<TYPE> NEQ LABEL
				SOJN	T4,FALSE
				TN.L(T)
				TLNE	T,$EXP!$STATUS
				GOTO FALSE
      THEN
	;T<STATUS>_OWN;
				TLO	T,$OWN
      FI;

      IF PRASE LEQ T<RHS> AND T<RHS> LESS PRLIB
				HRRZ	T1,T
				CAIL	T1,PRASE
				CAIL	T1,PRLIB
				GOTO	FALSE
      THEN
	  AMOF2
      ELSE
	BEGIN
	  INCR(THUNK);
	  ;T4_0;..NO OFFSET;..ALLREADY DONE;
				SETZ	T4,
	SETT(KA);
	  AMST;
	ZERO(KA);
	  DECR(THUNK)
	ENDD
      FI
    ENDD
  FI
FI
ENDD
OD
ENDD
SUBTTL	OBCODE SERVICE	* QTCADDFIX *

;TO PUT OUT A FIXUP FOR JUMPS OVER THEN OR ELSE PART

PROCEDURE QTCADDFIX;
BEGIN
  ;T<LHS>_'JSP  AX,0'; [303]
				 HRLI	 T,(JSP  AX,0) ;[303]
  MABS;
				MOVE	 T,RA;$
				SUBI	T,1;$
  FIXADD;
  KILLAX
ENDD
SUBTTL	OBCODE SERVICE	* DMVNM *

PROCEDURE DMVNM;..DOUBLE STORE NEGATIVE
BEGIN
  OWN DINSTR;
    ; DINSTR_T;..INCLUDING RIGHTHAND!!!;
				MOVEM	T,DINSTR
    ; T_'DMOVN ACC,ACC'
				TLZ	T,777000!$AM
				HLRZ	T4,T
				LSH	T4,-5
				HRRI	T,(T4)
				TLO	T,(DMOVN 0,0)
  MABS;
    ; T_DINSTR;..KILL NEGATION;
				MOVE	T,DINSTR
				TLZ	T,010000
  QDMOVEM
ENDD

SUBTTL	OBCODE SERVICE	* DMVN *

PROCEDURE DMVN;..DOUBLE LOAD NEGATIVE
BEGIN
  OWN DINSTR;
    ; DINSTR<LHS>_T<LHS>;..SAVE DESTINATION ACC;
				HLLZM	T,DINSTR
    ;..KILL NEGATION;
				TLZ	T,010000
  QDMOVE
    ; T_DINSTR;
				HLLZ	T,DINSTR
    ; T_'DFN ACC,ACC+1'; KA10
    ; T_'DMOVN ACC,ACC'; KI10
				TLZ	T,777000!$AM
				HLRZ	T4,T
				LSH	T4,-5
				HRRI	T,(T4)
				TLO	T,(DMOVN 0,0) ;
  MABS;
ENDD
SUBTTL	OBCODE SERVICE	* AMPTR *

;SOURCE IS A POINTER (F.I. A SUBSCRIPTED VARIABLE).
;SPECIAL CASE OF A POINTER IN A0

PROCEDURE AMPTR;
BEGIN
  OWN INSTR;
  IF PTR=A0 AND OFFSET NEQ 0
				TRNN	T,SP
				CAIN T4,0
				GOTO	FALSE
  THEN
    BEGIN
      ;INSTR_T;
				MOVEM	T,INSTR
      ;T_'ADDI A0,OFFSET';
				HRLZI	T,(ADDI 0,0)
				ADDI	T,(T4)
      MABS;
      ;T_INSTR;
				MOVE	T,INSTR
      ;OFFSET_0;
				SETZ	T4,
    ENDD
  FI;
    ;T<AM>_T<RHS>;
    ;T<RHS>_0;
				TLO	T,(T)
				HRRI	T,0
    ;IF T<INDEX>=A0 THEN SET INDIRECT BIT;
				TLNN	T,SP
				TLO	T,20
    ;T_T+T4;..ADD OFFSET;
				ADDI	T4,(T)
				HRRI	T,(T4)
    MABS
ENDD
SUBTTL	OBCODE SERVICE	* AMACC *	* AMRA *

PROCEDURE AMACC;..SOURCE IS AN ACC; GENERATION OF MOVE A,A IS AVOIDED
BEGIN
  IF T<ACC> NEQ T<RHS> OR T<OPCODE> NEQ MOVE OR OFFSET NEQ 0
				HLRZ	T1,T
				SUBI	T1,(MOVE	0,0)
				LSH	T1,-5
				SUBI	T1,(T)
				ADDI	T1,(T4)
				JUMPE	T1,FALSE

  THEN
      BEGIN
	;T_T+T4;
				ADDI	T4,(T)
				HRRI	T,(T4)
	MABS
      ENDD
  FI
ENDD





PROCEDURE AMRA;..ADDRESS OF SOURCE RELATIVE TO PROGRAM COUNTER RA
BEGIN
  ;T<RHS>_T<RHS>+RA;
				ADD	T,RA
  MREL
ENDD
SUBTTL	OBCODE SERVICE	* AMNEXT *	* AMPRV *	* AMSELF *

PROCEDURE AMNEXT;..SOURCE INDEXED BY ACC +1
BEGIN
  ;T1<ACC>_T<ACC>+1;
				HLRZ	T1,T
				ADDI	T1,40
SAMEN:				ANDI	T1,$STATUS!$DECL
  ;T1^-5;..BRING ACC IN  INDEX FIELD;
				LSH	T1,-5
      ;T<AM>_T1;
				TLO	T,(T1)
      ;T_T+T4;..ADD OFFSET;
				ADDI	T4,(T)
				HRRI	T,(T4)
      MABS
ENDD






PROCEDURE AMPRV;..SOURCE INDEXED BY ACC-1
BEGIN
  ;T1<ACC>_T<ACC>-1;
				HLRZ	T1,T
				SUBI	T1,40
  GOTO	SAMEN
ENDD




PROCEDURE AMSELF;..SOURCE INDEXED BY ACC
BEGIN
  ;T<AM>_T<ACCFIELD>;
				HLRZ	T1,T
				LSH	T1,-5
				ANDI	T1,17
				TLO	T,(T1)
  ; T_T+T4;..ADD OFFSET;
				ADDI	T4,(T)
				HRRI	T,(T4)
  MABS
ENDD
SUBTTL	OBCODE SERVICE	* AMISP *

PROCEDURE AMISP;..SOURCE IS POINTER  SAVED IN STACK
BEGIN
  OWN INSTR;
  IF OFFSET=0
				JUMPN	T4,FALSE
  THEN
    ; T<AM>_@SP;
				TLO	T,SP!20
    MABS
  ELSE
    BEGIN
      ; INSTR<RHS>_T<LHS>;
				HLLM	T,INSTR
      ; T<OPCODE,INDEX>_'MOVE,SP';
				TLZ	T,777000
				TLO	T,(<MOVE 0,(SP)>)
    MABS;
    				MOVEI	T4,1
				MOVE	T,INSTR
      AMSELF
    ENDD
  FI;
ENDD

SUBTTL	OBCODE SERVICE	* AMDL *	* AMSP *	* AMAX *

PROCEDURE AMDL;..SOURCE IS LOCAL OF PROC,I.E. INDEXED BY DL
BEGIN
  ;IF KA=0 THEN  T<AM>_DL;
				SKIPN	KA
				TLO	T,DL
  ; T_T+T4;..ADD OFFSET;
				ADDI	T4,(T)
				HRRI	T,(T4)
  MABS
ENDD

PROCEDURE AMSP;..SOURCE IS EXPR SAVED IN STACK
BEGIN
  ;T<AM>_SP;
				TLO	T,SP
  ; T_T+T4;..ADD OFFSET;
				ADDI	T4,(T)
				HRRI	T,(T4)
  MABS
ENDD


PROCEDURE AMAX;..SOURCE IS NON-LOCAL OF PROC,THUS INDEXED BY AX
BEGIN
  ;IF KA=0 THEN  T<AM>_AX;
				SKIPN	KA
				TLO	T,AX
  ;T_T+T4;..ADD OFFSET;
				ADDI	T4,(T)
				HRRI	T,(T4)
  MABS
ENDD

SUBTTL	OBCODE SERVICE	* AMPVAL *

PROCEDURE AMPVAL;..SOURCE IS PROCEDURE VALUE
BEGIN
  LOCAL INSTR,OFS;
  IF PROCLEV NEQ FNLEVEL AND PROCLEVEL NEQ CAX AND THUNK=0
				HLRZ	T2,(T)
				ANDI	T2,77
				ADDI	T2,1
				SKIPN	KA
				CAMN	T2,FNLEVEL
				GOTO	FALSE
				HRRO	T4,T4
				CAMN	T2,CAX
				GOTO	FALSE
  THEN
  BEGIN
    ;INSTR_T
				MOVEM	T,INSTR
    ;OFS_T4
				MOVEM	T4,OFS
    ;CAX_T2
				MOVEM	T2,CAX
    ;T_'MOVEI AX,@PROCLEV(DL)';
				HRLZI	T,(<MOVEI AX,@(DL)>)
				ADDI	T,-1(T2)
    MABS;
    ;T_INSTR
				MOVE	T,INSTR
    ;T4_OFS
				MOVE	T4,OFS
    ;T2_CAX
				MOVE	T2,CAX
  ENDD;
  FI;
  ;T<RH>_OFFSET
				HRRI	T,1(T2)
  IF NONLOCAL
				JUMPGE	T4,FALSE
				HRRZ	T4,T4
  THEN
    AMAX
  ELSE
    AMDL
  FI
ENDD;
SUBTTL	OBCODE SERVICE	* AMCT *

;SOURCE IS A CONSTANT
;AMCT OPTIMIZES SEQUENCES SUCH AS
;	ADDI	AC,N
;	OPC	REG,(AC)
;INTO	OPC	REG,N(AC)
;WHICH IS LIKELY TO OCCUR IN CODE FOR SUBSCRIPTED VARIABLES:
;A[3]  OR  A[I+3]. EVEN SUBSCRIPTED VARIABLES OF TYPE LONG REAL
;ARE OPTIMIZED IN THIS SENSE

PROCEDURE AMCT;
BEGIN
IF T<AM>=IMM OR FIX
				CAIL	T1,$CT
				GOTO	FALSE
THEN
  IF T<OPCODE>='ADDI' OR 'SUBI'
				HLRZ	T2,T
				SUBI	T2,(ADDI 0,0)
				TRNE	T2,773000
				GOTO	FALSE
  THEN
    BEGIN
      ;TX_ADR<NET INSTR>;
      ;T2_NEXT INSTR;
				MOVEI	T2,1(TX)
				HRRZ	TX,T2
				MOVE	T2,(TX)
				TLC	T2,770000
				TLCN	T2,770000
				JRST	.-4
      ;T4_
      IF T2<AM>=PTR
				HLRZ	T3,T2
				ANDI	T3,$AM
				CAIE	T3,$PTR
				GOTO	FALSE
      THEN
	;T2<RHS>
				HRLZI	T4,(T2)
				LSH	T4,5
      ELSE
	IF T2<AM>=SELF
				CAIE	T3,$SELF
				GOTO	FALSE
	THEN
	  ;T2<ACC>
				HLLZ	T4,T2
	ELSE
	  IF T2<AM>=NEXT
				CAIE	T3,$NEXT
				GOTO	FALSE
	  THEN
	    ;T2<ACC>+1
				HRLZI	T4,40
				ADD	T4,T2
	  ELSE
	    ;ZERO
				MOVEI	T4,0
	  FI
	FI
      FI;
      IF T<ACC> NEQ 0  AND  T<ACC>=T4<ACC>
				XOR	T4,T
				TLNE	T,$STATUS!$DECL
				TLNE	T4,$STATUS!$DECL
				GOTO	FALSE
      THEN
	BEGIN
	  ;INDEX_TX;
				MOVEM	TX,INDEX
	  ;KA_T4_ IF ADDI THEN T<RHS> ELSE -T<RHS>;
				TLNE	T,4000
				MOVN	T,T
				HRRZI	T4,(T)
				HRRZM	T4,KA
	  ;T_T2;..T_NEXT INSTR;
				MOVE	T,T2
	MPS;
	ZERO(KA)
	ENDD
      ELSE
	IF T2<OPCODE>=ADD OR SUB  AND  T2<ACC>=T<ACC> AND T<ACC>#0 AND 
	   ; T2<AM>#ACC OR  T2<ACC>#T2<RHS>
				HLLO	T3,T
				TLO	T3,$AM
				SUB	T3,T2
				TLNE	T3,1000
				TLNE	T3,772740
				GOTO	FALSE
				TLNE	T2,$AM-$ACC
				GOTO	TRUE
				HLRZ	T3,T2
				LSH	T3,-5
				XORI	T3,(T2)
				TRNE	T3,17
				TLNN	T,$STATUS!$DECL
				GOTO	FALSE
	THEN
	  BEGIN
	    ;TC[TX]_T;..POSTPONE IMMEDIATE INSTRUCTION;
				MOVEM	T,(TX)
	    ;T_T2;..DO NEXT INSTRUCTION FIRST;
				MOVE	T,T2
	    ;TX_INDEX;
				MOVE	TX,INDEX
	    EDIT(051) ; REWRITE ORIGINAL INSTRUCTION INTO TEMPCODE
				MOVEM	T,(TX)	; [E051]
	    GOTO .MTAD;
	  ENDD
	ELSE
	BEGIN
	  ;TX_INDEX;
				MOVE	TX,INDEX
	  MABS
	ENDD
       FI
      FI
      ENDD
    ELSE
      MABS
    FI
  ELSE
BEGIN
  ;T_T+CONTAB;
				ADD	T,CONTAB
  ;T1_CONSTTABLEADDRESS;
				HRRZI	T1,(T)
 IF  T4=1
				JUMPE	T4,FALSE
  THEN
    BEGIN
      ; T1_T1+T4;
				ADD	T1,T4
      GOTO OFALL
    ENDD
  FI;
  ;T<RHS>_LINK;
				HLR	T,(T1)
  ;LINK_RA;
				HRL	T1,RA
				HLLM	T1,(T1)
  MREL
ENDD
 FI
 ENDD
SUBTTL	OBCODE SERVICE	* AMOF1/2/3 *

PROCEDURE AMOF1;..TO BUILD FIXUP CHAIN IN VALUE FIELD OF ST-ENTRY
BEGIN
  ;T1_SYMTABLEADDRESS;
				HRRZI	T1,1(T)
OFALL: ;T<RHS>_LINK;
				HRR	T,(T1)
  ;LINK_RA;
				HRL	T1,RA
				HLRM	T1,(T1)
  MREL
ENDD



PROCEDURE AMOF2;..TO BUILD FIXUP IN FIRST EXTENSION WORD OF ST-ENTRY
BEGIN
  ;T1_ADDRESS OF EXTENSION;
				MOVE	T1,2(T)
				ANDI	T1,77
				ADDI	T1,1
				IDIVI	T1,6
				ADDI	T1,3(T)
  GOTO OFAUX
ENDD



PROCEDURE AMOF3;..TO BUILD FIXUP CHAIN IN SECOND EXTENSION WORD
BEGIN
  ;T1_ADDRESS OF AUX.EXTENSION;
				MOVE	T1,2(T);..FIRST WORD OF NAME
				ANDI	T1,77
				ADDI    T1,1
				IDIVI   T1,6
				ADDI	T1,4(T)
  ;IF AUX=0 THEN AUX<LHS>_RA;
  OFAUX:			HRLZ	T2,RA
				SKIPN	(T1)
				HLLZM	T2,(T1)
  GOTO OFALL
ENDD


SUBTTL	OBCODE SERVICE	* NOCHAIN *

;NOCHAIN HANDLES THE ST-SOURCE OF WHICH THE ADDRESS IS KNOWN AT
;COMPILE TIME.FOR INSTANCE THE ADDRESS OF A LOCAL OF A PROC BODY IS
;KNOWN AT COMPILE TIME AS Q(DL),WHERE DL IS THE DYNAMIC LEVEL
;POINTER.FOR A NON-LOCAL IT MAY BE NECESSARY TO INSERT AN INSTRUCTION
;TO LOAD THE AUXILIARY ADDRESS MODIFIER AX WITH THE APPROPRIATE DISPLAY
;ELEMENT. THIS IS DESCRIBED MORE PRECISELY IN THE MEMOS

PROCEDURE NOCHAIN;
BEGIN
OWN INSTR,OFS;
IF PROCLEV NEQ FNLEVEL AND PROCLEVEL NEQ CAX AND THUNK=0
				HLRZ	T2,(T)
				ANDI	T2,77
				SKIPN	KA
				CAMN	T2,FNLEVEL
				GOTO	FALSE
				HRRO	T4,T4
				CAMN	T2,CAX
				GOTO	FALSE
THEN
  BEGIN
    ;INSTR_T;
				MOVEM	T,INSTR
    ;OFS_T4;
				MOVEM	T4,OFS
    ;CAX_T2
				MOVEM	T2,CAX
    ;T_'MOVEI AX,@PROCLEV(DL)';
				HRLZI	T,(<MOVEI AX,@(DL)>)
				ADDI	T,-1(T2)
    MABS;
    ;T_INSTR;
				MOVE	T,INSTR
    ;T4_OFS;
				MOVE	T4,OFS
  ENDD
FI;

  ;T<RHS>_VALUE;
				HRR	T,1(T)

IF NONLOCAL
				JUMPGE	T4,FALSE
				HRRZ	T4,T4
THEN
  AMAX
ELSE
  AMDL
FI
ENDD

SUBTTL	OBCODE SERVICE	* AMST *

;..T CONTAINS THE INSTRUCTION;
;..AMFIELD MAY CONTAIN PROCLEV FOR TYPEDESCRIPTOR;
;..T4 CONTAINS OFFSET;

;AMST DEALS WITH A SOURCE IN THE SYMBOL TABLE.
;THE MEMOS DESCRIBE IN DETAIL HOW LABELS ARE TREATED IN THE ONE PASS
;COMPILER AND HOW THE FIRST AND SECOND EXTENSION WORDS ARE USED TO BUILD
;FIXUP CHAINS FOR CURRENT AND INNER REFERENCES.
;GLOBALS AND OWN VARIABLES CANNOT BE USED RECURSIVELY. THAT ALLOWS A
;PROGRAM TO ADDRESS THESE DIRECTLY, BUT IT IMPLIES THAT THE ADDRESSES
;ARE NOT KNOWN AT COMPILE TIME. HENCE A FIXUP CHAIN FOR EACH OF THOSE
;MUST BE GENERATED

PROCEDURE AMST;
BEGIN
REGISTER TV;
;;TV_T<TYPE,VALUE>;
				MOVE	TV,1(T)
;T1_PROCLEV;
				HLRZ	T1,(T)
				ANDI	T1,77

IF TV<KIND>=VAR OR ARRAY
				TLNE	TV,$EXP
				GOTO	FALSE
THEN
  IF TV<TYPE>=LABEL
				T.L(TV)
  THEN
    IF TV<DECL>=UNDECL OR TV<STATUS>=FORWARD
				TLNN	TV,$DECL
				GOTO	TRUE
				T.FOW(TV)
    THEN
      IF THUNK=0
				SKIPE	THUNK
				GOTO FALSE
      THEN
	AMOF3
      ELSE
	AMOF2
      FI
    ELSE
      IF TV<STATUS>=SIMPLE
				TLNE	TV,$STATUS
				GOTO	FALSE
      THEN
	BEGIN
	  IF THUNK=0
				SKIPE	THUNK
				GOTO FALSE
	  THEN
	  ;T<RHS>_TV<VALUE>+2;..LOCAL LABEL;
				HRRI	T,2(TV)
	  ELSE
	    ;T<RHS>_TV<VALUE>
				HRRI	T,(TV)
	  FI;
	  MREL
	ENDD
      ELSE
	BEGIN
	  ;T4_0;..NO OFFSET;
				SETZ	T4,
	  NOCHAIN;..FORMAL LABEL
	ENDD
      FI
    FI
  ELSE
    IF GLOBAL OR OWN
				TLNN	TV,$STATUS
				SOJE	T1,TRUE
				T.OWN(TV)
    THEN
      IF T4=0
				JUMPN	T4,FALSE
      THEN
	AMOF1
      ELSE
	  AMOF2
      FI
    ELSE
      NOCHAIN
    FI
  FI
ELSE    ;..REMAIN PROCEDURE IDENTIFIERS;
  IF TV<STATUS>=EXTERN
				HLRZ	T2,TV
				ANDI	T2,$STATUS
				CAIE	T2,$EXT
				GOTO	FALSE
  THEN
      AMOF1
  ELSE
    IF TV<STATUS>=SIMPLE OR REGULAR
				TLNE	TV,$FOV
				GOTO	FALSE
    THEN
      BEGIN
	;T<RHS>_TV<VALUE>;
				HRR	T,TV
Edit(144) ; Ensure procedure call is relocated
	MREL0	; [E144]
      ENDD
    ELSE
      IF TV<STATUS>=FORWARD
				T.FOW(TV)
      THEN
	AMOF1
      ELSE    ;..REMAIN FORMAL PROCEDURES;
	BEGIN
	  ;T4_0;..NO OFFSET;
				SETZ	T4,
	  NOCHAIN
	ENDD
      FI
    FI
  FI
FI;
;IF TV<KIND,STATUS>=PROC OR FORMAL THEN KILLAX;
				TLC	TV,$PRO!$FON
				TLNE	TV,$PRO
				TLNN	TV,$FON
				SETOM	CAX
ENDD

SUBTTL	OBCODE SERVICE	* QTCSF *	* POWCONV *

PROCEDURE QTCSF;..TO STORE INTO A FORMAL (SEE THE MEMOS)
BEGIN
;T<LHS>_'XCT 0';
				HRLI	T,(XCT 0,0)
;T4_1;OFFSET
				MOVEI	T4,1
NOCHAIN
KILLAX
ENDD











;POWCONV GENERATES THE APPROPRIATE ADDRESS OF POWER OR CONVERT
;ROUTINES

PROCEDURE POWCONV;	;..ADR<VALUE>=3*(OPCODE-724)+PRLIB+1;
BEGIN
  KILLAX;
  ;T1_ADDRESS<VALUE FIELD>;
				LSH	T,-33
				SUBI	T,724
				MOVE	T1,T
				LSH	T,1
				ADDI	T1,PRLIB+1(T)
  ;T_INSTR;
				HRLZI	T,(JSP AX,0)
  GOTO OFALL
ENDD;

SUBTTL	OBCODE SERVICE	* QLF *

;THERE ARE FOUR GROUPS OF SIX DOUBLE FLOATING OPERATIONS.
;THE GROUPS REFLECT THE ACCUMULATOR-DESTINATION OPERAND (IN ACCFIELD)
;A0,A3,A6 OR A11, WHILE EACH GROUP HAS SIX OPERATIONS:
;FAD,FSUB,FMP,FDIV,RFSUB AND RFDIV.
;QLF GENERATES AN INSTRUCTION TO LOAD THE ADDRESS OF THE SOURCE IN
; REGISTER AX AND AN INSTRUCTION THAT CALLS THE APPROPRIATE OPERATION

PROCEDURE QLF;
BEGIN
  OWN INSTR;
    ; INSTR<LHS>_T<LHS>;
				HLLZM	T,INSTR
      ;T<0PCODE,ACCFIELD>_'MOVEI AX,0'
				TLZ	T,777777-$AM
				TLO	T,(MOVEI AX,0)
    ; MTAD;
				PUSHJ	SP,.MTAD
    ; T<RHS>_INSTR<ACCFIELD>;
				HLRZ	T,INSTR
				ANDI	T,777-$AM
    ; T_T:3 ;
				IDIVI	T,60
    ; T1<RHS>_INSTR<OPCODE FIELD>;
				HLRZ	T1,INSTR
  ;T<RHS>_STADR<FLROUTINE>;..=3*(OPCODE-720+C+2*ACC)+PRLIB
				;WHERE 3*C=DFAD0-PRLIB;
				LSH	T1,-11
				SUBI	T1,702
				IMULI	T1,3
				IMULI	T,11
				ADDI	T,PRLIB(T1)
  ;T_'PUSHJ SP,0';
				HRLI	T,(PUSHJ SP,0)
  AMOF1
  KILLAX
ENDD
SUBTTL BACKCHAIN FIXUP AND ST DECREASE AT BLOCKEXIT


;BEXIT DELETES FROM THE SYMBOL TABLE THE SET OF ST-ENTRIES OF THE
;CURRENT BLOCK. IT HAS TO DO SPECIAL THINGS FOR UNDECLARED LABELS
;LABELS ARE HANDLED IN TWO STEPS:
;STEP1: THE CURRENT CHAIN IS LINKED ONTO THE INNER CHAIN
;STEP2: IF THERE IS A LABEL OF THE SAME NAME IN THE OUTER BLOCK,
;THIS ONE IS HOOKED ONTO IT AND THE ST-ENTRY OF THE CURRENT ONE
;IS DELETED;IF NOT,THEN THE ST-ENTRY OF THE CURRENT LABEL IS MOVED
;TO THE OUTER BLOCK.
;ANOTHER OBLIGATION OF BEXIT IS TO PRESENT THE VARIOUS FIXUP CHAINS
;TO THE OUTPUT

PROCEDURE BEXIT;
BEGIN
REGISTER BX,TV,EXT;
OWN NNASTE;
;BX_STBB;..FIRST ENTRY OF THIS BLOCK;
				HRRZ	BX,STBB
;NNASTE_BX-1;..NEXT NEW AVAILABLE ENTRY;
				MOVEM	BX,NNASTE
				SOS	NNASTE
;STBB_OLD STBB;
				MOVE	T,@NNASTE
				MOVEM	T,STBB
	IF NOT PRODUCTION SWITCH SET;
				TNGB(TRPOFF);$
	  THEN;...OUTPUT THE BLOCK IDENTIFIER
				BHDR;$
	FI;

WHILE BX LESS NASTE
				CAML	BX,NASTE
				GOTO	FALSE
DO
BEGIN
;EXT_ADDRESS OF FIRST EXTENSION WORD;
				MOVE    EXT,2(BX);..FIRST WORD OF NAME
				ANDI    EXT,77;..NR. OF CHARACTERS-1;
				ADDI    EXT,1
				IDIVI   EXT,6;..LENGTH OF NAME IN WORDS - 1;
				ADDI    EXT,3(BX)
;TV_ENTRY<TYPE>,<VALUE>;
				MOVE	TV,1(BX)
      IF TV=LABEL AND VAR  AND STATUS NEQ FORMAL
				TLNN	TV,$TYPE
				TLO	TV,$EXP!$TYPE
				HLRZ	T,TV
				ANDI	T,$KIND!$TYPE!$STATUS
				CAIL	T,$L
				CAIL	T,$L!$FON
				GOTO	FALSE
      THEN
      IF TV<DECL> 
				T.DECL(TV)
      THEN
       BEGIN
        IF BX<LINC> NEQ 0
				SKIPN	T,(EXT)
				GOTO	FALSE
	THEN
  	FIXREL( ,TV)
	FI;
	IF BX<LCC> NEQ 0
				SKIPN	T,1(EXT)
				GOTO	FALSE
	THEN
 	BEGIN
  	;T1_TV+2;..TO PROCESS THE LOCAL LABEL;
				HRRZ	T1,TV
				ADDI	T1,2
  	;FIXREL
				PUSHJ	SP,.ADRFIX
 	ENDD
	FI
   ENDD;..OF DECLARED LABEL
  ELSE
  IF STATUS = FORWARD
				T.FOW(TV)
  THEN
    ;..SET DECL.BIT IN ORDER TO DELETE LATER ON;
				TLO	TV,$DECL
				MOVEM	TV,1(BX)
				HRR	SYM,BX		; [266]
				HLL	SYM,1(BX)	; [266]
				TLO	SYM,$ST		; [266]
    FAIL(62,FRIED,DEL,FORWARD HAS NO MATCHING DECL IN SAME BLOCK)  ; [266]
				SETZ	SYM,		; [266]
  ELSE
   IF BX<LCC> NEQ 0
				SKIPN	T,1(EXT)
				GOTO	FALSE
   THEN
	IF BX<LINC> NEQ 0
				SKIPN	T1,(EXT)
				GOTO	FALSE
	THEN
 	BEGIN
	;BX<LINC>_BX<LCC>
				HRRM	T,(EXT)
  	;T<RHS>_BX<SCC>;
				HLRZ	T,T
  	;BX<LCC,SCC>_0;
				SETZM	1(EXT)
				PUSHJ	SP,.ADRFIX
 	ENDD
	ELSE
 	BEGIN
	  ;INNER CHAIN_CURRENT CHAIN;
				MOVE	T,1(EXT)
				MOVEM	T,(EXT)
  	;BX<SCC,LCC>_0
				SETZM	1(EXT)
 	ENDD
	FI
     FI
   FI
  FI
 ELSE
  IF ENTRY =GLOBAL OR OWN AND ENTRY<KIND>=VAR OR ARRAY
				TLNE	TV,$EXP
				GOTO	FALSE
				MOVE	T,(BX)
				TLNN	T,76
				GOTO	TRUE
				T.OWN(TV)
  THEN
    BEGIN
      ;T1<RHS>_BX<VALUE>;
				HRRZ	T1,TV
      TOFIX;
	IF ENTRY<KIND>=VAR AND ENTRY<TYPE>=TWO WORD OPERAND
				T.VAR(TV)
				T.TWO(TV)
	THEN
 	BEGIN
  	;T1<RHS>_HEADER OF CHAIN;
				HRRZ	T1,(EXT)
  	TOFIX
 	ENDD
	ELSE
	  IF ENTRY<KIND>=ARRAY
				TLNN	TV,$ARR
				GOTO	FALSE
	  THEN
	    BEGIN
				HRRZI	T1,0
     	  TOFIX
    	ENDD
	   FI
	FI
      ENDD
  ELSE
   IF ENTRY<STATUS>=FORWARD
				T.FOW(TV)
   THEN
				HRR	SYM,BX		; [266]
				HLL	SYM,1(BX)	; [266]
				TLO	SYM,$ST		; [266]
    FAIL(62,FRIED,DEL,FORWARD HAS NO MATCHING DECL IN THE SAME BLOCK)  ; [266]
				SETZ	SYM,		; [266]
   ELSE
      IF ENTRY<KIND>=PROC AND STATUS=EXT
				T.PRO(TV)
				HLRZ	T,TV
				ANDI	T,$STATUS
				CAIE	T,$EXT
				GOTO	FALSE
      THEN
	BEGIN
	  ;T<RHS>_TV<RHS>;
				HRRZ	T,TV
	  ;T4<RHS>_BX;
				HRRZI	T4,(BX)
	  EXTFIX
	ENDD
     FI
   FI
  FI
 FI;
 ;DELETE OR MOVE ENTRY:
 IF ENTRY<TYPE>=UNDECL.LABEL
				TLNN	TV,$DECL
				T.L(TV)
 THEN
  BEGIN
   ;ENTRY<BL>_ENTRY<BL>-1;..MOVE LABEL TO OUTER BLOCK;
				HLRZ	T3,(BX)
				SUBI	T3,100
				HRLM	T3,(BX)
   IF ENTRY<VALUE> NEQ 0 AND ENTRY<VALUE><BL>=ENTRY<BL>
				TRNN	TV,777777
				GOTO	FALSE
				HLRZ	T,(TV)
				XOR	T3,T	;..BL.PL OF ENTRY<VALUE>;
				ANDI	T3,77700
				JUMPN	T3,FALSE
   THEN
	BEGIN
 	;SET DECLARED BIT IN ORDER TO DELETE LATER ON;
				TLO	TV,$DECL
				MOVEM	TV,1(BX)
	 IF ENTRY<VALUE><TYPE>=VAR AND LABEL
				MOVE	T,1(TV)
				T.L(T)
			T.VAR(T)
 	THEN
  	IF ENTRY<VALUE><LINC> NEQ 0
				HRRZI T4,(EXT)
				SUBI    T4,(BX)
				ADDI    T4,(TV)
				SKIPN	T1,(T4)
				GOTO	FALSE
  	THEN
   	BEGIN
		;T_ENTRY<SINC>;
				HLRZ	T,(EXT)
		;ENTRY<VALUE><LINC>_ENTRY<LINC>;
				HRRZ	T3,(EXT)
				HRRM	T3,(T4)
		;FIXREL
				PUSHJ	SP,.ADRFIX
   	ENDD
  	ELSE
   	;ENTRY<VALUE><SINC,LINC>_ENTRY<SINC,LINC>
				MOVE	T3,(EXT)
				MOVEM	T3,(T4)
  	FI
 	ELSE
  	FAIL(64,FRIED,DEL,FORWARD DECL.MISSING)
 	FI
	ENDD
   FI
  ENDD
 FI;..ONLY THE LABEL THAT OUGHT TO BE MOVED IS STILL 'UNDECLARED';

;..COMPUTE THE HASH;..T4=HASH;
				MOVE	T4,2(BX)
				MULI	T4,647327	;..KEN'S RANDOM CONSTANT;
				ANDI	T4,177
  ;EXT_RECORDLENGTH;
				SKIPGE	(BX)
				ADDI	EXT,2
				SUBI    EXT,(BX)

IF BX LEQ HASHTABLE[HASH]
				CAMLE	BX,SYMHT(T4)
				GOTO	FALSE
 THEN
  ;HASHTABLE[HASH]_ENTRY<LINK>
				HRRZ	T1,(BX)
				HRRM	T1,SYMHT(T4)
 FI;

 IF ENTRY<TYPE>=UNDECL.LABEL
				TLNN	TV,$DECL
				T.L(TV)
 THEN
  BEGIN
   ;T1_RECORDLENGTH +NNASTE-1;
				MOVE	T1,NNASTE
				ADDI	T1,-1(EXT)
   ;T<LHS,RHS>_BX,NNASTE;
				HRRZ	T,NNASTE
				HRL	T,BX
   ;MOVE ENTRY;
				BLT	T,(T1)
   ;T3_NEW ADDRESS;
				HRRZ	T3,NNASTE
   ;NNASTE_NNASTE+RECORDLENGTH;
				ADDM	EXT,NNASTE
   ;ENTRY<LINK>_HASHTABLE[HASH]
				HRRZ	T,SYMHT(T4)
				HRRM	T,(T3)
   ;HASHTABLE[HASH]_NEWADDRESS
				HRRZM	T3,SYMHT(T4)
  ENDD
ELSE
  BEGIN
    ;TV<DECL,AM>_PROCLEV;
				TLZ	TV,$DECL!$AM
				HLRZ	T,(BX)
				ANDI	T,$DECL!$AM
				TLO	TV,(T)
    ;T<RHS>_ADDRESS ST ENTRY;
				HRRZI	T,(BX)
	IF PRODUCTION SWITCH NOT SET;
				TNGB(TRPOFF);$
	  THEN;..OUTPUT THE ASCII SYMBOL BLOCK;
				TYPE0;$
	FI;

  ENDD
 FI;


 ;BX_NEXT ENTRY;
				ADD	BX,EXT
ENDD
OD;
  ;BLOCKLEVEL_BLOCKLEVEL-1;
				SOS	BLOCKLEVEL
				MOVE	T,NNASTE
 ;NASTE_NNASTE;..FIRST SINGLE N,SECOND DOUBLE N;
				MOVEM	T,NASTE

ENDD


ENDD; OF MODULE MSER

LIT
END