Google
 

Trailing-Edge - PDP-10 Archives - bb-m836c-bm_tops20_v6_1_tools - tools/blis10/h2regi.bli
There are 18 other files named h2regi.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BEUSED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!
!COPYRIGHT (C) 1977,1978 BY DIGITAL EQUIPMENT CORPORATION
!FILENAME:	H2REGI.BLI
!DATE:		7 JUNE 1973		MGM/FLD


! REVISION HISTORY::
!  1-20-78 ROUTINE GLR,GLAR ARE MODIFIED TO FIX BUG#4. REGISTER
!	   DECLARATIONS WITHIN GLOBAL ROUTINES.
!
!  10-19-77 ROUTINE DUMPREG IS MODIFIED TO FIX A BUG RELATED TO MOD FUNCTION.
!           CLEAR ALL REGISTER REFERENCES IF A REGISTER IS DUMPED ONTO
!           A STACK.
!
!  9-27-77 ROUTINE ACQUIRE AND REGINIT ARE MODIFIED TO FIX BUG#48,
!          NESTED ROUTINES WITH INCR OR DECR LOOP EXPRESSIONS.
!          SAVABLE TEMPS ARE NOT PRESERVED ACROSS THE ROUTINES.
!          A GLOBAL VARIABLE REGTEMP IS ADDED AND USED IN DE3N AND
!          IN THIS MODULE IN ROUTINE ACQUIRE.
!  9-19-77 ROUTINE COPYTRCT,RESRT,RESTORERESULT ARE MODIFIED TO
!          FIX BUG=#36.
!          ROUTINE CODEN IS MODIFIED TO FIX  BUG#39.
!
GLOBAL BIND LOREV=2;
GLOBAL REGTEMP;			%9-27-77%
EXTERNAL MODFLAG;

! REVISION HISTORY
!
!
!
!			GENERAL DOCUMENTATION FOR REGIST.BLI
!	
!	
!		THE SET OF 16 ACCUMULATORS ARE PUT INTO FOUR SETS BY THE BLISS
!	MACHINE USING THE FOLLOWING STRATEGY:
!	
!		1. FIRST THE REGISTERS DECLARED IN THE MODULE HEAD AS "RESERVED"
!		   ARE SET ASIDE AND NOT USED IN THE REMAINING THREE SUBSETS.
!	
!		2. THEN THE FOUR RUN-TIME REGISTERS SREG,BREG,FREG, AND VREG ARE
!		   DEFINED.  IN THE ABSENCE OF USER SPECIFICATION THESE ARE
!		   GENERALLY THE LOWEST FOUR AVAILABLE REGISTERS.
!	
!		3. THE REMAINING REGISTERS ARE BROKEN INTO TWO CLASSES: DECLARABLE
!		   (SAVABLE) AND TEMPORARY.  THE NUMBER OF DECLARABLE IS EITHER
!		   SET BY THE USER (DREGS=) OR IS DEFAULTED TO FIVE.  THESE
!		   SAVABLE REGISTERS ARE SAVED IN ROUTINE PROLOGS AND
!		   RESTORED IN THE EPILOGS.  THE TEMPORARIES ARE SAVED
!		   AT CALL SITES OF ROUTINES IF THEIR VALUES MUST BE PRESERVED.
!	
!		THE INITIALIZATION OF THE NAMES SREG, ... ,VREG AND THE DEFINITION
!	OF THEIR ADDRESSES, ETC. IS DONE IN THE ROUTINE RGINIT(H3REGIST).
!	
!	
!		THE ALLOCATION OF REGISTERS IS CONTROLLED BY TWO TABLES: ART AND
!	RT.  THEIR FORMAT IS SPECIFIED BELOW.  THE ART TABLE MAINTAINS A "MAP"
!	OF AVAILABLE SPACE AND THE RT TABLE MAINTAINS THE "NAME" OF INTERMEDIATE
!	RESULTS.  REFERENCES TO INTERMEDIATE RESULTS FROM LEXEMES ALWAYS REFER
!	TO THE RT TABLE SO THAT IF A REGISTER MUST BE SAVED ON THE STACK, SUBSEQUENT
!	CODE GENERATION FOR THAT RESULT WILL BE AWARE THAT THE RESULT IS NO
!	LONGER IN A REGISTER.
!	
!	    ART[0:19]
!	
!............................................................................................................
!                 !                 !\  \  \ !              !  !\  \  \  \  \  \  \  \  \  \ !              !
!                 !                 ! \  \  \!              ! F! \  \  \  \  \  \  \  \  \  \!              !
!                 !                 !  \  \  !              ! R!  \  \  \  \  \  \  \  \  \  !              !
!     FCHAINF     !     BCHAINF     !\  \  \ !     RTEF     ! E!\  \  \  \  \  \  \  \  \  \ !     LRTEF    !
!                 !                 ! \  \  \!              ! E! \  \  \  \  \  \  \  \  \  \!              !
!                 !                 !  \  \  !              ! F!  \  \  \  \  \  \  \  \  \  !              !
!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!
!                30                24                18                12                 6
!		THE ART TABLE CONTAINS TWO DOUBLY LINKED CHAINS: ONE FOR THE
!	TEMPORARY REGISTERS AND ONE FOR THE SAVABLE REGISTERS.  THE RUN-TIME
!	REGISTERS AND THE RESERVED REGISTERS ARE NOT LINKED INTO EITHER CHAIN.
!	THE TEMPORARY REGISTER ARE ALLOCATED IN ROUND-ROBIN FASHION TO PROLONG
!	THE LIFE OF VALUES IN REGISTERS.  THE SAVABLE REGISTERS ARE ALLOCATED
!	AS A STACK TO MINIMIZE THE SAVING AND RESTORING.  THE ROUTINE REGINIT
!	INITIALIZES THE ART (AND RT) TABLE.
!	
!		THE ENTRIES A[0] THROUGH A[15] CORRESPOND TO THE ACTUAL
!	REGISTERS 0 THROUGH 15:  A[I] CONTAINING INFORMATION RELATING TO REGISTER I.
!	
!		A[16]: TAIL OF TEMPORARY  CHAIN
!		A[17]: TAIL OF SAVABLE CHAIN
!		A[18]: HEAD OF TEMPORARY CHAIN
!		A[19]: HEAD OF SAVABLE CHAIN
!	
!		THE FIELDS ARE INTERPRETED AS FOLLOWS:
!	
!		FCHAINF: INDEX IF NEXT REGISTER IN CHAIN
!		BCHAINF: INDEX OF PREVIOUS REGISTER IN CHAIN
!		RTEF:    INDEX OF "NAME" IN RT TABLE
!		FREEF:   BIT INDICATING REGISTER IS ALLOCATABLE
!		LRTEF:   INDEX OF MOST RECENT "NAME" IN RT TABLE.  (AT ONE POINT
!			  IN THE IMPLEMENTATION THIS FIELD WAS NECESSARY BUT NOW
!			  SERVES MAINLY AS A CONVENIENCE WHEN OBTAINING A NEW NAME.)
!	    RT-TABLE
!	
!		RT[0]: NOT USED, SET TO 0
!		RT[1]: BIT-MASK OF AVAILABLE, SAVABLE REGISTERS
!		RT[2:3]: NOT USED, SET TO -1
!		RT[4]: LINK TO THE PREVIOUS VERSION OF ART AND RT TABLE(SEE SAVRT)

!	
!		RT[5:15]
!	
!............................................................................................................
!           !  !\ !           !                       !\  \ !  !                                            !
!           ! H! \!           !                       ! \  \!  !                                            !
!           ! O!  !           !                       !  \  ! R!                                            !
!   ARTEF   ! L!\ ! BLOCKSIZEF!          USEF         !\  \ ! S!                  S T E F                   !
!           ! Y! \!           !                       ! \  \! F!                                            !
!           ! F!  !           !                       !  \  !  !                                            !
!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!
!                30                24                18                12                 6
!	
!	
!		THIS PORTION OF THE RT TABLE IS USED TO NAME: (1) DECLARED
!	REGISTERS; (2) RUN-TIME REGISTERS; AND (3) RESERVED REGISTERS.  THUS
!	WHENEVER A LEXEME IS CREATEED WHICH REFERS TO THE VALUE OF A REGISTER FROM
!	ONE OF THE ABOVE THREE CLASSES, ITS RTEF IS AN INDEX IN THE RANGE 5 TO 15.
!	
!	
!		FIELDS:
!	
!		ARTEF:  REGISTER ADDRESS (INDEX INTO ART)
!		HOLYF:  SET TO 1 (IGNORED)
!		BLOCKSIZEF: # OF REGISTERS ALLOCATED IN SAME CHUNK WITH THIS
!			    ONE:  E.G. REGISTER R[3];
!		USEF: SET TO 1 (IGNORED)
!		LSF: SET TO 1
!		STEF: IF THE REGISTER IS EXPLICITLY DECLARED THEN THE ST-INDEX
!		      OF THE SYMBOL.  ZERO OTHERWISE (E.G. 4<>_ ...)
!	    RT[16:31]
!	
!............................................................................................................
!           !  !\  \  \  \  \ !                       !\  \ !  !                                            !
!           ! H! \  \  \  \  \!                       ! \  \!  !                                            !
!           ! O!  \  \  \  \  !                       !  \  ! R!                                            !
!   ARTEF   ! L!\  \  \  \  \ !          USEF         !\  \ ! S!                 NEXTF/STEF                 !
!           ! Y! \  \  \  \  \!                       ! \  \! F!                                            !
!           ! F!  \  \  \  \  !                       !  \  !  !                                            !
!!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!
!		                30                24                18                12                 6
!	
!	
!		THIS PORTION OF THE TABLE IS USED TO NAME TEMPORARY RESULTS (INCLUDING
!	VREG WHEN IS CONTAINS THE RESULT OF A CONTROL EXPRRESSION OR ROUTINE).
!	NAMES IN THIS RANGE CAN REFER BOTH TO ACTUAL REGISTERS AND TEMPORARY LOCALS
!	(I.E. REGISTERS SAVED ON THE STACK).
!	
!		FIELDS:
!	
!		ARTEF: REGISTER ADDRESS (INDEX INTO ART).  NOTE: REGISTER 0 IS
!		       NEVER USED AS A TEMPORARY.
!		HOLYF: WHEN SET IT INDICATES THAT ONE OF THE OPERATOR ROUTINES HAS
!		       TESTED ONE OF ITS OPERAND LEXEMES AND HAS FOUND ITS
!		       RTEF REFERENCING A REAL REGISTER.  HENCE THIS BIT BEING
!		       SET PREVENTS A REGISTER FROM BEING SAVED ON THE STACK
!		       UNTIL IT IS USED IN AN INSTRUCTION.
!		USEF: A COUNT OF THE NUMBER OF TIMES THIS TEMPORARY RESULT
!		      WILL BE USED IN COMPILING THE PRESENT EXPRESSION.
!		RSF: 0 IF THIS NAME REFERENCES A REAL REGISTER. 1 IF IT REFERENCES
!		     A TEMPORARY VALUE WHICH IS NOW A LOCAL.
!		NEXTF/STEF: IF RSF IS 0 THEN THIS IS THE INDEX OF THE HEADER OF A
!		            DOUBLY LINKED LIST OF LEXEMES WHICH: (1) DEPEND UPON THIS
!			    TEMPORARY VALUE (GRAPH-TABLE LEXEMES) OR (2) REPRESENT VALUES IN THIS
!			    REGISTER (ORDINARY LEXEMES).   IF RSF IS 1  THEN THIS IS THE INDEX OF A
!			    GENSYMS (GENERATED-SYMBOL) ENTRY IN THE SYMBOL TABLE.
!	GLOBALS USED BY REGIST.BLI:
!		HITREGM:	TEMPORARY REGISTER MASK
!		MODREGM:	(4-RUN-TIME REGS) OR RESREGM
!		NOSVR:		NUMBER OF SAVABLE REGISTERS
!		RESREGM:	RESERVED REGISTER MASK
!		SVREGM:		SAVABLE REGISTER MASK
!		CODEPROP:	SET TO 1 WHEN CODEN PRODUCES INST.
!		GENSYMS:	SEE GENLOCAL BELOW
!		VTARGET:	IF >0 THEN USE VREG AS A TEMP





FORWARD ACQUIRE,CHGNG,CHGNGF,CLEARONE,CODEN,CTRCTH;
FORWARD DUA,DUM,DUAN,DUMPREG,ENTER;
FORWARD FREERN,GENLOCAL,GETAR,GETMIN,GETRN,GLAR,GLR,GLTR;
FORWARD INCRUSEN,MATCH,MOVEREG,OPENSPACE,RELREG;
FORWARD RMALL,RMFRLST,SAVEWORTHY,SWAP,TRCTSEARCH;
FORWARD UNUSEOLDNAMP;
GLOBAL ROUTINE GLR(X,F,N)=

!	PRIMARY ROUTINE TO GENERATE CODE TO LOAD A REGISTER WITH THE LEXEME X.
!	CALLED BY THE FOUR ROUTINES:
!	
!		(1) GLTR (GENERATE-LOAD-TEMP-REGISTER)
!			N=1, F=0
!	
!		(2) GLTR2 (GENERATE-LOAD-TWO-ADJACENT-REGISTERS)
!			N=2, F=0
!	
!		(3) GLPR (GENERATE-LOAD-PARTICULAR-REGISTER)
!			N=ADDRESS OF REG, F=2
!	
!		(4) GOLTR (GENERATE-LOAD-TEMP-REGISTER---BUT ONLY NEGATE
!			   IF YOU GET IT FOR FREE, E.G. MOVN)
!			N=1 OR 2, F=1
!	
!	GLOBAL VARIABLES USED BY GLR:
!		OPTTOREGADDR:
!			SET BY GOTM FOR EXPRESSIONS OF THE FORM
!			REG_.REG OP EXP.  IF NOT -1, THEN IT CONTAINS
!			THE ADDRESS OF REG.
!
!		LOADECREG:
!			IF F=2 (GLPR CASE), THEN LOADECREG IS SET TO
!			.N BEFORE CALLING GMA SO THAT IF GMA MUST
!			LOAD A REGISTER IT WILL USE THE ONE POINTED TO
!			LOADECREG.
!

  BEGIN
    REGISTER R;
    MACRO NEGBIT=R<0,1>$,	! NEG-BIT SET IN X
	  NOTBIT=R<1,1>$,	! NOT-BIT SET IN X
	  FULLWORD=R<2,1>$,	! 36-BIT LOAD
	  HALFWORD=R<3,1>$,	! 18-BIT LOAD
	  RIGHTHLF=R<4,1>$,	! 18-BIT LOAD (RIGHT, I.E. <0,18>)
	  INDIRBIT=R<5,1>$,	! INDIRECT ADDRESSING (IF \ EVER HAPPENS)
	  ANDCASE=R<6,1>$,	! A BYTE WITH POSITION 0 CAN BE LOADED
				! BY "ANDING" A REGISTER WHICH NOW CONTAINS
				! .X<0,36>
	  SINGTEMPCASE=R<7,1>$; ! ONE, TEMPORARY TO BE LOADED

    REGISTER OPCODE;	! FUNCTION FOR LOAD INSTRUCTION

    LOCAL REG,		! ADDRESS OF LOADED REGISTER
	  COPFIELD,	! .X<COPF>
	  ADDRESS,	! CODE-3 FORMAT OF ADDRESS IN LOADING INSTRUCTION
	  VALUE,	! USED TO HOLD VALUE OF LITERAL
	  NGNTMASK,	! MASK : NEGM XOR NOTM XOR EMPTY
	  OLDX,		! A COPY OF THE INPUT LEXEME X
	  PSFIELD,	! POSN-SIZEFIELD OF X
	  ANDMASK,	! MASK TO BE ANDED FOR ANDCASE
	  ANDLEX;	! .X<0,36> USED IN ANDCASE
LOCAL STVEC TEMP;		%1-20-78%
! THE FOLLOWING 8 LINES ARE ADDED ON 1-20-78
IF .X<LSF> THEN
	BEGIN
	TEMP=.X<STEF>;
	IF .TEMP[0]<TYPEF> EQL REGT
		THEN ( X=.TEMP[1]<ADDRESSF>;
		       X<VEF>=1
		     );
	END;

!	THESE FIRST FOUR 'IF' STATEMENTS CHECK TO SEE IF THE LEXEME X
!	IS ALREADY IN A REGISTER AND  ALSO ('IF' #3) ADJUST THE INPUT
!	LEXEME TO A MORE STANDARD FORM.

    SINGTEMPCASE_.F NEQ 2 AND .N NEQ 2;
    IF REGP(.X AND NOT NGNTM) THEN IF .SINGTEMPCASE THEN
      IF .RT[.X<RTEF>]<ARTEF> EQL .OPTTOREGADDR THEN
	RETURN IF .X<NGNTF> NEQ 0 THEN GLPR(.X,.OPTTOREGADDR) ELSE .X;
    IF .X<COPF> NEQ 0 THEN
      IF (.X AND (POSNM OR SIZEM OR RTEM OR LSM OR VEM)) EQL VEM THEN
	X<POSNSIZEF>_LITV(.X<LSSTEF>)^(-24);
    IF .SINGTEMPCASE THEN
      IF TVRP(.X) THEN RETURN .X;
    IF .F NEQ 2 THEN
      (IF (REG_MATCH(.X,(.N-1)*2)) NEQ .X THEN RETURN .REG)
    ELSE REGSEARCH(X,0);

!	NOW WE LOAD X IF IT IS A LITERAL

    IF LITP(.X) THEN
      BEGIN
	VALUE_LITV(.X);
	IF .VALUE EQL 0 THEN (OPCODE_SETZ; ADDRESS_0) ELSE
	IF .VALUE EQL -1 THEN (OPCODE_SETO; ADDRESS_0) ELSE
	IF SMNEGLITVP(.VALUE) THEN (OPCODE_MOVNI; ADDRESS_-.VALUE) ELSE
	IF SMPOSLITVP(.VALUE) THEN (OPCODE_MOVEI; ADDRESS_.VALUE) ELSE
	IF .VALUE<RIGHTF> EQL 0 THEN (OPCODE_HRLZI;ADDRESS_.VALUE<LEFTF>) ELSE
	IF .VALUE<RIGHTF> EQL 1^18-1 THEN (OPCODE_HRLOI; ADDRESS_.VALUE<LEFTF>)
	ELSE (OPCODE_MOVE; ADDRESS_LITA(.X));
	CODEN(.OPCODE,
	      REG_IF .F EQL 2 THEN .N ELSE ACQUIRE(-1,.N),
	      .ADDRESS,3,.X);
	RETURN(LEXRA(.REG))
      END;
    COPFIELD_.X<COPF>;
    NEGBIT_.X<NEGF>;
    NOTBIT_.X<NOTF>;
    OLDX_.X;
    X_.X AND NOT (NEGM OR NOTM OR COPM);
    OPCODE_0;
    INDIRBIT_0;
    NGNTMASK_0;
    ANDCASE_0;

!	THIS MESSY IF-THEN-ELSE STATEMENT DETERMINES WHETHER
!	TO GENERATE A FULL OR HALF WORD LOAD AND IN THE CASE WHERE WE
!	HAVE A DOTTED LEXEME WITH A SIZE FIELD OF ZERO AND ITS
!	RTEF FIELD IS SET, WE MANIPULATE X SO THAT WHEN GMA IS CALLED
!	LATER IT CAN DO ITS THING CORRECTLY.  TO UNDERSTAND THIS
!	YOU MUST READ THROUGH GMA.

    IF .COPFIELD NEQ 0 THEN
      IF .X<SIZEF> EQL 0 AND .X<RTEF> NEQ 0 THEN
	BEGIN
	  OPCODE_CASE .COPFIELD OF SET
		   0;
		   (COPFIELD_0; LDB);
		   MOVE;
		   (COPFIELD_0; SESTOG_.SESTOG OR 2;
		    INDIRBIT_1; MOVE)
		 TES;
	  FULLWORD_1;
	  HALFWORD_0
	END
      ELSE
	BEGIN
	  PSFIELD_.X<POSNSIZEF>;
	  HALFWORD_(RIGHTHLF_.PSFIELD EQL 18) OR .PSFIELD EQL #2222;
	  FULLWORD_.PSFIELD EQL 36;
	  IF .PSFIELD NEQ 0 THEN
	    IF NOT .FULLWORD THEN IF .F NEQ 2 THEN
	      IF .RIGHTHLF OR ((.PSFIELD AND #77^6) EQL 0) THEN
		BEGIN
		  ANDLEX_(.X AND NOT (POSNM OR SIZEM)) OR (ZERO36 OR DOTM);
		  REG_MATCH(.ANDLEX,(.N-1)*2);
		  IF .REG NEQ .ANDLEX THEN
		    BEGIN
		      ANDCASE_1; REG_.RT[.REG<RTEF>]<ARTEF>;
		      ANDMASK_
		        IF .RIGHTHLF THEN RIGHTM ELSE 1^.PSFIELD-1;
		      OPCODE_ANDI-(.ANDMASK<LEFTF> NEQ 0);
		      CODEN(.OPCODE,.REG,
			    IF .OPCODE THEN .ANDMASK
			    ELSE LITA(LITLEXEME(.ANDMASK)),
			    3,.OLDX AND NOT NGNTM)
		    END
		END
	END
    ELSE
      BEGIN
	IF ZERONAMP(.X) THEN (OPCODE_MOVEI; COPFIELD_1);
	FULLWORD_1;
	HALFWORD_0
      END;
    LOADECREG_IF .F EQL 2 THEN .N ELSE -1;
    X<COPF>_.COPFIELD;
    ADDRESS_IF NOT .ANDCASE THEN IF .FULLWORD OR .HALFWORD THEN GMA(.X) ELSE GPA(.X);
    LOADECREG_-1;
    IF .OPCODE EQL 0 THEN
      IF .ADDRESS<RELOCF> NEQ 0 OR
	(IF .ADDRESS<IXYF> LEQ 15 THEN
	   IF .F EQL 2 THEN (.ADDRESS<IXYF> NEQ .N OR NOT .FULLWORD)
	   ELSE NOT ITRP(LEXRN(.ART[.ADDRESS<IXYF>]<RTEF>))
	 ELSE 1) THEN
	OPCODE_
	  CASE 2*.HALFWORD+.FULLWORD OF SET
	    LDB;
	    IF .NEGBIT THEN (NEGBIT_0;NGNTMASK_NEGM;MOVN) ELSE
	    IF .NOTBIT THEN (NOTBIT_0;NGNTMASK_NOTM; SETCM)
	    ELSE MOVE;
	    IF .RIGHTHLF THEN HRRZ ELSE HLRZ TES;
    IF NOT .ANDCASE THEN
      IF .OPCODE NEQ 0 THEN
        CODEN(.OPCODE,
	      REG_IF .F EQL 2 THEN .N ELSE ACQUIRE(-1,.N),
	      .ADDRESS OR .INDIRBIT^23,3,(.OLDX AND NOT NGNTM) OR .NGNTMASK)
      ELSE
        REG_
	  IF .F EQL 2 THEN .N ELSE
	  IF .N THEN .ADDRESS<RELRF>
	  ELSE ACQUIRE(.ADDRESS<RELRF>,2);
    IF .NOTBIT THEN CODE(SETCA,.REG,0,1) ELSE
    IF .NEGBIT AND NOT .F THEN CODE(MOVN,.REG,.REG,4);
    LEXRA(.REG) OR (IF .F AND .NEGBIT THEN NEGM)
  END;
GLOBAL ROUTINE GLTR(X)=GLR(.X,0,1);



GLOBAL ROUTINE GOLTR(X)=GLR(.X,1,1);



GLOBAL ROUTINE GLTR2(X)=GLR(.X,0,2);



GLOBAL ROUTINE GLPR(X,A)=GLR(.X,2,.A);



GLOBAL ROUTINE GLAR(X)=
  !(GENERATE-LOAD-ANY-REGISTER)
  !CALLED TO LOAD A VALUE INTO A (POTENTIALLY) READ ONLY REGISTER.  IT
  !FIRST ATTEMPTS TO FIND X INS SOME REGISTER (EVEN IF THAT REGISTER'S
  !USE IS GREATER THAN 1) AND FAILING THAT CALLS GLTR.

  BEGIN LOCAL R;
! THE FOLLOWING 9 LINES ARE ADDED ON 1-20-78
	LOCAL STVEC TEMP;
	IF .X<LSF> THEN
	BEGIN
	TEMP=.X<STEF>;
	IF .TEMP[0]<TYPEF> EQL REGT
	  THEN ( X=.TEMP[1]<ADDRESSF>;
		 X<VEF>=1
	       );
	END;
    IF DCRP(.X) THEN RETURN .X;
    IF (R_MATCH(.X,1)) NEQ .X THEN RETURN .R;
    GLTR(.X)
  END;
GLOBAL ROUTINE RELOADTEMP(ADDRESS,NAME)=
  !RELOADS TEMPORARY MEMORY INTO A REGISTER.  USED BY THE GCREATE
  !ROUTINES FOR THEIR TEMPORARY STACK AND BASE REGISTERS.  ALSO USED
  !BY GMA.  IF ADDRESS=0, THEN ANY REGISTER IS LOADED, OTHERWISE
  !THAT PARTICULAR REGISTER IS LOADED AFTER ITS CONTENTS (IF IN USE)
  !ARE DUMPED.  RETURNS THE ADDRESS OF THE REGISTER.  CARE IS TAKEN
  !NOT TO USE THE VREG SINCE WEIRD SIDE-EFFECTS ARE CAUSED AT THE
  !POPPING OF REGISTER TABLES.

  BEGIN REGISTER SAVVTARGET;
  ROUTINE FUNMARK(L)=
    IF .L<LEFTF> EQL GTLEX THEN MARKFUNNY(.L)
    ELSE SETFUNBIT(.L);

    IF NOT .RT[.NAME]<RSF> THEN RETURN .RT[.NAME]<ARTEF>;
    IF .ADDRESS NEQ 0 THEN
      BEGIN
	IF NOT .ART[.ADDRESS]<FREEF> THEN DUMPREG(.ADDRESS);
	RMFRLST(.ADDRESS)
      END
    ELSE (SAVVTARGET_.VTARGET; VTARGET_-1; ADDRESS_GETAR(-1,1); VTARGET_.SAVVTARGET);
    CODE(MOVE,.ADDRESS,GMA(LEXNPSD(.RT[.NAME]<LSSTEF>,0,36,1)),1);
    RT[.NAME]<LSSTEF>_.ST[.RT[.NAME]<NEXTF>,1]<LEFTF>;
    SCAN0(.RT[.NAME]<STEF>,FUNMARK);
    IF .RT[.ART[.ADDRESS]<LRTEF>]<ARTEF> EQL .ADDRESS THEN
      BEGIN
	RT[.ART[.ADDRESS]<LRTEF>]<LEFTF>_0;
	CLEARONE(RT[.ART[.ADDRESS]<LRTEF>])
      END;
    ART[.ADDRESS]<LRTEF>_ART[.ADDRESS]<RTEF>_.NAME;
    RT[.NAME]<ARTEF>_.ADDRESS
  END;
GLOBAL ROUTINE ACQUIRE(A,N)=
    !THIS ROUTINE ACQUIRES REGISTERS, BOTH TEMPORARY AND DECLARED.
    !PARAMETERS:
    !   DECLARED:    A=ST-INDEX + 16; N=BLOCKSIZE
    !   INCR-DECR:   A=-(ST-INDEX); N=1
    !   TEMPORARY:   A=-1; N=1 OR 2
    !   DIV/MOD:     -1<A<16; N=2
    !RETURNS THE ADDRESS OF THE FIRST OF THE N REGISTERS.  IN THE
    !DIV/MOD CASE, THE RETURNED REGISTER CONTAINS THE CONTENTS OF A.
  BEGIN LOCAL M,R;
    IF .A EQL -1 THEN
      BEGIN
        R_GETAR(-1,.N); GETRN(.R,0,0);
        IF .N EQL 2 THEN GETRN(.R+1,0,0)
      END ELSE
    IF .A LSS 0 THEN
      IF (R_.ART[19]<FCHAINF>) LSS 17 THEN (RMFRLST(.R);
                    IF (1^.R AND .SVREGM) NEQ 0 THEN REGTEMP=.REGTEMP OR 1^.R;   %9-27-77%
                         GETRN(.R,.N,-.A))       %9-27-77%
      ELSE
        BEGIN
          R_INCR I FROM 16 TO 31 DO
              IF (1^.RT[.I]<ARTEF> AND .SVREGM) NEQ 0 THEN
                IF NOT .RT[.I]<HOLYF> THEN BREAK(DUMPREG(.RT[.I]<ARTEF>));
          IF .R LSS 0 THEN RETURN(ERROR(.NSYM,#761))
          ELSE (IF (1^.R AND .SVREGM) NEQ 0 THEN REGTEMP=.REGTEMP OR 1^.R;GETRN(.R,.N,-.A))   %9-27-77%
        END ELSE
    IF .A GTR 15 THEN
      BEGIN
        M_(1^.N)-1;
        R_DECR I FROM 16-.N TO 0 DO
            IF (.RT[1]^(-.I) AND .M) EQL .M THEN BREAK(.I);
        IF .R LSS 0 THEN RETURN(ERROR(.NSYM,#762))
        ELSE INCR I FROM .R TO .R+.N-1 DO RMFRLST(.I);
        GETRN(.R,.N,.A-16)
      END
    ELSE
      BEGIN R_GETAR(.A,.N);GETRN(.R+1,0,0) END;
    .R
  END;
GLOBAL ROUTINE RMFRLST(R)=
    !THIS ROUTINE REMOVES THE REGISTER R FROM THE FREE LIST IN ART
    !(IF IT IS THERE).  IF R IS A SAVABLE TEMPORARY,THE
    !APPROPRIATE BIT IN RT[1] IS SET TO 0.
  BEGIN
    IF .ART[.R]<CHAINF> NEQ 0 THEN
      BEGIN
        ART[.ART[.R]<FCHAINF>]<BCHAINF>_.ART[.R]<BCHAINF>;
        ART[.ART[.R]<BCHAINF>]<FCHAINF>_.ART[.R]<FCHAINF>;
        ART[.R]<CHAINF>_0;
        REGUSE_.REGUSE OR 1^.R;
        ART[.R]<FREEF>_0;
        IF (1^.R AND .SVREGM) NEQ 0 THEN RT[1]<.R,1>_0
      END;
    .R
  END;
GLOBAL ROUTINE ENTFRLST(J)=

    !ENTERS REGISTER J IN THE FREE LIST OF ART AND IF J IS
    !A SAVABLE REGISTER SETS THE APPROPRIATE BIT IN RT[1]

  BEGIN REGISTER T;
  IF (1^.J AND .MODREGM) EQL 0 THEN
    BEGIN
    ART[.J]<15,6>_1;
    IF (1^.J AND .SVREGM) EQL 0 THEN
      BEGIN
        ART[T_.ART[16]<BCHAINF>]<FCHAINF>_.J;
        ART[16]<BCHAINF>_.J;
        ART[.J]<FCHAINF>_16;
        ART[.J]<BCHAINF>_.T
      END
    ELSE
      BEGIN
        ART[T_.ART[19]<FCHAINF>]<BCHAINF>_.J;
        ART[19]<FCHAINF>_.J;
        ART[.J]<FCHAINF>_.T;
        ART[.J]<BCHAINF>_19;
        RT[1]<.J,1>_1
      END
    END
  ELSE IF .J EQL .VREG THEN ART[.J]_0
  END;
GLOBAL ROUTINE TRYVREG=
  !A FIRST ATTEMPT AT TRYING TO OPTIMIZE MINI-ROUTINE AND MINI EXPRESSIONS
  !WHICH RESULT IN LOADING THE VALUE REGISTER FROM A TEMPORARY.  THIS
  !ALGORITHM SAYS THAT IF VTARGET IS GTR 0 THEN TRY TO USE VREG
  !RATHER THAN ANOTHER TEMP. VTARGET IS MANIPULATED BY THE SYNTAX ROUTINES
  !AND GENCODE AND IN A (CLEVER-KLUDGEY) WAY BY GREL.

  IF .VTARGET GTR 0 THEN
  BEGIN
    IF .ART[.VREG]<LRTEF> GEQ 16 THEN
      RETURN
	IF .RT[.ART[.VREG]<LRTEF>]<ARTEF> EQL .VREG THEN
	  .RT[.ART[.VREG]<LRTEF>]<USEF> EQL 0
	ELSE  .RT[.ART[.VREG]<LRTEF>]<ARTEF> EQL 0;
    .ART[.VREG]<LRTEF> EQL 0
  END;
GLOBAL ROUTINE GETAR(A,N)=
    !THIS ROUTINE IS CALLED BY ACQUIRE AND FINDS THE N(=1 OR 2)
    !TEMPORARY REGISTERS.  IT FIRST ATTEMPTS TO RETURN A HI-TEMP
    !FAILING THIS IT SELECTS A SAVABLE TEMP AND FAILING THIS IT
    !CALLS SWAP TO PUT TEMPORARY VALUES ON THE STACK. IF A IS NOT
    !-1, THEN A (AND A+1 IF N=2) ARE TO BE ACQUIRED.


  BEGIN LOCAL R;
    IF .A GEQ 0 THEN IF
      (IF .ART[.A+1]<RTEF> NEQ 0 THEN
	 IF .ART[.A+1]<DTF> THEN NOT .RT[.ART[.A+1]<RTEF>]<HOLYF>
	 ELSE 0
       ELSE (1^(.A+1) AND (.SVREGM OR .MODREGM)) EQL 0) THEN
      BEGIN
	IF NOT .ART[.A+1]<FREEF> THEN DUMPREG(.A+1);
	RMFRLST(.A+1); RETURN .A
      END;
    IF .N EQL 2 THEN
      BEGIN
        R_INCR I FROM 18 TO 19 DO
          BEGIN
            R_.ART[.I]<FCHAINF>;
            WHILE .R LSS (.I-2) DO
              IF .ART[.R+1]<FREEF> THEN EXITLOOP[2] .R
              ELSE R_.ART[.R]<FCHAINF>
          END;
        IF .R LSS 0 THEN A_SWAP(.A,2)
        ELSE
          BEGIN
            RMFRLST(.R);RMFRLST(.R+1);
            A_IF .A GEQ 0 THEN MOVEREG(.A,.R) ELSE .R
          END;
        RETURN .A
      END;
    IF TRYVREG() THEN RETURN RMFRLST(.VREG);
    IF (R_.ART[18]<FCHAINF>) LSS 16 THEN RMFRLST(.R) ELSE
    IF (R_.ART[19]<FCHAINF>) LSS 17 THEN RMFRLST(.R) 
    ELSE SWAP(.A,2)
  END;
GLOBAL ROUTINE GETRN(A,TDN,S)=

  %ACQUIRES A NAME FOR REGISTER A. IF TDN IS 0, THEN THE REGISTER
   IS TEMPORARY ELSE TDN IS THE NUMBER OF DECLARED REGISTERS IN A
   BLOCK AND S IS THEIR SYMBOL TABLE ENTRY%

  BEGIN 
    REGISTER T;
    IF .TDN GTR 0 THEN
    BEGIN
      INCR I FROM .A TO .A+.TDN -1 DO
	BEGIN
	  T_
	    INCR J FROM 5 TO 15 DO
	      IF .RT[.J]<ARTEF> EQL .I THEN EXITLOOP(.J);
	  IF .T LSS 0 THEN
	    T_
	      INCR J FROM 5 TO 15 DO
		IF .RT[.J]<LEFTF> EQL 0 THEN EXITLOOP(.J);
	  IF .T GTR 15 THEN RETURN(ERROR(.NSYM,#761));
	  IF .ART[.I]<LRTEF> GEQ 16 AND NOT .RT[.ART[.I]<LRTEF>]<RSF> THEN
	  BEGIN
	    RT[.ART[.I]<LRTEF>]<LEFTF>_0;
	    CLEARONE(RT[.ART[.I]<LRTEF>])
	  END;
	  RT[.T]<BLOCKSIZEF>_.TDN;
	  RT[.T]<ARTEF>_.I;
	  RT[.T]<USEF>_(RT[.T]<LSF>_1);
	  RT[.T]<STEF>_.S;
	  ART[.I]<RTEF>_ART[.I]<LRTEF>_.T;
	END;
      .ART[.A]<RTEF>
    END
    ELSE
      BEGIN
	IF UNUSEOLDNAMP(.A) OR
	   (.RT[.ART[.A]<LRTEF>]<ARTEF> EQL .A AND .ART[.A]<LRTEF> GEQ 16) THEN
	  T_.ART[.A]<LRTEF>
	ELSE
	BEGIN
          T_16;
          UNTIL .RT[.T]<LEFTF> EQL 0 AND NOT .RT[.T]<RSF>
            DO T_.T+1;
          IF .T GTR 31 THEN
		(T_16;
		UNTIL .RT[.T]<USEF> EQL 0 AND NOT .RT[.T]<RSF>
		    DO T_.T+1);
	IF .T GTR 31 THEN RETURN(ERROR(.NSYM,#760));
	  INCR I FROM 0 TO 15 DO
	    IF .ART[.I]<LRTEF> EQL .T THEN
	      BREAK(ART[.I]<LRTEF>_0)
	END;
        RT[.T]<ARTEF>_.A;
        RT[.T]<USEF>_1;
	CLEARONE(RT[.T]);
        ART[.A]<LRTEF>_ART[.A]<RTEF>_.T
      END
  END;
GLOBAL ROUTINE UNUSEOLDNAMP(A)=
    !PREDICATE TO SEE IF THE NAME REFERENCED BY .ART[.A]<LRTEF>
    !IS FREE TO BE USED.

  IF .ART[.A]<LRTEF> NEQ 0 AND NOT .RT[.ART[.A]<LRTEF>]<RSF>
    THEN .RT[.ART[.A]<LRTEF>]<LEFTF> EQL 0
  ELSE 0;


GLOBAL ROUTINE SWAP(A,N)=

  %MOVES N REGISTERS INTO TEMPORARY MEMORY AND REACQUIRES THEM.
   IF A IS NOT -1, THEN THE CONTENTS OF A WILL BE IN THE
   FIRST OF THE N REGISTERS%

  BEGIN LOCAL T;
    IF .A EQL -1 THEN OPENSPACE(0,.N) ELSE
    IF (T_OPENSPACE(.A+1,.N)) EQL .A THEN .A
    ELSE MOVEREG(.A,.T)
  END;



GLOBAL ROUTINE MOVEREG(A,R)=

  %MOVES REGISTER A TO REGISTER R AND ADJUSTS REGISTER TABLE%

  IF .A EQL .R THEN .A ELSE
  BEGIN
    CODE(MOVE,.R,.A,1);
    IF NOT UNUSEOLDNAMP(.R) AND .RT[.ART[.R]<LRTEF>]<ARTEF> EQL .R THEN
      CLEARONE(RT[.ART[.R]<LRTEF>]);
    RT[ART[.R]<LRTEF>_ART[.R]<RTEF>_.ART[.A]<RTEF>]<ARTEF>_.R;
    ART[.A]<LRTEF>_ART[.A]<RTEF>_0;
    IF .A NEQ .R+1 THEN ENTFRLST(.A);
    .R
  END;
GLOBAL ROUTINE OPENSPACE(A,N)=

  %FREES N(=1 OR 2) REGISTERS BY MOVING THE N 'LEAST USED' REGISTER(S)
   TO TEMPORARY MEMORY%

  BEGIN REGISTER R;
    R_GETMIN(.N);
    IF .N EQL 1 THEN (DUMPREG(.R); RMFRLST(.R)) 
    ELSE
      BEGIN
        IF .RT[.ART[.R]<RTEF>]<USEF> NEQ 0 AND .R NEQ (.A-1)
          THEN DUMPREG(.R);
        IF .N EQL 2 THEN
	  BEGIN
	    IF .RT[.ART[.R+1]<RTEF>]<USEF> NEQ 0 AND (.R+1) NEQ (.A-1)
              THEN DUMPREG(.R+1);
	    RMFRLST(.R+1)
	  END;
	RMFRLST(.R)
      END
  END;
GLOBAL ROUTINE DUMPREG(A)=

  %A IS THE ADDRESS OF A REGISTER DUE TO BE DUMPED IN TEMPORARY
   MEMORY. DUMPREG ACQUIRES LOCAL MEMORY; GENERATES THE DUMPING
   CODE AND SETS THE RT ENTRY%

  BEGIN LOCAL M; REGISTER N;
    N_.ART[.A]<RTEF>;
    M_GENLOCAL();
    GSTO(.M,LEXRN(.N));
    IF .MODFLAG THEN (CLEARONE(RT[.N]); MODFLAG = 0);
    ST[.M<NEXTF>,1]<LEFTF>_.RT[.N]<NEXTF>;
    RT[.N]<NEXTF>_.M;
    RT[.N]<RSF>_1;
    RT[.N]<ARTEF>_0;
    ENTFRLST(.A);
    .A
  END;
!		A GLOBAL COMMENT ON THE GENSYMS(GENERATED-SYMBOLS) LIST:
!	
!		GENSYMS IS A GLOBAL VARIABLE WHOSE VALUE IS THE INDEX OF THE
!	TOP ITEM ON A PUSHDOWN LIST OF TWO-WORD CELLS WHICH HAVE
!	THE FORMAT OF THE FIRST TWO WORDS OF A ST-ENTRY. 
!		THE LIST IS USED BY TWO ROUTINE:
!	
!		GENLOCAL:
!	
!		    THIS ROUTINE GENERATES LOCAL VARIABLES (1) FOR SAVING TEMPORARY
!		REGISTERS AT FUNCTION CALLS AND ACROSS CONTROL EXPRESSIONS,
!		(2) FOR USE IN CONTROL EXPRESSIONS TO HOLD
!		TEMPORARY VALUES (E.G. INCR-DECR COMPUTED TO-VALUES).
!	
!		GANL:
!	
!		    THIS ROUTINE GENERATES NEW NAMES FOR SYMBOLS WHICH RESULT
!		FROM ADDING CONSTANTS TO GLOBALS, OWNS, LOCALS, ETC.  FOR
!		MORE DETAILS SEE THE ROUTINE GANL (IN H2ARITH).
!	


GLOBAL ROUTINE GENLOCAL=

  %GENERATE A SINGLE UNNAMED LOCAL FOR THE CURRENT FUNCTION LEVEL
   AND BLOCK LEVEL AND LINK IT TO GENSYMS%

  BEGIN LOCAL I;
    I_GETSPACE(1);
    CT[.I,0]<BLF>_.BLOCKLEVEL;
    CT[.I,0]<FLF>_.FUNCTIONLEVEL;
    CT[.I,0]<TYPEF>_LOCALT;
    CT[.I,0]<LSF>_1;
    CT[.I,0]<LINKF>_.GENSYMS;
    GENSYMS_.I;
    CT[.I,1]<ADDRESSF>_.NEXTLOCAL;
    NEXTLOCAL_.NEXTLOCAL+1;
    IF .NEXTLOCAL GTR .MAXLOCAL THEN MAXLOCAL_.NEXTLOCAL;
    .I+(LSM OR ZERO36)
  END;
GLOBAL ROUTINE GETMIN(N)=

  %RETURNS THE ART INDEX OF THE FIRST REGISTER OF THE 'LEAST
   EXPENSIVE' BLOCK OF N REGISTERS.  N MUST BE 1 OR 2%

  BEGIN LOCAL I,J,M,S,T;
    T_1^13-1;
    CASE .N-1 OF SET
      INCR P FROM 0 TO 15 DO
	IF ((1^.P) AND .MODREGM) EQL 0 THEN
        IF .T GEQ (IF .RT[I_.ART[.P]<RTEF>]<RSF>
                     OR .RT[.I]<HOLYF> THEN S_1^12
                  ELSE S_.RT[.I]<USEF>)
        THEN (T_.S;M_.P);
      INCR P FROM 0 TO 14 DO
	IF ((3^.P) AND .MODREGM) EQL 0 THEN
        IF .T GEQ (IF .RT[I_.ART[.P]<RTEF>]<RSF> OR
                     .RT[J_.ART[.P+1]<RTEF>]<RSF> OR
                     .RT[.I]<HOLYF> OR
                     .RT[.J]<HOLYF> THEN S_1^12
                  ELSE S_(I_.RT[.I]<USEF>)*(J_.RT[.J]<USEF>)+.I+.J)
        THEN (T_.S;M_.P) TES;
    IF .T EQL 1^12 THEN RETURN(ERROR(.NSYM,#760)) ELSE .M
  END;



GLOBAL ROUTINE REACQUIRE(A,N)=

    !REMOVES THE REGISTER A (NAME N) FROM THE FREE LIST AND LINKS
    !IT TO NAME N.  CALLED WHEN A VALUE IS REFOUND IN  A REGISTER.

  BEGIN
    RMFRLST(.A);
    ART[.A]<RTEF>_.N;
    RT[.N]<USEF>_1;
    .A
  END;
GLOBAL ROUTINE MATCH(X,F)=

  %SEARCHES TRCT FOR AN EXACT MATCH WITH THE LEXEME X.  IF F IS ONE,
   THEN THE USE FIELD IS IGNORED.  OTHERWISE THE USE FIELD MUST BE
   0. ACQUIRE IS CALLED WITH N=2 IF F IS TWO ELSE REACQUIRE. IF
   SUCCESSFUL, THE LEXEME .R FOR THE APPROPRIATE REGISTER IS RETURNED
   IN PLACE OF X%

  BEGIN LOCAL A,C,N,R;
    C_.CODEPROP;CODEPROP_0;
    R_IF .X<RTEF> EQL 0 AND NOT .X<NOTF> THEN
        IF (N_TRCTSEARCH(.X)) GTR 0 THEN
          IF .F THEN INCRUSEN(.N) ELSE
	  IF .RT[.N]<USEF> NEQ 0 THEN .X
	  ELSE
	    BEGIN
	      A_.RT[.N]<ARTEF>;
	      REACQUIRE(.A,.N);
	      IF .F NEQ 0 THEN A_ACQUIRE(.A,2);
	      LEXRA(.A)
	    END
        ELSE .X
      ELSE .X;
    IF .R NEQ .X AND .CODEPROP EQL 0 THEN NORECVAL_.NORECVAL+1;
    CODEPROP_.CODEPROP OR .C;
    .R
  END;
GLOBAL ROUTINE TRCTSEARCH(X)=

  %TRCT IS SEARCHED FOR THE LEXEME X.  IF THE SEARCH IS SUCCESS-
   FUL, THE REGISTER NAME IS RETURNED AS THE VALUE, OTHERWISE -1%

  BEGIN REGISTER H,I,J;
    INCR K FROM 16 TO 31 DO
      IF .RT[.K]<LEFTF> NEQ 0 THEN IF NOT .RT[.K]<RSF> THEN
        BEGIN
          I_.CT[H_.RT[.K]<NEXTF>,1]<NEXTF>;
          UNTIL .I EQL .H DO
            (J_.CT[.I,0]<NEXTF>;
             IF .X EQL .CT[.I,1] THEN RETURN .K;
             I_.J)
        END
  END;
GLOBAL ROUTINE REGSEARCH(X,Y)=
  !CALLED TO SEE IF LEXEMES POINTED TO BY X AND Y ALREADY ARE IN
  !REGISTERS.  IF SO THE LEXEMES ARE REPLACED BY APPROPRIATE REGISTER
  !LEXEMES.
  BEGIN
    INCR I FROM -1 TO 0 DO
      BEGIN LOCAL R,COPY; BIND A=.Y[.I];
	IF A EQL 0 THEN EXITBLOCK;
	IF NOT SAVEWORTHY(.A) THEN EXITBLOCK;
	COPY_.A;
	IF FULLWORD(.COPY) AND (.COPY<COPF> NEQ 0) THEN
	  COPY<POSNSIZEF>_36;
	IF (R_MATCH(.COPY,1)) NEQ .COPY THEN A_.R
      END
  END;
GLOBAL ROUTINE SAVEWORTHY(L)=
    !PREDICATE TO CHECK IF LEXEME L IS TO BE PRESERVED IN A
    !TRCT (TEMPORARY-REGISTER-CONTENTS-LIST).  NOTE IN PARTICULAR
    !THAT THIS IMPLIES THAT WE DO NOT PRESERVE LEXEMES IN
    !THESE LISTS IF THEIR NOT-BIT IS SET NOR IF THEY ARE LEXEMES WITH
    !NON-ZERO REGISTER FIELDS.
    .L<RTEF> EQL 0 AND NOT .L<NOTF>;



GLOBAL ROUTINE GTUPDATE(REGNAME,LEXEME)=
  !CALLED FROM CODEN TO UPDATE THE GRAPH TABLE AND TRCT LIST
  !WHICH IS HANGING FROM RT[.REGNAME]
  BEGIN
    RMALL(.LEXEME);
    IF SAVEWORTHY(.LEXEME)
	AND .REGNAME GEQ 16 THEN ENTER(.REGNAME,.LEXEME);
    SETFUNBIT(.LEXEME);
    SESTOG_.SESTOG OR 1
  END;
!	WHENEVER CODEN IS CALLED IT PLANTS AN INSTRUCTION AT THE BOTTOM
!	OF THE LIST WHOSE HEADER IS PRESENTLY POINTED TO BY CODEPTR.
!	THE FORMAT OF ITS OUTPUT IS:
!
!
!............................................................................................................
!  !              !                                            !                                            !
!  !              !                                            !                                            !
!  !              !                                            !                                            !
! 0!    RELOCF    !                  P R E V F                 !                  N E X T F                 !
!  !              !                                            !                                            !
!  !              !                                            !                                            !
!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!
!                          !           !  !           !                                                     !
!                          !           !  !           !                                                     !
!                          !           !  !           !                                                     !
!             F            !     A     ! I!     X     !                          Y                          !
!                          !           !  !           !                                                     !
!                          !           !  !           !                                                     !
!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!..!
!                30                24                18                12                 6
!
!	THE RELOCF IS A CODE TO THE LOADER INTERFACE INDICATED THE KIND
!	OF RELOCATION (IF ANY) TO BE DONE ON THE Y FIELD.  F,A,I,X
!	CORRESPOND TO THE FIELDS OF A NORMAL PDP10 INSTRUCTION.


GLOBAL ROUTINE CODEN(F,A,M,U,L)=

  %CODEN PLANTS THE PDP10 INSTRUCTION CODE WITH FUNCTION F,
   ACCUMULATOR A, AND ADDRESS FIELD M(CODE-3 FORMAT (SEE FSA)).  U INDICATES THE UPDATE
   ROUTINE FOR TRCT AND L IS THE LEXEME(DEFAULT 0) INVOLVED IN
   THE UPDATE%

  BEGIN LOCAL R,T,Z; REGISTER I;
    CODEPROP_1;
    Z_CT[I_NEWBOT(.CODEPTR,1),1]_(.F AND 1^9-1)^27 OR
                                    (R_.A AND 1^4-1)^23 OR
                                    (.M AND 1^23-1);
    T_.ART[.R]<RTEF>;
    CT[.I,0]<RELOCF>_.M<RELOCF>;
    IF (I_.A<RELRF>) NEQ 0 THEN DUA(.I);
    IF (I_.M<RIGHTF>) LEQ 15 AND .M<RELOCF> EQL 0 THEN
       RT[.ART[.I]<RTEF>]<HOLYF>_0;
    IF (I_.M<INDXF>) NEQ 0 THEN
      (RT[.ART[.I]<RTEF>]<HOLYF>_0;
      IF .U EQL 2 AND .I NEQ .FREG THEN U_5
      ELSE IF .U EQL 3 AND .I NEQ .FREG THEN SESTOG_.SESTOG OR 2);
    IF (I_.M<RELRF>) NEQ 0 THEN DUA(.I);
    IF .L<RTEF> NEQ 0 THEN
      IF .RT[.L<RTEF>] NEQ .FREG THEN
      BEGIN
	IF (.F EQL DPB) AND REGP(.L AND NOT COPM)	%9-19-77%
			THEN U = 8			%9-19-77%
        ELSE
	BEGIN
	  IF .U EQL 2 THEN U_5 ELSE
	  IF .U EQL 3 THEN SESTOG_.SESTOG OR 2;
	  RT[.L<RTEF>]<HOLYF>_0
	END
      END;
    IF .T GEQ 16 OR .U GEQ 5 OR .U EQL 2 THEN
      BEGIN
        RT[.T]<HOLYF>_0;
        CASE .U OF SET
          !0: NO CHANGE
             0;
          !1: CLEAR TRCT ENTRY
	     CLEARONE(RT[.T]);
          !2: MOVEM,DPB,HALF-WORD TO MEMORY
		GTUPDATE(.T,.L);
          !3: MOVE,LDB,HALF-WORD TO ACCUMULATOR
	     (CLEARONE(RT[.T]);IF SAVEWORTHY(.L) THEN ENTER(.T,.L));
          !4: MOVN   T,T
             CHGNG(.T);
          !5: AN INDEXED ADDRESS WAS GENERATED
             SESTOG_.SESTOG OR 3;
          !6: OP-TO-M
		GTUPDATE(0,.L);
          !7: OP-TO-B
	     BEGIN
               CLEARONE(RT[.T]);
		GTUPDATE(.T,.L)
	     END;
	!8: CLEAR ALL TEMPORARY REGS. FOR DPB INST AND LEXEME IS A REGISTER
		(CLEARSOME();FIXSIDEEFFECTS())		%9-19-77%
               TES;
        FREERN(RT[.T]);
      END;
    .Z
  END;
!  THE FOLLOWING SHOULD BE A MACRO BUT THERE ARE TOO MANY FORMALS, ETC.
!  AROUND TO MAKE IT EASY TO CHANGE

GLOBAL ROUTINE CODE(F,A,M,U)=CODEN(.F,.A,.M,.U,0);



ROUTINE CHGNG(T)=

  %CHANGES THE NEG BITS OF ALL ENTRIES IN THE TRCT LIST OF REGISTER
   NAME T%

    SCAN0(CTRCTH(.T),CHGNGF);



ROUTINE CHGNGF(I)=
  !CALLED FROM CHGNG TO XOR THE NEG-BIT OF  ITEMS HANGING FROM RT[.I]

    IF .CT[.I,1]<LEFTF> EQL GTLEX THEN
      (GT[.CT[.I,1]<NEXTF>,0]<RESULTF>_0; ERASE(.I))
    ELSE CT[.I,1]_.CT[.I,1] XOR NEGM;


GLOBAL ROUTINE ENTER(T,L)=

  %ENTERS LEXEME L ON THE TRCT LIST OF REGISTER NAME T%

  CT[NEWBOT(CTRCTH(.T),1),1]_.L;



GLOBAL ROUTINE RMREFREG(REG)=

  ! REMOVES ALL REFERENCES TO CONTENTS OF REG IN TRCT

  BEGIN
    ROUTINE RMREGP(I,REG)=
      (.CT[.I,1] AND (DOTM OR LSSTEM)) EQL (.REG OR DOTM);

    INCR I FROM 16 TO 31 DO
      (SCAN(CTRCTH(.I),.REG,RMREGP,ERASE);
       FREERN(RT[.I]))
  END;
GLOBAL ROUTINE RMALL(L)=
  !REMOVES ALL OCCURENCES OF ITEMS IN TRCT WITH THE SAME STE AS L

  BEGIN
    ROUTINE RMALLP(I,X)=.X<LSSTEF> EQL .CT[.I,1]<LSSTEF>;

    INCR I FROM 16 TO 31 DO
      (SCAN(CTRCTH(.I),.L,RMALLP,ERASE); FREERN(RT[.I]))
  END;


GLOBAL ROUTINE CLEARONE(I)=
  !CALLED TO CLEAR TRCT LIST HANGING FROM .I
  BEGIN
    ROUTINE CLTRCT(I)=
      !(CLEAR-TEMPORARY-REGISTER-CONTENTS-LIST)
    
      BEGIN
        IF .CT[.I,1]<LEFTF> EQL GTLEX THEN

%3.4%	!THIS CHANGE FIXES A BUG WHICH RESULTED FROM THE FACT THAT
%3.4%	!WHEN A TEMP WAS RE-USED, GRAPH TABLE LEXEMES WHICH COUNTED ON THE
%3.4%	!OLD TEMP CONTENTS BUT DID NOT USE THE TEMP DIRECTLY DID NOT HAVE
%3.4%	!RESULT BITS TURNED OFF.  THE NEW ROUTINE GTORES CYCLES THROUGH
%3.4%	!THE GT TURNING OFF RESULT BITS IN ALL GT ENTRIES WHICH COUNT
%3.4%	!ON THE OLD CONTENTS OF THE REGISTER.

%3.4%	GTORES(.CT[.I,1]);

        ERASE(.I)
      END;
    
    IF .I<RIGHTF> GEQ RT[16]<0,0> THEN
    BEGIN
      SCAN0(IF NOT .(.I)<RSF> THEN .(.I)<NEXTF>
	    ELSE .ST[.(.I)<NEXTF>,1]<LEFTF>,CLTRCT);
      FREERN(.I)
    END
  END;
GLOBAL ROUTINE CLEARSOME=
    !CLEAR TRCT LIST OF EACH REGISTER WHOSE USE IS ZERO

  BEGIN 
    INCR I FROM RT[16] TO RT[31] DO
      IF .(.I)<USEF> EQL 0 THEN CLEARONE(.I)
  END;


GLOBAL ROUTINE CLEARTEMP=
    !CLEARS TRCT LIST OF EACH TEMPORARY LOCAL WHOSE USE IS ZERO

  BEGIN
  INCR I FROM RT[16] TO RT[31] DO
    IF .(.I)<USEF> EQL 0 THEN
    IF .(.I)<RSF> THEN CLEARONE(.I)
  END;



GLOBAL ROUTINE FREERN(I)=

  %FREES REGISTER NAME(ADDR. I) IF USE IS 0 AND TRCT
   ENTRY IS NULL.%

  IF .(.I)<USEF> EQL 0 THEN
    IF NOT .(.I)<RSF> THEN
      (IF NULL(.(.I)<NEXTF>) THEN (.I)<LEFTF>_0)
    ELSE (IF NULL(.ST[.(.I)<NEXTF>,1]<LEFTF>) THEN WORD(.I)_HEADER(0,0,0));
GLOBAL ROUTINE DUA(R)=
  !(DECREASE-USE-ADDRESS)  DECREASE USE OF REGISTER ADDRESS A
    DUAN(.R,.ART[.R]<RTEF>);



GLOBAL ROUTINE DUN(N)=
  !(DECREASE-USE-NAME) DECREASE USE OF REGISSTER NAME N
    DUAN(.RT[.N]<ARTEF>,.N);



GLOBAL ROUTINE DUAN(R,N)=

  %ATTEMPTS TO DECREASE THE USE COUNT OF REGISTER R(NAME N)
   AND RELEASE IT IF THE USE BECOMES 0%

  IF .N GEQ 16 THEN
    BEGIN
      IF .RT[.N]<RSF> THEN DUM(.N) ELSE
      IF (IF .RT[.N]<USEF> NEQ 0 THEN
        (RT[.N]<USEF>_.RT[.N]<USEF>-1) EQL 0 ELSE 1) THEN
        RELREG(.R,1);
      .RT[.N]<USEF>
    END
  ELSE 0;



GLOBAL ROUTINE DUM(N)=

  %GIVEN THE NAME OF A DUMPED REGISTER, ATTEMPT TO DECREASE ITS USE
   COUNT AND RELEASE IT%

  BEGIN
      IF (RT[.N]<USEF>_.RT[.N]<USEF>-1) EQL 0 THEN
        CLEARONE(RT[.N])
  END;
GLOBAL ROUTINE INCRUSEN(N)=

  %INCREASES USE COUNT OF UNLOCKED REGISTER NAMED N, REACQUIRING IT
   IF NECESSARY, AND RETURNS LEXEME OF REGISTER%

  IF .N GEQ 16 THEN
  BEGIN
    IF (RT[.N]<USEF>_.RT[.N]<USEF>+1) GTR 1^8-1 THEN RETURN ERROR(.NSYM,#772);
    IF .RT[.N]<USEF> EQL 1 THEN LEXRA(REACQUIRE(.RT[.N]<ARTEF>,.N))
    ELSE LEXRN(.N)
  END
  ELSE 0;



GLOBAL ROUTINE DULEX(X)=

  %X IS AN ARBITRARY LEXEME.  DULEX DECREASES THE USE COUNT OF
   ANY TEMPORARY REGISTER TO WHICH IT REFERS%

  IF .X<DTF> THEN
    IF .RT[.X<RTEF>]<RSF> THEN DUM(.X<RTEF>)
    ELSE DUN(.X<RTEF>);
GLOBAL ROUTINE RELREG(A,N)=
    !THIS ROUTINE RELEASES N REGISTERS BEGINNING WITH A FROM THE ART
    !TABLE AND IF THE TRCT LIST IS EMPTY OR THE REGISTER IS DECLARED,
    !IT ALSO RELEASES THE CORRESPONDING REGISTER NAME.
  BEGIN LOCAL B,B1,NAME;
    NAME_.ART[.A]<LRTEF>;
    B_(NULL(.RT[.NAME]<NEXTF>) AND NOT .RT[.NAME]<RSF>) OR .NAME LEQ 15;
    DECR J FROM .A+.N-1 TO .A DO
      BEGIN
	IF .B THEN ART[.J]<LRTEF>_RT[.ART[.J]<RTEF>]<LEFTF>_0;
	IF (B1_(1^.J AND .MODREGM) EQL 0) AND .ART[.J]<CHAINF> EQL 0 THEN
	  ENTFRLST(.J)
	ELSE IF NOT .B1 THEN ART[.J]<RTEF>_0
      END
  END;



GLOBAL ROUTINE REGINIT(GR)=
    !INITIALIZES THE REGISTER TABLES AT THE BEGINNING OF THE MODULE
    !AND AT THE BEGINNING OF EACH ROUTINE OR FUNCTION COMPILATION.
    !PARAMETER: 0 FOR FCNS AND ROUTINES
    !           1 FOR GLOBAL ROUTINE
    !           2 FOR MODULE
  BEGIN LOCAL M,B,T;
    IF .GR EQL 2 THEN
      INCR I FROM 16 TO 31 DO RT[.I]_HEADER(0,0,0)
    ELSE (CLEARSOME();SAVRT(1));
    RT[2]_RT[3]_-1;
    IF .GR GTR 0 THEN
      BEGIN
        RT[1]_.SVREGM;
        INCR I FROM 0 TO 15 DO ART[.I]_0;
        INCR I FROM 5 TO 15 DO
	  IF ((1^.RT[.I]<ARTEF>) AND .MODREGM) EQL 0 THEN RT[.I]_0
      END;
    ART[16]_63^30 OR 18^24 OR 2^16;
    ART[17]_63^30 OR 19^24 OR 3^16;
    ART[18]_16^30;
    ART[19]_17^30;
    M_.MODREGM;
    MODREGM_.MODREGM OR (.SVREGM AND NOT .RT[1]);
    INCR I FROM 0 TO 15 DO ENTFRLST(.I);
    MODREGM_.M;
    REGUSE_0;
    REGTEMP=0					%9-27-77%
  END;
GLOBAL ROUTINE SAVREG(F)=
  !CALLED TO SAVE ANY REGISTERS THAT ARE IN USE AT THE CALL SITE OF
  !A FUNCTION OR ROUTINE.  F IS THE LEXEME OF THE FUNCTION CALL
  !WHICH MIGHT INCLUDE A REGISTER.  IF IT DOES THEN IF THAT REGISTER
  !HAS A USE OF ONE, IT IS NOT SAVED SINCE ITS SINGLE-USE WILL OCCUR
  !IN THE PUSHJ INSTRUCTION

  BEGIN LOCAL N,R;
    INCR I FROM 0 TO 15 DO
      IF (R_.ART[.I]<RTEF>;.R) GEQ 16 AND NOT .RT[.R]<RSF> THEN
	IF (N_.RT[.R]<USEF>) GTR 0 THEN
	  IF NOT(.R EQL .F<RTEF> AND .N EQL 1) THEN
	    (NOCSAV_.NOCSAV+1;DUMPREG(.I))
  END;


GLOBAL ROUTINE LIVR(LEX)=
  !(LINK-IN-THE-VALUE-REGISTER) A SEMI-KLUDGE TO INSERT A NAME
  !FOR THE VALUE REGISTER IN THE RT TABLE AT THE END OF A FORKED
  !CONTROL STRUCTURE.

  BEGIN
    ART[.VREG]_.LEX; ART[.VREG]<LRTEF>_.LEX<RTEF>;
    RT[.LEX<RTEF>]<LEFTF>_.VREG^14 OR 1
  END;



GLOBAL ROUTINE CTRCTH(I)=
  !RETURNS THE INDEX OF THE HEADER OF THE TRCT LIST APPENDED
  !FROM RT[.I] IF IT IS THE NAME OF A REGISTER OR FROM THE LEFT-HALF
  !OF THE SYMBOL TABLE ENTRY FOR THE GENERATED SYMBOL IF IT IS
  !A TEMPORARY LOCAL

  IF .RT[.I]<RSF> THEN .ST[.RT[.I]<NEXTF>,1]<LEFTF>
  ELSE .RT[.I]<NEXTF>;
!		A GLOBAL COMMENT ON THE NEXT THREE ROUTINES AND THE RT TABLE:
!	
!	
!		IN ORDER TO PRESERVE THE STATE OF THE REGISTER TABLES SO THAT
!	AT EACH ENTRY POINT TO A NODE OF A FORK THE STATE IS THE SAME, WE USE
!	THE ROUTINES SAVRT AND RESRT TO PUSH AND POP RESPECTIVELY COPIES OF THE
!	TABLES AS THEY APPEARED AT ENTRY TO THE FIRST NODE.  HENCE IF, FOR EXAMPLE,
!	WE ARE COMPILING AN IF-THEN-ELSE EXPRESSION AND .X IS IN REGISTER R
!	UPON ENTRY TO THE "THEN", THE SAVING OF THE TABLES AT THAT POINT AND
!	RESTORING THEM UPON ENTERING THE "ELSE" ALLOWS ONE TO USE THE FACT THAT
!	.X IS STILL IN R ON ENTRY TO THE "ELSE".  NO APOLOGY IS MADE FOR THE
!	OBSCURITY OF THESE ROUTINES--SAVE THE EXCUSE THAT THEY WERE NOT DESIGNED
!	BUT RATHER WERE BORN OVER THE PERIOD (RATHER LENGTHY PARTUM) DURING
!	WHICH WE PAINFULLY LEARNED THE INTRICACIES OF THE INTERACTIONS
!	BETWEEN THE REGISTER TABLES AND THE GRAPHTABLE. (PHEW!)
!	
!		SAVRT:
!	
!		(1):	GETS A CHUNK OF SPACE
!		(2):	COPIES ART AND RT[0:15] DIRECTLY
!		(3):	RT[4] IS ASSIGNED THE INDEX OF THE CHUNK ALLOCATED IN (1).
!			THUS WE ARE IN EFFECT CREATING A PUSHDOWN LIST OF COPIES
!			OF THE TABLES (DEPTH DETERMINED BY THE DEPTH OF NESTING
!			OF FORKED EXPRESSIONS).
!		(4):	THEN THE CELLS RT[16:31] ARE COPIED:
!			(A):	IF RT[.I] IS A REGISTER, THEN ITS TRCT LIST IS
!				DUPLICATED ITEM FOR ITEM.
!			(B):	IF RT[.I] IS TEMPORARY MEMORY, THEN ITS TRCT LIST
!				IS COPIED BUT WITH AN EXTRA CELL APPENDED AT THE
!				BOTTOM CONTAINING THE ST-INDEX OF THE GENSYMS
!				SYMBOL ENTRY.  THIS IS NECESSARY SINCE THIS
!				SYMBOL INDEX MIGHT DISAPPEAR FROM RT WHILE THE
!				PRESENT BRANCH IS BEING COMPILED.
!	
!		RESRT:
!	
!		---	NOTE THAT RESRT "POPS" THE PUSHDOWN LIST OF TABLES IF
!			ITS PARAMETER IS 1 AND ONLY REFRESHES THE ART AND RT
!			TABLES FROM THE COPY ON THE TOP OF THE LIST IF THE
!			PARAMETER IS ZERO.
!	
!		(1):	COPIES BACK INTO ART AND RT[0:15]
!		(2):	FOR EACH ENTRY IN RT[16:31]:
!			(A):	IT ERASES THE OLD LIST
!			(B):	COPIES IN A NEW RT[I]
!			(C):	IF THE RESTORED ENTRY IS TEMPORARY MEMORY, IT
!				RESTORES THE STEF FROM THE BOTTOM OF THE LIST
!				(CF. SAVRT 4-B)
!			(D):	IF THIS IS A "REFRESH" AND NOT A "POP", IT MAKES
!				A NEW COPY OF THE LIST (CALLS COPYTRCT)
!			(E):	THE LIST IS SCANNED TO RESTORE THE RESULT BITS OF
!				ANY GT-NODES IN THE LIST
!		(3):	IF IT IS A "POP", THE OLD COPY IS RELEASED
GLOBAL ROUTINE COPYTRCT(RRBIT,I,E,BASE)=
  !CALLED TO COPY THE TRCT LIST APPENDED TO RT[.I].
  !ACTUALLY THE NEW CELLS BECOME THE LISTS HANGING OFF THE RT ENTRIES
  !AND THE OLD CELLS ARE LEFT HANGING OFF THE COPY IN TABLE
  !	RRBIT:  RESTORERESULTBIT (RESRT CALLED)
  !	I: INDEX INTO RT TABLE
  !	E: 1 WHEN SAVRT CALLS AND WE ARE MAKING UP A FRESH RT TABLE FOR A NEW ROUTINE
  !	BASE: INDEX OF THE BASE OF THE CHUNK OF CT WHERE THE COPY IS BEINGSTORED

  BEGIN LOCAL B,H; REGISTER C,J,K;
	IF .RT[.I]<RSF> THEN B_.(C_ST[.RT[.I]<NEXTF>,1]<LEFTF>)
	ELSE B_.(C_RT[.I]<NEXTF>);
	IF .E THEN RT[.I]_HEADER(0,0,0) ELSE
        IF NULL(.B) THEN .C_HEADER(0,0,0)
        ELSE
          BEGIN
            .C_HEADER(0,0,0);
            K_.CT[.B,1]<NEXTF>;
            UNTIL .K EQL .B DO
              BEGIN
                J_.CT[.K,0]<NEXTF>;
                CT[H_GETSPACE(1),1]_.CT[.K,1];
		IF .RRBIT THEN
		  IF .CT[.K,1]<LEFTF> EQL GTLEX THEN
		    RESTORERESULT(.CT[.K,1],.I);
                PUSHBOT(..C,.H);
                K_.J
              END
          END;
       IF .RT[.I]<RSF> THEN (CT[.BASE,20]+.I)<0,15>_.B
  END;
GLOBAL ROUTINE SAVRT(E)=
    !THIS ROUTINE IS CALLED TO SAVE THE REGISTER TABLES
    !PARAMTERS;
    !   0  CASE,IF-THEN-ELSE
    !   1  FCN OR RTN OR NEW MODULE
  BEGIN LOCAL A,B;
    A_CT[B_GETSPACE(26),0];
    INCR I FROM 0 TO 19 DO (.A+@I)<0,36>_.ART[.I];
    A_.A+20;
    INCR I FROM 0 TO 15 DO (.A+@I)<0,36>_.RT[.I];
    RT[4]_.B;
    INCR I FROM 16 TO 31 DO
      BEGIN
        (.A+@I)<0,36>_.RT[.I];
	IF .RT[.I]<RSF> THEN
	  CT[NEWBOT(CTRCTH(.I),1),1]_.RT[.I]<STEF>;
	COPYTRCT(0,.I,.E,.B);
	IF .RT[.I]<RSF> THEN ERASEBOT(CTRCTH(.I))
      END
  END;
GLOBAL ROUTINE RESRT(KRFLG)=
    !RESTORES THE REGISTER TABLES.  KEEPS THE PRESENTLY STACKED
    !COPY IF KRFLG IS 0 AND RELEASES IT IF IT IS 1.
  BEGIN LOCAL A,B; REGISTER C,D;
    CLEARSOME();
    A_CT[B_.RT[4]<NEXTF>,0];
    INCR I FROM 0 TO 19 DO ART[.I]_.(.A+@I)<0,36>;
    A_.A+20;
    INCR I FROM 0 TO 15 DO RT[.I]_.(.A+.I)<0,36>;
    INCR I FROM 16 TO 31 DO
      BEGIN
	IF  .RT[.I]<USEF> NEQ 0 AND NOT .RT[.I]<RSF> THEN CLEARONE(RT[.I]);
        ERASE(CTRCTH(.I));
        RT[.I]_.(.A+@I)<0,36>;
	IF .RT[.I]<RSF> THEN
	  BEGIN
	    D_.RT[.I]<NEXTF>;
	    C_RT[.I]<NEXTF>_.CT[.CT[.D,1]<PREVF>,1]<STEF>;
	    ST[.C,1]<LEFTF>_.D
	  END;
	IF NOT .KRFLG THEN COPYTRCT(1,.I,0,.B);
        IF .RT[.I]<RSF> THEN ERASEBOT(CTRCTH(.I));
	D_CTRCTH(.I);
	C_.CT[.D,1]<NEXTF>;
	WHILE .C NEQ .D DO
	  (IF .CT[.C,1]<LEFTF> EQL GTLEX THEN RESTORERESULT(.CT[.C,1],.I);
          C=.CT[.C,0]<NEXTF>)
      END;
    IF .KRFLG THEN RELEASESPACE(.B,26) ELSE RT[4]_.B
  END;
GLOBAL ROUTINE FREEVREG=
  !THE NAME OF THIS ROUTINE IS RATHER A MISNOMER NOW.  ITS PURPOSE
  !NOW IS TO SAVE ON THE STACK ANY REGISTER WHOSE USE IS NON-ZERO AT
  !THE BEGINNING OF A CONTROL EXPRESSION.

  BEGIN
    INCR I FROM 16 TO 31 DO
      IF .RT[.I]<USEF> NEQ 0 AND NOT .RT[.I]<RSF> THEN
          DUMPREG(.RT[.I]<ARTEF>)
  END;



GLOBAL ROUTINE GETVREG=
  %MOVES .VREG TO A TEMPORARY IF ITS USE IS NON-ZERO AND RETURNS
   NAME OF .VREG%
  BEGIN
    IF .RT[.ART[.VREG]<RTEF>]<USEF> NEQ 0
      THEN IF NOT .RT[.ART[.VREG]<RTEF>]<LSF>  THEN DUMPREG(.VREG);
    LEXRN(ART[.VREG]<RTEF>_GETRN(.VREG,0,0))
  END;



!END OF H2REGI.BLI