!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
		EXTERNAL OUTPUT;
!FILENAE:	H3XREF.BLI
!DATE:		10 JULY 73	MGM/FLD

%3.2%	GLOBAL BIND H3XRV=2;	!MODULE VERSION NUMBER

	OWN NUMPLINE,		! NUMBER OF ENTRIES PER LINE
	    NUMTLINE;		! NUMBER OF ENTRIES ALREADY ON THIS LINE


FORWARD XINS,XPRINLEV;
ROUTINE XSORT =
	BEGIN
	LOCAL T1,T2,T3;
	INCR I FROM 0 TO HTSIZE -1 DO 
		IF (T1_.XHT[.I]) NEQ 0 THEN
		BEGIN
		XHT[.I]_0;
	DO (
		XINS(.T1);
		T1_.XT[.T1,2]<0,18>;
	   ) UNTIL .T1 EQL 0;
		END;
	END;

ROUTINE XFIX(PTR)=
	BEGIN
	LOCAL T1;
	T1_XT[.PTR,-1]<1,7>;
	INCR I FROM 1 TO 10 DO IF SCANI(T1) EQL #177 THEN
		REPLACEN(T1,0);
	END;

ROUTINE XOUTSTN(I)=
	IF NOT .LSTFLG THEN
	BEGIN EXTERNAL OUTPUT; LOCAL P,N,C; MACHOP ILDB=#134;
	P_ST[.I,-1]<1,7>; N_0;
	WHILE (C_ILDB(3,P)) NEQ 0 AND .N LSS 10 DO (OUTPUT(2,.C);N_.N+1);
	.N
	END;
ROUTINE XINS(PTR)=
	BEGIN
	LOCAL T1,T2,T3;
	XFIX(.PTR);	! CLEAN UP RUBOUTS
	IF .XHED EQL 0 THEN (XHED_.PTR; XT[.PTR,3]<18,18>_0;RETURN);
	IF .XT[.PTR,0] LSS .XT[.XHED,0] THEN
		(XT[.PTR,3]<18,18>_.XHED;XHED_.PTR;RETURN);
	IF .XT[.PTR,0] EQL .XT[.XHED,0] THEN
		IF .XT[.PTR,1] LSS .XT[.XHED,1] THEN
		(XT[.PTR,3]<18,18>_.XHED; XHED_.PTR; RETURN);
	T1_.XHED;
	DO (T2_.T1; T1_.XT[.T1,3]<18,18>) UNTIL
	   (IF .T1 EQL 0 THEN 1 ELSE IF .XT[.PTR,0] EQL .XT[.T1,0] THEN
		.XT[.PTR,1] LSS .XT[.T1,1] ELSE
		.XT[.PTR,0] LSS .XT[.T1,0]);
	XT[.PTR,3]<18,18>_.T1;
	XT[.T2,3]<18,18>_.PTR;
	END;

ROUTINE XNEWTIT=
	BEGIN
	EXTERNAL XR2COMPACT;
	LOCAL GOAL;
	IF .XR2COMPACT THEN
	    BEGIN
	    OUTSTR("Modul",5);
	    OUTSTR("e    ",5);
	    OUTSTR("  ",2);
	    END;
	OUTSTR("Ident",5);
	OUTSTR("ifier",5);
	OUTSTR(" BL  ",5);
	OUTSTR("Decl ",5);
!5.200.41 .....
	OUTSTR("TYP U",5);
	OUTSTR("SED",3);
! ..... 5.200.41
	NEWLINE();
	IF .XR2COMPACT
	    THEN GOAL=8
	    ELSE GOAL=6;
	INCR I FROM 1 TO .GOAL DO OUTSTR("-----",5);
	END;

ROUTINE XNEWLINE=
	BEGIN
	NEWLINE();
	IF .NLINES EQL 0 THEN (XNEWTIT();NEWLINE());
	END;

!5.200.40 .....
ROUTINE XR2TIT=
	BEGIN
	INCR I FROM 1 TO 10 DO OUTSTR("!XREF",5);
	NEWLINE();
	END;
! .... 5.200.40

ROUTINE XPRINT(X,Y) =
	BEGIN
%5.200.30 .... %
	ROUTINE OUTNUMITEM(N)=
		BEGIN
		IF .N<17,1> THEN (N_-(.N+#777777^18);CHAR_"R")
			    ELSE CHAR_" ";
	%3.20%	OUTNUM(.N/16,10,5,0);OUTPUT(2,.CHAR)
		END;

% ... 5.200.30%

! 5.200.40 ...
	EXTERNAL XR2COMPACT,XR3COMPACT;

	ROUTINE OUTXID(X,Y)=
	BEGIN

! 5.200.41 ....	TO PRINT OUT DECLARED TYPES

	LOCAL DTYP;
	BIND DECLTYP=PLIT(
		" UNK"," NIL"," GLO"," OWN"," EXT",
		" LOC"," BND"," PRM"," RTN"," EXP",
		" G-R"," FUN"," S-F"," PLT"," LBL",
		" FWD"," REG"," G-A"," G-P","    ",
		4:"   "," STR",
		" MCR"," LXM",3:"   ",
		"    ","    "," MCH"," SPF"," ABS",
		" SPU"," PTR"," LNK");
! .....  5.200.41

! ... 5.200.40

	LOCAL T1,T2,T3;
	XNEWLINE();
	NUMTLINE=0;
! 5.200.40 ...
	IF .XR2COMPACT THEN
		(XOUTSTN(.XR3COMPACT);OUTBLANK(2));
! .... 5.200.40
	OUTBLANK(11-XOUTSTN(.X));
%3.20%	OUTNUM(.XT[.Y,2]<18,18>-1,10,2,0);	! BLOCKLEVEL
	OUTBLANK(1);
	IF (T1_.XT[.Y,1]<18,18>) NEQ 0 THEN 
%5.200.30% %5.200.41 ...%	BEGIN
				IF .T1<17,1> THEN T1_-(.T1 +#777777^18);
				OUTNUM(.T1/16,10,5,0)
				END
% .... 5.200.41 %
	ELSE
%5.200.30% %5.200.41%	(OUTSTR("*****",5)%;OUTPUT(2," ")%);
! 5.200.41%5.200.30%	OUTBLANK(2);
%5.200.41 ...%
		DTYP=.XT[.Y,3]<29,6>;
		OUTSTR(.DECLTYP[.DTYP],4);
% .... 5.200.41%
%5.200.40%	END;	!END OF OUTXID


	ROUTINE XOUTNITEM(X,Y)=
	    BEGIN
	    IF .X EQL 0 THEN RETURN .VREG;
	    IF .NUMTLINE EQL .NUMPLINE
		THEN IF .XR2COMPACT
		    THEN OUTXID(.X,.Y)
		    ELSE (XNEWLINE(); NUMTLINE=0; OUTBLANK(23));
	    NUMTLINE=.NUMTLINE+1;
	    OUTNUMITEM(.X);
	    .VREG
	    END;


	LOCAL NODEPNT;

! CODE FOR XPRINT BEGINS HERE ................
	OUTXID(.X,.Y);		! PRINT THE TITLE THE FIRST TIME
	NODEPNT=.XT[.Y,0]<18,18>;
	WHILE .NODEPNT GTR 4 DO
	    BEGIN
	    XOUTNITEM(.XT[.NODEPNT,0]<0,18>,.Y);
	    XOUTNITEM(.XT[.NODEPNT,1]<18,18>,.Y);
	    XOUTNITEM(.XT[.NODEPNT,1]<0,18>,.Y);
	    NODEPNT=.XT[.NODEPNT,0]<18,18>;
	    END;
	.VREG
	END;
ROUTINE XSELECT=
	BEGIN
	LOCAL T1,T2,T3;
	T1_.XHED;
	WHILE .T1 NEQ 0 DO (XPRINLEV(.T1,.XT[.T1,3]<0,18>);
		T1_.XT[.T1,3]<18,18>);
	END;

ROUTINE XPRINLEV(X,Y) =
	BEGIN
	LOCAL T1,T2,T3;
	WHILE .XT[.Y,2]<0,18> NEQ 0 DO Y_.XT[.Y,2]<0,18>;
	WHILE .Y NEQ 0 DO
		BEGIN
		XPRINT(.X,.Y);
		IF .XT[.Y,3]<0,18> NEQ 0 THEN XPRINLEV(.X,.XT[.Y,3]<0,18>);
		Y_.XT[.Y,1]<0,18>;
		END;
	END;


%3.1%	GLOBAL ROUTINE XREFWRITE =
	BEGIN
! 5.200.40
	GLOBAL XR1COMPACT;	! SET TO 1 BY /Q
	GLOBAL XR2COMPACT;	! SET TO XR1COMPACT BY /C
	GLOBAL XR3COMPACT;	! HOLDS INDEX TO STE WITH SOURCE NAME
	EXTERNAL IOBUFF;
	LOCAL P1,P2,CH;
	XR2COMPACT_.XR1COMPACT;	!=1 FOR COMPACT XREF LISTING
	XR1COMPACT_0;	!RESET
	NUMPLINE=(IF .XR2COMPACT
	    THEN 15
	    ELSE 17);

	XR3COMPACT_GETSPACE(1);
	
	P1_(IOBUFF+#112-1)<1,6>;
	P2_(ST[.XR3COMPACT,0]-1)<1,7>;
	INCR I FROM 1 TO 10
		DO (REPLACEI(P2,#40));
	P2_(ST[.XR3COMPACT,0]-1)<1,7>;
	INCR I FROM 1 TO 6
		DO (CH_SCANI(P1); IF .CH EQL 0 THEN EXITLOOP; REPLACEI(P2,.CH+#40));

! ... 5.200.40
	PAGE(); NLINES_0;
%5.200.40% IF .XR2COMPACT THEN XR2TIT();
	XNEWTIT();
	XHED_0;
	XSORT();
	XSELECT();
%5.200.40%  XR2COMPACT_0;
	END;


!END OF H3XREF.BLI
    