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