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: