Google
 

Trailing-Edge - PDP-10 Archives - BB-X117B-SB_1986 - 10,7/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) DIGITAL EQUIPMENT CORPORATION 1980,1981,1982,1986. ALL RIGHTS RESERVED.
!
!
!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 : NOVALUE,			!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) : NOVALUE = 	!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:
!
!	0
!
! 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;

    0

    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: