Google
 

Trailing-Edge - PDP-10 Archives - BB-X117B-SB_1986 - 10,7/tkb36/bcor.bli
There are 2 other files named bcor.bli in the archive. Click here to see a list.
!NET:<DECNET20-V3P0.TKB-VNP>BCOR.BLI.37 15-Mar-81 11:11:33, Edit by SROBINSON
!NET:<DECNET20-V3P0.TKB-VNP>BCOR.BLI.6 15-Jan-81 09:22:10, Edit by SROBINSON
!NET:<DECNET20-V3P0.TKB-VNP>BCOR.BLI.2  4-Jun-80 15:09:41, Edit by SROBINSON
!<REL4A.TKB-VNP>BCOR.BLI.8,  7-Dec-79 08:35:47, Edit by SROBINSON
!<REL4A.TKB-VNP>BCOR.BLI.7,  3-Dec-79 14:20:00, Edit by SROBINSON
!BCOR.BLI 24-OCT-85 EDIT BY BANKS
MODULE BCOR (					!BUILD CORE IMAGE
		IDENT = 'X2.0-4'
		) =
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-20
!
! ABSTRACT:
!
!
! THIS MODULE BUILDS THE CORE IMAGE OF THE TASK.
!  IT COPIES ALL TEXT INTO THE CORE IMAGE,
!   AND COMPUTES THE RELOCATION INFORMATION.
!
!
! ENVIRONMENT: TOPS-20 USER MODE
!
! AUTHOR: J. SAUTER, CREATION DATE: 08-MAR-78
!
! MODIFIED BY:
!
!	Scott G. Robinson, 28-SEP-78 : VERSION X0.1-2A
!	- Enhance error message capability within EVAL
!	- Fix EVAL to handle COMPLEMENT operation correctly
!	- Fix BCOR to correctly set the task size so we get a good
!	   and useful task image written to disk
!
!	Scott G. Robinson, 6-NOV-78 : VERSION X0.1-3A
!	- Fix BLBL to not clobber core image when number of units
!	   is not in range 1 - 8
!
!	Scott G. Robinson, 9-JAN-79 : VERSION X0.1-4A
!	- Fix RESV to resolve PSECTS to an even boundary
!
!	Scott G. Robinson, 18-FEB-79 : VERSION X0.1-5
!	- Fix Map output of TKB20 to be mostly reasonable (in other words,
!	   make a previous hack a feature)
!-----------------------------------------------------------------------------

!
!	Scott G. Robinson, 3-DEC-79 : Version X2.0
!	- Add TOPS-10 Compatibility for DECnet-10
!
!	Scott G. Robinson, 7-DEC-79 : Version X2.0-1
!	- Fix Storage map to output correct length of module
!
!	Scott G. Robinson, 4-MAY-80 : Version X2.0-2
!	- Add transfer address to PSECT map
!
!	Scott G. Robinson, 15-JAN-81 : Version X2.0-3
!	- Add Support for /DA Switch and Build Correct
!	  Header for it
!	- Fix Map Output to make it more readable
!	- Fix Transfer Address Finding Code to work
!
!	Scott G. Robinson, 15-MAR-81 : Version X2.0-4
!	- Finish Support for /DA Switch and include special
!	  hacks for ODT
!
!	, : VERSION
! 01	-
!--

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

FORWARD ROUTINE
    STO11 : NOVALUE,				! STORE A PDP-11 BYTE
    EVAL,					!COMPUTE RELOCATION
    STO_TEXT : NOVALUE,				!STORE TEXT INFO
    PRC_RLD,					!STORE RELOCATION INFO
    RESV,					!RESOLVE PSECTS
    SEL_OTA,					!FIND ODT TRANSFER ADDRESS
    SEL_TTA,					!FIND MODULE STARTING ADDRESS
    BCOR : NOVALUE,				!BUILD CORE IMAGE
    BLBL : NOVALUE,				!BUILD LABEL AND HEADER
    STO16L : NOVALUE,				!STORE 16 BITS IN LABEL
    STO16H : NOVALUE;				!STORE 16 BITS IN HEADER

!
! INCLUDE FILES
!

LIBRARY 'TKBLIB';

!REQUIRE 'BLOCKH.REQ';				!PREPARE TO DEFINE STORAGE BLOCKS
!REQUIRE 'FILE.REQ';				!FILE BLOCK
!REQUIRE 'FILSW.REQ';				!FILE SWITCH BLOCK
!REQUIRE 'GLOBL.REQ';				!GLOBAL SYMBOL BLOCK
!REQUIRE 'MODU.REQ';				!MODULE BLOCK
!REQUIRE 'PSECT.REQ';				!PSECT BLOCK
!REQUIRE 'RLDD.REQ';				!RELOCATION DATA BLOCK
!REQUIRE 'RLDH.REQ';				!RELOCATION HEADER BLOCK
!REQUIRE 'ROOT.REQ';				!ROOT BLOCK
!REQUIRE 'TEXTD.REQ';				!TEXT DATA BLOCK
!REQUIRE 'TEXTH.REQ';				!TEXT HEADER BLOCK
!REQUIRE 'BLOCKT.REQ';				!END OF DEFINING STORAGE BLOCKS
!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!

LITERAL
    DEBUG = 0;

!
! OWN STORAGE:
!
!	NONE
!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
    ATOR50 : NOVALUE,				!ASCII TO RADIX_50 CONVERSION
    R50TOA : NOVALUE,				!RADIX_50 TO ASCII CONVERSION
    ERRMSG : NOVALUE,				!TYPE AN ERROR MESSAGE
    ERROR : NOVALUE,				!SIGNAL AN INTERNAL ERROR
    GETSTG,					!GET STORAGE
    GBL_VAL,					!GET VALUE OF GLOBAL
    GET_SW,					!GET A FILE SWITCH
    OUTNUM : NOVALUE,				!WRITE A NUMBER ON A FILE
    OUTPUT : NOVALUE,				!WRITE ON A FILE
    OUTSTR : NOVALUE,				!WRITE A STRING ON A FILE
    PCRLF : NOVALUE,				!SEND CRLF TO A FILE
    FND_CHAIN;					!FIND A BLOCK IN A CHAIN

ROUTINE STO11 (BYTEVAL, ADDRESS, CORE_IMAGE, CORE_SIZE) : NOVALUE = 	!STORE PDP-11 BYTE

!++
! FUNCTIONAL DESCRIPTION:
!
!
!	ROUTINE TO STORE A BYTE INTO SIMULATED PDP-11 MEMORY.
!
!
! FORMAL PARAMETERS:
!
!	BYTEVAL - THE VALUE OF THE BYTE TO STORE
!	ADDRESS - PDP-11 ADDRESS OF WHERE TO STORE
!	CORE_IMAGE - POINTER TO SIMULATED PDP-11 CORE
!	CORE_SIZE - SIZE OF CORE, FOR ERROR CHECKING.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	STORES INTO THE CORE IMAGE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	CORE_IMAGE : REF VECTOR;

    LOCAL
	ADDR1,
	ADDR2,
	CORE_WORD;

    IF (.ADDRESS GEQU .CORE_SIZE)
    THEN
	ERROR (UPLIT (%ASCIZ'ADDRESS OUT OF RANGE - STO11'))
    ELSE
	BEGIN
	ADDR1 = .ADDRESS/4;
	ADDR2 = .ADDRESS MOD 4;
	CORE_WORD = .CORE_IMAGE [.ADDR1];
	CORE_WORD<(CASE .ADDR2 FROM 0 TO 3 OF
		SET
		[0] : 18;
		[1] : 26;
		[2] : 0;
		[3] : 8;
		TES), 8> = .BYTEVAL;
	CORE_IMAGE [.ADDR1] = .CORE_WORD;
	END;

    END;					!OF STO11
ROUTINE EVAL (OPND_TYPE, OPND, RELOC_INFO) = 	!EVALUATE RELOCATION

!++
! FUNCTIONAL DESCRIPTION:
!
!
!	ROUTINE TO EVALUATE RELOCATION.  CALLS ITSELF RECURSIVELY.
!
!
! FORMAL PARAMETERS:
!
!	OPND_TYPE - THE TYPE OF OPERAND: CONSTANT, GLOBAL, ETC.
!	OPND - THE OPERAND.  OFTEN A POINTER.
!	RELOC_INFO - VARIOUS INFORMATION CARRIED FOR RELOCATION PROCESSING
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	THE VALUE TO BE STORED IN PDP-11 MEMORY
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'EVAL');

    MAP
	RELOC_INFO : REF VECTOR;

    BIND
	PSECT_PTR = RELOC_INFO [0],		!POINTER TO CURRENT PSECT
	STACK_BASE = RELOC_INFO [1],		!BASE OF THE PDP-11'S STACK
	HAA = RELOC_INFO [2],			!HIGHEST ALLOCATED ADDRESS
	CORE_IMAGE = RELOC_INFO [3],		!IMAGE OF SIMULATED PDP-11 CORE
	CORE_SIZE = RELOC_INFO [4],		!SIZE OF SIMULATED PDP-11 CORE
	A_OFFS = RELOC_INFO [5];		!ADDRESS OFFSET INTO TASK

    MAP
	PSECT_PTR : REF PSECT_BLOCK;

    OWN
	EVAL_LEVEL : INITIAL (0);

    LOCAL
	RESULT,
	GLOBL_PTR : REF GLOBL_BLOCK,
	OPERATOR,
	OPND1,
	OPND2,
	PSECT_PTR1 : REF PSECT_BLOCK,
	RLDD_PTR : REF RLDD_BLOCK;

    IF (DEBUG GEQ 2)
    THEN
	BEGIN
	PCRLF (1);
	OUTSTR (1, UPLIT (%ASCIZ'	Eval Called with Operand type '));
	OUTNUM (1, .OPND_TYPE, 10, 0);
	OUTSTR (1, UPLIT (%ASCIZ' and Operand of '));
	OUTNUM (1, .OPND, 10, 0);
	END;

    CASE .OPND_TYPE FROM 1 TO MAX_RLD_OPND OF
	SET

	[RLD_OPND_CON] :
	    .OPND;

	[RLD_OPND_PSECT] :
	    BEGIN
	    PSECT_PTR1 = .OPND;
	    .PSECT_PTR1 [PSECT_BASE]
	    END;

	[RLD_OPND_GLOBAL] :
	    BEGIN
	    GLOBL_PTR = .OPND;
	    GBL_VAL (.GLOBL_PTR)
	    END;

	[RLD_OPND_BSTK] :
	    .STACK_BASE;

	[RLD_OPND_HLA] :
	    .HAA;

	[RLD_OPND_OPR] :
	    BEGIN
	    RLDD_PTR = .OPND;
	    OPERATOR = .RLDD_PTR [RLDD_OPER];

	    IF (DEBUG GEQ 1)
	    THEN
		BEGIN
		EVAL_LEVEL = .EVAL_LEVEL + 1;
		PCRLF (1);
		OUTSTR (1, UPLIT (%ASCIZ'Begin Relocation at Level '));
		OUTNUM (1, .EVAL_LEVEL, 10, 0);
		OUTSTR (1, UPLIT (%ASCIZ' Using Operator '));
		OUTNUM (1, .OPERATOR, 10, 0);
		OUTSTR (1, UPLIT (%ASCIZ' with Operands '));
		OUTNUM (1, .RLDD_PTR [RLDD_OP1T], 10, 0);
		OUTSTR (1, UPLIT (%ASCIZ' and '));
		OUTNUM (1, .RLDD_PTR [RLDD_OP2T], 10, 0);
		END;

	    RESULT = (CASE .OPERATOR FROM 1 TO MAX_RLD_OP OF
		SET
		[RLD_OP_ADD] : EVAL (.RLDD_PTR [RLDD_OP1T], .RLDD_PTR [RLDD_OPND1], .RELOC_INFO) + EVAL (
			.RLDD_PTR [RLDD_OP2T], .RLDD_PTR [RLDD_OPND2], .RELOC_INFO);
		[RLD_OP_SUB] : EVAL (.RLDD_PTR [RLDD_OP1T], .RLDD_PTR [RLDD_OPND1], .RELOC_INFO) - EVAL (
			.RLDD_PTR [RLDD_OP2T], .RLDD_PTR [RLDD_OPND2], .RELOC_INFO);
		[RLD_OP_MUL] : EVAL (.RLDD_PTR [RLDD_OP1T], .RLDD_PTR [RLDD_OPND1], .RELOC_INFO)*EVAL (
			.RLDD_PTR [RLDD_OP2T], .RLDD_PTR [RLDD_OPND2], .RELOC_INFO);
		[RLD_OP_DIV] :
		    BEGIN
		    OPND1 = EVAL (.RLDD_PTR [RLDD_OP1T], .RLDD_PTR [RLDD_OPND1], .RELOC_INFO);
		    OPND2 = EVAL (.RLDD_PTR [RLDD_OP2T], .RLDD_PTR [RLDD_OPND2], .RELOC_INFO);

		    IF (.OPND2 EQL 0)
		    THEN
			BEGIN
			ERRMSG (1, 17, ROUTINE_NAME, PSECT_PTR [PSECT_NAME], 0, 0, 0);
			0
			END
		    ELSE
			.OPND1/.OPND2

		    END;
		[RLD_OP_AND] : EVAL (.RLDD_PTR [RLDD_OP1T], .RLDD_PTR [RLDD_OPND1], .RELOC_INFO) AND EVAL (
			.RLDD_PTR [RLDD_OP2T], .RLDD_PTR [RLDD_OPND2], .RELOC_INFO);
		[RLD_OP_OR] : EVAL (.RLDD_PTR [RLDD_OP1T], .RLDD_PTR [RLDD_OPND1], .RELOC_INFO) OR EVAL (
			.RLDD_PTR [RLDD_OP2T], .RLDD_PTR [RLDD_OPND2], .RELOC_INFO);
		[RLD_OP_COM] : NOT (IF (.RLDD_PTR [RLDD_OP1T] NEQ RLD_OPND_OMIT) THEN EVAL (.RLDD_PTR [
				RLDD_OP1T], .RLDD_PTR [RLDD_OPND1], .RELOC_INFO) ELSE EVAL (.RLDD_PTR [
				RLDD_OP2T], .RLDD_PTR [RLDD_OPND2], .RELOC_INFO));
		[OUTRANGE] :
		    BEGIN
		    ERRMSG (1, 39, ROUTINE_NAME, UPLIT (%ASCIZ'Operator'), .OPERATOR, 0, 0);
		    0
		    END;
		TES);

	    IF (DEBUG GEQ 1) THEN EVAL_LEVEL = .EVAL_LEVEL - 1;

	    .RESULT
	    END;

	[INRANGE, OUTRANGE] :
	    BEGIN
	    ERRMSG (1, 39, ROUTINE_NAME, UPLIT (%ASCIZ'Operand'), .OPND_TYPE, 0, 0);
	    0
	    END;
	TES

    END;					!OF EVAL
ROUTINE STO_TEXT (TEXTH_PTR, RELOC_INFO) : NOVALUE = 	!STORE TEXT INFO

!++
! FUNCTIONAL DESCRIPTION:
!
!
!	ROUTINE TO STORE TEXT INFORMATION IN THE PDP-11
!	 SIMULATED MEMORY.
!
!
! FORMAL PARAMETERS:
!
!	TEXTH_PTR - POINTER TO TEXTH BLOCK HEADING THE TEXT
!	RELOC_INFO - VARIOUS INFORMATION CARRIED TO PERFORM RELOCATION
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	STORES INTO THE CORE IMAGE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'STO_TEXT');

    MAP
	RELOC_INFO : REF VECTOR,
	TEXTH_PTR : REF TEXTH_BLOCK;

    BIND
	PSECT_PTR = RELOC_INFO [0],		!POINTER TO CURRENT PSECT
	STACK_BASE = RELOC_INFO [1],		!BASE OF THE PDP-11'S STACK
	HAA = RELOC_INFO [2],			!HIGHEST ALLOCATED ADDRESS
	CORE_IMAGE = RELOC_INFO [3],		!IMAGE OF SIMULATED PDP-11 CORE
	CORE_SIZE = RELOC_INFO [4],		!SIZE OF SIMULATED PDP-11 CORE
	A_OFFS = RELOC_INFO [5];		!ADDRESS OFFSET INTO TASK

    MAP
	PSECT_PTR : REF PSECT_BLOCK;

    LOCAL
	START_SEGMENT,
	MAX_SEGMENT,
	BYTEVAL,
	TEXTH_PTR1 : REF TEXTH_BLOCK,
	TEXTD_PTR : REF TEXTD_BLOCK,
	LOCATION,
	NUM_BYTES,
	TEXTD_ADDR,
	FILE_PTR : REF FILE_BLOCK,
	MODU_PTR : REF MODU_BLOCK,
	SEG_PTR : REF MODU_BLOCK;

    TEXTH_PTR1 = .TEXTH_PTR;
    SEG_PTR = 0;

    WHILE (.TEXTH_PTR1 NEQ 0) DO
	BEGIN

	IF (.PSECT_PTR NEQ .TEXTH_PTR1 [TEXTH_PSECT])
	THEN
	    ERROR (UPLIT (%ASCIZ'BAD PSECT POINTER - STO_TEXT'))
	ELSE
	    BEGIN
	    LOCATION = .PSECT_PTR [PSECT_BASE] + .TEXTH_PTR1 [TEXTH_OFFSET];
	    TEXTD_PTR = .TEXTH_PTR1 [TEXTH_DATA];
	    MODU_PTR = .TEXTH_PTR1 [TEXTH_MODU];
	    FILE_PTR = .MODU_PTR [MODU_OBJ_FILE];

	    IF (.SEG_PTR NEQ .MODU_PTR)
	    THEN
		BEGIN
		START_SEGMENT = .LOCATION;
		MAX_SEGMENT = .LOCATION;
		SEG_PTR = .MODU_PTR;
		PCRLF (1);
		OUTSTR (1, UPLIT (%ASCIZ'			'));
		OUTNUM (1, .LOCATION, 8, 6);
		OUTPUT (1, %O'11');
		END;

	    WHILE (.TEXTD_PTR NEQ 0) DO
		BEGIN
		NUM_BYTES = .TEXTD_PTR [TEXTD_NUM_BYTES];
		TEXTD_ADDR = CH$PTR (TEXTD_PTR [TEXTD_DATA], -1, 8);

		WHILE (.NUM_BYTES NEQ 0) DO
		    BEGIN
		    BYTEVAL = CH$A_RCHAR (TEXTD_ADDR);
		    STO11 (.BYTEVAL, .LOCATION - .A_OFFS, .CORE_IMAGE, .CORE_SIZE);
		    LOCATION = .LOCATION + 1;

		    IF .LOCATION GTR .MAX_SEGMENT THEN MAX_SEGMENT = .LOCATION;

		    NUM_BYTES = .NUM_BYTES - 1;
		    END;

		TEXTD_PTR = .TEXTD_PTR [TEXTD_NEXT];
		END;

	    TEXTH_PTR1 = .TEXTH_PTR1 [TEXTH_NEXT];

	    IF ((.MODU_PTR NEQ .TEXTH_PTR1 [TEXTH_MODU]) OR (.TEXTH_PTR1 EQL 0))
	    THEN
		BEGIN
		OUTNUM (1, .MAX_SEGMENT - .START_SEGMENT, 8, 6);
		OUTPUT (1, %O'11');

		IF (.FILE_PTR NEQ 0) THEN OUTSTR (1, FILE_PTR [FILE_NAME]);

		OUTPUT (1, %O'11');

		IF (.MODU_PTR NEQ 0) THEN OUTSTR (1, MODU_PTR [MODU_NAME]);

		OUTPUT (1, %O'11');

		IF ((.MODU_PTR NEQ 0) AND (.MODU_PTR [MODU_FLAG_IDENT] NEQ 0))
		THEN
		    OUTSTR (1,
			MODU_PTR [MODU_IDENT]);

		END;

	    END;

	END;

    END;					!OF STO_TEXT
ROUTINE PRC_RLD (RLDH_PTR, RELOC_INFO) = 	!STORE RELOCATED INFORMATION

!++
! FUNCTIONAL DESCRIPTION:
!
!
!	ROUTINE TO COMPUTE AND STORE RELOCATED INFORMATION.
!
!
! FORMAL PARAMETERS:
!
!	RLDH_PTR - POINTER TO RLDH HEADER BLOCK
!	RELOC_INFO - VECTOR OF RELOCATION INFORMATION
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	STORES INTO THE CORE IMAGE
!
! ROUTINE VALUE:
!
!	0
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'PRC_RLD');

    MAP
	RELOC_INFO : REF VECTOR,
	RLDH_PTR : REF RLDH_BLOCK;

    BIND
	PSECT_PTR = RELOC_INFO [0],		!POINTER TO CURRENT PSECT
	STACK_BASE = RELOC_INFO [1],		!BASE OF THE PDP-11'S STACK
	HAA = RELOC_INFO [2],			!HIGHEST ALLOCATED ADDRESS
	CORE_IMAGE = RELOC_INFO [3],		!IMAGE OF SIMULATED PDP-11 CORE
	CORE_SIZE = RELOC_INFO [4],		!SIZE OF SIMULATED PDP-11 CORE
	A_OFFS = RELOC_INFO [5];		!ADDRESS OFFSET INTO TASK

    MAP
	PSECT_PTR : REF PSECT_BLOCK;

    LOCAL
	ADDRESS,
	BYTE_FLAG,
	VAL_TO_STORE;

    IF (.PSECT_PTR NEQ .RLDH_PTR [RLDH_PSECT])
    THEN
	ERROR (UPLIT (%ASCIZ'BAD PSECT POINTER - PRC_RELOC'))
    ELSE
	BEGIN
	ADDRESS = .RLDH_PTR [RLDH_ADDR] + .PSECT_PTR [PSECT_BASE];
	BYTE_FLAG = .RLDH_PTR [RLDH_BYTE];
	VAL_TO_STORE = EVAL (RLD_OPND_OPR, .RLDH_PTR [RLDH_VALUE], .RELOC_INFO);

	IF ((.BYTE_FLAG NEQ 0) AND (.VAL_TO_STORE GTRU 255))
	THEN
	    ERRMSG (0, 18, ROUTINE_NAME,
		PSECT_PTR [PSECT_NAME], .VAL_TO_STORE, 0, 0);

	STO11 (.VAL_TO_STORE<0, 8>, .ADDRESS - .A_OFFS, .CORE_IMAGE, .CORE_SIZE);

	IF (.BYTE_FLAG EQL 0)
	THEN
	    STO11 (.VAL_TO_STORE<8, 8>, .ADDRESS + 1 - .A_OFFS, .CORE_IMAGE,
		.CORE_SIZE);

	END;

    0

    END;					!OF PRC_RLD
ROUTINE RESV (GLOBL_PTR, PSECT_PTR, RELOC_BASE) = 	!COMPUTE PSECT BASES

!++
! FUNCTIONAL DESCRIPTION:
!
!	COMPUTE THE BASE ADDRESS FOR EACH PSECT.  PSECTS ARE ARRANGED
!	 IN MEMORY IN TWO SECTIONS: READ/WRITE AND READ-ONLY.
!	 WITHIN EACH SECTION PSECTS ARE ARRANGED IN ALPHABETICAL
!	 ORDER.  AS PSECTS ARE ENCOUNTERED IN THE INPUT FILES THEY
!	 ARE LINKED IN THIS ORDER.
!
! FORMAL PARAMETERS:
!
!	GLOBL_PTR - POINTER TO FIRST GLOBAL FOR THE MAP
!	PSECT_PTR - POINTER TO THE FIRST PSECT TO BE ALLOCATED MEMORY
!	RELOC_BASE - BASE FROM WHICH TO RELOCATE EVERYTHING
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	HIGHEST ALLOCATED ADDRESS
!
! SIDE EFFECTS
!
!	MODIFIES THE DATA STRUCTURE
!
!--

    BEGIN

    MAP
	GLOBL_PTR : REF GLOBL_BLOCK,
	PSECT_PTR : REF PSECT_BLOCK;

    LOCAL
	CURRENT_BASE,
	FLAGS,
	PSECT_PTR1 : REF PSECT_BLOCK;

    PSECT_PTR1 = .PSECT_PTR;
    CURRENT_BASE = (.RELOC_BASE + 1) AND ( NOT 1);

    WHILE (.PSECT_PTR1 NEQ 0) DO
	BEGIN
	PSECT_PTR1 [PSECT_BASE] = .CURRENT_BASE;
	FLAGS = .PSECT_PTR1 [PSECT_FLAGS];

	IF (.FLAGS<PSECT_FLG_REL, 1> NEQ 0)
	THEN
	    CURRENT_BASE = .CURRENT_BASE + ((.PSECT_PTR1 [PSECT_SIZE] + 1) AND ( NOT 1));

	PSECT_PTR1 = .PSECT_PTR1 [PSECT_NEXT];
	END;

    .CURRENT_BASE
    END;					!OF RESV
ROUTINE SEL_TTA (MODU_PTR, UNUSED) = 		!SELECT MODULE WITH STARTING ADDR

!++
! FUNCTIONAL DESCRIPTION:
!
!
!	ROUTINE TO SELECT A MODULE WITH A STARTING ADDRESS
!
!
! FORMAL PARAMETERS:
!
!	MODU_PTR - POINTER TO A MODULE BLOCK
!	UNUSED - ARGUMENT FROM CALL TO FND_CHAIN, NOT USED
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	0 IF NO STARTING ADDRESS (WHICH CAUSES FND_CHAIN TO KEEP
!	 SCANNING), OR THE STARTING ADDRESS + %O'200000'.
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	MODU_PTR : REF MODU_BLOCK;

    LOCAL
	PSECT_PTR : REF PSECT_BLOCK,
	DA_FSW_PTR : REF FILSW_BLOCK,
	TTA;

    BIND
	FILE_PTR = .MODU_PTR [MODU_OBJ_FILE] : REF FILE_BLOCK;

    DA_FSW_PTR = GET_SW (FILE_PTR, UPLIT (%ASCIZ'DA', 0));

    IF .DA_FSW_PTR NEQ 0
    THEN
	0
    ELSE
	BEGIN
	TTA = .MODU_PTR [MODU_XFR_OFFSET];

	IF .TTA NEQ 0
	THEN

	    IF ((.TTA<0, 1>) NEQ 0)
	    THEN
		0
	    ELSE
		(IF ((PSECT_PTR = .MODU_PTR [MODU_XFR_PSECT]) EQL 0) THEN .TTA ELSE .TTA + .PSECT_PTR [
			PSECT_BASE])

	ELSE
	    0

	END

    END;					!OF SEL_TTA
ROUTINE SEL_OTA (MODU_PTR, UNUSED) = 		!SELECT MODULE WITH ODT TRANSFER ADDRESS

!++
! FUNCTIONAL DESCRIPTION:
!
!
!	ROUTINE TO SELECT A /DA MODULE WITH A STARTING ADDRESS
!
!
! FORMAL PARAMETERS:
!
!	MODU_PTR - POINTER TO A MODULE BLOCK
!	UNUSED - ARGUMENT FROM CALL TO FND_CHAIN, NOT USED
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	0 IF NO STARTING ADDRESS (WHICH CAUSES FND_CHAIN TO KEEP
!	 SCANNING), OR THE STARTING ADDRESS + %O'200000'.
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    MAP
	MODU_PTR : REF MODU_BLOCK;

    LOCAL
	PSECT_PTR : REF PSECT_BLOCK,
	DA_FSW_PTR : REF FILSW_BLOCK,
	OTA;

    BIND
	FILE_PTR = .MODU_PTR [MODU_OBJ_FILE] : REF FILE_BLOCK;

    DA_FSW_PTR = GET_SW (FILE_PTR, UPLIT (%ASCIZ'DA', 0));

    IF .DA_FSW_PTR EQL 0
    THEN
	0
    ELSE
	BEGIN
	OTA = .MODU_PTR [MODU_XFR_OFFSET];

	IF .OTA NEQ 0
	THEN

	    IF ((.OTA<0, 1>) NEQ 0)
	    THEN
		0
	    ELSE
		(IF ((PSECT_PTR = .MODU_PTR [MODU_XFR_PSECT]) EQL 0) THEN .OTA ELSE .OTA + .PSECT_PTR [
			PSECT_BASE])

	ELSE
	    0

	END

    END;					!OF SEL_OTA

GLOBAL ROUTINE BCOR (PSECT_PTR, GLOBL_PTR, MODU_CHAIN, FILE_PTR, ROOT_PTR) : NOVALUE = 	!BUILD CORE IMAGE

!++
! FUNCTIONAL DESCRIPTION:
!
!
!	ROUTINE TO BUILD THE PDP-11 CORE IMAGE.
!
!
! FORMAL PARAMETERS:
!
!	PSECT_PTR - POINTER TO FIRST PSECT OF PROGRAM
!	GLOBL_PTR - POINTER TO FIRST GLOBAL OF PROGRAM
!	MODU_CHAIN - POINTER TO CHAIN OF MODULES
!	FILE_PTR - POINTER TO TASK FILE, TO GET SWITCHES
!	ROOT_PTR - POINTER TO ROOT BLOCK, FOR RETURNING RESULTS
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	STORES INTO THE CORE IMAGE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'BUILD_CORE_IMAGE');

    MAP
	FILE_PTR : REF FILE_BLOCK,
	GLOBL_PTR : REF GLOBL_BLOCK,
	PSECT_PTR : REF PSECT_BLOCK,
	ROOT_PTR : REF ROOT_BLOCK;

    LOCAL
	CORE_IMAGE : REF VECTOR,
	HAA,
	NOHD_FSW_PTR : REF FILSW_BLOCK,
	OTA,
	PBASE,
	PBASE_FSW_PTR : REF FILSW_BLOCK,
	PSECT_PTR1 : REF PSECT_BLOCK,
	PSIZE,
	PSIZE_FSW_PTR : REF FILSW_BLOCK,
	RELOC_INFO : VECTOR [8],
	STACK_BASE,
	STACK_FSW_PTR : REF FILSW_BLOCK,
	TEMP,
	TTA,
	UNITS,
	ODT_UNITS,
	UNITS_FSW_PTR : REF FILSW_BLOCK;

!
! RELOC INFO IS LAID OUT AS FOLLOWS:
!
! 0 - POINTER TO CURRENT PSECT
! 1 - STACK BASE
! 2 - HIGHEST ALLOCATED ADDRESS
! 3 - POINTER TO PDP-11 CORE IMAGE
! 4 - SIZE OF CORE
! 5 - BASE ADDRESS OF TASK, USUALLY 0
! 6 - POINTER TO TASK LABEL, OR 0
! 7 - LENGTH OF TASK LABEL, OR 0
!
!
! GET THE RELEVANT SWITCHES
!
    STACK_FSW_PTR = GET_SW (.FILE_PTR, UPLIT (%ASCII'STACK', 0));
    PBASE_FSW_PTR = GET_SW (.FILE_PTR, UPLIT (%ASCII'PBASE', 0));
    PSIZE_FSW_PTR = GET_SW (.FILE_PTR, UPLIT (%ASCII'PSIZE', 0));
    NOHD_FSW_PTR = GET_SW (.FILE_PTR, UPLIT (%ASCII'NOHD', 0));
    UNITS_FSW_PTR = GET_SW (.FILE_PTR, UPLIT (%ASCII'UNITS', 0));
!
! FIND OUT IF WE HAVE ODT TRANSFER ADDRESS AND UPDATE UNITS
! ACCORDINGLY. THIS CALCULATION IS SLOPPY BECAUSE IT HAS THE SIDE EFFECT
! OF NOT ALLOWING TRANSFER ADDRESSES TO BEGIN AT LOCATION 0 OF A PSECT.
!
    ODT_UNITS = (IF (FND_CHAIN (.MODU_CHAIN, SEL_OTA, 0) NEQ 0) THEN 2 ELSE 0);
!
! COMPUTE NUMBER OF UNITS, INCLUDE ADDITIONAL ONES FOR ODT
!
    UNITS = (IF (.UNITS_FSW_PTR EQL 0) THEN 6 ELSE .UNITS_FSW_PTR [FSW_VAL]);
!
! COMPUTE SIZE OF STACK
!
    STACK_BASE = (IF (.NOHD_FSW_PTR NEQ 0) THEN 0 ELSE %O'142' + ((.UNITS + .ODT_UNITS)*4));
    STACK_BASE = .STACK_BASE + (IF (.STACK_FSW_PTR EQL 0) THEN 512 ELSE IF (.STACK_FSW_PTR [FSW_VAL_PRES] EQL
	    0) THEN 512 ELSE (.STACK_FSW_PTR [FSW_VAL])*2);
!
! COMPUTE BASE ADDRESS OF TASK.  THIS WILL USUALLY BE ZERO.
!
    PBASE = (IF (.PBASE_FSW_PTR EQL 0) THEN 0 ELSE .PBASE_FSW_PTR [FSW_VAL]);
!
! RESOLVE PSECT BASES AND GLOBAL ADDRESSES, AND COMPUTE
!  HIGHEST ALLOCATED ADDRESS.
!
    HAA = RESV (.GLOBL_PTR, .PSECT_PTR, .STACK_BASE + .PBASE);
!
! COMPUTE SIZE OF TASK
!
    PSIZE = (IF (.PSIZE_FSW_PTR EQL 0) THEN 0 ELSE .PSIZE_FSW_PTR [FSW_VAL]);

    IF (.PSIZE EQL 0) THEN PSIZE = .HAA - .PBASE;

    IF (.PSIZE LSS (.HAA - .PBASE))
    THEN
	BEGIN
	ERRMSG (0, 22, ROUTINE_NAME, .PSIZE, .HAA - .PBASE, 0, 0);
	PSIZE = .HAA - .PBASE;
	END;

!
! GET STORAGE FOR THE CORE IMAGE
!

    IF ((CORE_IMAGE = GETSTG ((.PSIZE + 3)/4)) EQL 0)
    THEN
	ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
    ELSE
	BEGIN
!
! PUT INFORMATION IN RELOCATION VECTOR FOR OTHER ROUTINES
!
	RELOC_INFO [1] = .STACK_BASE;
	RELOC_INFO [2] = .HAA;
	RELOC_INFO [3] = .CORE_IMAGE;
	RELOC_INFO [4] = .PSIZE;
	RELOC_INFO [5] = .PBASE;
!
! COMPUTE TASK TRANSFER ADDRESS
!
	TTA = FND_CHAIN (.MODU_CHAIN, SEL_TTA, 0);
	TTA = (IF (.TTA EQL 0) THEN 1 ELSE .TTA<0, 16>);
!
! COMPUTE ODT TRANSFER ADDRESS
!
    OTA = FND_CHAIN (.MODU_CHAIN, SEL_OTA, 0);
    OTA = (IF (.OTA EQL 0) THEN 1 ELSE .OTA<0, 16>);
!
! OUTPUT INFORMATION ABOUT THE TASK WHILE COMPLETING PROCESSING
!
	OUTPUT (1, %O'14');
	OUTSTR (1, UPLIT (%ASCIZ'TKB36 V03.00 MCB V3.x Task Builder'));
	PCRLF (1);
!
! CREATE THE LABEL AND FILL IN THE HEADER
!
	BLBL (.FILE_PTR, .MODU_CHAIN, RELOC_INFO, .TTA, .OTA);
!
! OUTPUT STACK LIMIT INFORMATION
!
	PCRLF (1);
	OUTSTR (1, UPLIT (%ASCIZ'Stack Limits: '));
	TEMP = (IF (.NOHD_FSW_PTR NEQ 0) THEN 0 ELSE %O'142' + ((.UNITS + .ODT_UNITS)*4));
	OUTNUM (1, .TEMP, 8, 6);
	OUTPUT (1, %c' ');
	OUTNUM (1, .STACK_BASE, 8, 6);
	OUTPUT (1, %C' ');
	OUTNUM (1, .STACK_BASE - .TEMP, 8, 6);
	OUTPUT (1, %C' ');
	OUTNUM (1, .STACK_BASE - .TEMP, 10, 5);
	OUTPUT (1, %C'.');
!
! NOW SCAN THROUGH THE PSECTS, PUTTING EACH IN CORE.
!
	PCRLF (1);
	PCRLF (1);
	OUTSTR (1, UPLIT (%ASCIZ'PSECT Storage Map'));
	PCRLF (1);
	PCRLF (1);
	OUTSTR (1, UPLIT (%ASCIZ'Name	Loc	Length	/Start	Length	File	Module	Ident'));
	PSECT_PTR1 = .PSECT_PTR;

	WHILE (.PSECT_PTR1 NEQ 0) DO
	    BEGIN
	    RELOC_INFO [0] = .PSECT_PTR1;
	    PCRLF (1);
	    OUTSTR (1, PSECT_PTR1 [PSECT_NAME]);
	    OUTPUT (1, %O'11');
	    OUTNUM (1, .PSECT_PTR1 [PSECT_BASE], 8, 6);
	    OUTPUT (1, %O'11');
	    OUTNUM (1, .PSECT_PTR1 [PSECT_SIZE], 8, 6);
	    STO_TEXT (.PSECT_PTR1 [PSECT_TEXT], RELOC_INFO);
	    FND_CHAIN (.PSECT_PTR1 [PSECT_RLD], PRC_RLD, RELOC_INFO);
	    PSECT_PTR1 = .PSECT_PTR1 [PSECT_NEXT];
	    END;

	PCRLF (1);
!
! FILL IN IMPORTANT LOCATIONS IN ODT IF A DEBUGGER WAS FOUND;
! THIS IS A DOG OF A HACK BUT ALL I (SGR) HAD TIME FOR.
!

	IF (.OTA NEQ 1)
	THEN
	    BEGIN

	    LOCAL
		GBL_PTR : REF GLOBL_BLOCK,
		ODTL1,
		ODTL2;

	    ODTL1 = 0;
	    ODTL2 = 0;
	    GBL_PTR = .ROOT_PTR [ROOT_GLOBALS];

	    UNTIL (.GBL_PTR EQL 0) DO
		BEGIN

		IF (CH$EQL (LEN_GBL_NAME, CH$PTR (UPLIT (%ASCIZ'.ODTL1')), LEN_GBL_NAME,
			CH$PTR (GBL_PTR [GBL_NAME])))
		THEN
		    ODTL1 = GBL_VAL (.GBL_PTR);

		IF (CH$EQL (LEN_GBL_NAME, CH$PTR (UPLIT (%ASCIZ'.ODTL2')), LEN_GBL_NAME,
			CH$PTR (GBL_PTR [GBL_NAME])))
		THEN
		    ODTL2 = GBL_VAL (.GBL_PTR);

		GBL_PTR = .GBL_PTR [GBL_NEXT];
		END;

	    IF (.ODTL1 NEQ 0) THEN STO11 (.UNITS + 1, .ODTL1 - .PBASE, .CORE_IMAGE, .PSIZE);

	    IF (.ODTL2 NEQ 0) THEN STO11 (.UNITS + 2, .ODTL2 - .PBASE, .CORE_IMAGE, .PSIZE);

	    END;

!
! RETURN RESULTS IN THE ROOT BLOCK
!
	ROOT_PTR [ROOT_CIMAGE] = .CORE_IMAGE;
	ROOT_PTR [ROOT_CSIZE] = ((.HAA + %O'777') AND %O'377000') - .PBASE;
	ROOT_PTR [ROOT_TBASE] = .PBASE;
	ROOT_PTR [ROOT_LBL] = .RELOC_INFO [6];
	ROOT_PTR [ROOT_LSIZE] = .RELOC_INFO [7];
	END;					!OF HAVE CORE IMAGE VECTOR

    END;					!OF BCOR

ROUTINE BLBL (FILE_PTR, MODU_CHAIN, RELOC_INFO, TTA, OTA) : NOVALUE = 	!BUILD TASK LABEL AND HEADER

!++
! FUNCTIONAL DESCRIPTION:
!
!	BUILD THE TASK LABEL AND HEADER.  THE INFORMATION IS TAKEN MOSTLY
!	 FROM SWITCHES IN THE COMMAND STRING.
!
! FORMAL PARAMETERS:
!
!	FILE_PTR - THE TASK FILE POINTER: ROOT FOR SWITCHES
!	RELOC_INFO - VECTOR OF RELOCATION INFORMATION
!	TTA - TASK TRANSFER ADDRESS, 1 IF NONE.
!	OTA - ODT TRANSFER ADDRESS, 1 IF NONE.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	OBTAINS STORAGE FROM THE FREE STORAGE LIST
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'BLBL');

    MAP
	FILE_PTR : REF FILE_BLOCK,
	RELOC_INFO : REF VECTOR;

    BIND
	PSECT_PTR = RELOC_INFO [0],		!POINTER TO CURRENT PSECT
	STACK_BASE = RELOC_INFO [1],		!BASE OF THE PDP-11'S STACK
	HAA = RELOC_INFO [2],			!HIGHEST ALLOCATED ADDRESS
	CORE_IMAGE = RELOC_INFO [3],		!IMAGE OF SIMULATED PDP-11 CORE
	CORE_SIZE = RELOC_INFO [4],		!SIZE OF SIMULATED PDP-11 CORE
	A_OFFS = RELOC_INFO [5];		!ADDRESS OFFSET INTO TASK

!
! DEFINE THE OFFSETS INTO THE FIRST LABEL BLOCK AND THE TASK HEADER
!
! ALREADY INCLUDED IN LIBRARY ABOVE
!    REQUIRE 'TSKDEF.REQ';
!

    LOCAL
	PDR_OFFSET,
	PDR_NUMBER,
	PDR_VALUE,
	AC_FSW_PTR : REF FILSW_BLOCK,
	FLAGS,
	LBL_PTR : REF VECTOR,
	MODU_PTR : REF MODU_BLOCK,
	NOHD_FSW_PTR : REF FILSW_BLOCK,
	NOMM_FSW_PTR : REF FILSW_BLOCK,
	PAR_FSW_PTR : REF FILSW_BLOCK,
	PBASE_FSW_PTR : REF FILSW_BLOCK,
	PR_FSW_PTR : REF FILSW_BLOCK,
	PSIZE_FSW_PTR : REF FILSW_BLOCK,
	PRI_FSW_PTR : REF FILSW_BLOCK,
	REG_BLK,
	R50 : VECTOR [4],
	TASK_FSW_PTR : REF FILSW_BLOCK,
	TEMP,
	UNITS,
	ODT_UNITS,
	UNITS_FSW_PTR : REF FILSW_BLOCK,
	VLEN,
	WINDOW;

!
! GET POINTERS TO SWITCHES
!
    AC_FSW_PTR = GET_SW (.FILE_PTR, UPLIT (%ASCII'AC', 0));
    NOHD_FSW_PTR = GET_SW (.FILE_PTR, UPLIT (%ASCII'NOHD', 0));
    NOMM_FSW_PTR = GET_SW (.FILE_PTR, UPLIT (%ASCII'NOMM', 0));
    PAR_FSW_PTR = GET_SW (.FILE_PTR, UPLIT (%ASCII'PAR', 0));
    PBASE_FSW_PTR = GET_SW (.FILE_PTR, UPLIT (%ASCII'PBASE', 0));
    PR_FSW_PTR = GET_SW (.FILE_PTR, UPLIT (%ASCII'PR', 0));
    PSIZE_FSW_PTR = GET_SW (.FILE_PTR, UPLIT (%ASCII'PSIZE', 0));
    PRI_FSW_PTR = GET_SW (.FILE_PTR, UPLIT (%ASCII'PRI', 0));
    TASK_FSW_PTR = GET_SW (.FILE_PTR, UPLIT (%ASCII'TASK', 0));
    UNITS_FSW_PTR = GET_SW (.FILE_PTR, UPLIT (%ASCII'UNITS', 0));

    IF ((LBL_PTR = GETSTG (1024)) EQL 0)
    THEN
	ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
    ELSE
	BEGIN					!FILL IN LABEL INFORMATION
!
! FILL IN TASK NAME
!
	PCRLF (1);
	OUTSTR (1, UPLIT (%ASCIZ'Task Name: '));

	IF (.TASK_FSW_PTR NEQ 0)
	THEN
	    BEGIN				!WE HAVE "/TASK"

	    IF (.TASK_FSW_PTR [FSW_TEXT_PRES] NEQ 0)
	    THEN
		BEGIN				!WE HAVE A TASK NAME
		ATOR50 (TASK_FSW_PTR [FSW_TEXT], LBL_PTR [L$BTSK]);
		END;

	    END;

	TEMP = .LBL_PTR [L$BTSK + 2] OR .LBL_PTR [L$BTSK + 3]^8 OR .LBL_PTR [L$BTSK + 0]^16 OR .LBL_PTR [
	    L$BTSK + 1]^24;
	R50TOA (.TEMP, R50 [0]);
	OUTSTR (1, R50 [0]);
!
! FILL IN PARTITION NAME
!
	PCRLF (1);
	OUTSTR (1, UPLIT (%ASCIZ'Partition: '));

	IF (.PAR_FSW_PTR NEQ 0)
	THEN
	    BEGIN				!WE HAVE "/PAR"

	    IF (.PAR_FSW_PTR [FSW_TEXT_PRES] NEQ 0)
	    THEN
		BEGIN				!WE HAVE A PARTITION NAME
		ATOR50 (PAR_FSW_PTR [FSW_TEXT], LBL_PTR [L$BPAR]);
		END;

	    END
	ELSE
	    ATOR50 (UPLIT (%ASCII'GEN   '), LBL_PTR [L$BPAR]);

	TEMP = .LBL_PTR [L$BPAR + 2] OR .LBL_PTR [L$BPAR + 3]^8 OR .LBL_PTR [L$BPAR + 0]^16 OR .LBL_PTR [
	    L$BPAR + 1]^24;
	R50TOA (.TEMP, R50 [0]);
	OUTSTR (1, R50 [0]);
!
! OUTPUT IDENT
!
	begin
	routine GET_TOP (MODU_PTR, DUMMY) =
	    begin
	    .MODU_PTR
	    end;
	MODU_PTR = FND_CHAIN (.MODU_CHAIN, GET_TOP, 0);
	end;
	PCRLF (1);
	OUTSTR (1, UPLIT (%ASCIZ'Ident: '));

	IF ((.MODU_PTR NEQ 0) AND (.MODU_PTR [MODU_FLAG_IDENT] NEQ 0)) THEN OUTSTR (1, MODU_PTR [MODU_IDENT]);

!
! FILL IN BASE ADDRESS OF TASK
!
	PCRLF (1);
	OUTSTR (1, UPLIT (%ASCIZ'Task Address Limits: '));
	STO16L (.A_OFFS, LBL_PTR [L$BSA]);
	OUTNUM (1, .A_OFFS, 8, 6);
	OUTPUT (1, %C' ');
!
! FILL IN HIGHEST ADDRESS
!
	VLEN = ((((.HAA - .A_OFFS) + 63)/64)*64) - 1;
	STO16L (.A_OFFS + .VLEN, LBL_PTR [L$BHGV]);
	STO16L (.A_OFFS + .VLEN, LBL_PTR [L$BMXV]);
	OUTNUM (1, .A_OFFS + .VLEN, 8, 6);
!
! STORE SIZE OF TASK IN 64-BYTE BLOCKS
!
	PCRLF (1);
	OUTSTR (1, UPLIT (%ASCIZ'Task Size: '));
	STO16L ((.VLEN + 1)/64, LBL_PTR [L$BLDZ]);
	STO16L ((.VLEN + 1)/64, LBL_PTR [L$BMXZ]);
	OUTNUM (1, (.VLEN + 1)/2, 10, 0);
	OUTSTR (1, UPLIT (%ASCIZ'. Words'));
!
! STORE NUMBER OF TASK WINDOWS
!
	STO16L (1, LBL_PTR [L$BWND]);
!
! STORE SIZE OF OVERLAY SEGMENT DESCRIPTORS
!
	STO16L (12, LBL_PTR [L$BSEG]);
!
! COMPUTE FLAGS AND STORE THEM
!
	FLAGS = (IF (.NOHD_FSW_PTR NEQ 0) THEN TS$NHD ELSE 0)	!
	OR (IF (.AC_FSW_PTR NEQ 0) THEN TS$ACP ELSE 0)	!
	OR (IF ((.PR_FSW_PTR EQL 0) AND (.AC_FSW_PTR EQL 0)) THEN 0 ELSE TS$PRV)	!
	OR TS$CHK;
	STO16L (.FLAGS, LBL_PTR [L$BFLG]);
!
! STORE PRIORITY
!
	STO16L ((IF (.PRI_FSW_PTR EQL 0) THEN 0 ELSE .PRI_FSW_PTR [FSW_VAL]), LBL_PTR [L$BPRI]);
!
! STORE TASK TRANSFER ADDRESS
!
	STO16L ((IF .OTA EQL 1 THEN .TTA ELSE .OTA), LBL_PTR [L$BXFR]);
	PCRLF (1);
	OUTSTR (1, UPLIT (%ASCIZ'Task Transfer Address: '));
	OUTNUM (1, .TTA, 8, 6);
	PCRLF (1);
	OUTSTR (1, UPLIT (%ASCIZ'Debugger Transfer Address: '));
	OUTNUM (1, .OTA, 8, 6);
!
! STORE BLOCK NUMBER OF HEADER
!
	STO16L (2, LBL_PTR [L$BHRB]);
!
! STORE NUMBER OF BLOCKS IN LABEL
!
	STO16L (2, LBL_PTR [L$BBLK]);
!
! STORE NUMBER OF UNITS
!
	UNITS = (IF (.UNITS_FSW_PTR EQL 0) THEN 6 ELSE .UNITS_FSW_PTR [FSW_VAL]);
	ODT_UNITS = (IF (.OTA NEQ 1) THEN 2 ELSE 0);
	STO16L ((.UNITS + .ODT_UNITS), LBL_PTR [L$BLUN]);
!
! STORE TABLE OF UNITS
!

	INCR UNIT_NO FROM 1 TO .UNITS DO
	    BEGIN				!STORE ASCII DEVICE NAME AND BINARY UNIT NUMBER
	    STO16L ((CASE .UNIT_NO FROM 1 TO 8 OF
		    SET
		    [1, 2, 3, 4] : %C'S' + (%C'Y'*256);
		    [5] : %C'T' + (%C'I'*256);
		    [6] : %C'C' + (%C'L'*256);
		    [7, 8] : %C'S' + (%C'Y'*256);
		    [OUTRANGE] : %C'S' + (%C'Y'*256);
		    TES), LBL_PTR [(%O'1000' + ((.UNIT_NO - 1)*4))]);
	    STO16L ((CASE .UNIT_NO FROM 1 TO 8 OF
		    SET
		    [1, 2, 3, 4, 5, 6, 7, 8] : 0;
		    [OUTRANGE] : 0;
		    TES), LBL_PTR [(%O'1000' + ((.UNIT_NO - 1)*4) + 2)]);
	    END;

!
! STORE ODT UNIT DESIGNATIONS
!

	IF .ODT_UNITS NEQ 0
	THEN
	    BEGIN
	    STO16L (%C'T' + (%C'I'*256), LBL_PTR [(%O'1000' + ((.UNITS)*4))]);
	    STO16L (0, LBL_PTR [(%O'1000' + ((.UNITS)*4) + 2)]);
	    STO16L (%C'C' + (%C'L'*256), LBL_PTR [(%O'1000' + ((.UNITS + 1)*4))]);
	    STO16L (0, LBL_PTR [(%O'1000' + ((.UNITS + 1)*4) + 2)]);
	    END;

!
! NOW STORE HEADER
!
	STO16H (%O'142' + ((.UNITS + .ODT_UNITS)*4), H$HDLN, .RELOC_INFO);
	STO16H (%O'107117', H$EFLM, .RELOC_INFO);	!?
	STO16H (%O'424', H$CUIC, .RELOC_INFO);	![1,24]
	STO16H (%O'424', H$DUIC, .RELOC_INFO);	![1,24]
	STO16H (%O'170017', H$IPS, .RELOC_INFO);
	STO16H ((IF .OTA EQL 1 THEN .TTA ELSE .OTA), H$IPC, .RELOC_INFO);
	STO16H (.A_OFFS + .STACK_BASE, H$ISP, .RELOC_INFO);
	STO16H (%O'76' + ((.UNITS + .ODT_UNITS)*4), H$WND, .RELOC_INFO);
!
	STO16H (%O'140' + ((.UNITS + .ODT_UNITS)*4), H$GARD, .RELOC_INFO);
	REG_BLK = %O'140' + ((.UNITS + .ODT_UNITS)*4) - 12;
!
	STO16H ((.UNITS + .ODT_UNITS), H$NLUN, .RELOC_INFO);
!	INCR UNIT_NO FROM 1 TO .UNITS DO
!	    BEGIN
!
! I DONT UNDERSTAND HOW THE LUN TABLE IS CONSTRUCTED, SO I
!  AM GOING TO LEAVE IT ALL ZERO.
!
!	    END;
!
! COMPUTE LOCATION IN THE HEADER OF THE WINDOW BLOCK
!
	WINDOW = H$LUN + ((.UNITS + .ODT_UNITS)*4);
!
! STORE NUMBER OF WINDOW BLOCKS
!
	STO16H (1, .WINDOW, .RELOC_INFO);
!
! THE PCB ADDRESS IS LEFT ZERO BECAUSE I DON'T KNOW WHAT TO PUT THERE.
!
! STORE PARTITION BASE AS LOW VIRTUAL ADDRESS LIMIT
!
	STO16H (.A_OFFS, .WINDOW + 4, .RELOC_INFO);
!
! STORE PARTITION SIZE AS HIGH VIRTUAL ADDRESS LIMIT
!
	STO16H (.VLEN + .A_OFFS, .WINDOW + 6, .RELOC_INFO);
!
! STORE WINDOW SIZE
!
	STO16H ((.VLEN + 1)/64, .WINDOW + 10, .RELOC_INFO);
!
! STORE PDR INFORMATION
!
	PDR_OFFSET = (.A_OFFS/4096) + %O'200';
	PDR_NUMBER = (.VLEN/8192) + 1;
	PDR_VALUE = ((.VLEN + 1)/64) - 1;
	STO16H (.PDR_OFFSET<0, 8> + .PDR_NUMBER<0, 8>*256, .WINDOW + 14, .RELOC_INFO);
	STO16H (.PDR_VALUE<0, 7>*256 + 6, .WINDOW + 16, .RELOC_INFO);
!
! REMAINDER OF WINDOW BLOCK IS LEFT ALL ZERO
!
! SETUP REGISTERS TO REFLECT TASK ATTRIBUTES
!
	STO16H (2, .REG_BLK, .RELOC_INFO);	!RELATIVE BLOCK # OF HEADER
	R50 [0] = 0;
	R50 [1] = 0;

	IF ((.MODU_PTR NEQ 0) AND (.MODU_PTR [MODU_FLAG_IDENT] NEQ 0))
	THEN
	    ATOR50 (MODU_PTR [MODU_IDENT],
		R50);				!GET TASK IDENT

	STO16H (.R50 [0], .REG_BLK + 4, .RELOC_INFO);	!STORE IDENT
	STO16H (.R50 [1], .REG_BLK + 2, .RELOC_INFO);

	IF .OTA NEQ 1
	THEN
	    BEGIN
	    STO16H ((.LBL_PTR [L$BTSK] OR .LBL_PTR [L$BTSK + 1]^8), .REG_BLK + 8, .RELOC_INFO);
						!STORE TASK NAME
	    STO16H ((.LBL_PTR [L$BTSK + 2] OR .LBL_PTR [L$BTSK + 3]^8), .REG_BLK + 6, .RELOC_INFO);
	    STO16H (.TTA, .REG_BLK + 10, .RELOC_INFO);
	    END;

!
!
! STORE BASE AND SIZE OF LABEL AREA
!
	RELOC_INFO [6] = .LBL_PTR;
	RELOC_INFO [7] = 1024;
	END;					!HAVE STORAGE FOR LABEL

    END;					!OF BLBL
ROUTINE STO16L (VALUE, LOCN) : NOVALUE = 	!STORE 16 BITS IN LABEL

!++
! FUNCTIONAL DESCRIPTION:
!
!	STORE 16 BITS IN THE LABEL BUFFER.  THIS BUFFER HOLDS 8 BITS
!	 PER VALUE.
!
! FORMAL PARAMETERS:
!
!	VALUE - THE 16-BIT NUMBER TO STORE
!	LOCN - POINTER TO THE PLACE TO STORE THE LOW 8 BITS.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	STORES IN THE LABEL BUFFER
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'STO16L');

    MAP
	LOCN : REF VECTOR;

    LOCN [0] = .VALUE<0, 8>;
    LOCN [1] = .VALUE<8, 8>;
    END;					!OF STO16L
ROUTINE STO16H (VALUE, LOCN, RELOC_INFO) : NOVALUE = 	!STORE 16 BITS IN HEADER

!++
! FUNCTIONAL DESCRIPTION:
!
!	STORE 16 BITS IN THE TASK HEADER.  USE STO11.
!
! FORMAL PARAMETERS:
!
!	VALUE - THE 16-BIT NUMBER TO STORE
!	LOW-MEMORY ADDRESS IN PDP-11 TASK: PLACE IN THE HEADER.
!	RELOC_INFO - VECTOR OF RELOCATION INFORMATION
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	STORES IN TASK HEADER
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'STO16H');

    MAP
	RELOC_INFO : REF VECTOR;

    BIND
	PSECT_PTR = RELOC_INFO [0],		!POINTER TO CURRENT PSECT
	STACK_BASE = RELOC_INFO [1],		!BASE OF THE PDP-11'S STACK
	HAA = RELOC_INFO [2],			!HIGHEST ALLOCATED ADDRESS
	CORE_IMAGE = RELOC_INFO [3],		!IMAGE OF SIMULATED PDP-11 CORE
	CORE_SIZE = RELOC_INFO [4],		!SIZE OF SIMULATED PDP-11 CORE
	A_OFFS = RELOC_INFO [5];		!ADDRESS OFFSET INTO TASK

    STO11 (.VALUE<0, 8>, .LOCN, .CORE_IMAGE, .CORE_SIZE);
    STO11 (.VALUE<8, 8>, .LOCN + 1, .CORE_IMAGE, .CORE_SIZE);
    END;					!OF STO16H
END

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