!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:	LOXREF.BLI
!DATE:		24 MAY 73	MGM/FLD

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




%



				BLISS
			CROSS-REFERENCE MODULE
			----------------------

					C. WEINSTOCK
					DEC.  1970



%




MACRO TRUE=1$;
! *** ***  XREF ENTRY  *** ***


!	+-----------------------------------------+
!	!					  !
!	!		   XID1			  !
!	!					  !
!	+-----------------------------------------+
!	!					  !
!	!		   XID2			  !
!	!					  !
!	+-----------------------------------------+
!	!		     !			  !
!	!	XCBL	     !	     NXREF	  !
!	!		     !			  !
!	+-----------------------------------------+
!	!		     !			  !
!	!	XFLAG	     !	     DBLK	  !
!	!		     !			  !
!	+-----------------------------------------+



!	+-----------------------------------------+
!	!		     !			  !
!	!	DTPTR	     !	     DBPTR	  !
!	!		     !			  !
!	+-----------------------------------------+
!	!		     !			  !
!	!	DLINE	     !	     DBKWD	  !
!	!		     !			  !
!	+-----------------------------------------+
!	!		     !			  !
!	!	DBLEV	     !	     DFWRD	  !
!	!		     !			  !
!	+-----------------------------------------+
!	!		     !			  !
!	!	DFLAG	     !	     DSUBS	  !
!	!		     !			  !
!	+-----------------------------------------+




%
BLISS CROSS-REFERENCE INTERFACES WITH THE BLISS 
COMPILER AT FIVE POINTS.

1.	IN THE INITIALIZATION PHASE WHERE SWITCHES ARE SET

2.	IN THE SYMBOL TABLE INSERT ROUTINE

3.	IN THE SYMBOL TABLE LOOKUP ROUTINE

4.	IN THE END OF BLOCK ROUTINE
5.	BEFORE BLISS EXITS - TO PRINT OUT CROSS-REFERENCE

THE ROUTINE THAT INTERFACES AT THE SYMBOL TABLE

INSERT ROUTINE IS CALLED XREFINS. IT TAKES ONE PARAMETER
THE ADDINFO PARAMETER TO STINSERT. IT WORKS AS FOLLOWS:

1.	USE THE HASH FUNCTION TO FIND THE PROPER INDEX
	INTO XHT (XREF HASH TABLE).

2.	USING ROUTINE XFIND, SEE IF THE XREF TABLE ALREADY
	HAS AN XREF ENTRY FOR .ACCUM AND .ACCUM+1
3.	IF ONE DOES NOT EXIST, CREATE ONE, GOTO 8.
4.	IF ONE DOES EXIST, FIND MOST RECENT
	DECLARATION BLOCK FOR IT. (THE MOST RECENT DECLARATION
	BLOCK IS THAT FOUND BY SEARCHING DOWN DSUBS OR DBLK
	FOR THE LAST ONE WITHOUT THE END-OF-SCOPE FLAG ON.)
5.	IF NO SUCH DECLARATION BLOCK IS FOUND, LINK A NEW
	DECLARATION BLOCK ONTO THE TOP LEVEL LIST. (THIS IS
	DONE BY CAUSING DBLK TO POINT TO IT AND THE OLD VALUE
	OF DBLK GOES TO DFWRD).
6.	IF ONE IS FOUND, COMPARE BLOCKLEVELS AND IF EQUAL,
	SET ON DUPLICATE FLAG ON OLD ONE.
7.	LINK NEW DECLARATION BLOCK ONTO CHAIN POINTED TO
	BY DSUBS OF CURRENT DECLARATION BLOCK.
8.	IF .ADDINFO NEQ 0 THEN SET DLINE=.LINCNT.
9.	RETURN

THE ROUTINE THAT INTERFACES AT THE SYMBOL TABLE

LOOKUP ROUTINE IS CALLED XLINE.  IT TAKES NO
PARAMETERS.  IT ASSUMES THAT IF IT CANT FIND THE
SYMBOL BEING USED, IT WILL BE UNDECLARED BY BLISS
IT WORKS AS FOLLOWS:

1.	USE THE HASH FUNCTION TO FIND THE PROPER INDEX
	INTO XHT.
2.	USE XFIND TO FIND ENTRY.
3.	USE XDFIND TO FIND MOST RECENT ENTRY.
4.	IF THE MOST RECENT ENTRY IS THE XREF ENTRY OR
	IF THE XREF ENTRY DOESNT EXIST, EXIT
5.	IF IT DOES EXIST FIND LINE BLOCK POINTED TO BY
	DBPTR.
6.	IF IT EXISTS, FIND FREE ENTRY. IF NO FREE ENTRY, 0R
	DOESNT EXIST, LINK NEW ONE ON CHAIN AND SET CELL1 TO
	LINCNT.

THE ROUTINE THAT SETS UNDECLARED FLAGS AT BLOCKEND
IS CALLED XEOB.  IT TAKES ONE PARAMETER, THE POINTER
TO THE SYMBOL TABLE ENTRY WITH THE NAME IN IT
IT WORKS AS FOLLOWS:

1.	FIND SYMBOL IN XT
2.	FIND CURRENT USAGE.
3.	SET FLAG
4.	EXIT - NOTE, SINCE THE DUPLICATE IS  ON FWRD CHAIN,
	WE NEED ONLY PURGE FIRST OCCURRANCE
%
ROUTINE XDFIND(PTR) =
	BEGIN
	LOCAL T1;
	WHILE .XT[.PTR,3]<0,18> NEQ 0 DO
		IF NOT (T1_.XT[.PTR,3]<0,18>; .XT[.T1,3]<19,1>) THEN
		    PTR_.T1 ELSE EXITLOOP;
	RETURN .PTR
	END;

ROUTINE XFIND(X,Y,Z) =
	BEGIN
	WHILE .X NEQ 0 DO
		IF .XT[.X,0] EQL .Y AND .XT[.X,1] EQL .Z THEN
		RETURN .X ELSE X_.XT[.X,2]<0,18>;
	RETURN 0
	END;

! XREFTYPE IS CALLED FROM DECSYM,DECSYQ AND THE OTHER
! DECLARATORY SPOTS.  IT STORES THE TYPE IN THE DECL-XREF NODE
! THIS CAUSES A DESCRIPTIVE FIELD TO PRINT IN THE TYP COLUMN
! (SEE XR3N.BLI)

GLOBAL ROUTINE XREFTYPE(TYPE)=
	BEGIN
	EXTERNAL XLASTNAMEX;
	LOCAL L1,L2;
	L1=.XLASTNAMEX;
	L2=XDFIND(.L1);
	XT[.L2,3]<29,6>=.TYPE
	END;
%5.200.30%	EXTERNAL XLASTNAMEX;

%5.200.30 ....%  GLOBAL ROUTINE XUNFORWT=
		BEGIN
		GLOBAL XLASTNAMEX;
		LOCAL T1,T2,T3;
		T3_.XLASTNAMEX;	! SET BY LAST XREFINS OR XLINE
		IF .XT[.T3,3]<18,18> NEQ 0 THEN
			(XT[.T3,3]<18,18>_-.XT[.T3,3]<18,18>;
			RETURN);
		T2_XDFIND(.T3);
		 XT[.T2,1]<18,18>_-.XT[.T2,1]<18,18>;
%... 5.200.30%	END;

%3.1%	GLOBAL ROUTINE XREFINS(LEX) =  
	BEGIN
	LOCAL T1,T2,T3;
%MERGE%	IF .ACCUM EQL 0 THEN RETURN 0;
	T2_HASH(.ACCUM); 	! FIND ENTRY IN XHT
	T1_.XHT[.T2];	! POINT AT FIRST XREF ENTRY HERE
	IF (T1_XFIND(.T1,.ACCUM,.(ACCUM+1))) EQL 0 THEN 	! IF XREF ENTRY DOESN'T EXIST YET
		BEGIN		! CREATE IT
		T1_GETSPACE(2);
%5.200.30%	XLASTNAMEX_.T1;
		XT[.T1,2]<0,18>_.XHT[.T2];	! LINK NEW
		XHT[.T2]_.T1;	! ENTRY ON CHAIN
		XT[.T1,0]_.ACCUM;	! INITIALIZE
		XT[.T1,1]_.(ACCUM+1);
		XT[.T1,2]<18,18>_.BLOCKLEVEL;
		T2_GETSPACE(2);	! SET UP A DECLARATION BLOCK
		XT[.T1,3]<0,18>_.T2;	! LINK ON
		END
	ELSE
		BEGIN
%5.200.30%	XLASTNAMEX_.T1;
		XT[.T1,2]<18,18>_.BLOCKLEVEL;
		XT[.T1,3]<18,18>_0;	! CLEAR PENDING LINE ********
		T1_XDFIND(.T1);		! FIND CURRENT OF
						! SAME BLOCK LEVEL
		T2_GETSPACE(2);	! SET UP A DECLARATION BLOCK
		T3_.XT[.T1,3]<0,18>;	! INIT USED VALUE
		IF .XT[.T1,3]<18,18> LSS 0 THEN
			IF .XT[.T1,2]<18,18> EQL .BLOCKLEVEL THEN
			XT[.T1,3]<18,1> _ TRUE;	! SET DUP FLAG
		XT[.T2,2]<0,18>_.T3;		! SET FORWARD LINK
		IF .XT[.T2,2]<0,18> NEQ 0 THEN XT[.XT[.T2,2]<0,18>,1]<0,18>_.T2;
					! SET BACKWARD LINK
		XT[.T1,3]<0,18>_.T2;	! SET SUBSIDIARY LINK
		END;	! AT THIS POINT STEPS 1 THROUGH 7 DONE
	XT[.T2,2]<18,18>_.BLOCKLEVEL;
        XT[.T2,3]<35,1>_TRUE;
		XT[.T2,1]<18,18>_.LINCNT;
	RETURN 0;
	END;

%3.1%	GLOBAL ROUTINE XLINE =
	BEGIN
	LOCAL T1,T2,T3;
	T2_HASH(.ACCUM);	! FIND ENTRY IN XHT
	IF (T3_.XHT[.T2]) EQL 0 THEN RETURN;
	IF (T3_XFIND(.T3,.ACCUM,.(ACCUM+1))) EQL 0 THEN RETURN;
%5.200.30%	XLASTNAMEX_.T3;
	IF .XT[T1_XDFIND(.T3),3]<18,18> EQL 0 THEN RETURN;

	!IF WE HAVE PURGED THE XT ENTRY, SIMPLY RETURN.
	!SOMETIMES XEOB CALLS XLINE IN THIS CASE FROM BLOCKPURGE
	!WHEN THE SYMBOL TO BE PURGED IS ONE THAT REMAINS PERMANENTLY
	!IN THE SYMBOL TABLE SUCH AS A GLOBALT SYMBOL.
	!XEOB ATTEMPTS TO PURGE IT FROM THE XT AT EVERY OUTER BLOCK
	!EXIT

	IF .T1 EQL .T3 THEN IF .XT[.T1,3]<19,1> THEN RETURN;

! 5.200.31   IF .LINCNT NEQ 0 THEN XNCBUFF_.NCBUFF;
	IF .XT[.T3,3]<18,18> EQL 0 THEN
		( XT[.T3,3]<18,18>_.LINCNT;RETURN);
	IF .XT[.T1,0]<0,18> NEQ 0 THEN
		BEGIN
		IF .XT[.XT[.T1,0]<0,18>,0]<18,18> GTR 3 THEN
			BEGIN
			T2_GETSPACE(1);
			XT[.XT[.T1,0]<0,18>,0]<18,18>_.T2;
			XT[.T1,0]<0,18>_.T2;
			XT[.T2,0]<18,18>_2;
			XT[.T2,0]<0,18>_.XT[.T3,3]<18,18>;
			XT[.T3,3]<18,18>_.LINCNT;
			END
		ELSE	BEGIN
			XT[.XT[.T1,0]<0,18>,1]<0,0><(IF .XT[.XT[.T1,0]<0,18>,0]<18,18> EQL 2 THEN 18
				ELSE 0),18>_.XT[.T3,3]<18,18>;
			XT[.T3,3]<18,18>_.LINCNT;
			XT[.XT[.T1,0]<0,18>,0]<18,18>_.XT[.XT[.T1,0]<0,18>,0]<18,18>+1;
			END;
		END
	ELSE	BEGIN
		T2_GETSPACE(1);
		XT[.T1,0]<18,18>_.T2;
		XT[.T1,0]<0,18>_.T2;
		XT[.T2,0]<18,18>_2;
		XT[.T2,0]<0,18>_.XT[.T3,3]<18,18>;
		XT[.T3,3]<18,18>_.LINCNT;
		END;
	END;

%3.1%	GLOBAL ROUTINE XEOB(PTR) =
	BEGIN
	EXTERNAL XREFERASE;
	LOCAL T1,T2,T3,T4,T5;
	T2_HASH(.XT[.PTR,2]);		! FIND DISP TO XHT
	T1_.XHT[.T2];	! FIND XT ENTRY
	T1_XFIND(.T1,.XT[.PTR,2],.XT[.PTR,3]);
	IF .T1 EQL 0 THEN RETURN;
! 5.200.31	IF .NCBUFF EQL .XNCBUFF
%5.200.31%	IF .XREFERASE
%5.200.31%	THEN (XT[.T1,3]<18,18>_0; XREFERASE_0) ELSE
		(T3_.LINCNT;LINCNT_0;T4_.ACCUM;T5_.(ACCUM+1);
		 ACCUM_.XT[.PTR,2];ACCUM+1_.XT[.PTR,3];XLINE();
		 LINCNT_.T3;ACCUM_.T4;ACCUM+1_.T5);
	XT[.T1,2]<18,18>_.BLOCKLEVEL;
	T1_XDFIND(.T1);			! FIND OPEN ENTRY
	XT[.T1,3]<19,1>_TRUE;		! SET PURGED BIT
	RETURN
        END;



!END OF LOXREF.BLI