Trailing-Edge
-
PDP-10 Archives
-
BB-X117B-SB_1986
-
10,7/vnp36/rstb.bli
There are 2 other files named rstb.bli in the archive. Click here to see a list.
!<REL4A.TKB-VNP>RSTB.BLI.3, 3-Dec-79 14:59:04, Edit by SROBINSON
MODULE RSTB ( !READ SYMBOL TABLE
IDENT = 'X2.0'
) =
BEGIN
!
!
!
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1980,1981,1982,1986. ALL RIGHTS RESERVED.
!
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
!AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!
!++
! FACILITY: VNP-20
!
! ABSTRACT:
!
!
! THIS MODULE READS A SYMBOL TABLE, EITHER FOR THE KERNEL OR
! FOR A TASK.
!
!
! ENVIRONMENT: TOPS-20 USER MODE
!
! AUTHOR: J. SAUTER, CREATION DATE: 31-MAY-78
!
! MODIFIED BY:
!
! Scott G. Robinson, 3-DEC-79 : Version X2.0
! - Ensure DECnet-10 Compatibility
!
!
! , : VERSION
! 01 -
!--
!<BLF/PAGE>
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
RD16, !READ A 16-BIT WORD
RDLBBL, !READ AN OBJECT BLOCK (NON-DOS FMT)
RSTB : NOVALUE, !READ SYMBOL TABLE
GET_BYTE, !GET AN 8-BIT BYTE FROM FILE
GET_WORD, !GET A 16-BIT WORD FROM FILE
OBJ_GSD : NOVALUE, !PROCESS GSD OBJECT ENTRY
OBJ_END_GSD : NOVALUE, !END OF GSD ENTRIES
OBJ_EOM : NOVALUE, !END OF MODULE
GSD_MNAME : NOVALUE, !MODULE NAME
GSD_CNAME : NOVALUE, !CSECT NAME (INVALID)
GSD_ISN : NOVALUE, !INTERNAL SYMBOL NAME (INVALID)
GSD_TRA : NOVALUE, !TRANSFER ADDRESS
SEL_GLOBAL, !FIND A GLOBAL SYMBOL
GSD_GSN : NOVALUE, !GLOBAL SYMBOL
SEL_PSECT, !FIND A PSECT
GSD_PSN : NOVALUE, !PSECT
GSD_IDENT : NOVALUE, !MODULE IDENTIFICATION
GSD_MAP : NOVALUE, !MAPPED ARRAY (INVALID)
OBJ_ISD : NOVALUE, !INTERNAL SYMBOL (INVALID)
SYM_VAL, !RETURN VALUE OF A SYMBOL
SEL_SYMBOL, !FIND A SYMBOL BY NAME
GBL_VAL; !RETURN VALUE OF A GLOBAL
!
! INCLUDE FILES:
!
LIBRARY 'VNPLIB';
!REQUIRE 'BLOCKH.REQ'; !PREPARE TO DEFINE STORAGE BLOCKS
!REQUIRE 'FILE.REQ'; !DEFINE FILE BLOCK
!REQUIRE 'FILSW.REQ'; !DEFINE FILE SWITCHES
!REQUIRE 'GLOBL.REQ'; !DEFINE GLOBAL BLOCK
!REQUIRE 'MODU.REQ'; !DEFINE MODULE BLOCK
!REQUIRE 'PSECT.REQ'; !DEFINE PSECT BLOCK
!REQUIRE 'BLOCKT.REQ'; !END OF DEFINING STORAGE BLOCKS
!
! MACROS:
!
! NONE
!
! EQUATED SYMBOLS:
!
LITERAL
DEBUG = 0;
!
! OWN STORAGE:
!
! NONE
!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
OPEN, !OPEN A FILE
CLOSE : NOVALUE, !CLOSE A FILE
INPUT, !READ FROM A FILE
OUTPUT : NOVALUE, !OUTPUT TO A FILE
ERROR : NOVALUE, !SIGNAL PROGRAMMING ERROR
ERRMSG : NOVALUE, !ERROR MESSAGE
GETSTG, !GET STORAGE
FRESTG : NOVALUE, !FREE STORAGE
PCRLF : NOVALUE, !PRINT CRLF
OUTNUM : NOVALUE, !PRINT A NUMBER
OUTSTR : NOVALUE, !PRINT A STRING
R50TOA : NOVALUE, !CONVERT RADIX50 TO ASCII
GETBLK, !GET A STORAGE BLOCK
BLD_CHAIN, !BUILD ONTO A CHAIN
FND_CHAIN; !FIND AN ITEM IN A CHAIN
ROUTINE RD16 (CHAN, CHKSUM) = !READ A 16-BIT WORD
!++
! FUNCTIONAL DESCRIPTION:
!
! READ A 16-BIT WORD, ASSEMBLING IT FROM THE 8-BIT
! INPUT STREAM. MAINTAIN THE CHECKSUM.
!
! FORMAL PARAMETERS:
!
! CHAN - THE CHANNEL OVER WHICH TO READ THE 8-BIT BYTES
! CHKSUM - ADDRESS OF THE CHECKSUM CELL
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! THE VALUE OF THE 16-BIT WORD READ, OR -1 IF WE REACHED
! END OF FILE ON INPUT.
!
! SIDE EFFECTS
!
! READS FROM THE INPUT FILE. MAY REACH EOF.
!
!--
BEGIN
LOCAL
BYTE1,
BYTE2,
RESULT;
IF ((BYTE1 = INPUT (.CHAN)) LSS 0)
THEN
.BYTE1
ELSE
BEGIN
.CHKSUM = ..CHKSUM + .BYTE1;
IF ((BYTE2 = INPUT (.CHAN)) LSS 0)
THEN
.BYTE2
ELSE
BEGIN
.CHKSUM = ..CHKSUM + .BYTE2;
RESULT = 0;
RESULT<8, 8> = .BYTE2; !HIGH-ORDER BYTE
RESULT<0, 8> = .BYTE1; !LOW-ORDER BYTE
.RESULT
END
END
END;
!
ROUTINE RDLBBL (CHAN, FILE_PTR, BYTES_READ) = !READ A LIBRARY BLOCK
!++
! FUNCTIONAL DESCRIPTION:
!
! READ A BLOCK OF DATA FROM THE LIBRARY FILE. THIS BLOCK
! STARTS WITH A COUNT WORD FOLLOWED BY "COUNT" DATA WORDS.
! THE DATA WORDS COMPRISE OBJECT TEXT WHICH MAY CONTAIN
! SEVERAL RECORDS.
! THIS FORMAT IS ALSO USED FOR OBJECT FILES WITHOUT THE "DOS"
! SWITCH.
!
! FORMAL PARAMETERS:
!
! CHAN - THE CHANNEL OVER WHICH TO READ DATA. IT MUST HAVE
! BEEN OPENED IN WORD MODE.
! FILE_PTR - POINTER TO THE FILE BLOCK FOR
! ERROR MESSAGES.
! BYTES_READ - SET TO THE NUMBER OF BYTES READ FROM THE INPUT
! CHANNEL.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! A POINTER TO A VECTOR. THE FIRST WORD OF THE VECTOR HAS
! ITS LENGTH IN WORDS. THE SECOND HAS THE LENGTH OF DATA IN
! BYTES. SUBSEQUENT WORDS ARE THE DATA READ, SUITABLE
! FOR SCANNING 8 BITS AT A TIME USING CH$A_RCHAR. IT IS
! THE CALLER'S RESPONSIBILITY TO FREE THIS VECTOR BY CALLING
! FRESTG.
! IF WE REACH EOF, -1 IS RETURNED. IF STORAGE IS NOT AVAILABLE,
! 0 IS RETURNED. AN INVALID FORMAT ALSO RETURNS -1.
!
! SIDE EFFECTS
!
! READS DATA FROM THE INPUT CHANNEL. MAY GET EOF.
! OBTAINS STORAGE FROM THE FREE LIST.
! WILL RETURN IT ON ERROR.
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'READ_LIBRARY_BLOCK');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
BLKPTR,
BYTE1,
CHKSUM,
COUNT,
OUTLEN,
RESULT : REF VECTOR;
RESULT = 0;
.BYTES_READ = 0;
OUTLEN = 0;
WHILE (.OUTLEN EQL 0) DO
BEGIN
OUTLEN = RD16 (.CHAN, CHKSUM);
.BYTES_READ = ..BYTES_READ + 2;
END;
IF ((.OUTLEN LSS 2) OR (.OUTLEN GTR 128))
THEN
BEGIN
IF (.OUTLEN NEQ -1) THEN ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
RESULT = -1;
END
ELSE
BEGIN
IF ((RESULT = GETSTG ((((.OUTLEN)/4) + 3))) LEQ 0)
THEN
BEGIN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0);
END
ELSE
BEGIN
RESULT [0] = (((.OUTLEN)/4) + 3); !AMOUNT TO FREE
RESULT [1] = .OUTLEN; !NUMBER OF BYTES
BLKPTR = CH$PTR (RESULT [2], -1, 8);
COUNT = 0;
WHILE (((COUNT = .COUNT + 1) LEQ .OUTLEN) AND (.BYTE1 GEQ 0)) DO
BEGIN
BYTE1 = INPUT (.CHAN);
.BYTES_READ = ..BYTES_READ + 1;
IF (.BYTE1 GEQ 0) THEN CH$A_WCHAR (.BYTE1, BLKPTR);
END;
IF (.BYTE1 LSS 0)
THEN
BEGIN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
FRESTG (.RESULT, .RESULT [0]);
RESULT = -1;
END;
END;
END;
.RESULT
END; !OF RDLBBL
GLOBAL ROUTINE RSTB (FILE_CHAN, FILE_PTR) : NOVALUE = !READ SYMBOL TABLE
!++
! FUNCTIONAL DESCRIPTION:
!
! READ A SYMBOL TABLE FOR A TASK OR SYSTEM IMAGE
!
! FORMAL PARAMETERS:
!
! FILE_CHAN - THE CHANNEL NUMBER TO USE WHEN READING THE FILE.
! FILE_PTR - POINTER TO THE FILE BLOCK WHICH DESCRIBES
! THE SYMBOL TABLE FILE TO BE READ
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! GETS SPACE FROM FREE STORAGE TO HOLD THE SYMBOLS
!
! ROUTINE VALUE:
!
! POINTER TO THE CHAIN BLOCK WHICH POINTS TO THE SYMBOLS
!
! SIDE EFFECTS
!
! READS THE SYMBOL TABLE FILE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'READ_SYMBOL_TABLE');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
ASCVAL : VECTOR [CH$ALLOCATION (LEN_PSECT_NAME)],
BLKPTR : REF VECTOR,
BYTECTR,
BYTEPTR,
BYTES_READ,
CHAR,
COUNTER,
POINTER,
PREV_CHAR : VECTOR [3],
R50VAL,
READ_DONE,
RECORD_TYPE;
IF (OPEN (.FILE_CHAN, FILE_PTR [FILE_NAME], 2, 0, UPLIT (%ASCIZ'STB')) NEQ 0)
THEN
BEGIN !SUCCESSFUL INPUT OPEN
READ_DONE = 0;
DO
BEGIN
BLKPTR = RDLBBL (.FILE_CHAN, .FILE_PTR, BYTES_READ);
IF (.BLKPTR LEQ 0)
THEN
BEGIN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
READ_DONE = -1;
END
ELSE
BEGIN
BYTEPTR = CH$PTR (BLKPTR [2], -1, 8);
BYTECTR = .BLKPTR [1];
IF (DEBUG GEQ 2)
THEN
BEGIN
PCRLF (1);
OUTNUM (1, .BYTECTR, 10, 0);
COUNTER = .BYTECTR;
POINTER = .BYTEPTR;
PREV_CHAR [0] = 0;
PREV_CHAR [1] = 0;
PREV_CHAR [2] = 0;
R50VAL = 0;
WHILE ((COUNTER = .COUNTER - 1) GEQ 0) DO
BEGIN
CHAR = CH$A_RCHAR (POINTER);
PCRLF (1);
OUTSTR (1, UPLIT (%ASCIZ' '));
OUTNUM (1, .CHAR, 8, 0);
OUTPUT (1, %O'11');
R50VAL<24, 8> = .PREV_CHAR [1];
R50VAL<16, 8> = .PREV_CHAR [0];
R50VAL<8, 8> = .CHAR;
R50VAL<0, 8> = .PREV_CHAR [2];
R50TOA (.R50VAL, ASCVAL [0]);
OUTSTR (1, ASCVAL [0]);
PREV_CHAR [0] = .PREV_CHAR [1];
PREV_CHAR [1] = .PREV_CHAR [2];
PREV_CHAR [2] = .CHAR;
END;
END; !DEBUG
RECORD_TYPE = GET_BYTE (BYTEPTR, BYTECTR, .FILE_PTR);
CASE .RECORD_TYPE FROM 1 TO 6 OF
SET
[1] :
OBJ_GSD (BYTEPTR, BYTECTR, .FILE_PTR); !GSD
[2] :
OBJ_END_GSD (BYTEPTR, BYTECTR, .FILE_PTR); !END OF GSD
[5] :
OBJ_ISD (BYTEPTR, BYTECTR, .FILE_PTR); !INTERNAL SYMBOL DIRECTORY
[6] :
BEGIN
OBJ_EOM (BYTEPTR, BYTECTR, .FILE_PTR); !END OF MODULE
READ_DONE = -1;
END;
[3, 4, OUTRANGE] :
BEGIN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
READ_DONE = -1;
END;
TES;
FRESTG (.BLKPTR, .BLKPTR [0]);
END
END
UNTIL (.READ_DONE NEQ 0);
CLOSE (.FILE_CHAN);
END; !OF SUCCESSFUL INPUT OPEN
END; !OF READ_FILE
ROUTINE GET_BYTE (BYTEPTR, BYTECTR, FILE_PTR) = !GET BYTE
!++
! FUNCTIONAL DESCRIPTION:
!
! FETCH A BYTE FROM THE OBJECT RECORD. MAINTAIN
! THE COUNTER AND GIVE AN ERROR MESSAGE IF IT RUNS OUT.
!
! FORMAL PARAMETERS:
!
! BYTEPTR - POINTER TO THE BYTE POINTER
! BYTECTR - POINTER TO THE COUNTER CELL
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE FILE
! BEING READ, FOR ERROR MESSAGES.
!
! IMPLICIT INPUTS:
!
! THE OBJECT RECORD POINTED TO
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! THE VALUE OF THE BYTE, OR -1 IF WE RAN OFF THE END.
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GET_BYTE');
MAP
FILE_PTR : REF FILE_BLOCK;
IF (..BYTECTR GTR 0)
THEN
BEGIN
.BYTECTR = ..BYTECTR - 1;
CH$A_RCHAR (.BYTEPTR)
END
ELSE
BEGIN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
-1
END
END; !OF GET_BYTE
ROUTINE GET_WORD (BYTEPTR, BYTECTR, FILE_PTR) = !GET WORD
!++
! FUNCTIONAL DESCRIPTION:
!
! FETCH A WORD FROM THE OBJECT RECORD. MAINTAIN
! THE COUNTER AND GIVE AN ERROR MESSAGE IF IT RUNS OUT.
!
! FORMAL PARAMETERS:
!
! BYTEPTR - POINTER TO THE BYTE POINTER
! BYTECTR - POINTER TO THE COUNTER CELL
! FILE_PTR - POINTER TO FILE BLOCK FOR ERROR MESSAGES
!
! IMPLICIT INPUTS:
!
! THE OBJECT RECORD POINTED TO
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! THE VALUE OF THE WORD, OR -1 IF WE RAN OFF THE END.
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GET_WORD');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
RESULT;
IF (..BYTECTR GTR 1)
THEN
BEGIN
.BYTECTR = ..BYTECTR - 2;
RESULT = CH$A_RCHAR (.BYTEPTR);
RESULT<8, 8> = CH$A_RCHAR (.BYTEPTR);
.RESULT
END
ELSE
BEGIN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
-1
END
END; !OF GET_WORD
ROUTINE OBJ_GSD (BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !PROCESS GSD RECORD
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS A GLOBAL SYMBOL DIRECTORY ENTRY IN THE OBJECT
! FILE. THIS IS DONE BY FETCHING THE PARAMETERS AND THEN
! TO A SUBROUTINE TO HANDLE THE ENTRY TYPE.
!
! FORMAL PARAMETERS:
!
! BYTEPTR - POINTER TO THE BYTE POINTER
! BYTECTR - POINTER TO THE COUNTER CELL
! FILE_PTR - POINTER TO THE FILE BLOCK OF THE OBJECT
! FILE BEING READ. THIS IS FOR ERROR MESSAGES AND TO
! POINT TO THE DATA READ.
!
! IMPLICIT INPUTS:
!
! THE OBJECT RECORD POINTED TO
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! IN MANY CASES, THE HANDLERS FOR THE ENTRY TYPES WILL
! OBTAIN SPACE FROM THE FREE STORAGE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'OBJ_GSD');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
MODU_PTR : REF MODU_BLOCK,
CHAR,
R50VAL,
ASCVAL : VECTOR [CH$ALLOCATION (LEN_PSECT_NAME)],
FLAGS,
ETYPE,
VALUE;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'GSD RECORD, LENGTH = '));
OUTNUM (1, ..BYTECTR, 10, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) NEQ 0)
THEN
BEGIN
IF ((.MODU_PTR [MODU_FLAG_EGSD] NEQ 0) AND (.MODU_PTR [MODU_FLAG_ENDED] NEQ 0))
THEN
ERRMSG (0, 10,
ROUTINE_NAME, 0, 0, 0, 0);
END;
CHAR = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR); !UNUSED BYTE
DO
BEGIN
R50VAL = 0;
R50VAL<16, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50VAL<0, 16> = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
R50TOA (.R50VAL, ASCVAL [0]);
FLAGS = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR);
ETYPE = GET_BYTE (.BYTEPTR, .BYTECTR, .FILE_PTR);
VALUE = GET_WORD (.BYTEPTR, .BYTECTR, .FILE_PTR);
CASE .ETYPE FROM 0 TO 7 OF
SET
[0] :
GSD_MNAME (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);
[1] :
GSD_CNAME (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);
[2] :
GSD_ISN (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);
[3] :
GSD_TRA (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);
[4] :
GSD_GSN (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);
[5] :
GSD_PSN (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);
[6] :
GSD_IDENT (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);
[7] :
GSD_MAP (ASCVAL [0], .FLAGS, .VALUE, .FILE_PTR);
[OUTRANGE] :
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
TES;
END
UNTIL (..BYTECTR EQL 0);
END; !OF OBJ_GSD
ROUTINE OBJ_END_GSD (BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !PROCESS END GSD RECORD
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE END GSD RECORD.
!
! FORMAL PARAMETERS:
!
! BYTEPTR - POINTER TO THE BYTE POINTER
! BYTECTR - POINTER TO THE COUNTER CELL
! FILE_PTR - POINTER TO FILE BLOCK
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! SETS A FLAG WHICH FORBIDS ANY MORE GSD RECORDS IN
! THIS MODULE.
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'OBJ_END_GSD');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
MODU_PTR : REF MODU_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'END GSD RECORD, LENGTH = '));
OUTNUM (1, ..BYTECTR, 10, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN
IF (.MODU_PTR [MODU_FLAG_EGSD] NEQ 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN
MODU_PTR [MODU_FLAG_EGSD] = 1;
END;
END;
END; !OF OBJ_END_GSD
ROUTINE OBJ_ISD (BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !PROCESS ISD RECORD
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS INTERNAL SYMBOL DIRECTORY RECORD.
!
! FORMAL PARAMETERS:
!
! BYTEPTR - POINTER TO THE BYTE POINTER
! BYTECTR - POINTER TO THE COUNTER CELL
! FILE_PTR - POINTER TO OBJECT FILE BLOCK
!
! IMPLICIT INPUTS:
!
! THE OBJECT RECORD POINTED TO
!
! IMPLICIT OUTPUTS:
!
! ADDS THE INTERNAL SYMBOLS TO THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'OBJ_ISD');
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'INTERNAL SYMBOL DIRECTORY RECORD, LENGTH = '));
OUTNUM (1, ..BYTECTR, 10, 0);
END; !DEBUG
ERRMSG (0, 12, ROUTINE_NAME, 0, 0, 0, 0);
END; !OF OBJ_ISD
ROUTINE OBJ_EOM (BYTEPTR, BYTECTR, FILE_PTR) : NOVALUE = !PROCESS END OF MODULE RECORD
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE END MODULE RECORD.
!
! FORMAL PARAMETERS:
!
! BYTEPTR - POINTER TO THE BYTE POINTER
! BYTECTR - POINTER TO THE COUNTER CELL
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! THE OBJECT RECORD POINTED TO
!
! IMPLICIT OUTPUTS:
!
! SETS A FLAG TO INDICATE THAT WE ARE BETWEEN MODULES.
! AN EOF IS OK IN THIS CONTEXT.
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'OBJ_EOM');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
MODU_PTR : REF MODU_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'END OF MODULE RECORD, LENGTH = '));
OUTNUM (1, ..BYTECTR, 10, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN
IF ((.MODU_PTR [MODU_FLAG_EGSD] EQL 0) OR (.MODU_PTR [MODU_FLAG_ENDED] NEQ 0))
THEN
ERRMSG (0, 10,
ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
MODU_PTR [MODU_FLAG_ENDED] = 1;
END;
END; !OF OBJ_EOM
ROUTINE GSD_MNAME (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = !PROCESS MODULE NAME ENTRY
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE MODULE NAME ENTRY OF THE GSD RECORD
!
! FORMAL PARAMETERS:
!
! ASCPTR - POINTER TO NAME, IN ASCII
! FLAGS - THE FLAGS BYTE
! VALUE - THE VALUE WORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! ADDS THE MODULE NAME TO THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS SPACE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GSD_MNAME');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
MODU_PTR : REF MODU_BLOCK,
FILE_ERROR;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'MODULE NAME, NAME = '));
OUTSTR (1, .ASCPTR);
OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
OUTNUM (1, .FLAGS, 8, 0);
OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
OUTNUM (1, .VALUE, 8, 0);
END; !DEBUG
!
FILE_ERROR = 0;
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) NEQ 0)
THEN
BEGIN
IF (.MODU_PTR [MODU_FLAG_ENDED] EQL 0)
THEN
BEGIN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
FILE_ERROR = -1;
END
ELSE
BEGIN
ERRMSG (0, 23, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
FILE_ERROR = -1;
END;
END;
IF (.FILE_ERROR EQL 0)
THEN
BEGIN !THERE IS NOT ALREADY A MODULE BEING PROCESSED
IF ((MODU_PTR = GETBLK (MODU_TYP, MODU_LEN)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN !WE HAVE STORAGE FOR THE MODULE NAME
IF ((FILE_PTR [FILE_DOWN] = BLD_CHAIN (.FILE_PTR, .FILE_PTR [FILE_DOWN], .MODU_PTR)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN !WE HAVE STORAGE FOR THE CHAIN BLOCK
CH$MOVE (LEN_MODU_NAME, CH$PTR (.ASCPTR), CH$PTR (MODU_PTR [MODU_NAME]));
FILE_PTR [FILE_MODU] = .MODU_PTR;
MODU_PTR [MODU_OBJ_FILE] = .FILE_PTR;
MODU_PTR [MODU_SECTOR] = 0;
END;
END;
END;
END; !OF GSD_MNAME
ROUTINE GSD_CNAME (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = !PROCESS CSECT NAME ENTRY
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE CSECT NAME ENTRY OF THE GSD RECORD
! THIS IS IMPLEMENTED BY CONVERTING THE CSECT INTO
! AN APPROPRIATE PSECT.
!
! FORMAL PARAMETERS:
!
! ASCPTR - POINTER TO NAME, IN ASCII
! FLAGS - THE FLAGS BYTE
! VALUE - THE VALUE WORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! CALLS GSD_PNAME
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GSD_CNAME');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
MODU_PTR : REF MODU_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'CSECT NAME, NAME = '));
OUTSTR (1, .ASCPTR);
OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
OUTNUM (1, .FLAGS, 8, 0);
OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
OUTNUM (1, .VALUE, 8, 0);
END; !DEBUG
!
! TURN THE CSECT NAME ENTRY INTO A PSECT BY CALLING GSD_PNAME WITH
! THE APPROPRIATE ARGUMENTS.
!
IF (CH$EQL (LEN_PSECT_NAME, CH$PTR (.ASCPTR), LEN_PSECT_NAME,
CH$PTR (UPLIT (%ASCIZ' '
))))
THEN
BEGIN !BLANK CSECT, MAKE LOCAL PSECT
GSD_PSN (.ASCPTR, (1^PSECT_FLG_REL), .VALUE, .FILE_PTR);
END
ELSE
IF (CH$EQL (LEN_PSECT_NAME, CH$PTR (.ASCPTR), LEN_PSECT_NAME,
CH$PTR (UPLIT (%ASCIZ'. ABS.'
))))
THEN
BEGIN !ASECT, MAKE AN ABSOLUTE PSECT
GSD_PSN (UPLIT (%ASCIZ'. ABS.'), ((1^PSECT_FLG_GBL) + (1^PSECT_FLG_OVR)), .VALUE, .FILE_PTR);
END
ELSE
BEGIN !NAMED CSECT, MAKE A GLOBAL PSECT
GSD_PSN (.ASCPTR, ((1^PSECT_FLG_GBL) + (1^PSECT_FLG_REL) + (1^PSECT_FLG_OVR)), .VALUE, .FILE_PTR);
END;
END; !OF GSD_CNAME
ROUTINE GSD_ISN (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = !PROCESS INTERNAL SYMBOL NAME ENTRY
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE INTERNAL SYMBOL NAME ENTRY OF THE GSD RECORD.
! THIS IS NOT IMPLEMENTED SINCE MACY11 DOES NOT PRODUCE
! THESE RECORDS.
!
! FORMAL PARAMETERS:
!
! ASCPTR - POINTER TO NAME, IN ASCII
! FLAGS - THE FLAGS BYTE
! VALUE - THE VALUE WORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! PRINTS AN ERROR MESSAGE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GSD_ISN');
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'INTERNAL SYMBOL NAME, NAME = '));
OUTSTR (1, .ASCPTR);
OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
OUTNUM (1, .FLAGS, 8, 0);
OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
OUTNUM (1, .VALUE, 8, 0);
END; !DEBUG
ERRMSG (0, 12, ROUTINE_NAME, 0, 0, 0, 0);
END; !OF GSD_ISN
ROUTINE GSD_TRA (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = !PROCESS TRANSFER ADDRESS ENTRY
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE TRANSFER ADDRESS ENTRY OF THE GSD RECORD
!
! FORMAL PARAMETERS:
!
! ASCPTR - POINTER TO NAME, IN ASCII
! FLAGS - THE FLAGS BYTE
! VALUE - THE VALUE WORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! STORES THE TRANSFER ADDRESS IN THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GSD_TRA');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
MODU_PTR : REF MODU_BLOCK,
PSECT_PTR : REF PSECT_BLOCK,
PSECT_INFO : VECTOR [3];
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'TRANSFER ADDRESS, NAME = '));
OUTSTR (1, .ASCPTR);
OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
OUTNUM (1, .FLAGS, 8, 0);
OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
OUTNUM (1, .VALUE, 8, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
PSECT_INFO [0] = .ASCPTR;
PSECT_INFO [1] = 0;
PSECT_INFO [2] = 0;
PSECT_PTR = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_PSECT, PSECT_INFO);
IF (.PSECT_PTR EQL 0)
THEN
MODU_PTR [MODU_XFR_OFFSET] = .VALUE
ELSE
BEGIN
MODU_PTR [MODU_XFR_PSECT] = .PSECT_PTR;
MODU_PTR [MODU_XFR_OFFSET] = .VALUE + .PSECT_PTR [PSECT_OFFSET];
END;
END;
END; !OF GSD_TRA
ROUTINE SEL_GLOBAL (GLOBAL_PTR, GLOBAL_INFO) = !SELECT PROPER GLOBAL
!++
! FUNCTIONAL DESCRIPTION:
!
! SELECT THE GLOBAL DESCRIBED FROM THE LIST OF ALL GLOBALS.
! USED IN A CALL TO FND_CHAIN.
!
! FORMAL PARAMETERS:
!
! GLOBAL_PTR - POINTER TO GLOBAL TO TEST FOR SUITABILITY
! GLOBAL_INFO - INFORMATION ABOUT THE GLOBAL WE ARE LOOKING FOR
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! POINTER TO THE GLOBAL, OR 0.
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
MAP
GLOBAL_PTR : REF GLOBL_BLOCK,
GLOBAL_INFO : REF VECTOR [3];
!
! THE GLOBAL_INFO VECTOR CONTAINS:
!
! 0: POINTER TO THE GLOBAL NAME, IN ASCII
! 1: THE GLOBAL FLAGS
! 2: THE "VALUE" WORD FROM THE GLOBAL
!
IF (CH$NEQ (LEN_GBL_NAME, CH$PTR (.GLOBAL_INFO [0]), LEN_GBL_NAME, CH$PTR (GLOBAL_PTR [GBL_NAME])))
THEN
0
ELSE
.GLOBAL_PTR
END; !OF SEL_GLOBAL
ROUTINE GSD_GSN (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = !PROCESS GLOBAL SYMBOL NAME
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE GLOBAL SYMBOL NAME ENTRY OF THE GSD RECORD
!
! FORMAL PARAMETERS:
!
! ASCPTR - POINTER TO NAME, IN ASCII
! FLAGS - THE FLAGS BYTE
! VALUE - THE VALUE WORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! ADDS THE GLOBAL SYMBOL TO THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS SPACE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GSD_GSN');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
GLOBL_PTR : REF GLOBL_BLOCK,
GLOBAL_INFO : VECTOR [3],
MODU_PTR : REF MODU_BLOCK,
MODU_PTR1 : REF MODU_BLOCK,
PSECT_PTR : REF PSECT_BLOCK,
TEMP_FLAGS;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'GLOBAL SYMBOL NAME, NAME = '));
OUTSTR (1, .ASCPTR);
OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
OUTNUM (1, .FLAGS, 8, 0);
OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
OUTNUM (1, .VALUE, 8, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN !WE ARE PROCESSING A MODULE
PSECT_PTR = .MODU_PTR [MODU_PSECT];
GLOBAL_INFO [0] = .ASCPTR;
GLOBAL_INFO [1] = .FLAGS;
GLOBAL_INFO [2] = .VALUE;
!
! BE SURE THE GLOBAL IS NOT ALREADY CHAINED TO THE CURRENT MODULE.
!
GLOBL_PTR = FND_CHAIN (.MODU_PTR [MODU_GLOBALS], SEL_GLOBAL, GLOBAL_INFO);
IF (.GLOBL_PTR NEQ 0)
THEN
BEGIN !ALREADY CHAINED
MODU_PTR1 = .GLOBL_PTR [GBL_DEF_MODU];
TEMP_FLAGS = .GLOBL_PTR [GBL_FLAGS];
ERRMSG (0, 13, GLOBL_PTR [GBL_NAME], MODU_PTR1 [MODU_NAME], !
.GLOBL_PTR [GBL_VALUE] + !
(IF (.TEMP_FLAGS<GBL_FLG_REL, 1> EQL 0) THEN 0 ELSE %O'200000'), !
MODU_PTR [MODU_NAME], !
.VALUE + (IF (.FLAGS<GBL_FLG_REL, 1> EQL 0) THEN 0 ELSE %O'200000'));
END
ELSE
BEGIN !NO PREVIOUS REFERENCE TO THIS SYMBOL
IF ((GLOBL_PTR = GETBLK (GLOBL_TYP, GLOBL_LEN)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0,
0)
ELSE
BEGIN !WE HAVE STORAGE FOR THE GLOBAL BLOCK
CH$MOVE (LEN_GBL_NAME, CH$PTR (.ASCPTR), CH$PTR (GLOBL_PTR [GBL_NAME]));
GLOBL_PTR [GBL_FLAGS] = .FLAGS;
GLOBL_PTR [GBL_VALUE] = .VALUE;
GLOBL_PTR [GBL_DEF_MODU] = .MODU_PTR;
IF ((MODU_PTR [MODU_GLOBALS] = BLD_CHAIN (.MODU_PTR, .MODU_PTR [MODU_GLOBALS], .GLOBL_PTR))
EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0);
IF (.FLAGS<GBL_FLG_REL, 1> NEQ 0)
THEN
BEGIN
GLOBL_PTR [GBL_DEF_PSECT] = .PSECT_PTR;
GLOBL_PTR [GBL_DEF_OFFSET] = .PSECT_PTR [PSECT_OFFSET];
END;
END;
END;
END;
END; !OF GSD_GSN
ROUTINE SEL_PSECT (PSECT_PTR, PSECT_INFO) = !SELECT PROPER PSECT
!++
! FUNCTIONAL DESCRIPTION:
!
! SELECT THE PSECT DESCRIBED FROM THE LIST OF ALL PSECTS.
! USED IN A CALL TO FND_CHAIN.
!
! FORMAL PARAMETERS:
!
! PSECT_PTR - POINTER TO PSECT TO TEST FOR SUITABILITY
! PSECT_INFO - INFORMATION ABOUT THE PSECT WE ARE LOOKING FOR
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! POINTER TO THE PSECT, OR 0.
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
MAP
PSECT_PTR : REF PSECT_BLOCK,
PSECT_INFO : REF VECTOR [3];
!
! THE PSECT_INFO VECTOR CONTAINS:
!
! 0: POINTER TO THE PSECT NAME, IN ASCII
! 1: THE PSECT FLAGS
! 2: THE MAXIMUM LENGTH OF THE PSECT
!
IF (CH$NEQ (LEN_PSECT_NAME, CH$PTR (.PSECT_INFO [0]), LEN_PSECT_NAME, CH$PTR (PSECT_PTR [PSECT_NAME])))
THEN
0
ELSE
.PSECT_PTR
END; !OF SEL_PSECT
ROUTINE GSD_PSN (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = !PROCESS PSECT NAME
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE PROGRAM SECTION NAME ENTRY OF THE GSD RECORD
!
! FORMAL PARAMETERS:
!
! ASCPTR - POINTER TO NAME, IN ASCII
! FLAGS - THE FLAGS BYTE
! VALUE - THE VALUE WORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! ADDS THE PSECT NAME TO THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! OBTAINS SPACE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GSD_PSN');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
MODU_PTR : REF MODU_BLOCK,
PSECT_PTR : REF PSECT_BLOCK,
PSECT_INFO : VECTOR [3],
SEARCH_DONE;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'PSECT NAME, NAME = '));
OUTSTR (1, .ASCPTR);
OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
OUTNUM (1, .FLAGS, 8, 0);
OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
OUTNUM (1, .VALUE, 8, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN !WE ARE PROCESSING A MODULE
PSECT_INFO [0] = .ASCPTR;
PSECT_INFO [1] = .FLAGS;
PSECT_INFO [2] = .VALUE;
!
PSECT_PTR = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_PSECT, PSECT_INFO);
IF (.PSECT_PTR EQL 0)
THEN
BEGIN !FIRST REFERENCE TO THIS PSECT BY THIS MODULE
IF ((PSECT_PTR = GETBLK (PSECT_TYP, PSECT_LEN)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0,
0)
ELSE
BEGIN !WE HAVE STORAGE FOR THE PSECT BLOCK
CH$MOVE (LEN_PSECT_NAME, CH$PTR (.ASCPTR), CH$PTR (PSECT_PTR [PSECT_NAME]));
PSECT_PTR [PSECT_FLAGS] = .FLAGS;
PSECT_PTR [PSECT_SIZE] = 0;
PSECT_PTR [PSECT_OFFSET] = 0;
IF ((MODU_PTR [MODU_PSECTS] = BLD_CHAIN (.MODU_PTR, .MODU_PTR [MODU_PSECTS], .PSECT_PTR)) EQL
0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
PSECT_PTR = FND_CHAIN (.MODU_PTR [MODU_PSECTS], SEL_PSECT, PSECT_INFO);
IF (.PSECT_PTR EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
MODU_PTR [MODU_PSECT] = .PSECT_PTR;
PSECT_PTR [PSECT_OFFSET] = (IF (.FLAGS<PSECT_FLG_OVR, 1> NEQ 0) THEN 0 ELSE .PSECT_PTR [
PSECT_SIZE] + (IF ((.PSECT_PTR [PSECT_SIZE] MOD 2) EQL 0) THEN 0 ELSE 1));
PSECT_PTR [PSECT_SIZE] = (IF (.FLAGS<PSECT_FLG_OVR, 1> NEQ 0) THEN MAX (.PSECT_PTR [
PSECT_SIZE], .VALUE) ELSE .PSECT_PTR [PSECT_SIZE] + .VALUE);
PSECT_PTR [PSECT_SECTOR] = .MODU_PTR [MODU_SECTOR];
IF ((MODU_PTR [MODU_SECTOR] = .MODU_PTR [MODU_SECTOR] + 1) GTR 255)
THEN
ERRMSG (0, 10,
ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
END;
END;
END; !OF FIRST REFERENCE TO THIS PSECT BY THIS MODULE
IF (((.PSECT_PTR [PSECT_FLAGS] XOR .FLAGS) AND ((1^PSECT_FLG_HI) OR (1^PSECT_FLG_LIB) OR (1^
PSECT_FLG_OVR) OR (1^PSECT_FLG_RO) OR (1^PSECT_FLG_REL) OR (1^PSECT_FLG_GBL) OR (1^PSECT_FLG_DATA)
)) NEQ 0)
THEN
ERRMSG (0, 15, ROUTINE_NAME, MODU_PTR [MODU_NAME], PSECT_PTR [PSECT_NAME],
.PSECT_PTR [PSECT_FLAGS], .FLAGS);
END; !OF PROCESSING A MODULE
END; !OF GSD_PSN
ROUTINE GSD_IDENT (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = !PROCESS VERSION IDENT
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE PROGRAM VERSION IDENTIFICATION ENTRY OF THE
! GSD RECORD. THIS ENTRY IS PRODUCED BY THE ".IDENT"
! ASSEMBLER DIRECTIVE.
!
! FORMAL PARAMETERS:
!
! ASCPTR - POINTER TO NAME, IN ASCII
! FLAGS - THE FLAGS BYTE
! VALUE - THE VALUE WORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! ADDS THE IDENTIFICATION TO THE DATA STRUCTURE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GSD_IDENT');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
MODU_PTR : REF MODU_BLOCK;
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'PROGRAM VERSION IDENTIFICATION, NAME = '));
OUTSTR (1, .ASCPTR);
OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
OUTNUM (1, .FLAGS, 8, 0);
OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
OUTNUM (1, .VALUE, 8, 0);
END; !DEBUG
IF ((MODU_PTR = .FILE_PTR [FILE_MODU]) EQL 0)
THEN
ERRMSG (0, 10, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN !THERE IS A MODULE BEING PROCESSED
CH$MOVE (LEN_MODU_VER, CH$PTR (.ASCPTR), CH$PTR (MODU_PTR [MODU_IDENT]));
MODU_PTR [MODU_FLAG_IDENT] = 1;
END;
END; !OF GSD_IDENT
ROUTINE GSD_MAP (ASCPTR, FLAGS, VALUE, FILE_PTR) : NOVALUE = !PROCESS MAPPED ARRAY
!++
! FUNCTIONAL DESCRIPTION:
!
! PROCESS THE MAPPED ARRAY ENTRY OF THE GSD RECORD.
! THIS IS NOT IMPLEMENTED SINCE IT IS NOT PRODUCED BY MACY11.
!
! FORMAL PARAMETERS:
!
! ASCPTR - POINTER TO NAME, IN ASCII
! FLAGS - THE FLAGS BYTE
! VALUE - THE VALUE WORD
! FILE_PTR - POINTER TO THE FILE BLOCK FOR THE OBJECT FILE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! PRINTS AN ERROR MESSAGE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'GSD_MAP');
IF (DEBUG GEQ 1)
THEN
BEGIN
PCRLF (1);
OUTPUT (1, %O'11');
OUTPUT (1, %O'11');
OUTSTR (1, UPLIT (%ASCIZ'MAPPED ARRAY DECLARATION, NAME = '));
OUTSTR (1, .ASCPTR);
OUTSTR (1, UPLIT (%ASCIZ', FLAGS = '));
OUTNUM (1, .FLAGS, 8, 0);
OUTSTR (1, UPLIT (%ASCIZ', VALUE = '));
OUTNUM (1, .VALUE, 8, 0);
END; !DEBUG
ERRMSG (0, 12, ROUTINE_NAME, 0, 0, 0, 0);
END; !OF GSD_MAP
GLOBAL ROUTINE SYM_VAL (FILE_PTR, SYMBOL_NAME, ERR) = !GET VALUE OF NAMED SYMBOL
!++
! FUNCTIONAL DESCRIPTION:
!
! GET THE VALUE OF A NAMED SYMBOL FROM A (SYMBOL TABLE) FILE
!
! FORMAL PARAMETERS:
!
! FILE_PTR - THE FILE BLOCK THAT MAY HAVE THE SPECIFIED SYMBOL
! SYMBOL_NAME - NAME OF THE SYMBOL, MAX OF 7 WITH LAST NULL.
! ERR - 0 = PRINT ERROR MESSAGE IF NOT FOUND, 1 = JUST RETURN -1.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! VALUE OF THE SYMBOL, OR -1 IF UNDEFINED.
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'SYMBOL_VALUE');
MAP
FILE_PTR : REF FILE_BLOCK;
LOCAL
GLOBL_PTR : REF GLOBL_BLOCK,
MODU_PTR : REF MODU_BLOCK,
CHAR_NUMBER,
SYMBOL_END,
PADDED_SYMBOL : VECTOR [CH$ALLOCATION (LEN_GBL_NAME)];
IF (.FILE_PTR EQL 0)
THEN
BEGIN
ERRMSG (0, 32, ROUTINE_NAME, .SYMBOL_NAME, FILE_PTR [FILE_NAME], 0, 0);
-1
END
ELSE
BEGIN
MODU_PTR = .FILE_PTR [FILE_MODU];
IF (.MODU_PTR EQL 0)
THEN
BEGIN
ERRMSG (0, 32, ROUTINE_NAME, .SYMBOL_NAME, FILE_PTR [FILE_NAME], 0, 0);
-1
END
ELSE
BEGIN
SYMBOL_END = CH$FIND_CH (LEN_GBL_NAME-1, CH$PTR (.SYMBOL_NAME), 0);
IF CH$FAIL (.SYMBOL_END)
THEN
GLOBL_PTR = FND_CHAIN (.MODU_PTR [MODU_GLOBALS], SEL_SYMBOL,
.SYMBOL_NAME)
ELSE
BEGIN
CHAR_NUMBER = CH$DIFF (.SYMBOL_END, CH$PTR (.SYMBOL_NAME));
CH$WCHAR (0,
CH$COPY (.CHAR_NUMBER, CH$PTR (.SYMBOL_NAME), %C' ', LEN_GBL_NAME-1,
CH$PTR (PADDED_SYMBOL)));
GLOBL_PTR = FND_CHAIN (.MODU_PTR [MODU_GLOBALS], SEL_SYMBOL, PADDED_SYMBOL);
END;
IF (.GLOBL_PTR EQL 0)
THEN
BEGIN
IF (.ERR EQL 0) THEN ERRMSG (0, 32, ROUTINE_NAME, .SYMBOL_NAME, FILE_PTR [FILE_NAME], 0, 0);
-1
END
ELSE
(GBL_VAL (.GLOBL_PTR)) AND %O'177777'
END
END
END; !OF SYM_VAL
ROUTINE SEL_SYMBOL (GLOBL_PTR, SYMBOL_NAME) = !SEE IF THIS IS THE TARGET SYMBOL
!++
! FUNCTIONAL DESCRIPTION:
!
! SEE IF THIS IS THE SYMBOL WE ARE SEARCHING FOR. USED IN
! CALL TO FND_CHAIN.
!
! FORMAL PARAMETERS:
!
! GLOBL_PTR - POINTER TO THE SYMBOL TO TEST
! SYMBOL_NAME - POINTER TO NAME OF SYMBOL WE ARE LOOKING FOR
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! 0 IF THIS IS NOT THE PROPER SYMBOL (WHICH WILL CAUSE FND_CHAIN
! TO KEEP SEARCHING), OR THE POINTER TO THE GLOBAL BLOCK IF
! THE NAME MATCHES.
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
MAP
GLOBL_PTR : REF GLOBL_BLOCK;
IF (CH$EQL (LEN_GBL_NAME, CH$PTR (GLOBL_PTR [GBL_NAME]), LEN_GBL_NAME, CH$PTR (.SYMBOL_NAME), 0))
THEN
.GLOBL_PTR
ELSE
0
END; !OF SEL_SYMBOL
GLOBAL ROUTINE GBL_VAL (GLOBL_PTR) = !RETURN VALUE OF GLOBAL SYMBOL
!++
! FUNCTIONAL DESCRIPTION:
!
! IF THE GLOBAL SYMBOL IS ABSOLUTE, JUST RETURN ITS VALUE CELL.
! IF IT IS RELOCATABLE, WE MUST ADD TO THIS THE BASE OF THE
! PSECT IT WAS DEFINED IN AND THE OFFSET INTO THAT PSECT AT
! THE TIME OF THE DEFINITION.
! AN UNDEFINED SYMBOL RETURNS ZERO AND GIVES AN ERROR MESSAGE.
!
! FORMAL PARAMETERS:
!
! GLOBL_PTR - POINTER TO THE GLOBAL WHOSE VALUE IS TO BE RETURNED
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! THE VALUE OF THE GLOBAL SYMBOL, WITH THE HIGH-ORDER BIT
! SPREAD.
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
MAP
GLOBL_PTR : REF GLOBL_BLOCK;
LOCAL
FLAGS,
PSECT_PTR : REF PSECT_BLOCK,
RESULT;
FLAGS = .GLOBL_PTR [GBL_FLAGS];
IF (.FLAGS<GBL_FLG_DEF, 1> EQL 0)
THEN
BEGIN
ERRMSG (0, 16, GLOBL_PTR [GBL_NAME], 0, 0, 0, 0);
0
END
ELSE
BEGIN
IF (.FLAGS<GBL_FLG_REL, 1> EQL 0)
THEN
RESULT = .GLOBL_PTR [GBL_VALUE]
ELSE
BEGIN
PSECT_PTR = .GLOBL_PTR [GBL_DEF_PSECT];
RESULT = .GLOBL_PTR [GBL_VALUE] + .PSECT_PTR [PSECT_BASE] + .GLOBL_PTR [GBL_DEF_OFFSET]
END;
IF (.RESULT<15, 1> NEQ 0) THEN RESULT<16, 20> = -1;
.RESULT
END
END; !OF GBL_VAL
END
ELUDOM