Trailing-Edge
-
PDP-10 Archives
-
BB-X117B-SB_1986
-
10,7/tkb36/wstb.bli
There are 2 other files named wstb.bli in the archive. Click here to see a list.
!<REL4A.TKB-VNP>WSTB.BLI.3, 3-Dec-79 15:18:02, Edit by SROBINSON
MODULE WSTB ( !WRITE STB FILE
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: TKB-20
!
! ABSTRACT:
!
!
! THIS MODULE WRITES THE 'STB' FILE, WHICH CONTAINS THE SYMBOL
! DEFINITIONS.
!
!
! ENVIRONMENT: TOPS-20 USER MODE
!
! AUTHOR: J. SAUTER, CREATION DATE: 16-MAR-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
WR_REC : NOVALUE, !WRITE RECORD
WR_GSD : NOVALUE, !PUT GSD IN BUFFER
WSTB : NOVALUE; !WRITE STB FILE
!
! INCLUDE FILES
!
LIBRARY 'TKBLIB';
!REQUIRE 'BLOCKH.REQ'; !PREPARE TO DEFINE STORAGE BLOCKS
!REQUIRE 'FILE.REQ'; !FILE DATA BLOCK
!REQUIRE 'FILSW.REQ'; !SWITCH STORAGE BLOCK
!REQUIRE 'GLOBL.REQ'; !GLOBAL STORAGE BLOCK
!REQUIRE 'MODU.REQ'; !MODULE STORAGE BLOCK
!REQUIRE 'PSECT.REQ'; !PSECT STORAGE BLOCK
!REQUIRE 'BLOCKT.REQ'; !END OF STORAGE BLOCK DEFINITIONS
!
! MACROS:
!
! NONE
!
! EQUATED SYMBOLS:
!
LITERAL
DEBUG = 0,
LEN_STB_BUF = %O'172';
!
! OWN STORAGE:
!
! NONE
!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
ATOR50 : NOVALUE, !ASCII TO RADIX50_11
ERRMSG : NOVALUE, !TYPE AN ERROR MESSAGE
ERROR : NOVALUE, !SIGNAL AN INTERNAL ERROR
FND_CHAIN, !FIND A BLOCK IN A CHAIN
FRESTG, !FREE STORAGE
GBL_VAL, !GET VALUE OF GLOBAL
GETSTG, !GET STORAGE
OUTNUM : NOVALUE, !WRITE A NUMBER ON A FILE
OUTPUT : NOVALUE; !WRITE ON A FILE
ROUTINE WR_REC (CHAN, RECBUF) : NOVALUE = !WRITE RECORD
!++
! FUNCTIONAL DESCRIPTION:
!
!
! ROUTINE TO WRITE A RECORD FROM THE RECORD BUFFER. THE FIRST
! WORD IS THE NUMBER OF BYTES TO WRITE, IN ADDITION TO THE
! COUNT BYTE.
!
!
! FORMAL PARAMETERS:
!
! CHAN - CHANNEL ON WHICH TO WRITE THE RECORD FILE
! RECBUF - RECORD BUFFER, ONE BYTE PER WORD
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! WRITES ON THE SPECIFIED FILE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'WR_REC');
MAP
RECBUF : REF VECTOR;
LOCAL
LEN;
LEN = .RECBUF [0];
OUTPUT (.CHAN, .LEN);
OUTPUT (.CHAN, 0);
INCR COUNTER FROM 1 TO .LEN DO
OUTPUT (.CHAN, .RECBUF [.COUNTER]);
RECBUF [0] = 0;
END; !OF WR_REC
ROUTINE WR_GSD (CHAN, RECBUF, GSD_BUF) : NOVALUE = !WRITE A GSD ENTRY
!++
! FUNCTIONAL DESCRIPTION:
!
!
! ROUTINE TO PLACE A GSD ENTRY IN THE RECORD BUFFER. IF THE
! BUFFER WOULD OVERFLOW IT IS WRITTEN FIRST.
!
!
!
! FORMAL PARAMETERS:
!
! CHAN - CHANNEL ON WHICH TO WRITE THE STB FILE
! RECBUF - BUFFER WHICH HOLDS THE RECORD BEING BUILT
! GSD_BUF - POINTER TO GSD BUFFER, ONE BYTE PER WORD
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! MAY CALL WR_REC, WHICH WRITES ON THE SPECIFIED FILE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'WR_GSD');
MAP
RECBUF : REF VECTOR,
GSD_BUF : REF VECTOR;
LOCAL
LEN;
IF ((.RECBUF [0] + 8) GTR LEN_STB_BUF) THEN WR_REC (.CHAN, .RECBUF);
IF ((LEN = .RECBUF [0]) EQL 0)
THEN
BEGIN
!
! WE JUST WROTE THE RECORD, OR THIS IS THE FIRST CALL TO WR_GSD
!
RECBUF [1] = 1; !FLAG GSD RECORD
RECBUF [2] = 0;
RECBUF [0] = 2;
LEN = 2;
END;
INCR COUNTER FROM 1 TO 8 DO
RECBUF [.LEN + .COUNTER] = .GSD_BUF [.COUNTER - 1];
RECBUF [0] = .LEN + 8;
END; !OF WR_GSD
ROUTINE SEL_MODU (MODU_PTR, UNUSED) = !FIND A MODULE WITH AN IDENT
!++
! FUNCTIONAL DESCRIPTION:
!
!
! ROUTINE TO SELECT A MODULE WITH AN IDENT
!
!
! FORMAL PARAMETERS:
!
! MODU_PTR - POINTER TO MODULE BLOCK
! UNUSED - PASSED FROM CALL TO FND_CHAIN, NOT USED.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! POINTER TO THE MODULE BLOCK IF IT HAS AN IDENT, OTHERWISE
! 0.
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
MAP
MODU_PTR : REF MODU_BLOCK;
IF (.MODU_PTR [MODU_FLAG_IDENT] NEQ 0) THEN .MODU_PTR ELSE 0
END; !OF SEL_MODU
GLOBAL ROUTINE WSTB (CHAN, MODU_CHAIN, PSECT_PTR, GLOBL_PTR, FILE_PTR) : NOVALUE = !WRITE STB FILE
!++
! FUNCTIONAL DESCRIPTION:
!
!
! ROUTINE TO WRITE THE STB FILE. THE FILE IS WRITTEN IN OBJECT
! FILE FORMAT. IT CONTAINS ONLY THE MODULE NAME, THE IDENT
! AND THE DEFINITIONS OF THE GLOBAL SYMBOLS. AT THE END IS
! AN END GSD RECORD FOLLOWED BY AN END MODULE RECORD.
!
!
! FORMAL PARAMETERS:
!
! CHAN - CHANNEL ON WHICH TO WRITE THE STB FILE
! MODU_CHAIN - CHAIN TO ALL MODULES
! PSECT_PTR - POINTER TO FIRST PSECT
! GLOBL_PTR - POINTER TO FIRST GLOBAL
! FILE_PTR - POINTER TO STB FILE BLOCK
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! WRITES ON THE SPECIFIED FILE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'WSTB');
MAP
FILE_PTR : REF FILE_BLOCK,
GLOBL_PTR : REF GLOBL_BLOCK,
PSECT_PTR : REF PSECT_BLOCK;
LOCAL
GLOBAL_VALUE,
GLOBL_PTR1 : REF GLOBL_BLOCK,
GSD_BUF : REF VECTOR,
MODU_PTR : REF MODU_BLOCK,
REC_BUF : REF VECTOR,
SEARCH_DONE;
IF ((REC_BUF = GETSTG (LEN_STB_BUF + 1)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
IF ((GSD_BUF = GETSTG (8)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
REC_BUF [0] = 0;
!
! THE MODULE NAME AND IDENT COME FROM THE FIRST MODULE
! WITH A NON-BLANK IDENT
!
MODU_PTR = FND_CHAIN (.MODU_CHAIN, SEL_MODU, 0);
IF (.MODU_PTR NEQ 0)
THEN
BEGIN
ATOR50 (MODU_PTR [MODU_NAME], .GSD_BUF);
GSD_BUF [4] = 0;
GSD_BUF [5] = 0;
GSD_BUF [6] = 0;
GSD_BUF [7] = 0;
WR_GSD (.CHAN, .REC_BUF, .GSD_BUF);
ATOR50 (MODU_PTR [MODU_IDENT], .GSD_BUF);
GSD_BUF [4] = 0;
GSD_BUF [5] = 6;
GSD_BUF [6] = 0;
GSD_BUF [7] = 0;
WR_GSD (.CHAN, .REC_BUF, .GSD_BUF);
END
ELSE
BEGIN
!
! THERE IS NO MODULE WITH AN IDENT. THEREFORE WE TAKE THE MODULE
! NAME FROM THE NAME OF THE TASK FILE, AND PROVIDE NO IDENT.
!
ATOR50 (FILE_PTR [FILE_NAME], .GSD_BUF);
GSD_BUF [4] = 0;
GSD_BUF [5] = 0;
GSD_BUF [6] = 0;
GSD_BUF [7] = 0;
WR_GSD (.CHAN, .REC_BUF, .GSD_BUF);
END;
GLOBL_PTR1 = .GLOBL_PTR;
WHILE (.GLOBL_PTR1 NEQ 0) DO
BEGIN
ATOR50 (GLOBL_PTR1 [GBL_NAME], .GSD_BUF);
GSD_BUF [4] = .GLOBL_PTR1 [GBL_FLAGS] AND ( NOT (1^GBL_FLG_REL));
GSD_BUF [5] = 4;
GLOBAL_VALUE = GBL_VAL (.GLOBL_PTR1);
GSD_BUF [6] = .GLOBAL_VALUE<0, 8>;
GSD_BUF [7] = .GLOBAL_VALUE<8, 8>;
WR_GSD (.CHAN, .REC_BUF, .GSD_BUF);
GLOBL_PTR1 = .GLOBL_PTR1 [GBL_NEXT];
END;
!
! FINISH OFF THIS RECORD
!
WR_REC (.CHAN, .REC_BUF);
!
! END WITH END GSD FOLLOWED BY END MODULE
!
REC_BUF [0] = 2;
REC_BUF [1] = 2;
REC_BUF [2] = 0;
WR_REC (.CHAN, .REC_BUF);
REC_BUF [0] = 2;
REC_BUF [1] = 6;
REC_BUF [2] = 0;
WR_REC (.CHAN, .REC_BUF);
FRESTG (.REC_BUF, LEN_STB_BUF + 1);
FRESTG (.GSD_BUF, 8);
END;
END;
END; !OF WSTB
END
ELUDOM
! Local Modes:
! Comment Start:!
! Comment Column:36
! Auto Save Mode:2
! Mode:Fundamental
! End: