Google
 

Trailing-Edge - PDP-10 Archives - BB-X117B-SB_1986 - 10,7/tkb36/tkb36.bli
There are 2 other files named tkb36.bli in the archive. Click here to see a list.
!DSKB:TKB36.BLI[10,6026], 11-Sep-85 10:19:33, Edit by DAVENPORT
!
! 3A(10)
!	TKB36	- Add binary copyright notice.
!	ALL	- Update source copyright notice.
!
!<DECNET20-V3P0.TKB-VNP>TKB36.BLI.5 28-Apr-81 09:50:32, Edit by SROBINSON
!<DECNET20-V3P0.TKB-VNP>TKB36.BLI.2 15-Jan-81 08:45:48, Edit by SROBINSON
!<DECNET20-V3P0.TKB-VNP>TKB36.BLI.1, 26-Aug-80 13:59:38, Edit by SROBINSON
MODULE TKB36 (					!MAIN PROGRAM FOR TKB36
		IDENT = 'X3.0-2',
		VERSION = '3A(10)',
		MAIN = TKB36
		) =
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-36
!
! ABSTRACT:
!
!
! THIS MODULE IS THE MAIN PROGRAM FOR TKB36.  IT DRIVES ALL OF THE
!  OTHER MODULES BY CALLING ROUTINES IN THEM.
!
!
! ENVIRONMENT: TOPS-20 USER MODE
!
! AUTHOR: J. SAUTER, CREATION DATE: 14-MAR-78
!
! MODIFIED BY:
!
!	Scott G. Robinson, 15-FEB-79 : VERSION X0.1-2
!	- Support new format call to CMDLIN
!-----------------------------------------------------------------------
!
!	Scott G. Robinson, 3-DEC-79 : Version X2.0
!	- Ensure DECnet-10 Compatibility
!
!	Scott G. Robinson, 26-AUG-80 : Version X3.0
!	- Convert to VNP36 nomenclature in main module
!
!	Scott G. Robinson, 15-JAN-81 : Version X3.0-1
!	- Fix Global Symbol Output in WMAP
!	- Add /DA Support
!	- Convert to TKBLIB Library
!
! X3.0-2 - Add CR/LF to end of output
!
!	, : VERSION
! 01	-
!--

!<BLF/PAGE>
!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    SEL_INPUT,					!SELECT AN INPUT FILE
    SEL_OUTPUT,					!SELECT AN OUTPUT FILE
    TKB36 : NOVALUE;				!MAIN PROGRAM

!
! INCLUDE FILES:
!

LIBRARY 'TKBLIB';

!REQUIRE 'BLOCKH.REQ';				!PREPARE TO DEFINE STORAGE BLOCKS
!REQUIRE 'FILE.REQ';				!DEFINE FILE BLOCK
!REQUIRE 'FILSW.REQ';				!DEFINE FILE SWITCHES
!REQUIRE 'ROOT.REQ';				!ROOT BLOCK FOR TASK BUILDER
!REQUIRE 'BLOCKT.REQ';				!END OF DEFINING STORAGE BLOCKS
!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!

LITERAL
    DEBUG = 0;

!
! OWN STORAGE:
!

GLOBAL
    COPYRIGHT : vector [20]
		initial (%asciz 'COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION, 1984, 1986. ALL RIGHTS RESERVED.'),
    ROOT : REF ROOT_BLOCK;

!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
    BCOR : NOVALUE,				!BUILD CORE IMAGE
    ERROR : NOVALUE,				!SIGNAL PROGRAMMING ERROR
    GET_SW,					!GET A SWITCH AND VALUE
    OPEN,					!OPEN A FILE
    PCRLF : NOVALUE,		    		!PRINT A CR/LF
    ERRMSG : NOVALUE,				!ERROR MESSAGE
    GETSTG,					!GET STORAGE
    CLOSE : NOVALUE,				!CLOSE A FILE
    CMDLIN,					!READ A COMMAND LINE
    GLOB,					!PRINT GLOBAL MAP
    RDFILE,					!READ THE OBJECT FILE
    RDLIBR,					!READ AN OBJECT LIBRARY
    INISTG : NOVALUE,				!INITIALIZE STORAGE MANAGER
    FND_CHAIN,					!FIND A BLOCK IN A CHAIN
    GETBLK,					!GET A STORAGE BLOCK
    WTSK : NOVALUE,				!WRITE TASK FILE
    WSTB : NOVALUE,				!WRITE STB FILE
    RESET_ALL;					!RESET ALL I/O

ROUTINE SEL_INPUT (FILE_PTR, UNUSED) = 		!SELECT AN INPUT FILE

!++
! FUNCTIONAL DESCRIPTION:
!
!	SELECT AN INPUT FILE.  USED IN CALL TO FND_CHAIN.
!
! FORMAL PARAMETERS:
!
!	FILE_PTR - POINTER TO A FILE BLOCK TO BE TESTED.
!	UNUSED - ARGUMENT FROM CALLER OF FND_CHAIN, NOT USED.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	0 IF THIS CANNOT BE AN INPUT FILE (WHICH WILL CAUSE FND_CHAIN
!	 TO KEEP SEARCHING), OR THE POINTER TO THE FILE BLOCK IF
!	 IT CAN BE AN INPUT FILE.
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	FILE_PTR : REF FILE_BLOCK;

!

    IF (.FILE_PTR [FILE_FLAG_IND] NEQ 0)
    THEN
	BEGIN					!INDIRECT FILE
	FND_CHAIN (.FILE_PTR [FILE_DOWN], SEL_INPUT, 0)
	END
    ELSE
	BEGIN

	IF (.FILE_PTR [FILE_FLAG_OUT] EQL 0) THEN .FILE_PTR ELSE 0

	END

    END;					!OF SEL_INPUT
ROUTINE SEL_OUTPUT (FILE_PTR, UNUSED) = 	!SELECT AN OUTPUT FILE

!++
! FUNCTIONAL DESCRIPTION:
!
!	SELECT AN OUTPUT FILE.  USED IN CALL TO FND_CHAIN.
!
! FORMAL PARAMETERS:
!
!	FILE_PTR - POINTER TO A FILE BLOCK TO BE TESTED.
!	UNUSED - ARGUMENT FROM CALLER OF FND_CHAIN, NOT USED.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	0 IF THIS CANNOT BE AN OUTPUT FILE (WHICH WILL CAUSE FND_CHAIN
!	 TO KEEP SEARCHING), OR THE POINTER TO THE FILE BLOCK IF
!	 IT CAN BE AN OUTPUT FILE.
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	FILE_PTR : REF FILE_BLOCK;

!

    IF (.FILE_PTR [FILE_FLAG_IND] NEQ 0)
    THEN
	BEGIN					!INDIRECT FILE
	FND_CHAIN (.FILE_PTR [FILE_DOWN], SEL_OUTPUT, 0)
	END
    ELSE
	BEGIN

	IF (.FILE_PTR [FILE_FLAG_IN] EQL 0) THEN .FILE_PTR ELSE 0

	END

    END;					!OF SEL_OUTPUT
ROUTINE TKB36 : NOVALUE = 			!MAIN PGM

!++
! FUNCTIONAL DESCRIPTION:
!
!	TOP LEVEL PROGRAM FOR THE TASK BUILDER
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	WRITES OUT THE VARIOUS FILES WHICH REPRESENT AN RSX-11M TASK
!
!--

    BEGIN

    BIND
	ROUTINE_NAME =
	    UPLIT (%ASCIZ'TKB36>');

    LOCAL
	FAKE_FILE_PTR : REF FILE_BLOCK,
	FILE_PTR : REF FILE_BLOCK,
	MAP_CHAN,
	MAP_FILE : REF FILE_BLOCK,
	SEARCH_DONE,
	STACK_BASE,
	STB_CHAN,
	STB_FILE : REF FILE_BLOCK,
	TASK_CHAN,
	TASK_FILE : REF FILE_BLOCK;

    RESET_ALL ();				!RESET ALL I/O
    INISTG (2000);				!INITIALIZE STORAGE MANAGER
!
! GET STORAGE FOR THE BLOCK THAT LIVES AT THE ROOT OF THE
!  DATA STRUCTURE.
!
    ROOT = GETBLK (ROOT_TYP, ROOT_LEN);
!
! GET STORAGE FOR THE FAKE FILE BLOCK THAT THE FILES GROW FROM
!
    FAKE_FILE_PTR = GETBLK (FILE_TYP, FILE_LEN);
    FAKE_FILE_PTR [FILE_HIGH] = .ROOT;
    FAKE_FILE_PTR [FILE_FLAG_FAKE] = 1;
    ROOT [ROOT_TOP_FILE] = .FAKE_FILE_PTR;
!
! SCAN A COMMAND
!

    IF (CMDLIN (0, .FAKE_FILE_PTR, ROUTINE_NAME) NEQ 0)
    THEN
	BEGIN
	MAP_CHAN = -1;
	MAP_FILE = 0;
	STB_CHAN = -1;
	STB_FILE = 0;
	TASK_CHAN = -1;
	TASK_FILE = 0;

	IF ((FILE_PTR = FND_CHAIN (.FAKE_FILE_PTR [FILE_DOWN], SEL_OUTPUT, 0)) NEQ 0)
	THEN
	    BEGIN
	    SEARCH_DONE = 0;

	    WHILE (.SEARCH_DONE EQL 0) DO
		BEGIN

		IF (GET_SW (.FILE_PTR, UPLIT (%ASCIZ'MAP', 0)) NEQ 0)
		THEN
		    BEGIN

		    IF (.MAP_CHAN GTR 0)
		    THEN
			ERRMSG (0, 19, ROUTINE_NAME, FILE_PTR [FILE_NAME],
			    UPLIT (%ASCIZ'map'), 0, 0)
		    ELSE
			BEGIN

			IF ((OPEN (1, FILE_PTR [FILE_NAME], 1, 1, UPLIT (%ASCIZ'MAP'))) NEQ 0)
			THEN
			    BEGIN
			    MAP_CHAN = 1;
			    MAP_FILE = .FILE_PTR;
			    END;

			END;

		    END
		ELSE

		    IF (GET_SW (.FILE_PTR, UPLIT (%ASCIZ'TASK', 0)) NEQ 0)
		    THEN
			BEGIN

			IF (.TASK_CHAN GTR 0)
			THEN
			    ERRMSG (0, 19, ROUTINE_NAME, FILE_PTR [FILE_NAME],
				UPLIT (%ASCIZ'task'), 0, 0)
			ELSE
			    BEGIN

			    IF ((OPEN (2, FILE_PTR [FILE_NAME], 2, 1, UPLIT (%ASCIZ'TSK'))) NEQ 0)
			    THEN
				BEGIN
				TASK_CHAN = 2;
				TASK_FILE = .FILE_PTR;
				END;

			    END;

			END
		    ELSE

			IF (GET_SW (.FILE_PTR, UPLIT (%ASCIZ'STB', 0)) NEQ 0)
			THEN
			    BEGIN

			    IF (.STB_CHAN GTR 0)
			    THEN
				ERRMSG (0, 19, ROUTINE_NAME, FILE_PTR [FILE_NAME],
				    UPLIT (%ASCIZ'symbol table'
				    ), 0, 0)
			    ELSE
				BEGIN

				IF ((OPEN (3, FILE_PTR [FILE_NAME], 2, 1, UPLIT (%ASCIZ'STB'))) NEQ 0)
				THEN
				    BEGIN
				    STB_CHAN = 3;
				    STB_FILE = .FILE_PTR;
				    END;

				END;

			    END
			ELSE
			    ERRMSG (0, 20, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);

		IF ((FILE_PTR = .FILE_PTR [FILE_NEXT]) EQL 0)
		THEN
		    SEARCH_DONE = 1
		ELSE

		    IF (.FILE_PTR [FILE_FLAG_IN] NEQ 0) THEN SEARCH_DONE = 1;

		END

	    END;				!OF WHILE SEARCH_DONE

	FILE_PTR = FND_CHAIN (.FAKE_FILE_PTR [FILE_DOWN], SEL_INPUT, 0);

	IF (.FILE_PTR EQL 0)
	THEN
	    ERRMSG (0, 21, ROUTINE_NAME, 0, 0, 0, 0)
	ELSE
	    BEGIN				!FOUND AN INPUT FILE

	    WHILE (.FILE_PTR NEQ 0) DO
		BEGIN

		IF ((OPEN (4, FILE_PTR [FILE_NAME], 2, 0, UPLIT (%ASCIZ'OBJ'))) NEQ 0)
		THEN
		    BEGIN
		    (IF (GET_SW (.FILE_PTR, UPLIT (%ASCIZ'LB', 0)) NEQ 0) THEN RDLIBR ELSE RDFILE) (4,
			.FILE_PTR);
		    CLOSE (4);
		    END;			!SUCCESSFUL INPUT OPEN

		FILE_PTR = .FILE_PTR [FILE_NEXT];
		END;

	    IF ((FILE_PTR = GETBLK (FILE_TYP, FILE_LEN)) NEQ 0)
	    THEN
		BEGIN
		CH$MOVE (11, CH$PTR (UPLIT (%ASCIZ'SYSLIB.OLB')), CH$PTR (FILE_PTR [FILE_NAME]));

		IF (OPEN (4, FILE_PTR [FILE_NAME], 2, 0, UPLIT (%ASCIZ'OBJ')))
		THEN
		    BEGIN
		    RDLIBR (4, .FILE_PTR);
		    CLOSE (4);
		    END;

		BCOR (.ROOT [ROOT_PSECTS], .ROOT [ROOT_GLOBALS], .ROOT [ROOT_MODULES], .TASK_FILE, .ROOT);
		GLOB (.MAP_CHAN, .ROOT [ROOT_GLOBALS]);

		IF (.MAP_CHAN GTR 0) THEN
		    BEGIN
		    PCRLF(.MAP_CHAN);
		    CLOSE (.MAP_CHAN);
		    END;

		IF (.TASK_CHAN GTR 0)
		THEN
		    BEGIN
		    WTSK (.ROOT [ROOT_CIMAGE], .ROOT [ROOT_CSIZE], .ROOT [ROOT_LBL], .ROOT [ROOT_LSIZE],
			.TASK_FILE, .TASK_CHAN);
		    CLOSE (.TASK_CHAN);
		    END;

		IF (.STB_CHAN GTR 0)
		THEN
		    BEGIN
		    WSTB (.STB_CHAN, .ROOT [ROOT_MODULES], .ROOT [ROOT_PSECTS], .ROOT [ROOT_GLOBALS],
			.TASK_FILE);
		    CLOSE (.STB_CHAN);
		    END;

		END;

	    END;				!FOUND AN INPUT FILE

	END

    END;
END

ELUDOM
! Local Modes:
! Mode:Fundamental
! Auto Save Mode:2
! Comment Start:!
! Comment Column:36
! End: