Google
 

Trailing-Edge - PDP-10 Archives - TOPS-20_V6.1_DECnetSrc_7-23-85 - mcb/tkb36/tkb36.bli
There are 2 other files named tkb36.bli in the archive. Click here to see a list.
!<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',
		MAIN = TKB36
		) =
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-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
    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: