Google
 

Trailing-Edge - PDP-10 Archives - BB-R595B-SM_11-9-85 - mcb/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
MODULE BCOR (					!BUILD CORE IMAGE
		IDENT = 'X2.0-4'
		) =
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 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:
!
!	NONE
!
! 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;

    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'177000') - .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