Google
 

Trailing-Edge - PDP-10 Archives - TOPS-20_V6.1_DECnetSrc_7-23-85 - mcb/vnp36/rstb.bli
There are 2 other files named rstb.bli in the archive. Click here to see a list.
!<REL4A.TKB-VNP>RSTB.BLI.3,  3-Dec-79 14:59:04, Edit by SROBINSON
MODULE RSTB (					!READ SYMBOL TABLE
		IDENT = 'X2.0'
		) =
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: VNP-20
!
! ABSTRACT:
!
!
! THIS MODULE READS A SYMBOL TABLE, EITHER FOR THE KERNEL OR
!  FOR A TASK.
!
!
! ENVIRONMENT: TOPS-20 USER MODE
!
! AUTHOR: J. SAUTER, CREATION DATE: 31-MAY-78
!
! MODIFIED BY:
!
!	Scott G. Robinson, 3-DEC-79 : Version X2.0
!	- Ensure DECnet-10 Compatibility
!
!
!	, : VERSION
! 01	-
!--

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

FORWARD ROUTINE
    RD16,					!READ A 16-BIT WORD
    RDLBBL,					!READ AN OBJECT BLOCK (NON-DOS FMT)
    RSTB : NOVALUE,				!READ SYMBOL TABLE
    GET_BYTE,					!GET AN 8-BIT BYTE FROM FILE
    GET_WORD,					!GET A 16-BIT WORD FROM FILE
    OBJ_GSD : NOVALUE,				!PROCESS GSD OBJECT ENTRY
    OBJ_END_GSD : NOVALUE,			!END OF GSD ENTRIES
    OBJ_EOM : NOVALUE,				!END OF MODULE
    GSD_MNAME : NOVALUE,			!MODULE NAME
    GSD_CNAME : NOVALUE,			!CSECT NAME (INVALID)
    GSD_ISN : NOVALUE,				!INTERNAL SYMBOL NAME (INVALID)
    GSD_TRA : NOVALUE,				!TRANSFER ADDRESS
    SEL_GLOBAL,					!FIND A GLOBAL SYMBOL
    GSD_GSN : NOVALUE,				!GLOBAL SYMBOL
    SEL_PSECT,					!FIND A PSECT
    GSD_PSN : NOVALUE,				!PSECT
    GSD_IDENT : NOVALUE,			!MODULE IDENTIFICATION
    GSD_MAP : NOVALUE,				!MAPPED ARRAY (INVALID)
    OBJ_ISD : NOVALUE,				!INTERNAL SYMBOL (INVALID)
    SYM_VAL,					!RETURN VALUE OF A SYMBOL
    SEL_SYMBOL,					!FIND A SYMBOL BY NAME
    GBL_VAL;					!RETURN VALUE OF A GLOBAL

!
! INCLUDE FILES:
!

LIBRARY 'VNPLIB';

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

LITERAL
    DEBUG = 0;

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

EXTERNAL ROUTINE
    OPEN,					!OPEN A FILE
    CLOSE : NOVALUE,				!CLOSE A FILE
    INPUT,					!READ FROM A FILE
    OUTPUT : NOVALUE,				!OUTPUT TO A FILE
    ERROR : NOVALUE,				!SIGNAL PROGRAMMING ERROR
    ERRMSG : NOVALUE,				!ERROR MESSAGE
    GETSTG,					!GET STORAGE
    FRESTG : NOVALUE,				!FREE STORAGE
    PCRLF : NOVALUE,				!PRINT CRLF
    OUTNUM : NOVALUE,				!PRINT A NUMBER
    OUTSTR : NOVALUE,				!PRINT A STRING
    R50TOA : NOVALUE,				!CONVERT RADIX50 TO ASCII
    GETBLK,					!GET A STORAGE BLOCK
    BLD_CHAIN,					!BUILD ONTO A CHAIN
    FND_CHAIN;					!FIND AN ITEM IN A CHAIN
ROUTINE RD16 (CHAN, CHKSUM) = 			!READ A 16-BIT WORD

!++
! FUNCTIONAL DESCRIPTION:
!
!	READ A 16-BIT WORD, ASSEMBLING IT FROM THE 8-BIT
!	 INPUT STREAM.  MAINTAIN THE CHECKSUM.
!
! FORMAL PARAMETERS:
!
!	CHAN - THE CHANNEL OVER WHICH TO READ THE 8-BIT BYTES
!	CHKSUM - ADDRESS OF THE CHECKSUM CELL
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	THE VALUE OF THE 16-BIT WORD READ, OR -1 IF WE REACHED
!	 END OF FILE ON INPUT.
!
! SIDE EFFECTS
!
!	READS FROM THE INPUT FILE.  MAY REACH EOF.
!
!--

    BEGIN

    LOCAL
	BYTE1,
	BYTE2,
	RESULT;

    IF ((BYTE1 = INPUT (.CHAN)) LSS 0)
    THEN
	.BYTE1
    ELSE
	BEGIN
	.CHKSUM = ..CHKSUM + .BYTE1;

	IF ((BYTE2 = INPUT (.CHAN)) LSS 0)
	THEN
	    .BYTE2
	ELSE
	    BEGIN
	    .CHKSUM = ..CHKSUM + .BYTE2;
	    RESULT = 0;
	    RESULT<8, 8> = .BYTE2;		!HIGH-ORDER BYTE
	    RESULT<0, 8> = .BYTE1;		!LOW-ORDER BYTE
	    .RESULT
	    END

	END

    END;
!
ROUTINE RDLBBL (CHAN, FILE_PTR, BYTES_READ) = 	!READ A LIBRARY BLOCK

!++
! FUNCTIONAL DESCRIPTION:
!
!	READ A BLOCK OF DATA FROM THE LIBRARY FILE.  THIS BLOCK
!	 STARTS WITH A COUNT WORD FOLLOWED BY "COUNT" DATA WORDS.
!	 THE DATA WORDS COMPRISE OBJECT TEXT WHICH MAY CONTAIN
!	 SEVERAL RECORDS.
!	THIS FORMAT IS ALSO USED FOR OBJECT FILES WITHOUT THE "DOS"
!	 SWITCH.
!
! FORMAL PARAMETERS:
!
!	CHAN - THE CHANNEL OVER WHICH TO READ DATA.  IT MUST HAVE
!	 BEEN OPENED IN WORD MODE.
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR
!	 ERROR MESSAGES.
!	BYTES_READ - SET TO THE NUMBER OF BYTES READ FROM THE INPUT
!	 CHANNEL.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	A POINTER TO A VECTOR.  THE FIRST WORD OF THE VECTOR HAS
!	 ITS LENGTH IN WORDS.  THE SECOND HAS THE LENGTH OF DATA IN
!	 BYTES.  SUBSEQUENT WORDS ARE THE DATA READ, SUITABLE
!	 FOR SCANNING 8 BITS AT A TIME USING CH$A_RCHAR.  IT IS
!	 THE CALLER'S RESPONSIBILITY TO FREE THIS VECTOR BY CALLING
!	 FRESTG.
!	IF WE REACH EOF, -1 IS RETURNED.  IF STORAGE IS NOT AVAILABLE,
!	 0 IS RETURNED.  AN INVALID FORMAT ALSO RETURNS -1.
!
! SIDE EFFECTS
!
!	READS DATA FROM THE INPUT CHANNEL.  MAY GET EOF.
!	OBTAINS STORAGE FROM THE FREE LIST.
!	 WILL RETURN IT ON ERROR.
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'READ_LIBRARY_BLOCK');

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	BLKPTR,
	BYTE1,
	CHKSUM,
	COUNT,
	OUTLEN,
	RESULT : REF VECTOR;

    RESULT = 0;
    .BYTES_READ = 0;
    OUTLEN = 0;

    WHILE (.OUTLEN EQL 0) DO
	BEGIN
	OUTLEN = RD16 (.CHAN, CHKSUM);
	.BYTES_READ = ..BYTES_READ + 2;
	END;

    IF ((.OUTLEN LSS 2) OR (.OUTLEN GTR 128))
    THEN
	BEGIN

	IF (.OUTLEN NEQ -1) THEN ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);

	RESULT = -1;
	END
    ELSE
	BEGIN

	IF ((RESULT = GETSTG ((((.OUTLEN)/4) + 3))) LEQ 0)
	THEN
	    BEGIN
	    ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0);
	    END
	ELSE
	    BEGIN
	    RESULT [0] = (((.OUTLEN)/4) + 3);	!AMOUNT TO FREE
	    RESULT [1] = .OUTLEN;		!NUMBER OF BYTES
	    BLKPTR = CH$PTR (RESULT [2], -1, 8);
	    COUNT = 0;

	    WHILE (((COUNT = .COUNT + 1) LEQ .OUTLEN) AND (.BYTE1 GEQ 0)) DO
		BEGIN
		BYTE1 = INPUT (.CHAN);
		.BYTES_READ = ..BYTES_READ + 1;

		IF (.BYTE1 GEQ 0) THEN CH$A_WCHAR (.BYTE1, BLKPTR);

		END;

	    IF (.BYTE1 LSS 0)
	    THEN
		BEGIN
		ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
		FRESTG (.RESULT, .RESULT [0]);
		RESULT = -1;
		END;

	    END;

	END;

    .RESULT
    END;					!OF RDLBBL
GLOBAL ROUTINE RSTB (FILE_CHAN, FILE_PTR) : NOVALUE = 	!READ SYMBOL TABLE

!++
! FUNCTIONAL DESCRIPTION:
!
!	READ A SYMBOL TABLE FOR A TASK OR SYSTEM IMAGE
!
! FORMAL PARAMETERS:
!
!	FILE_CHAN - THE CHANNEL NUMBER TO USE WHEN READING THE FILE.
!	FILE_PTR - POINTER TO THE FILE BLOCK WHICH DESCRIBES
!		THE SYMBOL TABLE FILE TO BE READ
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	GETS SPACE FROM FREE STORAGE TO HOLD THE SYMBOLS
!
! ROUTINE VALUE:
!
!	POINTER TO THE CHAIN BLOCK WHICH POINTS TO THE SYMBOLS
!
! SIDE EFFECTS
!
!	READS THE SYMBOL TABLE FILE
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'READ_SYMBOL_TABLE');

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	ASCVAL : VECTOR [CH$ALLOCATION (LEN_PSECT_NAME)],
	BLKPTR : REF VECTOR,
	BYTECTR,
	BYTEPTR,
	BYTES_READ,
	CHAR,
	COUNTER,
	POINTER,
	PREV_CHAR : VECTOR [3],
	R50VAL,
	READ_DONE,
	RECORD_TYPE;

    IF (OPEN (.FILE_CHAN, FILE_PTR [FILE_NAME], 2, 0, UPLIT (%ASCIZ'STB')) NEQ 0)
    THEN
	BEGIN					!SUCCESSFUL INPUT OPEN
	READ_DONE = 0;

	DO
	    BEGIN
	    BLKPTR = RDLBBL (.FILE_CHAN, .FILE_PTR, BYTES_READ);

	    IF (.BLKPTR LEQ 0)
	    THEN
		BEGIN
		ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
		READ_DONE = -1;
		END
	    ELSE
		BEGIN
		BYTEPTR = CH$PTR (BLKPTR [2], -1, 8);
		BYTECTR = .BLKPTR [1];

		IF (DEBUG GEQ 2)
		THEN
		    BEGIN
		    PCRLF (1);
		    OUTNUM (1, .BYTECTR, 10, 0);
		    COUNTER = .BYTECTR;
		    POINTER = .BYTEPTR;
		    PREV_CHAR [0] = 0;
		    PREV_CHAR [1] = 0;
		    PREV_CHAR [2] = 0;
		    R50VAL = 0;

		    WHILE ((COUNTER = .COUNTER - 1) GEQ 0) DO
			BEGIN
			CHAR = CH$A_RCHAR (POINTER);
			PCRLF (1);
			OUTSTR (1, UPLIT (%ASCIZ'    '));
			OUTNUM (1, .CHAR, 8, 0);
			OUTPUT (1, %O'11');
			R50VAL<24, 8> = .PREV_CHAR [1];
			R50VAL<16, 8> = .PREV_CHAR [0];
			R50VAL<8, 8> = .CHAR;
			R50VAL<0, 8> = .PREV_CHAR [2];
			R50TOA (.R50VAL, ASCVAL [0]);
			OUTSTR (1, ASCVAL [0]);
			PREV_CHAR [0] = .PREV_CHAR [1];
			PREV_CHAR [1] = .PREV_CHAR [2];
			PREV_CHAR [2] = .CHAR;
			END;

		    END;			!DEBUG

		RECORD_TYPE = GET_BYTE (BYTEPTR, BYTECTR, .FILE_PTR);

		CASE .RECORD_TYPE FROM 1 TO 6 OF
		    SET

		    [1] :
			OBJ_GSD (BYTEPTR, BYTECTR, .FILE_PTR);	!GSD

		    [2] :
			OBJ_END_GSD (BYTEPTR, BYTECTR, .FILE_PTR);	!END OF GSD

		    [5] :
			OBJ_ISD (BYTEPTR, BYTECTR, .FILE_PTR);	!INTERNAL SYMBOL DIRECTORY

		    [6] :
			BEGIN
			OBJ_EOM (BYTEPTR, BYTECTR, .FILE_PTR);	!END OF MODULE
			READ_DONE = -1;
			END;

		    [3, 4, OUTRANGE] :
			BEGIN
			ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
			READ_DONE = -1;
			END;
		    TES;

		FRESTG (.BLKPTR, .BLKPTR [0]);
		END

	    END
	UNTIL (.READ_DONE NEQ 0);

	CLOSE (.FILE_CHAN);
	END;					!OF SUCCESSFUL INPUT OPEN

    END;					!OF READ_FILE
ROUTINE GET_BYTE (BYTEPTR, BYTECTR, FILE_PTR) = 	!GET BYTE

!++
! FUNCTIONAL DESCRIPTION:
!
!	FETCH A BYTE FROM THE OBJECT RECORD.  MAINTAIN
!	 THE COUNTER AND GIVE AN ERROR MESSAGE IF IT RUNS OUT.
!
! FORMAL PARAMETERS:
!
!	BYTEPTR - POINTER TO THE BYTE POINTER
!	BYTECTR - POINTER TO THE COUNTER CELL
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE FILE
!	 BEING READ, FOR ERROR MESSAGES.
!
! IMPLICIT INPUTS:
!
!	THE OBJECT RECORD POINTED TO
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	THE VALUE OF THE BYTE, OR -1 IF WE RAN OFF THE END.
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'GET_BYTE');

    MAP
	FILE_PTR : REF FILE_BLOCK;

    IF (..BYTECTR GTR 0)
    THEN
	BEGIN
	.BYTECTR = ..BYTECTR - 1;
	CH$A_RCHAR (.BYTEPTR)
	END
    ELSE
	BEGIN
	ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
	-1
	END

    END;					!OF GET_BYTE
ROUTINE GET_WORD (BYTEPTR, BYTECTR, FILE_PTR) = 	!GET WORD

!++
! FUNCTIONAL DESCRIPTION:
!
!	FETCH A WORD FROM THE OBJECT RECORD.  MAINTAIN
!	 THE COUNTER AND GIVE AN ERROR MESSAGE IF IT RUNS OUT.
!
! FORMAL PARAMETERS:
!
!	BYTEPTR - POINTER TO THE BYTE POINTER
!	BYTECTR - POINTER TO THE COUNTER CELL
!	FILE_PTR - POINTER TO FILE BLOCK FOR ERROR MESSAGES
!
! IMPLICIT INPUTS:
!
!	THE OBJECT RECORD POINTED TO
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	THE VALUE OF THE WORD, OR -1 IF WE RAN OFF THE END.
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'GET_WORD');

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	RESULT;

    IF (..BYTECTR GTR 1)
    THEN
	BEGIN
	.BYTECTR = ..BYTECTR - 2;
	RESULT = CH$A_RCHAR (.BYTEPTR);
	RESULT<8, 8> = CH$A_RCHAR (.BYTEPTR);
	.RESULT
	END
    ELSE
	BEGIN
	ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
	-1
	END

    END;					!OF GET_WORD
ROUTINE OBJ_GSD (BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = 	!PROCESS GSD RECORD

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS A GLOBAL SYMBOL DIRECTORY ENTRY IN THE OBJECT
!	 FILE.  THIS IS DONE BY FETCHING THE PARAMETERS AND THEN
!	 TO A SUBROUTINE TO HANDLE THE ENTRY TYPE.
!
! FORMAL PARAMETERS:
!
!	BYTEPTR - POINTER TO THE BYTE POINTER
!	BYTECTR - POINTER TO THE COUNTER CELL
!	FILE_PTR - POINTER TO THE FILE BLOCK OF THE OBJECT
!	 FILE BEING READ.  THIS IS FOR ERROR MESSAGES AND TO
!	 POINT TO THE DATA READ.
!
! IMPLICIT INPUTS:
!
!	THE OBJECT RECORD POINTED TO
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	IN MANY CASES, THE HANDLERS FOR THE ENTRY TYPES WILL
!	 OBTAIN SPACE FROM THE FREE STORAGE LIST
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'OBJ_GSD');

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	MODU_PTR : REF MODU_BLOCK,
	CHAR,
	R50VAL,
	ASCVAL : VECTOR [CH$ALLOCATION (LEN_PSECT_NAME)],
	FLAGS,
	ETYPE,
	VALUE;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'GSD RECORD, LENGTH = '));
	OUTNUM (1, ..BYTECTR, 10, 0);
	END;					!DEBUG

    IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) NEQ 0)
    THEN
	BEGIN

	IF ((.MODU_PTR [MODU_FLAG_EGSD] NEQ 0) AND (.MODU_PTR [MODU_FLAG_ENDED] NEQ 0))
	THEN
	    ERRMSG (0, 10,
		ROUTINE_NAME, 0, 0, 0, 0);

	END;

    CHAR = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR);	!UNUSED BYTE

    DO
	BEGIN
	R50VAL = 0;
	R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
	R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
	R50TOA (.R50VAL, ASCVAL [0]);
	FLAGS = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR);
	ETYPE = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR);
	VALUE = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);

	CASE .ETYPE FROM 0 TO 7 OF
	    SET

	    [0] :
		GSD_MNAME (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);

	    [1] :
		GSD_CNAME (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);

	    [2] :
		GSD_ISN (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);

	    [3] :
		GSD_TRA (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);

	    [4] :
		GSD_GSN (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);

	    [5] :
		GSD_PSN (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);

	    [6] :
		GSD_IDENT (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);

	    [7] :
		GSD_MAP (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);

	    [OUTRANGE] :
		ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
	    TES;

	END
    UNTIL (..BYTECTR EQL 0);

    END;					!OF OBJ_GSD
ROUTINE OBJ_END_GSD (BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = 	!PROCESS END GSD RECORD

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE END GSD RECORD.
!
! FORMAL PARAMETERS:
!
!	BYTEPTR - POINTER TO THE BYTE POINTER
!	BYTECTR - POINTER TO THE COUNTER CELL
!	FILE_PTR - POINTER TO FILE BLOCK
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	SETS A FLAG WHICH FORBIDS ANY MORE GSD RECORDS IN
!	 THIS MODULE.
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'OBJ_END_GSD');

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	MODU_PTR : REF MODU_BLOCK;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'END GSD RECORD, LENGTH = '));
	OUTNUM (1, ..BYTECTR, 10, 0);
	END;					!DEBUG

    IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
    THEN
	ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
	    0, 0)
    ELSE
	BEGIN

	IF (.MODU_PTR [MODU_FLAG_EGSD] NEQ 0)
	THEN
	    ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
	ELSE
	    BEGIN
	    MODU_PTR [MODU_FLAG_EGSD] = 1;
	    END;

	END;

    END;					!OF OBJ_END_GSD
ROUTINE OBJ_ISD (BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = 	!PROCESS ISD RECORD

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS INTERNAL SYMBOL DIRECTORY RECORD.
!
! FORMAL PARAMETERS:
!
!	BYTEPTR - POINTER TO THE BYTE POINTER
!	BYTECTR - POINTER TO THE COUNTER CELL
!	FILE_PTR - POINTER TO OBJECT FILE BLOCK
!
! IMPLICIT INPUTS:
!
!	THE OBJECT RECORD POINTED TO
!
! IMPLICIT OUTPUTS:
!
!	ADDS THE INTERNAL SYMBOLS TO THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'OBJ_ISD');

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'INTERNAL SYMBOL DIRECTORY RECORD, LENGTH = '));
	OUTNUM (1, ..BYTECTR, 10, 0);
	END;					!DEBUG

    ERRMSG (0, 12, ROUTINE_NAME, 0, 0, 0, 0);
    END;					!OF OBJ_ISD
ROUTINE OBJ_EOM (BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = 	!PROCESS END OF MODULE RECORD

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE END MODULE RECORD.
!
! FORMAL PARAMETERS:
!
!	BYTEPTR - POINTER TO THE BYTE POINTER
!	BYTECTR - POINTER TO THE COUNTER CELL
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	THE OBJECT RECORD POINTED TO
!
! IMPLICIT OUTPUTS:
!
!	SETS A FLAG TO INDICATE THAT WE ARE BETWEEN MODULES.
!	 AN EOF IS OK IN THIS CONTEXT.
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'OBJ_EOM');

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	MODU_PTR : REF MODU_BLOCK;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'END OF MODULE RECORD, LENGTH = '));
	OUTNUM (1, ..BYTECTR, 10, 0);
	END;					!DEBUG

    IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
    THEN
	ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
	    0, 0)
    ELSE
	BEGIN

	IF ((.MODU_PTR [MODU_FLAG_EGSD] EQL 0) OR (.MODU_PTR [MODU_FLAG_ENDED] NEQ 0))
	THEN
	    ERRMSG (0, 10,
		ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
	ELSE
	    MODU_PTR [MODU_FLAG_ENDED] = 1;

	END;

    END;					!OF OBJ_EOM
ROUTINE GSD_MNAME (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = 	!PROCESS MODULE NAME ENTRY

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE MODULE NAME ENTRY OF THE GSD RECORD
!
! FORMAL PARAMETERS:
!
!	ASCPTR - POINTER TO NAME, IN ASCII
!	FLAGS - THE FLAGS BYTE
!	VALUE - THE VALUE WORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	ADDS THE MODULE NAME TO THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	OBTAINS SPACE FROM THE FREE LIST
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'GSD_MNAME');

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	MODU_PTR : REF MODU_BLOCK,
	FILE_ERROR;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'MODULE NAME, NAME = '));
	OUTSTR (1, .ASCPTR);
	OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
	OUTNUM (1, .FLAGS, 8, 0);
	OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
	OUTNUM (1, .VALUE, 8, 0);
	END;					!DEBUG

!
    FILE_ERROR = 0;

    IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) NEQ 0)
    THEN
	BEGIN

	IF (.MODU_PTR [MODU_FLAG_ENDED] EQL 0)
	THEN
	    BEGIN
	    ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
	    FILE_ERROR = -1;
	    END
	ELSE
	    BEGIN
	    ERRMSG (0, 23, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
	    FILE_ERROR = -1;
	    END;

	END;

    IF (.FILE_ERROR EQL 0)
    THEN
	BEGIN					!THERE IS NOT ALREADY A MODULE BEING PROCESSED

	IF ((MODU_PTR = GETBLK (MODU_TYP, MODU_LEN)) EQL 0)
	THEN
	    ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
	ELSE
	    BEGIN				!WE HAVE STORAGE FOR THE MODULE NAME

	    IF ((FILE_PTR [FILE_DOWN] = BLD_CHAIN (.FILE_PTR, .FILE_PTR [FILE_DOWN], .MODU_PTR)) EQL 0)
	    THEN
		ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
	    ELSE
		BEGIN				!WE HAVE STORAGE FOR THE CHAIN BLOCK
		CH$MOVE (LEN_MODU_NAME, CH$PTR (.ASCPTR), CH$PTR (MODU_PTR [MODU_NAME]));
		FILE_PTR [FILE_MODU] = .MODU_PTR;
		MODU_PTR [MODU_OBJ_FILE] = .FILE_PTR;
		MODU_PTR [MODU_SECTOR] = 0;
		END;

	    END;

	END;

    END;					!OF GSD_MNAME
ROUTINE GSD_CNAME (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = 	!PROCESS CSECT NAME ENTRY

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE CSECT NAME ENTRY OF THE GSD RECORD
!	 THIS IS IMPLEMENTED BY CONVERTING THE CSECT INTO
!	 AN APPROPRIATE PSECT.
!
! FORMAL PARAMETERS:
!
!	ASCPTR - POINTER TO NAME, IN ASCII
!	FLAGS - THE FLAGS BYTE
!	VALUE - THE VALUE WORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	CALLS GSD_PNAME
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'GSD_CNAME');

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	MODU_PTR : REF MODU_BLOCK;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'CSECT NAME, NAME = '));
	OUTSTR (1, .ASCPTR);
	OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
	OUTNUM (1, .FLAGS, 8, 0);
	OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
	OUTNUM (1, .VALUE, 8, 0);
	END;					!DEBUG

!
! TURN THE CSECT NAME ENTRY INTO A PSECT BY CALLING GSD_PNAME WITH
!  THE APPROPRIATE ARGUMENTS.
!

    IF (CH$EQL (LEN_PSECT_NAME, CH$PTR (.ASCPTR), LEN_PSECT_NAME,
	    CH$PTR (UPLIT (%ASCIZ'      '
		))))
    THEN
	BEGIN					!BLANK CSECT, MAKE LOCAL PSECT
	GSD_PSN (.ASCPTR, (1^PSECT_FLG_REL), .VALUE, .FILE_PTR);
	END
    ELSE

	IF (CH$EQL (LEN_PSECT_NAME, CH$PTR (.ASCPTR), LEN_PSECT_NAME,
		CH$PTR (UPLIT (%ASCIZ'. ABS.'
		    ))))
	THEN
	    BEGIN				!ASECT, MAKE AN ABSOLUTE PSECT
	    GSD_PSN (UPLIT (%ASCIZ'. ABS.'), ((1^PSECT_FLG_GBL) + (1^PSECT_FLG_OVR)), .VALUE, .FILE_PTR);
	    END
	ELSE
	    BEGIN				!NAMED CSECT, MAKE A GLOBAL PSECT
	    GSD_PSN (.ASCPTR, ((1^PSECT_FLG_GBL) + (1^PSECT_FLG_REL) + (1^PSECT_FLG_OVR)), .VALUE, .FILE_PTR);
	    END;

    END;					!OF GSD_CNAME
ROUTINE GSD_ISN (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = 	!PROCESS INTERNAL SYMBOL NAME ENTRY

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE INTERNAL SYMBOL NAME ENTRY OF THE GSD RECORD.
!	 THIS IS NOT IMPLEMENTED SINCE MACY11 DOES NOT PRODUCE
!	 THESE RECORDS.
!
! FORMAL PARAMETERS:
!
!	ASCPTR - POINTER TO NAME, IN ASCII
!	FLAGS - THE FLAGS BYTE
!	VALUE - THE VALUE WORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	PRINTS AN ERROR MESSAGE
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'GSD_ISN');

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'INTERNAL SYMBOL NAME, NAME = '));
	OUTSTR (1, .ASCPTR);
	OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
	OUTNUM (1, .FLAGS, 8, 0);
	OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
	OUTNUM (1, .VALUE, 8, 0);
	END;					!DEBUG

    ERRMSG (0, 12, ROUTINE_NAME, 0, 0, 0, 0);
    END;					!OF GSD_ISN
ROUTINE GSD_TRA (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = 	!PROCESS TRANSFER ADDRESS ENTRY

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE TRANSFER ADDRESS ENTRY OF THE GSD RECORD
!
! FORMAL PARAMETERS:
!
!	ASCPTR - POINTER TO NAME, IN ASCII
!	FLAGS - THE FLAGS BYTE
!	VALUE - THE VALUE WORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	STORES THE TRANSFER ADDRESS IN THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'GSD_TRA');

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	MODU_PTR : REF MODU_BLOCK,
	PSECT_PTR : REF PSECT_BLOCK,
	PSECT_INFO : VECTOR [3];

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'TRANSFER ADDRESS, NAME = '));
	OUTSTR (1, .ASCPTR);
	OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
	OUTNUM (1, .FLAGS, 8, 0);
	OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
	OUTNUM (1, .VALUE, 8, 0);
	END;					!DEBUG

    IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
    THEN
	ERRMSG (0, 10, ROUTINE_NAME, 0, 0, 0, 0)
    ELSE
	BEGIN
	PSECT_INFO [0] = .ASCPTR;
	PSECT_INFO [1] = 0;
	PSECT_INFO [2] = 0;
	PSECT_PTR = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_PSECT, PSECT_INFO);

	IF (.PSECT_PTR EQL 0)
	THEN
	    MODU_PTR [MODU_XFR_OFFSET] = .VALUE
	ELSE
	    BEGIN
	    MODU_PTR [MODU_XFR_PSECT] = .PSECT_PTR;
	    MODU_PTR [MODU_XFR_OFFSET] = .VALUE + .PSECT_PTR [PSECT_OFFSET];
	    END;

	END;

    END;					!OF GSD_TRA
ROUTINE SEL_GLOBAL (GLOBAL_PTR, GLOBAL_INFO) = 	!SELECT PROPER GLOBAL

!++
! FUNCTIONAL DESCRIPTION:
!
!	SELECT THE GLOBAL DESCRIBED FROM THE LIST OF ALL GLOBALS.
!	 USED IN A CALL TO FND_CHAIN.
!
! FORMAL PARAMETERS:
!
!	GLOBAL_PTR - POINTER TO GLOBAL TO TEST FOR SUITABILITY
!	GLOBAL_INFO - INFORMATION ABOUT THE GLOBAL WE ARE LOOKING FOR
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	POINTER TO THE GLOBAL, OR 0.
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	GLOBAL_PTR : REF GLOBL_BLOCK,
	GLOBAL_INFO : REF VECTOR [3];

!
! THE GLOBAL_INFO VECTOR CONTAINS:
!
! 0: POINTER TO THE GLOBAL NAME, IN ASCII
! 1: THE GLOBAL FLAGS
! 2: THE "VALUE" WORD FROM THE GLOBAL
!

    IF (CH$NEQ (LEN_GBL_NAME, CH$PTR (.GLOBAL_INFO [0]), LEN_GBL_NAME, CH$PTR (GLOBAL_PTR [GBL_NAME])))
    THEN
	0
    ELSE
	.GLOBAL_PTR

    END;					!OF SEL_GLOBAL
ROUTINE GSD_GSN (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = 	!PROCESS GLOBAL SYMBOL NAME

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE GLOBAL SYMBOL NAME ENTRY OF THE GSD RECORD
!
! FORMAL PARAMETERS:
!
!	ASCPTR - POINTER TO NAME, IN ASCII
!	FLAGS - THE FLAGS BYTE
!	VALUE - THE VALUE WORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	ADDS THE GLOBAL SYMBOL TO THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	OBTAINS SPACE FROM THE FREE LIST
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'GSD_GSN');

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	GLOBL_PTR : REF GLOBL_BLOCK,
	GLOBAL_INFO : VECTOR [3],
	MODU_PTR : REF MODU_BLOCK,
	MODU_PTR1 : REF MODU_BLOCK,
	PSECT_PTR : REF PSECT_BLOCK,
	TEMP_FLAGS;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'GLOBAL SYMBOL NAME, NAME = '));
	OUTSTR (1, .ASCPTR);
	OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
	OUTNUM (1, .FLAGS, 8, 0);
	OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
	OUTNUM (1, .VALUE, 8, 0);
	END;					!DEBUG

    IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
    THEN
	ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
	    0, 0)
    ELSE
	BEGIN					!WE ARE PROCESSING A MODULE
	PSECT_PTR = .MODU_PTR [MODU_PSECT];
	GLOBAL_INFO [0] = .ASCPTR;
	GLOBAL_INFO [1] = .FLAGS;
	GLOBAL_INFO [2] = .VALUE;
!
! BE SURE THE GLOBAL IS NOT ALREADY CHAINED TO THE CURRENT MODULE.
!
	GLOBL_PTR = FND_CHAIN (.MODU_PTR [MODU_GLOBALS], SEL_GLOBAL, GLOBAL_INFO);

	IF (.GLOBL_PTR NEQ 0)
	THEN
	    BEGIN				!ALREADY CHAINED
	    MODU_PTR1 = .GLOBL_PTR [GBL_DEF_MODU];
	    TEMP_FLAGS = .GLOBL_PTR [GBL_FLAGS];
	    ERRMSG (0, 13, GLOBL_PTR [GBL_NAME], MODU_PTR1 [MODU_NAME], 	!
		.GLOBL_PTR [GBL_VALUE] + 	!
		(IF (.TEMP_FLAGS<GBL_FLG_REL, 1> EQL 0) THEN 0 ELSE %O'200000'), 	!
		MODU_PTR [MODU_NAME], 		!
		.VALUE + (IF (.FLAGS<GBL_FLG_REL, 1> EQL 0) THEN 0 ELSE %O'200000'));
	    END
	ELSE
	    BEGIN				!NO PREVIOUS REFERENCE TO THIS SYMBOL

	    IF ((GLOBL_PTR = GETBLK (GLOBL_TYP, GLOBL_LEN)) EQL 0)
	    THEN
		ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0,
		    0)
	    ELSE
		BEGIN				!WE HAVE STORAGE FOR THE GLOBAL BLOCK
		CH$MOVE (LEN_GBL_NAME, CH$PTR (.ASCPTR), CH$PTR (GLOBL_PTR [GBL_NAME]));
		GLOBL_PTR [GBL_FLAGS] = .FLAGS;
		GLOBL_PTR [GBL_VALUE] = .VALUE;
		GLOBL_PTR [GBL_DEF_MODU] = .MODU_PTR;

		IF ((MODU_PTR [MODU_GLOBALS] = BLD_CHAIN (.MODU_PTR, .MODU_PTR [MODU_GLOBALS], .GLOBL_PTR))
		    EQL 0)
		THEN
		    ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0);

		IF (.FLAGS<GBL_FLG_REL, 1> NEQ 0)
		THEN
		    BEGIN
		    GLOBL_PTR [GBL_DEF_PSECT] = .PSECT_PTR;
		    GLOBL_PTR [GBL_DEF_OFFSET] = .PSECT_PTR [PSECT_OFFSET];
		    END;

		END;

	    END;

	END;

    END;					!OF GSD_GSN
ROUTINE SEL_PSECT (PSECT_PTR, PSECT_INFO) = 	!SELECT PROPER PSECT

!++
! FUNCTIONAL DESCRIPTION:
!
!	SELECT THE PSECT DESCRIBED FROM THE LIST OF ALL PSECTS.
!	 USED IN A CALL TO FND_CHAIN.
!
! FORMAL PARAMETERS:
!
!	PSECT_PTR - POINTER TO PSECT TO TEST FOR SUITABILITY
!	PSECT_INFO - INFORMATION ABOUT THE PSECT WE ARE LOOKING FOR
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	POINTER TO THE PSECT, OR 0.
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	PSECT_PTR : REF PSECT_BLOCK,
	PSECT_INFO : REF VECTOR [3];

!
! THE PSECT_INFO VECTOR CONTAINS:
!
! 0: POINTER TO THE PSECT NAME, IN ASCII
! 1: THE PSECT FLAGS
! 2: THE MAXIMUM LENGTH OF THE PSECT
!

    IF (CH$NEQ (LEN_PSECT_NAME, CH$PTR (.PSECT_INFO [0]), LEN_PSECT_NAME, CH$PTR (PSECT_PTR [PSECT_NAME])))
    THEN
	0
    ELSE
	.PSECT_PTR

    END;					!OF SEL_PSECT
ROUTINE GSD_PSN (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = 	!PROCESS PSECT NAME

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE PROGRAM SECTION NAME ENTRY OF THE GSD RECORD
!
! FORMAL PARAMETERS:
!
!	ASCPTR - POINTER TO NAME, IN ASCII
!	FLAGS - THE FLAGS BYTE
!	VALUE - THE VALUE WORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	ADDS THE PSECT NAME TO THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	OBTAINS SPACE FROM THE FREE LIST
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'GSD_PSN');

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	MODU_PTR : REF MODU_BLOCK,
	PSECT_PTR : REF PSECT_BLOCK,
	PSECT_INFO : VECTOR [3],
	SEARCH_DONE;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'PSECT NAME, NAME = '));
	OUTSTR (1, .ASCPTR);
	OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
	OUTNUM (1, .FLAGS, 8, 0);
	OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
	OUTNUM (1, .VALUE, 8, 0);
	END;					!DEBUG

    IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
    THEN
	ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
	    0, 0)
    ELSE
	BEGIN					!WE ARE PROCESSING A MODULE
	PSECT_INFO [0] = .ASCPTR;
	PSECT_INFO [1] = .FLAGS;
	PSECT_INFO [2] = .VALUE;
!
	PSECT_PTR = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_PSECT, PSECT_INFO);

	IF (.PSECT_PTR EQL 0)
	THEN
	    BEGIN				!FIRST REFERENCE TO THIS PSECT BY THIS MODULE

	    IF ((PSECT_PTR = GETBLK (PSECT_TYP, PSECT_LEN)) EQL 0)
	    THEN
		ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0,
		    0)
	    ELSE
		BEGIN				!WE HAVE STORAGE FOR THE PSECT BLOCK
		CH$MOVE (LEN_PSECT_NAME, CH$PTR (.ASCPTR), CH$PTR (PSECT_PTR [PSECT_NAME]));
		PSECT_PTR [PSECT_FLAGS] = .FLAGS;
		PSECT_PTR [PSECT_SIZE] = 0;
		PSECT_PTR [PSECT_OFFSET] = 0;

		IF ((MODU_PTR [MODU_PSECTS] = BLD_CHAIN (.MODU_PTR, .MODU_PTR [MODU_PSECTS], .PSECT_PTR)) EQL
		    0)
		THEN
		    ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		ELSE
		    PSECT_PTR = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_PSECT, PSECT_INFO);

		IF (.PSECT_PTR EQL 0)
		THEN
		    ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		ELSE
		    BEGIN
		    MODU_PTR [MODU_PSECT] = .PSECT_PTR;
		    PSECT_PTR [PSECT_OFFSET] = (IF (.FLAGS<PSECT_FLG_OVR, 1> NEQ 0) THEN 0 ELSE .PSECT_PTR [
			    PSECT_SIZE] + (IF ((.PSECT_PTR [PSECT_SIZE] MOD 2) EQL 0) THEN 0 ELSE 1));
		    PSECT_PTR [PSECT_SIZE] = (IF (.FLAGS<PSECT_FLG_OVR, 1> NEQ 0) THEN MAX (.PSECT_PTR [
				PSECT_SIZE], .VALUE) ELSE .PSECT_PTR [PSECT_SIZE] + .VALUE);
		    PSECT_PTR [PSECT_SECTOR] = .MODU_PTR [MODU_SECTOR];

		    IF ((MODU_PTR [MODU_SECTOR] = .MODU_PTR [MODU_SECTOR] + 1) GTR 255)
		    THEN
			ERRMSG (0, 10,
			    ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);

		    END;

		END;

	    END;				!OF FIRST REFERENCE TO THIS PSECT BY THIS MODULE

	IF (((.PSECT_PTR [PSECT_FLAGS] XOR .FLAGS) AND ((1^PSECT_FLG_HI) OR (1^PSECT_FLG_LIB) OR (1^
	    PSECT_FLG_OVR) OR (1^PSECT_FLG_RO) OR (1^PSECT_FLG_REL) OR (1^PSECT_FLG_GBL) OR (1^PSECT_FLG_DATA)
	    )) NEQ 0)
	THEN
	    ERRMSG (0, 15, ROUTINE_NAME, MODU_PTR [MODU_NAME], PSECT_PTR [PSECT_NAME],
		.PSECT_PTR [PSECT_FLAGS], .FLAGS);

	END;					!OF PROCESSING A MODULE

    END;					!OF GSD_PSN
ROUTINE GSD_IDENT (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = 	!PROCESS VERSION IDENT

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE PROGRAM VERSION IDENTIFICATION ENTRY OF THE
!	 GSD RECORD.  THIS ENTRY IS PRODUCED BY THE ".IDENT"
!	 ASSEMBLER DIRECTIVE.
!
! FORMAL PARAMETERS:
!
!	ASCPTR - POINTER TO NAME, IN ASCII
!	FLAGS - THE FLAGS BYTE
!	VALUE - THE VALUE WORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	ADDS THE IDENTIFICATION TO THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'GSD_IDENT');

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	MODU_PTR : REF MODU_BLOCK;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'PROGRAM VERSION IDENTIFICATION, NAME = '));
	OUTSTR (1, .ASCPTR);
	OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
	OUTNUM (1, .FLAGS, 8, 0);
	OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
	OUTNUM (1, .VALUE, 8, 0);
	END;					!DEBUG

    IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
    THEN
	ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
	    0, 0)
    ELSE
	BEGIN					!THERE IS A MODULE BEING PROCESSED
	CH$MOVE (LEN_MODU_VER, CH$PTR (.ASCPTR), CH$PTR (MODU_PTR [MODU_IDENT]));
	MODU_PTR [MODU_FLAG_IDENT] = 1;
	END;

    END;					!OF GSD_IDENT
ROUTINE GSD_MAP (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = 	!PROCESS MAPPED ARRAY

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE MAPPED ARRAY ENTRY OF THE GSD RECORD.
!	 THIS IS NOT IMPLEMENTED SINCE IT IS NOT PRODUCED BY MACY11.
!
! FORMAL PARAMETERS:
!
!	ASCPTR - POINTER TO NAME, IN ASCII
!	FLAGS - THE FLAGS BYTE
!	VALUE - THE VALUE WORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	PRINTS AN ERROR MESSAGE
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'GSD_MAP');

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'MAPPED ARRAY DECLARATION, NAME = '));
	OUTSTR (1, .ASCPTR);
	OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
	OUTNUM (1, .FLAGS, 8, 0);
	OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
	OUTNUM (1, .VALUE, 8, 0);
	END;					!DEBUG

    ERRMSG (0, 12, ROUTINE_NAME, 0, 0, 0, 0);
    END;					!OF GSD_MAP
GLOBAL ROUTINE SYM_VAL (FILE_PTR, SYMBOL_NAME, ERR) = 	!GET VALUE OF NAMED SYMBOL

!++
! FUNCTIONAL DESCRIPTION:
!
!	GET THE VALUE OF A NAMED SYMBOL FROM A (SYMBOL TABLE) FILE
!
! FORMAL PARAMETERS:
!
!	FILE_PTR - THE FILE BLOCK THAT MAY HAVE THE SPECIFIED SYMBOL
!	SYMBOL_NAME - NAME OF THE SYMBOL, MAX OF 7 WITH LAST NULL.
!	ERR - 0 = PRINT ERROR MESSAGE IF NOT FOUND, 1 = JUST RETURN -1.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	VALUE OF THE SYMBOL, OR -1 IF UNDEFINED.
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'SYMBOL_VALUE');

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	GLOBL_PTR : REF GLOBL_BLOCK,
	MODU_PTR : REF MODU_BLOCK,
	CHAR_NUMBER,
	SYMBOL_END,
	PADDED_SYMBOL : VECTOR [CH$ALLOCATION (LEN_GBL_NAME)];

    IF (.FILE_PTR EQL 0)
    THEN
	BEGIN
	ERRMSG (0, 32, ROUTINE_NAME, .SYMBOL_NAME, FILE_PTR [FILE_NAME], 0, 0);
	-1
	END
    ELSE
	BEGIN
	MODU_PTR = .FILE_PTR [FILE_MODU];

	IF (.MODU_PTR EQL 0)
	THEN
	    BEGIN
	    ERRMSG (0, 32, ROUTINE_NAME, .SYMBOL_NAME, FILE_PTR [FILE_NAME], 0, 0);
	    -1
	    END
	ELSE
	    BEGIN
	    SYMBOL_END = CH$FIND_CH (LEN_GBL_NAME-1, CH$PTR (.SYMBOL_NAME), 0);

	    IF CH$FAIL (.SYMBOL_END)
	    THEN
		GLOBL_PTR = FND_CHAIN (.MODU_PTR [MODU_GLOBALS], SEL_SYMBOL,
		    .SYMBOL_NAME)
	    ELSE
		BEGIN
		CHAR_NUMBER = CH$DIFF (.SYMBOL_END, CH$PTR (.SYMBOL_NAME));
		CH$WCHAR (0,
		    CH$COPY (.CHAR_NUMBER, CH$PTR (.SYMBOL_NAME), %C' ', LEN_GBL_NAME-1,
			CH$PTR (PADDED_SYMBOL)));
		GLOBL_PTR = FND_CHAIN (.MODU_PTR [MODU_GLOBALS], SEL_SYMBOL, PADDED_SYMBOL);
		END;

	    IF (.GLOBL_PTR EQL 0)
	    THEN
		BEGIN

		IF (.ERR EQL 0) THEN ERRMSG (0, 32, ROUTINE_NAME, .SYMBOL_NAME, FILE_PTR [FILE_NAME], 0, 0);

		-1
		END
	    ELSE
		(GBL_VAL (.GLOBL_PTR)) AND %O'177777'

	    END

	END

    END;					!OF SYM_VAL
ROUTINE SEL_SYMBOL (GLOBL_PTR, SYMBOL_NAME) = 	!SEE IF THIS IS THE TARGET SYMBOL

!++
! FUNCTIONAL DESCRIPTION:
!
!	SEE IF THIS IS THE SYMBOL WE ARE SEARCHING FOR.  USED IN
!	 CALL TO FND_CHAIN.
!
! FORMAL PARAMETERS:
!
!	GLOBL_PTR - POINTER TO THE SYMBOL TO TEST
!	SYMBOL_NAME - POINTER TO NAME OF SYMBOL WE ARE LOOKING FOR
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	0 IF THIS IS NOT THE PROPER SYMBOL (WHICH WILL CAUSE FND_CHAIN
!	 TO KEEP SEARCHING), OR THE POINTER TO THE GLOBAL BLOCK IF
!	 THE NAME MATCHES.
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	GLOBL_PTR : REF GLOBL_BLOCK;

    IF (CH$EQL (LEN_GBL_NAME, CH$PTR (GLOBL_PTR [GBL_NAME]), LEN_GBL_NAME, CH$PTR (.SYMBOL_NAME), 0))
    THEN
	.GLOBL_PTR
    ELSE
	0

    END;					!OF SEL_SYMBOL
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 AND GIVES AN ERROR MESSAGE.
!
! 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, WITH THE HIGH-ORDER BIT
!	 SPREAD.
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	GLOBL_PTR : REF GLOBL_BLOCK;

    LOCAL
	FLAGS,
	PSECT_PTR : REF PSECT_BLOCK,
	RESULT;

    FLAGS = .GLOBL_PTR [GBL_FLAGS];

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

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

	IF (.RESULT<15, 1> NEQ 0) THEN RESULT<16, 20> = -1;

	.RESULT
	END

    END;					!OF GBL_VAL

END

ELUDOM