Trailing-Edge
-
PDP-10 Archives
-
TOPS-20_V6.1_DECnetSrc_7-23-85
-
mcb/tkb36/bfio.bli
There are 2 other files named bfio.bli in the archive. Click here to see a list.
!<DECNET20-V3P0.TKB-VNP>BFIO.BLI.10 16-Jan-81 14:41:38, Edit by SROBINSON
!NET:<DECNET20-V3P0.TKB-VNP>BFIO.BLI.7 16-Jan-81 12:18:08, Edit by SROBINSON
!<REL4A.TKB-VNP>BFIO.BLI.10, 28-Nov-79 07:20:19, Edit by SROBINSON
MODULE BFIO ( !BINARY FILE I/O
IDENT = 'X2.0-3'
) =
BEGIN
!
!
!
! COPYRIGHT (c) 1980, 1981, 1982
! DIGITAL EQUIPMENT CORPORATION
! Maynard, Massachusetts
!
! This software is furnished under a license and may be used
! and copied only in accordance with the terms of such license
! and with the inclusion of the above copyright notice. This
! software or any other copies thereof may not be provided or
! otherwise made available to any other person. No title to
! and ownership of the software is hereby transferred.
!
! The information in this software is subject to change
! without notice and should not be construed as a commitment
! by DIGITAL EQUIPMENT CORPORATION.
!
! DIGITAL assumes no responsibility for the use or reliability
! of its software on equipment which is not supplied by
! DIGITAL.
!
!++
! FACILITY: TKB-20
!
! ABSTRACT:
!
!
! THIS MODULE READS THE BINARY ("OBJECT") FILE, CHECKING CHECKSUMS.
!
!
! ENVIRONMENT: TOPS-20 USER MODE
!
! AUTHOR: J. SAUTER, CREATION DATE: 20-JAN-78
!
! MODIFIED BY:
!
! Scott G. Robinson, 26-SEP-78 : VERSION X0.1-2A
! - Modify so that a recovery can be done on a module error
! such as reading a DOS formatted module in RSX mode
! - Fixup so that odd length records are aligned correctly
! - Fix problem with complex relocation that caused constant operands
! to not be generated correctly
! - Ensure PSECTs are considered in Radix-50 Order
!
! Scott G. Robinson, 18-FEB-79 : VERSION X0.1-3
! - Modify TEXT processing to include a pointer to the MODULE block
! so that BCOR can obtain vital statistics about a load module
!
! Dale C. Gunn, 24-AUG-79 : VERSION X0.1-4
! - Modify GSD_PSN to not round text offsets within PSECT's
!
!------------ End of modifications for V0 and V1 ------------
!
!
! Scott G. Robinson, 28-NOV-79 : Version X2.0
! - Make object module reading a two pass operation so
! that BLISS-16 objects work correctly. Also ensure
! TOPS-10 compatibility.
!
! Scott G. Robinson, 16-JAN-81 : Version X2.0-1
! - Make Transfer Addresses work Correctly for BCOR
! - Make Selective Search Flags apply to Libraries
!
! Scott G. Robinson, 27-JAN-81 : Version X2.0-2
! - Make Global Symbols defined after referenced in same
! module work correctly
!
! Scott G. Robinson, 28-JAN-81 : Version X2.0-3
! - Make another fix to /SSed Global Symbol References
!
! , : VERSION
! 01 -
!--
!<BLF/PAGE>
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
RD16, !READ A 16-BIT WORD
RDOBBL, !READ AN OBJECT BLOCK
RDLBBL, !READ A LIBRARY BLOCK
RDFILE : NOVALUE, !READ AN OBJECT FILE
RDLIBR : NOVALUE, !READ A LIBRARY FILE
GET_BYTE, !GET BYTE FROM OBJ RECORD
GET_WORD, !GET WORD FROM OBJ RECORD
!
! ROUTINES FOR PROCESSING OBJECT RECORDS
!
OBJ_GSD : NOVALUE, !PROCESS GSD RECORD
OBJ_END_GSD : NOVALUE, !PROCESS END GSD RECORD
OBJ_TEXT : NOVALUE, !PROCESS TEXT RECORD
OBJ_RLD : NOVALUE, !PROCESS RLD RECORD
OBJ_ISD : NOVALUE, !PROCESS INTERNAL SYMBOL DICTIONARY RECORD
OBJ_EOM : NOVALUE, !PROCESS END OF MODULE
!
! ROUTINES FOR PROCESSING GSD ENTRIES
!
GSD_MNAME : NOVALUE, !PROCESS MODULE NAME
GSD_CNAME : NOVALUE, !PROCESS CSECT NAME ENTRY
GSD_ISN : NOVALUE, !PROCESS INTERNAL SYMBOL NAME
GSD_TRA : NOVALUE, !PROCESS TRANSFER ADDRESS
SEL_GLOBAL, !FIND A GLOBAL SYMBOL
GSD_GSN : NOVALUE, !PROCESS GLOBAL SYMBOL NAME
SEL_PSECT, !FIND A PSECT BY NAME
SEL_SECTOR, !FIND A PSECT BY SECTOR
GSD_PSN : NOVALUE, !PROCESS PSECT NAME
GSD_IDENT : NOVALUE, !PROCESS AN IDENT
GSD_MAP : NOVALUE, !PROCESS A MAPPED ARRAY
!
! ROUTINES FOR PROCESSING RLD ENTRIES
!
M_RLDH, !MAKE RLDH BLOCK
M_RLDD, !MAKE RLDD BLOCK
GBL_REF : NOVALUE, !RECORD A GLOBAL REFERENCE
R_ERR : NOVALUE, !ERROR (NOT USED)
R_IR : NOVALUE, !INTERNAL RELOCATION
R_GR : NOVALUE, !GLOBAL RELOCATION
R_IDR : NOVALUE, !INTERNAL DISPLACED RELOCATION
R_GDR : NOVALUE, !GLOBAL DISPLACED RELOCATION
R_GAR : NOVALUE, !GLOBAL ADDITIVE RELOCATION
R_GADR : NOVALUE, !GLOBAL ADDITIVE DISPLACED RELOCATION
R_LCD : NOVALUE, !LOCATION COUNTER DEFINITION
R_LCM : NOVALUE, !LOCATION COUNTER MODIFICATION
R_PL : NOVALUE, !PROGRAM LIMITS
R_PR : NOVALUE, !PSECT RELOCATION
R_PDR : NOVALUE, !PSECT DISPLACED RELOCATION
R_PAR : NOVALUE, !PSECT ADDITIVE RELOCATION
R_PADR : NOVALUE, !PSECT ADDITIVE DISPLACED RELOCATION
R_CR : NOVALUE, !COMPLEX RELOCATION
R_LR : NOVALUE; !LIBRARY RELOCATION
!
! INCLUDE FILES:
!
LIBRARY 'TKBLIB';
!REQUIRE 'BLOCKH.REQ'; !PREPARE TO DEFINE STORAGE BLOCKS
!REQUIRE 'FILE.REQ'; !DEFINE FILE STORAGE BLOCKS
!REQUIRE 'GLOBL.REQ'; !DEFINE GLOBAL STORAGE BLOCK
!REQUIRE 'MODU.REQ'; !DEFINE MODULE STORAGE BLOCK
!REQUIRE 'PSECT.REQ'; !DEFINE PSECT STORAGE BLOCK
!REQUIRE 'RLDD.REQ'; !DEFINE RLD DATA STORAGE BLOCK
!REQUIRE 'RLDH.REQ'; !DEFINE RLD HEADER STORAGE BLOCK
!REQUIRE 'ROOT.REQ'; !DEFINE ROOT STORAGE BLOCK
!REQUIRE 'TEXTD.REQ'; !DEFINE OBJECT TEXT DATA STORAGE BLOCK
!REQUIRE 'TEXTH.REQ'; !DEFINE OBJECT TEXT HEADER STORAGE BLOCK
!REQUIRE 'BLOCKT.REQ'; !END OF STORAGE BLOCK DEFINITIONS
!
! MACROS:
!
! NONE
!
! EQUATED SYMBOLS:
!
LITERAL
DEBUG = 0;
!
! OWN STORAGE:
!
! NONE
!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
OPEN : NOVALUE, !OPEN A FILE
CLOSE : NOVALUE, !CLOSE A FILE
INPUT, !READ FROM A FILE
ERRMSG : NOVALUE, !PRINT AN ERROR MESSAGE
GETSTG, !GET STORAGE FROM THE FREE LIST
GET_SW, !GET A FILE SWITCH
FRESTG, !RETURN STORAGE TO THE FREE LIST
GETBLK, !GET A STORAGE BLOCK
BLD_CHAIN, !BUILD A CHAIN BLOCK
FND_CHAIN, !FIND AN ITEM IN A CHAINED BLOCK
RX50, !CONVERT CHARACTER TO RADIX 50
R50TOA : NOVALUE, !CONVERT RADIX 50 TO ASCII
PCRLF : NOVALUE, !PRINT CRLF
OUTPUT : NOVALUE, !WRITE ON A FILE
OUTNUM : NOVALUE, !PRINT A NUMBER
OUTSTR : NOVALUE; !PRINT AN ASCII STRING
EXTERNAL
ROOT : REF ROOT_BLOCK; !ROOT OF DATA STRUCTURE
ROUTINE RD16 (CHAN, CHKSUM) = !READ A 16-BIT WORD
!++
! FUNCTIONAL DESCRIPTION:
!
! READ A 16-BIT WORD, ASSEMBLING IT FROM THE 8-BIT
! INPUT STREAM. MAINTAIN THE CHECKSUM.
!
! FORMAL PARAMETERS:
!
! CHAN - THE CHANNEL OVER WHICH TO READ THE 8-BIT BYTES
! CHKSUM - ADDRESS OF THE CHECKSUM CELL
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! THE VALUE OF THE 16-BIT WORD READ, OR -1 IF WE REACHED
! END OF FILE ON INPUT.
!
! SIDE EFFECTS
!
! READS FROM THE INPUT FILE. MAY REACH EOF.
!
!--
BEGIN
LOCAL
BYTE1,
BYTE2,
RESULT;
IF ((BYTE1 = INPUT (.CHAN)) LSS 0)
THEN
.BYTE1
ELSE
BEGIN
.CHKSUM = ..CHKSUM + .BYTE1;
IF ((BYTE2 = INPUT (.CHAN)) LSS 0)
THEN
.BYTE2
ELSE
BEGIN
.CHKSUM = ..CHKSUM + .BYTE2;
RESULT = 0;
RESULT<8, 8> = .BYTE2; !HIGH-ORDER BYTE
RESULT<0, 8> = .BYTE1; !LOW-ORDER BYTE
.RESULT
END
END
END;
!
ROUTINE RDOBBL (CHAN, FILE_PTR, BYTES_READ) = !READ AN OBJECT BLOCK
!++
! FUNCTIONAL DESCRIPTION:
!
! READ A BLOCK OF DATA FROM THE OBJECT FILE. THIS BLOCK
! STARTS WITH A HEADER OF 1 AND ENDS WITH A CHECKSUM.
! LEADING ZEROS ARE IGNORED. AFTER THE HEADER IS A COUNT
! WORD WHICH IS FOLLOWED BY TEXT. THIS TEXT MAY CONTAIN
! SEVERAL RECORDS.
! THIS FORMAT IS USED BY ".OBJ" FILES WHICH HAVE BEEN PASSED
! THROUGH THE RSX-11M UTILITY "FLX".
!
! FORMAL PARAMETERS:
!
! CHAN - THE CHANNEL OVER WHICH TO READ DATA. IT MUST HAVE
! BEEN OPENED IN WORD MODE.
! FILE_PTR - POINTER TO THE FILE BLOCK FOR
! ERROR MESSAGES.
! BYTES_READ - SET TO THE NUMBER OF BYTES READ FROM THE INPUT
! CHANNEL.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! A POINTER TO A VECTOR. THE FIRST WORD OF THE VECTOR HAS
! ITS LENGTH IN WORDS. THE SECOND HAS THE LENGTH OF DATA IN
! BYTES. SUBSEQUENT WORDS ARE THE DATA READ, SUITABLE
! FOR SCANNING 8 BITS AT A TIME USING CH$A_RCHAR. IT IS
! THE CALLER'S RESPONSIBILITY TO FREE THIS VECTOR BY CALLING
! FRESTG.
! IF WE REACH EOF, -1 IS RETURNED. IF STORAGE IS NOT AVAILABLE,
! 0 IS RETURNED. AN INVALID FORMAT ALSO RETURNS -1.
!
! SIDE EFFECTS
!
! READS DATA FROM THE INPUT CHANNEL. MAY GET EOF.
! OBTAINS STORAGE FROM THE FREE LIST.
! WILL RETURN IT ON ERROR.
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'READ_OBJECT_BLOCK');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
BLKPTR,
BYTE1,
CHKSUM,
COUNT,
OUTLEN,
RESULT : REF VECTOR;
CHKSUM = 0;
.BYTES_READ = 0;
RESULT = 0;
!
! SKIP BLANK LEADER
!
DO
BEGIN
BYTE1 = INPUT (.CHAN);
.BYTES_READ = ..BYTES_READ + 1;
END
UNTIL (.BYTE1 NEQ 0);
IF (.BYTE1 NEQ 1)
THEN
BEGIN
IF (..BYTES_READ LEQ 2) THEN RETURN -1;
IF (.BYTE1 GTR 0) THEN ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
RESULT = -1;
END
ELSE
BEGIN
CHKSUM = .CHKSUM + .BYTE1;
BYTE1 = INPUT (.CHAN);
.BYTES_READ = ..BYTES_READ + 1;
IF (.BYTE1 NEQ 0)
THEN
BEGIN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
RESULT = -1;
END
ELSE
BEGIN
.BYTES_READ = ..BYTES_READ + 2;
IF ((OUTLEN = RD16 (.CHAN, CHKSUM)) LSS 6)
THEN
BEGIN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
RESULT = -1;
END
ELSE
BEGIN
IF ((RESULT = GETSTG ((((.OUTLEN - 4)/4) + 3))) LEQ 0)
THEN
BEGIN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0);
END
ELSE
BEGIN
RESULT [0] = (((.OUTLEN - 4)/4) + 3); !AMOUNT TO FREE
RESULT [1] = .OUTLEN - 4; !NUMBER OF BYTES
BLKPTR = CH$PTR (RESULT [2], -1, 8);
COUNT = 0;
WHILE (((COUNT = .COUNT + 1) LEQ .OUTLEN - 4) AND (.BYTE1 GEQ 0)) DO
BEGIN
BYTE1 = INPUT (.CHAN);
.BYTES_READ = ..BYTES_READ + 1;
CHKSUM = .CHKSUM + .BYTE1;
IF (.BYTE1 GEQ 0) THEN CH$A_WCHAR (.BYTE1, BLKPTR);
END;
IF (.BYTE1 LSS 0)
THEN
BEGIN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
FRESTG (.RESULT, .RESULT [0]);
RESULT = -1;
END
ELSE
BEGIN
BYTE1 = INPUT (.CHAN);
.BYTES_READ = ..BYTES_READ + 1;
IF (.BYTE1 LSS 0)
THEN
BEGIN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
FRESTG (.RESULT, .RESULT [0]);
RESULT = -1;
END
ELSE
BEGIN
CHKSUM = -.CHKSUM;
CHKSUM = .CHKSUM<0, 8>;
IF (.BYTE1 NEQ .CHKSUM)
THEN
BEGIN
ERRMSG (0, 11, ROUTINE_NAME, FILE_PTR [FILE_NAME], .CHKSUM, .BYTE1, 0);
FRESTG (.RESULT, .RESULT [0]);
RESULT = -1;
END;
END;
END;
END;
END;
END;
END;
.RESULT
END; !OF RDOBBL
ROUTINE RDLBBL (CHAN, FILE_PTR, BYTES_READ) = !READ A LIBRARY BLOCK
!++
! FUNCTIONAL DESCRIPTION:
!
! READ A BLOCK OF DATA FROM THE LIBRARY FILE. THIS BLOCK
! STARTS WITH A COUNT WORD FOLLOWED BY "COUNT" DATA WORDS.
! THE DATA WORDS COMPRISE OBJECT TEXT WHICH MAY CONTAIN
! SEVERAL RECORDS.
! THIS FORMAT IS ALSO USED FOR OBJECT FILES WITHOUT THE "DOS"
! SWITCH.
!
! FORMAL PARAMETERS:
!
! CHAN - THE CHANNEL OVER WHICH TO READ DATA. IT MUST HAVE
! BEEN OPENED IN WORD MODE.
! FILE_PTR - POINTER TO THE FILE BLOCK FOR
! ERROR MESSAGES.
! BYTES_READ - SET TO THE NUMBER OF BYTES READ FROM THE INPUT
! CHANNEL.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! A POINTER TO A VECTOR. THE FIRST WORD OF THE VECTOR HAS
! ITS LENGTH IN WORDS. THE SECOND HAS THE LENGTH OF DATA IN
! BYTES. SUBSEQUENT WORDS ARE THE DATA READ, SUITABLE
! FOR SCANNING 8 BITS AT A TIME USING CH$A_RCHAR. IT IS
! THE CALLER'S RESPONSIBILITY TO FREE THIS VECTOR BY CALLING
! FRESTG.
! IF WE REACH EOF, -1 IS RETURNED. IF STORAGE IS NOT AVAILABLE,
! 0 IS RETURNED. AN INVALID FORMAT ALSO RETURNS -1.
!
! SIDE EFFECTS
!
! READS DATA FROM THE INPUT CHANNEL. MAY GET EOF.
! OBTAINS STORAGE FROM THE FREE LIST.
! WILL RETURN IT ON ERROR.
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'READ_LIBRARY_BLOCK');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
BLKPTR,
BYTE1,
CHKSUM,
COUNT,
OUTLEN,
RESULT : REF VECTOR;
RESULT = 0;
.BYTES_READ = 0;
OUTLEN = 0;
WHILE (.OUTLEN EQL 0) DO
BEGIN
OUTLEN = RD16 (.CHAN, CHKSUM);
.BYTES_READ = ..BYTES_READ + 2;
END;
IF ((.OUTLEN LSS 2) OR (.OUTLEN GTR 128))
THEN
BEGIN
IF (.OUTLEN NEQ -1) THEN ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
RESULT = -1;
END
ELSE
BEGIN
IF ((RESULT = GETSTG ((((.OUTLEN)/4) + 3))) LEQ 0)
THEN
BEGIN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0);
END
ELSE
BEGIN
RESULT [0] = (((.OUTLEN)/4) + 3); !AMOUNT TO FREE
RESULT [1] = .OUTLEN; !NUMBER OF BYTES
BLKPTR = CH$PTR (RESULT [2], -1, 8);
COUNT = 0;
WHILE (((COUNT = .COUNT + 1) LEQ .OUTLEN) AND (.BYTE1 GEQ 0)) DO
BEGIN
BYTE1 = INPUT (.CHAN);
.BYTES_READ = ..BYTES_READ + 1;
IF (.BYTE1 GEQ 0) THEN CH$A_WCHAR (.BYTE1, BLKPTR);
END;
IF (.BYTE1 LSS 0)
THEN
BEGIN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
FRESTG (.RESULT, .RESULT [0]);
RESULT = -1;
END;
END;
END;
!
! SKIP TO VIRTUAL WORD BOUNDARY
!
IF ((..BYTES_READ AND 1) EQL 1)
THEN
BEGIN
INPUT (.CHAN);
.BYTES_READ = ..BYTES_READ + 1;
END;
.RESULT
END; !OF RDLBBL
GLOBAL ROUTINE RDFILE (CHAN, FILE_PTR) : NOVALUE = !READ AN OBJECT FILE
!++
! FUNCTIONAL DESCRIPTION:
!
! READ AN OBJECT FILE AND PROCESS EACH RECORD.
!
!
! FORMAL PARAMETERS:
!
! CHAN - THE CHANNEL OVER WHICH TO READ DATA. IT MUST HAVE
! BEEN OPENED IN WORD MODE.
! FILE_PTR - POINTER TO FILE BLOCK FOR ERROR MESSAGES
! AND TO SERVE AS A ROOT BLOCK FOR THE DATA READ.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! READS DATA FROM THE INPUT CHANNEL. MAY GET EOF.
! OBTAINS STORAGE FROM THE FREE LIST.
! ALL SUCH STORAGE IS RETURNED BEFORE THIS ROUTINE EXITS.
! CALLS THE RECORD PROCESSING ROUTINES, SEVERAL OF WHICH
! OBTAIN STORAGE FROM THE FREE LIST.
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'READ_FILE');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
ASCVAL : VECTOR [CH$ALLOCATION (LEN_PSECT_NAME)],
BLKPTR : REF VECTOR,
BYTECTR,
BYTEPTR,
BYTES_READ,
CHAR,
COUNTER,
DOS_SW,
POINTER,
PREV_CHAR : VECTOR [3],
R50VAL,
RECORD_TYPE,
OBJ_PASS;
! /-SS is the default condition for files
ROOT [SS_FLAG] = 0;
! The /DOS switch is no longer used...
! DOS_SW = GET_SW (.FILE_PTR, UPLIT (%ASCIZ'DOS', 0));
!
! At first, try reading the object module as DOS format
! If that fails then read it in RSX format and continue on
!
BLKPTR = RDOBBL (.CHAN, .FILE_PTR, BYTES_READ);
DOS_SW = 1;
IF ((.BLKPTR EQL -1) AND (.BYTES_READ LEQ 2))
THEN
BEGIN
CLOSE (.CHAN);
OPEN (.CHAN, FILE_PTR [FILE_NAME], 2, 0, UPLIT (%ASCIZ'OBJ'));
BLKPTR = RDLBBL (.CHAN, .FILE_PTR, BYTES_READ);
DOS_SW = 0;
END;
!
! Begin in Pass 1 over the object module
!
OBJ_PASS = 1;
!
! The following is the main loop over the object module, it continues
! until we have read an apparent EOF for the second pass over the object
! module.
!
DO
BEGIN
IF (.BLKPTR GTR 0)
THEN
BEGIN
BYTEPTR = CH$PTR (BLKPTR [2], -1, 8);
BYTECTR = .BLKPTR [1];
IF (DEBUG GEQ 2)
THEN
BEGIN
PCRLF (1);
OUTNUM (1, .BYTECTR, 10, 0);
COUNTER = .BYTECTR;
POINTER = .BYTEPTR;
PREV_CHAR [0] = 0;
PREV_CHAR [1] = 0;
PREV_CHAR [2] = 0;
R50VAL = 0;
WHILE ((COUNTER = .COUNTER - 1) GEQ 0) DO
BEGIN
CHAR = CH$A_RCHAR (POINTER);
PCRLF (1);
OUTSTR (1, UPLIT (%ASCIZ' '));
OUTNUM (1, .CHAR, 8, 0);
OUTPUT (1, %O'11');
R50VAL<24, 8> = .PREV_CHAR [1];
R50VAL<16, 8> = .PREV_CHAR [0];
R50VAL<8, 8> = .CHAR;
R50VAL<0, 8> = .PREV_CHAR [2];
R50TOA (.R50VAL, ASCVAL [0]);
OUTSTR (1, ASCVAL [0]);
PREV_CHAR [0] = .PREV_CHAR [1];
PREV_CHAR [1] = .PREV_CHAR [2];
PREV_CHAR [2] = .CHAR;
END;
END; !DEBUG
RECORD_TYPE = GET_BYTE (BYTEPTR, BYTECTR, .FILE_PTR);
!
! We now process the object records based upon the particular OBJ_PASS.
! During pass 1 we read only GSD and END_GSD records. During pass 2 we
! read the other records...
!
CASE .OBJ_PASS FROM 1 TO 2 OF
SET
[1] :
CASE .RECORD_TYPE FROM 1 TO 6 OF
SET
[1] :
OBJ_GSD (BYTEPTR, BYTECTR, .FILE_PTR); !GSD
[2] :
OBJ_END_GSD (BYTEPTR, BYTECTR, .FILE_PTR); !END OF GSD
[INRANGE] :
;
[OUTRANGE] :
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
TES;
[2] :
CASE .RECORD_TYPE FROM 1 TO 6 OF
SET
[3] :
OBJ_TEXT (BYTEPTR, BYTECTR, .FILE_PTR); !TEXT
[4] :
OBJ_RLD (BYTEPTR, BYTECTR, .FILE_PTR); !RELOCATION DICTIONARY
[5] :
OBJ_ISD (BYTEPTR, BYTECTR, .FILE_PTR); !INTERNAL SYMBOL DIRECTORY
[6] :
OBJ_EOM (BYTEPTR, BYTECTR, .FILE_PTR); !END OF MODULE
[INRANGE] :
;
[OUTRANGE] :
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
TES;
TES;
FRESTG (.BLKPTR, .BLKPTR [0]);
BLKPTR = (IF (.DOS_SW NEQ 0) THEN RDOBBL ELSE RDLBBL) (.CHAN, .FILE_PTR, BYTES_READ);
IF (.BLKPTR LEQ 0)
THEN
BEGIN
OBJ_PASS = .OBJ_PASS + 1;
IF (.OBJ_PASS EQL 2)
THEN
BEGIN
CLOSE (.CHAN);
OPEN (.CHAN, FILE_PTR [FILE_NAME], 2, 0, UPLIT (%ASCIZ'OBJ'));
BLKPTR = (IF (.DOS_SW NEQ 0) THEN RDOBBL ELSE RDLBBL) (.CHAN, .FILE_PTR, BYTES_READ);
END;
END
END
END
UNTIL (.BLKPTR LEQ 0);
END; !OF READ_FILE
GLOBAL ROUTINE RDLIBR (CHAN, FILE_PTR) : NOVALUE = !READ A LIBRARY FILE
!++
! FUNCTIONAL DESCRIPTION:
!
! READ A LIBRARY FILE. ACCEPT ONLY THOSE MODULES WHICH
! DEFINE SYMBOLS CURRENTLY UNDEFINED.
!
!
! FORMAL PARAMETERS:
!
! CHAN - THE CHANNEL OVER WHICH TO READ DATA. IT MUST HAVE
! BEEN OPENED IN WORD MODE.
! FILE_PTR - POINTER TO FILE BLOCK FOR ERROR MESSAGES
! AND TO SERVE AS A ROOT BLOCK FOR THE DATA READ.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! READS DATA FROM THE INPUT CHANNEL. MAY GET EOF.
! OBTAINS STORAGE FROM THE FREE LIST.
! ALL SUCH STORAGE IS RETURNED BEFORE THIS ROUTINE EXITS.
! CALLS THE RECORD PROCESSING ROUTINES, SEVERAL OF WHICH
! OBTAIN STORAGE FROM THE FREE LIST.
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'READ_LIBRARY');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
ASCVAL : VECTOR [CH$ALLOCATION (LEN_GBL_NAME)],
ATTRIBUTES,
BLKPTR : REF VECTOR,
BYTECTR,
BYTEPTR,
BYTES_READ,
CHAR,
CHKSUM,
COUNTER,
EPT_BLOCK,
EPT_BYTE,
EPT_NUMBER,
EPT_POSITION,
EPT_SIZE,
FILE_POSITION,
FLAGS,
GLOBL_PTR : REF GLOBL_BLOCK,
GLOBL_PTR1 : REF GLOBL_BLOCK,
MOD_SIZE,
MODU_DONE,
POINTER,
PREV_CHAR : VECTOR [3],
R50VAL,
RECORD_TYPE,
SCAN_DONE,
SEARCH_DONE;
! /-SS is the Default for reading libraries
ROOT [SS_FLAG] = 0;
!
! READ RELAVENT INFORMATION FROM THE LIBRARY HEADER.
!
! FIRST SKIP VERSION AND DATES
!
INCR COUNTER FROM 1 TO 9 DO
RD16 (.CHAN, CHKSUM);
FILE_POSITION = 18;
!
! READ EPT SIZE, STARTING BLOCK AND NUMBER
!
EPT_SIZE = RD16 (.CHAN, CHKSUM);
FILE_POSITION = .FILE_POSITION + 2;
EPT_SIZE = .EPT_SIZE<0, 8>;
EPT_BLOCK = RD16 (.CHAN, CHKSUM);
FILE_POSITION = .FILE_POSITION + 2;
EPT_NUMBER = RD16 (.CHAN, CHKSUM);
FILE_POSITION = .FILE_POSITION + 2;
!
! NOW SKIP TO THE BEGINNING OF THE ENTRY POINT TABLE
!
INCR COUNTER FROM (.FILE_POSITION/2) TO ((.EPT_BLOCK - 1)*256) - 1 DO
RD16 (.CHAN, CHKSUM);
FILE_POSITION = (.EPT_BLOCK - 1)*512;
!
! SCAN THE ENTRY POINT TABLE, NOTING MODULES THAT NEED TO BE READ.
!
INCR COUNTER FROM 1 TO .EPT_NUMBER DO
BEGIN
R50VAL = 0;
R50VAL<16, 16> = RD16 (.CHAN, CHKSUM);
R50VAL<0, 16> = RD16 (.CHAN, CHKSUM);
R50TOA (.R50VAL, ASCVAL [0]);
EPT_BLOCK = RD16 (.CHAN, CHKSUM);
EPT_BYTE = RD16 (.CHAN, CHKSUM);
INCR COUNTER1 FROM 5 TO (.EPT_SIZE/2) DO
RD16 (.CHAN, CHKSUM);
FILE_POSITION = .FILE_POSITION + .EPT_SIZE;
SEARCH_DONE = 0;
GLOBL_PTR = .ROOT [ROOT_GLOBALS];
IF (.GLOBL_PTR NEQ 0)
THEN
WHILE (.SEARCH_DONE EQL 0) DO
IF (CH$GTR (LEN_GBL_NAME, CH$PTR (ASCVAL [0]), LEN_GBL_NAME, CH$PTR (GLOBL_PTR [GBL_NAME])))
THEN
BEGIN
GLOBL_PTR = .GLOBL_PTR [GBL_NEXT];
IF (.GLOBL_PTR EQL 0) THEN SEARCH_DONE = 2;
END
ELSE
SEARCH_DONE = 1;
IF (.SEARCH_DONE EQL 1)
THEN
BEGIN
IF (CH$EQL (LEN_GBL_NAME, CH$PTR (ASCVAL [0]), LEN_GBL_NAME, CH$PTR (GLOBL_PTR [GBL_NAME])))
THEN
SEARCH_DONE = 3
END;
IF (.SEARCH_DONE EQL 3)
THEN
BEGIN
FLAGS = .GLOBL_PTR [GBL_FLAGS];
IF (.FLAGS<GBL_FLG_DEF, 1> EQL 0)
THEN
BEGIN !THIS IS AN UNDEFINED GLOBAL
IF (.GLOBL_PTR [GBL_IN_EPT] EQL 0)
THEN
BEGIN !NOT ALREADY SEEN
GLOBL_PTR [GBL_IN_EPT] = 1;
GLOBL_PTR [GBL_EPT_POS] = ((.EPT_BLOCK - 1)*512) + (.EPT_BYTE + 2);
END;
END;
END;
END; !OF SCANNING EPT
!
! NOW FIND THE EARLIEST UNSATISFIED REQUEST, SKIP TO THERE IN THE
! LIBRARY FILE, AND PROCESS THAT MODULE.
!
SCAN_DONE = 0;
WHILE (.SCAN_DONE EQL 0) DO
BEGIN
SEARCH_DONE = 0;
GLOBL_PTR = .ROOT [ROOT_GLOBALS];
EPT_POSITION = 0;
WHILE (.SEARCH_DONE EQL 0) DO
BEGIN
IF (.GLOBL_PTR EQL 0)
THEN
SEARCH_DONE = 1
ELSE
BEGIN
FLAGS = .GLOBL_PTR [GBL_FLAGS];
IF ((.GLOBL_PTR [GBL_IN_EPT] NEQ 0) AND .FLAGS<GBL_FLG_DEF, 1> EQL 0)
THEN
BEGIN
IF ((.GLOBL_PTR [GBL_EPT_POS] LSS .EPT_POSITION) OR (.EPT_POSITION EQL 0))
THEN
BEGIN
GLOBL_PTR1 = .GLOBL_PTR;
EPT_POSITION = .GLOBL_PTR [GBL_EPT_POS];
END;
END;
GLOBL_PTR = .GLOBL_PTR [GBL_NEXT];
END;
END;
IF (.EPT_POSITION EQL 0)
THEN
SCAN_DONE = 1
ELSE
BEGIN !WE HAVE A MODULE TO LOAD
IF (.EPT_POSITION LSS .FILE_POSITION)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN
INCR COUNTER FROM (.FILE_POSITION/2) TO (.EPT_POSITION/2) - 1 DO
RD16 (.CHAN, CHKSUM);
FILE_POSITION = .EPT_POSITION;
!
! WE ARE NOW AT THE HEADER FOR THE MODULE. GET ITS LENGTH BUT
! OTHERWISE SKIP OVER IT.
!
ATTRIBUTES = RD16 (.CHAN, CHKSUM);
ROOT [SS_FLAG] = .ATTRIBUTES<8, 1>; !Set SS based upon Mod Head
MOD_SIZE = 0;
MOD_SIZE<16, 16> = RD16 (.CHAN, CHKSUM);
MOD_SIZE<0, 16> = RD16 (.CHAN, CHKSUM);
INCR COUNTER FROM 1 TO 5 DO
RD16 (.CHAN, CHKSUM);
FILE_POSITION = .FILE_POSITION + 16;
MODU_DONE = 0;
WHILE (.MODU_DONE EQL 0) DO
BEGIN
BLKPTR = RDLBBL (.CHAN, .FILE_PTR, BYTES_READ);
FILE_POSITION = .FILE_POSITION + .BYTES_READ;
MOD_SIZE = .MOD_SIZE - .BYTES_READ;
IF (.BLKPTR GTR 0)
THEN
BEGIN
BYTEPTR = CH$PTR (BLKPTR [2], -1, 8);
BYTECTR = .BLKPTR [1];
IF (DEBUG GEQ 2)
THEN
BEGIN
PCRLF (1);
OUTNUM (1, .BYTECTR, 10, 0);
COUNTER = .BYTECTR;
POINTER = .BYTEPTR;
PREV_CHAR [0] = 0;
PREV_CHAR [1] = 0;
PREV_CHAR [2] = 0;
R50VAL = 0;
WHILE ((COUNTER = .COUNTER - 1) GEQ 0) DO
BEGIN
CHAR = CH$A_RCHAR (POINTER);
PCRLF (1);
OUTSTR (1, UPLIT (%ASCIZ' '));
OUTNUM (1, .CHAR, 8, 0);
OUTPUT (1, %O'11');
R50VAL<24, 8> = .PREV_CHAR [1];
R50VAL<16, 8> = .PREV_CHAR [0];
R50VAL<8, 8> = .CHAR;
R50VAL<0, 8> = .PREV_CHAR [2];
R50TOA (.R50VAL, ASCVAL [0]);
OUTSTR (1, ASCVAL [0]);
PREV_CHAR [0] = .PREV_CHAR [1];
PREV_CHAR [1] = .PREV_CHAR [2];
PREV_CHAR [2] = .CHAR;
END;
END; !DEBUG
RECORD_TYPE = GET_BYTE (BYTEPTR, BYTECTR, .FILE_PTR);
CASE .RECORD_TYPE FROM 1 TO 6 OF
SET
[1] :
OBJ_GSD (BYTEPTR, BYTECTR, .FILE_PTR); !GSD
[2] :
OBJ_END_GSD (BYTEPTR, BYTECTR, .FILE_PTR); !END OF GSD
[3] :
OBJ_TEXT (BYTEPTR, BYTECTR, .FILE_PTR); !TEXT
[4] :
OBJ_RLD (BYTEPTR, BYTECTR, .FILE_PTR); !RELOCATION DICTIONARY
[5] :
OBJ_ISD (BYTEPTR, BYTECTR, .FILE_PTR); !INTERNAL SYMBOL DIRECTORY
[6] :
BEGIN
OBJ_EOM (BYTEPTR, BYTECTR, .FILE_PTR); !END OF MODULE
MODU_DONE = 1;
END;
[OUTRANGE] :
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
TES;
FRESTG (.BLKPTR, .BLKPTR [0]);
END
END; !OF WHILE (.MODU_DONE EQL 0)
END; !OF SEARCH THROUGH UNDEFINED GLOBALS
END;
END;
END; !OF READ_LIBRARY
ROUTINE GET_BYTE (BYTEPTR, BYTECTR, FILE_PTR) = !GET BYTE
!++
! FUNCTIONAL DESCRIPTION:
!
! FETCH A BYTE FROM THE OBJECT RECORD. MAINTAIN
! THE COUNTER AND GIVE AN ERROR MESSAGE IF IT RUNS OUT.
!
! FORMAL PARAMETERS:
!
! BYTEPTR - POINTER TO THE BYTE POINTER
! BYTECTR - POINTER TO THE COUNTER CELL
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE FILE
! BEING READ, FOR ERROR MESSAGES.
!
! IMPLICIT INPUTS:
!
! THE OBJECT RECORD POINTED TO
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! THE VALUE OF THE BYTE, OR -1 IF WE RAN OFF THE END.
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GET_BYTE');
MAP
FILE_PTR : REF FILE_BLOCK;
IF (..BYTECTR GTR 0)
THEN
BEGIN
.BYTECTR = ..BYTECTR - 1;
CH$A_RCHAR (.BYTEPTR)
END
ELSE
BEGIN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
-1
END
END; !OF GET_BYTE
ROUTINE GET_WORD (BYTEPTR, BYTECTR, FILE_PTR) = !GET WORD
!++
! FUNCTIONAL DESCRIPTION:
!
! FETCH A WORD FROM THE OBJECT RECORD. MAINTAIN
! THE COUNTER AND GIVE AN ERROR MESSAGE IF IT RUNS OUT.
!
! FORMAL PARAMETERS:
!
! BYTEPTR - POINTER TO THE BYTE POINTER
! BYTECTR - POINTER TO THE COUNTER CELL
! FILE_PTR - POINTER TO FILE BLOCK FOR ERROR MESSAGES
!
! IMPLICIT INPUTS:
!
! THE OBJECT RECORD POINTED TO
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! THE VALUE OF THE WORD, OR -1 IF WE RAN OFF THE END.
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GET_WORD');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
RESULT;
IF (..BYTECTR GTR 1)
THEN
BEGIN
.BYTECTR = ..BYTECTR - 2;
RESULT = CH$A_RCHAR (.BYTEPTR);
RESULT<8, 8> = CH$A_RCHAR (.BYTEPTR);
.RESULT
END
ELSE
BEGIN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
-1
END
END; !OF GET_WORD
ROUTINE OBJ_GSD (BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !PROCESS GSD RECORD
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS A GLOBAL SYMBOL DIRECTORY ENTRY IN THE OBJECT
! FILE. THIS IS DONE BY FETCHING THE PARAMETERS AND THEN
! TO A SUBROUTINE TO HANDLE THE ENTRY TYPE.
!
! FORMAL PARAMETERS:
!
! BYTEPTR - POINTER TO THE BYTE POINTER
! BYTECTR - POINTER TO THE COUNTER CELL
! FILE_PTR - POINTER TO THE FILE BLOCK OF THE OBJECT
! FILE BEING READ. THIS IS FOR ERROR MESSAGES AND TO
! POINT TO THE DATA READ.
!
! IMPLICIT INPUTS:
!
! THE OBJECT RECORD POINTED TO
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! IN MANY CASES, THE HANDLERS FOR THE ENTRY TYPES WILL
! OBTAIN SPACE FROM THE FREE STORAGE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'OBJ_GSD');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
MODU_PTR : REF MODU_BLOCK,
CHAR,
R50VAL,
ASCVAL : VECTOR [CH$ALLOCATION (LEN_PSECT_NAME)],
FLAGS,
ETYPE,
VALUE;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'GSD RECORD, LENGTH = '));
OUTNUM (1, ..BYTECTR, 10, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) NEQ 0)
THEN
BEGIN
IF (.MODU_PTR [MODU_FLAG_EGSD] NEQ 0) THEN ERRMSG (0, 10, ROUTINE_NAME, 0, 0, 0, 0);
END;
CHAR = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR); !UNUSED BYTE
DO
BEGIN
R50VAL = 0;
R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50TOA (.R50VAL, ASCVAL [0]);
FLAGS = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR);
ETYPE = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR);
VALUE = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
CASE .ETYPE FROM 0 TO 7 OF
SET
[0] :
GSD_MNAME (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);
[1] :
GSD_CNAME (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);
[2] :
GSD_ISN (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);
[3] :
GSD_TRA (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);
[4] :
GSD_GSN (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);
[5] :
GSD_PSN (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);
[6] :
GSD_IDENT (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);
[7] :
GSD_MAP (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);
[OUTRANGE] :
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
TES;
END
UNTIL (..BYTECTR EQL 0);
END; !OF OBJ_GSD
ROUTINE OBJ_END_GSD (BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !PROCESS END GSD RECORD
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE END GSD RECORD.
!
! FORMAL PARAMETERS:
!
! BYTEPTR - POINTER TO THE BYTE POINTER
! BYTECTR - POINTER TO THE COUNTER CELL
! FILE_PTR - POINTER TO FILE BLOCK
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! SETS A FLAG WHICH FORBIDS ANY MORE GSD RECORDS IN
! THIS MODULE.
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'OBJ_END_GSD');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
MODU_PTR : REF MODU_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'END GSD RECORD, LENGTH = '));
OUTNUM (1, ..BYTECTR, 10, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN
IF (.MODU_PTR [MODU_FLAG_EGSD] NEQ 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN
MODU_PTR [MODU_FLAG_EGSD] = 1;
END;
END;
END; !OF OBJ_END_GSD
ROUTINE OBJ_TEXT (BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !PROCESS TEXT RECORD
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS AN OBJECT TEXT RECORD
!
! FORMAL PARAMETERS:
!
! BYTEPTR - POINTER TO THE BYTE POINTER
! BYTECTR - POINTER TO THE COUNTER CELL
! FILE_PTR - POINTER TO FILE BLOCK
!
! IMPLICIT INPUTS:
!
! THE OBJECT RECORD POINTED TO
!
! IMPLICIT OUTPUTS:
!
! PUTS THE TEXT IN THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS SPACE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'OBJ_TEXT');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
CHAR,
LOAD_ADDRESS,
MODU_PTR : REF MODU_BLOCK,
NEXT_TEXTD_PTR : REF TEXTD_BLOCK,
NEXT_TEXTH_PTR : REF TEXTH_BLOCK,
PSECT_PTR : REF PSECT_BLOCK,
TEXTD_ADDR,
TEXTD_PTR : REF TEXTD_BLOCK,
TEXTH_PTR : REF TEXTH_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'TEXT RECORD, LENGTH = '));
OUTNUM (1, ..BYTECTR, 10, 0);
END; !DEBUG
CHAR = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR); !UNUSED BYTE
LOAD_ADDRESS = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
IF (DEBUG GEQ 1)
THEN
BEGIN
OUTSTR (1, UPLIT (%ASCIZ', LOAD ADDRESS = '));
OUTNUM (1, .LOAD_ADDRESS, 8, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN !WE HAVE A CURRENT MODULE
IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN !WE HAVE A CURRENT PSECT
PSECT_PTR [PSECT_LLA] = .LOAD_ADDRESS + .PSECT_PTR [PSECT_OFFSET];
!
! FIND THE LAST TEXT RECORD FOR THIS PSECT
!
TEXTH_PTR = 0;
NEXT_TEXTH_PTR = .PSECT_PTR [PSECT_TEXT];
WHILE (.NEXT_TEXTH_PTR NEQ 0) DO
BEGIN
TEXTH_PTR = .NEXT_TEXTH_PTR;
NEXT_TEXTH_PTR = .TEXTH_PTR [TEXTH_NEXT];
END;
IF ((NEXT_TEXTH_PTR = GETBLK (TEXTH_TYP, TEXTH_LEN)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0,
0, 0, 0)
ELSE
BEGIN !WE HAVE STORAGE FOR TEXT HEADER
NEXT_TEXTH_PTR [TEXTH_PREV] = .TEXTH_PTR;
IF (.TEXTH_PTR NEQ 0)
THEN
TEXTH_PTR [TEXTH_NEXT] = .NEXT_TEXTH_PTR
ELSE
PSECT_PTR [PSECT_TEXT] = .NEXT_TEXTH_PTR;
TEXTH_PTR = .NEXT_TEXTH_PTR;
TEXTH_PTR [TEXTH_PSECT] = .PSECT_PTR;
TEXTH_PTR [TEXTH_OFFSET] = .LOAD_ADDRESS + .PSECT_PTR [PSECT_OFFSET];
TEXTH_PTR [TEXTH_MODU] = .FILE_PTR [FILE_MODU];
IF ((TEXTD_PTR = GETBLK (TEXTD_TYP, TEXTD_LEN)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0,
0, 0)
ELSE
BEGIN !WE HAVE STORAGE FOR THE FIRST TEXT DATA BLOCK
TEXTH_PTR [TEXTH_DATA] = .TEXTD_PTR;
TEXTD_PTR [TEXTD_TH] = .TEXTH_PTR;
TEXTD_ADDR = CH$PTR (TEXTD_PTR [TEXTD_DATA], -1, 8);
WHILE (..BYTECTR GTR 0) DO
BEGIN
CHAR = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR);
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'TEXT BYTE = '));
OUTNUM (1, .CHAR, 8, 0);
END; !DEBUG
IF (.TEXTD_PTR [TEXTD_NUM_BYTES] EQL MAX_TEXT_DATA)
THEN
BEGIN
IF ((NEXT_TEXTD_PTR = GETBLK (TEXTD_TYP, TEXTD_LEN)) EQL 0)
THEN
ERRMSG (0, 1,
ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
NEXT_TEXTD_PTR [TEXTD_PREV] = .TEXTD_PTR;
TEXTD_PTR [TEXTD_NEXT] = .NEXT_TEXTD_PTR;
TEXTD_PTR = .NEXT_TEXTD_PTR;
TEXTD_PTR [TEXTD_TH] = .TEXTH_PTR;
TEXTD_ADDR = CH$PTR (TEXTD_PTR [TEXTD_DATA], -1, 8);
END;
END;
CH$A_WCHAR (.CHAR, TEXTD_ADDR);
TEXTD_PTR [TEXTD_NUM_BYTES] = .TEXTD_PTR [TEXTD_NUM_BYTES] + 1;
END;
END; !OF PER-CHARACTER ITERATION
END;
END;
END;
END; !OF OBJ_TEXT
ROUTINE OBJ_RLD (BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !PROCESS RLD RECORD
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE RELOCATION DICTIONARY RECORD
! BY FETCHING THE COMMAND, BYTE FLAG AND DISPLACEMENT,
! THEN DISPATCHING.
!
! FORMAL PARAMETERS:
!
! BYTEPTR - POINTER TO THE BYTE POINTER
! BYTECTR - POINTER TO THE COUNTER CELL
! FILE_PTR - POINTER TO OBJECT FILE BLOCK, FOR ERROR
! MESSAGES AND TO HOLD DATA READ.
!
! IMPLICIT INPUTS:
!
! THE OBJECT RECORD POINTED TO
!
! IMPLICIT OUTPUTS:
!
! MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! GETS STORAGE FROM THE FREE LIST
!
!--
BEGIN
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
CHAR,
CMD,
MODIF,
DISP;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'RELOCATION DIRECTORY RECORD, LENGTH = '));
OUTNUM (1, ..BYTECTR, 10, 0);
END; !DEBUG
CHAR = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR); !UNUSED BYTE
DO
BEGIN
CMD = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR);
IF (.CMD NEQ 0)
THEN
BEGIN
MODIF = .CMD<7, 1>;
CMD = .CMD<0, 6>;
DISP = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR);
CASE .CMD FROM %O'1' TO %O'20' OF
SET
[%O'1'] :
R_IR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);
[%O'2'] :
R_GR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);
[%O'3'] :
R_IDR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);
[%O'4'] :
R_GDR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);
[%O'5'] :
R_GAR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);
[%O'6'] :
R_GADR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);
[%O'7'] :
R_LCD (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);
[%O'10'] :
R_LCM (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);
[%O'11'] :
R_PL (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);
[%O'12'] :
R_PR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);
[%O'13'] :
R_ERR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);
[%O'14'] :
R_PDR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);
[%O'15'] :
R_PAR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);
[%O'16'] :
R_PADR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);
[%O'17'] :
R_CR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);
[%O'20'] :
R_LR (.MODIF, .DISP, .BYTEPTR, .BYTECTR, .FILE_PTR);
[OUTRANGE] :
ERRMSG (0, 10, UPLIT (%ASCIZ'OBJ_RLD'), FILE_PTR [FILE_NAME], 0, 0, 0);
TES;
END;
END
UNTIL (..BYTECTR EQL 0);
END; !OF OBJ_RLD
ROUTINE OBJ_ISD (BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !PROCESS ISD RECORD
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS INTERNAL SYMBOL DIRECTORY RECORD.
!
! FORMAL PARAMETERS:
!
! BYTEPTR - POINTER TO THE BYTE POINTER
! BYTECTR - POINTER TO THE COUNTER CELL
! FILE_PTR - POINTER TO OBJECT FILE BLOCK
!
! IMPLICIT INPUTS:
!
! THE OBJECT RECORD POINTED TO
!
! IMPLICIT OUTPUTS:
!
! ADDS THE INTERNAL SYMBOLS TO THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'OBJ_ISD');
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'INTERNAL SYMBOL DIRECTORY RECORD, LENGTH = '));
OUTNUM (1, ..BYTECTR, 10, 0);
END; !DEBUG
ERRMSG (0, 12, ROUTINE_NAME, 0, 0, 0, 0);
END; !OF OBJ_ISD
ROUTINE OBJ_EOM (BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !PROCESS END OF MODULE RECORD
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE END MODULE RECORD.
!
! FORMAL PARAMETERS:
!
! BYTEPTR - POINTER TO THE BYTE POINTER
! BYTECTR - POINTER TO THE COUNTER CELL
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! THE OBJECT RECORD POINTED TO
!
! IMPLICIT OUTPUTS:
!
! SETS A FLAG TO INDICATE THAT WE ARE BETWEEN MODULES.
! AN EOF IS OK IN THIS CONTEXT.
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'OBJ_EOM');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
MODU_PTR : REF MODU_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'END OF MODULE RECORD, LENGTH = '));
OUTNUM (1, ..BYTECTR, 10, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN
IF (.MODU_PTR [MODU_FLAG_EGSD] EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN
FILE_PTR [FILE_MODU] = 0;
END;
END;
END; !OF OBJ_EOM
ROUTINE GSD_MNAME (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = !PROCESS MODULE NAME ENTRY
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE MODULE NAME ENTRY OF THE GSD RECORD
!
! FORMAL PARAMETERS:
!
! ASCPTR - POINTER TO NAME, IN ASCII
! FLAGS - THE FLAGS BYTE
! VALUE - THE VALUE WORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! ADDS THE MODULE NAME TO THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS SPACE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GSD_MNAME');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
MODU_PTR : REF MODU_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'MODULE NAME, NAME = '));
OUTSTR (1, .ASCPTR);
OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
OUTNUM (1, .FLAGS, 8, 0);
OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
OUTNUM (1, .VALUE, 8, 0);
END; !DEBUG
!
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) NEQ 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN !THERE IS NOT ALREADY A MODULE BEING PROCESSED
IF ((MODU_PTR = GETBLK (MODU_TYP, MODU_LEN)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN !WE HAVE STORAGE FOR THE MODULE NAME
IF ((FILE_PTR [FILE_DOWN] = BLD_CHAIN (.FILE_PTR, .FILE_PTR [FILE_DOWN], .MODU_PTR)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN !WE HAVE STORAGE FOR THE CHAIN BLOCK
CH$MOVE (LEN_MODU_NAME, CH$PTR (.ASCPTR), CH$PTR (MODU_PTR [MODU_NAME]));
FILE_PTR [FILE_MODU] = .MODU_PTR;
MODU_PTR [MODU_OBJ_FILE] = .FILE_PTR;
MODU_PTR [MODU_SECTOR] = 0;
IF ((ROOT [ROOT_MODULES] = BLD_CHAIN (.ROOT, .ROOT [ROOT_MODULES], .MODU_PTR)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0);
END;
END;
END;
END; !OF GSD_MNAME
ROUTINE GSD_CNAME (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = !PROCESS CSECT NAME ENTRY
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE CSECT NAME ENTRY OF THE GSD RECORD
! THIS IS IMPLEMENTED BY CONVERTING THE CSECT INTO
! AN APPROPRIATE PSECT.
!
! FORMAL PARAMETERS:
!
! ASCPTR - POINTER TO NAME, IN ASCII
! FLAGS - THE FLAGS BYTE
! VALUE - THE VALUE WORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! CALLS GSD_PSN
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GSD_CNAME');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
MODU_PTR : REF MODU_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'CSECT NAME, NAME = '));
OUTSTR (1, .ASCPTR);
OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
OUTNUM (1, .FLAGS, 8, 0);
OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
OUTNUM (1, .VALUE, 8, 0);
END; !DEBUG
!
! TURN THE CSECT NAME ENTRY INTO A PSECT BY CALLING GSD_PSN WITH
! THE APPROPRIATE ARGUMENTS.
!
IF (CH$EQL (LEN_PSECT_NAME, CH$PTR (.ASCPTR), LEN_PSECT_NAME,
CH$PTR (UPLIT (%ASCIZ' '
))))
THEN
BEGIN !BLANK CSECT, MAKE LOCAL PSECT
GSD_PSN (.ASCPTR, (1^PSECT_FLG_REL), .VALUE, .FILE_PTR);
END
ELSE
IF (CH$EQL (LEN_PSECT_NAME, CH$PTR (.ASCPTR), LEN_PSECT_NAME,
CH$PTR (UPLIT (%ASCIZ'. ABS.'
))))
THEN
BEGIN !ASECT, MAKE AN ABSOLUTE PSECT
GSD_PSN (UPLIT (%ASCIZ'. ABS.'), ((1^PSECT_FLG_GBL) + (1^PSECT_FLG_OVR)), .VALUE, .FILE_PTR);
END
ELSE
BEGIN !NAMED CSECT, MAKE A GLOBAL PSECT
GSD_PSN (.ASCPTR, ((1^PSECT_FLG_GBL) + (1^PSECT_FLG_REL) + (1^PSECT_FLG_OVR)), .VALUE, .FILE_PTR);
END;
END; !OF GSD_CNAME
ROUTINE GSD_ISN (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = !PROCESS INTERNAL SYMBOL NAME ENTRY
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE INTERNAL SYMBOL NAME ENTRY OF THE GSD RECORD.
! THIS IS NOT IMPLEMENTED SINCE MACY11 DOES NOT PRODUCE
! THESE RECORDS.
!
! FORMAL PARAMETERS:
!
! ASCPTR - POINTER TO NAME, IN ASCII
! FLAGS - THE FLAGS BYTE
! VALUE - THE VALUE WORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! PRINTS AN ERROR MESSAGE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GSD_ISN');
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'INTERNAL SYMBOL NAME, NAME = '));
OUTSTR (1, .ASCPTR);
OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
OUTNUM (1, .FLAGS, 8, 0);
OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
OUTNUM (1, .VALUE, 8, 0);
END; !DEBUG
ERRMSG (0, 12, ROUTINE_NAME, 0, 0, 0, 0);
END; !OF GSD_ISN
ROUTINE GSD_TRA (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = !PROCESS TRANSFER ADDRESS ENTRY
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE TRANSFER ADDRESS ENTRY OF THE GSD RECORD
!
! FORMAL PARAMETERS:
!
! ASCPTR - POINTER TO NAME, IN ASCII
! FLAGS - THE FLAGS BYTE
! VALUE - THE VALUE WORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! STORES THE TRANSFER ADDRESS IN THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GSD_TRA');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
MODU_PTR : REF MODU_BLOCK,
PSECT_PTR : REF PSECT_BLOCK,
PSECT_INFO : VECTOR [3];
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'TRANSFER ADDRESS, NAME = '));
OUTSTR (1, .ASCPTR);
OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
OUTNUM (1, .FLAGS, 8, 0);
OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
OUTNUM (1, .VALUE, 8, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
PSECT_INFO [0] = .ASCPTR;
PSECT_INFO [1] = 0;
PSECT_INFO [2] = 0;
PSECT_PTR = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_PSECT, PSECT_INFO);
IF (.PSECT_PTR EQL 0)
THEN
MODU_PTR [MODU_XFR_OFFSET] = .VALUE + %O'200000'
ELSE
BEGIN
MODU_PTR [MODU_XFR_PSECT] = .PSECT_PTR;
MODU_PTR [MODU_XFR_OFFSET] = .VALUE + .PSECT_PTR [PSECT_OFFSET] + %O'200000';
END;
END;
END; !OF GSD_TRA
ROUTINE SEL_GLOBAL (GLOBAL_PTR, GLOBAL_INFO) = !SELECT PROPER GLOBAL
!++
! FUNCTIONAL DESCRIPTION:
!
! SELECT THE GLOBAL DESCRIBED FROM THE LIST OF ALL GLOBALS.
! USED IN A CALL TO FND_CHAIN.
!
! FORMAL PARAMETERS:
!
! GLOBAL_PTR - POINTER TO GLOBAL TO TEST FOR SUITABILITY
! GLOBAL_INFO - INFORMATION ABOUT THE GLOBAL WE ARE LOOKING FOR
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! POINTER TO THE GLOBAL, OR 0.
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
MAP
GLOBAL_PTR : REF GLOBL_BLOCK,
GLOBAL_INFO : REF VECTOR [3];
!
! THE GLOBAL_INFO VECTOR CONTAINS:
!
! 0: POINTER TO THE GLOBAL NAME, IN ASCII
! 1: THE GLOBAL FLAGS
! 2: THE "VALUE" WORD FROM THE GLOBAL
!
IF (CH$NEQ (LEN_GBL_NAME, CH$PTR (.GLOBAL_INFO [0]), LEN_GBL_NAME, CH$PTR (GLOBAL_PTR [GBL_NAME])))
THEN
0
ELSE
.GLOBAL_PTR
END; !OF SEL_GLOBAL
ROUTINE GSD_GSN (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = !PROCESS GLOBAL SYMBOL NAME
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE GLOBAL SYMBOL NAME ENTRY OF THE GSD RECORD
!
! FORMAL PARAMETERS:
!
! ASCPTR - POINTER TO NAME, IN ASCII
! FLAGS - THE FLAGS BYTE
! VALUE - THE VALUE WORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! ADDS THE GLOBAL SYMBOL TO THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS SPACE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GSD_GSN');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
GLOBL_PTR : REF GLOBL_BLOCK,
GLOBL_PTR1 : REF GLOBL_BLOCK,
GLOBL_PTR2 : REF GLOBL_BLOCK,
GLOBAL_INFO : VECTOR [3],
MODU_PTR : REF MODU_BLOCK,
MODU_PTR1 : REF MODU_BLOCK,
PSECT_PTR : REF PSECT_BLOCK,
SEARCH_DONE,
TEMP_FLAGS;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'GLOBAL SYMBOL NAME, NAME = '));
OUTSTR (1, .ASCPTR);
OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
OUTNUM (1, .FLAGS, 8, 0);
OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
OUTNUM (1, .VALUE, 8, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN !WE ARE PROCESSING A MODULE
PSECT_PTR = .MODU_PTR [MODU_PSECT];
GLOBAL_INFO [0] = .ASCPTR;
GLOBAL_INFO [1] = .FLAGS;
GLOBAL_INFO [2] = .VALUE;
SEARCH_DONE = 0;
GLOBL_PTR1 = .ROOT [ROOT_GLOBALS];
GLOBL_PTR2 = 0;
IF (.GLOBL_PTR1 NEQ 0)
THEN
WHILE (.SEARCH_DONE EQL 0) DO
IF (CH$GTR (LEN_GBL_NAME, CH$PTR (.ASCPTR), LEN_GBL_NAME, CH$PTR (GLOBL_PTR1 [GBL_NAME])))
THEN
BEGIN
GLOBL_PTR2 = .GLOBL_PTR1;
GLOBL_PTR1 = .GLOBL_PTR1 [GBL_NEXT];
IF (.GLOBL_PTR1 EQL 0) THEN SEARCH_DONE = 2;
END
ELSE
SEARCH_DONE = 1;
IF (.SEARCH_DONE EQL 1)
THEN
BEGIN
IF (CH$EQL (LEN_GBL_NAME, CH$PTR (.ASCPTR), LEN_GBL_NAME, CH$PTR (GLOBL_PTR1 [GBL_NAME])))
THEN
SEARCH_DONE = 3
END;
IF (.SEARCH_DONE NEQ 3)
THEN
BEGIN !THIS IS THE FIRST REFERENCE TO THIS GLOBAL
IF (((GET_SW (.FILE_PTR, UPLIT (%ASCII'SS', 0)) EQL 0) AND (.ROOT [SS_FLAG] EQL 0)) OR (.FLAGS<
GBL_FLG_DEF, 1> EQL 0))
THEN
BEGIN !NOT 'SS' SWITCH OR IT IS A REFERENCE
IF ((GLOBL_PTR = GETBLK (GLOBL_TYP, GLOBL_LEN)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0,
0, 0)
ELSE
BEGIN !WE HAVE STORAGE FOR THE GLOBAL BLOCK
CH$MOVE (LEN_GBL_NAME, CH$PTR (.ASCPTR), CH$PTR (GLOBL_PTR [GBL_NAME]));
!
! LINK THIS SYMBOL INTO THE LIST
!
GLOBL_PTR [GBL_NEXT] = .GLOBL_PTR1;
GLOBL_PTR [GBL_PREV] = .GLOBL_PTR2;
IF (.GLOBL_PTR1 NEQ 0) THEN GLOBL_PTR1 [GBL_PREV] = .GLOBL_PTR;
IF (.GLOBL_PTR2 NEQ 0)
THEN
GLOBL_PTR2 [GBL_NEXT] = .GLOBL_PTR
ELSE
ROOT [ROOT_GLOBALS] = .GLOBL_PTR;
END;
END
ELSE
GLOBL_PTR = 0
END !OF SEARCH_DONE NEQ 3
ELSE
BEGIN !PREVIOUS REFERENCE TO THIS GLOBAL
TEMP_FLAGS = .GLOBL_PTR1 [GBL_FLAGS];
GLOBL_PTR = (IF (((GET_SW (.FILE_PTR, UPLIT (%ASCIZ'SS', 0)) NEQ 0) OR .ROOT [SS_FLAG]) AND (
.TEMP_FLAGS<GBL_FLG_DEF, 1> NEQ 0) AND (.FLAGS<GBL_FLG_DEF, 1> NEQ 0)) THEN 0 ELSE .GLOBL_PTR1
);
END;
IF (.GLOBL_PTR NEQ 0)
THEN
BEGIN !WE WISH TO PROCESS THIS GLOBAL
!
! THE GLOBAL BLOCK IS LINKED TO THE ROOT. NOW BE SURE IT IS
! CHAINED FROM THE CURRENT MODULE.
!
GLOBL_PTR1 = FND_CHAIN (.MODU_PTR [MODU_GLOBALS], SEL_GLOBAL, GLOBAL_INFO);
IF (.GLOBL_PTR1 EQL 0)
THEN
BEGIN
IF ((MODU_PTR [MODU_GLOBALS] = BLD_CHAIN (.MODU_PTR, .MODU_PTR [MODU_GLOBALS], .GLOBL_PTR))
EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
GLOBL_PTR1 = FND_CHAIN (.MODU_PTR [MODU_GLOBALS], SEL_GLOBAL, GLOBAL_INFO);
END;
IF (.GLOBL_PTR NEQ .GLOBL_PTR1) THEN ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
IF (.FLAGS<GBL_FLG_DEF, 1> NEQ 0)
THEN
BEGIN !THIS IS A DEFINING REFERENCE
TEMP_FLAGS = .GLOBL_PTR [GBL_FLAGS];
IF (.TEMP_FLAGS<GBL_FLG_DEF, 1> NEQ 0)
THEN
BEGIN !THERE WAS AN EARLIER DEFINITION
IF ((.VALUE NEQ .GLOBL_PTR [GBL_VALUE]) OR (.FLAGS<GBL_FLG_REL, 1> NEQ 0) OR (.TEMP_FLAGS<
GBL_FLG_REL, 1> NEQ 0))
THEN
BEGIN !MULTIPLE DEFINITION
MODU_PTR1 = .GLOBL_PTR [GBL_DEF_MODU];
ERRMSG (0, 13, GLOBL_PTR [GBL_NAME], MODU_PTR1 [MODU_NAME],
.GLOBL_PTR [GBL_VALUE] + (IF (.TEMP_FLAGS<GBL_FLG_REL, 1> EQL 0) THEN 0 ELSE %O
'200000'), MODU_PTR [MODU_NAME],
.VALUE + (IF (.FLAGS<GBL_FLG_REL, 1> EQL 0) THEN 0 ELSE %O'200000'));
END;
END
ELSE
BEGIN !NO EARLIER DEFINITION
GLOBL_PTR [GBL_FLAGS] = .FLAGS;
GLOBL_PTR [GBL_VALUE] = .VALUE;
GLOBL_PTR [GBL_DEF_MODU] = .MODU_PTR;
IF (.FLAGS<GBL_FLG_REL, 1> NEQ 0)
THEN
BEGIN
GLOBL_PTR [GBL_DEF_PSECT] = .PSECT_PTR;
GLOBL_PTR [GBL_DEF_OFFSET] = .PSECT_PTR [PSECT_OFFSET];
END;
END;
END; !OF DEFINING REFERENCE
END;
END;
END; !OF GSD_GSN
ROUTINE SEL_PSECT (PSECT_PTR, PSECT_INFO) = !SELECT PROPER PSECT
!++
! FUNCTIONAL DESCRIPTION:
!
! SELECT THE PSECT DESCRIBED FROM THE LIST OF ALL PSECTS.
! USED IN A CALL TO FND_CHAIN.
!
! FORMAL PARAMETERS:
!
! PSECT_PTR - POINTER TO PSECT TO TEST FOR SUITABILITY
! PSECT_INFO - INFORMATION ABOUT THE PSECT WE ARE LOOKING FOR
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! POINTER TO THE PSECT, OR 0.
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
MAP
PSECT_PTR : REF PSECT_BLOCK,
PSECT_INFO : REF VECTOR [3];
!
! THE PSECT_INFO VECTOR CONTAINS:
!
! 0: POINTER TO THE PSECT NAME, IN ASCII
! 1: THE PSECT FLAGS
! 2: THE MAXIMUM LENGTH OF THE PSECT
!
IF (CH$NEQ (LEN_PSECT_NAME, CH$PTR (.PSECT_INFO [0]), LEN_PSECT_NAME, CH$PTR (PSECT_PTR [PSECT_NAME])))
THEN
0
ELSE
.PSECT_PTR
END; !OF SEL_PSECT
ROUTINE GSD_PSN (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = !PROCESS PSECT NAME
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE PROGRAM SECTION NAME ENTRY OF THE GSD RECORD
!
! FORMAL PARAMETERS:
!
! ASCPTR - POINTER TO NAME, IN ASCII
! FLAGS - THE FLAGS BYTE
! VALUE - THE VALUE WORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! ADDS THE PSECT NAME TO THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS SPACE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GSD_PSN');
LABEL
OUT;
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
TEMP,
CHAR1,
CHAR2,
MODU_PTR : REF MODU_BLOCK,
PSECT_PTR : REF PSECT_BLOCK,
PSECT_PTR1 : REF PSECT_BLOCK,
PSECT_PTR2 : REF PSECT_BLOCK,
PSECT_INFO : VECTOR [3],
SEARCH_DONE;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'PSECT NAME, NAME = '));
OUTSTR (1, .ASCPTR);
OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
OUTNUM (1, .FLAGS, 8, 0);
OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
OUTNUM (1, .VALUE, 8, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN !WE ARE PROCESSING A MODULE
PSECT_INFO [0] = .ASCPTR;
PSECT_INFO [1] = .FLAGS;
PSECT_INFO [2] = .VALUE;
SEARCH_DONE = 0;
PSECT_PTR1 = .ROOT [ROOT_PSECTS];
PSECT_PTR2 = 0;
IF (.PSECT_PTR1 NEQ 0)
THEN
WHILE (.SEARCH_DONE EQL 0) DO
BEGIN
!
! THE RESULT OF THE FOLLOWING CODE IS:
! 0 IF THE SYMBOLS ARE EQUAL TO EACH OTHER
! 1 IF THE SYMBOLS ARE LESS THAN EACH OTHER
! 2 IF THE SYMBOLS ARE GREATER THAN EACH OTHER
!
TEMP = (
OUT :
BEGIN
INCR COUNTER FROM 0 TO LEN_PSECT_NAME - 1 DO
BEGIN
CHAR1 = RX50 (CH$RCHAR (CH$PTR (.ASCPTR, .COUNTER)));
CHAR2 = RX50 (CH$RCHAR (CH$PTR (PSECT_PTR1 [PSECT_NAME], .COUNTER)));
IF (.CHAR1 NEQ .CHAR2)
THEN
IF (.CHAR1 GTR .CHAR2) THEN LEAVE OUT WITH 2 ELSE LEAVE OUT WITH 1;
END;
0
END
);
SEARCH_DONE = (CASE .TEMP FROM 0 TO 2 OF
SET
[2] :
BEGIN
PSECT_PTR2 = .PSECT_PTR1;
PSECT_PTR1 = .PSECT_PTR1 [PSECT_NEXT];
IF (.PSECT_PTR1 EQL 0) THEN 2 ELSE 0
END;
[1] : 1;
[0] : 3;
TES);
END;
IF (.SEARCH_DONE NEQ 3)
THEN
BEGIN !THIS IS THE FIRST REFERENCE TO THIS PSECT
IF ((PSECT_PTR = GETBLK (PSECT_TYP, PSECT_LEN)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0,
0)
ELSE
BEGIN !WE HAVE STORAGE FOR THE PSECT BLOCK
CH$MOVE (LEN_PSECT_NAME, CH$PTR (.ASCPTR), CH$PTR (PSECT_PTR [PSECT_NAME]));
PSECT_PTR [PSECT_FLAGS] = .FLAGS;
PSECT_PTR [PSECT_SIZE] = 0;
PSECT_PTR [PSECT_OFFSET] = 0;
!
! LINK THIS PSECT INTO THE LIST
!
PSECT_PTR [PSECT_NEXT] = .PSECT_PTR1;
PSECT_PTR [PSECT_PREV] = .PSECT_PTR2;
IF (.PSECT_PTR1 NEQ 0) THEN PSECT_PTR1 [PSECT_PREV] = .PSECT_PTR;
IF (.PSECT_PTR2 NEQ 0)
THEN
PSECT_PTR2 [PSECT_NEXT] = .PSECT_PTR
ELSE
ROOT [ROOT_PSECTS] = .PSECT_PTR;
END;
END !OF SEARCH_DONE NEQ 3
ELSE
PSECT_PTR = .PSECT_PTR1;
!
! THE PSECT BLOCK IS LINKED TO THE ROOT. NOW BE SURE IT IS
! CHAINED FROM THE CURRENT MODULE.
!
PSECT_PTR1 = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_PSECT, PSECT_INFO);
IF (.PSECT_PTR1 EQL 0)
THEN
BEGIN !FIRST REFERENCE TO THIS PSECT BY THIS MODULE
IF ((MODU_PTR [MODU_PSECTS] = BLD_CHAIN (.MODU_PTR, .MODU_PTR [MODU_PSECTS], .PSECT_PTR)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
PSECT_PTR1 = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_PSECT, PSECT_INFO);
IF (.PSECT_PTR NEQ .PSECT_PTR1)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
MODU_PTR [MODU_PSECT] = .PSECT_PTR;
PSECT_PTR [PSECT_OFFSET] = (IF (.FLAGS<PSECT_FLG_OVR, 1> NEQ 0) THEN 0 ELSE .PSECT_PTR [
PSECT_SIZE]);
PSECT_PTR [PSECT_SIZE] = (IF (.FLAGS<PSECT_FLG_OVR, 1> NEQ 0) THEN MAX (.PSECT_PTR [PSECT_SIZE
], .VALUE) ELSE .PSECT_PTR [PSECT_SIZE] + .VALUE);
PSECT_PTR [PSECT_SECTOR] = .MODU_PTR [MODU_SECTOR];
IF ((MODU_PTR [MODU_SECTOR] = .MODU_PTR [MODU_SECTOR] + 1) GTR 255)
THEN
ERRMSG (0, 10,
ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
END;
END; !OF FIRST REFERENCE TO THIS PSECT BY THIS MODULE
IF (((.PSECT_PTR [PSECT_FLAGS] XOR .FLAGS) AND ((1^PSECT_FLG_HI) OR (1^PSECT_FLG_LIB) OR (1^
PSECT_FLG_OVR) OR (1^PSECT_FLG_RO) OR (1^PSECT_FLG_REL) OR (1^PSECT_FLG_GBL) OR (1^PSECT_FLG_DATA)
)) NEQ 0)
THEN
ERRMSG (0, 15, ROUTINE_NAME, MODU_PTR [MODU_NAME], PSECT_PTR [PSECT_NAME],
.PSECT_PTR [PSECT_FLAGS], .FLAGS);
END; !OF PROCESSING A MODULE
END; !OF GSD_PSN
ROUTINE GSD_IDENT (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = !PROCESS VERSION IDENT
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE PROGRAM VERSION IDENTIFICATION ENTRY OF THE
! GSD RECORD. THIS ENTRY IS PRODUCED BY THE ".IDENT"
! ASSEMBLER DIRECTIVE.
!
! FORMAL PARAMETERS:
!
! ASCPTR - POINTER TO NAME, IN ASCII
! FLAGS - THE FLAGS BYTE
! VALUE - THE VALUE WORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! ADDS THE IDENTIFICATION TO THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GSD_IDENT');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
MODU_PTR : REF MODU_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'PROGRAM VERSION IDENTIFICATION, NAME = '));
OUTSTR (1, .ASCPTR);
OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
OUTNUM (1, .FLAGS, 8, 0);
OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
OUTNUM (1, .VALUE, 8, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN !THERE IS A MODULE BEING PROCESSED
CH$MOVE (LEN_MODU_VER, CH$PTR (.ASCPTR), CH$PTR (MODU_PTR [MODU_IDENT]));
MODU_PTR [MODU_FLAG_IDENT] = 1;
END;
END; !OF GSD_IDENT
ROUTINE GSD_MAP (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = !PROCESS MAPPED ARRAY
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE MAPPED ARRAY ENTRY OF THE GSD RECORD.
! THIS IS NOT IMPLEMENTED SINCE IT IS NOT PRODUCED BY MACY11.
!
! FORMAL PARAMETERS:
!
! ASCPTR - POINTER TO NAME, IN ASCII
! FLAGS - THE FLAGS BYTE
! VALUE - THE VALUE WORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! PRINTS AN ERROR MESSAGE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GSD_MAP');
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'MAPPED ARRAY DECLARATION, NAME = '));
OUTSTR (1, .ASCPTR);
OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
OUTNUM (1, .FLAGS, 8, 0);
OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
OUTNUM (1, .VALUE, 8, 0);
END; !DEBUG
ERRMSG (0, 12, ROUTINE_NAME, 0, 0, 0, 0);
END; !OF GSD_MAP
ROUTINE GBL_REF (GLOBL_PTR, PSECT_PTR, MODU_PTR) : NOVALUE = !RECORD A GLOBAL REFERENCE
!++
! FUNCTIONAL DESCRIPTION:
!
! RECORD, USING CHAIN BLOCKS, A GLOBAL REFERENCE TO THE SPECIFIED
! GLOBAL SYMBOL IN THE SPECIFIED PSECT IN THE SPECIFIED MODULE.
!
! FORMAL PARAMETERS:
!
! GLOBL_PTR - POINTER TO THE GLOBAL SYMBOL BEING REFERENCED
! PSECT_PTR - POINTER TO THE PSECT IN WHICH THE REFERENCE OCCURS
! MODU_PTR - POINTER TO THE MODULE IN WHICH THE REFERENCE OCCURS
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! MAY OBTAIN STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GBL_REF');
MAP
GLOBL_PTR : REF GLOBL_BLOCK,
MODU_PTR : REF MODU_BLOCK,
PSECT_PTR : REF PSECT_BLOCK;
LOCAL
GLOBAL_INFO : VECTOR [3];
GLOBAL_INFO [0] = GLOBL_PTR [GBL_NAME];
GLOBAL_INFO [1] = .GLOBL_PTR [GBL_FLAGS];
GLOBAL_INFO [2] = .GLOBL_PTR [GBL_VALUE];
IF (FND_CHAIN (.PSECT_PTR [PSECT_GLOBALS], SEL_GLOBAL, GLOBAL_INFO) EQL 0)
THEN
BEGIN !FIRST REFERENCE BY THIS GLOBAL TO THIS PSECT
IF ((PSECT_PTR [PSECT_GLOBALS] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_GLOBALS], .GLOBL_PTR)) EQL 0
)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0);
IF ((GLOBL_PTR [GBL_PSECTS] = BLD_CHAIN (.GLOBL_PTR, .GLOBL_PTR [GBL_PSECTS], .PSECT_PTR)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0);
END; !OF FIRST REFERENCE BY THIS GLOBAL TO THIS PSECT
END; !OF GBL_REF
ROUTINE M_RLDH (MODIF, DISP, PSECT_PTR, LOCATION) = !MAKE RLDH BLOCK
!++
! FUNCTIONAL DESCRIPTION:
!
! BUILD AN RLDH BLOCK FROM FREE STORAGE, AND FILL IN SOME
! OF THE FIELDS.
!
! FORMAL PARAMETERS:
!
! MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
! DISP - DISPLACEMENT INTO TEXT RECORD
! PSECT_PTR - POINTER TO THE PSECT THAT THIS RELOCATION APPLIES TO
! LOCATION - OFFSET IN PSECT SPECIFIED BY LOCATION COUNTER SETTING
! OPERATION.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! POINTER TO THE RLDH, OR 0 IF OUT OF STORAGE
! THE CALLER IS RESPONSIBLE FOR GIVING THE 'OUT OF STORAGE'
! ERROR MESSAGE.
!
! SIDE EFFECTS
!
! OBTAINS STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'M_RLDH');
MAP
PSECT_PTR : REF PSECT_BLOCK;
LOCAL
RLDH_PTR : REF RLDH_BLOCK;
IF ((RLDH_PTR = GETBLK (RLDH_TYP, RLDH_LEN)) EQL 0)
THEN
0
ELSE
BEGIN !WE HAVE AN RLDH BLOCK
RLDH_PTR [RLDH_PSECT] = .PSECT_PTR;
RLDH_PTR [RLDH_BYTE] = .MODIF;
RLDH_PTR [RLDH_ADDR] = .PSECT_PTR [PSECT_LLA] - 4 + .DISP;
.RLDH_PTR
END
END; !OF M_RLDH
ROUTINE M_RLDD (OPER, OP1T, OP2T, OPND1, OPND2) = !MAKE RLDD BLOCK
!++
! FUNCTIONAL DESCRIPTION:
!
! BUILD AN RLDD BLOCK FROM FREE STORAGE, AND FILL IN
! ITS FIELDS.
!
! FORMAL PARAMETERS:
!
! OPER - THE OPERATION TO BE PERFORMED.
! OP1T - THE TYPE OF OPERAND 1
! OP2T - THE TYPE OF OPERAND 2, "OMIT" IF NONE.
! OPND1 - OPERAND 1, EITHER A CONSTANT OR A POINTER
! OPND2 - OPERAND 2, A CONSTANT OR A POINTER IF PRESENT, 0 IF
! OMITTED.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! POINTER TO THE RLDD, OR 0 IF OUT OF STORAGE.
! IF EITHER OPERAND IS AN RLDD BLOCK BUT IS 0,
! 0 IS RETURNED. THE CALLER IS RESPONSIBLE FOR GIVING
! THE 'OUT OF STORAGE' ERROR MESSAGE IN THIS CASE.
!
! SIDE EFFECTS
!
! MAY OBTAIN STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'M_RLDD');
LOCAL
RLDD_PTR : REF RLDD_BLOCK;
IF (((.OP1T EQL RLD_OPND_OPR) AND (.OPND1 EQL 0)) OR ((.OP2T EQL RLD_OPND_OPR) AND (.OPND2 EQL 0)))
THEN
0
ELSE
BEGIN
IF ((RLDD_PTR = GETBLK (RLDD_TYP, RLDD_LEN)) EQL 0)
THEN
0
ELSE
BEGIN !WE HAVE AN RLDD BLOCK
RLDD_PTR [RLDD_OPER] = .OPER;
RLDD_PTR [RLDD_OP1T] = .OP1T;
RLDD_PTR [RLDD_OP2T] = .OP2T;
RLDD_PTR [RLDD_OPND1] = .OPND1;
RLDD_PTR [RLDD_OPND2] = .OPND2;
.RLDD_PTR
END
END
END; !OF M_RLDD
ROUTINE R_ERR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !RLD ERROR
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE UNUSED ENTRY OF THE RLD RECORD.
!
! FORMAL PARAMETERS:
!
! MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
! DISP - DISPLACEMENT INTO TEXT RECORD
! BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
! BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
! FILE_PTR - POINTER TO THE OBJECT FILE'S FILE BLOCK
!
! IMPLICIT INPUTS:
!
! INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! PRINTS AN ERROR MESSAGE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'R_ERR');
MAP
FILE_PTR : REF FILE_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'ERROR, MODIF = '));
OUTNUM (1, .MODIF, 2, 0);
OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
OUTNUM (1, .DISP, 8, 0);
END; !DEBUG
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
END; !OF R_ERR
ROUTINE R_IR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !RLD INTERNAL RELOCATION
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE INTERNAL RELOCATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
! MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
! DISP - DISPLACEMENT INTO TEXT RECORD
! BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
! BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
! MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'R_IR');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
CONSTANT,
MODU_PTR : REF MODU_BLOCK,
PSECT_PTR : REF PSECT_BLOCK,
RLDH_PTR : REF RLDH_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'INTERNAL RELOCATION, MODIF = '));
OUTNUM (1, .MODIF, 2, 0);
OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
OUTNUM (1, .DISP, 8, 0);
END; !DEBUG
CONSTANT = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
IF (DEBUG GEQ 1)
THEN
BEGIN
OUTSTR (1, UPLIT (%ASCIZ', CONSTANT = '));
OUTNUM (1, .CONSTANT, 8, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN !WE ARE INSIDE A MODULE
IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !WE ARE INSIDE A PSECT
IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
THEN
ERRMSG (0,
1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN !WE HAVE AN RLD HEADER
!
! FOR INTERNAL RELOCATION, THE VALUE TO BE STORED IS THE CURRENT PSECT
! BASE PLUS THE GIVEN CONSTANT.
!
IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_ADD, RLD_OPND_OPR, RLD_OPND_CON,
M_RLDD (RLD_OP_ADD, RLD_OPND_PSECT, RLD_OPND_CON, .PSECT_PTR,
.PSECT_PTR [PSECT_OFFSET]), .CONSTANT)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);
END;
END;
END;
END; !OF R_IR
ROUTINE R_GR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !RLD GLOBAL RELOCATION
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE GLOBAL RELOCATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
! MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
! DISP - DISPLACEMENT INTO TEXT RECORD
! BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
! BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
! MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'R_GR');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
ASCVAL : VECTOR [CH$ALLOCATION (LEN_GBL_NAME)],
CONSTANT,
GLOBAL_INFO : VECTOR [3],
GLOBL_PTR : REF GLOBL_BLOCK,
MODU_PTR : REF MODU_BLOCK,
PSECT_PTR : REF PSECT_BLOCK,
R50VAL,
RLDH_PTR : REF RLDH_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'GLOBAL RELOCATION, MODIF = '));
OUTNUM (1, .MODIF, 2, 0);
OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
OUTNUM (1, .DISP, 8, 0);
END; !DEBUG
R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50TOA (.R50VAL, ASCVAL [0]);
IF (DEBUG GEQ 1)
THEN
BEGIN
OUTSTR (1, UPLIT (%ASCIZ', NAME = '));
OUTSTR (1, ASCVAL [0]);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN !WE ARE INSIDE A MODULE
GLOBAL_INFO [0] = ASCVAL [0];
GLOBAL_INFO [1] = 0;
GLOBAL_INFO [2] = 0;
IF ((GLOBL_PTR = FND_CHAIN (.MODU_PTR [MODU_GLOBALS], SEL_GLOBAL, GLOBAL_INFO)) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !THIS GLOBAL HAS BEEN DECLARED IN THIS MODULE
IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !WE ARE INSIDE A PSECT
GBL_REF (.GLOBL_PTR, .PSECT_PTR, .MODU_PTR);
IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN !WE HAVE AN RLD HEADER
!
! FOR GLOBAL RELOCATION, THE VALUE TO BE STORED IS SIMPLY THE VALUE OF
! THE GLOBAL SYMBOL. WE REPRESENT THIS BY ADDING THE GLOBAL VALUE
! TO 0.
!
IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_ADD, RLD_OPND_GLOBAL, RLD_OPND_CON,
.GLOBL_PTR, 0)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);
END;
END;
END;
END;
END; !OF R_GR
ROUTINE R_IDR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !RLD INTERNAL DISPLACED RELOCATION
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE INTERNAL DISPLACED RELOCATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
! MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
! DISP - DISPLACEMENT INTO TEXT RECORD
! BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
! BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
! FILE_PTR - POINTER TO THE OBJECT FILE BLOCK
!
! IMPLICIT INPUTS:
!
! INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
! MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'R_IDR');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
CONSTANT,
MODU_PTR : REF MODU_BLOCK,
PSECT_PTR : REF PSECT_BLOCK,
RLDH_PTR : REF RLDH_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'INTERNAL DISPLACED RELOCATION, MODIF = '));
OUTNUM (1, .MODIF, 2, 0);
OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
OUTNUM (1, .DISP, 8, 0);
END; !DEBUG
CONSTANT = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
IF (DEBUG GEQ 1)
THEN
BEGIN
OUTSTR (1, UPLIT (%ASCIZ', CONSTANT = '));
OUTNUM (1, .CONSTANT, 8, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN !WE ARE INSIDE A MODULE
IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !WE ARE INSIDE A PSECT
IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
THEN
ERRMSG (0,
1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN !WE HAVE AN RLD HEADER
!
! FOR INTERNAL DISPLACED RELOCATION, THE VALUE TO BE STORED IS THE
! STORE ADDRESS + 2 PLUS THE BASE OF THE CURRENT PSECT, SUBTRACTED
! FROM THE GIVEN CONSTANT.
!
IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_SUB, RLD_OPND_CON, RLD_OPND_OPR, .CONSTANT,
M_RLDD (RLD_OP_ADD, RLD_OPND_CON, RLD_OPND_PSECT, .RLDH_PTR [RLDH_ADDR] + 2,
.PSECT_PTR))) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);
END;
END;
END;
END; !OF R_IDR
ROUTINE R_GDR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !RLD GLOBAL DISPLACED RELOCATION
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE GLOBAL DISPLACED RELOCATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
! MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
! DISP - DISPLACEMENT INTO TEXT RECORD
! BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
! BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
! MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'R_GDR');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
ASCVAL : VECTOR [CH$ALLOCATION (LEN_GBL_NAME)],
CONSTANT,
GLOBAL_INFO : VECTOR [3],
GLOBL_PTR : REF GLOBL_BLOCK,
MODU_PTR : REF MODU_BLOCK,
PSECT_PTR : REF PSECT_BLOCK,
R50VAL,
RLDH_PTR : REF RLDH_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'GLOBAL DISPLACED RELOCATION, MODIF = '));
OUTNUM (1, .MODIF, 2, 0);
OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
OUTNUM (1, .DISP, 8, 0);
END; !DEBUG
R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50TOA (.R50VAL, ASCVAL [0]);
IF (DEBUG GEQ 1)
THEN
BEGIN
OUTSTR (1, UPLIT (%ASCIZ', NAME = '));
OUTSTR (1, ASCVAL [0]);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN !WE ARE INSIDE A MODULE
GLOBAL_INFO [0] = ASCVAL [0];
GLOBAL_INFO [1] = 0;
GLOBAL_INFO [2] = 0;
IF ((GLOBL_PTR = FND_CHAIN (.MODU_PTR [MODU_GLOBALS], SEL_GLOBAL, GLOBAL_INFO)) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !THIS GLOBAL HAS BEEN DECLARED IN THIS MODULE
IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !WE ARE INSIDE A PSECT
GBL_REF (.GLOBL_PTR, .PSECT_PTR, .MODU_PTR);
IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN !WE HAVE AN RLD HEADER
!
! FOR GLOBAL DISPLACED RELOCATION, THE VALUE TO BE STORED IS THE SUM
! OF THE STORE ADDRESS + 2 AND THE BASE OF THE CURRENT PSECT,
! SUBTRACTED FROM THE VALUE OF THE GLOBAL SYMBOL.
!
IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_SUB, RLD_OPND_GLOBAL, RLD_OPND_OPR,
.GLOBL_PTR,
M_RLDD (RLD_OP_ADD, RLD_OPND_CON, RLD_OPND_PSECT,
.RLDH_PTR [RLDH_ADDR] + 2, .PSECT_PTR))) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);
END;
END;
END;
END;
END; !OF R_GDR
ROUTINE R_GAR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !RLD GLOBAL ADDITIVE RELOCATION
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE GLOBAL ADDITIVE RELOCATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
! MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
! DISP - DISPLACEMENT INTO TEXT RECORD
! BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
! BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
! MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'R_GAR');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
ASCVAL : VECTOR [CH$ALLOCATION (LEN_GBL_NAME)],
CONSTANT,
GLOBAL_INFO : VECTOR [3],
GLOBL_PTR : REF GLOBL_BLOCK,
MODU_PTR : REF MODU_BLOCK,
PSECT_PTR : REF PSECT_BLOCK,
R50VAL,
RLDH_PTR : REF RLDH_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'GLOBAL ADDITIVE RELOCATION, MODIF = '));
OUTNUM (1, .MODIF, 2, 0);
OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
OUTNUM (1, .DISP, 8, 0);
END; !DEBUG
R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50TOA (.R50VAL, ASCVAL [0]);
IF (DEBUG GEQ 1)
THEN
BEGIN
OUTSTR (1, UPLIT (%ASCIZ', NAME = '));
OUTSTR (1, ASCVAL [0]);
END; !DEBUG
CONSTANT = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
IF (DEBUG GEQ 1)
THEN
BEGIN
OUTSTR (1, UPLIT (%ASCIZ', CONSTANT = '));
OUTNUM (1, .CONSTANT, 8, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN !WE ARE INSIDE A MODULE
GLOBAL_INFO [0] = ASCVAL [0];
GLOBAL_INFO [1] = 0;
GLOBAL_INFO [2] = 0;
IF ((GLOBL_PTR = FND_CHAIN (.MODU_PTR [MODU_GLOBALS], SEL_GLOBAL, GLOBAL_INFO)) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !THIS GLOBAL HAS BEEN DECLARED IN THIS MODULE
IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !WE ARE INSIDE A PSECT
GBL_REF (.GLOBL_PTR, .PSECT_PTR, .MODU_PTR);
IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN !WE HAVE AN RLD HEADER
!
! FOR GLOBAL ADDITIVE RELOCATION, THE VALUE TO BE STORED IS THE
! VALUE OF THE GLOBAL SYMBOL PLUS THE VALUE OF THE CONSTANT.
!
IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_ADD, RLD_OPND_GLOBAL, RLD_OPND_CON,
.GLOBL_PTR, .CONSTANT)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);
END;
END;
END;
END;
END; !OF R_GAR
ROUTINE R_GADR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE =
!RLD GLOBAL ADDITIVE DISPLACED RELOCATION
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE GLOBAL ADDITIVE DISPLACED RELOCATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
! MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
! DISP - DISPLACEMENT INTO TEXT RECORD
! BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
! BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
! FILE_PTR - POINTER TO FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
! MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'R_GADR');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
ASCVAL : VECTOR [CH$ALLOCATION (LEN_GBL_NAME)],
CONSTANT,
GLOBAL_INFO : VECTOR [3],
GLOBL_PTR : REF GLOBL_BLOCK,
MODU_PTR : REF MODU_BLOCK,
PSECT_PTR : REF PSECT_BLOCK,
R50VAL,
RLDH_PTR : REF RLDH_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'GLOBAL ADDITIVE DISPLACED RELOCATION, MODIF = '));
OUTNUM (1, .MODIF, 2, 0);
OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
OUTNUM (1, .DISP, 8, 0);
END; !DEBUG
R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50TOA (.R50VAL, ASCVAL [0]);
IF (DEBUG GEQ 1)
THEN
BEGIN
OUTSTR (1, UPLIT (%ASCIZ', NAME = '));
OUTSTR (1, ASCVAL [0]);
END; !DEBUG
CONSTANT = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
IF (DEBUG GEQ 1)
THEN
BEGIN
OUTSTR (1, UPLIT (%ASCIZ', CONSTANT = '));
OUTNUM (1, .CONSTANT, 8, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN !WE ARE INSIDE A MODULE
GLOBAL_INFO [0] = ASCVAL [0];
GLOBAL_INFO [1] = 0;
GLOBAL_INFO [2] = 0;
IF ((GLOBL_PTR = FND_CHAIN (.MODU_PTR [MODU_GLOBALS], SEL_GLOBAL, GLOBAL_INFO)) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !THIS GLOBAL HAS BEEN DECLARED IN THIS MODULE
IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !WE ARE INSIDE A PSECT
GBL_REF (.GLOBL_PTR, .PSECT_PTR, .MODU_PTR);
IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN !WE HAVE AN RLD HEADER
!
! FOR GLOBAL ADDITIVE DISPLACED RELOCATION, THE VALUE TO BE STORED IS THE SUM
! OF THE STORE ADDRESS + 2 AND THE BASE OF THE CURRENT PSECT,
! SUBTRACTED FROM THE VALUE OF THE GLOBAL SYMBOL, PLUS THE GIVEN CONSTANT.
!
IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_SUB, RLD_OPND_OPR, RLD_OPND_OPR,
M_RLDD (RLD_OP_ADD, RLD_OPND_GLOBAL, RLD_OPND_CON, .GLOBL_PTR, .CONSTANT),
M_RLDD (RLD_OP_ADD, RLD_OPND_CON, RLD_OPND_PSECT, .RLDH_PTR [RLDH_ADDR] + 2,
.PSECT_PTR))) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);
END;
END;
END;
END;
END; !OF R_GAR
ROUTINE R_LCD (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !RLD LOCATION COUNTER DEFINITION
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE LOCATION COUNTER DEFINITION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
! MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
! DISP - DISPLACEMENT INTO TEXT RECORD
! BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
! BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
! MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'R_LCD');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
MODU_PTR : REF MODU_BLOCK,
PSECT_PTR : REF PSECT_BLOCK,
PSECT_INFO : VECTOR [3],
R50VAL,
ASCVAL : VECTOR [CH$ALLOCATION (LEN_PSECT_NAME)],
CONSTANT;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'LOCATION COUNTER DEFINITION, MODIF = '));
OUTNUM (1, .MODIF, 2, 0);
OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
OUTNUM (1, .DISP, 8, 0);
END; !DEBUG
R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50TOA (.R50VAL, ASCVAL [0]);
IF (DEBUG GEQ 1)
THEN
BEGIN
OUTSTR (1, UPLIT (%ASCIZ', NAME = '));
OUTSTR (1, ASCVAL [0]);
END; !DEBUG
CONSTANT = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
IF (DEBUG GEQ 1)
THEN
BEGIN
OUTSTR (1, UPLIT (%ASCIZ', CONSTANT = '));
OUTNUM (1, .CONSTANT, 8, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
PSECT_INFO [0] = ASCVAL;
PSECT_INFO [1] = 0;
PSECT_INFO [2] = 0;
PSECT_PTR = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_PSECT, PSECT_INFO);
IF (.PSECT_PTR EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
MODU_PTR [MODU_PSECT] = .PSECT_PTR;
MODU_PTR [MODU_LC] = .CONSTANT;
END;
END;
END; !OF R_LCD
ROUTINE R_LCM (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !RLD LOCATION COUNTER MODIFICATION
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE LOCATION COUNTER MODIFICATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
! MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
! DISP - DISPLACEMENT INTO TEXT RECORD
! BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
! BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
! MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'R_LCM');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
CONSTANT,
MODU_PTR : REF MODU_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'LOCATION COUNTER MODIFICATION, MODIF = '));
OUTNUM (1, .MODIF, 2, 0);
OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
OUTNUM (1, .DISP, 8, 0);
END; !DEBUG
CONSTANT = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
IF (DEBUG GEQ 1)
THEN
BEGIN
OUTSTR (1, UPLIT (%ASCIZ', CONSTANT = '));
OUTNUM (1, .CONSTANT, 8, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
IF (.MODU_PTR [MODU_PSECT] EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
MODU_PTR [MODU_LC] = .CONSTANT;
END;
END;
END; !OF R_LCM
ROUTINE R_PL (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !RLD PROGRAM LIMITS
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE PROGRAM LIMITS ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
! MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
! DISP - DISPLACEMENT INTO TEXT RECORD
! BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
! BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
! MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'R_PL');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
CONSTANT,
MODU_PTR : REF MODU_BLOCK,
PSECT_PTR : REF PSECT_BLOCK,
RLDH_PTR : REF RLDH_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'PROGRAM LIMITS, MODIF = '));
OUTNUM (1, .MODIF, 2, 0);
OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
OUTNUM (1, .DISP, 8, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
THEN
ERRMSG (0,
1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_ADD, RLD_OPND_BSTK, RLD_OPND_CON, 0, 0)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);
IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP + 2, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_ADD, RLD_OPND_HLA, RLD_OPND_CON, 0, 0))
EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);
END;
END;
END;
END;
END;
END;
END; !OF R_PL
ROUTINE R_PR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !RLD PSECT RELOCATION
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE PSECT RELOCATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
! MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
! DISP - DISPLACEMENT INTO TEXT RECORD
! BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
! BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
! MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'R_PR');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
ASCVAL : VECTOR [CH$ALLOCATION (LEN_PSECT_NAME)],
CONSTANT,
MODU_PTR : REF MODU_BLOCK,
PSECT_INFO : VECTOR [3],
PSECT_PTR : REF PSECT_BLOCK,
PSECT_PTR1 : REF PSECT_BLOCK,
R50VAL,
RLDH_PTR : REF RLDH_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'PSECT RELOCATION, MODIF = '));
OUTNUM (1, .MODIF, 2, 0);
OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
OUTNUM (1, .DISP, 8, 0);
END; !DEBUG
R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50TOA (.R50VAL, ASCVAL [0]);
IF (DEBUG GEQ 1)
THEN
BEGIN
OUTSTR (1, UPLIT (%ASCIZ', NAME = '));
OUTSTR (1, ASCVAL [0]);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN !WE ARE INSIDE A MODULE
PSECT_INFO [0] = ASCVAL [0];
PSECT_INFO [1] = 0;
PSECT_INFO [2] = 0;
IF ((PSECT_PTR1 = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_PSECT, PSECT_INFO)) EQL 0)
THEN
ERRMSG (0,
10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !THIS PSECT HAS BEEN DECLARED IN THIS MODULE
IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !WE ARE INSIDE A PSECT
IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN !WE HAVE AN RLD HEADER
!
! FOR PSECT RELOCATION, THE VALUE TO BE STORED IS SIMPLY THE VALUE OF
! THE PSECT BASE.
!
IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_ADD, RLD_OPND_PSECT, RLD_OPND_CON,
.PSECT_PTR1, .PSECT_PTR1 [PSECT_OFFSET])) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);
END;
END;
END;
END;
END; !OF R_PR
ROUTINE R_PDR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !RLD PSECT DISPLACED RELOCATION
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE PSECT DISPLACED RELOCATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
! MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
! DISP - DISPLACEMENT INTO TEXT RECORD
! BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
! BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
! MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'R_PDR');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
ASCVAL : VECTOR [CH$ALLOCATION (LEN_PSECT_NAME)],
CONSTANT,
MODU_PTR : REF MODU_BLOCK,
PSECT_INFO : VECTOR [3],
PSECT_PTR : REF PSECT_BLOCK,
PSECT_PTR1 : REF PSECT_BLOCK,
R50VAL,
RLDH_PTR : REF RLDH_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'PSECT DISPLACED RELOCATION, MODIF = '));
OUTNUM (1, .MODIF, 2, 0);
OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
OUTNUM (1, .DISP, 8, 0);
END; !DEBUG
R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50TOA (.R50VAL, ASCVAL [0]);
IF (DEBUG GEQ 1)
THEN
BEGIN
OUTSTR (1, UPLIT (%ASCIZ', NAME = '));
OUTSTR (1, ASCVAL [0]);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN !WE ARE INSIDE A MODULE
PSECT_INFO [0] = ASCVAL [0];
PSECT_INFO [1] = 0;
PSECT_INFO [2] = 0;
IF ((PSECT_PTR1 = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_PSECT, PSECT_INFO)) EQL 0)
THEN
ERRMSG (0,
10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !THIS PSECT HAS BEEN DECLARED IN THIS MODULE
IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !WE ARE INSIDE A PSECT
IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN !WE HAVE AN RLD HEADER
!
! FOR PSECT DISPLACED RELOCATION, THE VALUE TO BE STORED IS THE SUM
! OF THE STORE ADDRESS + 2 AND THE BASE OF THE CURRENT PSECT,
! SUBTRACTED FROM THE BASE OF THE SPECIFIED PSECT.
!
IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_SUB, RLD_OPND_OPR, RLD_OPND_OPR,
M_RLDD (RLD_OP_ADD, RLD_OPND_PSECT, RLD_OPND_CON, .PSECT_PTR1,
.PSECT_PTR1 [PSECT_OFFSET]),
M_RLDD (RLD_OP_ADD, RLD_OPND_CON,
RLD_OPND_PSECT, .RLDH_PTR [RLDH_ADDR] + 2, .PSECT_PTR))) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);
END;
END;
END;
END;
END; !OF R_PDR
ROUTINE R_PAR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !RLD PSECT ADDITIVE RELOCATION
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE PSECT ADDITIVE RELOCATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
! MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
! DISP - DISPLACEMENT INTO TEXT RECORD
! BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
! BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
! MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'R_PAR');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
ASCVAL : VECTOR [CH$ALLOCATION (LEN_PSECT_NAME)],
CONSTANT,
MODU_PTR : REF MODU_BLOCK,
PSECT_INFO : VECTOR [3],
PSECT_PTR : REF PSECT_BLOCK,
PSECT_PTR1 : REF PSECT_BLOCK,
R50VAL,
RLDH_PTR : REF RLDH_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'PSECT ADDITIVE RELOCATION, MODIF = '));
OUTNUM (1, .MODIF, 2, 0);
OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
OUTNUM (1, .DISP, 8, 0);
END; !DEBUG
R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50TOA (.R50VAL, ASCVAL [0]);
IF (DEBUG GEQ 1)
THEN
BEGIN
OUTSTR (1, UPLIT (%ASCIZ', NAME = '));
OUTSTR (1, ASCVAL [0]);
END; !DEBUG
CONSTANT = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
IF (DEBUG GEQ 1)
THEN
BEGIN
OUTSTR (1, UPLIT (%ASCIZ', CONSTANT = '));
OUTNUM (1, .CONSTANT, 8, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN !WE ARE INSIDE A MODULE
PSECT_INFO [0] = ASCVAL [0];
PSECT_INFO [1] = 0;
PSECT_INFO [2] = 0;
IF ((PSECT_PTR1 = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_PSECT, PSECT_INFO)) EQL 0)
THEN
ERRMSG (0,
10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !THIS PSECT HAS BEEN DECLARED IN THIS MODULE
IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !WE ARE INSIDE A PSECT
IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN !WE HAVE AN RLD HEADER
!
! FOR PSECT ADDITIVE RELOCATION, THE VALUE TO BE STORED IS THE
! BASE OF THE SPECIFIED PSECT PLUS THE VALUE OF THE CONSTANT.
!
IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_ADD, RLD_OPND_OPR, RLD_OPND_CON,
M_RLDD (RLD_OP_ADD, RLD_OPND_PSECT, RLD_OPND_CON, .PSECT_PTR1,
.PSECT_PTR1 [PSECT_OFFSET]), .CONSTANT)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);
END;
END;
END;
END;
END; !OF R_PAR
ROUTINE R_PADR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE =
!RLD PSECT ADDITIVE DISPLACED RELOCATION
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE PSECT ADDITIVE DISPLACED RELOCATION ENTRY OF THE RLD RECORD
!
! FORMAL PARAMETERS:
!
! MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
! DISP - DISPLACEMENT INTO TEXT RECORD
! BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
! BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
! MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'R_PADR');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
ASCVAL : VECTOR [CH$ALLOCATION (LEN_PSECT_NAME)],
CONSTANT,
MODU_PTR : REF MODU_BLOCK,
PSECT_INFO : VECTOR [3],
PSECT_PTR : REF PSECT_BLOCK,
PSECT_PTR1 : REF PSECT_BLOCK,
R50VAL,
RLDH_PTR : REF RLDH_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'PSECT ADDITIVE DISPLACED RELOCATION, MODIF = '));
OUTNUM (1, .MODIF, 2, 0);
OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
OUTNUM (1, .DISP, 8, 0);
END; !DEBUG
R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50TOA (.R50VAL, ASCVAL [0]);
IF (DEBUG GEQ 1)
THEN
BEGIN
OUTSTR (1, UPLIT (%ASCIZ', NAME = '));
OUTSTR (1, ASCVAL [0]);
END; !DEBUG
CONSTANT = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
IF (DEBUG GEQ 1)
THEN
BEGIN
OUTSTR (1, UPLIT (%ASCIZ', CONSTANT = '));
OUTNUM (1, .CONSTANT, 8, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN !WE ARE INSIDE A MODULE
PSECT_INFO [0] = ASCVAL [0];
PSECT_INFO [1] = 0;
PSECT_INFO [2] = 0;
IF ((PSECT_PTR1 = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_PSECT, PSECT_INFO)) EQL 0)
THEN
ERRMSG (0,
10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !THIS PSECT HAS BEEN DECLARED IN THIS MODULE
IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !WE ARE INSIDE A PSECT
IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN !WE HAVE AN RLD HEADER
!
! FOR PSECT ADDITIVE DISPLACED RELOCATION, THE VALUE TO BE STORED IS THE SUM
! OF THE STORE ADDRESS + 2 AND THE BASE OF THE CURRENT PSECT,
! SUBTRACTED FROM THE BASE OF THE SPECIFIED PSECT, PLUS THE GIVEN CONSTANT.
!
IF ((RLDH_PTR [RLDH_VALUE] = M_RLDD (RLD_OP_SUB, RLD_OPND_OPR, RLD_OPND_OPR,
M_RLDD (RLD_OP_ADD, RLD_OPND_OPR, RLD_OPND_CON,
M_RLDD (RLD_OP_ADD,
RLD_OPND_PSECT, RLD_OPND_CON, .PSECT_PTR1, .PSECT_PTR1 [PSECT_OFFSET]),
.CONSTANT),
M_RLDD (RLD_OP_ADD, RLD_OPND_CON, RLD_OPND_PSECT,
.RLDH_PTR [RLDH_ADDR] + 2, .PSECT_PTR))) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);
END;
END;
END;
END;
END; !OF R_PADR
ROUTINE SEL_SECTOR (PSECT_PTR, SECTOR) = !SELECT PROPER SECTOR
!++
! FUNCTIONAL DESCRIPTION:
!
! SELECT A PSECT GIVEN ITS SECTOR NUMBER.
! USED IN A CALL TO FND_CHAIN.
!
! FORMAL PARAMETERS:
!
! PSECT_PTR - POINTER TO PSECT TO TEST FOR SUITABILITY
! SECTOR - NUMBER OF THE SECTOR WANTED
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! POINTER TO THE PSECT, OR 0.
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
MAP
PSECT_PTR : REF PSECT_BLOCK;
IF (.SECTOR NEQ .PSECT_PTR [PSECT_SECTOR]) THEN 0 ELSE .PSECT_PTR
END; !OF SEL_SECTOR
ROUTINE R_CR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !RLD COMPLEX RELOCATION
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE COMPLEX RELOCATION ENTRY OF THE RLD RECORD.
!
! FORMAL PARAMETERS:
!
! MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
! DISP - DISPLACEMENT INTO TEXT RECORD
! BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
! BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
! MODIFIES THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'R_CR');
LITERAL
STACK_LIMIT = 100;
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
ASCVAL : VECTOR [CH$ALLOCATION (LEN_PSECT_NAME)],
COMMAND_TERM,
CONSTANT,
GLOBAL_INFO : VECTOR [3],
GLOBL_PTR : REF GLOBL_BLOCK,
MODU_PTR : REF MODU_BLOCK,
OFFSET,
OPCODE,
OPND_TYPE : VECTOR [STACK_LIMIT],
OPND_VAL : VECTOR [STACK_LIMIT],
PSECT_PTR : REF PSECT_BLOCK,
PSECT_PTR1 : REF PSECT_BLOCK,
R50VAL,
RLDD_PTR : REF RLDD_BLOCK,
RLDH_PTR : REF RLDH_BLOCK,
SECTOR,
STACK_DEPTH,
TEMP_RLDH_VAL;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'COMPLEX RELOCATION, MODIF = '));
OUTNUM (1, .MODIF, 2, 0);
OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
OUTNUM (1, .DISP, 8, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN !WE ARE INSIDE A MODULE
IF ((PSECT_PTR = .MODU_PTR [MODU_PSECT]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !WE ARE INSIDE A PSECT
STACK_DEPTH = 0;
COMMAND_TERM = 0;
WHILE (.COMMAND_TERM EQL 0) DO
BEGIN
OPCODE = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR);
CASE .OPCODE FROM %O'0' TO %O'21' OF
SET
[%O'0'] :
BEGIN !NO OPERATION
IF (DEBUG GEQ 1)
THEN
BEGIN !DEBUG
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'NOP OPERATOR'));
END; !DEBUG
END;
[%O'1'] :
BEGIN !ADDITION
IF (DEBUG GEQ 1)
THEN
BEGIN !DEBUG
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'ADD OPERATOR'));
END; !DEBUG
RLDD_PTR = M_RLDD (RLD_OP_ADD, .OPND_TYPE [.STACK_DEPTH - 2],
.OPND_TYPE [.STACK_DEPTH - 1], .OPND_VAL [.STACK_DEPTH - 2],
.OPND_VAL [.STACK_DEPTH - 1]);
IF ((STACK_DEPTH = .STACK_DEPTH - 2) LSS 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN
OPND_TYPE [.STACK_DEPTH] = RLD_OPND_OPR;
OPND_VAL [.STACK_DEPTH] = .RLDD_PTR;
STACK_DEPTH = .STACK_DEPTH + 1;
END;
END;
[%O'2'] :
BEGIN !SUBTRACT
IF (DEBUG GEQ 1)
THEN
BEGIN !DEBUG
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'SUB OPERATOR'));
END; !DEBUG
RLDD_PTR = M_RLDD (RLD_OP_SUB, .OPND_TYPE [.STACK_DEPTH - 2],
.OPND_TYPE [.STACK_DEPTH - 1], .OPND_VAL [.STACK_DEPTH - 2],
.OPND_VAL [.STACK_DEPTH - 1]);
IF ((STACK_DEPTH = .STACK_DEPTH - 2) LSS 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN
OPND_TYPE [.STACK_DEPTH] = RLD_OPND_OPR;
OPND_VAL [.STACK_DEPTH] = .RLDD_PTR;
STACK_DEPTH = .STACK_DEPTH + 1;
END;
END;
[%O'3'] :
BEGIN !MULTIPLICATION
IF (DEBUG GEQ 1)
THEN
BEGIN !DEBUG
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'MUL OPERATOR'));
END; !DEBUG
RLDD_PTR = M_RLDD (RLD_OP_MUL, .OPND_TYPE [.STACK_DEPTH - 2],
.OPND_TYPE [.STACK_DEPTH - 1], .OPND_VAL [.STACK_DEPTH - 2],
.OPND_VAL [.STACK_DEPTH - 1]);
IF ((STACK_DEPTH = .STACK_DEPTH - 2) LSS 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN
OPND_TYPE [.STACK_DEPTH] = RLD_OPND_OPR;
OPND_VAL [.STACK_DEPTH] = .RLDD_PTR;
STACK_DEPTH = .STACK_DEPTH + 1;
END;
END;
[%O'4'] :
BEGIN !DIVIDE
IF (DEBUG GEQ 1)
THEN
BEGIN !DEBUG
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'DIV OPERATOR'));
END; !DEBUG
RLDD_PTR = M_RLDD (RLD_OP_DIV, .OPND_TYPE [.STACK_DEPTH - 2],
.OPND_TYPE [.STACK_DEPTH - 1], .OPND_VAL [.STACK_DEPTH - 2],
.OPND_VAL [.STACK_DEPTH - 1]);
IF ((STACK_DEPTH = .STACK_DEPTH - 2) LSS 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN
OPND_TYPE [.STACK_DEPTH] = RLD_OPND_OPR;
OPND_VAL [.STACK_DEPTH] = .RLDD_PTR;
STACK_DEPTH = .STACK_DEPTH + 1;
END;
END;
[%O'5'] :
BEGIN !LOGICAL AND
IF (DEBUG GEQ 1)
THEN
BEGIN !DEBUG
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'AND OPERATOR'));
END; !DEBUG
RLDD_PTR = M_RLDD (RLD_OP_AND, .OPND_TYPE [.STACK_DEPTH - 2],
.OPND_TYPE [.STACK_DEPTH - 1], .OPND_VAL [.STACK_DEPTH - 2],
.OPND_VAL [.STACK_DEPTH - 1]);
IF ((STACK_DEPTH = .STACK_DEPTH - 2) LSS 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN
OPND_TYPE [.STACK_DEPTH] = RLD_OPND_OPR;
OPND_VAL [.STACK_DEPTH] = .RLDD_PTR;
STACK_DEPTH = .STACK_DEPTH + 1;
END;
END;
[%O'6'] :
BEGIN !LOGICAL OR
IF (DEBUG GEQ 1)
THEN
BEGIN !DEBUG
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'OR OPERATOR'));
END; !DEBUG
RLDD_PTR = M_RLDD (RLD_OP_OR, .OPND_TYPE [.STACK_DEPTH - 2],
.OPND_TYPE [.STACK_DEPTH - 1], .OPND_VAL [.STACK_DEPTH - 2],
.OPND_VAL [.STACK_DEPTH - 1]);
IF ((STACK_DEPTH = .STACK_DEPTH - 2) LSS 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN
OPND_TYPE [.STACK_DEPTH] = RLD_OPND_OPR;
OPND_VAL [.STACK_DEPTH] = .RLDD_PTR;
STACK_DEPTH = .STACK_DEPTH + 1;
END;
END;
[%O'10'] :
BEGIN !NEGATION, REPRESENTED AS 0-VALUE
IF (DEBUG GEQ 1)
THEN
BEGIN !DEBUG
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'NEG OPERATOR'));
END; !DEBUG
RLDD_PTR = M_RLDD (RLD_OP_SUB, RLD_OPND_CON, .OPND_TYPE [.STACK_DEPTH - 1], 0,
.OPND_VAL [.STACK_DEPTH - 1]);
IF ((STACK_DEPTH = .STACK_DEPTH - 1) LSS 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN
OPND_TYPE [.STACK_DEPTH] = RLD_OPND_OPR;
OPND_VAL [.STACK_DEPTH] = .RLDD_PTR;
STACK_DEPTH = .STACK_DEPTH + 1;
END;
END;
[%O'11'] :
BEGIN !COMPLEMENT
IF (DEBUG GEQ 1)
THEN
BEGIN !DEBUG
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'COM OPERATOR'));
END; !DEBUG
RLDD_PTR = M_RLDD (RLD_OP_COM, .OPND_TYPE [.STACK_DEPTH - 1], RLD_OPND_OMIT,
.OPND_VAL [.STACK_DEPTH - 1], 0);
IF ((STACK_DEPTH = .STACK_DEPTH - 1) LSS 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN
OPND_TYPE [.STACK_DEPTH] = RLD_OPND_OPR;
OPND_VAL [.STACK_DEPTH] = .RLDD_PTR;
STACK_DEPTH = .STACK_DEPTH + 1;
END;
END;
[%O'12'] :
BEGIN !NORMAL COMMAND TERMINATION
IF (DEBUG GEQ 1)
THEN
BEGIN !DEBUG
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'STORE OPERATOR'));
END; !DEBUG
COMMAND_TERM = 1;
END;
[%O'13'] :
BEGIN !DISPLACED COMMAND TERMINATION
IF (DEBUG GEQ 1)
THEN
BEGIN !DEBUG
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'STORE DISPLACED OPERATOR'));
END; !DEBUG
COMMAND_TERM = 2;
END;
[%O'16'] :
BEGIN !GLOBAL SYMBOL VALUE
R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50TOA (.R50VAL, ASCVAL [0]);
IF (DEBUG GEQ 1)
THEN
BEGIN !DEBUG
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'GLOBAL SYMBOL OPERAND = '));
OUTSTR (1, ASCVAL [0]);
END; !DEBUG
GLOBAL_INFO [0] = ASCVAL [0];
GLOBAL_INFO [1] = 0;
GLOBAL_INFO [2] = 0;
IF ((GLOBL_PTR = FND_CHAIN (.MODU_PTR [MODU_GLOBALS], SEL_GLOBAL, GLOBAL_INFO)) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !THIS GLOBAL HAS BEEN DECLARED IN THIS MODULE
GBL_REF (.GLOBL_PTR, .PSECT_PTR, .MODU_PTR);
OPND_TYPE [.STACK_DEPTH] = RLD_OPND_GLOBAL;
OPND_VAL [.STACK_DEPTH] = .GLOBL_PTR;
IF ((STACK_DEPTH = .STACK_DEPTH + 1) GTR STACK_LIMIT)
THEN
ERRMSG (0, 14,
ROUTINE_NAME, FILE_PTR [FILE_NAME], STACK_LIMIT, 0, 0);
END;
END;
[%O'17'] :
BEGIN !RELOCATABLE VALUE
IF (DEBUG GEQ 1)
THEN
BEGIN !DEBUG
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'RELOCATABLE VALUE, OPERANDS = '));
END; !DEBUG
SECTOR = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR);
OFFSET = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
IF (DEBUG GEQ 1)
THEN
BEGIN !DEBUG
OUTNUM (1, .SECTOR, 10, 0);
OUTSTR (1, UPLIT (%ASCIZ', '));
OUTNUM (1, .OFFSET, 8, 0);
END; !DEBUG
IF ((PSECT_PTR1 = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_SECTOR, .SECTOR)) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN !THIS PSECT HAS BEEN DECLARED IN THIS MODULE
OPND_TYPE [.STACK_DEPTH] = RLD_OPND_OPR;
OPND_VAL [.STACK_DEPTH] = M_RLDD (RLD_OP_ADD, RLD_OPND_PSECT, RLD_OPND_CON,
.PSECT_PTR1, .PSECT_PTR1 [PSECT_OFFSET] + .OFFSET);
IF ((STACK_DEPTH = .STACK_DEPTH + 1) GTR STACK_LIMIT)
THEN
ERRMSG (0, 14,
ROUTINE_NAME, FILE_PTR [FILE_NAME], STACK_LIMIT, 0, 0);
END;
END;
[%O'20'] :
BEGIN !CONSTANT
IF (DEBUG GEQ 1)
THEN
BEGIN !DEBUG
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'CONSTANT OPERAND, VALUE ='));
END; !DEBUG
CONSTANT = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
IF (DEBUG GEQ 1)
THEN
BEGIN !DEBUG
OUTNUM (1, .CONSTANT, 8, 0);
END; !DEBUG
OPND_TYPE [.STACK_DEPTH] = RLD_OPND_CON;
OPND_VAL [.STACK_DEPTH] = .CONSTANT;
STACK_DEPTH = .STACK_DEPTH + 1;
END;
[%O'21'] :
BEGIN !RESIDENT LIBRARY BASE
IF (DEBUG GEQ 1)
THEN
BEGIN !DEBUG
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'RESIDENT LIBRARY BASE OPERAND'));
END; !DEBUG
ERRMSG (0, 12, ROUTINE_NAME, 0, 0, 0, 0);
END;
[INRANGE] :
BEGIN !UNUSED VALUE
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
END;
[OUTRANGE] :
BEGIN !OUT OF VALID RANGE
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
END;
TES;
END; !OF ITERATION ON PICKING UP OPERATORS AND OPERANDS
!
! THERE SHOULD NOW BE ONE ITEM IN THE STACK, THE VALUE TO
! STORE.
!
IF (.STACK_DEPTH NEQ 1) THEN ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
IF ((RLDH_PTR = M_RLDH (.MODIF, .DISP, .PSECT_PTR, .MODU_PTR [MODU_LC])) EQL 0)
THEN
ERRMSG (0,
1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
TEMP_RLDH_VAL = (IF ((.COMMAND_TERM EQL 1) AND (.OPND_TYPE [.STACK_DEPTH - 1] EQL RLD_OPND_OPR
)) THEN
!
! THIS, THE USUAL CASE, CAN BE HANDLED WITHOUT CREATING ANOTHER
! RLDD BLOCK.
!
.OPND_VAL [.STACK_DEPTH - 1] ELSE M_RLDD (RLD_OP_SUB, .OPND_TYPE [.STACK_DEPTH - 1],
(IF (.COMMAND_TERM EQL 1) THEN RLD_OPND_CON ELSE RLD_OPND_OPR),
.OPND_VAL [.STACK_DEPTH - 1],
(IF (.COMMAND_TERM EQL 1) THEN 0 ELSE M_RLDD (RLD_OP_ADD, RLD_OPND_CON,
RLD_OPND_PSECT, .RLDH_PTR [RLDH_ADDR] + 2, .PSECT_PTR))));
RLDH_PTR [RLDH_VALUE] = .TEMP_RLDH_VAL;
STACK_DEPTH = .STACK_DEPTH - 1;
PSECT_PTR [PSECT_RLD] = BLD_CHAIN (.PSECT_PTR, .PSECT_PTR [PSECT_RLD], .RLDH_PTR);
END;
END;
END;
END; !OF R_CR
ROUTINE R_LR (MODIF, DISP, BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !RLD LIBRARY RELOCATION
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE LIBRARY RELOCATION ENTRY OF THE RLD RECORD.
! THIS IS NOT IMPLEMENTED.
!
! FORMAL PARAMETERS:
!
! MODIF - 0 = MODIFIES WORD, 1 = MODIFIES BYTE
! DISP - DISPLACEMENT INTO TEXT RECORD
! BYTEPTR - POINTER TO FIRST INFO BYTE (USING CH$A_RCHAR)
! BYTECTR - COUNT OF BYTES LEFT IN THE RLD RECORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! INFO BYTES FROM THE RLD RECORD
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'R_LR');
LOCAL
CONSTANT;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'LIBRARY RELOCATION, MODIF = '));
OUTNUM (1, .MODIF, 2, 0);
OUTSTR (1, UPLIT (%ASCIZ', DISP = '));
OUTNUM (1, .DISP, 8, 0);
END; !DEBUG
CONSTANT = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
IF (DEBUG GEQ 1)
THEN
BEGIN
OUTSTR (1, UPLIT (%ASCIZ', CONSTANT = '));
OUTNUM (1, .CONSTANT, 8, 0);
END; !DEBUG
ERRMSG (0, 12, ROUTINE_NAME, 0, 0, 0, 0);
END; !OF R_LR
!
END
ELUDOM
! Local Modes:
! Comment Column:36
! Comment Start:!
! Mode:Fundamental
! Auto Save Mode:2
! End: