Trailing-Edge
-
PDP-10 Archives
-
BB-X117B-SB_1986
-
10,7/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) DIGITAL EQUIPMENT CORPORATION 1980,1981,1982,1986. ALL RIGHTS RESERVED.
!
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
!AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!
!
!++
! FACILITY: TKB-20
!
! ABSTRACT:
!
!
! THIS MODULE 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: