Google
 

Trailing-Edge - PDP-10 Archives - BB-R595B-SM_11-9-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: