Google
 

Trailing-Edge - PDP-10 Archives - BB-R595B-SM_11-9-85 - mcb/tkb36/bfio.bli
There are 2 other files named bfio.bli in the archive. Click here to see a list.
!<DECNET20-V3P0.TKB-VNP>BFIO.BLI.10 16-Jan-81 14:41:38, Edit by SROBINSON
!NET:<DECNET20-V3P0.TKB-VNP>BFIO.BLI.7 16-Jan-81 12:18:08, Edit by SROBINSON
!<REL4A.TKB-VNP>BFIO.BLI.10, 28-Nov-79 07:20:19, Edit by SROBINSON
MODULE BFIO (					!BINARY FILE I/O
		IDENT = 'X2.0-3'
		) =
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 READS THE BINARY ("OBJECT") FILE, CHECKING CHECKSUMS.
!
!
! ENVIRONMENT: TOPS-20 USER MODE
!
! AUTHOR: J. SAUTER, CREATION DATE: 20-JAN-78
!
! MODIFIED BY:
!
!	Scott G. Robinson, 26-SEP-78 : VERSION X0.1-2A
!	- Modify so that a recovery can be done on a module error
!	   such as reading a DOS formatted module in RSX mode
!	- Fixup so that odd length records are aligned correctly
!	- Fix problem with complex relocation that caused constant operands
!	   to not be generated correctly
!	- Ensure PSECTs are considered in Radix-50 Order
!
!	Scott G. Robinson, 18-FEB-79 : VERSION X0.1-3
!	- Modify TEXT processing to include a pointer to the MODULE block
!	   so that BCOR can obtain vital statistics about a load module
!
!	Dale C. Gunn, 24-AUG-79 : VERSION X0.1-4
!	- Modify GSD_PSN to not round text offsets within PSECT's
!
!------------ End of modifications for V0 and V1 ------------

!
!
!	Scott G. Robinson, 28-NOV-79 : Version X2.0
!	- Make object module reading a two pass operation so
!	   that BLISS-16 objects work correctly. Also ensure
!	   TOPS-10 compatibility.
!
!	Scott G. Robinson, 16-JAN-81 : Version X2.0-1
!	- Make Transfer Addresses work Correctly for BCOR
!	- Make Selective Search Flags apply to Libraries
!
!	Scott G. Robinson, 27-JAN-81 : Version X2.0-2
!	- Make Global Symbols defined after referenced in same
!	  module work correctly
!
!	Scott G. Robinson, 28-JAN-81 : Version X2.0-3
!	- Make another fix to /SSed Global Symbol References
!
!	, : VERSION
! 01	-
!--

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

FORWARD ROUTINE
    RD16,					!READ A 16-BIT WORD
    RDOBBL,					!READ AN OBJECT BLOCK
    RDLBBL,					!READ A LIBRARY BLOCK
    RDFILE : NOVALUE,				!READ AN OBJECT FILE
    RDLIBR : NOVALUE,				!READ A LIBRARY FILE
    GET_BYTE,					!GET BYTE FROM OBJ RECORD
    GET_WORD,					!GET WORD FROM OBJ RECORD
!
! ROUTINES FOR PROCESSING OBJECT RECORDS
!
    OBJ_GSD : NOVALUE,				!PROCESS GSD RECORD
    OBJ_END_GSD : NOVALUE,			!PROCESS END GSD RECORD
    OBJ_TEXT : NOVALUE,				!PROCESS TEXT RECORD
    OBJ_RLD : NOVALUE,				!PROCESS RLD RECORD
    OBJ_ISD : NOVALUE,				!PROCESS INTERNAL SYMBOL DICTIONARY RECORD
    OBJ_EOM : NOVALUE,				!PROCESS END OF MODULE
!
! ROUTINES FOR PROCESSING GSD ENTRIES
!
    GSD_MNAME : NOVALUE,			!PROCESS MODULE NAME
    GSD_CNAME : NOVALUE,			!PROCESS CSECT NAME ENTRY
    GSD_ISN : NOVALUE,				!PROCESS INTERNAL SYMBOL NAME
    GSD_TRA : NOVALUE,				!PROCESS TRANSFER ADDRESS
    SEL_GLOBAL,					!FIND A GLOBAL SYMBOL
    GSD_GSN : NOVALUE,				!PROCESS GLOBAL SYMBOL NAME
    SEL_PSECT,					!FIND A PSECT BY NAME
    SEL_SECTOR,					!FIND A PSECT BY SECTOR
    GSD_PSN : NOVALUE,				!PROCESS PSECT NAME
    GSD_IDENT : NOVALUE,			!PROCESS AN IDENT
    GSD_MAP : NOVALUE,				!PROCESS A MAPPED ARRAY
!
! ROUTINES FOR PROCESSING RLD ENTRIES
!
    M_RLDH,					!MAKE RLDH BLOCK
    M_RLDD,					!MAKE RLDD BLOCK
    GBL_REF : NOVALUE,				!RECORD A GLOBAL REFERENCE
    R_ERR : NOVALUE,				!ERROR (NOT USED)
    R_IR : NOVALUE,				!INTERNAL RELOCATION
    R_GR : NOVALUE,				!GLOBAL RELOCATION
    R_IDR : NOVALUE,				!INTERNAL DISPLACED RELOCATION
    R_GDR : NOVALUE,				!GLOBAL DISPLACED RELOCATION
    R_GAR : NOVALUE,				!GLOBAL ADDITIVE RELOCATION
    R_GADR : NOVALUE,				!GLOBAL ADDITIVE DISPLACED RELOCATION
    R_LCD : NOVALUE,				!LOCATION COUNTER DEFINITION
    R_LCM : NOVALUE,				!LOCATION COUNTER MODIFICATION
    R_PL : NOVALUE,				!PROGRAM LIMITS
    R_PR : NOVALUE,				!PSECT RELOCATION
    R_PDR : NOVALUE,				!PSECT DISPLACED RELOCATION
    R_PAR : NOVALUE,				!PSECT ADDITIVE RELOCATION
    R_PADR : NOVALUE,				!PSECT ADDITIVE DISPLACED RELOCATION
    R_CR : NOVALUE,				!COMPLEX RELOCATION
    R_LR : NOVALUE;				!LIBRARY RELOCATION

!
! INCLUDE FILES:
!

LIBRARY 'TKBLIB';

!REQUIRE 'BLOCKH.REQ';				!PREPARE TO DEFINE STORAGE BLOCKS
!REQUIRE 'FILE.REQ';				!DEFINE FILE STORAGE BLOCKS
!REQUIRE 'GLOBL.REQ';				!DEFINE GLOBAL STORAGE BLOCK
!REQUIRE 'MODU.REQ';				!DEFINE MODULE STORAGE BLOCK
!REQUIRE 'PSECT.REQ';				!DEFINE PSECT STORAGE BLOCK
!REQUIRE 'RLDD.REQ';				!DEFINE RLD DATA STORAGE BLOCK
!REQUIRE 'RLDH.REQ';				!DEFINE RLD HEADER STORAGE BLOCK
!REQUIRE 'ROOT.REQ';				!DEFINE ROOT STORAGE BLOCK
!REQUIRE 'TEXTD.REQ';				!DEFINE OBJECT TEXT DATA STORAGE BLOCK
!REQUIRE 'TEXTH.REQ';				!DEFINE OBJECT TEXT HEADER STORAGE BLOCK
!REQUIRE 'BLOCKT.REQ';				!END OF STORAGE BLOCK DEFINITIONS
!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!

LITERAL
    DEBUG = 0;

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

EXTERNAL ROUTINE
    OPEN : NOVALUE,				!OPEN A FILE
    CLOSE : NOVALUE,				!CLOSE A FILE
    INPUT,					!READ FROM A FILE
    ERRMSG : NOVALUE,				!PRINT AN ERROR MESSAGE
    GETSTG,					!GET STORAGE FROM THE FREE LIST
    GET_SW,					!GET A FILE SWITCH
    FRESTG,					!RETURN STORAGE TO THE FREE LIST
    GETBLK,					!GET A STORAGE BLOCK
    BLD_CHAIN,					!BUILD A CHAIN BLOCK
    FND_CHAIN,					!FIND AN ITEM IN A CHAINED BLOCK
    RX50,					!CONVERT CHARACTER TO RADIX 50
    R50TOA : NOVALUE,				!CONVERT RADIX 50 TO ASCII
    PCRLF : NOVALUE,				!PRINT CRLF
    OUTPUT : NOVALUE,				!WRITE ON A FILE
    OUTNUM : NOVALUE,				!PRINT A NUMBER
    OUTSTR : NOVALUE;				!PRINT AN ASCII STRING

EXTERNAL
    ROOT : REF ROOT_BLOCK;			!ROOT OF DATA STRUCTURE
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 RDOBBL (CHAN, FILE_PTR, BYTES_READ) = 	!READ AN OBJECT BLOCK

!++
! FUNCTIONAL DESCRIPTION:
!
!	READ A BLOCK OF DATA FROM THE OBJECT FILE.  THIS BLOCK
!	 STARTS WITH A HEADER OF 1 AND ENDS WITH A CHECKSUM.
!	 LEADING ZEROS ARE IGNORED.  AFTER THE HEADER IS A COUNT
!	 WORD WHICH IS FOLLOWED BY TEXT.  THIS TEXT MAY CONTAIN
!	 SEVERAL RECORDS.
!	THIS FORMAT IS USED BY ".OBJ" FILES WHICH HAVE BEEN PASSED
!	 THROUGH THE RSX-11M UTILITY "FLX".
!
! 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_OBJECT_BLOCK');

    MAP
	FILE_PTR : REF FILE_BLOCK;

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

    CHKSUM = 0;
    .BYTES_READ = 0;
    RESULT = 0;
!
! SKIP BLANK LEADER
!

    DO
	BEGIN
	BYTE1 = INPUT (.CHAN);
	.BYTES_READ = ..BYTES_READ + 1;
	END
    UNTIL (.BYTE1 NEQ 0);

    IF (.BYTE1 NEQ 1)
    THEN
	BEGIN

	IF (..BYTES_READ LEQ 2) THEN RETURN -1;

	IF (.BYTE1 GTR 0) THEN ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);

	RESULT = -1;
	END
    ELSE
	BEGIN
	CHKSUM = .CHKSUM + .BYTE1;
	BYTE1 = INPUT (.CHAN);
	.BYTES_READ = ..BYTES_READ + 1;

	IF (.BYTE1 NEQ 0)
	THEN
	    BEGIN
	    ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
	    RESULT = -1;
	    END
	ELSE
	    BEGIN
	    .BYTES_READ = ..BYTES_READ + 2;

	    IF ((OUTLEN = RD16 (.CHAN, CHKSUM)) LSS 6)
	    THEN
		BEGIN
		ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
		RESULT = -1;
		END
	    ELSE
		BEGIN

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

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

			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
		    ELSE
			BEGIN
			BYTE1 = INPUT (.CHAN);
			.BYTES_READ = ..BYTES_READ + 1;

			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
			ELSE
			    BEGIN
			    CHKSUM = -.CHKSUM;
			    CHKSUM = .CHKSUM<0, 8>;

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

			    END;

			END;

		    END;

		END;

	    END;

	END;

    .RESULT
    END;					!OF RDOBBL
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;

!
! SKIP TO VIRTUAL WORD BOUNDARY
!

    IF ((..BYTES_READ AND 1) EQL 1)
    THEN
	BEGIN
	INPUT (.CHAN);
	.BYTES_READ = ..BYTES_READ + 1;
	END;

    .RESULT
    END;					!OF RDLBBL
GLOBAL ROUTINE RDFILE (CHAN, FILE_PTR) : NOVALUE = 	!READ AN OBJECT FILE

!++
! FUNCTIONAL DESCRIPTION:
!
!	READ AN OBJECT FILE AND PROCESS EACH RECORD.
!
!
! FORMAL PARAMETERS:
!
!	CHAN - THE CHANNEL OVER WHICH TO READ DATA.  IT MUST HAVE
!	 BEEN OPENED IN WORD MODE.
!	FILE_PTR - POINTER TO FILE BLOCK FOR ERROR MESSAGES
!	 AND TO SERVE AS A ROOT BLOCK FOR THE DATA READ.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	READS DATA FROM THE INPUT CHANNEL.  MAY GET EOF.
!	OBTAINS STORAGE FROM THE FREE LIST.
!	 ALL SUCH STORAGE IS RETURNED BEFORE THIS ROUTINE EXITS.
!	CALLS THE RECORD PROCESSING ROUTINES, SEVERAL OF WHICH
!	 OBTAIN STORAGE FROM THE FREE LIST.
!
!--

    BEGIN

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

    MAP
	FILE_PTR : REF FILE_BLOCK;

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

! /-SS is the default condition for files
    ROOT [SS_FLAG] = 0;
! The /DOS switch is no longer used...
!   DOS_SW = GET_SW (.FILE_PTR, UPLIT (%ASCIZ'DOS', 0));
!
! At first, try reading the object module as DOS format
!  If that fails then read it in RSX format and continue on
!
    BLKPTR = RDOBBL (.CHAN, .FILE_PTR, BYTES_READ);
    DOS_SW = 1;

    IF ((.BLKPTR EQL -1) AND (.BYTES_READ LEQ 2))
    THEN
	BEGIN
	CLOSE (.CHAN);
	OPEN (.CHAN, FILE_PTR [FILE_NAME], 2, 0, UPLIT (%ASCIZ'OBJ'));
	BLKPTR = RDLBBL (.CHAN, .FILE_PTR, BYTES_READ);
	DOS_SW = 0;
	END;

!
! Begin in Pass 1 over the object module
!
    OBJ_PASS = 1;
!
! The following is the main loop over the object module, it continues
!  until we have read an apparent EOF for the second pass over the object
!  module.
!

    DO
	BEGIN

	IF (.BLKPTR GTR 0)
	THEN
	    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);
!
! We now process the object records based upon the particular OBJ_PASS.
!  During pass 1 we read only GSD and END_GSD records. During pass 2 we
!  read the other records...
!

	    CASE .OBJ_PASS FROM 1 TO 2 OF
		SET

		[1] :

		    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

			[INRANGE] :
			;

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

		[2] :

		    CASE .RECORD_TYPE FROM 1 TO 6 OF
			SET

			[3] :
			    OBJ_TEXT (BYTEPTR, BYTECTR, .FILE_PTR);	!TEXT

			[4] :
			    OBJ_RLD (BYTEPTR, BYTECTR, .FILE_PTR);	!RELOCATION DICTIONARY

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

			[6] :
			    OBJ_EOM (BYTEPTR, BYTECTR, .FILE_PTR);	!END OF MODULE

			[INRANGE] :
			;

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

		TES;

	    FRESTG (.BLKPTR, .BLKPTR [0]);
	    BLKPTR = (IF (.DOS_SW NEQ 0) THEN RDOBBL ELSE RDLBBL) (.CHAN, .FILE_PTR, BYTES_READ);

	    IF (.BLKPTR LEQ 0)
	    THEN
		BEGIN
		OBJ_PASS = .OBJ_PASS + 1;

		IF (.OBJ_PASS EQL 2)
		THEN
		    BEGIN
		    CLOSE (.CHAN);
		    OPEN (.CHAN, FILE_PTR [FILE_NAME], 2, 0, UPLIT (%ASCIZ'OBJ'));
		    BLKPTR = (IF (.DOS_SW NEQ 0) THEN RDOBBL ELSE RDLBBL) (.CHAN, .FILE_PTR, BYTES_READ);
		    END;

		END

	    END

	END
    UNTIL (.BLKPTR LEQ 0);

    END;					!OF READ_FILE
GLOBAL ROUTINE RDLIBR (CHAN, FILE_PTR) : NOVALUE = 	!READ A LIBRARY FILE

!++
! FUNCTIONAL DESCRIPTION:
!
!	READ A LIBRARY FILE.  ACCEPT ONLY THOSE MODULES WHICH
!	 DEFINE SYMBOLS CURRENTLY UNDEFINED.
!
!
! FORMAL PARAMETERS:
!
!	CHAN - THE CHANNEL OVER WHICH TO READ DATA.  IT MUST HAVE
!	 BEEN OPENED IN WORD MODE.
!	FILE_PTR - POINTER TO FILE BLOCK FOR ERROR MESSAGES
!	 AND TO SERVE AS A ROOT BLOCK FOR THE DATA READ.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	READS DATA FROM THE INPUT CHANNEL.  MAY GET EOF.
!	OBTAINS STORAGE FROM THE FREE LIST.
!	 ALL SUCH STORAGE IS RETURNED BEFORE THIS ROUTINE EXITS.
!	CALLS THE RECORD PROCESSING ROUTINES, SEVERAL OF WHICH
!	 OBTAIN STORAGE FROM THE FREE LIST.
!
!--

    BEGIN

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

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	ASCVAL : VECTOR [CH$ALLOCATION (LEN_GBL_NAME)],
	ATTRIBUTES,
	BLKPTR : REF VECTOR,
	BYTECTR,
	BYTEPTR,
	BYTES_READ,
	CHAR,
	CHKSUM,
	COUNTER,
	EPT_BLOCK,
	EPT_BYTE,
	EPT_NUMBER,
	EPT_POSITION,
	EPT_SIZE,
	FILE_POSITION,
	FLAGS,
	GLOBL_PTR : REF GLOBL_BLOCK,
	GLOBL_PTR1 : REF GLOBL_BLOCK,
	MOD_SIZE,
	MODU_DONE,
	POINTER,
	PREV_CHAR : VECTOR [3],
	R50VAL,
	RECORD_TYPE,
	SCAN_DONE,
	SEARCH_DONE;

! /-SS is the Default for reading libraries
    ROOT [SS_FLAG] = 0;
!
! READ RELAVENT INFORMATION FROM THE LIBRARY HEADER.
!
! FIRST SKIP VERSION AND DATES
!

    INCR COUNTER FROM 1 TO 9 DO
	RD16 (.CHAN, CHKSUM);

    FILE_POSITION = 18;
!
! READ EPT SIZE, STARTING BLOCK AND NUMBER
!
    EPT_SIZE = RD16 (.CHAN, CHKSUM);
    FILE_POSITION = .FILE_POSITION + 2;
    EPT_SIZE = .EPT_SIZE<0, 8>;
    EPT_BLOCK = RD16 (.CHAN, CHKSUM);
    FILE_POSITION = .FILE_POSITION + 2;
    EPT_NUMBER = RD16 (.CHAN, CHKSUM);
    FILE_POSITION = .FILE_POSITION + 2;
!
! NOW SKIP TO THE BEGINNING OF THE ENTRY POINT TABLE
!

    INCR COUNTER FROM (.FILE_POSITION/2) TO ((.EPT_BLOCK - 1)*256) - 1 DO
	RD16 (.CHAN, CHKSUM);

    FILE_POSITION = (.EPT_BLOCK - 1)*512;
!
! SCAN THE ENTRY POINT TABLE, NOTING MODULES THAT NEED TO BE READ.
!

    INCR COUNTER FROM 1 TO .EPT_NUMBER DO
	BEGIN
	R50VAL = 0;
	R50VAL<16, 16> = RD16 (.CHAN, CHKSUM);
	R50VAL<0, 16> = RD16 (.CHAN, CHKSUM);
	R50TOA (.R50VAL, ASCVAL [0]);
	EPT_BLOCK = RD16 (.CHAN, CHKSUM);
	EPT_BYTE = RD16 (.CHAN, CHKSUM);

	INCR COUNTER1 FROM 5 TO (.EPT_SIZE/2) DO
	    RD16 (.CHAN, CHKSUM);

	FILE_POSITION = .FILE_POSITION + .EPT_SIZE;
	SEARCH_DONE = 0;
	GLOBL_PTR = .ROOT [ROOT_GLOBALS];

	IF (.GLOBL_PTR NEQ 0)
	THEN

	    WHILE (.SEARCH_DONE EQL 0) DO

		IF (CH$GTR (LEN_GBL_NAME, CH$PTR (ASCVAL [0]), LEN_GBL_NAME, CH$PTR (GLOBL_PTR [GBL_NAME])))
		THEN
		    BEGIN
		    GLOBL_PTR = .GLOBL_PTR [GBL_NEXT];

		    IF (.GLOBL_PTR EQL 0) THEN SEARCH_DONE = 2;

		    END
		ELSE
		    SEARCH_DONE = 1;

	IF (.SEARCH_DONE EQL 1)
	THEN
	    BEGIN

	    IF (CH$EQL (LEN_GBL_NAME, CH$PTR (ASCVAL [0]), LEN_GBL_NAME, CH$PTR (GLOBL_PTR [GBL_NAME])))
	    THEN
		SEARCH_DONE = 3

	    END;

	IF (.SEARCH_DONE EQL 3)
	THEN
	    BEGIN
	    FLAGS = .GLOBL_PTR [GBL_FLAGS];

	    IF (.FLAGS<GBL_FLG_DEF, 1> EQL 0)
	    THEN
		BEGIN				!THIS IS AN UNDEFINED GLOBAL

		IF (.GLOBL_PTR [GBL_IN_EPT] EQL 0)
		THEN
		    BEGIN			!NOT ALREADY SEEN
		    GLOBL_PTR [GBL_IN_EPT] = 1;
		    GLOBL_PTR [GBL_EPT_POS] = ((.EPT_BLOCK - 1)*512) + (.EPT_BYTE + 2);
		    END;

		END;

	    END;

	END;					!OF SCANNING EPT

!
! NOW FIND THE EARLIEST UNSATISFIED REQUEST, SKIP TO THERE IN THE
!  LIBRARY FILE, AND PROCESS THAT MODULE.
!
    SCAN_DONE = 0;

    WHILE (.SCAN_DONE EQL 0) DO
	BEGIN
	SEARCH_DONE = 0;
	GLOBL_PTR = .ROOT [ROOT_GLOBALS];
	EPT_POSITION = 0;

	WHILE (.SEARCH_DONE EQL 0) DO
	    BEGIN

	    IF (.GLOBL_PTR EQL 0)
	    THEN
		SEARCH_DONE = 1
	    ELSE
		BEGIN
		FLAGS = .GLOBL_PTR [GBL_FLAGS];

		IF ((.GLOBL_PTR [GBL_IN_EPT] NEQ 0) AND .FLAGS<GBL_FLG_DEF, 1> EQL 0)
		THEN
		    BEGIN

		    IF ((.GLOBL_PTR [GBL_EPT_POS] LSS .EPT_POSITION) OR (.EPT_POSITION EQL 0))
		    THEN
			BEGIN
			GLOBL_PTR1 = .GLOBL_PTR;
			EPT_POSITION = .GLOBL_PTR [GBL_EPT_POS];
			END;

		    END;

		GLOBL_PTR = .GLOBL_PTR [GBL_NEXT];
		END;

	    END;

	IF (.EPT_POSITION EQL 0)
	THEN
	    SCAN_DONE = 1
	ELSE
	    BEGIN				!WE HAVE A MODULE TO LOAD

	    IF (.EPT_POSITION LSS .FILE_POSITION)
	    THEN
		ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
		    0, 0)
	    ELSE
		BEGIN

		INCR COUNTER FROM (.FILE_POSITION/2) TO (.EPT_POSITION/2) - 1 DO
		    RD16 (.CHAN, CHKSUM);

		FILE_POSITION = .EPT_POSITION;
!
! WE ARE NOW AT THE HEADER FOR THE MODULE.  GET ITS LENGTH BUT
!  OTHERWISE SKIP OVER IT.
!
		ATTRIBUTES = RD16 (.CHAN, CHKSUM);
		ROOT [SS_FLAG] = .ATTRIBUTES<8, 1>;	!Set SS based upon Mod Head
		MOD_SIZE = 0;
		MOD_SIZE<16, 16> = RD16 (.CHAN, CHKSUM);
		MOD_SIZE<0, 16> = RD16 (.CHAN, CHKSUM);

		INCR COUNTER FROM 1 TO 5 DO
		    RD16 (.CHAN, CHKSUM);

		FILE_POSITION = .FILE_POSITION + 16;
		MODU_DONE = 0;

		WHILE (.MODU_DONE EQL 0) DO
		    BEGIN
		    BLKPTR = RDLBBL (.CHAN, .FILE_PTR, BYTES_READ);
		    FILE_POSITION = .FILE_POSITION + .BYTES_READ;
		    MOD_SIZE = .MOD_SIZE - .BYTES_READ;

		    IF (.BLKPTR GTR 0)
		    THEN
			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

			    [3] :
				OBJ_TEXT (BYTEPTR, BYTECTR, .FILE_PTR);	!TEXT

			    [4] :
				OBJ_RLD (BYTEPTR, BYTECTR, .FILE_PTR);	!RELOCATION DICTIONARY

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

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

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

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

		    END;			!OF WHILE (.MODU_DONE EQL 0)

		END;				!OF SEARCH THROUGH UNDEFINED GLOBALS

	    END;

	END;

    END;					!OF READ_LIBRARY
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) 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_TEXT (BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = 	!PROCESS TEXT RECORD

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS AN OBJECT TEXT RECORD
!
! FORMAL PARAMETERS:
!
!	BYTEPTR - POINTER TO THE BYTE POINTER
!	BYTECTR - POINTER TO THE COUNTER CELL
!	FILE_PTR - POINTER TO FILE BLOCK
!
! IMPLICIT INPUTS:
!
!	THE OBJECT RECORD POINTED TO
!
! IMPLICIT OUTPUTS:
!
!	PUTS THE TEXT IN THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	OBTAINS SPACE FROM THE FREE LIST
!
!--

    BEGIN

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

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	CHAR,
	LOAD_ADDRESS,
	MODU_PTR : REF MODU_BLOCK,
	NEXT_TEXTD_PTR : REF TEXTD_BLOCK,
	NEXT_TEXTH_PTR : REF TEXTH_BLOCK,
	PSECT_PTR : REF PSECT_BLOCK,
	TEXTD_ADDR,
	TEXTD_PTR : REF TEXTD_BLOCK,
	TEXTH_PTR : REF TEXTH_BLOCK;

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

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

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	OUTSTR (1, UPLIT (%ASCIZ', LOAD ADDRESS = '));
	OUTNUM (1, .LOAD_ADDRESS, 8, 0);
	END;					!DEBUG

    IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
    THEN
	ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
    ELSE
	BEGIN					!WE HAVE A CURRENT MODULE

	IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
	THEN
	    ERRMSG (0, 10, ROUTINE_NAME, 0, 0, 0, 0)
	ELSE
	    BEGIN				!WE HAVE A CURRENT PSECT
	    PSECT_PTR [PSECT_LLA] = .LOAD_ADDRESS + .PSECT_PTR [PSECT_OFFSET];
!
! FIND THE LAST TEXT RECORD FOR THIS PSECT
!
	    TEXTH_PTR = 0;
	    NEXT_TEXTH_PTR = .PSECT_PTR [PSECT_TEXT];

	    WHILE (.NEXT_TEXTH_PTR NEQ 0) DO
		BEGIN
		TEXTH_PTR = .NEXT_TEXTH_PTR;
		NEXT_TEXTH_PTR = .TEXTH_PTR [TEXTH_NEXT];
		END;

	    IF ((NEXT_TEXTH_PTR = GETBLK (TEXTH_TYP, TEXTH_LEN)) EQL 0)
	    THEN
		ERRMSG (0, 1, ROUTINE_NAME, 0,
		    0, 0, 0)
	    ELSE
		BEGIN				!WE HAVE STORAGE FOR TEXT HEADER
		NEXT_TEXTH_PTR [TEXTH_PREV] = .TEXTH_PTR;

		IF (.TEXTH_PTR NEQ 0)
		THEN
		    TEXTH_PTR [TEXTH_NEXT] = .NEXT_TEXTH_PTR
		ELSE
		    PSECT_PTR [PSECT_TEXT] = .NEXT_TEXTH_PTR;

		TEXTH_PTR = .NEXT_TEXTH_PTR;
		TEXTH_PTR [TEXTH_PSECT] = .PSECT_PTR;
		TEXTH_PTR [TEXTH_OFFSET] = .LOAD_ADDRESS + .PSECT_PTR [PSECT_OFFSET];
		TEXTH_PTR [TEXTH_MODU] = .FILE_PTR [FILE_MODU];

		IF ((TEXTD_PTR = GETBLK (TEXTD_TYP, TEXTD_LEN)) EQL 0)
		THEN
		    ERRMSG (0, 1, ROUTINE_NAME, 0, 0,
			0, 0)
		ELSE
		    BEGIN			!WE HAVE STORAGE FOR THE FIRST TEXT DATA BLOCK
		    TEXTH_PTR [TEXTH_DATA] = .TEXTD_PTR;
		    TEXTD_PTR [TEXTD_TH] = .TEXTH_PTR;
		    TEXTD_ADDR = CH$PTR (TEXTD_PTR [TEXTD_DATA], -1, 8);

		    WHILE (..BYTECTR GTR 0) DO
			BEGIN
			CHAR = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR);

			IF (DEBUG GEQ 1)
			THEN
			    BEGIN
			    PCRLF (1);
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTSTR (1, UPLIT (%ASCIZ'TEXT BYTE = '));
			    OUTNUM (1, .CHAR, 8, 0);
			    END;		!DEBUG

			IF (.TEXTD_PTR [TEXTD_NUM_BYTES] EQL MAX_TEXT_DATA)
			THEN
			    BEGIN

			    IF ((NEXT_TEXTD_PTR = GETBLK (TEXTD_TYP, TEXTD_LEN)) EQL 0)
			    THEN
				ERRMSG (0, 1,
				    ROUTINE_NAME, 0, 0, 0, 0)
			    ELSE
				BEGIN
				NEXT_TEXTD_PTR [TEXTD_PREV] = .TEXTD_PTR;
				TEXTD_PTR [TEXTD_NEXT] = .NEXT_TEXTD_PTR;
				TEXTD_PTR = .NEXT_TEXTD_PTR;
				TEXTD_PTR [TEXTD_TH] = .TEXTH_PTR;
				TEXTD_ADDR = CH$PTR (TEXTD_PTR [TEXTD_DATA], -1, 8);
				END;

			    END;

			CH$A_WCHAR (.CHAR, TEXTD_ADDR);
			TEXTD_PTR [TEXTD_NUM_BYTES] = .TEXTD_PTR [TEXTD_NUM_BYTES] + 1;
			END;

		    END;			!OF PER-CHARACTER ITERATION

		END;

	    END;

	END;

    END;					!OF OBJ_TEXT
ROUTINE OBJ_RLD (BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = 	!PROCESS RLD RECORD

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE RELOCATION DICTIONARY RECORD
!	 BY FETCHING THE COMMAND, BYTE FLAG AND DISPLACEMENT,
!	 THEN DISPATCHING.
!
! FORMAL PARAMETERS:
!
!	BYTEPTR - POINTER TO THE BYTE POINTER
!	BYTECTR - POINTER TO THE COUNTER CELL
!	FILE_PTR - POINTER TO OBJECT FILE BLOCK, FOR ERROR
!	 MESSAGES AND TO HOLD DATA READ.
!
! IMPLICIT INPUTS:
!
!	THE OBJECT RECORD POINTED TO
!
! IMPLICIT OUTPUTS:
!
!	MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	GETS STORAGE FROM THE FREE LIST
!
!--

    BEGIN

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	CHAR,
	CMD,
	MODIF,
	DISP;

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

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

    DO
	BEGIN
	CMD = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR);

	IF (.CMD NEQ 0)
	THEN
	    BEGIN
	    MODIF = .CMD<7, 1>;
	    CMD = .CMD<0, 6>;
	    DISP = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR);

	    CASE .CMD FROM %O'1' TO %O'20' OF
		SET

		[%O'1'] :
		    R_IR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);

		[%O'2'] :
		    R_GR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);

		[%O'3'] :
		    R_IDR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);

		[%O'4'] :
		    R_GDR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);

		[%O'5'] :
		    R_GAR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);

		[%O'6'] :
		    R_GADR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);

		[%O'7'] :
		    R_LCD (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);

		[%O'10'] :
		    R_LCM (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);

		[%O'11'] :
		    R_PL (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);

		[%O'12'] :
		    R_PR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);

		[%O'13'] :
		    R_ERR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);

		[%O'14'] :
		    R_PDR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);

		[%O'15'] :
		    R_PAR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);

		[%O'16'] :
		    R_PADR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);

		[%O'17'] :
		    R_CR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);

		[%O'20'] :
		    R_LR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);

		[OUTRANGE] :
		    ERRMSG (0, 10, UPLIT (%ASCIZ'OBJ_RLD'), FILE_PTR [FILE_NAME], 0, 0, 0);
		TES;

	    END;

	END
    UNTIL (..BYTECTR EQL 0);

    END;					!OF OBJ_RLD
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)
	THEN
	    ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
	ELSE
	    BEGIN
	    FILE_PTR [FILE_MODU] = 0;
	    END;

	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;

    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

!

    IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) NEQ 0)
    THEN
	ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
	    0, 0)
    ELSE
	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;

		IF ((ROOT [ROOT_MODULES] = BLD_CHAIN (.ROOT, .ROOT [ROOT_MODULES], .MODU_PTR)) EQL 0)
		THEN
		    ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 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_PSN
!
!--

    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_PSN 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 + %O'200000'
	ELSE
	    BEGIN
	    MODU_PTR [MODU_XFR_PSECT] = .PSECT_PTR;
	    MODU_PTR [MODU_XFR_OFFSET] = .VALUE + .PSECT_PTR [PSECT_OFFSET] + %O'200000';
	    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,
	GLOBL_PTR1 : REF GLOBL_BLOCK,
	GLOBL_PTR2 : REF GLOBL_BLOCK,
	GLOBAL_INFO : VECTOR [3],
	MODU_PTR : REF MODU_BLOCK,
	MODU_PTR1 : REF MODU_BLOCK,
	PSECT_PTR : REF PSECT_BLOCK,
	SEARCH_DONE,
	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;
	SEARCH_DONE = 0;
	GLOBL_PTR1 = .ROOT [ROOT_GLOBALS];
	GLOBL_PTR2 = 0;

	IF (.GLOBL_PTR1 NEQ 0)
	THEN

	    WHILE (.SEARCH_DONE EQL 0) DO

		IF (CH$GTR (LEN_GBL_NAME, CH$PTR (.ASCPTR), LEN_GBL_NAME, CH$PTR (GLOBL_PTR1 [GBL_NAME])))
		THEN
		    BEGIN
		    GLOBL_PTR2 = .GLOBL_PTR1;
		    GLOBL_PTR1 = .GLOBL_PTR1 [GBL_NEXT];

		    IF (.GLOBL_PTR1 EQL 0) THEN SEARCH_DONE = 2;

		    END
		ELSE
		    SEARCH_DONE = 1;

	IF (.SEARCH_DONE EQL 1)
	THEN
	    BEGIN

	    IF (CH$EQL (LEN_GBL_NAME, CH$PTR (.ASCPTR), LEN_GBL_NAME, CH$PTR (GLOBL_PTR1 [GBL_NAME])))
	    THEN
		SEARCH_DONE = 3

	    END;

	IF (.SEARCH_DONE NEQ 3)
	THEN
	    BEGIN				!THIS IS THE FIRST REFERENCE TO THIS GLOBAL

	    IF (((GET_SW (.FILE_PTR, UPLIT (%ASCII'SS', 0)) EQL 0) AND (.ROOT [SS_FLAG] EQL 0)) OR (.FLAGS<
		    GBL_FLG_DEF, 1> EQL 0))
	    THEN
		BEGIN				!NOT 'SS' SWITCH OR IT IS A REFERENCE

		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]));
!
! LINK THIS SYMBOL INTO THE LIST
!
		    GLOBL_PTR [GBL_NEXT] = .GLOBL_PTR1;
		    GLOBL_PTR [GBL_PREV] = .GLOBL_PTR2;

		    IF (.GLOBL_PTR1 NEQ 0) THEN GLOBL_PTR1 [GBL_PREV] = .GLOBL_PTR;

		    IF (.GLOBL_PTR2 NEQ 0)
		    THEN
			GLOBL_PTR2 [GBL_NEXT] = .GLOBL_PTR
		    ELSE
			ROOT [ROOT_GLOBALS] = .GLOBL_PTR;

		    END;

		END
	    ELSE
		GLOBL_PTR = 0

	    END					!OF SEARCH_DONE NEQ 3
	ELSE
	    BEGIN				!PREVIOUS REFERENCE TO THIS GLOBAL
	    TEMP_FLAGS = .GLOBL_PTR1 [GBL_FLAGS];
	    GLOBL_PTR = (IF (((GET_SW (.FILE_PTR, UPLIT (%ASCIZ'SS', 0)) NEQ 0) OR .ROOT [SS_FLAG]) AND (
		.TEMP_FLAGS<GBL_FLG_DEF, 1> NEQ 0) AND (.FLAGS<GBL_FLG_DEF, 1> NEQ 0)) THEN 0 ELSE .GLOBL_PTR1
	    );
	    END;

	IF (.GLOBL_PTR NEQ 0)
	THEN
	    BEGIN				!WE WISH TO PROCESS THIS GLOBAL
!
! THE GLOBAL BLOCK IS LINKED TO THE ROOT.  NOW BE SURE IT IS
!  CHAINED FROM THE CURRENT MODULE.
!
	    GLOBL_PTR1 = FND_CHAIN (.MODU_PTR [MODU_GLOBALS], SEL_GLOBAL, GLOBAL_INFO);

	    IF (.GLOBL_PTR1 EQL 0)
	    THEN
		BEGIN

		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)
		ELSE
		    GLOBL_PTR1 = FND_CHAIN (.MODU_PTR [MODU_GLOBALS], SEL_GLOBAL, GLOBAL_INFO);

		END;

	    IF (.GLOBL_PTR NEQ .GLOBL_PTR1) THEN ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);

	    IF (.FLAGS<GBL_FLG_DEF, 1> NEQ 0)
	    THEN
		BEGIN				!THIS IS A DEFINING REFERENCE
		TEMP_FLAGS = .GLOBL_PTR [GBL_FLAGS];

		IF (.TEMP_FLAGS<GBL_FLG_DEF, 1> NEQ 0)
		THEN
		    BEGIN			!THERE WAS AN EARLIER DEFINITION

		    IF ((.VALUE NEQ .GLOBL_PTR [GBL_VALUE]) OR (.FLAGS<GBL_FLG_REL, 1> NEQ 0) OR (.TEMP_FLAGS<
			    GBL_FLG_REL, 1> NEQ 0))
		    THEN
			BEGIN			!MULTIPLE DEFINITION
			MODU_PTR1 = .GLOBL_PTR [GBL_DEF_MODU];
			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;

		    END
		ELSE
		    BEGIN			!NO EARLIER DEFINITION
		    GLOBL_PTR [GBL_FLAGS] = .FLAGS;
		    GLOBL_PTR [GBL_VALUE] = .VALUE;
		    GLOBL_PTR [GBL_DEF_MODU] = .MODU_PTR;

		    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;				!OF DEFINING REFERENCE

	    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');

    LABEL
	OUT;

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	TEMP,
	CHAR1,
	CHAR2,
	MODU_PTR : REF MODU_BLOCK,
	PSECT_PTR : REF PSECT_BLOCK,
	PSECT_PTR1 : REF PSECT_BLOCK,
	PSECT_PTR2 : 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;
	SEARCH_DONE = 0;
	PSECT_PTR1 = .ROOT [ROOT_PSECTS];
	PSECT_PTR2 = 0;

	IF (.PSECT_PTR1 NEQ 0)
	THEN

	    WHILE (.SEARCH_DONE EQL 0) DO
		BEGIN
!
! THE RESULT OF THE FOLLOWING CODE IS:
!	0 IF THE SYMBOLS ARE EQUAL TO EACH OTHER
!	1 IF THE SYMBOLS ARE LESS THAN EACH OTHER
!	2 IF THE SYMBOLS ARE GREATER THAN EACH OTHER
!
		TEMP = (
OUT :
		BEGIN

		INCR COUNTER FROM 0 TO LEN_PSECT_NAME - 1 DO
		    BEGIN
		    CHAR1 = RX50 (CH$RCHAR (CH$PTR (.ASCPTR, .COUNTER)));
		    CHAR2 = RX50 (CH$RCHAR (CH$PTR (PSECT_PTR1 [PSECT_NAME], .COUNTER)));

		    IF (.CHAR1 NEQ .CHAR2)
		    THEN

			IF (.CHAR1 GTR .CHAR2) THEN LEAVE OUT WITH 2 ELSE LEAVE OUT WITH 1;

		    END;

		0
		END
		);
		SEARCH_DONE = (CASE .TEMP FROM 0 TO 2 OF
		    SET
		    [2] :
			BEGIN
			PSECT_PTR2 = .PSECT_PTR1;
			PSECT_PTR1 = .PSECT_PTR1 [PSECT_NEXT];

			IF (.PSECT_PTR1 EQL 0) THEN 2 ELSE 0

			END;
		    [1] : 1;
		    [0] : 3;
		    TES);
		END;

	IF (.SEARCH_DONE NEQ 3)
	THEN
	    BEGIN				!THIS IS THE FIRST REFERENCE TO THIS PSECT

	    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;
!
! LINK THIS PSECT INTO THE LIST
!
		PSECT_PTR [PSECT_NEXT] = .PSECT_PTR1;
		PSECT_PTR [PSECT_PREV] = .PSECT_PTR2;

		IF (.PSECT_PTR1 NEQ 0) THEN PSECT_PTR1 [PSECT_PREV] = .PSECT_PTR;

		IF (.PSECT_PTR2 NEQ 0)
		THEN
		    PSECT_PTR2 [PSECT_NEXT] = .PSECT_PTR
		ELSE
		    ROOT [ROOT_PSECTS] = .PSECT_PTR;

		END;

	    END					!OF SEARCH_DONE NEQ 3
	ELSE
	    PSECT_PTR = .PSECT_PTR1;

!
! THE PSECT BLOCK IS LINKED TO THE ROOT.  NOW BE SURE IT IS
!  CHAINED FROM THE CURRENT MODULE.
!
	PSECT_PTR1 = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_PSECT, PSECT_INFO);

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

	    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_PTR1 = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_PSECT, PSECT_INFO);

	    IF (.PSECT_PTR NEQ .PSECT_PTR1)
	    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]);
		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;				!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
ROUTINE GBL_REF (GLOBL_PTR, PSECT_PTR, MODU_PTR) : NOVALUE = 	!RECORD A GLOBAL REFERENCE

!++
! FUNCTIONAL DESCRIPTION:
!
!	RECORD, USING CHAIN BLOCKS, A GLOBAL REFERENCE TO THE SPECIFIED
!	 GLOBAL SYMBOL IN THE SPECIFIED PSECT IN THE SPECIFIED MODULE.
!
! FORMAL PARAMETERS:
!
!	GLOBL_PTR - POINTER TO THE GLOBAL SYMBOL BEING REFERENCED
!	PSECT_PTR - POINTER TO THE PSECT IN WHICH THE REFERENCE OCCURS
!	MODU_PTR - POINTER TO THE MODULE IN WHICH THE REFERENCE OCCURS
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	MAY OBTAIN STORAGE FROM THE FREE LIST
!
!--

    BEGIN

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

    MAP
	GLOBL_PTR : REF GLOBL_BLOCK,
	MODU_PTR : REF MODU_BLOCK,
	PSECT_PTR : REF PSECT_BLOCK;

    LOCAL
	GLOBAL_INFO : VECTOR [3];

    GLOBAL_INFO [0] = GLOBL_PTR [GBL_NAME];
    GLOBAL_INFO [1] = .GLOBL_PTR [GBL_FLAGS];
    GLOBAL_INFO [2] = .GLOBL_PTR [GBL_VALUE];

    IF (FND_CHAIN (.PSECT_PTR [PSECT_GLOBALS], SEL_GLOBAL, GLOBAL_INFO) EQL 0)
    THEN
	BEGIN					!FIRST REFERENCE BY THIS GLOBAL TO THIS PSECT

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

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

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

    END;					!OF GBL_REF
ROUTINE M_RLDH (MODIF, DISP, PSECT_PTR, LOCATION) = 	!MAKE RLDH BLOCK

!++
! FUNCTIONAL DESCRIPTION:
!
!	BUILD AN RLDH BLOCK FROM FREE STORAGE, AND FILL IN SOME
!	 OF THE FIELDS.
!
! FORMAL PARAMETERS:
!
!	MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
!	DISP - DISPLACEMENT INTO TEXT RECORD
!	PSECT_PTR - POINTER TO THE PSECT THAT THIS RELOCATION APPLIES TO
!	LOCATION - OFFSET IN PSECT SPECIFIED BY LOCATION COUNTER SETTING
!	 OPERATION.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	POINTER TO THE RLDH, OR 0 IF OUT OF STORAGE
!	 THE CALLER IS RESPONSIBLE FOR GIVING THE 'OUT OF STORAGE'
!	 ERROR MESSAGE.
!
! SIDE EFFECTS
!
!	OBTAINS STORAGE FROM THE FREE LIST
!
!--

    BEGIN

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

    MAP
	PSECT_PTR : REF PSECT_BLOCK;

    LOCAL
	RLDH_PTR : REF RLDH_BLOCK;

    IF ((RLDH_PTR = GETBLK (RLDH_TYP, RLDH_LEN)) EQL 0)
    THEN
	0
    ELSE
	BEGIN					!WE HAVE AN RLDH BLOCK
	RLDH_PTR [RLDH_PSECT] = .PSECT_PTR;
	RLDH_PTR [RLDH_BYTE] = .MODIF;
	RLDH_PTR [RLDH_ADDR] = .PSECT_PTR [PSECT_LLA] - 4 + .DISP;
	.RLDH_PTR
	END

    END;					!OF M_RLDH
ROUTINE M_RLDD (OPER, OP1T, OP2T, OPND1, OPND2) = 	!MAKE RLDD BLOCK

!++
! FUNCTIONAL DESCRIPTION:
!
!	BUILD AN RLDD BLOCK FROM FREE STORAGE, AND FILL IN
!	 ITS FIELDS.
!
! FORMAL PARAMETERS:
!
!	OPER - THE OPERATION TO BE PERFORMED.
!	OP1T - THE TYPE OF OPERAND 1
!	OP2T - THE TYPE OF OPERAND 2, "OMIT" IF NONE.
!	OPND1 - OPERAND 1, EITHER A CONSTANT OR A POINTER
!	OPND2 - OPERAND 2, A CONSTANT OR A POINTER IF PRESENT, 0 IF
!	 OMITTED.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	POINTER TO THE RLDD, OR 0 IF OUT OF STORAGE.
!	 IF EITHER OPERAND IS AN RLDD BLOCK BUT IS 0,
!	 0 IS RETURNED.  THE CALLER IS RESPONSIBLE FOR GIVING
!	 THE 'OUT OF STORAGE' ERROR MESSAGE IN THIS CASE.
!
! SIDE EFFECTS
!
!	MAY OBTAIN STORAGE FROM THE FREE LIST
!
!--

    BEGIN

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

    LOCAL
	RLDD_PTR : REF RLDD_BLOCK;

    IF (((.OP1T EQL RLD_OPND_OPR) AND (.OPND1 EQL 0)) OR ((.OP2T EQL RLD_OPND_OPR) AND (.OPND2 EQL 0)))
    THEN
	0
    ELSE
	BEGIN

	IF ((RLDD_PTR = GETBLK (RLDD_TYP, RLDD_LEN)) EQL 0)
	THEN
	    0
	ELSE
	    BEGIN				!WE HAVE AN RLDD BLOCK
	    RLDD_PTR [RLDD_OPER] = .OPER;
	    RLDD_PTR [RLDD_OP1T] = .OP1T;
	    RLDD_PTR [RLDD_OP2T] = .OP2T;
	    RLDD_PTR [RLDD_OPND1] = .OPND1;
	    RLDD_PTR [RLDD_OPND2] = .OPND2;
	    .RLDD_PTR
	    END

	END

    END;					!OF M_RLDD
ROUTINE R_ERR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = 	!RLD ERROR

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE UNUSED ENTRY OF THE RLD RECORD.
!
! FORMAL PARAMETERS:
!
!	MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
!	DISP - DISPLACEMENT INTO TEXT RECORD
!	BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
!	BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
!	FILE_PTR - POINTER TO THE OBJECT FILE'S FILE BLOCK
!
! IMPLICIT INPUTS:
!
!	INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	PRINTS AN ERROR MESSAGE
!
!--

    BEGIN

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

    MAP
	FILE_PTR : REF FILE_BLOCK;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'ERROR, MODIF = '));
	OUTNUM (1, .MODIF, 2, 0);
	OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
	OUTNUM (1, .DISP, 8, 0);
	END;					!DEBUG

    ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
    END;					!OF R_ERR
ROUTINE R_IR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = 	!RLD INTERNAL RELOCATION

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE INTERNAL RELOCATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
!	MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
!	DISP - DISPLACEMENT INTO TEXT RECORD
!	BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
!	BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
!	MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	OBTAINS STORAGE FROM THE FREE LIST
!
!--

    BEGIN

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

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	CONSTANT,
	MODU_PTR : REF MODU_BLOCK,
	PSECT_PTR : REF PSECT_BLOCK,
	RLDH_PTR : REF RLDH_BLOCK;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'INTERNAL RELOCATION, MODIF = '));
	OUTNUM (1, .MODIF, 2, 0);
	OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
	OUTNUM (1, .DISP, 8, 0);
	END;					!DEBUG

    CONSTANT = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	OUTSTR (1, UPLIT (%ASCIZ', CONSTANT = '));
	OUTNUM (1, .CONSTANT, 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 INSIDE A MODULE

	IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
	THEN
	    ERRMSG (0, 10, ROUTINE_NAME,
		FILE_PTR [FILE_NAME], 0, 0, 0)
	ELSE
	    BEGIN				!WE ARE INSIDE A PSECT

	    IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
	    THEN
		ERRMSG (0,
		    1, ROUTINE_NAME, 0, 0, 0, 0)
	    ELSE
		BEGIN				!WE HAVE AN RLD HEADER
!
! FOR INTERNAL RELOCATION, THE VALUE TO BE STORED IS THE CURRENT PSECT
!  BASE PLUS THE GIVEN CONSTANT.
!

		IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_ADD, RLD_OPND_OPR, RLD_OPND_CON,
			M_RLDD (RLD_OP_ADD, RLD_OPND_PSECT, RLD_OPND_CON, .PSECT_PTR,
			    .PSECT_PTR [PSECT_OFFSET]), .CONSTANT)) EQL 0)
		THEN
		    ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		ELSE
		    PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);

		END;

	    END;

	END;

    END;					!OF R_IR
ROUTINE R_GR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = 	!RLD GLOBAL RELOCATION

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE GLOBAL RELOCATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
!	MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
!	DISP - DISPLACEMENT INTO TEXT RECORD
!	BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
!	BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
!	MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	OBTAINS STORAGE FROM THE FREE LIST
!
!--

    BEGIN

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

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	ASCVAL : VECTOR [CH$ALLOCATION (LEN_GBL_NAME)],
	CONSTANT,
	GLOBAL_INFO : VECTOR [3],
	GLOBL_PTR : REF GLOBL_BLOCK,
	MODU_PTR : REF MODU_BLOCK,
	PSECT_PTR : REF PSECT_BLOCK,
	R50VAL,
	RLDH_PTR : REF RLDH_BLOCK;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'GLOBAL RELOCATION, MODIF = '));
	OUTNUM (1, .MODIF, 2, 0);
	OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
	OUTNUM (1, .DISP, 8, 0);
	END;					!DEBUG

    R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
    R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
    R50TOA (.R50VAL, ASCVAL [0]);

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	OUTSTR (1, UPLIT (%ASCIZ', NAME = '));
	OUTSTR (1, ASCVAL [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 INSIDE A MODULE
	GLOBAL_INFO [0] = ASCVAL [0];
	GLOBAL_INFO [1] = 0;
	GLOBAL_INFO [2] = 0;

	IF ((GLOBL_PTR = FND_CHAIN (.MODU_PTR [MODU_GLOBALS], SEL_GLOBAL, GLOBAL_INFO)) EQL 0)
	THEN
	    ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
	ELSE
	    BEGIN				!THIS GLOBAL HAS BEEN DECLARED IN THIS MODULE

	    IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
	    THEN
		ERRMSG (0, 10, ROUTINE_NAME,
		    FILE_PTR [FILE_NAME], 0, 0, 0)
	    ELSE
		BEGIN				!WE ARE INSIDE A PSECT
		GBL_REF (.GLOBL_PTR, .PSECT_PTR, .MODU_PTR);

		IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
		THEN
		    ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		ELSE
		    BEGIN			!WE HAVE AN RLD HEADER
!
! FOR GLOBAL RELOCATION, THE VALUE TO BE STORED IS SIMPLY THE VALUE OF
!  THE GLOBAL SYMBOL.  WE REPRESENT THIS BY ADDING THE GLOBAL VALUE
!  TO 0.
!

		    IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_ADD, RLD_OPND_GLOBAL, RLD_OPND_CON,
			    .GLOBL_PTR, 0)) EQL 0)
		    THEN
			ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		    ELSE
			PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);

		    END;

		END;

	    END;

	END;

    END;					!OF R_GR
ROUTINE R_IDR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = 	!RLD INTERNAL DISPLACED RELOCATION

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE INTERNAL DISPLACED RELOCATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
!	MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
!	DISP - DISPLACEMENT INTO TEXT RECORD
!	BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
!	BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
!	FILE_PTR - POINTER TO THE OBJECT FILE BLOCK
!
! IMPLICIT INPUTS:
!
!	INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
!	MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	OBTAINS STORAGE FROM THE FREE LIST
!
!--

    BEGIN

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

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	CONSTANT,
	MODU_PTR : REF MODU_BLOCK,
	PSECT_PTR : REF PSECT_BLOCK,
	RLDH_PTR : REF RLDH_BLOCK;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'INTERNAL DISPLACED RELOCATION, MODIF = '));
	OUTNUM (1, .MODIF, 2, 0);
	OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
	OUTNUM (1, .DISP, 8, 0);
	END;					!DEBUG

    CONSTANT = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	OUTSTR (1, UPLIT (%ASCIZ', CONSTANT = '));
	OUTNUM (1, .CONSTANT, 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 INSIDE A MODULE

	IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
	THEN
	    ERRMSG (0, 10, ROUTINE_NAME,
		FILE_PTR [FILE_NAME], 0, 0, 0)
	ELSE
	    BEGIN				!WE ARE INSIDE A PSECT

	    IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
	    THEN
		ERRMSG (0,
		    1, ROUTINE_NAME, 0, 0, 0, 0)
	    ELSE
		BEGIN				!WE HAVE AN RLD HEADER
!
! FOR INTERNAL DISPLACED RELOCATION, THE VALUE TO BE STORED IS THE
!  STORE ADDRESS + 2 PLUS THE BASE OF THE CURRENT PSECT, SUBTRACTED
!  FROM THE GIVEN CONSTANT.
!

		IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_SUB, RLD_OPND_CON, RLD_OPND_OPR, .CONSTANT,
			M_RLDD (RLD_OP_ADD, RLD_OPND_CON, RLD_OPND_PSECT, .RLDH_PTR [RLDH_ADDR] + 2,
			    .PSECT_PTR))) EQL 0)
		THEN
		    ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		ELSE
		    PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);

		END;

	    END;

	END;

    END;					!OF R_IDR
ROUTINE R_GDR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = 	!RLD GLOBAL DISPLACED RELOCATION

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE GLOBAL DISPLACED RELOCATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
!	MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
!	DISP - DISPLACEMENT INTO TEXT RECORD
!	BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
!	BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
!	MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	OBTAINS STORAGE FROM THE FREE LIST
!
!--

    BEGIN

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

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	ASCVAL : VECTOR [CH$ALLOCATION (LEN_GBL_NAME)],
	CONSTANT,
	GLOBAL_INFO : VECTOR [3],
	GLOBL_PTR : REF GLOBL_BLOCK,
	MODU_PTR : REF MODU_BLOCK,
	PSECT_PTR : REF PSECT_BLOCK,
	R50VAL,
	RLDH_PTR : REF RLDH_BLOCK;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'GLOBAL DISPLACED RELOCATION, MODIF = '));
	OUTNUM (1, .MODIF, 2, 0);
	OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
	OUTNUM (1, .DISP, 8, 0);
	END;					!DEBUG

    R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
    R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
    R50TOA (.R50VAL, ASCVAL [0]);

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	OUTSTR (1, UPLIT (%ASCIZ', NAME = '));
	OUTSTR (1, ASCVAL [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 INSIDE A MODULE
	GLOBAL_INFO [0] = ASCVAL [0];
	GLOBAL_INFO [1] = 0;
	GLOBAL_INFO [2] = 0;

	IF ((GLOBL_PTR = FND_CHAIN (.MODU_PTR [MODU_GLOBALS], SEL_GLOBAL, GLOBAL_INFO)) EQL 0)
	THEN
	    ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
	ELSE
	    BEGIN				!THIS GLOBAL HAS BEEN DECLARED IN THIS MODULE

	    IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
	    THEN
		ERRMSG (0, 10, ROUTINE_NAME,
		    FILE_PTR [FILE_NAME], 0, 0, 0)
	    ELSE
		BEGIN				!WE ARE INSIDE A PSECT
		GBL_REF (.GLOBL_PTR, .PSECT_PTR, .MODU_PTR);

		IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
		THEN
		    ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		ELSE
		    BEGIN			!WE HAVE AN RLD HEADER
!
! FOR GLOBAL DISPLACED RELOCATION, THE VALUE TO BE STORED IS THE SUM
!  OF THE STORE ADDRESS + 2 AND THE BASE OF THE CURRENT PSECT,
!  SUBTRACTED FROM THE VALUE OF THE GLOBAL SYMBOL.
!

		    IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_SUB, RLD_OPND_GLOBAL, RLD_OPND_OPR,
			    .GLOBL_PTR,
			    M_RLDD (RLD_OP_ADD, RLD_OPND_CON, RLD_OPND_PSECT,
				.RLDH_PTR [RLDH_ADDR] + 2, .PSECT_PTR))) EQL 0)
		    THEN
			ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		    ELSE
			PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);

		    END;

		END;

	    END;

	END;

    END;					!OF R_GDR
ROUTINE R_GAR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = 	!RLD GLOBAL ADDITIVE RELOCATION

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE GLOBAL ADDITIVE RELOCATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
!	MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
!	DISP - DISPLACEMENT INTO TEXT RECORD
!	BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
!	BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
!	MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	OBTAINS STORAGE FROM THE FREE LIST
!
!--

    BEGIN

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

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	ASCVAL : VECTOR [CH$ALLOCATION (LEN_GBL_NAME)],
	CONSTANT,
	GLOBAL_INFO : VECTOR [3],
	GLOBL_PTR : REF GLOBL_BLOCK,
	MODU_PTR : REF MODU_BLOCK,
	PSECT_PTR : REF PSECT_BLOCK,
	R50VAL,
	RLDH_PTR : REF RLDH_BLOCK;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'GLOBAL ADDITIVE RELOCATION, MODIF = '));
	OUTNUM (1, .MODIF, 2, 0);
	OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
	OUTNUM (1, .DISP, 8, 0);
	END;					!DEBUG

    R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
    R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
    R50TOA (.R50VAL, ASCVAL [0]);

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	OUTSTR (1, UPLIT (%ASCIZ', NAME = '));
	OUTSTR (1, ASCVAL [0]);
	END;					!DEBUG

    CONSTANT = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	OUTSTR (1, UPLIT (%ASCIZ', CONSTANT = '));
	OUTNUM (1, .CONSTANT, 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 INSIDE A MODULE
	GLOBAL_INFO [0] = ASCVAL [0];
	GLOBAL_INFO [1] = 0;
	GLOBAL_INFO [2] = 0;

	IF ((GLOBL_PTR = FND_CHAIN (.MODU_PTR [MODU_GLOBALS], SEL_GLOBAL, GLOBAL_INFO)) EQL 0)
	THEN
	    ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
	ELSE
	    BEGIN				!THIS GLOBAL HAS BEEN DECLARED IN THIS MODULE

	    IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
	    THEN
		ERRMSG (0, 10, ROUTINE_NAME,
		    FILE_PTR [FILE_NAME], 0, 0, 0)
	    ELSE
		BEGIN				!WE ARE INSIDE A PSECT
		GBL_REF (.GLOBL_PTR, .PSECT_PTR, .MODU_PTR);

		IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
		THEN
		    ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		ELSE
		    BEGIN			!WE HAVE AN RLD HEADER
!
! FOR GLOBAL ADDITIVE RELOCATION, THE VALUE TO BE STORED IS THE
!  VALUE OF THE GLOBAL SYMBOL PLUS THE VALUE OF THE CONSTANT.
!

		    IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_ADD, RLD_OPND_GLOBAL, RLD_OPND_CON,
			    .GLOBL_PTR, .CONSTANT)) EQL 0)
		    THEN
			ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		    ELSE
			PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);

		    END;

		END;

	    END;

	END;

    END;					!OF R_GAR
ROUTINE R_GADR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE =
						!RLD GLOBAL ADDITIVE DISPLACED RELOCATION

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE GLOBAL ADDITIVE DISPLACED RELOCATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
!	MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
!	DISP - DISPLACEMENT INTO TEXT RECORD
!	BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
!	BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
!	FILE_PTR - POINTER TO FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
!	MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	OBTAINS STORAGE FROM THE FREE LIST
!
!--

    BEGIN

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

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	ASCVAL : VECTOR [CH$ALLOCATION (LEN_GBL_NAME)],
	CONSTANT,
	GLOBAL_INFO : VECTOR [3],
	GLOBL_PTR : REF GLOBL_BLOCK,
	MODU_PTR : REF MODU_BLOCK,
	PSECT_PTR : REF PSECT_BLOCK,
	R50VAL,
	RLDH_PTR : REF RLDH_BLOCK;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'GLOBAL ADDITIVE DISPLACED RELOCATION, MODIF = '));
	OUTNUM (1, .MODIF, 2, 0);
	OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
	OUTNUM (1, .DISP, 8, 0);
	END;					!DEBUG

    R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
    R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
    R50TOA (.R50VAL, ASCVAL [0]);

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	OUTSTR (1, UPLIT (%ASCIZ', NAME = '));
	OUTSTR (1, ASCVAL [0]);
	END;					!DEBUG

    CONSTANT = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	OUTSTR (1, UPLIT (%ASCIZ', CONSTANT = '));
	OUTNUM (1, .CONSTANT, 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 INSIDE A MODULE
	GLOBAL_INFO [0] = ASCVAL [0];
	GLOBAL_INFO [1] = 0;
	GLOBAL_INFO [2] = 0;

	IF ((GLOBL_PTR = FND_CHAIN (.MODU_PTR [MODU_GLOBALS], SEL_GLOBAL, GLOBAL_INFO)) EQL 0)
	THEN
	    ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
	ELSE
	    BEGIN				!THIS GLOBAL HAS BEEN DECLARED IN THIS MODULE

	    IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
	    THEN
		ERRMSG (0, 10, ROUTINE_NAME,
		    FILE_PTR [FILE_NAME], 0, 0, 0)
	    ELSE
		BEGIN				!WE ARE INSIDE A PSECT
		GBL_REF (.GLOBL_PTR, .PSECT_PTR, .MODU_PTR);

		IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
		THEN
		    ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		ELSE
		    BEGIN			!WE HAVE AN RLD HEADER
!
! FOR GLOBAL ADDITIVE DISPLACED RELOCATION, THE VALUE TO BE STORED IS THE SUM
!  OF THE STORE ADDRESS + 2 AND THE BASE OF THE CURRENT PSECT,
!  SUBTRACTED FROM THE VALUE OF THE GLOBAL SYMBOL, PLUS THE GIVEN CONSTANT.
!

		    IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_SUB, RLD_OPND_OPR, RLD_OPND_OPR,
			    M_RLDD (RLD_OP_ADD, RLD_OPND_GLOBAL, RLD_OPND_CON, .GLOBL_PTR, .CONSTANT),
			    M_RLDD (RLD_OP_ADD, RLD_OPND_CON, RLD_OPND_PSECT, .RLDH_PTR [RLDH_ADDR] + 2,
				.PSECT_PTR))) EQL 0)
		    THEN
			ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		    ELSE
			PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);

		    END;

		END;

	    END;

	END;

    END;					!OF R_GAR
ROUTINE R_LCD (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = 	!RLD LOCATION COUNTER DEFINITION

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE LOCATION COUNTER DEFINITION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
!	MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
!	DISP - DISPLACEMENT INTO TEXT RECORD
!	BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
!	BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
!	MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	OBTAINS STORAGE FROM THE FREE LIST
!
!--

    BEGIN

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

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	MODU_PTR : REF MODU_BLOCK,
	PSECT_PTR : REF PSECT_BLOCK,
	PSECT_INFO : VECTOR [3],
	R50VAL,
	ASCVAL : VECTOR [CH$ALLOCATION (LEN_PSECT_NAME)],
	CONSTANT;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'LOCATION COUNTER DEFINITION, MODIF = '));
	OUTNUM (1, .MODIF, 2, 0);
	OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
	OUTNUM (1, .DISP, 8, 0);
	END;					!DEBUG

    R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
    R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
    R50TOA (.R50VAL, ASCVAL [0]);

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	OUTSTR (1, UPLIT (%ASCIZ', NAME = '));
	OUTSTR (1, ASCVAL [0]);
	END;					!DEBUG

    CONSTANT = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	OUTSTR (1, UPLIT (%ASCIZ', CONSTANT = '));
	OUTNUM (1, .CONSTANT, 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] = ASCVAL;
	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
	    ERRMSG (0, 10, ROUTINE_NAME, 0, 0, 0, 0)
	ELSE
	    BEGIN
	    MODU_PTR [MODU_PSECT] = .PSECT_PTR;
	    MODU_PTR [MODU_LC] = .CONSTANT;
	    END;

	END;

    END;					!OF R_LCD
ROUTINE R_LCM (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = 	!RLD LOCATION COUNTER MODIFICATION

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE LOCATION COUNTER MODIFICATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
!	MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
!	DISP - DISPLACEMENT INTO TEXT RECORD
!	BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
!	BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
!	MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	OBTAINS STORAGE FROM THE FREE LIST
!
!--

    BEGIN

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

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	CONSTANT,
	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'LOCATION COUNTER MODIFICATION, MODIF = '));
	OUTNUM (1, .MODIF, 2, 0);
	OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
	OUTNUM (1, .DISP, 8, 0);
	END;					!DEBUG

    CONSTANT = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	OUTSTR (1, UPLIT (%ASCIZ', CONSTANT = '));
	OUTNUM (1, .CONSTANT, 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

	IF (.MODU_PTR [MODU_PSECT] EQL 0)
	THEN
	    ERRMSG (0, 10, ROUTINE_NAME, 0, 0, 0, 0)
	ELSE
	    BEGIN
	    MODU_PTR [MODU_LC] = .CONSTANT;
	    END;

	END;

    END;					!OF R_LCM
ROUTINE R_PL (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = 	!RLD PROGRAM LIMITS

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE PROGRAM LIMITS ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
!	MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
!	DISP - DISPLACEMENT INTO TEXT RECORD
!	BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
!	BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
!	MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	OBTAINS STORAGE FROM THE FREE LIST
!
!--

    BEGIN

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

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	CONSTANT,
	MODU_PTR : REF MODU_BLOCK,
	PSECT_PTR : REF PSECT_BLOCK,
	RLDH_PTR : REF RLDH_BLOCK;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'PROGRAM LIMITS, MODIF = '));
	OUTNUM (1, .MODIF, 2, 0);
	OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
	OUTNUM (1, .DISP, 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

	IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
	THEN
	    ERRMSG (0, 10, ROUTINE_NAME, 0, 0, 0, 0)
	ELSE
	    BEGIN

	    IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
	    THEN
		ERRMSG (0,
		    1, ROUTINE_NAME, 0, 0, 0, 0)
	    ELSE
		BEGIN

		IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_ADD, RLD_OPND_BSTK, RLD_OPND_CON, 0, 0)) EQL 0)
		THEN
		    ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		ELSE
		    BEGIN
		    PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);

		    IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP + 2, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
		    THEN
			ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		    ELSE
			BEGIN

			IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_ADD, RLD_OPND_HLA, RLD_OPND_CON, 0, 0))
			    EQL 0)
			THEN
			    ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
			ELSE
			    BEGIN
			    PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);
			    END;

			END;

		    END;

		END;

	    END;

	END;

    END;					!OF R_PL
ROUTINE R_PR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = 	!RLD PSECT RELOCATION

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE PSECT RELOCATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
!	MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
!	DISP - DISPLACEMENT INTO TEXT RECORD
!	BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
!	BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
!	MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	OBTAINS STORAGE FROM THE FREE LIST
!
!--

    BEGIN

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

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	ASCVAL : VECTOR [CH$ALLOCATION (LEN_PSECT_NAME)],
	CONSTANT,
	MODU_PTR : REF MODU_BLOCK,
	PSECT_INFO : VECTOR [3],
	PSECT_PTR : REF PSECT_BLOCK,
	PSECT_PTR1 : REF PSECT_BLOCK,
	R50VAL,
	RLDH_PTR : REF RLDH_BLOCK;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'PSECT RELOCATION, MODIF = '));
	OUTNUM (1, .MODIF, 2, 0);
	OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
	OUTNUM (1, .DISP, 8, 0);
	END;					!DEBUG

    R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
    R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
    R50TOA (.R50VAL, ASCVAL [0]);

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	OUTSTR (1, UPLIT (%ASCIZ', NAME = '));
	OUTSTR (1, ASCVAL [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 INSIDE A MODULE
	PSECT_INFO [0] = ASCVAL [0];
	PSECT_INFO [1] = 0;
	PSECT_INFO [2] = 0;

	IF ((PSECT_PTR1 = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_PSECT, PSECT_INFO)) EQL 0)
	THEN
	    ERRMSG (0,
		10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
	ELSE
	    BEGIN				!THIS PSECT HAS BEEN DECLARED IN THIS MODULE

	    IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
	    THEN
		ERRMSG (0, 10, ROUTINE_NAME,
		    FILE_PTR [FILE_NAME], 0, 0, 0)
	    ELSE
		BEGIN				!WE ARE INSIDE A PSECT

		IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
		THEN
		    ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		ELSE
		    BEGIN			!WE HAVE AN RLD HEADER
!
! FOR PSECT RELOCATION, THE VALUE TO BE STORED IS SIMPLY THE VALUE OF
!  THE PSECT BASE.
!

		    IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_ADD, RLD_OPND_PSECT, RLD_OPND_CON,
			    .PSECT_PTR1, .PSECT_PTR1 [PSECT_OFFSET])) EQL 0)
		    THEN
			ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		    ELSE
			PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);

		    END;

		END;

	    END;

	END;

    END;					!OF R_PR
ROUTINE R_PDR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = 	!RLD PSECT DISPLACED RELOCATION

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE PSECT DISPLACED RELOCATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
!	MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
!	DISP - DISPLACEMENT INTO TEXT RECORD
!	BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
!	BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
!	MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	OBTAINS STORAGE FROM THE FREE LIST
!
!--

    BEGIN

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

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	ASCVAL : VECTOR [CH$ALLOCATION (LEN_PSECT_NAME)],
	CONSTANT,
	MODU_PTR : REF MODU_BLOCK,
	PSECT_INFO : VECTOR [3],
	PSECT_PTR : REF PSECT_BLOCK,
	PSECT_PTR1 : REF PSECT_BLOCK,
	R50VAL,
	RLDH_PTR : REF RLDH_BLOCK;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'PSECT DISPLACED RELOCATION, MODIF = '));
	OUTNUM (1, .MODIF, 2, 0);
	OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
	OUTNUM (1, .DISP, 8, 0);
	END;					!DEBUG

    R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
    R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
    R50TOA (.R50VAL, ASCVAL [0]);

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	OUTSTR (1, UPLIT (%ASCIZ', NAME = '));
	OUTSTR (1, ASCVAL [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 INSIDE A MODULE
	PSECT_INFO [0] = ASCVAL [0];
	PSECT_INFO [1] = 0;
	PSECT_INFO [2] = 0;

	IF ((PSECT_PTR1 = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_PSECT, PSECT_INFO)) EQL 0)
	THEN
	    ERRMSG (0,
		10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
	ELSE
	    BEGIN				!THIS PSECT HAS BEEN DECLARED IN THIS MODULE

	    IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
	    THEN
		ERRMSG (0, 10, ROUTINE_NAME,
		    FILE_PTR [FILE_NAME], 0, 0, 0)
	    ELSE
		BEGIN				!WE ARE INSIDE A PSECT

		IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
		THEN
		    ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		ELSE
		    BEGIN			!WE HAVE AN RLD HEADER
!
! FOR PSECT DISPLACED RELOCATION, THE VALUE TO BE STORED IS THE SUM
!  OF THE STORE ADDRESS + 2 AND THE BASE OF THE CURRENT PSECT,
!  SUBTRACTED FROM THE BASE OF THE SPECIFIED PSECT.
!

		    IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_SUB, RLD_OPND_OPR, RLD_OPND_OPR,
			    M_RLDD (RLD_OP_ADD, RLD_OPND_PSECT, RLD_OPND_CON, .PSECT_PTR1,
				.PSECT_PTR1 [PSECT_OFFSET]),
			    M_RLDD (RLD_OP_ADD, RLD_OPND_CON,
				RLD_OPND_PSECT, .RLDH_PTR [RLDH_ADDR] + 2, .PSECT_PTR))) EQL 0)
		    THEN
			ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		    ELSE
			PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);

		    END;

		END;

	    END;

	END;

    END;					!OF R_PDR
ROUTINE R_PAR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = 	!RLD PSECT ADDITIVE RELOCATION

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE PSECT ADDITIVE RELOCATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
!	MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
!	DISP - DISPLACEMENT INTO TEXT RECORD
!	BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
!	BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
!	MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	OBTAINS STORAGE FROM THE FREE LIST
!
!--

    BEGIN

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

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	ASCVAL : VECTOR [CH$ALLOCATION (LEN_PSECT_NAME)],
	CONSTANT,
	MODU_PTR : REF MODU_BLOCK,
	PSECT_INFO : VECTOR [3],
	PSECT_PTR : REF PSECT_BLOCK,
	PSECT_PTR1 : REF PSECT_BLOCK,
	R50VAL,
	RLDH_PTR : REF RLDH_BLOCK;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'PSECT ADDITIVE RELOCATION, MODIF = '));
	OUTNUM (1, .MODIF, 2, 0);
	OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
	OUTNUM (1, .DISP, 8, 0);
	END;					!DEBUG

    R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
    R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
    R50TOA (.R50VAL, ASCVAL [0]);

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	OUTSTR (1, UPLIT (%ASCIZ', NAME = '));
	OUTSTR (1, ASCVAL [0]);
	END;					!DEBUG

    CONSTANT = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	OUTSTR (1, UPLIT (%ASCIZ', CONSTANT = '));
	OUTNUM (1, .CONSTANT, 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 INSIDE A MODULE
	PSECT_INFO [0] = ASCVAL [0];
	PSECT_INFO [1] = 0;
	PSECT_INFO [2] = 0;

	IF ((PSECT_PTR1 = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_PSECT, PSECT_INFO)) EQL 0)
	THEN
	    ERRMSG (0,
		10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
	ELSE
	    BEGIN				!THIS PSECT HAS BEEN DECLARED IN THIS MODULE

	    IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
	    THEN
		ERRMSG (0, 10, ROUTINE_NAME,
		    FILE_PTR [FILE_NAME], 0, 0, 0)
	    ELSE
		BEGIN				!WE ARE INSIDE A PSECT

		IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
		THEN
		    ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		ELSE
		    BEGIN			!WE HAVE AN RLD HEADER
!
! FOR PSECT ADDITIVE RELOCATION, THE VALUE TO BE STORED IS THE
!  BASE OF THE SPECIFIED PSECT PLUS THE VALUE OF THE CONSTANT.
!

		    IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_ADD, RLD_OPND_OPR, RLD_OPND_CON,
			    M_RLDD (RLD_OP_ADD, RLD_OPND_PSECT, RLD_OPND_CON, .PSECT_PTR1,
				.PSECT_PTR1 [PSECT_OFFSET]), .CONSTANT)) EQL 0)
		    THEN
			ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		    ELSE
			PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);

		    END;

		END;

	    END;

	END;

    END;					!OF R_PAR
ROUTINE R_PADR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE =
						!RLD PSECT ADDITIVE DISPLACED RELOCATION

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE PSECT ADDITIVE DISPLACED RELOCATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
!	MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
!	DISP - DISPLACEMENT INTO TEXT RECORD
!	BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
!	BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
!	MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	OBTAINS STORAGE FROM THE FREE LIST
!
!--

    BEGIN

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

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	ASCVAL : VECTOR [CH$ALLOCATION (LEN_PSECT_NAME)],
	CONSTANT,
	MODU_PTR : REF MODU_BLOCK,
	PSECT_INFO : VECTOR [3],
	PSECT_PTR : REF PSECT_BLOCK,
	PSECT_PTR1 : REF PSECT_BLOCK,
	R50VAL,
	RLDH_PTR : REF RLDH_BLOCK;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'PSECT ADDITIVE DISPLACED RELOCATION, MODIF = '));
	OUTNUM (1, .MODIF, 2, 0);
	OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
	OUTNUM (1, .DISP, 8, 0);
	END;					!DEBUG

    R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
    R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
    R50TOA (.R50VAL, ASCVAL [0]);

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	OUTSTR (1, UPLIT (%ASCIZ', NAME = '));
	OUTSTR (1, ASCVAL [0]);
	END;					!DEBUG

    CONSTANT = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	OUTSTR (1, UPLIT (%ASCIZ', CONSTANT = '));
	OUTNUM (1, .CONSTANT, 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 INSIDE A MODULE
	PSECT_INFO [0] = ASCVAL [0];
	PSECT_INFO [1] = 0;
	PSECT_INFO [2] = 0;

	IF ((PSECT_PTR1 = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_PSECT, PSECT_INFO)) EQL 0)
	THEN
	    ERRMSG (0,
		10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
	ELSE
	    BEGIN				!THIS PSECT HAS BEEN DECLARED IN THIS MODULE

	    IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
	    THEN
		ERRMSG (0, 10, ROUTINE_NAME,
		    FILE_PTR [FILE_NAME], 0, 0, 0)
	    ELSE
		BEGIN				!WE ARE INSIDE A PSECT

		IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
		THEN
		    ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		ELSE
		    BEGIN			!WE HAVE AN RLD HEADER
!
! FOR PSECT ADDITIVE DISPLACED RELOCATION, THE VALUE TO BE STORED IS THE SUM
!  OF THE STORE ADDRESS + 2 AND THE BASE OF THE CURRENT PSECT,
!  SUBTRACTED FROM THE BASE OF THE SPECIFIED PSECT, PLUS THE GIVEN CONSTANT.
!

		    IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_SUB, RLD_OPND_OPR, RLD_OPND_OPR,
			    M_RLDD (RLD_OP_ADD, RLD_OPND_OPR, RLD_OPND_CON,
				M_RLDD (RLD_OP_ADD,
				    RLD_OPND_PSECT, RLD_OPND_CON, .PSECT_PTR1, .PSECT_PTR1 [PSECT_OFFSET]),
				.CONSTANT),
			    M_RLDD (RLD_OP_ADD, RLD_OPND_CON, RLD_OPND_PSECT,
				.RLDH_PTR [RLDH_ADDR] + 2, .PSECT_PTR))) EQL 0)
		    THEN
			ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
		    ELSE
			PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);

		    END;

		END;

	    END;

	END;

    END;					!OF R_PADR
ROUTINE SEL_SECTOR (PSECT_PTR, SECTOR) = 	!SELECT PROPER SECTOR

!++
! FUNCTIONAL DESCRIPTION:
!
!	SELECT A PSECT GIVEN ITS SECTOR NUMBER.
!	 USED IN A CALL TO FND_CHAIN.
!
! FORMAL PARAMETERS:
!
!	PSECT_PTR - POINTER TO PSECT TO TEST FOR SUITABILITY
!	SECTOR - NUMBER OF THE SECTOR WANTED
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	POINTER TO THE PSECT, OR 0.
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	PSECT_PTR : REF PSECT_BLOCK;

    IF (.SECTOR NEQ .PSECT_PTR [PSECT_SECTOR]) THEN 0 ELSE .PSECT_PTR

    END;					!OF SEL_SECTOR
ROUTINE R_CR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = 	!RLD COMPLEX RELOCATION

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE COMPLEX RELOCATION ENTRY OF THE RLD RECORD.
!
! FORMAL PARAMETERS:
!
!	MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
!	DISP - DISPLACEMENT INTO TEXT RECORD
!	BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
!	BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
!	MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	OBTAINS STORAGE FROM THE FREE LIST
!
!--

    BEGIN

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

    LITERAL
	STACK_LIMIT = 100;

    MAP
	FILE_PTR : REF FILE_BLOCK;

    LOCAL
	ASCVAL : VECTOR [CH$ALLOCATION (LEN_PSECT_NAME)],
	COMMAND_TERM,
	CONSTANT,
	GLOBAL_INFO : VECTOR [3],
	GLOBL_PTR : REF GLOBL_BLOCK,
	MODU_PTR : REF MODU_BLOCK,
	OFFSET,
	OPCODE,
	OPND_TYPE : VECTOR [STACK_LIMIT],
	OPND_VAL : VECTOR [STACK_LIMIT],
	PSECT_PTR : REF PSECT_BLOCK,
	PSECT_PTR1 : REF PSECT_BLOCK,
	R50VAL,
	RLDD_PTR : REF RLDD_BLOCK,
	RLDH_PTR : REF RLDH_BLOCK,
	SECTOR,
	STACK_DEPTH,
	TEMP_RLDH_VAL;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'COMPLEX RELOCATION, MODIF = '));
	OUTNUM (1, .MODIF, 2, 0);
	OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
	OUTNUM (1, .DISP, 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 INSIDE A MODULE

	IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
	THEN
	    ERRMSG (0, 10, ROUTINE_NAME,
		FILE_PTR [FILE_NAME], 0, 0, 0)
	ELSE
	    BEGIN				!WE ARE INSIDE A PSECT
	    STACK_DEPTH = 0;
	    COMMAND_TERM = 0;

	    WHILE (.COMMAND_TERM EQL 0) DO
		BEGIN
		OPCODE = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR);

		CASE .OPCODE FROM %O'0' TO %O'21' OF
		    SET

		    [%O'0'] :
			BEGIN			!NO OPERATION

			IF (DEBUG GEQ 1)
			THEN
			    BEGIN		!DEBUG
			    PCRLF (1);
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTSTR (1, UPLIT (%ASCIZ'NOP OPERATOR'));
			    END;		!DEBUG

			END;

		    [%O'1'] :
			BEGIN			!ADDITION

			IF (DEBUG GEQ 1)
			THEN
			    BEGIN		!DEBUG
			    PCRLF (1);
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTSTR (1, UPLIT (%ASCIZ'ADD OPERATOR'));
			    END;		!DEBUG

			RLDD_PTR = M_RLDD (RLD_OP_ADD, .OPND_TYPE [.STACK_DEPTH - 2],
			    .OPND_TYPE [.STACK_DEPTH - 1], .OPND_VAL [.STACK_DEPTH - 2],
			    .OPND_VAL [.STACK_DEPTH - 1]);

			IF ((STACK_DEPTH = .STACK_DEPTH - 2) LSS 0)
			THEN
			    ERRMSG (0, 10, ROUTINE_NAME,
				FILE_PTR [FILE_NAME], 0, 0, 0)
			ELSE
			    BEGIN
			    OPND_TYPE [.STACK_DEPTH] = RLD_OPND_OPR;
			    OPND_VAL [.STACK_DEPTH] = .RLDD_PTR;
			    STACK_DEPTH = .STACK_DEPTH + 1;
			    END;

			END;

		    [%O'2'] :
			BEGIN			!SUBTRACT

			IF (DEBUG GEQ 1)
			THEN
			    BEGIN		!DEBUG
			    PCRLF (1);
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTSTR (1, UPLIT (%ASCIZ'SUB OPERATOR'));
			    END;		!DEBUG

			RLDD_PTR = M_RLDD (RLD_OP_SUB, .OPND_TYPE [.STACK_DEPTH - 2],
			    .OPND_TYPE [.STACK_DEPTH - 1], .OPND_VAL [.STACK_DEPTH - 2],
			    .OPND_VAL [.STACK_DEPTH - 1]);

			IF ((STACK_DEPTH = .STACK_DEPTH - 2) LSS 0)
			THEN
			    ERRMSG (0, 10, ROUTINE_NAME,
				FILE_PTR [FILE_NAME], 0, 0, 0)
			ELSE
			    BEGIN
			    OPND_TYPE [.STACK_DEPTH] = RLD_OPND_OPR;
			    OPND_VAL [.STACK_DEPTH] = .RLDD_PTR;
			    STACK_DEPTH = .STACK_DEPTH + 1;
			    END;

			END;

		    [%O'3'] :
			BEGIN			!MULTIPLICATION

			IF (DEBUG GEQ 1)
			THEN
			    BEGIN		!DEBUG
			    PCRLF (1);
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTSTR (1, UPLIT (%ASCIZ'MUL OPERATOR'));
			    END;		!DEBUG

			RLDD_PTR = M_RLDD (RLD_OP_MUL, .OPND_TYPE [.STACK_DEPTH - 2],
			    .OPND_TYPE [.STACK_DEPTH - 1], .OPND_VAL [.STACK_DEPTH - 2],
			    .OPND_VAL [.STACK_DEPTH - 1]);

			IF ((STACK_DEPTH = .STACK_DEPTH - 2) LSS 0)
			THEN
			    ERRMSG (0, 10, ROUTINE_NAME,
				FILE_PTR [FILE_NAME], 0, 0, 0)
			ELSE
			    BEGIN
			    OPND_TYPE [.STACK_DEPTH] = RLD_OPND_OPR;
			    OPND_VAL [.STACK_DEPTH] = .RLDD_PTR;
			    STACK_DEPTH = .STACK_DEPTH + 1;
			    END;

			END;

		    [%O'4'] :
			BEGIN			!DIVIDE

			IF (DEBUG GEQ 1)
			THEN
			    BEGIN		!DEBUG
			    PCRLF (1);
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTSTR (1, UPLIT (%ASCIZ'DIV OPERATOR'));
			    END;		!DEBUG

			RLDD_PTR = M_RLDD (RLD_OP_DIV, .OPND_TYPE [.STACK_DEPTH - 2],
			    .OPND_TYPE [.STACK_DEPTH - 1], .OPND_VAL [.STACK_DEPTH - 2],
			    .OPND_VAL [.STACK_DEPTH - 1]);

			IF ((STACK_DEPTH = .STACK_DEPTH - 2) LSS 0)
			THEN
			    ERRMSG (0, 10, ROUTINE_NAME,
				FILE_PTR [FILE_NAME], 0, 0, 0)
			ELSE
			    BEGIN
			    OPND_TYPE [.STACK_DEPTH] = RLD_OPND_OPR;
			    OPND_VAL [.STACK_DEPTH] = .RLDD_PTR;
			    STACK_DEPTH = .STACK_DEPTH + 1;
			    END;

			END;

		    [%O'5'] :
			BEGIN			!LOGICAL AND

			IF (DEBUG GEQ 1)
			THEN
			    BEGIN		!DEBUG
			    PCRLF (1);
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTSTR (1, UPLIT (%ASCIZ'AND OPERATOR'));
			    END;		!DEBUG

			RLDD_PTR = M_RLDD (RLD_OP_AND, .OPND_TYPE [.STACK_DEPTH - 2],
			    .OPND_TYPE [.STACK_DEPTH - 1], .OPND_VAL [.STACK_DEPTH - 2],
			    .OPND_VAL [.STACK_DEPTH - 1]);

			IF ((STACK_DEPTH = .STACK_DEPTH - 2) LSS 0)
			THEN
			    ERRMSG (0, 10, ROUTINE_NAME,
				FILE_PTR [FILE_NAME], 0, 0, 0)
			ELSE
			    BEGIN
			    OPND_TYPE [.STACK_DEPTH] = RLD_OPND_OPR;
			    OPND_VAL [.STACK_DEPTH] = .RLDD_PTR;
			    STACK_DEPTH = .STACK_DEPTH + 1;
			    END;

			END;

		    [%O'6'] :
			BEGIN			!LOGICAL OR

			IF (DEBUG GEQ 1)
			THEN
			    BEGIN		!DEBUG
			    PCRLF (1);
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTSTR (1, UPLIT (%ASCIZ'OR OPERATOR'));
			    END;		!DEBUG

			RLDD_PTR = M_RLDD (RLD_OP_OR, .OPND_TYPE [.STACK_DEPTH - 2],
			    .OPND_TYPE [.STACK_DEPTH - 1], .OPND_VAL [.STACK_DEPTH - 2],
			    .OPND_VAL [.STACK_DEPTH - 1]);

			IF ((STACK_DEPTH = .STACK_DEPTH - 2) LSS 0)
			THEN
			    ERRMSG (0, 10, ROUTINE_NAME,
				FILE_PTR [FILE_NAME], 0, 0, 0)
			ELSE
			    BEGIN
			    OPND_TYPE [.STACK_DEPTH] = RLD_OPND_OPR;
			    OPND_VAL [.STACK_DEPTH] = .RLDD_PTR;
			    STACK_DEPTH = .STACK_DEPTH + 1;
			    END;

			END;

		    [%O'10'] :
			BEGIN			!NEGATION, REPRESENTED AS 0-VALUE

			IF (DEBUG GEQ 1)
			THEN
			    BEGIN		!DEBUG
			    PCRLF (1);
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTSTR (1, UPLIT (%ASCIZ'NEG OPERATOR'));
			    END;		!DEBUG

			RLDD_PTR = M_RLDD (RLD_OP_SUB, RLD_OPND_CON, .OPND_TYPE [.STACK_DEPTH - 1], 0,
			    .OPND_VAL [.STACK_DEPTH - 1]);

			IF ((STACK_DEPTH = .STACK_DEPTH - 1) LSS 0)
			THEN
			    ERRMSG (0, 10, ROUTINE_NAME,
				FILE_PTR [FILE_NAME], 0, 0, 0)
			ELSE
			    BEGIN
			    OPND_TYPE [.STACK_DEPTH] = RLD_OPND_OPR;
			    OPND_VAL [.STACK_DEPTH] = .RLDD_PTR;
			    STACK_DEPTH = .STACK_DEPTH + 1;
			    END;

			END;

		    [%O'11'] :
			BEGIN			!COMPLEMENT

			IF (DEBUG GEQ 1)
			THEN
			    BEGIN		!DEBUG
			    PCRLF (1);
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTSTR (1, UPLIT (%ASCIZ'COM OPERATOR'));
			    END;		!DEBUG

			RLDD_PTR = M_RLDD (RLD_OP_COM, .OPND_TYPE [.STACK_DEPTH - 1], RLD_OPND_OMIT,
			    .OPND_VAL [.STACK_DEPTH - 1], 0);

			IF ((STACK_DEPTH = .STACK_DEPTH - 1) LSS 0)
			THEN
			    ERRMSG (0, 10, ROUTINE_NAME,
				FILE_PTR [FILE_NAME], 0, 0, 0)
			ELSE
			    BEGIN
			    OPND_TYPE [.STACK_DEPTH] = RLD_OPND_OPR;
			    OPND_VAL [.STACK_DEPTH] = .RLDD_PTR;
			    STACK_DEPTH = .STACK_DEPTH + 1;
			    END;

			END;

		    [%O'12'] :
			BEGIN			!NORMAL COMMAND TERMINATION

			IF (DEBUG GEQ 1)
			THEN
			    BEGIN		!DEBUG
			    PCRLF (1);
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTSTR (1, UPLIT (%ASCIZ'STORE OPERATOR'));
			    END;		!DEBUG

			COMMAND_TERM = 1;
			END;

		    [%O'13'] :
			BEGIN			!DISPLACED COMMAND TERMINATION

			IF (DEBUG GEQ 1)
			THEN
			    BEGIN		!DEBUG
			    PCRLF (1);
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTSTR (1, UPLIT (%ASCIZ'STORE DISPLACED OPERATOR'));
			    END;		!DEBUG

			COMMAND_TERM = 2;
			END;

		    [%O'16'] :
			BEGIN			!GLOBAL SYMBOL VALUE
			R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
			R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
			R50TOA (.R50VAL, ASCVAL [0]);

			IF (DEBUG GEQ 1)
			THEN
			    BEGIN		!DEBUG
			    PCRLF (1);
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTSTR (1, UPLIT (%ASCIZ'GLOBAL SYMBOL OPERAND = '));
			    OUTSTR (1, ASCVAL [0]);
			    END;		!DEBUG

			GLOBAL_INFO [0] = ASCVAL [0];
			GLOBAL_INFO [1] = 0;
			GLOBAL_INFO [2] = 0;

			IF ((GLOBL_PTR = FND_CHAIN (.MODU_PTR [MODU_GLOBALS], SEL_GLOBAL, GLOBAL_INFO)) EQL 0)

			THEN
			    ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
			ELSE
			    BEGIN		!THIS GLOBAL HAS BEEN DECLARED IN THIS MODULE
			    GBL_REF (.GLOBL_PTR, .PSECT_PTR, .MODU_PTR);
			    OPND_TYPE [.STACK_DEPTH] = RLD_OPND_GLOBAL;
			    OPND_VAL [.STACK_DEPTH] = .GLOBL_PTR;

			    IF ((STACK_DEPTH = .STACK_DEPTH + 1) GTR STACK_LIMIT)
			    THEN
				ERRMSG (0, 14,
				    ROUTINE_NAME, FILE_PTR [FILE_NAME], STACK_LIMIT, 0, 0);

			    END;

			END;

		    [%O'17'] :
			BEGIN			!RELOCATABLE VALUE

			IF (DEBUG GEQ 1)
			THEN
			    BEGIN		!DEBUG
			    PCRLF (1);
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTSTR (1, UPLIT (%ASCIZ'RELOCATABLE VALUE, OPERANDS = '));
			    END;		!DEBUG

			SECTOR = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR);
			OFFSET = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);

			IF (DEBUG GEQ 1)
			THEN
			    BEGIN		!DEBUG
			    OUTNUM (1, .SECTOR, 10, 0);
			    OUTSTR (1, UPLIT (%ASCIZ', '));
			    OUTNUM (1, .OFFSET, 8, 0);
			    END;		!DEBUG

			IF ((PSECT_PTR1 = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_SECTOR, .SECTOR)) EQL 0)
			THEN
			    ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
			ELSE
			    BEGIN		!THIS PSECT HAS BEEN DECLARED IN THIS MODULE
			    OPND_TYPE [.STACK_DEPTH] = RLD_OPND_OPR;
			    OPND_VAL [.STACK_DEPTH] = M_RLDD (RLD_OP_ADD, RLD_OPND_PSECT, RLD_OPND_CON,
				.PSECT_PTR1, .PSECT_PTR1 [PSECT_OFFSET] + .OFFSET);

			    IF ((STACK_DEPTH = .STACK_DEPTH + 1) GTR STACK_LIMIT)
			    THEN
				ERRMSG (0, 14,
				    ROUTINE_NAME, FILE_PTR [FILE_NAME], STACK_LIMIT, 0, 0);

			    END;

			END;

		    [%O'20'] :
			BEGIN			!CONSTANT

			IF (DEBUG GEQ 1)
			THEN
			    BEGIN		!DEBUG
			    PCRLF (1);
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTSTR (1, UPLIT (%ASCIZ'CONSTANT OPERAND, VALUE ='));
			    END;		!DEBUG

			CONSTANT = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);

			IF (DEBUG GEQ 1)
			THEN
			    BEGIN		!DEBUG
			    OUTNUM (1, .CONSTANT, 8, 0);
			    END;		!DEBUG

			OPND_TYPE [.STACK_DEPTH] = RLD_OPND_CON;
			OPND_VAL [.STACK_DEPTH] = .CONSTANT;
			STACK_DEPTH = .STACK_DEPTH + 1;
			END;

		    [%O'21'] :
			BEGIN			!RESIDENT LIBRARY BASE

			IF (DEBUG GEQ 1)
			THEN
			    BEGIN		!DEBUG
			    PCRLF (1);
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTPUT (1, %O'11');
			    OUTSTR (1, UPLIT (%ASCIZ'RESIDENT LIBRARY BASE OPERAND'));
			    END;		!DEBUG

			ERRMSG (0, 12, ROUTINE_NAME, 0, 0, 0, 0);
			END;

		    [INRANGE] :
			BEGIN			!UNUSED VALUE
			ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
			END;

		    [OUTRANGE] :
			BEGIN			!OUT OF VALID RANGE
			ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
			END;
		    TES;

		END;				!OF ITERATION ON PICKING UP OPERATORS AND OPERANDS

!
! THERE SHOULD NOW BE ONE ITEM IN THE STACK, THE VALUE TO
!  STORE.
!

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

	    IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
	    THEN
		ERRMSG (0,
		    1, ROUTINE_NAME, 0, 0, 0, 0)
	    ELSE
		BEGIN
		TEMP_RLDH_VAL = (IF ((.COMMAND_TERM EQL 1) AND (.OPND_TYPE [.STACK_DEPTH - 1] EQL RLD_OPND_OPR
		    )) THEN
!
! THIS, THE USUAL CASE, CAN BE HANDLED WITHOUT CREATING ANOTHER
!  RLDD BLOCK.
!
		    .OPND_VAL [.STACK_DEPTH - 1] ELSE M_RLDD (RLD_OP_SUB, .OPND_TYPE [.STACK_DEPTH - 1],
			(IF (.COMMAND_TERM EQL 1) THEN RLD_OPND_CON ELSE RLD_OPND_OPR),
			.OPND_VAL [.STACK_DEPTH - 1],
			(IF (.COMMAND_TERM EQL 1) THEN 0 ELSE M_RLDD (RLD_OP_ADD, RLD_OPND_CON,
				RLD_OPND_PSECT, .RLDH_PTR [RLDH_ADDR] + 2, .PSECT_PTR))));
		RLDH_PTR [RLDH_VALUE] = .TEMP_RLDH_VAL;
		STACK_DEPTH = .STACK_DEPTH - 1;
		PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);
		END;

	    END;

	END;

    END;					!OF R_CR
ROUTINE R_LR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = 	!RLD LIBRARY RELOCATION

!++
! FUNCTIONAL DESCRIPTION:
!
!	PROCESS THE LIBRARY RELOCATION ENTRY OF THE RLD RECORD.
!	 THIS IS NOT IMPLEMENTED.
!
! FORMAL PARAMETERS:
!
!	MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
!	DISP - DISPLACEMENT INTO TEXT RECORD
!	BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
!	BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
!	FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
!	INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

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

    LOCAL
	CONSTANT;

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	PCRLF (1);
	OUTPUT (1, %O'11');
	OUTPUT (1, %O'11');
	OUTSTR (1, UPLIT (%ASCIZ'LIBRARY RELOCATION, MODIF = '));
	OUTNUM (1, .MODIF, 2, 0);
	OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
	OUTNUM (1, .DISP, 8, 0);
	END;					!DEBUG

    CONSTANT = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);

    IF (DEBUG GEQ 1)
    THEN
	BEGIN
	OUTSTR (1, UPLIT (%ASCIZ', CONSTANT = '));
	OUTNUM (1, .CONSTANT, 8, 0);
	END;					!DEBUG

    ERRMSG (0, 12, ROUTINE_NAME, 0, 0, 0, 0);
    END;					!OF R_LR
!
END

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