!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!
!COPYRIGHT (C) 1972,1973,1974,1977,1978 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 01754
!FILENAME:	H1LEXA.BLI
!DATE:		1 MAR 73	MGM

%3.2%	GLOBAL BIND H1LEV=1;	!MODULE VERSION NUMBER


%3.1%	GLOBAL ROUTINE BLOCKPURGE(BLK)=
    BEGIN LOCAL L1,L2,L3,L4,FLDI;
	EXTERNAL XREFERASE;
%5.200.12%	LOCAL REALFSH,REALFSJ;
       EXTERNAL DUMPMACRO,IDERROR;
      !
      !  THIS ROUTINE PURGES THE SYMBOL TABLE OF ENTRIES MADE
      !  AT THE CURRENT BLOCKLEVEL, RELEASING SPACE AS IT DOES
      !  SO.  THE FOLLOWING SPECIAL CASES OCCUR:
      !        (1) MACRO ENTRIES: ALSO DELETE THE MT ENTRY
      !        (2) FORWARD ENTRIES: DELETE FROM ST, DON'T RELEASE SPACE
      !        (3) DECLARED REGISTERS: RELEASE THE REGISTERS TOO
      !        (4) MAPPED SYMBOLS: RELEASE THE INCARNATION ACTUALS
      !

      FLDI_.REALFS;
%5.200.12%	REALFSJ_0;	!REALFS STE NOT ENCOUNTERED
      INCR I FROM 0 TO 124 DO
        BEGIN
          L1_.HT[.I];
          IF .L1 NEQ 0 THEN
	WHILE
%5.200.12%	.L1 NEQ 0 AND
           .(L2_ST[.L1,0])<BLF> GTR .BLK DO
            BEGIN
