Google
 

Trailing-Edge - PDP-10 Archives - TOPS-20_V6.1_DECnetSrc_7-23-85 - mcb/tkb36/wmap.bli
There are 2 other files named wmap.bli in the archive. Click here to see a list.
!NET:<DECNET20-V3P0.TKB-VNP>WMAP.BLI.5 15-Jan-81 09:18:11, Edit by SROBINSON
!<REL4A.TKB-VNP>WMAP.BLI.3,  3-Dec-79 15:16:31, Edit by SROBINSON
MODULE WMAP (					!WRITE GLOBAL MAP
		IDENT = 'X2.0-1'
		) =
BEGIN
!
!
!
!                    COPYRIGHT (c) 1980, 1981, 1982
!                    DIGITAL EQUIPMENT CORPORATION
!                        Maynard, Massachusetts
!
!     This software is furnished under a license and may  be  used
!     and copied only in accordance with the terms of such license
!     and with the inclusion of the above copyright notice.   This
!     software  or any other copies thereof may not be provided or
!     otherwise made available to any other person.  No  title  to
!     and ownership of the software is hereby transferred.
!
!     The information  in  this  software  is  subject  to  change
!     without  notice  and should not be construed as a commitment
!     by DIGITAL EQUIPMENT CORPORATION.
!
!     DIGITAL assumes no responsibility for the use or reliability
!     of  its  software  on  equipment  which  is  not supplied by
!     DIGITAL.
!

!++
! FACILITY: TKB-20
!
! ABSTRACT:
!
!
! THIS MODULE PRINTS A LIST OF ALL GLOBALS WITH THEIR VALUES AND
!  REFERENCES.  IT ALSO FLAGS UNDEFINED GLOBALS.
!
!
! ENVIRONMENT: TOPS-20 USER MODE
!
! AUTHOR: J. SAUTER, CREATION DATE: 22-FEB-78
!
! MODIFIED BY:
!
!	Scott G. Robinson, 28-SEP-78 : VERSION X0.1-2A
!	- Make map generation more readable
!
!	Scott G. Robinson, 7-NOV-78 : VERSION X0.1-3A
!	- Make map show references to undefined symbols
!
!	Scott G. Robinson, 13-NOV-78 : VERSION X0.1-4A
!	- More cleanup of map generation
!-----------------------------------------------------------------------

!
!	Scott G. Robinson, 3-DEC-79 : Version X2.0
!	- Ensure DECnet-10 Compatibility
!
!	Scott G. Robinson, 15-JAN-80 : Version X2.0-1
!	- Yet another fix to the Global Symbol Xref
!	  (Eventually We will get this right!)
!
!	, : VERSION
! 01	-
!--

!<BLF/PAGE>
!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    GLOB : NOVALUE,				!PRODUCE GLOBAL LISTING
    PRC_GLOBL,					!PROCESS EACH GLOBAL
    SEL_PSECT,					!PROCESS EACH PSECT
    UNBLANK,					!SUBSTITUTE "BLANK" FOR BLANKS
    GBL_VAL;					!RETURN THE VALUE OF A GLOBAL

!
! INCLUDE FILES:
!

LIBRARY 'TKBLIB';

!REQUIRE 'BLOCKH.REQ';				!PREPARE TO DEFINE STORAGE BLOCKS
!REQUIRE 'GLOBL.REQ';				!GLOBAL SYMBOL BLOCK
!REQUIRE 'MODU.REQ';				!MODULE BLOCK
!REQUIRE 'PSECT.REQ';				!PSECT BLOCK
!REQUIRE 'BLOCKT.REQ';				!END OF DEFINING STORAGE BLOCKS
!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!

LITERAL
    DEBUG = 0;

!
! OWN STORAGE:
!
!	NONE
!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
    ERRMSG : NOVALUE,				!TYPE AN ERROR MESSAGE
    OUTNUM : NOVALUE,				!WRITE A NUMBER ON A FILE
    OUTPUT : NOVALUE,				!WRITE ON A FILE
    OUTSTR : NOVALUE,				!WRITE A STRING ON A FILE
    PCRLF : NOVALUE,				!SEND CRLF TO A FILE
    FND_CHAIN;					!FIND A BLOCK IN A CHAIN
GLOBAL ROUTINE GLOB (GLOB_CHAN, GLOBL_PTR) : NOVALUE = 	!PRINT A GLOBAL LISTING

!++
! FUNCTIONAL DESCRIPTION:
!
!	PRINT A GLOBAL LISTING.  FLAG UNDEFINED SYMBOLS AND PRINT A
!	 CROSS REFERENCE LISTING.  PSECT BASE ADDRESSES MUST BE RESOLVED.
!
! FORMAL PARAMETERS:
!
!	GLOB_CHAN - CHANNEL ON WHICH TO WRITE THE CROSS REFERENCE.
!	 LESS THAN ZERO MEANS NO GLOBAL CROSS REFERENCE.
!	GLOBL_PTR - POINTER TO ALPHABETICLY FIRST GLOBAL
!
! IMPLICIT INPUTS:
!
!	THE GLOBAL SYMBOLS
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	MAY PRINT THE GLOBAL CROSSREF AND ERROR MESSAGES
!
!--

    BEGIN

    MAP
	GLOBL_PTR : REF GLOBL_BLOCK;

    LOCAL
	FIRST_TIME,
	GLOB_INFO : VECTOR [4];

!
! THE GLOBAL INFORMATION VECTOR IS LAID OUT AS FOLLOWS:
!
!  0 - CHANNEL ON WHICH TO WRITE THE CROSS REFERENCE, LESS THAN
!	0 MEANS NO GLOBAL CROSS REFERENCE.
!  1 - CURRENT HORIZONTAL POSITION ON THE PRINT LINE.
!  2 - NUMBER OF PSECT NAMES PRINTED SO FAR.
!  3 - CURRENT VERTICAL POSITION ON THE PAGE.
!

    BIND
	HPOS = GLOB_INFO [1],
	VPOS = GLOB_INFO [3];

    FIRST_TIME = 1;
    VPOS = 55;
    HPOS = 0;
    GLOB_INFO [0] = .GLOB_CHAN;

    WHILE (.GLOBL_PTR NEQ 0) DO
	BEGIN

	IF ((.GLOB_CHAN GEQ 0) AND ((.VPOS GEQ 55) OR (.FIRST_TIME NEQ 0)))
	THEN
	    BEGIN
	    FIRST_TIME = 0;

	    IF (.VPOS GEQ 55)
	    THEN
		BEGIN
		PCRLF (.GLOB_CHAN);
		OUTPUT (.GLOB_CHAN, %O'14');	!FORM FEED
		END;

	    VPOS = 1;
	    OUTSTR (.GLOB_CHAN, UPLIT (%ASCIZ'Map of Global Symbols'));
	    PCRLF (.GLOB_CHAN);
	    VPOS = .VPOS + 1;
	    HPOS = 0;
	    PCRLF (.GLOB_CHAN);
	    VPOS = .VPOS + 1;
	    OUTSTR (.GLOB_CHAN, UPLIT (%ASCIZ'Name   Value   PSECT  Module ABS Value'));
	    PCRLF (.GLOB_CHAN);
	    VPOS = .VPOS + 1;
	    END;

	PRC_GLOBL (.GLOBL_PTR, GLOB_INFO);
	GLOBL_PTR = .GLOBL_PTR [GBL_NEXT];
	END;

    END;					!END OF GLOB
ROUTINE PRC_GLOBL (GLOBL_PTR, GLOB_INFO) = 	!PROCESS A GLOBAL SYMBOL

!++
! FUNCTIONAL DESCRIPTION:
!
!	LIST INFORMATION ABOUT A GLOBAL SYMBOL
!
! FORMAL PARAMETERS:
!
!	GLOBL_PTR - POINTER TO A GLOBAL SYMBOL BLOCK
!	GLOB_INFO - POINTER TO INFORMATION VECTOR.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	MAY PRINT ONE LINE OF GLOBAL CROSSREF, AND AN ERROR MESSAGE
!
!--

    BEGIN

    MAP
	GLOB_INFO : REF VECTOR,
	GLOBL_PTR : REF GLOBL_BLOCK;

    BIND
	HPOS = GLOB_INFO [1],
	VPOS = GLOB_INFO [3];

    LOCAL
	FLAGS,
	GLOB_CHAN,
	MODU_PTR : REF MODU_BLOCK,
	PSECT_PTR : REF PSECT_BLOCK;

    FLAGS = .GLOBL_PTR [GBL_FLAGS];

    IF (.FLAGS<GBL_FLG_DEF, 1> EQL 0) THEN ERRMSG (0, 16, GLOBL_PTR [GBL_NAME], 0, 0, 0, 0);

    GLOB_CHAN = .GLOB_INFO [0];

    IF (.GLOB_CHAN GEQ 0)
    THEN
	BEGIN

	IF (.HPOS GTR 0)
	THEN
	    BEGIN
	    PCRLF (.GLOB_CHAN);
	    VPOS = .VPOS + 1;
	    HPOS = 0;
	    END;

	OUTSTR (.GLOB_CHAN, GLOBL_PTR [GBL_NAME]);
	OUTPUT (.GLOB_CHAN, %C' ');
	HPOS = .HPOS + 8;

	IF (.FLAGS<GBL_FLG_DEF, 1> EQL 0)
	THEN
	    BEGIN
	    OUTSTR (.GLOB_CHAN, UPLIT (%ASCIZ'**Undefined** '));
	    HPOS = .HPOS + 14;
	    OUTSTR (.GLOB_CHAN, UPLIT (%ASCIZ'              '));
	    HPOS = .HPOS + 14;
	    END
	ELSE
	    BEGIN
	    OUTNUM (.GLOB_CHAN, .GLOBL_PTR [GBL_VALUE], 8, 6);
	    OUTPUT (.GLOB_CHAN, %C' ');
	    HPOS = .HPOS + 7;
	    PSECT_PTR = .GLOBL_PTR [GBL_DEF_PSECT];

	    IF (.FLAGS<GBL_FLG_REL, 1> NEQ 0)
	    THEN
		BEGIN
		OUTSTR (.GLOB_CHAN, UNBLANK (PSECT_PTR [PSECT_NAME]));
		END
	    ELSE
		OUTSTR (.GLOB_CHAN, UPLIT (%ASCIZ'      '));

	    OUTPUT (.GLOB_CHAN, %C' ');
	    HPOS = .HPOS + 7;
	    MODU_PTR = .GLOBL_PTR [GBL_DEF_MODU];
	    OUTSTR (.GLOB_CHAN, MODU_PTR [MODU_NAME]);
	    OUTPUT (.GLOB_CHAN, %C' ');
	    HPOS = .HPOS + 7;
	    OUTNUM (.GLOB_CHAN, GBL_VAL (.GLOBL_PTR), 8, 6);
	    OUTPUT (.GLOB_CHAN, %C' ');
	    HPOS = .HPOS + 7;
	    END;

	GLOB_INFO [2] = 0;
	FND_CHAIN (.GLOBL_PTR [GBL_PSECTS], SEL_PSECT, .GLOB_INFO);
	END;

    END;					!OF PRC_GLOBL
ROUTINE SEL_PSECT (PSECT_PTR, GLOB_INFO) = 	!PROCESS A PSECT REFERENCE TO A GLOBAL

!++
! FUNCTIONAL DESCRIPTION:
!
!	PRINT A PSECT REFERENCE TO A GLOBAL
!
! FORMAL PARAMETERS:
!
!	PSECT_PTR - POINTER TO THE PSECT WHICH REFERENCES THIS GLOBAL
!	GLOB_INFO - THE GLOBAL XREF INFORMATION VECTOR.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	WRITES ONE PSECT REFERENCE TO THE CURRENT GLOBAL
!
!--

    BEGIN

    MAP
	GLOB_INFO : REF VECTOR,
	PSECT_PTR : REF PSECT_BLOCK;

    BIND
	HPOS = GLOB_INFO [1],
	VPOS = GLOB_INFO [3];

    LOCAL
	GLOB_CHAN;

    GLOB_CHAN = .GLOB_INFO [0];

    IF (.GLOB_INFO [2] NEQ 0)
    THEN
	BEGIN
	OUTPUT (.GLOB_CHAN, %C',');
	HPOS = .HPOS + 1;
	END;

    IF (.HPOS GTR 100)
    THEN
	BEGIN
	PCRLF (.GLOB_CHAN);
	VPOS = .VPOS + 1;
	OUTPUT (.GLOB_CHAN, %O'11');
	OUTPUT (.GLOB_CHAN, %O'11');
	HPOS = 17;
	END;

    OUTSTR (.GLOB_CHAN, UNBLANK (PSECT_PTR [PSECT_NAME]));
    GLOB_INFO [2] = .GLOB_INFO [2] + 1;
    HPOS = .HPOS + 6;
    END;					!OF SEL_PSECT
ROUTINE UNBLANK (POINTER) = 			!RETURN "BLANK" FOR BLANKS

!++
! FUNCTIONAL DESCRIPTION:
!
!	IF THE POINTER POINTS TO SIX BLANKS, RETURN A POINTER TO
!	 SIX CHARACTERS OF "BLANK", OTHERWISE RETURN THE POINTER.
!
! FORMAL PARAMETERS:
!
!	POINTER - POINTER TO THE STRING TO TEST
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	POINTER TO A SUITABLE STRING
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    IF (CH$EQL (6, CH$PTR (.POINTER), 6, CH$PTR (UPLIT (%ASCIZ'      '))))
    THEN
	UPLIT (%ASCIZ' blank')
    ELSE
	.POINTER

    END;					!OF UNBLANK
GLOBAL ROUTINE GBL_VAL (GLOBL_PTR) = 		!RETURN VALUE OF GLOBAL SYMBOL

!++
! FUNCTIONAL DESCRIPTION:
!
!	IF THE GLOBAL SYMBOL IS ABSOLUTE, JUST RETURN ITS VALUE CELL.
!	 IF IT IS RELOCATABLE, WE MUST ADD TO THIS THE BASE OF THE
!	 PSECT IT WAS DEFINED IN AND THE OFFSET INTO THAT PSECT AT
!	 THE TIME OF THE DEFINITION.
!	 AN UNDEFINED SYMBOL RETURNS ZERO.
!
! FORMAL PARAMETERS:
!
!	GLOBL_PTR - POINTER TO THE GLOBAL WHOSE VALUE IS TO BE RETURNED
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	THE VALUE OF THE GLOBAL SYMBOL
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	GLOBL_PTR : REF GLOBL_BLOCK;

    LOCAL
	FLAGS,
	PSECT_PTR : REF PSECT_BLOCK;

    FLAGS = .GLOBL_PTR [GBL_FLAGS];

    IF (.FLAGS<GBL_FLG_DEF, 1> EQL 0)
    THEN
	0
    ELSE
	BEGIN

	IF (.FLAGS<GBL_FLG_REL, 1> EQL 0)
	THEN
	    .GLOBL_PTR [GBL_VALUE]
	ELSE
	    BEGIN
	    PSECT_PTR = .GLOBL_PTR [GBL_DEF_PSECT];
	    .GLOBL_PTR [GBL_VALUE] + .PSECT_PTR [PSECT_BASE] + .GLOBL_PTR [GBL_DEF_OFFSET]
	    END

	END

    END;					!OF GBL_VAL

END

ELUDOM
! Local Modes:
! Comment Start:!
! Comment Column:36
! Mode:Fundamental
! Auto Save Mode:2
! End: