Trailing-Edge
-
PDP-10 Archives
-
bb-d868c-bm_tops20_v4_2020_distr
-
language-sources/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