%5.200.31%      IF .XREFLG THEN (IF .L1 EQL .FLDI THEN XREFERASE_1; XEOB(.L1));
	      L4_.ST[.L1,0]<LINKF>;
              IF (L2_.(@L2)<TYPEF>) EQL MACROT THEN
               DUMPMACRO(.L1);   !DELETE MACRO DEFINITION
		IF .L2 EQL REGT THEN
		  (L3_.ST[.L1,1]; RELREG(GETLITVAL(.L3<ADDRESSF>)<LINKF>,
		             .L3<NRF>));
		IF .L1 EQL .FLDI THEN
		    IF .ST[.L1,0]<TYPEF> EQL MACROT THEN PUNT(#775) ELSE
			BEGIN
			HT[.I]_.L4; FUTSYM_0;
%5.200.12%		REALFSH_.L4;	!REMEMBER WHERE WE PUT HT[.I]
			 ACCUM_.ST[.L1,2]; (ACCUM+1)_.ST[.L1,3];
			IDFIXER(-1,0);
%5.200.12%		REALFSJ_.HT[.I];	!SEE IF HT[.I] CHANGED
%5.200.12%		FLDI_.REALFS		!WE COULD DO THIS RATHER OFTEN
			END;
	     IF .L2 EQL FORWT THEN IDERROR(0,.L1);

             % MUST RELEASE LEXEME STREAMS FOR STRUCTURES. %
             IF .L2 EQL STRT THEN
               (IF .ST[.L1,1]<SIMBITAF> THEN
                   RELSTRLIST(.ST[.L1,1]<LXTEAF>);
                IF .ST[.L1,1]<SIMBITSF> THEN
                   RELSTRLIST(.ST[.L1,1]<LXTESF>)
               );
             IF MAPPABLE(.L2) AND (.ST[.L1,1]<STRF> NEQ 0) THEN RELINCA((.ST[.L1,1]<STRF>));
             IF NOT(((1^MACROT+1^EXTRNT+1^GLOBALT+1^GROUTINET+1^ROUTINET+
                 1^GABSOLUTET+1^FUNCT+1^GPLITT)^(-.L2))  OR
%2.27%                (.L2 EQL STRT AND NOT .ST[.L1,1]<SIMBITAF>))
                   THEN (GTUPDATE(0,LSM OR .L1);RELEASESPACE(.L1,2));
	        L1_.L4;
            END;
%5.200.12%	IF .REALFSJ NEQ 0
%5.200.12%	THEN ( IF .REALFSH NEQ .REALFSJ
%5.200.12%		THEN ST[.REALFSJ,0]<LINKF>_.L1
%5.200.12%		ELSE HT[.I]_.L1;
%5.200.12%		REALFSJ_0)	! RE-INITIALIZE
%5.200.12%	ELSE 
          HT[.I]_.L1;
        END;
    END;

FORWARD SETUPOFF,FIXUPOFF,PLITSCAN,FIXPLITOFF;
GLOBAL ROUTINE GOFFSET(X)=
!  5.200.33 ......  MOVED FROM CN1 TO BE WITH ITS NEW FRIENDS IN A SHORTER MODULE
	BEGIN
	LOCAL L;
	EXTERNAL EXTFOROFF,BLKFOROFF,SETUPOFF,JNKFOROFF;
	IF NOT NAMP(.X)
	THEN RETURN (
		WARNEM(.NSYM,ERSMBSVNAME);ZERO
		);
	IF (.ST[.X<STEF>,0]<TYPEF> EQL LOCALT)
	THEN RETURN (
		IF .BLKFOROFF NEQ .TRBLEVEL THEN SETUPOFF();
			L_GETSPACE(1);
			ST[.L,0]_EXPRT^16+1^15;
			ST[.L,1]_.EXTFOROFF^18+
				.ST[.X<STEF>,1]<0,18>;	!-1-.NOSVR;
			ST[.L,0]<LINKF>_.JNKFOROFF;
			JNKFOROFF_.L;
		.L OR LSM
			);
	IF (.ST[.X<STEF>,0]<TYPEF> EQL FORMALT)
	THEN RETURN  (
		LITLEXEME(.ST[.X<STEF>,1]<0,15>+#7777777^15)
			);
	RETURN (
		WARNEM(.NSYM,ERSMBSVNAME);ZERO
			);
	END;
! ...... 5.200.33

GLOBAL ROUTINE SETUPOFF=
	BEGIN
	GLOBAL EXTFOROFF,BLKFOROFF,STKFOROFF,JNKFOROFF;
	!CALLED BECAUSE NO SPECIAL EXTERNAL EXISTS FOR THE
	!CURRENT BLOCK
	LOCAL S;

	! STACK THE PREVIOUS STATE

	S_GETSPACE(2);
	CT[.S,0]_.BLKFOROFF;
	CT[.S,3]_.EXTFOROFF;
	CT[.S,1]_.STKFOROFF;
	CT[.S,2]_.JNKFOROFF;
	STKFOROFF_.S;

	! BUILD A NEW CURRENT STATE

	EXTFOROFF_GETSPACE(1);
	ST[.EXTFOROFF,0]_EXTRNT^16+1^15;
	ST[.EXTFOROFF,1]_#777777;
	JNKFOROFF_0;
	BLKFOROFF_.TRBLEVEL;
	END;

GLOBAL ROUTINE FIXUPOFF(H)=
	BEGIN
	EXTERNAL STKFOROFF,BLKFOROFF,EXTFOROFF,JNKFOROFF;
	LOCAL L1,L2,L3;

	IF .TRBLEVEL GTR .BLKFOROFF THEN RETURN;

! FIXUP THE "SPECIAL" EXPRS IN CODETABLE, PLIT-TABLE, PT-TABLE
! THEN POP THE OFFSET STACK.

! FIXUP THE PLIT-TABLE

	PLITSCAN(.PLHEAD,FIXPLITOFF,.FNSTAT);

! FIX THE PT-TABLE

	DECR I FROM PTMASK+1 TO 0 DO
	    IF .PT[.I,0]<RELOCF> EQL EXPRELOC THEN
		IF .CT[.PT[.I,1]<0,15>,1]<18,15> EQL .EXTFOROFF
		    THEN (	PT[.I,0]<RELOCF>_NORELOC;
				PT[.I,1]<0,18>_.CT[.PT[.I,1]<0,15>,1]<0,18> - .FNSTAT);

! FIX THE CODE

	L1_.CT[.H,1]<NEXTF>;	!CODE HEADER
	UNTIL (.L1 EQL .H) DO
		BEGIN
		IF .CT[.L1,0]<RELOCF> EQL EXPRELOC
		THEN IF .CT[.CT[.L1,1]<0,15>,1]<18,15> EQL .EXTFOROFF
		THEN (	CT[.L1,0]<RELOCF>_NORELOC;
			CT[.L1,1]<0,18>_
			.CT[.CT[.L1,1]<0,15>,1]<0,18>-.FNSTAT);
		L1_.CT[.L1,0]<NEXTF>
		END;

!POP THE STACK

	! RELEASE THE JUNK NOW

	RELEASESPACE(.EXTFOROFF,1);
	L1_.JNKFOROFF;
	WHILE (.L1 NEQ 0) DO
	(L2_.ST[.L1,0]<LINKF>;
	RELEASESPACE(.L1,1);
	L1_.L2);

	L1_.STKFOROFF;
	EXTFOROFF_.CT[.L1,3];
	BLKFOROFF_.CT[.L1,0];
	STKFOROFF_.CT[.L1,1];
	JNKFOROFF_.CT[.L1,2];
	RELEASESPACE(.L1,2);

	END;

GLOBAL ROUTINE FIXPLITOFF(J,DELTA)=
	BEGIN
	EXTERNAL EXTFOROFF;
	LOCAL L;
	IF .CT[.J,0]<RELOCF> EQL EXPRELOC
	THEN IF .ST[L_.CT[.J,1]<0,15>,1]<18,15> EQL .EXTFOROFF
	THEN
		(CT[.J,0]<RELOCF>_NORELOC;
		CT[.J,1]<0,15>_.ST[.L,1]<0,15>-.DELTA);
	END;

GLOBAL ROUTINE PLITSCAN(H,R,A)=
	BEGIN
	LOCAL J;
	J_.CT[.H,1]<NEXTF>;
	WHILE .J NEQ .H DO
		BEGIN
		IF HEADERP(.J) THEN PLITSCAN(.J,.R,.A)
				ELSE (.R)(.J,.A);
		J_.CT[.J,0]<NEXTF>
		END
	END;
!END OF H1LEXA.BLI
   