!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

!COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: S. MURPHY
MODULE DEBUG(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4)=
BEGIN
	SWITCHES NOLIST;
	REQUIRE FIRST.BLI;
	REQUIRE TABLES.BLI;
	SWITCHES LIST;

	GLOBAL BIND DEBUV=2^18+36;	!VERSION DATE: 20-JUNE-1974
%(REVISION HISTORY
34	-----	-----	MOVE THE ROUTINE "DMPRLBLOCK" OUT OF THIS
			MODULE INTO THE MODULE "RELBUF"
35	-----	-----	CHECK THE FLAG "DBGDIMN" TO DETERMINE WHETHER
			TO DUMP ARRAY DIMENSIONS FOR FORDDT
36	-----	-----	ADD THE ROUTINES "INIFDDT" AND "XCTFDDT" TO GENERATE
			"XCT FDDT." WHEN THE "TRACE" OPTION OF THE 
			DEBUG SWITCH WAS SPECIFIED BY THE USER
)%


%(**********************************************
	THIS MODULE CONTAINS ROUTINES FOR OUTPUTING DEBUGGING INFORMATION
	TO THE REL FILE.
	THIS INCLUDES:
		1. ROUTINES TO OUTPUT A LABEL FOR EACH SOURCE LINE
		2. ROUTINES TO OUTPUT DIMENSION INFORMATION FOR ARRAYS
**********************************************)%



%(******DEFINE A BUFFER FOR A 20 WD REL FILE BLOCK THAT WILL HOLD SYMBOL
	DEFINITIONS FOR THE LABELS GENERATED FOR EACH SOURCE LINE***)%
OWN ISNRELBLOCK[20];

STRUCTURE SYMRELBLOCK[IX,WD,POS,SIZE]=	!STRUCTURE FOR A REL FILE BLOCK FOR
					! SYMBOL DEFINITIONS (BLOCK TYPE 2)
					! THE DEFINTION FOR THE NTH SYMBOL IN THE
					! BLOCK WILL BE REFERENCED USING "IX"=N
	(.SYMRELBLOCK+2+2*(.IX-1)+.WD)<.POS,.SIZE>;

MACRO	RBTYPE=0,0,LEFT$,	!BLOCK TYPE IS IN LEFT HALF OF THE 1ST WD OF THE BLOCK
	RBWDCT=0,0,RIGHT$,	!NUMBER OF WORDS IN THE BLOCK (NOT COUNTING THE 2 HEADER WDS)
	RBRELWD=0,1,WHOLE$,	!THE 2ND WORD OF THE BLOCK CONTAINS RELOCATION INFO

	RBSYMBOL=0,0,32$,	!FOR THE "IX"TH SYMBOL, THE SYMBOL IN RADIX 50 IS
				! IN BITS 4-35 OF THE 1ST WD OF THE ENTRY FOR THAT SYMBOL
	RBSYMTYP=0,32,4$,	!FOR THE "IX"TH SYMBOL, THE TYPE OF SYMBOL IS SPECIFIED
				! BY BITS 0-3 OF THE 1ST WD OF THE ENTRY FOR THAT SYMBOL
	RBSYMVAL=1,WHOLE$;	!FOR THE "IX"TH SYMBOL, THE VALUE OF THAT SYMBOL
				! IS IN THE 2ND WD OF THE ENTRY FOR THAT SYMBOL


BIND SYMDEFBLOCK=#2;	!BLOCK TYPE FOR A SYMBOL DEFINITION REL FILE BLOCK
BIND LOCSYMTYP=#2;	!IN A SYMBOL-DEF REL FILE BLOCK, THE SYMBOL TYPE FOR "LOCAL SYMBOL"





OWN ISNCT;	!NUMBER OF LABELS IN THE BUFFER "ISNRELBLOCK"
OWN PRVISNX;	!THE LAST ISN FOR WHICH WE GENERATED "XCT FORDDT"
OWN FDDTSYM;	!PTR TO SYM TABLE ENTRY FOR "FDDT."
OWN PREVISN;	!THE LAST ISN FOR WHICH WE MADE A LABEL
OWN LPRVISN;	!THE LAST ISN FOR WHICH WE LISTED A LABEL IN THE MACRO-EXPANDED LISTING



