! 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