Trailing-Edge
-
PDP-10 Archives
-
decuslib10-04
-
43,50325/tables.bli
There are 13 other files named tables.bli in the archive. Click here to see a list.
! File: TABLES.BLI
!
! This work was supported by the Advanced Research
! Projects Agency of the Office of the Secretary of
! Defense (F44620-73-C-0074) and is monitored by the
! Air Force Office of Scientific Research.
MODULE TABLES(TIMER=EXTERNAL(SIX12))=
BEGIN
SWITCHES NOLIST;
REQUIRE COMMON.BEG;
REQUIRE IOMACS.BEG;
REQUIRE GTST.BEG;
REQUIRE GTX.BEG; ! CAN'T USE NAME GT - SORRY!
REQUIRE ST.BEG;
REQUIRE OVLYLO.BEG;
REQUIRE LDSFT.BEG;
REQUIRE FLOW.BEG;
SWITCHES LIST;
REQUIRE TABONC.BEG;
BEGIN
BIND DOGARB1=-8; !IF LARGE SPACE GROWTH WITHIN ROUTINE DO
! GARBAGE COLLECTION EVERY 10K OR SO
BIND DOGARB =2; !OTHERWISE GARBAGECOLLECT BETWEEN ROUTINES
! EVERY 2K (ALSO SEE RNAMEFOLLOWS IN SYNTAX)
EXTERNAL
FREEVEC,
GARBCNT,
GARBLST;
BIND FREEMISC=FREEVEC[0];
! DYNAMIC STORAGE MANAGEMENT
! --------------------------
MACRO SPACEBLOCK=STVEC$, ! "STRUCTURE DECLARATION"
WORDF =0,0,36$,
COUNTF =0,18,18$,
LINKF =0,0,18$;
GLOBAL ROUTINE CALLEXECFORSPACE=
%< ASK MONITOR FOR NEW CORE >%
BEGIN
EXTERNAL JOBREL;
REGISTER R;
MACHOP CALLI=#47,
BLT=#251,
MOVEI=#201;
LOCAL X;
X_.JOBREL+1;
R_.JOBREL+PAGSIZE;
CALLI(R,#11);
X_-1;
IF .X LSS 0 THEN PUNT(805);
.X
END;
GLOBAL ROUTINE RELFLOW(ROOT)=
BEGIN
BIND GTVEC NODE=ROOT;BIND FLOLSTPTR NODEPTR=ROOT;
IF .NODE[FLOLSTBIT] THEN
BEGIN
RELLST(.NODEPTR[PRLGLSTF]);
RELLST(.NODEPTR[MULSTF]);
RELLST(.NODEPTR[EPLGLSTF]);
RELLST(.NODEPTR[PSLGLSTF]);
RELEASESPACE(GT,.NODE[FLOLSTF],2);
NODE[FLOLSTBIT]_0;
END;
END;
GLOBAL ROUTINE RSTRTREE(ROOT)=
BEGIN
MAP LEXEME ROOT;
BIND GTVEC NODE=ROOT; BIND FLOLSTPTR NODEPTR=ROOT;
IF .ROOT[LTYPF] EQL GTTYP
THEN
BEGIN
INCR I FROM OPRNDOFFSET TO .NODE[NODESIZEF]+OPRNDOFFSET-1
DO RSTRTREE(.NODE[.I,LEXW]);
RELEASESPACE(GT,.ROOT[ADDRF],.NODE[NODESIZEF]+BASEGTNODESIZE);
RETURN
END;
IF .ROOT[LTYPF] GEQ LOWFLOLSTTYPE THEN RELLST(.ROOT[ADDRF]);
END;
GLOBAL ROUTINE RSTRTHREAD(START)=
BEGIN
MAP STVEC START;
REGISTER STVEC SV:NX;
LOCAL LNX;
IF .START EQL 0 THEN RETURN;
WHILE .START NEQ .LASTPUR DO
BEGIN
SV_.START;
START_.START[THREAD];
CASE SYMPURGE(.SV) OF
SET
0; ! DONT RELEASE ANYTHING
BEGIN ! RELEASE THE ST ENTRY ONLY
RELEASESPACE(ST,.SV,.STSZ[.SV[TYPEF]]);
END;
BEGIN ! ALSO RETURN THREADS & NX LIST
IF .SV[LSTWORD] NEQ 0 THEN
(RELLST(.SV[VCHGLSTF]); RELLST(.SV[VUSELSTF]));
IF (NX_.SV[NXTHREAD]) NEQ 0 THEN
DO BEGIN
LNX_.NX[NXTHREAD];
RELEASESPACE(ST,.NX,.STSZ[.NX[TYPEF]]);
END UNTIL (NX_.LNX) EQL 0;
RELEASESPACE(ST,.SV,.STSZ[.SV[TYPEF]]);
END;
TES;
END;
END;
FORWARD SORTGARBAGE,MERGEGARBAGE,RELGARBAGE;
ROUTINE PRNTSPACE(START,STOP)=
BEGIN
MACRO STLEFT=0,18,18$,
STRITE=0,0,18$,
OUTCOMMAS=OUTXSTRING(COMMASTR,2,0)$;
BIND COMMASTR=PLIT(',,')<29,7>;
REGISTER SPACEBLOCK I;
I_.START;
WHILE .I LEQ .STOP
DO BEGIN
OUTOCT(.I,6);
OUTPUT("/");
TAB;
DECR J FROM 3 TO 0
DO BEGIN
OUTBLANK(2);
OUTOCT(.I[STLEFT],6);
OUTCOMMAS;
OUTOCT(.I[STRITE],6);
IF (I_.I+1) GTR .STOP THEN EXITLOOP;
END;
CRLF;
END;
END;
ROUTINE PRNOTFREE=
BEGIN
REGISTER SPACEBLOCK C:R,COUNT;
SORTGARBAGE();
MERGEGARBAGE();
COUNT_0;
C_.GARBLST<0,18>;
IF .C GTR .SAVTOP+1
THEN (COUNT_.COUNT+(.C-.SAVTOP)+1;
PRNTSPACE(.SAVTOP+1,.C-1);
CRLF);
WHILE .C[LINKF] NEQ 0
DO BEGIN
IF .C[LINKF] NEQ (R_.C+.C[COUNTF])
THEN (COUNT_.COUNT+.C[LINKF]-.R;
PRNTSPACE(.R,.C[LINKF]-1);
CRLF);
C_.C[LINKF];
END;
IF (R_.C+.C[COUNTF]) NEQ .TOPOFTABLE
THEN (COUNT_.COUNT+.TOPOFTABLE-.R;PRNTSPACE(.R,.TOPOFTABLE-1);CRLF);
OUTXSTRING(PLIT('TOTAL SPACE IN USE: ')<29,7>,20,0);
OUTOCT(.COUNT,1);
CRLF;
RELGARBAGE();
END;
GLOBAL ROUTINE RELEASESPACE(XBASE,SIZE)=
BEGIN
MAP SPACEBLOCK XBASE;
REGISTER SPACEBLOCK WLIST:P;
EXTERNAL PATCHES;
IF .PATCHES[99] NEQ 0 THEN CLEARCORE(.XBASE,.SIZE);
P_WLIST_FREEMISC<0,0>;
IF .SIZE LEQ MAXSEPLST
THEN WLIST_.WLIST+.SIZE
ELSE WHILE (IF .P NEQ 0 THEN (.P[COUNTF] LSS .SIZE))
DO (WLIST_.P;P_.P[LINKF]);
XBASE[LINKF]_.WLIST[LINKF];
XBASE[COUNTF]_.SIZE;
WLIST[LINKF]_.XBASE;
.VREG
END;
OWN SIZE; ! HOLDS THE SIZE ON GETSPACE REQUESTS
ROUTINE GETEX=
! GET EXACT FIT FROM SPECIFIED LIST
BEGIN
REGISTER SPACEBLOCK X;
IF .FREEVEC[.SIZE] EQL 0 THEN RETURN -1;
X_.FREEVEC[.SIZE];
FREEVEC[.SIZE]_.X[LINKF];
.X
END;
ROUTINE GETA=
! GET ALMOST AN EXACT FIT.
BEGIN
REGISTER SPACEBLOCK P;
INCR I FROM .SIZE+2 TO MAXSEPLST
DO IF (P_.FREEVEC[.I]) NEQ 0
THEN BEGIN
FREEVEC[.I]_.P[LINKF];
RELEASESPACE(.P+.SIZE,.I-.SIZE);
RETURN .P
END;
-1
END;
ROUTINE GETM=
! GET FIRST FIT FROM MISC LIST
BEGIN
REGISTER SPACEBLOCK L:N;
L_FREEMISC<0,0>; N_.L[LINKF];
WHILE .N NEQ 0 DO
BEGIN
REGISTER SIZE1;
SIZE1_.N[COUNTF];
IF .SIZE1 EQL .SIZE
THEN (L[LINKF]_.N[LINKF]; RETURN .N)
ELSE IF .SIZE1 GEQ (.SIZE+2)
THEN BEGIN
L[LINKF]_.N[LINKF];
RELEASESPACE(.N+.SIZE,.SIZE1-.SIZE);
RETURN .N
END
ELSE (L_.N; N_.L[LINKF]);
END;
-1
END;
ROUTINE GETTOP=
! GET SPACE FROM TOP OF TABLE
BEGIN
IF (.TOPOFTABLE+.SIZE) GTR .ENDOFSPACE THEN RETURN -1;
TOPOFTABLE_.TOPOFTABLE+.SIZE;
.TOPOFTABLE-.SIZE
END;
FORWARD GARBAGECOLLECT;
ROUTINE GETMON=
! GET NEW SPACE FROM MONITOR AND ALLOCATE FROM IT
BEGIN
IF (GARBCNT_.GARBCNT-1) LSS DOGARB1 THEN
(GARBAGECOLLECT(); GARBCNT_DOGARB);
IF (.ENDOFSPACE-.TOPOFTABLE) NEQ 0 THEN
RELEASESPACE(.TOPOFTABLE,.ENDOFSPACE-.TOPOFTABLE);
ENDOFSPACE_(TOPOFTABLE_CALLEXECFORSPACE())+PAGSIZE-1;
GETTOP()
END;
GLOBAL ROUTINE GETSPACE(T,SZ)=
! ALLOCATE SPACE OF SIZE SZ
BEGIN
MACRO TRY(RTN)=IF RTN() LSS 0$;
SIZE_.SZ;
IF .SIZE LEQ MAXSEPLST THEN
BEGIN
TRY(GETEX) THEN
TRY(GETTOP) THEN
TRY(GETA) THEN
TRY(GETM) THEN
TRY(GETMON) THEN PUNT(804);
END
ELSE BEGIN
TRY(GETM) THEN
TRY(GETTOP) THEN
TRY(GETMON) THEN PUNT(804);
END;
CLEARCORE(.VREG,.SIZE);
.VREG
END;
GLOBAL ROUTINE GETLST(LST)=
BEGIN MAP SPACEBLOCK LST;
LST_.LST[LINKF];
WHILE .LST NEQ 0 DO
BEGIN
OUTOCT(.LST,1); TAB;
OUTOCT(.LST[COUNTF],1); CRLF;
LST_.LST[LINKF]
END;
END;
ROUTINE SORTGARBAGE=
! SORT ALL FREE LISTS ONTO GARBLST BY ADDRESS
BEGIN
REGISTER SPACEBLOCK C:P:S;
LOCAL INTERVAL;
INTERVAL_(.TOPOFTABLE-.SAVTOP+127)/128;
GARBLST_0;
DECR I FROM MAXSEPLST TO 0
DO WHILE (C_.FREEVEC[.I]) NEQ 0
DO BEGIN
FREEVEC[.I]_.C[LINKF];
S_P_GARBLST[(.C-.SAVTOP)/.INTERVAL]<0,0>;
WHILE .P[LINKF] NEQ 0
DO IF .P[LINKF] LSS .C
THEN P_.P[LINKF]
ELSE EXITLOOP;
IF .P[LINKF] EQL 0 THEN S[COUNTF]_.C;
C[LINKF]_.P[LINKF];
P[LINKF]_.C
END;
.VREG
END;
ROUTINE MERGEGARBAGE=
! MERGE ADJACENT PIECES OF SPACE ON THE SORTED LIST GARBLST
BEGIN
REGISTER SPACEBLOCK C:P;
DECR I FROM 126 TO 0
DO IF .GARBLST[.I] EQL 0
THEN BEGIN
GARBLST[.I]_.GARBLST[.I+1];
GARBLST[.I+1]_0;
END
ELSE IF .GARBLST[.I+1] NEQ 0
THEN BEGIN
C_GARBLST[.I]<0,0>;
P_.C[COUNTF];
P[LINKF]_.GARBLST[.I+1];
GARBLST[.I+1]_0;
END;
P_.GARBLST<RIGHTPART>;
WHILE .P NEQ 0 DO
IF (.P+.P[COUNTF]) NEQ .P[LINKF]
THEN P_.P[LINKF]
ELSE BEGIN
C_.P[LINKF];
P[COUNTF]_.P[COUNTF]+.C[COUNTF];
P[LINKF]_.C[LINKF]
END;
.VREG
END;
ROUTINE RELGARBAGE=
! RELEASE ALL ITEMS ON THE MERGED, SORTED LIST GARBLST
BEGIN
REGISTER SPACEBLOCK C:P;
P_.GARBLST;
WHILE .P NEQ 0 DO
BEGIN
C_.P[LINKF]; RELEASESPACE(.P,.P[COUNTF]); P_.C
END;
.VREG
END;
GLOBAL ROUTINE GARBAGECOLLECT=
BEGIN
SORTGARBAGE();
MERGEGARBAGE();
RELGARBAGE()
END;
! SYMBOL TABLE ROUTINES
! ---------------------
ROUTINE HASH=
!---------------------------------------------------------------
!I. GENERAL:
!
! 1. COMPUTE THE HASH FUNCTION OF THE SET OF CHARACTERS IN "ACCUM".
!---------------------------------------------------------------
ABS((.ACCUM[0]+.ACCUM[1]) MOD HTSIZE);
GLOBAL ROUTINE STINSERT(NTI,TYPE,ADDINFO)=
!---------------------------------------------------------------
!I. GENERAL:
!
! 1. THIS ROUTINE CREATES A SYMBOL TABLE ENTRY AT THE
! CURRENT BLOCK AND FUNCTION LEVELS.
!
! 2. THE NAME TABLE ENTRY IS ALWAYS MADE BY THIS POINT,
! AND WE WILL HANG THIS NEW SYMBOL TABLE ENTRY
! OFF THE NAME TABLE ENTRY CORRESPONDING TO IT.
!
! 3. PARAMETERS:
!
! A. NTI - NAME TABLE INDEX OF SYMBOL.
!
! B. TYPE - TYPE OF THE SYMBOL
!
! C. ADDINFO - CONTENTS TO BE ADDED TO THE
! ADDITIONAL INFORMATION FIELD OF
! THE ENTRY WHEN CREATED.
!
! 5. LOCALS:
!
! A. STE - INDEX OF THE SPACE FOR THE SYMBOL TABLE
! ENTRY BEING CREATED.
!
! B. STSIZE - SIZE IN WORDS OF THE SYMBOL TABLE ENTRY
!
!II. SPECIFIC:
!
! 1. *
!
! A. GET THE HASH VALUE FOR THE SYMBOL.
!
! B. GET SPACE FOR THE ENTRY TO BE CREATED.
!
! C. MAKE THE LINK OF THE SYMBOL TABLE ENTRY
! POINT TO THE CLOSEST ENTRY HANGING OFF THE
! NAME TABLE.
!
! D. IN TURN, MAKE THE NAME TABLE ENTRY LINK
! FIELD NOW POINT TO THIS NEW ENTRY.
!
! E. GO DOWN THE HASH TABLE ENTRY THREAD AND FIND
! THE POINT AFTER WHICH THIS SYMBOL SHOULD BE
! ENTERED.
!
! F. MAKE THAT THREAD FIELD POINT TO THIS SYMBOL
! TABLE ENTRY, AND MAKE THIS ENTRY'S THREAD FIELD
! EQUAL TO THE OLD VALUE OF THAT THREAD FIELD.
!
! G. MAKE THE NAME POINTER FIELD OF THE SYMBOL
! TABLE ENTRY POINT TO THE NAME TABLE ENTRY
! WHICH IT HANGS OFF.
!
! H. GIVE THE BLOCK LEVEL FIELD
! OF THE SYMBOL TABLE ENTRY THE CORRECT
! VALUE.
!
! I. ADD THE CORRECT TYPE TO THE TYPE FIELD.
!
! J. ADD THE CORRECT ADDITIONAL INFORMATION WORD.
!
! K. SET LINKAGE NAME TO THE DEFAULT NAME.
!---------------------------------------------------------------
BEGIN
EXTERNAL UNAMNO;
MACRO NEWUNAME = (UNAMNO_.UNAMNO+1)$;
REGISTER STVEC STE;
LOCAL STSIZE;
BIND HSH=.NT[.NTI,HASHNO]; %[1.A]%
STSIZE_(IF .TYPE GEQ LOWSTTYPE
THEN .STSZ[.TYPE]
ELSE STENTRYSIZE);
STE_GETSPACE(ST,.STSIZE);
STE[STELINK]_.NT[.NTI,SYMLINK]; %[1.C]%
NT[.NTI,SYMLINK]_.STE; %[1.D]%
BEGIN
REGISTER L,M;
M_0; L_.HT[HSH,THREADF];
UNTIL .L EQL 0 OR .ST[.L,BLF] LEQ .BLOCKLEVEL
DO (M_.L; L_.ST[.L,THREAD]);
IF .M EQL 0
THEN HT[HSH,THREADF]_.STE
ELSE ST[.M,THREAD]_.STE;
STE[THREAD]_.L
END;
STE[NAMEPTR]_.NTI; %[1.G]%
STE[BLF]_.BLOCKLEVEL; %[1.H]%
STE[TYPEF]_.TYPE; %[1.I]%
IF .STSIZE GEQ 6 THEN
(STE[UNIQBIT]_.UNAMESW;
STE[UNIQENAMEF]_NEWUNAME;
STE[DEBUGF]_.DEBFLG);
IF .TYPE NEQ UNDECTYPE THEN STE[WHICHF]_.ADDINFO; %[1.J]%
.STE
END;
GLOBAL ROUTINE NTINSERT=
!---------------------------------------------------------------
!I. GENERAL:
!
! 1. THIS ROUTINE INSERTS AN IDENTIFIER INTO THE NAME
! TABLE.
!
!II. SPECIFIC:
!
! 1. *
!
! A. HASH THE NAME FOUND IN "ACCUM[0]", AND SAVE
! THE HASH VALUE IN "HSH".
!
! B. GET SPACE FOR A NAME TABLE ENTRY WITH
! "GETSPACE", AND SAVE THE INDEX OF THE
! ENTRY IN "NTE".
!
! C. MAKE THE LINK OF THE NAME TABLE ENTRY
! POINT TO THE FIRST ENTRY HANGING OFF THE
! HASH TABLE.
!
! D. MAKE THE HASH TABLE ENTRY POINT TO THIS NEW
! NAME ENTRY.
!
! E. SAVE THE HASH VALUE IN A NAME
! TABLE ENTRY FIELD.
!
! F. PUT THE NAME IN THE NAME TABLE ENTRY.
!
! G. ZERO THE NAME TABLE ENTRY LINK FIELD,
! WHICH WILL LATER HAVE A GROUP
! OF SYMBOL TABLE ENTRIES HANGING
! OFF IT.
!
! H. RETURN THE INDEX OF THE NAME TABLE ENTRY.
!---------------------------------------------------------------
BEGIN
REGISTER HSH,NTE;
HSH_HASH(); %[1.A]%
NTE_GETSPACE(NT,NAMEENTRY); %[1.B]%
NT[.NTE,NAMELINK]_.HT[.HSH,NAMEF]; %[1.C]%
HT[.HSH,NAMEF]_.NTE; %[1.D]%
NT[.NTE,HASHNO]_.HSH; %[1.E]%
NT[.NTE,ACCUM1]_.ACCUM[0]; %[1.F](2)%
NT[.NTE,ACCUM2]_.ACCUM[1];
NT[.NTE,SYMLINK]_0; %[1.G]%
.NTE %[1.H]%
END;
GLOBAL ROUTINE SEARCH(TYPE)=
!---------------------------------------------------------------
!I. GENERAL:
!
! 1. THIS ROUTINE SEARCHES FOR THE SYMBOL IN "ACCUM", AND
! INSERTS IT IF NECESSARY.
!
!II. SPECIFIC:
!
! 1. *
!
! A. HASH THE SYMBOL, AND PICK UP THE HASH TABLE
! LINK INTO THE LIST OF NAME TABLE ENTRIES
! HANGING OFF IT.
!
! B. LOOK DOWN THE LIST OF NAME TABLE ENTRIES
! UNTIL:
!
! 1. WE FIND THE SYMBOL. THEN RETURN THE
! VALUE OF ITS INDEX.
!
! 2. WE COME TO THE END OF THE NAME
! TABLE LIST.
! C. IF WE EXIT ABOVE BY COMMING TO THE
! END OF A NAME TABLE LIST, THEN CALL
! "NTINSERT" TO INSERT THE NAME INTO THE
! NAME TABLE. THEN WE INSERT THIS
! INTO THE SYMBOL TABLE WITH THE
! REQUESTED TYPE FIELD.
!
! D. FINALLY, RETURN WITH THE INDEX
! INTO THE NAME TABLE.
!---------------------------------------------------------------
BEGIN
REGISTER NTE;
NTE_.HT[HASH(),NAMEF]; %[1.A]%
WHILE .NTE NEQ 0 DO
BEGIN
IF .ACCUM[0] EQL .NT[.NTE,ACCUM1]
THEN IF .ACCUM[1] EQL .NT[.NTE,ACCUM2] THEN EXITLOOP;
NTE_.NT[.NTE,NAMELINK];
END;
IF .NTE NEQ 0
THEN (IF .NT[.NTE,SYMLINK] EQL 0
THEN STINSERT(.NTE,.TYPE,0))
ELSE STINSERT(NTE_NTINSERT(),.TYPE,0);
.NTE %[1.D]%
END;
END
END