GLOBAL ROUTINE INIFDDT=
%(***************************************************************************
	ROUTINE TO INITIALIZE FOR GENERATION OF "XCT FDDT." AT
	THE START OF EACH STMNT THAT STARTS A LINE.
	CALLED IF THE "TRACE" OPTION OF THE DEBUG SWITCH WAS
	SPECIFIED BY THE USER
***************************************************************************)%
BEGIN
	EXTERNAL NAME,ENTRY,TBLSEARCH;
	MAP BASE FDDTSYM;
	PRVISNX_0;	!ISN OF THE LAST STMNT FOR WHICH "XCT FORDDT" WAS GENERATED

	%(**MAKE SYMBOL TABLE ENTRY FOR "FDDT."**)%
	NAME_IDTAB;
	ENTRY[0]_SIXBIT'FDDT.';
	FDDTSYM_TBLSEARCH();
	FDDTSYM[OPERSP]_FNNAME;
END;	!END OF ROUTINE "INIFDDT"


GLOBAL ROUTINE XCTFDDT=
%(***************************************************************************
	ROUTINE TO GENERATE "XCT FDDT." IN FRONT OF EACH SOURCE
	PROGRAM STATEMENT THAT IS THE 1ST STMNT ON A LINE.
	CALLED BEFORE CODE IS GENERATED FOR EACH STMNT IF
	THE FLAG "DBGTRAC" IS SET.
***************************************************************************)%
BEGIN
	EXTERNAL PBOPWD,PSYMPTR,OBUFF;
	BIND XCTOCD=#256;
	EXTERNAL ISN;

	IF .ISN EQL 0 THEN RETURN;	!IF THIS STMNT WAS INSERTED BY THE COMPILER

	IF .ISN EQL .PRVISNX THEN RETURN;	!IF THIS IS NOT THE 1ST STMNT ON THE LINE

	%(**GENERATE "XCT FDDT."**)%
	PBOPWD_XCTOCD^27;
	PSYMPTR_.FDDTSYM;
	OBUFF();	!OUTPUT XCT FDDT. TO THE PEEPHOLE BUFFER
			! (THESE MUST BE GENERATED PRIOR TO PEEPHOLING)

	PRVISNX_.ISN;
END;	!OF ROUTINE "XCTFDDT"


GLOBAL ROUTINE DEFISN(ISN)=
%(***************************************************************************
	ROUTINE TO DEFINE A LABEL FOR THE INTERNAL SEQ NUMBER (IE LINE NUMBER) "ISN"
	AND ASSOCIATE THAT LABEL WITH THE LOCATION OF THE INSTRUCTION CURRENTLY
	BEING WRITTEN TO THE REL FILE.
	THE GLOBAL "HILOC" INDICATES THE LOCATION TO BE USED.
	THE BUFFER "ISNRELBLOCK" IS USED TO BUFFER 9 SUCH LABELS
	AT A TIME BEFORE WRITING THEM TO THE REL FILE (SINCE THE MAXIMUM
	REL FILE BLOCK SIZE IS 20 WDS - 2 HEADER WDS AND
	2 WDS FOR EACH OF THE LABELS)
***************************************************************************)%
BEGIN
	EXTERNAL HILOC;	!LOC OF INSTR CURRENTLY BEING OUTPUT TO REL FILE
	EXTERNAL DMPRLBLOCK;	!ROUTINE TO OUTPUT A BLOCK OF REL CODE
	EXTERNAL RADIX50;	!ROUTINE TO CONVERT LEFT JUSTIFIED SIXBIT TO RADIX 50
	REGISTER LABL;	!USED TO BUILD SIXBIT FOR THE SEQ NUMBER FOLLOWED BY "L"
			! (THIS WILL BE THE LABEL USED)
	REGISTER T1,T2;

	MAP SYMRELBLOCK ISNRELBLOCK;

	IF .ISN EQL 0 THEN RETURN;	!DO NOT GENERATE A LABEL FOR STMNTS INSERTED
					! BY THE COMPILER
	IF .ISN EQL .PREVISN THEN RETURN;	!IF THERE ARE MULTIPLE STMNTS ON A LINE,
					! ONLY GENERATE A LABEL FOR THE FIRST ONE

	ISNCT_.ISNCT+1;	!INCR CT OF LABELS IN THE BUFFER
	PREVISN_.ISN;

	%(***MAKE THE LEFT JUSTIFIED SIXBIT FOR THE ISN FOLLOWED BY "L"***)%
	LABL_0;
	LABL<30,6>_SIXBIT"L";
	T1_.ISN;
	UNTIL .T1 EQL 0
	DO (T2_.T1 MOD 10; T1_.T1/10;
		LABL_.LABL^(-6);	!SHIFT LABEL BUILT SO FAR TO THE RIGHT BY 1 CHAR
		LABL<30,6>_#20+.T2;	!PUT SIXBIT FOR THIS DIGIT
					! INTO LEFTMOST CHAR
	  );


	R2_.LABL; !GLOBAL TO CALL ROUTINE TO CONVERT TO RADIX50
	ISNRELBLOCK[.ISNCT,RBSYMBOL]_RADIX50();	!PUT RADIX50 FOR THE LABEL INTO THE REL BLOCK
	ISNRELBLOCK[.ISNCT,RBSYMTYP]_LOCSYMTYP;	!"TYPE" OF THIS SYMBOL IS "LOCAL"
	ISNRELBLOCK[.ISNCT,RBSYMVAL]_.HILOC;	!VAL OF SYMBOL IS THE REL ADDRESS OF THE CURRENT LOC
	ISNRELBLOCK[RBWDCT]_.ISNRELBLOCK[RBWDCT]+2;	!INCR CT OF WDS IN THE BUFFER


	%(***IF HAVE FILLED THE BUFFER, OUTPUT THIS REL FILE BLOCK AND
		RE-INIT THE BUFFER**)%
	IF .ISNCT EQL 9
	THEN
	BEGIN
		DMPRLBLOCK(ISNRELBLOCK,20);	!OUTPUT THE 20 WDS IN THE BUFFER
		ISNRELBLOCK[RBWDCT]_0;	!INIT CT OF WDS IN THE BUFFER
		ISNCT_0;		!INIT CT OF LABELS
	END;
END;




GLOBAL ROUTINE ENDISNRLBLK=
%(***************************************************************************
	ROUTINE TO DUMP TO THE REL FILE ANY LABELS REMAINING IN THE
	BUFFER USED FOR DEFINING LABELS CORRESPONDING TO EACH LINE.
***************************************************************************)%
BEGIN
	EXTERNAL DMPRLBLOCK;
	IF .ISNCT NEQ 0	!IF THERE ARE ANY LABELS IN THE BUFFER
	THEN
	BEGIN
		%(**IF THERE ARE LESS THAN 9 LABELS IN THE BUFFER(THE
			MAX NUMBER), ZERO THE RELOCATION BITS FOR THE LABELS
			THAT ARENT THERE (WE INITIALIZED THE RELOCATION BITS
			TO INDICATE THAT THE ADDRESSES FOR ALL 9 LABELS SHOULD
			BE RELOCATED.
		*****)%
		INCR I FROM (.ISNCT+1) TO 9
		DO
		(ISNRELBLOCK+1)<36-4*.I,4>_0;

		DMPRLBLOCK(ISNRELBLOCK,2*.ISNCT+2);	!OUTPUT THE CONTENTS OF THE
					! BUFFER TO THE REL FILE
	END;

END;


GLOBAL ROUTINE INIISNRLBLK=
%(***************************************************************************
	ROUTINE TO INITIALIZE THE BUFFER USED FOR DEFINING LABELS
	CORRESPONDING TO EACH LINE.
***************************************************************************)%
BEGIN
	MAP SYMRELBLOCK ISNRELBLOCK;

	ISNRELBLOCK[RBTYPE]_SYMDEFBLOCK;	!THIS REL BLOCK SHOULD BE BLOCK TYPE 2
						! (FOR SYMBOL DEFINITIONS)
	ISNRELBLOCK[RBWDCT]_0;
	ISNRELBLOCK[RBRELWD]_#042104210421;	!RELOCATION WD - INIT TO 0001 FOR THE 4 HALF WDS OF EACH SYM
						! (IE RELOCATE ONLY THE ADDR OF THE SYM)

	ISNCT_0;	!CT OF LABELS IN THE BUFFER
	PREVISN_0;	!THE LAST ISN FOR WHICH A LABEL WAS MADE
	LPRVISN_0;	!THE LAST ISN FOR WHICH A LABEL WAS LISTED IN THE
			! MACRO-EXPANDED LISTING
END;



GLOBAL ROUTINE ZOUDLB=
%(***************************************************************************
	ROUTINE TO INSERT INTO THE MACRO-EXPANDED LISTING
	AN "L" LABEL INSERTED FOR THE FIRST INSTR OF A GIVEN SOURCE LINE.
	THESE LABELS ARE INSERTED WHEN THE USER SPECIFIES THE "DEBUG" SWITCH.
	THIS ROUTINE IS CALLED WITH THE GLOBAL (REGISTER) "R1" SET TO
	THE ISN OF THE STMNT THAT THE
	INSTR CURRENTLY BEING LISTED BEGINS.
***************************************************************************)%
BEGIN
	EXTERNAL LSTOUT,ZOUDECIMAL,HEADCHK;
	IF .R1 EQL .LPRVISN THEN RETURN;	!IF THE PREVIOUS STMNT FOR WHICH WE
				! LISTED A LABEL HAD THE SAME ISN AS THIS STMNT, DONT MAKE A NEW LABEL

	LPRVISN_.R1;

	ZOUDECIMAL();	!LIST THE ISN IN DECIMAL
	CHR_"L"; LSTOUT();	! FOLLOWED BY "L"
	CHR_":"; LSTOUT();	! FOLLOWED BY ":"
	CHR_#15;LSTOUT(); CHR_#12; LSTOUT();		!LIST A CR - LF
	HEADCHK();	!CHECK FOR HEADING
	CHR_#11; LSTOUT(); LSTOUT();	! <TAB> <TAB>
END;





GLOBAL ROUTINE DUMPDIM=
%(***************************************************************************
	ROUTINE TO OUTPUT DIMENSION INFORMATION FOR ALL ARRAYS
	IF THE USER SPECIFIED EITHER THE "BOUNDS" SWITCH (INDICATING
	THAT BOUNDS CHECKING SHOULD BE PERFORMED ON ALL ARRAYS) OR
	THE "DEBUG" SWITCH (INDICATING THAT DEBUGGING INFORMATION SHOULD
	BE PASSED TO FORDDT) WITH THE "DIMENSIONS" OPTION

***************************************************************************)%
BEGIN
	EXTERNAL SYMTBL;
	EXTERNAL CGDIMBLOCK;	!ROUTINE TO OUPUT AN ARGUMENT BLOCK SPECIFYING
				! DIMENSION INFORMATION FOR A GIVEN ARRAY
	REGISTER BASE SYMPTR;

	IF NOT (.FLGREG<DBGDIMN> OR .FLGREG<BOUNDS>)	!UNLESS THE USER SPECIFIED
	THEN RETURN;				! EITHER THE "DEBUG" SWITCH OR THE "BOUNDS" SWITCH
						! DO NOT OUTPUT DIMENSION INFORMATION

	%(***WALK THRU THE SYMBOL TABLE AND OUTPUT DIMENSION INFO FOR EACH
		ARRAY NAME FOUND. (MUST DO THIS SINCE THERE IS NO WAY TO
		DIRECTLY GO THRU THE DIMENSION TABLE)
	***)%
	DECR I FROM SSIZ-1 TO 0
	DO
	BEGIN
		SYMPTR_.SYMTBL[.I];
		UNTIL .SYMPTR EQL 0	!LOOK AT EACH SYMBOL THAT HASHES TO THIS ENTRY
		DO
		BEGIN
			IF .SYMPTR[OPRSP1] EQL ARRAYNM1	!IF THIS IS AN ENTRY FOR AN ARRAY NAME
			THEN
			 CGDIMBLOCK(.SYMPTR);	!OUTPUT THE ARG BLOCK SPECIFYING DIMENSION INFO 
						! FOR THIS ARRAY
			SYMPTR_.SYMPTR[CLINK]
		END
	END
END;






GLOBAL ROUTINE CGDIMBLOCK(SYMPTR)=
%(***************************************************************************
	ROUTINE TO OUTPUT AN ARG BLOCK SPECIFYING THE DIMENSION INFORMATION
	FOR THE ARRAY WHOSE SYMBOL TABLE ENTRY IS POINTED TO BY "SYMPTR".
	THE FORMAT FOR THESE ARG BLOCKS IS:

	-----------------------------------------------------------------
	!		ARRAY NAME IN SIXBIT				!
	-----------------------------------------------------------------
	! DIM CT	! TYPE 	!I!	!  BASE ADDRESS			!
	-----------------------------------------------------------------
	!A!F!				! PTR TO OFFSET (IN WORDS)	!
	-----------------------------------------------------------------
	!				! PTR TO 1ST LOWER BOUND (IN ITEMS)!
	-----------------------------------------------------------------
	!				! PTR TO 1ST UPPER BOUND (IN ITEMS)!
	-----------------------------------------------------------------
	!				! PTR TO 1ST FACTOR (IN WORDS)	!
	-----------------------------------------------------------------
	!				! PTR TO 2ND LOWER BOUND	!

				ETC FOR ALL DIMENSIONS

	WHERE:
		A - IS FLAG FOR "ARRAY IS ADJUSTABLY DIMENSIONED"
		F - IS FLAG FOR "ARRAY IS A FORMAL PARAMETER"
		BASE ADDRESS - IS THE BASE ADDRESS OF THE ARRAY UNLESS THE
			ARRAY IS A FORMAL PARAMETER, IN WHICH CASE "I" IS
			SET, AND BASE ADDRESS POINTS TO THE VARIABLE THAT CONTAINS
			THE BASE ADDRESS
***************************************************************************)%
BEGIN
	EXTERNAL EVALU;		!TABLE OF TYPE CODES
	EXTERNAL PBOPWD,PSYMPTR,OBUFFA;
	MAP BASE SYMPTR;
	MAP OBJECTCODE PBOPWD;	!GLOBAL IN WHICH WD OF CODE TO BE OUTPUT IS SET UP
					! AND PASSED TO THE OUPUT BUFFERING ROUTINE ("OBUFFA")
	MAP BASE PSYMPTR;	!GLOBAL POINTING TO THE SYMBOL TABLE ENTRY FOR THE
				! ADDRESS FIELD OF THE WD OF CODE BEING OUTPUT
	REGISTER BASE DIMPTR;	!PTR TO DIMENSION TABLE ENTRY FOR THE ARRAY
				! FOR WHICH DIMENSION INFORMATION IS BEING OUTPUT
	REGISTER DIMSUBENTRY DIMLSTPTR;	!PTR TO THE SUBENTRY FOR THE
				! DIMENSION BEING OUTPUT

	MACRO AFLAG=0,35,1$,	!BIT USED FOR FLAG FOR "ADJUSTABLY DIMENSIONED"
				! IN THE ARG BLOCK
		FFLAG=0,34,1$;	! FLAG FOR "FORMAL ARRAY"

	EXTERNAL DEFLAB;	!ROUTINE TO ASSOCIATE THE CURRENT LOCATION WITH A GIVEN LABEL




	ROUTINE OUTPTR(SYMPTR)=
	%(************
		ROUTINE TO OUTPUT A POINTER TO THE VARIABLE OR CONSTANT
		WHOSE SYMBOL/CONSTANT TABLE ENTRY IS POINTED TO BY "SYMPTR"
	**************)%
	BEGIN
		PBOPWD_0;	!INIT WD TO BE OUTPUT
		PSYMPTR_.SYMPTR; !PTR TO SYM TAB ENTRY FOR WD TO BE OUTPUT
		PBOPWD[OTSADDR]_.PSYMPTR[IDADDR];
		OBUFFA()	!OUTPUT THE CONTENTS OF PBOPWD
	END;



	DIMPTR_.SYMPTR[IDDIM];

	DEFLAB(.DIMPTR[ARADLBL]);	!ASSOCIATE THE CURRENT LOC WITH THE LABEL TO
				! BE USED ON THIS ARG BLOCK

	%(**OUTPUT 1ST WD OF ARG BLOCK**)%
	PBOPWD_.SYMPTR[IDSYMBOL];	!SIXBIT FOR ARRAY NAME
	PSYMPTR_PBF2NOSYM;		! (TELLS OUTPUT MODULE TO NOT RELOCATE
					! EITHER HALF OF THE WORD)
	OBUFFA();

	%(**OUTPUT 2ND WD OF ARG BLOCK**)%
	PBOPWD_0;	!INIT WD TO BE OUTPUT TO 0
	PBOPWD[OTSCNT]_.DIMPTR[DIMNUM];	!SET UP DIM CT FIELD
	PBOPWD[OTSTYPE]_.EVALU[.SYMPTR[VALTYPE]];	!TYPE OF THE ARRAY

	IF .SYMPTR[FORMLFLG] THEN PBOPWD[OTSIND]_1;	!SET INDIRECT BIT FOR A FORMA; ARRAY

	PBOPWD[OTSADDR]_.SYMPTR[IDADDR];	!ADDR OF ARRAY OR OF VARHOLDING PTR TO ARRAY BASE
	PSYMPTR_.SYMPTR;	!PTR TO SYMBOL TABLE ENTRY FOR THE ARRAY NAME
	OBUFFA();	!OUTPUT THE CONTENTS OF PBOPWD WITH THE SYM TABLE INFO OF "PSYMPTR"

	%(**OUTPUT 3RD WD OF ARG BLOCK**)%
	PBOPWD_0;
	IF .DIMPTR[ADJDIMFLG] THEN PBOPWD[AFLAG]_1;	!FLAG FOR ADJ DIMENSIONED
	IF .SYMPTR[FORMLFLG] THEN PBOPWD[FFLAG]_1;	!FLAG FOR FORMAL ARRAY

	PSYMPTR_.DIMPTR[ARAOFFSET];	!SYM TAB ENTRY FOR TMP HOLDING CALCULAED OFFSET
					! OR CONST TABLE ENTRY FOR THE OFFSET (IF ARRAY
					! IS NOT ADJ DIM)
	PBOPWD[OTSADDR]_.PSYMPTR[IDADDR];
	OBUFFA();	!OUTPUT CONTENTS OF PBOPWD


	%(***OUTPUT BOUNDS AND FACTOR FOR EACH DIMENSION**)%
	DIMLSTPTR_DIMPTR[FIRSTDIM];	!PTR TO SUBENTRY FOR 1ST DIMENSION

	DECR CT FROM (.DIMPTR[DIMNUM]-1) TO 0
	DO
	BEGIN
		OUTPTR(.DIMLSTPTR[DIMLB]);
		OUTPTR(.DIMLSTPTR[DIMUB]);
		OUTPTR(.DIMLSTPTR[DIMFACTOR]);

		DIMLSTPTR_.DIMLSTPTR+DIMSUBSIZE
	END
END;

END
ELUDOM