Google
 

Trailing-Edge - PDP-10 Archives - BB-4157F-BM_1983 - fortran/compiler/debug.bli
There are 12 other files named debug.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1983
!AUTHOR: S. MURPHY/TFV/AHM

MODULE DEBUG(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4)=
BEGIN

	SWITCHES NOLIST;
	REQUIRE FIRST.BLI;
	REQUIRE TABLES.BLI;
	REQUIRE 'REQREL.BLI';
	SWITCHES LIST;

GLOBAL BIND DEBUGV = 7^24 + 0^18+ #1512;	! Version Date: 26-Mar-82

%(

***** Begin 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

***** Begin Version 6 *****

37	761	TFV	1-Mar-80	-----
	Choose arg type based on /GFLOATING

40	1002	TFV	1-Jul-80	------
	MAP EVALU onto EVALTAB to get the argtype for argblock entries

***** Begin Version 7 *****

1503	AHM	26-Feb-82
	Change the format of dimension information blocks for extended
	addressing support.  Rejustify some routines.

1505	AHM	12-Mar-82
	Have INIFDDT set the psect index of the symbol table entry for
	"FDDT." to PSDATA to relocate those references by .DATA.

1506	AHM	14-Mar-82
	Make DEFISN  use  ZOUTBLOCK  to  output  line  number  labels,
	instead of using its own buffers.

1512	AHM	26-Mar-82
	Convert to using ZSYMBOL in DEFISN to output symbols.

***** End Revision History *****

)%

! 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.

EXTERNAL
	OBJECTCODE PBOPWD,	! Global in which word of code to be
				!  output is set up and passed to the
				!  output buffering routine ("OBUFFA")
	BASE PSYMPTR,		! Global pointing to the symbol table
				!  entry for the address field of the
				!  word of code being output
	OBUFFA,			! Places data in the peephole buffer
%1503%	OIFIW;			! Lights the IFIW bit in a data word
				!  and calls OBUFFA

OWN
	PRVISNX,		! The last ISN for which we generated
				!  the code "XCT FDDT."
	BASE FDDTSYM,		! Pointer to STE for "FDDT."
	PREVISN,		! The last ISN for which we made a label
	LPRVISN;		! The last ISN for which we listed a label
				!  in the assembly language listing
GLOBAL ROUTINE INIFDDT=
BEGIN

! Initializes 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

	EXTERNAL NAME,ENTRY,TBLSEARCH;

	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;
%1505%	FDDTSYM[IDPSECT] = PSDATA	! Use .DATA.
END;	!End of "INIFDDT"
GLOBAL ROUTINE XCTFDDT=
BEGIN

! Generates "XCT FDDT." in front of each source program statement that
! is the 1st statement on a line.  Called before code is generated for
! each statement if the flag "DBGTRAC" is set.

	EXTERNAL 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 "XCTFDDT"
GLOBAL ROUTINE DEFISN(ISN)=
BEGIN

! Defines a label for the internal seq number (ie line number) ISN and
! associates that label with the location of the instruction currently
! being written  to the  REL  file.  The  global HILOC  indicates  the
! location to be used.

EXTERNAL
	HILOC,			! Address of instruction currently being
				!  output to the REL file
	RADIX50,		! Converts a left justified SIXBIT word
				!  to RADIX 50
	ZSYMBOL,		![1512] Buffers a symbol to the REL file
	RDATWD;			! Holds the word that ZOUTBLOCK buffers

REGISTER
	LABL,			! Used to build SIXBIT for the seq number
				!  followed by "L" (the label)
	T1;			! Holds the ISN as it is being
				!  decomposed for output

	IF .ISN EQL 0		! Do not generate a label for
	THEN RETURN;		!  statements inserted by the compiler

	IF .ISN EQL .PREVISN	! If there are multiple statements on a line,
	THEN RETURN;		!  only generate a label for the first one

	T1 = PREVISN = .ISN;	! Remember our ISN

! Make the left justified SIXBIT for the ISN followed by "L" (nnnnnL)

	LABL=SIXBIT 'L';	! Put in the L

	DO			! Loop for each digit
	BEGIN
		LABL = .LABL^(-6);		! Shift label built so far
						!  to the right by 1 char
		LABL<30,6> = (.T1 MOD 10)+#20;	! Get the rightmost digit into
						! leftmost character of label
		T1 = .T1/10;			! Discard digit from number
	END
	UNTIL .T1 EQL 0;

%1512%	ZSYMBOL(LOCDEF,.LABL,.HILOC,PSCODE)	![1512] Output the symbol

END;
GLOBAL ROUTINE INIISNRLBLK=
BEGIN

! Sets up for defining labels corresponding to each line.

	PREVISN = 0;		! The last ISN for which a label was made
	LPRVISN = 0		! The last ISN for which a label was listed
				!  in the assembly language listing
END;
GLOBAL ROUTINE ZOUDLB=
BEGIN

! Inserts into the  macro-expanded listing an  "L" label inserted  for
! the first  instruction of  a given  source line.   These labels  are
! inserted when the user specifies the "DEBUG" switch.  Call with  the
! global (register) "R1"  set to  the ISN  of the  statement that  the
! instruction currently being listed begins.

	EXTERNAL LSTOUT,ZOUDECIMAL,HEADCHK;
	IF .R1 EQL .LPRVISN
	THEN RETURN;			!If the previous statement for which we
					! listed a label had the same ISN as
 					! this one, don't make a new label

	LPRVISN_.R1;

	ZOUDECIMAL();	!LIST THE ISN IN DECIMAL
	CHR_"L"; LSTOUT();	! FOLLOWED BY "L"
	CHR_":"; LSTOUT();	! FOLLOWED BY ":"
	CRLF;
	HEADCHK();	!CHECK FOR HEADING
	CHR_#11; LSTOUT(); LSTOUT();	! <TAB> <TAB>
END;
GLOBAL ROUTINE DUMPDIM=
BEGIN

! 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.

	EXTERNAL SYMTBL;
	EXTERNAL CGDIMBLOCK;	! Outputs an argument block specifying
				!  dimension information for a given array
	REGISTER BASE SYMPTR;	! Points to the current STE under examiniation

! Unless the user specified either the "DEBUG" switch or the  "BOUNDS"
! switch, do not output dimension information.

	IF NOT (.FLGREG<DBGDIMN> OR .FLGREG<BOUNDS>)
	THEN RETURN;

! Walk through the  symbol table  and output dimension  info for  each
! array name found.  Must do this since there is no way to directly go
! through 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
		DO			!  this entry
		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]		! Look at the next STE
							!  in this bucket
		END
	END;
END;
ROUTINE OUTPTR(SYMPTR)=			![1503] Moved outside of CGDIMBLOCK
BEGIN

! Outputs a pointer to the variable or constant whose  symbol/constant
! table entry is pointed to by "SYMPTR"

	PSYMPTR=.SYMPTR;		!Ptr to STE for word to be output
	PBOPWD=0;			!Init word to be output
	PBOPWD[OTSADDR]=.PSYMPTR[IDADDR];	!Set address field from STE
%1503%	OIFIW()				!Output the contents of PBOPWD
END;
GLOBAL ROUTINE CGDIMBLOCK(SYMPTR)=	![1503] Routine reworked by AHM

! Outputs an arg block for PROAR. FORLIB calls generated by  PROARRXPN
! in ARRXPN.  The  arg block specifies  the dimension information  for
! the array whose STE is pointed to by "SYMPTR".  The format for these
! arg blocks is:

!                             PROAR. argument list

!  !=========================================================================!
!  !                          Array name in SIXBIT                           !
!  !-------------------------------------------------------------------------!
!  !1!0!  Dim count  ! Type  !I!        !            Base address            !
!  !-------------------------------------------------------------------------!
!V6!A!F!0!0!                            !      Ptr to offset (in words)      !
!V7!1!0!A!F!                            !      Ptr to offset (in words)      !
!  !=========================================================================!
!  !1!0!                                ! Ptr to first lower bound (in items)!
!  !-------------------------------------------------------------------------!
!  !1!0!                                ! Ptr to first upper bound (in items)!
!  !-------------------------------------------------------------------------!
!  !1!0!                                !   Ptr to first factor (in words)   !
!  !=========================================================================!
!  \                                                                         \
!  \               More triples for the rest of the 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
MAP
	BASE SYMPTR;			!This formal points to array whose
					! bounds are to be checked
EXTERNAL
%1002%	EVALTAB EVALU,			!Table of type codes
	DEFLAB;				!Associates the current location with
					! a given label
REGISTER
	BASE DIMPTR,			!Ptr to dimension table entry for the
					! array for which dimension information
					! is being output
	DIMSUBENTRY DIMLSTPTR;		!Ptr to the subentry for the dimension
					! being output

MACRO					!Define flag fields
%1503%	AFLAG=0,33,1$,			!Flag for "ADJUSTABLY DIMENSIONED"
%1503%	FFLAG=0,32,1$;			!Flag for "FORMAL ARRAY"

	DIMPTR=.SYMPTR[IDDIM];		!Point to the dimension table

	DEFLAB(.DIMPTR[ARADLBL]);	!Associate the current loc with the
					! label to be used on this arg block

! Output 1st word of arg block

	PBOPWD=.SYMPTR[IDSYMBOL];	!SIXBIT for array name
	PSYMPTR=PBF2NOSYM;		! Tell output module to not relocate
					! either half of the word
	OBUFFA();			!Write the word out

! Output 2nd word of arg block

	PBOPWD=0;			!Init word to be output to 0
	PBOPWD[OTSCNT]=.DIMPTR[DIMNUM];	!Set up dim count field

%1002%	PBOPWD[OTSTYPE]=.EVALU[.SYMPTR[VALTYPE]];	!Type of the array

	IF .SYMPTR[FORMLFLG]		!Set indirect bit for a formal,
%1503%		AND .SYMPTR[VALTYPE] NEQ CHARACTER	! non-character array
	THEN PBOPWD[OTSIND]=1;

	PBOPWD[OTSADDR]=.SYMPTR[IDADDR];	!Address of array or variable
						! holding pointer to array

	PSYMPTR=.SYMPTR;		!Ptr to STE for the array name
%1503%	OIFIW();			!Output PBOPWD as an IFIW

! Output 3rd word of arg block

	PBOPWD=0;			!Init data word

	IF .DIMPTR[ADJDIMFLG]		!Are we adjustably dimensioned ?
	THEN PBOPWD[AFLAG]=1;		!Yes, set the flag

	IF .SYMPTR[FORMLFLG]		!Are we a formal ?
	THEN PBOPWD[FFLAG]=1;		!Yes, set the flag

	PSYMPTR=.DIMPTR[ARAOFFSET];	!STE for temp holding calculated offset
					! or constant table entry for the
					! offset (if array is not adj dim)

	PBOPWD[OTSADDR]=.PSYMPTR[IDADDR];	!Point to the temp or constant
%1503%	OIFIW();			!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] TO 1	!Loop for all the dimensions
	DO
	BEGIN
		OUTPTR(.DIMLSTPTR[DIMLB]);	!Output the lower bound
		OUTPTR(.DIMLSTPTR[DIMUB]);	!Output the upper bound
		OUTPTR(.DIMLSTPTR[DIMFACTOR]);	!Output the factor

		DIMLSTPTR=.DIMLSTPTR+DIMSUBSIZE	!Point to the next entry
	END
END;

END
ELUDOM