Trailing-Edge
-
PDP-10 Archives
-
TOPS-20_V6.1_DECnetSrc_7-23-85
-
mcb/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) 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 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: