



		    announce_chwm.pl1               11/11/89  1107.2rew 11/11/89  0815.1       54747



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-05-13,GJohnson), approve(86-05-13,MCR7387),
     audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056):
     Correct error message documentation.
                                                   END HISTORY COMMENTS */


/* format: style2 */

announce_chwm:
     proc ();

/* format: off */
/* *	This procedure announces the value of the Collection One High Water Mark,
   *	once before, and once after segments are made paged.
   *
   *	Extracted from init_sst and make_segs_paged, 12/21/80 W. Olin Sibert
   * 	Modified September 1983 by Keith Loepere for high marks on unpaged page tables.
   */

/* format: on */

	dcl     parm_ptr		 pointer;

	dcl     ptp		 pointer;		/* Can't be declared in silly include files */
	dcl     wired_bit		 bit (1) aligned;
	dcl     suptop		 fixed bin;
	dcl     initbase		 fixed bin;
	dcl     n_pages		 fixed bin;
	dcl     wired		 fixed bin;
	dcl     total		 fixed bin;

	dcl     int_unpaged_page_tables$
				 external static;
	dcl     slt$		 fixed bin external static;
	dcl     sst_seg$		 external static;
	dcl     sstp		 pointer;
	dcl     cmp		 pointer;
	dcl     sst$cmp		 ptr ext static;
	dcl     sst$usedp		 bit (18) external static;
	dcl     sys_info$system_type	 fixed bin external static;
	dcl     unpaged_page_tables$	 external static;

	dcl     config_$find_parm	 entry (char (4) aligned, pointer);
	dcl     syserr		 entry options (variable);
	dcl     sys_boot_info$contig_mem_size
				 fixed bin (26) ext static;

	dcl     (addr, divide, pointer, rel, null, segno)
				 builtin;

/*  */

announce_chwm$before:
     entry ();

/* Announce the number of pages left over after collection one loaded and initialized */

	call config_$find_parm ("chwm", parm_ptr);	/* Should we bother? */
	if parm_ptr = null ()
	then return;

	sltp = addr (slt$);

	suptop = divide (slt.free_core_start + 1023, 1024, 17, 0);
	initbase = divide ((slt.free_core_start + slt.free_core_size - 1), 1024, 17, 0);

	total = divide (sys_boot_info$contig_mem_size, 1024, 17, 0);
	n_pages = total - (initbase - suptop);

	call syserr (ANNOUNCE, "announce_chwm: ^d. pages used of ^d. in wired environment.", n_pages, total);

	upt_ptr = addr (int_unpaged_page_tables$);
	call syserr (ANNOUNCE, "announce_chwm: ^d. words used of ^d. in int_unpaged_page_tables.", upt.current_length, upt.max_length);
	return;

/*  */

announce_chwm$after:
     entry ();

/* Announce the number of pages left after segs are made paged */

	call config_$find_parm ("chwm", parm_ptr);	/* Should we bother? */
	if parm_ptr = null ()
	then return;

	sltp = addr (slt$);
	sstp = addr (sst_seg$);
	cmp = sst$cmp;

	total = 0;
	wired = 0;

	cmep = pointer (cmp, sst$usedp);		/* scan the used list */
	ptp = pointer (sstp, cme.ptwp);

	if sys_info$system_type = ADP_SYSTEM
	then wired_bit = adp_ptw.wired;
	else wired_bit = l68_ptw.wired;

	if ptp = sstp
	then total = total + 1;
	else if wired_bit
	then wired = wired + 1;
	else total = total + 1;

	do cmep = pointer (cmep, cme.fp) repeat pointer (cmep, cme.fp) while (rel (cmep) ^= sst$usedp);

	     ptp = pointer (sstp, cme.ptwp);		/* get pointer to page table word */
	     if sys_info$system_type = ADP_SYSTEM
	     then wired_bit = adp_ptw.wired;
	     else wired_bit = l68_ptw.wired;

	     if ptp = sstp
	     then /* free */
		total = total + 1;
	     else if wired_bit
	     then wired = wired + 1;
	     else total = total + 1;
	end;

	call syserr (ANNOUNCE, "announce_chwm: ^d. pages wired, ^d. pages usable.", wired, total);

	upt_ptr = addr (unpaged_page_tables$);
	call syserr (ANNOUNCE, "announce_chwm: ^d. words used of ^d. in unpaged_page_tables.", upt.current_length, upt.max_length);
	return;					/* End of announce_chwm$after */

%page;
%include slt;
%page;
%include cmp;
%page;
%include "ptw.l68";
%page;
%include "ptw.adp";
%page;
%include syserr_constants;
%page;
%include system_types;
%page;
%include unpaged_page_tables;

/*  */

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   announce_chwm: WWW. pages used of XXX. in wired environment.

   S: $info

   T: $init

   M: This message is produced when the CHWM parameter is specified on
   the PARM CONFIG card. WWW is the number of pages of memory which
   remain unused (out of a maximum of XXX) after all the segments in 
   collection one have been loaded, and all the segments constructed by 
   collection one have been created.

   A: $ignore


   Message:
   announce_chwm: WWW. words used of XXX. in int_unpaged_page_tables.

   S: $info

   T: $init

   M: This message is produced when the CHWM parameter is specified on
   the PARM CONFIG card.  WWW is the number of words of the XXX word 
   long segment int_unpaged_page_tables used to hold page tables for
   temporary collection 1 segments.

   A: $ignore


   Message:
   announce_chwm: WWW pages wired, UUU pages usable.

   S: $info

   T: $init

   M: This message is produced when the CHWM paramter is specified on
   the PARM CONFIG card. WWW is the number of wired pages in collection
   one. UUU is the number of available main memory frames, including those
   occupied by wired pages, but not those occupied by unpaged segments.

   A: $ignore


   Message:
   announce_chwm: WWW. words used of XXX. in unpaged_page_tables.

   S: $info

   T: $init

   M: This message is produced when the CHWM parameter is specified on
   the PARM CONFIG card.  WWW is the number of words of the XXX word long 
   segment unpaged_page_tables used to hold page tables for permanent
   "unpaged" segments.

   A: $ignore

   END MESSAGE DOCUMENTATION */

     end announce_chwm;




		    bce_abs_seg.pl1                 11/11/89  1107.2rew 11/11/89  0807.4       19575



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-05-13,GJohnson), approve(86-05-13,MCR7387),
     audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056):
     Correct error message documentation.
                                                   END HISTORY COMMENTS */


bce_abs_seg: proc; return;

/* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */

/* Maintains a list of abs-segs to be freed (sdw's zeroed) at the end of a bce
pass.  Keith Loepere, May 1984. */

dcl  abs_seg_count		        fixed bin init (0) static;
dcl  abs_seg_index		        fixed bin;
dcl  abs_seg_list		        (128) fixed bin (17) unal static;
dcl  addr			        builtin;
dcl  baseptr		        builtin;
dcl  dimension		        builtin;
dcl  free_sdw		        fixed bin (71) init (0) static options (constant);
dcl  pmut$swap_sdw		        entry (ptr, ptr);
dcl  seg_num		        fixed bin (15) parameter;
dcl  syserr		        entry options (variable);

add: entry (seg_num);				/* add to list */

	abs_seg_count = abs_seg_count + 1;
	if abs_seg_count > dimension (abs_seg_list, 1) then call syserr (CRASH, "bce_abs_seg: Too many bce abs-segs.");
	abs_seg_list (abs_seg_count) = seg_num;
	return;

free: entry;					/* zero abs-seg sdws */

	do abs_seg_index = 1 to abs_seg_count;
	     call pmut$swap_sdw (baseptr (abs_seg_list (abs_seg_index)), addr (free_sdw));
	end;
	abs_seg_count = 0;
	return;
%page; %include syserr_constants;
%page;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   bce_abs_seg: Too many bce abs-segs.

   S: $crash

   T: $init

   M: More per-bce pass abs-segs were encountered than fit in the abs-seg
   array.  This is a software error.

   END MESSAGE DOCUMENTATION */

     end;




		    boot_rpv_subsystem.pl1          11/11/89  1107.2r w 11/11/89  0807.4       21186



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1983 *
        *                                                         *
        *********************************************************** */
/* BOOT_RPV_SUBSYSTEM -- uses hc_load_mpc to load FW in the RPV MPC */
/*                       uses config_data_ and the slt to find the FW */
/*		     contract is to both print (bce_error) informative */
/*		     message on errors and return code */

/* format: style2 */

boot_rpv_subsystem:
     procedure (FWid, Code);

	declare FWid		 character (*);
	declare Code		 fixed bin (35);

	declare hc_load_mpc		 entry (char (8) aligned, ptr, fixed bin (18), char (*), fixed bin (35));
	declare slt_manager$get_seg_ptr
				 entry (char (32) aligned) returns (ptr);
          declare bce_error		 entry options (variable);

          declare slt$		 aligned external static;

	declare sys_boot_info$disk_mpc_chanid
				 char (8) aligned external static;
	declare sys_boot_info$disk_mpc_model_number
				 fixed bin external static;

	declare fw_seg_name		 char (32) aligned;
	declare fw_seg_ptr		 pointer;
	declare fw_seg_length	 fixed bin (18);
	declare x			 fixed bin;
	declare problem		 char (64);
	declare ME		 char (32) init ("boot_rpv_subsystem") int static options (constant);

/* format: off */
%page; %include slte;
%page; %include slt;

/* format: on */


	Code = 0;
	fw_seg_name = "fw." || FWid;

	fw_seg_ptr = slt_manager$get_seg_ptr (fw_seg_name);
	if fw_seg_ptr = null ()
	then do;
		call bce_error (0, "^a: No firmware available for model ^d MPC.", ME,
		     sys_boot_info$disk_mpc_model_number);
		Code = 1;
		return;
	     end;

	sltp = addr (slt$);
	sltep = addr (slt.seg (bin (baseno (fw_seg_ptr), 18)));
	fw_seg_length = divide (slte_uns.bit_count, 36, 24, 0) - 1;

	call hc_load_mpc (sys_boot_info$disk_mpc_chanid, fw_seg_ptr, fw_seg_length, problem, Code);

	if Code ^= 0
	then call bce_error (Code, "^a: ^a booting ^d disk MPC ^a.", ME, problem, sys_boot_info$disk_mpc_model_number,
		sys_boot_info$disk_mpc_chanid);
	return;
     end boot_rpv_subsystem;




		    boot_tape_io.pl1                11/11/89  1107.2r w 11/11/89  0807.4       77679



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


/* format: style4,delnl,insnl,tree,ifthenstmt,indnoniterend */
boot_tape_io:
     procedure;

/* TAPE_IO - Magnetic Tape I/O Package for Multics Initialization
   9/9/68 - Noel I. Morris
   converted for IOM operation - 9/15/71 by N. I. Morris
   converted for MTS-500 operation - 8/27/73 by N. I. Morris
   converted to IOBM to avoid buffer split problem - 12/29/75 by B. Greenberg
   modified 1/25/76 by Noel I. Morris
   modified April 1981 by Chris Jones for io_manager conversion
   Modified March 1982 by C. Hornig for MR10 io_manager.
   Modified May   1982 by BIM for sys_boot_info as source of tape data.
   Modified April 1983 by K. Loepere for early entrypoint
   Modified October 1983 by Keith Loepere for loading mst in collection 1.
*/

dcl  chanid char (8) aligned;				/* name of tape channel */
dcl  rcode fixed bin (35);				/* error code */
dcl  op bit (6);					/* tape operation code */
dcl  buffabs1 fixed bin (26);				/* absolute address */
dcl  device_bits bit (6) aligned;			/* device number from PCW */
dcl  device fixed bin (6);

dcl  sys_boot_info$tape_device_number fixed bin (6) ext static;
dcl  sys_boot_info$tape_channel_number fixed bin (7) ext static;
dcl  sys_boot_info$tape_iom_number fixed bin (3) ext static;

dcl  TAPE_IO_EVENT fixed bin (35) static options (constant) init (15594741861);
						/* "tape" */

dcl  absadr entry (ptr, fixed bin (35)) returns (fixed bin (26));
dcl  pxss$addevent entry (fixed bin (35));
dcl  pxss$delevent entry (fixed bin (35));
dcl  pxss$notify entry (fixed bin (35));
dcl  pxss$wait entry;
dcl  syserr entry options (variable);

dcl  1 physical_record_buffer$ external,
       2 prb aligned,				/* give it an effective alias */
         3 bootload_loader_leftovers aligned,
	 4 buffer_index bit (18),			/* index to current buffer */
	 4 cur_buffer (1040) fixed bin,		/* record currently being processed */
         3 first_used_here aligned,
	 4 pad (33) fixed bin,
	 4 idcw like idcw,				/* IDCW for readingtape */
	 4 dcw1 like dcw,				/* IOTD DCW for tape read */
	 4 statp ptr,				/* pointer to status word */
	 4 ima like io_manager_arg,			/* args for connect */
	 4 flags,
	   5 reading_ahead bit (1) unaligned,		/* reading-ahead is in progress */
	   5 pad bit (35) unaligned,
	 4 ra_idcw like idcw,			/* IDCW for readingtape */
	 4 ra_dcw1 like dcw,			/* IOTD DCW for tape read */
	 4 ra_buffer (1040) fixed bin;		/* for read-ahead */

dcl  (addr, binary, bit, mod, null, rel, string, substr, unspec) builtin;
%page;
init_tape:
     entry;

/* INIT_TAPE/FINAL_TAPE - Initialize and Clean Up After Initialization Tape I/O. */

	unspec (prb.first_used_here) = ""b;		/* clear memory left from BOS */

	device = sys_boot_info$tape_device_number;
	device_bits = bit (device, 6);

	call io_chnl_util$iom_to_name (sys_boot_info$tape_iom_number, sys_boot_info$tape_channel_number, chanid, rcode);
	if rcode ^= 0 then call syserr (1, "boot_tape_io: code ^d from io_chnl_util$iom_to_name.", rcode);
	call io_manager$assign (prb.ima.chx, chanid, pxss$notify, TAPE_IO_EVENT, prb.statp, rcode);
	if rcode ^= 0				/* Tell the multiplexor we wish to use tape. */
	then call syserr (1, "boot_tape_io: Code ^d from io_manager$assign.", rcode);

	buffabs1 = absadr (addr (prb), rcode);
	if rcode ^= 0 then call syserr (1, "boot_tape_io: Code ^d from absadr.", rcode);

	prb.idcw.count = bit (binary (1, 6));		/* Set count field in IDCW. */
	prb.idcw.device = device_bits;		/* Copy the device code into instruction DCW. */
	prb.idcw.code = "111"b;			/* Make sure IDCW ID bits are on. */
	prb.idcw.ext = substr (bit (buffabs1), 3, 6);
	prb.idcw.ext_ctl = "1"b;
	string (prb.ra_idcw) = string (prb.idcw);
	prb.ra_idcw.command = "000101"b;		/* READ */

	prb.dcw1.address = bit (binary (mod (buffabs1 + binary (rel (addr (prb.cur_buffer)), 18), 1f18b), 18));
	prb.ra_dcw1.address = bit (binary (mod (buffabs1 + binary (rel (addr (prb.ra_buffer)), 18), 1f18b), 18));
						/* Set address in DCW's */
	prb.dcw1.tally, prb.ra_dcw1.tally = bit (binary (1040, 12));

	prb.ima.bound = 0;
	prb.ima.pcw = ""b;
	prb.ima.ptp = null ();			/* use absolute mode */
	return;

final_tape:
     entry;

	call io_manager$mask (prb.ima.chx);
	call io_manager$unassign (prb.ima.chx, (0));
	return;
%page;
/* GET_UNIT/SET_UNIT - Get Current Unit Number and Set New Unit Number. */

get_unit:
     entry (unit_no);

dcl  unit_no fixed bin (6);				/* tape unit device number */


	unit_no = binary (prb.idcw.device, 6);		/* Return the device code from IDCW. */

	return;

set_unit:
     entry (unit_no);


	prb.idcw.device = bit (unit_no);		/* Set the new tape unit number. */

	return;					/* All finished. Return to caller. */
%page;
/* Entries for Performing Tape I/O Operations. */

dcl  ret_status fixed bin (5);			/* major status from I/O operation */

read:
     entry (ret_status);

	op = "000101"b;
	go to connect;				/* Operation is Read Tape Binary. */

write:
     entry (ret_status);

	op = "001101"b;
	go to connect;				/* Operation is Write Tape Binary. */



backspace:
     entry (ret_status);

	op = "100110"b;
	go to connect;				/* Operation is Backspace Record. */



rewind:
     entry (ret_status);

	op = "111000"b;
	go to connect;				/* Operation is Rewind. */



unload:
     entry (ret_status);

	op = "111010"b;
	go to connect;				/* Operation is Rewind and Unload. */



skip_file:
     entry (ret_status);

	op = "100101"b;
	go to connect;				/* Operation is Forwardspace File. */



set_density_800:
     entry (ret_status);

	op = "110000"b;
	go to connect;				/* Operation is Set Density to 800. */



set_density_1600:
     entry (ret_status);

	op = "110101"b;
	go to connect;				/* Operation is Set Density to 1600. */
%page;
/* CONNECT - Issue Connect and Handle Status. */

connect:
	if prb.flags.reading_ahead then do;
	     call wait_for_status;
	     prb.flags.reading_ahead = "0"b;

	     if op = "000101"b then do;		/* did we guess right? */
		prb.cur_buffer = prb.ra_buffer;
		goto read_done;
		end;

/* We blew it. With luck it won't matter. */
	     end;

	prb.idcw.command = op;			/* Set tape operation in IDCW. */
	if (op = "000101"b) | (op = "001101"b)		/* If reading or writing tape ... */
	then prb.idcw.chan_cmd = "000000"b;		/* Set unit record transfer. */
	else prb.idcw.chan_cmd = "000010"b;		/* Set non-data transfer. */

	prb.ima.listp = addr (prb.idcw);
	call io_manager$connect_abs (prb.ima);		/* Fire up the device */
	call wait_for_status;
read_done:
	ret_status = binary (prb.statp -> io_status_word.power || prb.statp -> io_status_word.major, 5);
						/* Return the major status and the power bit. */

	if (op = "000101"b) & (ret_status = 0) then do;	/* if we just completed a read */
	     prb.ima.listp = addr (prb.ra_idcw);
	     call io_manager$connect_abs (prb.ima);	/* then lets keep going */
	     prb.flags.reading_ahead = "1"b;
	     end;

	return;


wait_for_status:
     procedure;

	call pxss$addevent (TAPE_IO_EVENT);
	do while (^prb.statp -> io_status_word.t);
	     call pxss$wait;
	     call pxss$addevent (TAPE_IO_EVENT);
	end;
	call pxss$delevent (TAPE_IO_EVENT);
	return;

     end wait_for_status;
%page;
%include iom_pcw;
%include iom_dcw;
%include io_status_word;
%include io_manager_dcls;
%include io_chnl_util_dcls;
%page;
/* BEGIN MESSAGE DOCUMENTATION

   Message:
   boot_tape_io: Code CODE from io_manager$assign

   S: $crash

   T: $init

   M: The bootload tape reading package could not assign the bootload
   tape drive to itself.
   $err

   A: $boot_tape

   Message:
   boot_tape_io: Unable to allocate buffer.

   S: $crash

   T: $init

   M: The bootload tape reading package could not allocate a wired-down buffer
   into which to read the bootload tape.
   $err

   A: $boot_tape

   Message:
   boot_tape_io: Code CODE from absadr.

   S: $crash

   T: $init

   M: boot_tape_io was unable to find the address of its buffer.
   $err

   A: $boot_tape

   END MESSAGE DOCUMENTATION */

     end boot_tape_io;




		    collect_free_core.pl1           11/11/89  1107.2r w 11/11/89  0815.2       47610



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


/* format: style2 */

collect_free_core:
     procedure;

/*

   This procedure is called at the end of collection 1 initialization by
real_initializer.  It inspects the SDW's for all "unpaged" segments, and marks
all core map entries which describe page frames containing words of these
segments.  All core map entries are then scanned, and any unmarked page frames
are freed.

   Written by Bernard Greenberg,  3/19/74.   */
/* Last modified 8/12/74 by BSG to abs-wire toehold for IOBM system */
/* Modified 8/82 BIM for $early entrypoint that marks initsegs and sup segs */
/* Remodified 10/82 BIM to remove same -- it was unneccessary */
/* Modified 9/83, Keith Loepere to tolerate paged wired segs */
/* Modified 12/83, Keith Loepere for breakpoint page support */

	dcl     slt$		 bit (36) external static;
	dcl     dseg$		 (0:4095) fixed bin (71) ext static;

	dcl     sst$cmp		 pointer external static;
	dcl     sst$last_core_block	 fixed bin (18) external static;

	dcl     absadr		 external entry (ptr, fixed bin (35)) returns (fixed bin (26));
	dcl     freecore		 external entry (fixed bin (18));
						/* entry to free a core frame */
	dcl     sdw_util_$dissect	 entry (ptr, ptr);
	dcl     (i, j)		 fixed bin (18);	/* temporaries */

	declare 1 sdwi		 aligned like sdw_info;

	dcl     cmp		 pointer;		/* core map and dseg pointers */
	dcl     (addr, fixed, baseno, divide)
				 builtin;

	declare PAGE_SIZE		 fixed bin init (1024) int static options (constant);
	declare 1 CME		 (0:sst$last_core_block) aligned like cme based (cmp);

/* format: off */

%page; %include slt;
%page; %include slte;
%page; %include scs;
%page; %include cmp;
%page; %include sdw_info;
%page; %include unpaged_page_tables;

/* format: on */


	sltp = addr (slt$);

	cmp = sst$cmp;				/* get pointer to core map array */

	begin;
	     declare bound_bootload_0$      ext static bit (36) aligned;
	     declare int_unpaged_page_tables$ ext static bit (36) aligned;
	     declare unpaged_page_tables$   ext static;
	     declare segno		      builtin;

/* Force the memory for bound_bootload_0 to be reclaimed now.
Note, though, that the first two pages thereof (the toehold) will be claimed
by the toehold's sdw. */
/* Also, int_upt is no longer needed.  It was not made paged by make_segs_paged
(and memory claimed) since it was needed until that program finished. */

	     dseg$ (segno (addr (bound_bootload_0$))) = 0;
	     dseg$ (segno (addr (int_unpaged_page_tables$))) = 0;
	     addr (unpaged_page_tables$) -> upt.iupt_absloc = 0; /* for dump analyzers */
	     addr (unpaged_page_tables$) -> upt.iupt_last_loc = 0;
	end;

	do i = slt.first_sup_seg to slt.last_sup_seg;
	     call PROCESS_SEGMENT (i);
	end;

PROCESS_SEGMENT:
     procedure (segno);
	declare segno		 fixed bin (18);
	declare sdwp		 pointer;

	sdwp = addr (dseg$ (segno));			/* construct a pointer to the sdw for this seg */
	unspec (sdwi) = ""b;
	call sdw_util_$dissect (sdwp, addr (sdwi));
	sltep = addr (slt.seg (segno));
	if slte.breakpointable 
	then sdwi.size = sdwi.size - 1024;		/* subtract off bkpt page */
	if ^sdwi.faulted & ((^slte.paged) | slte.layout_seg) & ^slte.abs_seg
	then call mark_core (absadr (baseptr (segno), (0)), sdwi.size);/* mark the start of the remaining words as used */

	return;

mark_core:
     procedure (absadr, length);

/* This procedure marks a core page frame
   as in use by "unpaged" segments */

	dcl     absadr		 fixed bin (26);	/* absolute address  pointing into page to be marked */
	dcl     first_page		 fixed bin (18);
	dcl     last_page		 fixed bin (18);
	dcl     length		 fixed bin (19);

	first_page = divide (absadr, PAGE_SIZE, 26, 0);
	last_page = divide (absadr + length - 1, PAGE_SIZE, 26, 0);

	begin;
	     declare 1 CMES		      (last_page - first_page + 1) aligned like cme defined (CME (first_page));

	     declare aa		      fixed bin;
	     declare syserr		      entry options (variable);

	     declare 1 TEMPLATE_CME	      aligned like CME;

	     unspec (TEMPLATE_CME) = ""b;
	     TEMPLATE_CME.bp, TEMPLATE_CME.fp = (18)"0"b;
	     TEMPLATE_CME.abs_w = "1"b;
	     CMES (*) = TEMPLATE_CME;
	end;
     end mark_core;
     end PROCESS_SEGMENT;


	do i = 0 to 7;				/* loop through all controllers, scanning core */
	     if scs$controller_data (i).online
	     then do;
		     do j = scs$controller_data (i).base
			to scs$controller_data (i).base + scs$controller_config_size (i) - 1;
						/* loop over all pages in controller */
			if CME (j).fp = (18)"1"b
			then call freecore (j);	/* free if not being used */
		     end;
		end;
	end;

	return;

     end collect_free_core;




		    create_rpv_partition.pl1        11/11/89  1107.2r w 11/11/89  0815.7      150516



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-05-13,GJohnson), approve(86-05-13,MCR7387),
     audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056):
     Correct error message documentation.
  2) change(86-05-29,Fawcett), approve(86-04-11,MCR7383),
     audit(86-05-29,GDixon), install(86-07-17,MR12.0-1097):
     Implement support of devices using 512 word IO.
                                                   END HISTORY COMMENTS */

create_rpv_partition: proc (rpv_pvtx, rpv_labelp, n_records, part_name, code);

/* routine to move pages around on the rpv (as yet not by any means
accepted for paging) so as to be able to create the named partition.

This program is very cautious about moving pages around and always writes
everything once it modifies it.

The idea is to find where the partition must go (high only), find segments
with pages in that area, move them elsewhere, update their vtoces and file
maps accordingly, and then get to updating the label to show the partition.

Everything is done so as to be interruptable without affecting the state of
the disk, with the possible exception of marking a few extra pages as used.

Initially coded by Keith Loepere, March 1983, against everyone's better 
judgment, including mine. */

/* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */

dcl  ME			        char (20) init ("create_rpv_partition") static options (constant);
dcl  bit_map_string		        bit (32) var;	/* a word of a bit map; used for counting bits therein */
dcl  bottom_to_vacate	        fixed bin;		/* lowest record in area to become new partition */
dcl  code			        fixed bin (35) parameter; /* standard */
dcl  error_table_$noalloc	        fixed bin (35) ext;
dcl  filemap_checksum_	        entry (ptr, fixed bin, bit (36) aligned);
dcl  first_free_rec		        fixed bin;		/* first record after low partitions */
dcl  have_vtoce		        bit (1) aligned;	/* true => rpv_vtoce_page contains the current vtoce */
dcl  last_free_rec		        fixed bin;		/* record just at start of high partitions */
dcl  n_records		        fixed bin parameter;	/* how big to make partition */
dcl  new_disk_record	        fixed bin;		/* record number to where to move page */
dcl  old_disk_record	        fixed bin;		/* of page we are to move */
dcl  part_name		        char (4) parameter;	/* for new partition */
dcl  part_num		        fixed bin;		/* loop counter on partitions */
dcl  read_disk$read_disk_no_test      entry (fixed bin, fixed bin, ptr, fixed bin (35));
dcl  1 rpv_label		        aligned like label based (rpv_labelp); /* label of rpv */
dcl  rpv_labelp		        ptr parameter;
dcl  rpv_page		        (1024) bit (36) aligned; /* page being moved around */
dcl  rpv_pvtx		        fixed bin parameter;	/* we trust this to point into pvt */
dcl  1 rpv_vol_map		        aligned like vol_map; /* work copy of vol_map */
dcl  1 rpv_vtoc_map		        aligned like vtoc_map;/* work copy of this */
dcl  rpv_vtoce_page		        (1024) bit (36) aligned; /* area to read a page of vtoces into */
dcl  seg_rec_num		        fixed bin;		/* loop counter on record num in a segment */
dcl  syserr		        entry options (variable);
dcl  syserr$error_code	        entry options (variable);
dcl  top_to_vacate		        fixed bin;		/* address of last record in area to become new partition */
dcl  vol_map_bit		        fixed bin;		/* bit in vol_map bit map word for record being considered */
dcl  vol_map_page		        fixed bin;		/* which page of vol_map we are putting used page bit into */
dcl  vol_map_word		        fixed bin;		/* pts to vol_map word being considered to find free page */
dcl  vtoc_filemap_checksum	        bit (36) aligned;	/* what checksum should be for vtoce test */
dcl  vtoc_map_bit		        fixed bin;		/* bit in vtoc bit map for this vtoce */
dcl  vtoc_map_word		        fixed bin;		/* word in vtoc bit map containing bit for this vtoce */
dcl  vtoc_num		        fixed bin;		/* loop counter thereon */
dcl  vtoc_record		        fixed bin;		/* record containing vtoce being considered */
dcl  vtoce_mod		        bit (1) aligned;	/* true => we moved a page of this seg and need to update vtoce on disk */
dcl  write_disk$write_disk_no_test    entry (fixed bin, fixed bin, ptr, fixed bin (35));

dcl (addr, addrel, bin, bit, dimension, divide, fixed, index, min, mod, size, substr) builtin;

	pvt_arrayp = addr (pvt$array);		/* so we can look at the device_type */


/* start by reading appropriate parts of disk header into work areas */

	call read_disk$read_disk_no_test (rpv_pvtx, VOLMAP_ADDR, addr (rpv_vol_map), code);
	if code ^= 0 then call bad_io (VOLMAP_ADDR);	/* first page */
	call read_disk$read_disk_no_test (rpv_pvtx, VOLMAP_ADDR + 1, addrel (addr (rpv_vol_map), 1024), code);
	if code ^= 0 then call bad_io (VOLMAP_ADDR + 1);	/* 2nd page thereof */
	call read_disk$read_disk_no_test (rpv_pvtx, VOLMAP_ADDR + 2, addrel (addr (rpv_vol_map), 2048), code);
	if code ^= 0 then call bad_io (VOLMAP_ADDR + 2);	/* 3rd page thereof */
	call read_disk$read_disk_no_test (rpv_pvtx, VTOC_MAP_ADDR, addr (rpv_vtoc_map), code);
	if code ^= 0 then call bad_io (VTOC_MAP_ADDR);

	if rpv_label.nparts >= dimension (rpv_label.parts, 1) then do;
	     call syserr (ANNOUNCE, "^a: No room in partition map for ^a.", ME, part_name);
	     code = error_table_$noalloc;
	     return;
	end;

/* Now we want to find where this space must go.  We do this completely from
the partition map.  The obvious method of just shaving the space from the
paging region described in the vol map may not work if we are on a second
try through this and have updated the vol map (shrunk it) but not updated
the partition map.  We would then reshrink the paging region.  So, we 
determine the partition's location from the last thing we would have written
before, the volume label. */

	first_free_rec = rpv_label.vtoc_size;		/* beginning of paging region or low partition area */
update_first:

/* this loop will try to find the end of the last low partition */

	do part_num = 1 to rpv_label.nparts;		/* look for low partitions */
	     if rpv_label.parts (part_num).frec = first_free_rec then do;
		first_free_rec = rpv_label.parts (part_num).frec + rpv_label.parts (part_num).nrec;
						/* where next low part should start */
		goto update_first;			/* start again to find a later low part */
	     end;
	end;

/* we now know the end of the last low partition and can therefore see
which partitions are high, in particular, which of them is lowest. */

	last_free_rec = rpv_label.vol_size;		/* end of paging or high part region */
	do part_num = 1 to rpv_label.nparts;
	     if rpv_label.parts (part_num).frec > first_free_rec then
						/* a high partition */
		last_free_rec = min (last_free_rec, rpv_label.parts (part_num).frec);
	end;

	bottom_to_vacate = last_free_rec - n_records;
	top_to_vacate = last_free_rec - 1;		/* these are the limits of the new partition */

	if rpv_vol_map.base_add < first_free_rec then do;
	     call syserr (ANNOUNCE, "^a: Paging region starts below end of low partitions.", ME);
	     code = error_table_$noalloc;
	     return;
	end;
	if rpv_vol_map.base_add + rpv_vol_map.n_rec > last_free_rec then do;
	     call syserr (ANNOUNCE, "^a: Paging region ends past start of high partitions.", ME);
	     code = error_table_$noalloc;
	     return;
	end;

	call compute_free_recs;			/* make sure we fit */
	if n_records > rpv_vol_map.n_free_rec then go to out_of_disk;

/* Mark as used all pages in this new partition region.  Some of these are
already so marked.  This marking helps keep future boots of a previous
release following our failure from grabbing them. */

	vol_map_word = divide (bottom_to_vacate - rpv_vol_map.base_add, 32, 17) + 1;
						/* start of bits for partition */
	if vol_map_word <= rpv_vol_map.bit_map_n_words then do;
	     vol_map_bit = mod (bottom_to_vacate - rpv_vol_map.base_add, 32) + 2;
	     substr (rpv_vol_map.bit_map (vol_map_word), vol_map_bit) = "0"b;
	     do vol_map_word = vol_map_word + 1 to rpv_vol_map.bit_map_n_words;
		rpv_vol_map.bit_map (vol_map_word) = "0"b; /* all used */
	     end;
	end;
	call compute_free_recs;			/* write this out */
	call write_disk$write_disk_no_test (rpv_pvtx, VOLMAP_ADDR, addr (rpv_vol_map), code);
	if code ^= 0 then call bad_io (VOLMAP_ADDR);	/* first page */
	call write_disk$write_disk_no_test (rpv_pvtx, VOLMAP_ADDR + 1, addrel (addr (rpv_vol_map), 1024), code);
	if code ^= 0 then call bad_io (VOLMAP_ADDR + 1);	/* 2nd page thereof */
	call write_disk$write_disk_no_test (rpv_pvtx, VOLMAP_ADDR + 2, addrel (addr (rpv_vol_map), 2048), code);
	if code ^= 0 then call bad_io (VOLMAP_ADDR + 2);	/* 3rd page thereof */

/* we don't ask at this time if vol_map shows enough room since we may have 
left its count bad from the last attempt through here so we just march on */

/* start up to look at segments */

	vol_map_word = 1;				/* place to start looking for free pages */
	vtoc_record = VTOC_ORIGIN - 1;		/* we'll read the next record for vtoces */

	have_vtoce = "0"b;
	vtocep = addr (rpv_vtoce_page);
	do vtoc_num = 0 to rpv_vtoc_map.n_vtoce - 1;

/* loop, getting vtoces, to look at segments */

	     if mod (vtoc_num, VTOCES_PER_RECORD (pvt_array (rpv_pvtx).device_type)) = 0 then do;
		have_vtoce = "0"b;			/* read in a set next time we need one */
		vtocep = addr (rpv_vtoce_page);
		vtoc_record = vtoc_record + 1;
	     end;
	     else vtocep = addrel (vtocep, size (vtoce));
	     vtoc_map_word = divide (vtoc_num, 32, 17);
	     vtoc_map_bit = mod (vtoc_num, 32) + 2;	/* find map bit */
	     if substr (rpv_vtoc_map.bit_map (vtoc_map_word), vtoc_map_bit, 1) then ; /* free vtoce */
	     else do;
		if have_vtoce then ;
		else do;				/* need to read */
		     call read_disk$read_disk_no_test (rpv_pvtx, vtoc_record, addr (rpv_vtoce_page), code);
		     if code ^= 0 then call bad_io (vtoc_record);
		     have_vtoce = "1"b;
		end;

		vtoce_mod = "0"b;			/* check out vtoce */
		call filemap_checksum_ (addr (vtoce.fm), fixed (vtoce.csl, 9), vtoc_filemap_checksum);
		if vtoce.fm_damaged | (vtoce.fm_checksum_valid & vtoc_filemap_checksum ^= vtoce.fm_checksum) then do;
		     call syserr (ANNOUNCE, "^a: vtoce ^d's file map is damaged.  Volume will need salvaging.", ME, vtoc_num);
		     code = error_table_$noalloc;
		     return;
		end;

/* now that we have found a real segment on disk, does it have pages in the
new partition area to be moved? */

		do seg_rec_num = 0 to fixed (vtoce.csl, 9) - 1;
		     if substr (vtoce.fm (seg_rec_num), 1, 1) then ; /* null page */
		     else do;
			old_disk_record = bin (substr (vtoce.fm (seg_rec_num), 2, 17), 17);
			if old_disk_record >= bottom_to_vacate & old_disk_record <= top_to_vacate then do; /* must move page out of region */

/* find a free page on the disk */

			     do vol_map_word = vol_map_word to rpv_vol_map.bit_map_n_words
				while (substr (rpv_vol_map.bit_map (vol_map_word), 2, 32) = "0"b); end;
			     if vol_map_word > rpv_vol_map.bit_map_n_words then go to out_of_disk;
			     vol_map_bit = index (substr (rpv_vol_map.bit_map (vol_map_word), 2, 32), "1"b) + 1;
			     new_disk_record = rpv_vol_map.base_add + (vol_map_word - 1) * 32 + vol_map_bit - 2;
			     if new_disk_record >= bottom_to_vacate then go to out_of_disk;

/* found a free page */

			     substr (rpv_vol_map.bit_map (vol_map_word), vol_map_bit, 1) = "0"b; /* use up page */
			     vol_map_page = divide (vol_map_word + 63, /* get wordno in vol_map */ 1024, 17);
			     call write_disk$write_disk_no_test (rpv_pvtx, VOLMAP_ADDR + vol_map_page, addrel (addr (rpv_vol_map), vol_map_page * 1024), code);
			     if code ^= 0 then call bad_io (VOLMAP_ADDR + vol_map_page); /* paranoid - force bit change out */

/* now move page of segment from old to new */

			     call read_disk$read_disk_no_test (rpv_pvtx, old_disk_record, addr (rpv_page), code);
			     if code ^= 0 then call bad_io (old_disk_record);
			     call write_disk$write_disk_no_test (rpv_pvtx, new_disk_record, addr (rpv_page), code);
			     if code ^= 0 then call bad_io (new_disk_record);

/* now to get vtoce updated */

			     vtoce_mod = "1"b;
			     vtoce.fm (seg_rec_num) = bit (fixed (new_disk_record, 18), 18);
			end;
		     end;
		end;

/* update vtoce on disk */

		if vtoce_mod then do;
		     vtoce.fm_checksum_valid = "1"b;
		     call filemap_checksum_ (addr (vtoce.fm), fixed (vtoce.csl, 9), vtoce.fm_checksum);
		     call write_disk$write_disk_no_test (rpv_pvtx, vtoc_record, addr (rpv_vtoce_page), code);
		     if code ^= 0 then call bad_io (vtoc_record);
		end;
	     end;
	end;

/* update vol_map header */

	rpv_vol_map.n_rec = bottom_to_vacate - rpv_vol_map.base_add;
	rpv_vol_map.bit_map_n_words = divide (rpv_vol_map.n_rec + 31, 32, 17);

/* we will count free records to avoid case where we just subtract records used
on each attempt and thereby screw up totals */

	call compute_free_recs;

/* update disk */

	call write_disk$write_disk_no_test (rpv_pvtx, VOLMAP_ADDR, addr (rpv_vol_map), code);
	if code ^= 0 then call bad_io (VOLMAP_ADDR);	/* updated volmap */

/* now we can put partition into header! */

	rpv_label.nparts = rpv_label.nparts + 1;
	rpv_label.parts (rpv_label.nparts).part = part_name;
	rpv_label.parts (rpv_label.nparts).frec = bottom_to_vacate;
	rpv_label.parts (rpv_label.nparts).nrec = n_records;

/* done!!! */

	code = 0;
	return;

out_of_disk:

/* help out next bootload of previous release that must free some disk */

	call compute_free_recs;
	call write_disk$write_disk_no_test (rpv_pvtx, VOLMAP_ADDR, addr (rpv_vol_map), code);
	call syserr (ANNOUNCE, "^a: Out of disk.", ME);
	code = error_table_$noalloc;
TERMINATE:
	return;
%page;
bad_io: proc (record_num);
dcl  record_num		        fixed bin parameter;
	call syserr$error_code (ANNOUNCE, code, "^a: Error accessing record ^d.", ME, record_num);
	goto TERMINATE;
     end;

compute_free_recs: proc;

/* look through bits to see new free figure */

	rpv_vol_map.n_free_rec = 0;
	do vol_map_word = 1 to rpv_vol_map.bit_map_n_words;
	     if vol_map_word < rpv_vol_map.bit_map_n_words then bit_map_string = substr (rpv_vol_map.bit_map (vol_map_word), 2, 32);
	     else bit_map_string = substr (rpv_vol_map.bit_map (vol_map_word), 2, mod (rpv_vol_map.n_rec - 1, 32) + 1);
	     vol_map_bit = index (bit_map_string, "1"b);
	     do while (vol_map_bit > 0);
		rpv_vol_map.n_free_rec = rpv_vol_map.n_free_rec + 1;
		bit_map_string = substr (bit_map_string, vol_map_bit + 1);
		vol_map_bit = index (bit_map_string, "1"b);
	     end;
	end;
	return;
     end;
%page;
%include disk_pack;
%include fs_vol_label;
%include pvte;
%include syserr_constants;
%include vol_map;
%include vtoc_map;
%include vtoce;
%page;
/* BEGIN MESSAGE DOCUMENTATION

   Message:
   create_rpv_partition: Paging region starts below end of low partitions.

   S: $crash

   T: $init

   M: An inconsistency was found in the partition map when adding a new 
   partition to the rpv.

   A: The rpv will need to be rebuilt.

   Message:
   create_rpv_partition: Paging region ends past start of high partitions.

   S: $crash

   T: $init

   M: An inconsistency was found in the partition map when adding a new
   partition to the rpv.

   A: The rpv will need to be rebuilt.

   Message:
   create_rpv_partition: vtoce NNN's file map is damaged.  Volume will need salvaging.

   S: $crash

   T: $init

   M: The vtoce named was found to be damaged when adding a new partition
   to the rpv.

   A: Salvage the rpv using a boot of the previous release.

   Message:
   create_rpv_partition: No room in partition map for NAME.

   S: $crash

   T: $init

   M: The partition map of the rpv was full.  The partition could not be 
   added.

   A: The rpv will need to be rebuilt.

   Message:
   create_rpv_partition: Out of disk.

   S: $crash

   T: $init

   M: Not enough free space existed on the rpv to add the new partition.

   A: The rlv will have to be rebuilt.

   Message:
   create_rpv_partition: Error accessing record NNN.

   S: $crash

   T: $init

   M: An i/o error occured when accessing record NNN of the rpv while 
   attempting to add a new partition.

   A: Try again.  IF the error persists, the rpv will need to be rebuilt.

   END MESSAGE DOCUMENTATION */

     end;




		    disk_init.pl1                   11/11/89  1107.2r w 11/11/89  0815.7      211392



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */



/* format: style4,delnl,insnl,indattr,ifthen,dclind10 */
disk_init:
     procedure (pvtx, confp);				/* here to init disk routines */

/* DISK_INIT - Initialize Data Bases for Disk DIMs.
   recoded 6/19/70 - Noel I. Morris
   revised 8/17/73 by N. I. Morris for DSU-191 and RSR feature
   revised 3/27/75 by Noel I. Morris for new storage system
   revised 4/79 by Michael R. Jordan for MSS0500/1.
   revised 4/80 by Michael R. Jordan for dual controller MSU0500/1 subsystems.
   modified June 1981 by C. Hornig for new I/O.
   Modified February 1982 by C. Hornig for MR10 io_manager.
   modified March 1982 by J. Bongiovanni for better config card validation
   modified October 1983 by E. N. Kittlitz to not read off end of dsk card

   Modified March 1984 by T. Oke to initialize system wide free_q.
   Modified April 1984 by T. Oke to change channel table initialization
   algorithm and permit up to dskdcl_chans_per_subsys channels per
   sub-system.
   Modified April 1984 by T. Oke to add use of syserr_constants include file.

   Modified May 1984 by T. Oke to add adaptive optimization initialization.
   Modified September 1984 by Chris Jones to correct error message.
   Modified Nov 26, 1984 by Fawcett to support dev 0 and fips.
   Modified Jan 1985 by Paul Farley to correct a bug in channel counting.
   Modified Jun 1985 by Paul Farley to correct a bug in checking for
   shared spindle when dev_array(i) is zero.
   Modified July 1985 by Paul Farley to include a fix for the channel pick loop
   done by Tom Oke.
*/

/****^  HISTORY COMMENTS:
  1) change(85-09-09,Fawcett), approve(85-09-09,MCR6979),
     audit(86-01-17,CLJones), install(86-03-21,MR12.0-1033):
     Device zero support
     for FIPS.
  2) change(86-01-20,Fawcett), approve(86-04-11,MCR7383),
     audit(86-07-07,GDixon), install(86-07-17,MR12.0-1097):
     Add support for 512_WORD_IO devices, 3380 and 3390.
  3) change(86-06-05,GJohnson), approve(86-06-05,MCR7387),
     audit(86-06-10,Martinson), install(86-07-17,MR12.0-1091):
     Correct error message documentation.
                                                   END HISTORY COMMENTS */

dcl	pvtx		   fixed bin parameter;	/* index to PVT entry for device */
dcl	confp		   ptr parameter;		/* config card ptr */

dcl	sx		   fixed bin;		/* disk subsystem index */
dcl	type		   fixed bin (8);		/* disk device type */
dcl	name		   char (4) aligned;	/* disk device name */
dcl	chx		   fixed bin (35);		/* io_manager index for channel */
dcl	idx		   fixed bin (12);		/* channel ID index for disk_interrupt */
dcl	i		   fixed bin;		/* logical unit number index */
dcl	j		   fixed bin;		/* configuration card unit index */
dcl	k		   fixed bin;		/* .. */
dcl	ci		   fixed bin;
dcl	devt		   fixed bin;		/* device type for this model number */
dcl	dev_array		   (0:63) fixed bin;	/* device types indexed by device # */
dcl	rcode		   fixed bin (35);		/* error code */
dcl	base		   bit (24) aligned;	/* absolute address of DCW list */
dcl	fips_disk		   bit (1);
dcl	chan_array	   (dskdcl_chans_per_subsys) char (8) aligned;
						/* names of channels */

/* Channel table.  Indicates start channel and count on each adaptor. */

dcl	adaptor_index	   fixed bin;
dcl	adaptor_count	   fixed bin;

dcl	1 adaptor		   (4),			/* Can be 4 LA's */
	  2 channel_start	   fixed bin,
	  2 chantab_index	   fixed bin,
	  2 channel_count	   fixed bin,
	  2 channels_used	   fixed bin;

dcl	1 d		   like devtab;

/* as dskdcl's number of IO types is increased - so increase the hbound */

dcl	response		   (0:6) float bin (27) static options (constant) initial (
						/* */
			   100.0,			/* PAGE_READ */
			   50000.0,		/* PAGE_WRITE */
			   20.0,			/* VTOC_READ */
			   50.0,			/* VTOC_WRITE */
			   1.0,			/* TEST */
			   200.0,			/* BOOTLOAD_READ */
			   100000.0		/* BOOTLOAD_WRITE */
			   );

dcl	ME		   char (16) static options (constant) init ("disk_init");

dcl	absadr		   ext entry (ptr, fixed bin (35)) returns (fixed bin (24));
dcl	config_$find_2	   entry (char (4), char (4) aligned, pointer);
dcl	dctl$disk_inter	   entry (bit (36) aligned, fixed bin (3), bit (36) aligned);
dcl	syserr		   ext entry options (variable);

dcl	error_table_$io_not_configured
			   fixed bin (35) ext static;

dcl	(addr, addrel, bin, bit, clock, currentsize, divide, float, hbound, mod, null, ptr, rel, size,
	substr, unspec)	   builtin;

	prph_dsk_cardp = confp;
	disksp = addr (disk_seg$);			/* Get pointer to disk segment. */

	if disk_data.free_offset = "0"b then do;	/* If never initialized ... */
	     disk_data.free_offset = bit (bin (currentsize (disk_data), 18));
						/* Set offset of first disktab structure. */
	     statp = addr (disksp -> disk_data.status_mask);
						/* Get pointer to mask for disk status. */
	     status.power = "1"b;			/* Set up mask to detect error conditions. */
	     status.major = "1111"b;
	     status.channel_stat = "111"b;
	     status.central_stat = "111"b;

/* Thread all queue entries into the free list. */

	     unspec (disk_data.free_q) = "0"b;		/* clear stats */
	     do i = 1 to disk_data.free_q_size - 1;	/* Step through all queue entries. */
		disk_data.free_q_entries (i).next = rel (addr (disk_data.free_q_entries (i + 1)));
		disk_data.free_q_entries (i + 1).prev = rel (addr (disk_data.free_q_entries (i)));
	     end;					/* Make each entry point to the next one. */

	     disk_data.free_q.head = rel (addr (disk_data.free_q_entries (1)));
						/* The head of the list is the first entry. */
	     disk_data.free_q.tail = rel (addr (disk_data.free_q_entries (disk_data.free_q_size)));
						/* The tail of the list is the last entry. */
	     disk_data.lock = ""b;			/* clear the lock */

/* Initialize system wide loading information. */

	     unspec (disk_data.sys_info) = "0"b;
	     disk_data.sys_info (PAGE_READ).max_depth = 6.0;
	     disk_data.sys_info (PAGE_READ).depth_map = rel (addr (disk_data.sys_info (PAGE_READ).depth));

	     disk_data.sys_info (PAGE_WRITE).max_depth = float (disk_data.free_q_size) * 0.75;
	     disk_data.sys_info (PAGE_WRITE).depth_map = rel (addr (disk_data.sys_info (PAGE_WRITE).depth));

	     disk_data.sys_info (VTOC_READ).max_depth = 6.0;
	     disk_data.sys_info (VTOC_READ).depth_map = rel (addr (disk_data.sys_info (VTOC_READ).depth));

	     disk_data.sys_info (VTOC_WRITE).max_depth = 12.0;
	     disk_data.sys_info (VTOC_WRITE).depth_map = rel (addr (disk_data.sys_info (VTOC_WRITE).depth));

	     disk_data.sys_info (BOOTLOAD_READ).max_depth = 6.0;
	     disk_data.sys_info (BOOTLOAD_READ).depth_map = rel (addr (disk_data.sys_info (BOOTLOAD_READ).depth));

	     disk_data.sys_info (BOOTLOAD_WRITE).max_depth = 12.0;
	     disk_data.sys_info (BOOTLOAD_WRITE).depth_map = rel (addr (disk_data.sys_info (BOOTLOAD_WRITE).depth));

	     disk_data.sys_info (TEST).max_depth = 1.0;
	     disk_data.sys_info (TEST).depth_map = rel (addr (disk_data.sys_info (TEST).depth));

/* Initialize stagnation time limit for optimizer */

	     disk_data.stagnate_time = 5000000;		/* 5 seconds */
	     disk_data.max_depth_reset_time = clock ();
	end;

/* Initialize sub-system information. */

	pvt_arrayp = addr (pvt$array);		/* Get pointer to PVT array */
	pvtep = addr (pvt_array (pvtx));		/* Get pointer to PVT entry for this device. */

	type = pvte.device_type;			/* Extract device type from PVT entry. */
	name = pvte.devname;			/* Get name of disk subsytem. */

	do sx = 1 to disk_data.subsystems while (name ^= disk_data.name (sx));
	end;					/* Look for this subsystem already initialized. */

	pvtdip = addr (pvte.dim_info);		/* Get pointer to dim_info in PVT entry. */
	pvtdi.sx = sx;				/* Put sx where disk dim can find it */

	pvtdi.usable_sect_per_cyl = divide (sect_per_cyl (type), sect_per_rec (type), 17, 0) * sect_per_rec (type);
						/* Compute # of usable sectors on disk cylinder. */
	pvtdi.unused_sect_per_cyl = sect_per_cyl (type) - pvtdi.usable_sect_per_cyl;
						/* Compute # of unused sectors at end of cylinder. */

	if sx > disk_data.subsystems then do;		/* If not already initialized ... */
	     disk_data.subsystems = sx;		/* Update count of subsystems. */
	     disk_data.name (sx) = name;
	     disk_data.offset (sx) = disk_data.free_offset;
						/* Set pointer to place for disk data base. */

	     diskp = ptr (disksp, disk_data.free_offset); /* Get pointer to disk data base. */
	     call init_disk_database;			/* Set up disktab structure. */

	     disk_data.free_offset = rel (addrel (diskp, currentsize (disktab) + disktab.nchan * size (chantab)));
	end;					/* Update first unused location in segment. */

	else					/* If already initialized ... */
	     diskp = ptr (disksp, disk_data.offset (sx)); /* Get pointer to disk data base. */

	disktab.pvtx (pvte.logical_area_number) = pvtx;	/* Save PVT entry index in device table. */

	return;

IS_FIPS:
     procedure () returns (bit (1));
dcl	groupx		   fixed bin;
dcl	i		   fixed bin;

	do groupx = 1 to hbound (prph_dsk_card.group, 1) while (prph_dsk_card.group (groupx).model ^= -1);
	     if prph_dsk_card.group (groupx).model ^= 0 then do;
		do i = 1 to config_data_$disk_drive_model_names.count;
		     if config_data_$disk_drive_model_names.names (i).model = prph_dsk_card.group (groupx).model then
			return (config_data_$disk_drive_model_names.names (i).device_0_valid);
		end;
		call syserr (CRASH, "^a: Disk model ^d not found in config_data_.", ME,
		     prph_dsk_card.group (groupx).model);
	     end;
	end;
	call syserr (CRASH, "^a: No valid disk models found on PRPH ^a card.", ME, prph_dsk_card.name);
     end IS_FIPS;

init_disk_database:
     procedure;

	disktab.abs_mem_addr = absadr (addr (disktab), rcode);
	if rcode ^= 0 then
	     goto absadr_error;

/* Find maximum number of devices in disk subsystem. */

	call check_config_fields (prph_dsk_cardp, addr (prph_dsk_card.group));

	fips_disk = IS_FIPS ();
	if fips_disk then
	     disktab.first_dev = 0;
	else disktab.first_dev = 1;

	j = disktab.first_dev;

	do i = 1 to hbound (prph_dsk_card.group, 1) while (prph_dsk_card.group (i).model ^= -1);
						/* Count disk drives. */
	     call check_config_fields (prph_dsk_cardp, addr (prph_dsk_card.group (i).ndrives));
						/* Make sure fields are there */
	     if (j + prph_dsk_card.group (i).ndrives - disktab.first_dev) > hbound (dev_array, 1) then
						/* Too many drives. */
		call syserr (CRASH, "^a: Too many devices configured for ^a.  Max device is ^d.", ME, name,
		     hbound (dev_array, 1));
	     devt = prph_dsk_card.group (i).model;
	     if devt ^= 0 then do;
		do devt = 1 to hbound (MODEL, 1) while (MODEL (devt) ^= prph_dsk_card.group (i).model);
		end;
		if devt > hbound (MODEL, 1) then	/* Bad device model number. */
		     call syserr (CRASH, "^a: Unknown model number ^d on PRPH ^a", ME, prph_dsk_card.group (i).model,
			name);
		devt = MODELX (devt);		/* Get device type. */
	     end;
	     do k = j to j + prph_dsk_card.group (i).ndrives - 1;
		dev_array (k) = devt;		/* This can be zero! => no device present. */
	     end;
	     j = j + prph_dsk_card.group (i).ndrives;
	end;

	disktab.last_dev, disktab.dev_index = j - 1;	/* set max drive and scan index */

/* Setup master optimization information. */

	unspec (d.opt_info) = "0"b;
	do i = 0 to MAX_IO_TYPE;
	     sysp = addr (disk_data.sys_info (i));
	     d.opt_info (i).sys_info = rel (addr (sys_info.fraction));
	     if sys_info.max_depth > 1.0 then do;
		d.opt_info (i).slope = (response (i) - 1.0) / (sys_info.max_depth - 1.0);
		d.opt_info (i).intercept = ((response (i) * sys_info.max_depth) - 1.0) / (sys_info.max_depth - 1.0);
	     end;
	     else do;
		d.opt_info (i).slope = 0.0;
		d.opt_info (i).intercept = 1.0e10;
	     end;
	end;

/* Analyze device configuration for errors. */

	do i = disktab.first_dev to disktab.last_dev;	/* Look at each device configured. */
	     dp = addr (disktab.devtab (i));
	     if dev_array (i) > 0 then
		if shared_spindle (dev_array (i)) then	/* This guy has a buddy. */
		     if mod (i, 2) ^= 0 then do;	/* First of a pair. */
			if i >= disktab.last_dev then do;
						/* If this is the last one, the next is missing. */
MISSING_BUDDY:
			     call syserr (CRASH, "^a: ^a ^[^d^s^;^s^d^] must be configured if ^a ^d is configured.",
				ME, name, mod (i, 2) = 0, i - 1, i + 1, name, i);
			end;
			if dev_array (i + 1) ^= dev_array (i) then do;
						/* Buddies must be the same type. */
BAD_BUDDY:
			     call syserr (CRASH, "^a: Devices ^d and ^d of ^a must have the same model number.", ME,
				i - 1 + mod (i, 2), i + mod (i, 2), name);
			end;
			devtab.buddy = i + 1;	/* Next guy has to be buddy. */
			devtab.pdi = i;		/* Set primary device index. */
		     end;
		     else do;			/* The second of a pair. */
			if i <= 1 then
			     goto MISSING_BUDDY;
			if dev_array (i - 1) ^= dev_array (i) then
			     goto BAD_BUDDY;
			devtab.buddy,		/* Last one is the buddy ... */
			     devtab.pdi = i - 1;	/* ... and the primary device. */
		     end;
		else do;				/* Not a shared spindle. */

		     devtab.buddy = 0;		/* No buddy */
		     devtab.pdi = i;		/* This is the primary device */
		end;
	     else ;

/* setup optimization and queues. */

	     unspec (devtab.opt_info) = unspec (d.opt_info);
	     unspec (devtab.wq) = "0"b;
	end;

/* Analyze channel information for disk subsystem. */

	if prph_dsk_card.nchan > dskdcl_chans_per_subsys then
TOO_MANY_CHANNELS:
	     call syserr (CRASH, "^a: Too many channels configured for ^a.  Limit is ^d.", ME, name,
		dskdcl_chans_per_subsys);

	do j = 1 to prph_dsk_card.nchan;		/* Determine the channels defined on disk card. */
	     call io_chnl_util$iom_to_name ((prph_dsk_card.iom), (prph_dsk_card.chan + j - 1), chan_array (j), rcode);
	     if rcode ^= 0 then
		call syserr (CRASH, "^a: Invalid channel on PRPH ^a card.", ME, prph_dsk_card.name);
	end;

/* Store adaptor information. */

	adaptor_index = 1;
	adaptor (1).channel_start = 1;
	adaptor (1).channel_count = prph_dsk_card.nchan;
	adaptor (1).channels_used = 0;
	adaptor (1).chantab_index = 1;

	chnl_cardp = null ();
	call config_$find_2 ("chnl", name, chnl_cardp);	/* Look for chnl card for this subsystem. */
	if chnl_cardp ^= null () then			/* If chnl card found ... */
	     do i = 1 to 3 while (chnl_card.group (i).iom > 0);
						/* Look at 3 possible channel groups. */
	     call check_config_fields (chnl_cardp, addr (chnl_card.group (i).nchan));
						/* Make sure fields are all there */

	     adaptor_index = adaptor_index + 1;
	     adaptor (adaptor_index).channel_start = j;
	     adaptor (adaptor_index).channel_count = chnl_card.group (i).nchan;
	     adaptor (adaptor_index).channels_used = 0;
	     adaptor (adaptor_index).chantab_index = j;	/* note start */

	     do k = 0 to chnl_card.group (i).nchan - 1;	/* Determine channels in each group. */
		if j > dskdcl_chans_per_subsys then
		     goto TOO_MANY_CHANNELS;
		call io_chnl_util$iom_to_name ((chnl_card.group (i).iom), (chnl_card.group (i).chan + k),
		     chan_array (j), rcode);
		if rcode ^= 0 then
		     call syserr (CRASH, "^a: Invalid channel on CHNL ^a card", ME, chnl_card.name);
		j = j + 1;			/* Step channel index. */
	     end;
	end;

	disktab.nchan = j - 1;			/* Set total number of channels. */


/* Calculate start of channel table */

	disktab.channels = rel (addrel (diskp, currentsize (disktab)));

/* Tell the iom manager about the disk. */

	ci = 0;					/* No channel entries filled yet. */
	adaptor_count = adaptor_index;
	adaptor_index = 0;
	do i = 1 to disktab.nchan;			/* Iterate for all channels. */
re_scan_adaptor:
	     adaptor_index = mod (adaptor_index, adaptor_count) + 1;
	     if adaptor (adaptor_index).channel_count <= 0 then
		goto re_scan_adaptor;		/* skip empty slot */
	     else do;
		adaptor (adaptor_index).channel_count = adaptor (adaptor_index).channel_count - 1;
		k = adaptor (adaptor_index).channel_start + adaptor (adaptor_index).channels_used;
		adaptor (adaptor_index).channels_used = adaptor (adaptor_index).channels_used + 1;
		ci = ci + 1;
		idx = (sx * dskdcl_chans_per_subsys) + ci - 1;
						/* Compute channel identification index */
		cp = addr (ptr (disksp, disktab.channels) -> disk_channel_table (ci));
						/* get pointer to channel info */
		chantab.chanid = chan_array (k);	/* Save channel name */

		call io_manager$assign (chx, chan_array (k), dctl$disk_inter, (idx), chantab.statusp, rcode);
		if rcode ^= 0 then			/* If error ... */
		     if rcode ^= error_table_$io_not_configured then
			call syserr (CRASH, "^a: Unable to assign ^a for ^a.", ME, chan_array (k),
			     disk_data.name (sx));
		     else ;
		else do;
		     chantab.chx = chx;		/* Save io_manager index in channel table. */
		     chantab.in_use = "1"b;		/* Indicate it's in use. */
		     disktab.channels_online = disktab.channels_online + 1;
		end;

/* Fill in all constant information in the DCW list. */

		base = bit (absadr (addr (cp -> chantab.select_data.limit), rcode));
		if rcode ^= 0 then			/* Get absolute address of base of DCW list. */
absadr_error:
		     call syserr (CRASH, "^a: error ^w from absadr for ^a ^a", ME, rcode, disk_data.name (sx),
			chan_array (k));

		idcwp = addr (chantab.rstdcw);	/* Get pointer to restore IDCW. */
		idcw.command = "42"b3;		/* command = 42 (restore access arm) */
		idcw.code = "111"b;			/* command dcw */
		idcw.control = "10"b;		/* set control to "proceed" */
		idcw.chan_cmd = "02"b3;		/* non-data transfer */
		idcw.count = "01"b3;		/* count of 1 */

		idcwp = addr (chantab.scdcw);		/* Get pointer to seek IDCW. */
		idcw.command = seek_command (devt);	/* set the correct seek type for the devices on this channel */
		idcw.ext = substr (base, 1, 6);	/* address extension */
		idcw.code = "111"b;			/* command dcw */
		idcw.ext_ctl = "1"b;		/* Turn on address extension bit. */
		idcw.control = "10"b;		/* set control to proceed */

		dcwp = addr (chantab.sddcw);		/* Get pointer to seek data xfer DCW. */
		dcw.address = substr (base, 7);
		dcw.tally = "0001"b3;

		idcwp = addr (chantab.dcdcw);		/* Get pointer to disk read/write IDCW. */
		idcw.code = "111"b;			/* command dcw */
		idcw.ext_ctl = "1"b;		/* Turn on address extension bit. */

		dcwp = addr (chantab.dddcw);		/* Get pointer to disk data xfer DCW. */

		base = bit (absadr (addr (cp -> chantab.detailed_status), rcode));
		if rcode ^= 0 then
		     go to absadr_error;		/* Get absolute address for detailed status. */

		idcwp = addr (chantab.dscdcw);	/* Get pointer to read status IDCW. */
		idcw.command = "22"b3;		/* Read Status Register command */
		idcw.ext = substr (base, 1, 6);
		idcw.code = "111"b;
		idcw.ext_ctl = "1"b;

		dcwp = addr (chantab.dsddcw);		/* Get pointer to status data xfer DCW. */
		dcw.address = substr (base, 7);
		dcw.tally = "0004"b3;

		idcwp = addr (chantab.rssdcw);	/* Get pointer to reset status IDCW. */
		idcw.command = "00"b3;		/* Request Status command */
		idcw.ext = substr (base, 1, 6);
		idcw.code = "111"b;
		idcw.ext_ctl = "1"b;
	     end;
	end;

	return;


     end init_disk_database;

/* Check that specified fields exist on config card */

check_config_fields:
     proc (cardp, fieldp);

dcl	cardp		   ptr;			/* Pointer to config card */
dcl	fieldp		   ptr;			/* Pointer to field within that card */

dcl	field_inx		   fixed bin;		/* Index of field */

	field_inx = bin (rel (fieldp)) - bin (rel (cardp));
	if field_inx > cardp -> config_card.type_word.n_fields then
						/* Not there */
	     call syserr (CRASH, "^a: Invalid format for ^a^[ ^a^;^1s^] card.", ME, cardp -> config_card.word,
		(cardp -> config_card.type_word.field_type (1) = CONFIG_STRING_TYPE
		| cardp -> config_card.type_word.field_type (1) = CONFIG_SINGLE_CHAR_TYPE), cardp -> chnl_card.name);

     end check_config_fields;

%include config_chnl_card;
%page;
%include config_data_dcls;
%page;
%include config_deck;
%page;
%include config_prph_dsk_card;
%page;
%include dskdcl;
%page;
%include fs_dev_types;
%page;
%include io_chnl_util_dcls;
%page;
%include io_manager_dcls;
%page;
%include iom_dcw;
%page;
%include iom_pcw;
%page;
%include iom_stat;
%page;
%include pvte;
%page;
%include syserr_constants;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   disk_init: Invalid channel on PRPH DSKx card.
 
   S:	$crash

   T:	$init

   M:	An invalid channel specification was found on the PRPH DSKx card.



   Message:
   disk_init: Invalid channel on CHNL DSKx card.

   S:	$crash

   T:	$init

   M:	An invalid channel specification was found on the CHNL card for DSKx.



   Message:
   disk_init: Unable to assign CCCC for DSKx.

   S:	$crash

   T:	$init

   M:	An error has occurred trying to assign an IOM channel
   for the disk subsystem DSKX.

   A:	$recover
   Check the configuration deck and the operability of the hardware before rebooting.


   Message:
   disk_init: error WWWW from absadr for DSKX iom N, ch ZZ.

   S:	$crash

   T:	$init

   M:	$err

   A:	$recover
   $boot_tape


   Message:
   disk_init: Too many devices configured for DSKn.  Max device is N.

   S:	$crash

   T:	$init

   M:	The software limit for devices per subsystem has been exceeded.

   A:	Fix the config deck and reboot.


   Message:
   disk_init: Unknown model number NNNN on PRPH dskN.

   S: $crash

   T: $init

   M: The model number NNNN on the prph card for disk subsystem N is invalid.
 
   A: Correct the config deck and reboot.


   Message:
   disk_init: DSKn D1 must be configured if DSKn D2 is configured.

   S:	$crash

   T:	$init

   M:	Only one of a pair of devices that share a common spindle has been
   configured.

   A:	Change the config deck to include the missing device and reboot.


   Message:
   disk_init: Devices D1 and D2 of DSKn must have the same model number.

   S:	$crash

   T:	$init

   M:	Two devices that share a common spindle have been configured
   with different model numbers.

   A:	Correct the config deck and reboot.


   Message:
   disk_init: Too many channels configured for DSKn.  Limit is N.

   S:	$crash

   T:	$init

   M:	The per subsystem software limit for logical channels has been exceeded.

   A:	Fix the config deck and reboot.  If more channels are needed, split
   the configuration into more subsystems in the config deck.


   Message:
   disk_init: Invalid format for XXXX card.

   S:     $crash

   T:	$init

   M:	A required field on the XXXX card is not present.

   A:	$recover
   Fix the configuration deck and reboot.


   Message:
   disk_init: Disk model XXXX not found in config_data_.

   S:	$crash

   T:	$init

   M:	$err

   A:	$recover
   Fix the configuration deck and reboot.


   Message:
   disk_init: No valid disk models found on PRPH DSKx card.

   S:	$crash

   T:	$init

   M:	All disk model fields were found to be zero.

   A:     Fix the configuration deck and reboot.


   END MESSAGE DOCUMENTATION */

     end disk_init;




		    establish_config_deck.pl1       11/11/89  1107.2r w 11/11/89  0807.4       44991



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1983 *
        *                                                         *
        *********************************************************** */

establish_config_deck: proc;

/* ESTABLISH_CONFIG_DECK -- set up segment that points over the config */
/* partition, and flush the in-memory config deck */
/* Modified April 1984 by Keith Loepere to wire config_deck */

/* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */

dcl  config_records		        fixed bin init (4) static options (constant);

dcl  config_deck_absadr	        fixed bin (26);
dcl  config_deck_page_num	        fixed bin;
dcl  old_intk_cardp		        ptr;
dcl  partition_sdw		        fixed bin (71) static init (0);

dcl  config_deck$		        ext static bit (36) aligned;
dcl  disk_config_deck$	        ext static bit (36) aligned;
dcl  page_num		        fixed bin;
dcl  ptp			        ptr;
dcl  ptw_ptr		        ptr;
dcl  pvt$root_pvtx		        fixed bin external static;
dcl  sst$abs_wired_count	        fixed bin (16) external static;
dcl  sst$cmp		        ptr external static;
dcl  sys_boot_info$bce_intk_card      external static;
dcl  sys_boot_info$config_part_frec   fixed bin (20) external static;

dcl  absadr		        entry (ptr, fixed bin (35)) returns (fixed bin (26));
dcl  config_$add		        entry (ptr, ptr);
dcl  config_$find		        entry (char (4) aligned, ptr);
dcl  freecore$thread	        entry (fixed bin);
dcl  make_sdw$no_pages	        entry (fixed bin (15), fixed bin (71), ptr, ptr);
dcl  pc_wired$write_wait	        entry (pointer, fixed bin, fixed bin);
dcl  pmut$swap_sdw		        entry (ptr, ptr);
dcl  ptw_util_$make_core	        entry (ptr, fixed bin (26));
dcl  ptw_util_$set_phm	        entry (ptr);
dcl  ptw_util_$set_wired	        entry (ptr);

dcl  addr			        builtin;
dcl  addrel		        builtin;
dcl  bin			        builtin;
dcl  bit			        builtin;
dcl  divide		        builtin;
dcl  null			        builtin;
dcl  rel			        builtin;
dcl  segno		        builtin;
dcl  size			        builtin;

dcl  deck			        (4096) bit (36) aligned based;
%page;
	if sys_info$collection_1_phase = SERVICE_INITIALIZATION then do;

/* During service, config_deck is a paged segment abs-wired onto the memory
location supplied for the config_deck during early initialization. It is not 
read again from the partition.  Writing it out is performed by config_$update, 
which does a pc_wired$write_wait. */

	     config_deck_absadr = absadr (addr (config_deck$), (0));
	     config_deck_page_num = divide (config_deck_absadr, 1024, 17);

/* Get an ASTE that describes config_deck (abs-seg), with a page table full 
of null addresses. */

	     call make_sdw$no_pages (segno (addr (config_deck$)), partition_sdw, astep, ptp);

	     aste.pvtx = pvt$root_pvtx;
	     aste.msl, aste.csl, aste.records = bit (bin (config_records, 9), 9);

	     do page_num = 0 to config_records - 1;
		ptw_ptr = addrel (ptp, page_num);
		call ptw_util_$make_core (ptw_ptr, config_deck_absadr + 1024 * page_num); /* make abs-seg ptw indicate memory */
		call ptw_util_$set_wired (ptw_ptr);
		call ptw_util_$set_phm (ptw_ptr);	/* for force write */

		cmep = addrel (sst$cmp, size (cme) * (config_deck_page_num + page_num)); /* make cme indicate disk */
		cmep -> mcme.record_no = bit (bin (sys_boot_info$config_part_frec + page_num, 18), 18);
		cmep -> mcme.add_type = add_type.disk;
		cmep -> cme.abs_w = "1"b;
		cmep -> cme.ptwp = rel (ptw_ptr);
		cmep -> cme.astep = rel (astep);

		call freecore$thread (config_deck_page_num + page_num);
	     end;
	     sst$abs_wired_count = sst$abs_wired_count + config_records;

	     call pmut$swap_sdw (addr (config_deck$), addr (partition_sdw)); /* make config_deck describe memory-disk abs-seg */

	     call pc_wired$write_wait (astep, 0, 4);	/* update disk copy with mem copy */
	end;

/* During bce, the config_deck is a wired segment, that describes the 
configuration used to attain a given bce command level.  The config deck 
editor actually updates disk_config_deck.  Here we must read this in for the
next pass. */

	else do;
	     addr (config_deck$) -> deck = addr (disk_config_deck$) -> deck;

/* Add bce's intk card (boot options) to deck */

	     intk_cardp = addr (sys_boot_info$bce_intk_card);
	     old_intk_cardp = null;
	     call config_$find (INTK_CARD_WORD, old_intk_cardp);
	     if old_intk_cardp = null then call config_$add (intk_cardp, null);
	     else old_intk_cardp -> intk_card = intk_card;	/* replace */
	end;
	return;
%page; %include add_type;
%page; %include aste;
%page; %include cmp;
%page; %include collection_1_phases;
%page; %include config_intk_card;
     end establish_config_deck;





		    establish_temp_segs.pl1         11/11/89  1107.2r w 11/11/89  0807.4       38232



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */
establish_temp_segs: proc;

/* Routine to cause the segments bootload_temp_n to be mapped onto
the boot partition.  It also creates the paged abs-segs multics_low_mem,
multics_high_mem, disk_config_deck and dump_seg.
Written by Keith Loepere, October 1983. */

/* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */

dcl  addr			        builtin;
dcl  bce_abs_seg$add	        entry (fixed bin (15));
dcl  bce_data$number_of_temp_segs     fixed bin external static;
dcl  character		        builtin;
dcl  codeptr		        builtin;
dcl  disk_config_deck$	        (4096) bit (36) aligned external;
dcl  divide		        builtin;
dcl  dump_seg$		        external;
dcl  first_record		        fixed bin (20);
dcl  ltrim		        builtin;
dcl  make_sdw$no_pages	        entry (fixed bin (15), fixed bin (71), ptr, ptr);
dcl  map_onto_disk		        entry (fixed bin, fixed bin (20), fixed bin, ptr, bit (1) aligned);
dcl  multics_high_mem$	        external;
dcl  multics_low_mem$	        external;
dcl  n_records		        fixed bin;
dcl  null			        builtin;
dcl  partition_sdw		        fixed bin (71);
dcl  pmut$swap_sdw		        entry (ptr, ptr);
dcl  ptp			        ptr;
dcl  pvt$root_pvtx		        fixed bin external static;
dcl  segno		        builtin;
dcl  slt$			        external;
dcl  slt_manager$get_seg_ptr	        entry (char (32) aligned) returns (ptr);
dcl  sys_boot_info$bce_part_frec      fixed bin (20) external static;
dcl  sys_boot_info$config_part_frec   fixed bin (20) external static;
dcl  sys_boot_info$rpv_cold_boot      bit (1) aligned external static;
dcl  sys_info$bce_max_seg_size        fixed bin (18) external static;
dcl  temp_seg_num		        fixed bin (15);
dcl  temp_seg_ptr		        ptr;
%page;
	sltp = addr (slt$);

	call map_onto_disk (pvt$root_pvtx, sys_boot_info$config_part_frec, 4, addr (disk_config_deck$), 
	     ^(sys_info$collection_1_phase = EARLY_INITIALIZATION & sys_boot_info$rpv_cold_boot));  /* disk contents don't matter for cold boot */
	call bce_abs_seg$add (segno (addr (disk_config_deck$)));

	call map_onto_disk (pvt$root_pvtx, sys_boot_info$bce_part_frec + SAVED_IMAGE_RECORDX, 256, addr (multics_low_mem$), "1"b);
	call bce_abs_seg$add (segno (addr (multics_low_mem$)));

	call map_onto_disk (pvt$root_pvtx, sys_boot_info$bce_part_frec + SAVED_IMAGE_RECORDX + 256, 256, addr (multics_high_mem$), "1"b);
	call bce_abs_seg$add (segno (addr (multics_high_mem$)));

	call make_sdw$no_pages (segno (addr (dump_seg$)), partition_sdw, astep, ptp);
	call pmut$swap_sdw (addr (dump_seg$), addr (partition_sdw));
	call bce_abs_seg$add (segno (addr (dump_seg$)));

	first_record = sys_boot_info$bce_part_frec + BCE_PAGING_AREA_RECORDX;

	temp_seg_ptr = codeptr (establish_temp_segs);	/* non-null */
	do temp_seg_num = 1 repeat temp_seg_num + 1 while (temp_seg_ptr ^= null);
	     temp_seg_ptr = slt_manager$get_seg_ptr ("bootload_temp_" || ltrim (character (temp_seg_num)));
	end;
	bce_data$number_of_temp_segs, temp_seg_num = temp_seg_num - 1; /* last temp seg no */
	n_records = divide (BCE_PAGING_AREA_LTH, temp_seg_num, 17); /* slice area evenly */
	sys_info$bce_max_seg_size = n_records * 1024;

	do temp_seg_num = 1 repeat temp_seg_num + 1;
	     temp_seg_ptr = slt_manager$get_seg_ptr ("bootload_temp_" || ltrim (character (temp_seg_num)));
	     if temp_seg_ptr = null then return;

	     sltep = addr (slt.seg (segno (temp_seg_ptr)));
	     slte_uns.max_length = n_records;

	     call map_onto_disk (pvt$root_pvtx, first_record, n_records, temp_seg_ptr, "0"b);
	     call bce_abs_seg$add (segno (temp_seg_ptr));

	     first_record = first_record + n_records;
	end;
	return;
%include aste;
%include bce_partition_layout;
%include collection_1_phases;
%include slt;
%include slte;
     end establish_temp_segs;




		    find_file_partition.pl1         11/11/89  1107.2r w 11/11/89  0815.8       34767



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-06-05,GJohnson), approve(86-06-05,MCR7387),
     audit(86-06-10,Martinson), install(86-07-11,MR12.0-1091):
     Correct error message documentation.
                                                   END HISTORY COMMENTS */


find_file_partition: proc;

/* Routine to cause the segment bootload_file_partition to be mapped onto
the file partition.  Written October 1983 by Keith Loepere. */

/* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */

dcl  addr			        builtin;
dcl  bce_abs_seg$add	        entry (fixed bin (15));
dcl  bootload_file_partition$	        external;
dcl  bootload_fs_$init	        entry (bit (1) aligned, fixed bin (19), fixed bin (35));
dcl  code			        fixed bin (35);
dcl  error_table_$nopart	        fixed bin (35) ext static;
dcl  first_record		        fixed bin (20);
dcl  map_onto_disk		        entry (fixed bin, fixed bin (20), fixed bin, ptr, bit (1) aligned);
dcl  me			        char (19) init ("find_file_partition") static options (constant);
dcl  1 my_label		        aligned like label;
dcl  n_records		        fixed bin;
dcl  px			        fixed bin;
dcl  pvt$root_pvtx		        fixed bin external static;
dcl  read_disk_label	        entry (fixed bin, ptr, char (*), fixed bin (35));
dcl  segno		        builtin;
dcl  syserr		        entry options (variable);
dcl  syserr$error_code	        entry options (variable);
%page;
	code = 0;
	labelp = addr (my_label);
	call read_disk_label (pvt$root_pvtx, labelp, "", code);
	if code = 0 then do px = 1 to label.nparts;
	     if label.parts (px).part = "file" then do;
		first_record = label.parts (px).frec;
		n_records = label.parts (px).nrec;
		go to found;
	     end;
	end;
	code = error_table_$nopart;
found:
	if code = 0 then
	     if n_records < 30 | n_records > 255 then call syserr (CRASH, "^a: file partition is ^d records, not between 30 and 255.", me, n_records);
	if code ^= 0
	then call syserr$error_code (CRASH, code, "^a: No file partition defined on RPV.", me);

	call map_onto_disk (pvt$root_pvtx, first_record, n_records, addr (bootload_file_partition$), "1"b);
	call bce_abs_seg$add (segno (addr (bootload_file_partition$)));

	call bootload_fs_$init ("0"b, 1024 * n_records, code); /* prepare to use */
	if code ^= 0 then do;
	     call syserr$error_code (ANNOUNCE, code, "^a: Initializing file partition.", me);
	     call bootload_fs_$init ("1"b, 1024 * n_records, code);
						/* goodbye old files */
	end;
	return;
%include disk_pack;
%include fs_vol_label;
%include syserr_constants;
%page;
/* BEGIN MESSAGE DOCUMENTATION

   Message:
   find_file_partition: file partition is NNN records, not between 30 and 255.

   S: $crash

   T: $init

   M: The partition holding the bce file system is of an invalid size.  The 
   rpv was either mal-formatted or damaged.

   A: The rpv will need to be rebuilt.

   Message:
   find_file_partition: No file partition defined on RPV.

   S: $crash

   T: $init

   M: The partition used to hold the bce file system is missing from the
   rpv.  Suspect damage of the rpv.

   A: The rpv will need to be rebuilt.

   Message:
   find_file_partition: Initting file partition.

   S: $info

   T: $init

   M: The bce file system was found to be damaged or never initialized.
   Any previous contents are discarded.

   END MESSAGE DOCUMENTATION */

     end find_file_partition;




		    find_rpv_subsystem.pl1          11/11/89  1107.2rew 11/11/89  0815.8      168354



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */

/* find_rpv_subsystem -- use sys_boot_info (or ask the operator) */
/* to locate the RPV when there is no config deck. BIM 8/82 */
/* Modified 2/83 by Keith Loepere to use bce_command_processor_ and
     environment */
/* Modified '83 by Keith Loepere for skipping firmware load on command. */
/* Modified 3/84 by Keith Loepere to use hc_load_mpc$test_controller */
/* Modified September of 1984 by Allen Ball to ask a better question. */

/****^  HISTORY COMMENTS:
  1) change(85-09-09,Farley), approve(85-09-09,MCR6979),
     audit(86-01-17,CLJones), install(86-03-21,MR12.0-1033):
     FIPS support.
  2) change(86-01-09,Fawcett), approve(86-04-11,MCR7383),
     audit(86-06-02,GDixon), install(86-07-17,MR12.0-1097):
     Add subvolume support for MSU3380 and MSU3390.
  3) change(86-04-22,Farley), approve(86-07-18,MCR7439),
     audit(86-08-18,Fawcett), install(86-10-20,MR12.0-1189):
     Changed to initialize all possible ss_info.flags.
  4) change(87-10-19,Farley), approve(88-02-26,MCR7796),
     audit(88-03-04,Fawcett), install(88-03-15,MR12.2-1035):
     Added use of sys_boot_info$default_rpv_data.  If data in non-null then
     operator will be queried for authentication.  If data is acceptable then
     standard rpv input request will be skipped.
  5) change(87-10-21,Farley), approve(88-02-26,MCR7796),
     audit(88-03-04,Fawcett), install(88-03-15,MR12.2-1035):
     Added validity checking of the sys_boot_info values when
     sys_boot_info$boot_without_query is set.
                                                   END HISTORY COMMENTS */

/* format: style2 */

find_rpv_subsystem:
     procedure;

/* Tasks are:
   1) find the rpv, using sys_boot_info if the data is valid.
   2) call init_early_config$disk to reflect the data. 
   3) boot RPV firmware.
*/

	declare error_table_$bad_command_name
				 fixed bin (35) ext static;
	declare error_table_$device_not_active
				 fixed bin (35) ext static;
	declare sys_boot_info$default_rpv_data
				 char (24) unaligned external static;
	declare sys_boot_info$rpv_cold_boot
				 bit (1) aligned external static;
	declare sys_boot_info$boot_without_query
				 bit (1) aligned external static;
	declare sys_boot_info$disk_device_has_sv
				 bit (1) aligned external static;
	declare sys_boot_info$disk_device_sv
				 fixed bin (17) external static;
	declare sys_boot_info$disk_device_number
				 fixed bin (6) external static;
	declare sys_boot_info$disk_model_number
				 fixed bin external static;
	declare sys_boot_info$disk_mpc_chanid
				 char (8) external static;
	declare sys_boot_info$disk_mpc_model_number
				 fixed bin external static;

	declare bce_query		 ext entry options (variable);
	declare bce_query$yes_no	 entry options (variable);
	declare boot_rpv_subsystem	 entry (char (*), fixed bin (35));
	declare com_err_		 entry options (variable);
	declare hc_load_mpc$test_controller
				 entry (char (8) aligned, fixed bin (35));
	declare ioa_		 entry options (variable);
	declare ioa_$rsnnl		 entry options (variable);
	declare init_early_config$disk entry external;
	declare syserr		 entry options (variable);
	declare cv_dec_check_	 entry (char (*), fixed bin (35)) returns (fixed bin (35));

	declare answer		 char (32);
	declare pz999		 pic "z999" based;
	declare cold_boot		 bit (1) aligned;
	declare yes_no		 bit (1);
	declare loaded_firmware	 bit (1) aligned;
	declare skip_firmware_load	 bit (1) aligned;
	declare ipc_controller	 bit (1) aligned init ("0"b);
	declare controllerx		 fixed bin;
	declare controller_fwid	 char (32);
	declare code		 fixed bin (35);
	declare ME		 char (32) init ("find_rpv_subsystem") internal static options (constant);

	declare (addr, convert, hbound, index, null, search, string, substr, translate)
				 builtin;		/* format: off */
%page; %include fs_dev_types;
%page; %include io_chnl_util_dcls;
%page; %include config_data_dcls;
%page; %include syserr_constants;
/* format: on */


RETRY:
	skip_firmware_load = "0"b;
	loaded_firmware = "0"b;
	cold_boot = "0"b;
	if ^sys_boot_info$boot_without_query
	then call QUERY;				/* will set loaded_firmware */
	else do;

/**** Data already in sys_boot_info. Verify its correctness and continue if
      all is well. Otherwise reset boot_without_query and query the operator
      for the proper response. */

		if ^CHECK_CHANNEL (sys_boot_info$disk_mpc_chanid)
		then go to RESET_N_RETRY;

		if sys_boot_info$disk_mpc_model_number = -1
		then answer = "ipc";
		else answer = convert (pz999, sys_boot_info$disk_mpc_model_number);
		if ^CHECK_MPC_MODEL (answer, controllerx)
		then go to RESET_N_RETRY;

		answer = convert (pz999, sys_boot_info$disk_model_number);
		if ^CHECK_DRIVE_MODEL (answer)
		then go to RESET_N_RETRY;

		call ioa_$rsnnl ("^d^[^a^;^s^]", answer, 0, sys_boot_info$disk_device_number,
		     sys_boot_info$disk_device_has_sv, valid_sv_array (sys_boot_info$disk_device_sv));
		if ^CHECK_DRIVE_NUMBER (answer)
		then go to RESET_N_RETRY;

		loaded_firmware = LOAD_MPC ();
		if ^loaded_firmware
		then do;
			call ioa_ ("^a: Firmware load failed. If RPV parameters were incorrect, then reenter", ME);
			call ioa_ ("    To give up respond ""shut"".");
		     end;
	     end;

	if ^loaded_firmware				/* global set in QUERY */
	then do;
RESET_N_RETRY:
		sys_boot_info$boot_without_query = "0"b;
		go to RETRY;
	     end;

/* Arrive here on success */


	sys_boot_info$rpv_cold_boot = cold_boot;	/* Advertise */
	call init_early_config$disk;			/* We got it right, record it */

	return;


QUERY:
     procedure;

	cold_boot = ""b;


	if QUERY_BRIEF ()
	then return;				/* one-line response given */

ASK_AGAIN:
	cold_boot = "0"b;
COLD_ASK_CHANNEL:
	call bce_query (answer, "^a: Enter RPV subsystem base channel, as Icc^[, or ""cold""^]. ", ME, ^cold_boot);
	if (answer = "cold" | answer = """cold""") & ^cold_boot
	then do;
		if CHECK_COLD ()
		then cold_boot = "1"b;
		go to COLD_ASK_CHANNEL;
	     end;

	else if answer = "shut" | answer = """shut"""
	then go to SHUTDOWN_REQUESTED;

	if ^CHECK_CHANNEL (answer)			/* side effect -- set sys_boot_info */
	then go to COLD_ASK_CHANNEL;

RE_ASK_SUBSYSTEM:
	call bce_query (answer, "^a: Enter RPV subsystem MPC model: ", ME);

	if ^CHECK_MPC_MODEL (answer, controllerx)
	then go to RE_ASK_SUBSYSTEM;

	if ^LOAD_MPC ()				/* get success before bothering with other questions */
	then go to ASK_AGAIN;

RE_ASK_DRIVE_MODEL:
	call bce_query (answer, "^a: Enter RPV disk drive model: ", ME);

	if ^CHECK_DRIVE_MODEL (answer)
	then go to RE_ASK_DRIVE_MODEL;

RE_ASK_DRIVE:
	call bce_query (answer, "^a: Enter RPV drive device number: ", ME);

	if ^CHECK_DRIVE_NUMBER (answer)
	then go to RE_ASK_DRIVE;
	call bce_query$yes_no (yes_no,
	     "^a: RPV is a model ^d drive, number ^d^[^a^;^1s^] on ^[MPC ^a (Model ^a)^;ipc ^a^1s^]^[, and this is a COLD boot^].^/    Is this correct? ",
	     ME, sys_boot_info$disk_model_number, sys_boot_info$disk_device_number, sys_boot_info$disk_device_has_sv,
	     valid_sv_array (sys_boot_info$disk_device_sv), (sys_boot_info$disk_mpc_model_number ^= -1),
	     sys_boot_info$disk_mpc_chanid, config_data_$mpc_msp_model_names.names (controllerx).name, cold_boot);
	if ^yes_no
	then go to ASK_AGAIN;

	return;


QUERY_BRIEF:
     procedure returns (bit (1) aligned);

%include bce_subsystem_info_;
	declare bce_command_processor_ entry (character (*), entry (ptr, char (*), fixed bin (35)) returns (entry), ptr,
				 fixed binary (35));
	declare cu_$arg_count_rel	 entry (fixed bin, ptr, fixed bin (35));
	declare cu_$arg_ptr_rel	 entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr);
	declare line		 char (132);
	declare code		 fixed bin (35);
	declare 1 my_ss_info	 aligned like ss_info;

	ss_info_ptr = addr (my_ss_info);
	ss_info.request_table_ptr = null ();		/* we find our own commands */
	ss_info.abort_label = RETURN_FAILURE;
	ss_info.name = "find_rpv_subsystem";
	ss_info.arg_list_ptr = null ();
	ss_info.info_ptr = null ();
	string (ss_info.flags) = ""b;
	ss_info.flags.forbid_semicolons = "1"b;

	if sys_boot_info$default_rpv_data ^= ""
	then do;
		line = sys_boot_info$default_rpv_data;
		call bce_query$yes_no (yes_no, "^a: Default RPV data is ""^a""^/Is this correct? ", ME, line);
		if yes_no
		then go to EXPAND_LINE;
		else line = "";
	     end;
AGAIN:
	call bce_query (line, "^a: Enter RPV data: ", ME);
EXPAND_LINE:
	call bce_command_processor_ (line, CF, ss_info_ptr, code);
	if code = 100				/* null line */
	then do;
		call ioa_ ("null line");
		go to AGAIN;
	     end;
	if code ^= 0
	then do;
		call com_err_ (code, ME, "Type ""help"" for help.");
		go to AGAIN;
	     end;

/* Control arrives at one of the following labels by non-local goto */

RETURN_SUCCESS:
	if ^LOAD_MPC ()
	then go to AGAIN;
	else return ("1"b);

RETURN_FAILURE:
	return ("0"b);


CF:
     procedure (Info_ptr, Command, Code) returns (entry);
	declare Command		 character (*);
	declare Code		 fixed binary (35);
	declare Info_ptr		 ptr;

	Code = 0;
	if Command = "help" | Command = "?"
	then return (HELP);
	else if Command = "query"
	then go to RETURN_FAILURE;
	else if Command = "rpv"
	then return (WARM);
	else if Command = "cold"
	then return (COLD);
	else if Command = "shut"
	then go to SHUTDOWN_REQUESTED;
	else if Command = "skip_load" | Command = "skip"
	then return (SKIP);
	else do;
		Code = error_table_$bad_command_name;
		return (null_entry_);
	     end;
     end CF;


HELP:
     procedure (Arg_list_ptr) options (non_quick);
	declare Arg_list_ptr	 ptr;

	call ioa_ ("For an ordinary boot, enter:");
	call ioa_ ("    rpv Icc MPC_Model Drive_Model Drive_Number");
	call ioa_ (" Where: I is the iom tag, cc is the base channel in decimal,");
	call ioa_ ("        MPC_Model is MPC Model, ");
	call ioa_ ("        Drive_Model is RPV drive model number, and ");
	call ioa_ ("        Drive_Number is the RPV device number.");
	call ioa_ ("^/For a cold boot, enter:");
	call ioa_ ("    cold Icc MPC_Model Drive_Model Drive_Number");
	call ioa_ ("^/To skip the firmware loading of the MPC, enter");
	call ioa_ ("    skip_load or skip");
	call ioa_ ("^/If this still is not clear, enter ""query"" for a setp-by-step query");
	go to AGAIN;
     end HELP;

SKIP:
     procedure (Arg_list_ptr) options (non_quick);
	declare Arg_list_ptr	 pointer;

	skip_firmware_load = "1"b;
	go to AGAIN;
     end SKIP;

WARM:
     procedure (Info_ptr);
	declare Info_ptr		 pointer;
	declare ap		 pointer;
	declare al		 fixed bin (21);
	declare arg		 character (al) based (ap);
	declare arg_count		 fixed bin;
	declare arg_list_ptr	 pointer;
	declare cold		 bit (1) aligned;

	cold = "0"b;
	go to COMMON;

COLD:
     entry (Info_ptr);

	cold = "1"b;
COMMON:
	arg_list_ptr = Info_ptr -> ss_info.arg_list_ptr;
	call cu_$arg_count_rel (arg_count, arg_list_ptr, (0));
	if arg_count ^= 4
	then
SYNTAX:
	     do;
		call ioa_ ("Invalid syntax. Type ""help"" for help.");
		go to AGAIN;
	     end;

	call cu_$arg_ptr_rel (1, ap, al, (0), arg_list_ptr);
	if ^CHECK_CHANNEL (arg)
	then go to AGAIN;

	call cu_$arg_ptr_rel (2, ap, al, (0), arg_list_ptr);
	if ^CHECK_MPC_MODEL (arg, controllerx)
	then go to AGAIN;

	call cu_$arg_ptr_rel (3, ap, al, (0), arg_list_ptr);
	if ^CHECK_DRIVE_MODEL (arg)
	then go to AGAIN;

	call cu_$arg_ptr_rel (4, ap, al, (0), arg_list_ptr);
	if ^CHECK_DRIVE_NUMBER (arg)
	then go to AGAIN;

	if cold
	then if ^CHECK_COLD ()
	     then go to AGAIN;
	     else cold_boot = "1"b;
	go to RETURN_SUCCESS;
     end WARM;

COMMON:
     end QUERY_BRIEF;

CHECK_COLD:
     procedure returns (bit (1) aligned);
	declare yes_no		 bit (1) aligned;
	call bce_query$yes_no (yes_no,
	     "^a: Booting cold will destroy all data on the RPV.^/   Are you sure that you want to boot cold? ", ME);
	return (yes_no);
     end CHECK_COLD;
     end QUERY;
%page;
CHECK_CHANNEL:
     procedure (Chanid) returns (bit (1) aligned);
	declare Chanid		 character (*);

	sys_boot_info$disk_mpc_chanid = translate (Chanid, "ABCD", "abcd");

	call io_chnl_util$name_to_iom ((sys_boot_info$disk_mpc_chanid), (0), (0), code);
	if code ^= 0				/* not an error table code */
	then do;
		call ioa_ ("^a is not a valid channel.", Chanid);
		call ioa_ ("     Use Icc, where I is the IOM tag (A, B, C, or D), and");
		call ioa_ ("     cc is the channel number, in decimal.");
		return ("0"b);
	     end;
	return ("1"b);
     end CHECK_CHANNEL;


CHECK_MPC_MODEL:
     procedure (Model, Controllerx) returns (bit (1) aligned);
	declare Model		 char (*);
	declare Controllerx		 fixed bin;
	declare x			 fixed bin;

	sys_boot_info$disk_mpc_model_number = cv_dec_check_ (Model, code);

	if code ^= 0
	then do;
		if Model = "ipc"
		then do;
			sys_boot_info$disk_mpc_model_number = -1;
						/* not firmware to load */
			ipc_controller = "1"b;
			skip_firmware_load = "1"b;
			Controllerx = 1;
			return ("1"b);
		     end;
		else do;
			call ioa_ ("^a is not a decimal number or ipc.", Model);
			call ioa_ ("An example of MPC model numbers is: MSP0600 -> 600 .");
			return ("0"b);
		     end;
	     end;

	do x = 1 to config_data_$mpc_msp_model_names.count;
	     if sys_boot_info$disk_mpc_model_number = config_data_$mpc_msp_model_names.names (x).model
	     then do;
		     Controllerx = x;
		     controller_fwid = config_data_$mpc_msp_model_names.names (Controllerx).fw_tag;
		     ipc_controller = "0"b;
		     return ("1"b);
		end;
	end;


	call ioa_ ("^a: ^d is not a known disk MPC model number.", ME, sys_boot_info$disk_mpc_model_number);
	return ("0"b);
     end CHECK_MPC_MODEL;


CHECK_DRIVE_MODEL:
     procedure (Model) returns (bit (1) aligned);
	declare Model		 char (*);
	declare x			 fixed bin;

	sys_boot_info$disk_model_number = cv_dec_check_ (Model, code);
	if code ^= 0
	then do;
bad_drive_model:
		call ioa_ ("^a is not a valid decimal number.", Model);
		call ioa_ ("An example of a drive model number is: MSU0451 -> 451.");
		return ("0"b);
	     end;
	do x = 1 to hbound (MODELN, 1) while (MODELN (x) ^= sys_boot_info$disk_model_number);
	end;
	if x > hbound (MODELN, 1)
	then goto bad_drive_model;
	if number_of_sv (x) > 1
	then sys_boot_info$disk_device_has_sv = "1"b;
	if ipc_controller
	then do x = 1 to hbound (config_data_$ipc_msp_model_names.valid_drives, 2);
		if sys_boot_info$disk_model_number
		     = config_data_$ipc_msp_model_names.names (controllerx).valid_drives (x)
		then return ("1"b);
	     end;

	else do x = 1 to hbound (config_data_$mpc_msp_model_names.valid_drives, 2);
		if sys_boot_info$disk_model_number
		     = config_data_$mpc_msp_model_names.names (controllerx).valid_drives (x)
		then return ("1"b);
	     end;

	call ioa_ ("Drive model ^d is not supported on MPC model ^d.", sys_boot_info$disk_model_number,
	     sys_boot_info$disk_mpc_model_number);
	return ("0"b);

     end CHECK_DRIVE_MODEL;


CHECK_DRIVE_NUMBER:
     procedure (Number) returns (bit (1) aligned);
	declare Number		 char (*);
	declare starting_dev	 fixed bin;
	declare last_dev		 fixed bin;
	declare x			 fixed bin;
	declare max_sv		 fixed bin;
	declare number		 char (8);
	declare valid_sv_subarray	 (max_sv) char (1) based (addr (valid_sv_string));
	if sys_boot_info$disk_device_has_sv
	then do;
		do x = 1 to hbound (MODELN, 1) while (MODELN (x) ^= sys_boot_info$disk_model_number);
		end;
		max_sv = number_of_sv (x);
		x = search (Number, substr (valid_sv_string, 1, max_sv));
		if x = 0
		then do;
			call ioa_ ("^d devices have ^d subvolumes ^a^( or ^a^)", sys_boot_info$disk_model_number,
			     max_sv, valid_sv_subarray);
			call ioa_ ("An example: 05b would indicate subvolume 2");
			return ("0"b);
		     end;
		else do;
			number = substr (Number, 1, (x - 1));
			sys_boot_info$disk_device_sv = index (valid_sv_string, substr (Number, x, 1)) - 1;
		     end;
	     end;
	else number = Number;
	sys_boot_info$disk_device_number = cv_dec_check_ (number, code);
	if code ^= 0
	then do;
		call ioa_ ("^a is not a valid decimal number.", Number);
		return ("0"b);
	     end;
	last_dev = 0;

/* The sys_boot_info$disk_model_number has been validated by CHECK_DRIVE_MODEL
   before this code is executed */

	do x = 1 to hbound (config_data_$disk_drive_model_names.names, 1) while (last_dev = 0);
	     if sys_boot_info$disk_model_number = config_data_$disk_drive_model_names.model (x)
	     then do;
		     if config_data_$disk_drive_model_names.device_0_valid (x)
		     then do;
			     starting_dev = 0;
			     last_dev = 31;
			end;
		     else do;
			     starting_dev = 1;
			     last_dev = 63;
			end;
		end;
	end;

	if sys_boot_info$disk_device_number > last_dev | sys_boot_info$disk_device_number < starting_dev
	then do;
		call ioa_ ("Device numbers may range from ^d to ^d. ^d is invalid.", starting_dev, last_dev,
		     sys_boot_info$disk_device_number);
		return ("0"b);
	     end;
	return ("1"b);
     end CHECK_DRIVE_NUMBER;
%page;
LOAD_FIRMWARE:
     procedure (loaded);

	declare loaded		 bit (1) aligned;

	loaded = "0"b;

	call boot_rpv_subsystem (controller_fwid, code);
	if code = 0
	then do;
		loaded = "1"b;
		return;
	     end;

	call com_err_ (code, ME, "Firmware load failed.");
	return;
     end LOAD_FIRMWARE;


LOAD_MPC:
     procedure returns (bit (1) aligned);
	declare yes_no		 bit (1) aligned;

	if skip_firmware_load
	then do;
		loaded_firmware = "1"b;
		return ("1"b);
	     end;
	loaded_firmware = "0"b;

	call hc_load_mpc$test_controller ((sys_boot_info$disk_mpc_chanid), code);
	if code = 0
	then do;
		loaded_firmware = "1"b;
		return ("1"b);
	     end;

	if code ^= error_table_$device_not_active
	then do;
		call com_err_ (code, ME, "Error testing mpc on channel ^a.", sys_boot_info$disk_mpc_chanid);
		call ioa_ ("The channel may be incorrect. Please reenter.");
		sys_boot_info$boot_without_query = "0"b;
		go to RETRY;
	     end;

	do while ("1"b);
	     call LOAD_FIRMWARE (loaded_firmware);

	     if loaded_firmware
	     then return ("1"b);

	     call ioa_ ("^a: Firmware load failed for ^d disk MPC on base channel ^a.", ME,
		sys_boot_info$disk_mpc_model_number, sys_boot_info$disk_mpc_chanid);
	     call bce_query$yes_no (yes_no, "^a: Do you want to retry firmware load with the same parameters? ", ME);
	     if ^yes_no
	     then return ("0"b);
	end;
     end LOAD_MPC;

SHUTDOWN_REQUESTED:
	call syserr (CRASH, "^a: Shutdown.", ME);

null_entry_:
     entry;
     end find_rpv_subsystem;




		    get_io_segs.pl1                 11/11/89  1107.2r w 11/11/89  0815.8      141993



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */

/* format: style4,delnl,insnl,indattr,ifthen,declareind10,dclind10 */
get_io_segs:
     procedure;

/* GET_IO_SEGS - Compute Sizes for Wired I/O Databases.
   coded 1/25/77 by Noel I. Morris
   Modified by C. Hornig for paged IOM November 1980
   Modified by J. Bongiovanni for stock_seg, February 1982
   Modified March 1982 by C. Hornig for more paged IOM
   Modified BIM 10/82 (and CAH) -- use hbound instead of -1
   Modified 12/83 by Chris Jones to allow chnl cards for tapes as well as disks
   Modified BIM 83-12-15 for demise of FNP cards.
   Modified 1/84 by Chris Jones to add ites to ioi_data and to add
   io_config_data and allow it to run in user ring for debugging.
   Modified 3/84 by T. Oke for system wide free queue PARM DSKQ n.
   Added limit variables min_per_drive and max_per_drive (5 and 200).
   Added two warning messages.
   Modified 9/84 by Keith Loepere to choose good free_q_size for bce.
   Modified 9/84 by Chris Jones to set disk_channel_count correctly, and to correct documentation and messages.
   Modified 11/84 by Paul Farley to make room in ioi_data for MCAs.
   Modified 06/85 by Paul Farley to make room for FIPS controllers in io_config_data.
*/

/****^  HISTORY COMMENTS:
  1) change(85-09-09,Farley), approve(85-09-09,MCR6979),
     audit(86-01-17,CLJones), install(86-03-21,MR12.0-1033):
     Add support for MCA
     and FIPS controllers.
  2) change(86-01-09,Fawcett), approve(86-04-11,MCR7383),
     audit(86-05-29,GDixon), install(86-07-17,MR12.0-1097):
     Add support for subvolumes that increase the size of pvt and stock_seg.
                                                   END HISTORY COMMENTS */

dcl	disk_subsystems	   fixed bin;		/* number of disk subsystems */
dcl	dev_idx		   fixed bin;
dcl	physical_volumes	   fixed bin;		/* number of storage system devices */
dcl	disk_channel_count	   fixed bin;		/* number of disk channels */
dcl	disk_drives	   fixed bin;		/* number of disk drives (including device 0) */
dcl	fptr		   ptr;			/* pointer to free_q parm */
dcl	1 dskq_parm	   aligned based (fptr),
	  2 name		   char (4),
	  2 size		   fixed bin;
dcl	free_q_size	   fixed bin;		/* number of free queue entries */
dcl	imus		   fixed bin;		/* number of IMU's */
dcl	controllers	   fixed bin;		/* number of MPCs and IPCs */
dcl	seg_size		   fixed bin (19);		/* size of segment */
dcl	subsystem_type	   char (4) aligned;
dcl	tsdw		   fixed bin (71);		/* temporary SDW */
dcl	i		   fixed bin;

dcl	config_$find	   entry (char (4) aligned, ptr);
dcl	config_$find_2	   entry (char (4) aligned, char (4) aligned, ptr);
dcl	config_$find_parm	   entry (char (*), ptr);

dcl	get_ring_		   entry () returns (fixed bin (3));
dcl	get_main		   entry (ptr, fixed bin (19), fixed bin (71));
dcl	ioa_		   entry () options (variable);
dcl	syserr		   entry options (variable);

dcl	min_per_drive	   fixed bin init (5) int static options (constant);
dcl	max_per_drive	   fixed bin init (200) int static options (constant);
dcl	ME		   char (32) init ("get_io_segs:") int static options (constant);
dcl	SYSERR_CONTROL_STRING  char (64) int static options (constant)
			   init ("^a Missing ndrives field on config card prph ^a.");
dcl	SYSERR_QUEUE_STRING_1  char (50) int static options (constant)
			   init ("^a DSKQ ^i. < ^i. per drive, forcing DSKQ ^i.");
dcl	SYSERR_QUEUE_STRING_2  char (50) int static options (constant)
			   init ("^a DSKQ ^i. > ^i. per drive, forcing DSKQ ^i.");

dcl	(addr, bin, hbound, lbound, max, min, null, ptr, rel, size, substr, wordno)
			   builtin;

/* Count how many of everything there are */

	ioi_subsystems, disk_subsystems, ioi_channels, ioi_devices, physical_volumes, disk_drives, ioi_multiplexers,
	     imus, controllers, disk_channel_count = 0;

/* * * * * * * * * PRPH cards * * * * * * * * * */

	prph_cardp = null ();
	call config_$find (PRPH_CARD_WORD, prph_cardp);	/* Search for PRPH cards. */
	do while (prph_cardp ^= null ());
	     ioi_subsystems = ioi_subsystems + 1;	/* Count an I/O subsystem. */

	     subsystem_type = substr (prph_card.name, 1, 3);
	     if /* case */ (subsystem_type = "tap") | (subsystem_type = "dsk") then do;
/**** NOTE THE ASSUMPTION THAT prph dsk AND prph tap CARDS ARE "like" ONE ANOTHER ****/
		prph_dsk_cardp = prph_cardp;
		prph_tap_cardp = prph_cardp;		/* do both for crossref purposes */
		if subsystem_type = "dsk" then do;
		     disk_subsystems = disk_subsystems + 1;
		     disk_channel_count = disk_channel_count + prph_dsk_card.nchan;
		end;
		ioi_channels = ioi_channels + prph_tap_card.nchan;
						/* count number of channels. */
		chnl_cardp = null ();
		call config_$find_2 (CHNL_CARD_WORD, prph_card.name, chnl_cardp);
		if chnl_cardp ^= null () then
		     do i = 1 to 3;			/* Count additional channels. */
		     if chnl_card.nchan (i) > 0 then do;
			ioi_channels = ioi_channels + chnl_card.nchan (i);
			if subsystem_type = "dsk" then
			     disk_channel_count = disk_channel_count + chnl_card.nchan (i);
		     end;
		end;
		ioi_devices = ioi_devices + 1;	/* Count drives plus controller. */
		do i = lbound (prph_tap_card.group, 1) to hbound (prph_tap_card.group, 1)
		     while (prph_tap_card.group (i).model ^= -1);
						/* count drives. */
		     if prph_tap_card.group (i).ndrives = -1 then
			if get_ring_ () = 0 then
			     call syserr (CRASH, SYSERR_CONTROL_STRING, ME, prph_card.name);
			else do;
			     call ioa_ (SYSERR_CONTROL_STRING, ME, prph_card.name);
			     return;
			end;

		     if subsystem_type = "dsk" then
			disk_drives = disk_drives + prph_dsk_card.group (i).ndrives;
		     if prph_tap_card.group (i).model ^= 0 then do;
			ioi_devices = ioi_devices + prph_tap_card.group (i).ndrives;
			if subsystem_type = "dsk" then do;
			     do dev_idx = 1 to hbound (MODEL, 1)
				while (prph_tap_card.group (i).model ^= MODEL (dev_idx));
			     end;
			     dev_idx = MODELX (dev_idx);
			     if number_of_sv (dev_idx) = 0 then
				physical_volumes = physical_volumes + prph_dsk_card.group (i).ndrives;
			     else physical_volumes =
				     physical_volumes
				     + (prph_dsk_card.group (i).ndrives * number_of_sv (dev_idx));
			end;
		     end;
		end;
	     end;

	     else do;				/* Other peripherals. */
		ioi_channels = ioi_channels + 1;
		ioi_devices = ioi_devices + 1;
	     end;
	     call config_$find (PRPH_CARD_WORD, prph_cardp);
						/* Search for PRPH cards. */
	end;

/* * * * * * * * * * MPC cards * * * * * * * * * */

	mpc_cardp = null ();
	call config_$find (MPC_CARD_WORD, mpc_cardp);

	do while (mpc_cardp ^= null ());
	     controllers = controllers + 1;

	     call config_$find (MPC_CARD_WORD, mpc_cardp);
	end;

/* * * * * * * * * * IPC FIPS cards * * * * * * * * * */

	ipc_cardp = null ();
	call config_$find (IPC_CARD_WORD, ipc_cardp);

	do while (ipc_cardp ^= null ());
	     if ipc_card.type = IPC_FIPS then
		controllers = controllers + 1;

	     call config_$find (IPC_CARD_WORD, ipc_cardp);
	end;

/* * * * * * * * * * IOM cards * * * * * * * * * */

	iom_cardp = null ();
	call config_$find (IOM_CARD_WORD, iom_cardp);

	do while (iom_cardp ^= null ());
	     ioi_multiplexers = ioi_multiplexers + 1;
	     if (iom_card.model = "iioc") | (iom_card.model = "imu") then
		imus = imus + 1;

	     call config_$find (IOM_CARD_WORD, iom_cardp);
	end;

/* * * * * * * * * * Allow for MCA in the IMUs * * * * * * * * * */

	ioi_subsystems = ioi_subsystems + imus;
	ioi_channels = ioi_channels + imus;
	ioi_devices = ioi_devices + imus;

/* * * * * * * * * * STOK card * * * * * * * * * */

	stok_cardp = null ();
	call config_$find (STOK_CARD_WORD, stok_cardp);
	if stok_cardp = null () then
	     n_in_record_stock = DEFAULT_N_IN_RECORD_STOCK;
	else if stok_card.type_word.n_fields < 1 then
	     n_in_record_stock = DEFAULT_N_IN_RECORD_STOCK;
	else if stok_card.n_record_stock_entries <= 0 then
	     n_in_record_stock = DEFAULT_N_IN_RECORD_STOCK;
	else n_in_record_stock = stok_card.n_record_stock_entries;
	if stok_cardp = null () then
	     n_in_vtoce_stock = DEFAULT_N_IN_VTOCE_STOCK;
	else if stok_card.type_word.n_fields < 2 then
	     n_in_vtoce_stock = DEFAULT_N_IN_VTOCE_STOCK;
	else if stok_card.n_vtoce_stock_entries <= 0 then
	     n_in_vtoce_stock = DEFAULT_N_IN_VTOCE_STOCK;
	else n_in_vtoce_stock = stok_card.n_vtoce_stock_entries;
	n_volmap_pages = 3;

/* * * * * * * * * * PARM DSKQ card * * * * * * * * * */

	if sys_info$collection_1_phase = SERVICE_INITIALIZATION then do;
	     free_q_size = 20 * physical_volumes;	/* set default */

	     call config_$find_parm ("dskq", fptr);	/* get ptr to dskq parameter */
	     if fptr ^= null () then do;
		free_q_size =
		     min (max (dskq_parm.size, min_per_drive * physical_volumes), max_per_drive * physical_volumes);
		if dskq_parm.size < (min_per_drive * physical_volumes) then
		     call syserr (ANNOUNCE, SYSERR_QUEUE_STRING_1, ME, dskq_parm.size, min_per_drive, free_q_size);
		else if dskq_parm.size > max_per_drive * physical_volumes then
		     call syserr (ANNOUNCE, SYSERR_QUEUE_STRING_2, ME, dskq_parm.size, max_per_drive, free_q_size);
	     end;
	end;
	else free_q_size = 64;			/* Don't let queue be large enough to grab all of bce's memory. */
%page;
/* Now allocate the databases */

/* * * * * * * * * * PVT * * * * * * * * * */

	pvtp = addr (pvt$);				/* Get pointer to PVT. */
	seg_size = bin (rel (addr (pvt.array))) + physical_volumes * size (pvte);
						/* Compute required size of PVT. */
	call install_segment (pvtp, seg_size, tsdw);
	pvt.max_n_entries = physical_volumes;		/* for init_pvt */


/* * * * * * * * * * STOCK_SEG * * * * * * * * * */

	stock_segp = addr (stock_seg$);
	seg_size = size (stock_seg) + physical_volumes * (size (record_stock) + size (vtoce_stock));
	call install_segment (stock_segp, seg_size, tsdw);
	stock_seg.record_stock_entries = n_in_record_stock;
	stock_seg.vtoce_stock_entries = n_in_vtoce_stock;
	stock_seg.record_stock_size = size (record_stock);
	stock_seg.vtoce_stock_size = size (vtoce_stock);
	stock_seg.n_stock_entries = physical_volumes;

/* * * * * * * * * * DISK_SEG * * * * * * * * * */

	disksp = addr (disk_seg$);			/* Get pointer to disk database segment. */
	seg_size =
	     size (disk_data) + free_q_size * size (quentry) + disk_subsystems * size (disktab)
	     + disk_drives * size (devtab) + disk_channel_count * size (chantab);
						/* Compute required size of disk_seg. */

	call install_segment (disksp, seg_size, tsdw);
	disk_data.free_q_size = free_q_size;

/* * * * * * * * * * IO_CONFIG_DATA * * * * * * * * * */

	io_config_data_ptr = addr (io_config_data$);
	io_config_device_table_ptr, io_config_channel_table_ptr, io_config_controller_table_ptr,
	     io_config_iom_table_ptr = io_config_data_ptr;/* base all of these so wordno gives the right answer */

	begin;

dcl	(device_table_length, channel_table_length, controller_table_length, iom_table_length, io_config_tables_length)
			   fixed bin (19);

	     device_table_length =
		wordno (addr (device_table.device_entry)) + size (device_entry_template) * ioi_devices;
	     channel_table_length =
		wordno (addr (channel_table.channel_entry)) + size (channel_entry_template) * ioi_channels;
	     controller_table_length =
		wordno (addr (controller_table.controller_entry)) + size (controller_entry_template) * controllers;
	     iom_table_length = wordno (addr (iom_table.iom_entry)) + size (iom_entry_template) * ioi_multiplexers;
	     io_config_tables_length =
		device_table_length + channel_table_length + controller_table_length + iom_table_length;
	     seg_size = wordno (addr (io_config_data.tables)) + io_config_tables_length;
	     call install_segment (io_config_data_ptr, seg_size, tsdw);

	     io_config_data.tables_length = io_config_tables_length;
	     io_config_data.device_table_offset = wordno (addr (io_config_data.tables));
	     io_config_data.channel_table_offset = io_config_data.device_table_offset + device_table_length;
	     io_config_data.controller_table_offset = io_config_data.channel_table_offset + channel_table_length;
	     io_config_data.iom_table_offset = io_config_data.controller_table_offset + controller_table_length;

	     io_config_device_table_ptr = ptr (io_config_data_ptr, io_config_data.device_table_offset);
	     io_config_channel_table_ptr = ptr (io_config_data_ptr, io_config_data.channel_table_offset);
	     io_config_controller_table_ptr = ptr (io_config_data_ptr, io_config_data.controller_table_offset);
	     io_config_iom_table_ptr = ptr (io_config_data_ptr, io_config_data.iom_table_offset);

	     device_table.n_devices = ioi_devices;
	     channel_table.n_channels = ioi_channels;
	     controller_table.n_controllers = controllers;
	     iom_table.n_ioms = ioi_multiplexers;
	end;

/* * * * * * * * * * IOI_DATA * * * * * * * * * */

	idp = addr (ioi_data$);			/* Get pointer to IOI data. */
	call install_segment (idp, size (ioi_data), tsdw);/* Make a wired segment. */

	ioi_data.ngt = ioi_subsystems;		/* Fill in real database. */
	ioi_data.nct = ioi_channels;
	ioi_data.ndt = ioi_devices;
	ioi_data.nit = ioi_multiplexers;

/* * * * * * * * * * IOM_DATA * * * * * * * * * */

	iom_data_ptr = addr (iom_data$);		/* Get pointer to IOM data. */
	n_devices = ioi_channels + ioi_multiplexers * 2 + imus;
						/* Compute number of channels needed */
	seg_size = size (iom_data);			/* Compute required length of iom_data. */

	call install_segment (iom_data_ptr, seg_size, tsdw);

	iom_data.n_devices = n_devices;		/* Remember this value. */

	return;

install_segment:
     proc (segptr, seglen, sdw);

dcl	segptr		   ptr;
dcl	seglen		   fixed bin (19);
dcl	sdw		   fixed bin (71);


dcl	pmut$swap_sdw	   entry (ptr, ptr);

	if get_ring_ () ^= 0 then
	     return;				/* already available */

	call get_main (segptr, seglen, sdw);
	call pmut$swap_sdw (segptr, addr (sdw));

     end install_segment;

/* format: off */
%include syserr_constants; %page;
%include config_chnl_card; %page;
%include config_deck; %page;
%include config_iom_card; %page;
%include config_ipc_card; %page;
%include config_mpc_card; %page;
%include config_prph_card; %page;
%include config_prph_dsk_card; %page;
%include config_prph_tap_card; %page;
%include config_stok_card; %page;
%include dskdcl; %page;
%include io_config_data; %page;
%include ioi_data; %page;
%include iom_data; %page;
%include pvt; %page;
%include pvte; %page;
%include stock_seg; %page;
%include access_mode_values;
%include collection_1_phases;
%include fs_dev_types;
/* format: on */

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   get_io_segs: Missing ndrives field on config card prph NAME.

   S:	$crash

   T:	$init

   M:	The prph card for the NAME subsystem is missing an ndrives field.

   A:	$config


   Message:
   get_io_segs: DSKQ mmm. < xxx. per drive, forcing DSKQ nnn.

   S:	$beep

   T:	$init

   M:	The dskq card specifies less than 5 queue entries per configured
   drive.  This is considered too few for efficient operation and is
   forced to 5 entries per drive.

   A:	$config


   Message:
   get_io_segs: DSKQ mmm. > xxx. per drive, forcing DSKQ nnn.
   S:	$beep

   T:	$init

   M:	The dskq card specifies an excess of queue entries beyond that
   reasonably required for efficient operation.  The free queue will be
   limited to 100 entries per drive.

   A:	$config


   END MESSAGE DOCUMENTATION */

     end get_io_segs;




		    init_aste_pools.pl1             11/11/89  1107.2r w 11/11/89  0815.8       37071



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */
/* format: style2 */


init_aste_pools: proc ();

/* format: off */

/* This procedure initializes all the ASTEs and initializes them. It also sets
   up some pointers in the (currently unpaged) name table, as well. */

/* Written 03/24/81, W. Olin Sibert, extracted from init_sst and made more efficient
   Modified 04/17/81, WOS, for ptw_util_$make_null
   */

/* format: on */

dcl  page_idx fixed bin;
dcl  pool_idx fixed bin;
dcl  aste_idx fixed bin;
dcl  aste_size fixed bin (10);
dcl  aste_count fixed bin;
dcl (prev_aste_offset, next_aste_offset) fixed bin (18) unsigned;
dcl (first_astep, last_astep) pointer;
dcl  astnoff fixed bin (18);
dcl  ptp pointer;

dcl 1 template_aste aligned automatic,
    2 aste_part like aste aligned,
    2 page_table (256) bit (36) aligned;

dcl  template_ptw bit (36) aligned;

dcl 1 aste_threads aligned automatic,			/* Used to generate the threads */
    2 next fixed bin (18) unsigned unaligned,
    2 prev fixed bin (18) unsigned unaligned;

dcl  based_thread_word bit (36) aligned based;		/* For assigning the threads to word zero of the ASTE */
dcl  aste_overlay (aste_size) bit (36) aligned based;	/* For assigning the whole ASTE */

dcl  ptw_util_$make_null entry (pointer, bit (22) aligned);

dcl (addr, addrel, binary, bit, rel) builtin;

/*  */

	sstp = addr (sst_seg$);			/* Initialize */
	sstnp = addr (sst_names_$);

	unspec (template_aste) = ""b; 		/* Initialize the template */
	template_aste.marker = "02"b3;		/* Put DF2 in the last word of the ASTE */

	call ptw_util_$make_null (addr (template_ptw), init_sst_null_addr); /* Fabricate a PTW */

	template_aste.page_table (*) = template_ptw;	/* All init_sst ptws are the same */

	astnoff = 0;				/* SST names start at zero */
	astep = sst.astap;				/* Beginning of ASTE array */

	do pool_idx = 0 to 3;
	     aste_count = binary (sst.no_aste (pool_idx), 18);
	     aste_size = size (aste) + sst.pts (pool_idx);

	     first_astep = astep;			/* And its first and last members */
	     last_astep = addrel (first_astep, (aste_count - 1) * aste_size);

	     template_aste.ptsi = bit (binary (pool_idx, 2), 2); /* Set up the template properly for this pool */

	     sstnp -> sstnt.ast_offsets (pool_idx) = binary (rel (astep), 18); /* Initialize pool base */
	     sstnp -> sstnt.ast_name_offsets (pool_idx) = astnoff; /* set up array index base aswell */
	     sstnp -> sstnt.ast_sizes (pool_idx) = aste_size; /* set up ASTE size for easy calc. */
	     astnoff = astnoff + aste_count;		/* SSTNT initialization */

	     aste_threads.prev = binary (rel (first_astep), 18) - aste_size; /* Use these to thread in "by hand" */
	     aste_threads.next = binary (rel (first_astep), 18) + aste_size;

	     do aste_idx = 1 to aste_count;		/* loop through for number of entries for this size */
		astep -> aste_overlay = addr (template_aste) -> aste_overlay;
		astep -> based_thread_word = unspec (aste_threads); /* "thread" it in */
		aste_threads.next = aste_threads.next + aste_size; /* and update to the next ASTE */
		aste_threads.prev = aste_threads.prev + aste_size;
		astep = addrel (astep, aste_size);	/* and point to the next one */
		end;				/* of a single pool */

	     first_astep -> aste.bp = rel (last_astep);	/* Thread in the first and last ASTEs properly */
	     last_astep -> aste.fp = rel (first_astep);

	     sst.ausedp (pool_idx) = rel (first_astep);	/* And initialize the list pointer */
	     end; 				/* of loop through pools */

	return;

/* format: off */

%page; %include system_types;
%page; %include aste;
%page; %include null_addresses;
%page; %include sstnt;
%page; %include sst;

	end init_aste_pools;




		    init_early_config.pl1           11/11/89  1107.2rew 11/11/89  0815.8      125811



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1989   *
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1983 *
        *                                                         *
        *********************************************************** */

/* format: style2 */

init_early_config:
     procedure;

/* *	This procedure is called very early in initialization to construct a
   *	"template" config deck which can then be used to construct a version
   *	of the Multics environment with which the real config deck can readily
   *	be found. This config deck includes the following cards, which are
   *	constructed from information acquired from the bootload dialogue or
   *	from a survey of equipment.
   *
   *	A typical initial config deck might look like this:
   *
   *	  (c)   cpu   a  7	on  l68.  80.
   *	  (c)   mem   a  512.  on
   *	  (a)   iom   a  0  iom  on
   *	  (a)   prph  opca  a  20  6601.  80.  on
   *	  (b)   prph  dska	24.  1.  0.  6  451.  7
   *	  (b)   root  dska	7.
   *	  (d)   clok  0. gmt  0.
   *	  (d)   sst   50.  25.  10.  4.
   *	  (d)   tcd   4.  20.  20.
   *	  (d)   intk  warm	0  boot
   *        (b)   prph  tapa  a  20.  1.  0.  3.  610.  1.
   *
   *	Those cards marked (a) are generated from a "hardware survey"; that is, from
   *	information which is read from hardware registers or the IOM bootload program
   *	during the bootload process. Those cards marked (b) are constructed from
   *	information gathered during the bootload dialogue, or compiled into bootload_info.
   *	The cards marked (c) are modified after this program runs.
   *
   *	11/15/80, W. Olin Sibert
   *	Modified 01/07/81, WOS, to move some stuff to scs_and_clock_init.
   *      Updated BIM 9/82
   *	Modified 1/11/84, Keith Loepere, for new format opc prph card.
   *	Modified 7/30/84, Paul Farley, for FIPS support.
   *	Modified 8/84, Chris Jones, for new disk dim.
   *	Modified 9/84, Keith Loepere, to build prph dsk card correct for
   *		shared spindle devices.
   *	Modified 2/25/85, Paul Farley, to add "fips" card when needed.
   */

/****^  HISTORY COMMENTS:
  1) change(85-09-09,Farley), approve(85-09-09,MCR6979),
     audit(86-01-17,CLJones), install(86-03-21,MR12.0-1033):
     FIPS support.
  2) change(86-01-09,Fawcett), approve(86-04-11,MCR7383),
     audit(86-07-07,GDixon), install(86-07-17,MR12.0-1097):
     Add subvolume support for MSU3380 and MSU3390.
  3) change(86-01-09,Fawcett), approve(86-04-11,MCR7351),
     audit(86-07-07,GDixon), install(86-07-17,MR12.0-1097):
     Change for iom_card model field from nsa to iom.
  4) change(86-06-05,GJohnson), approve(86-06-05,MCR7387),
     audit(86-06-12,Martinson), install(86-07-17,MR12.0-1091):
     Correct error message documentation.
  5) change(87-04-09,Farley), approve(87-07-06,MCR7717),
     audit(87-07-13,Lippard), install(87-07-17,MR12.1-1043):
     Changed default prph dska card to be "0. 62. 501. 2." instead of "0. 63.
     451. 1." to allow handling of the extra device for 500/501s.
  6) change(87-10-02,Farley), approve(88-02-26,MCR7794),
     audit(88-03-04,Fawcett), install(88-03-15,MR12.2-1035):
     Added code for the proper setting of the IOM model field on the IOM config
     card, based on the setting of the flag sys_boot_info$imu_style_iom.
  7) change(87-10-20,Farley), approve(88-02-26,MCR7795),
     audit(88-03-04,Fawcett), install(88-03-15,MR12.2-1035):
     Added code to set the clok card zone field to the value contained in
     sys_boot_info$default_time_zone.
  8) change(89-08-14,Farley), approve(89-09-18,MCR8133),
     audit(89-09-20,WAAnderson), install(89-10-03,MR12.3-1081):
     Added check for device zero when checking for FIPS tape devices. Looking
     for a "tape_mpc_fw_name" of "ipc" is not adequate, given that a change was
     made to skip the "Enter boot tape MPC model" question if the controller
     was found to be in an intelligent state.
                                                   END HISTORY COMMENTS */


	declare idx		 fixed bin;
	declare 1 card_image	 aligned like config_card;
	declare disk_iom		 fixed bin (3);
	declare disk_channel	 fixed bin (7);
	declare disk_num		 fixed bin;
	declare sub_num		 fixed bin;
	declare p99		 pic "99";
	declare part		 char (4) aligned;
	declare lowest_dev_number	 fixed bin (17);

	declare sys_boot_info$bootload_mem_size
				 fixed bin (35) ext;

	declare sys_boot_info$console_iom_number
				 fixed bin (3) ext;
	declare sys_boot_info$console_channel_number
				 fixed bin (6) ext;
	declare sys_boot_info$console_model
				 fixed bin (35) ext;
	declare sys_boot_info$default_time_zone
				 char (4) unaligned ext;
	declare sys_boot_info$tape_iom_number
				 fixed bin (3) ext;
	declare sys_boot_info$tape_channel_number
				 fixed bin (6) ext;
	declare sys_boot_info$tape_device_number
				 fixed bin (6) ext;
	declare sys_boot_info$tape_mpc_fw_name
				 char (32) ext;

	declare sys_boot_info$iom_port_table
				 (4) fixed bin (35) ext;
	declare sys_boot_info$imu_style_iom
				 bit (1) aligned external static;
	declare sys_boot_info$disk_mpc_chanid
				 character (8) aligned external static;
	declare sys_boot_info$disk_device_has_sv
				 bit (1) aligned external static;
	declare sys_boot_info$disk_device_sv
				 fixed bin (17) external static;
	declare sys_boot_info$disk_device_number
				 fixed bin (6) ext;
	declare sys_boot_info$disk_model_number
				 fixed bin (35) ext;



	declare config_$clear	 entry ();
	declare config_$add		 entry (pointer, pointer);
	declare config_$find_2	 entry (char (4) aligned, char (4) aligned, ptr);
	declare config_$find	 entry (char (4) aligned, ptr);
	declare config_$delete	 entry (ptr);
	declare cv_config_card_	 entry (char (*), pointer, fixed bin (35));
	declare syserr		 entry options (variable);

	declare (addr, convert, dimension, divide, null, round, substr)
				 builtin;

/* */

	call config_$clear ();			/* Clear out anything that's "there" now. */

	call make_card ("cpu a 0 on l68 80.", cpu_cardp); /* CPU card. Always CPU A. */
	call config_$add (cpu_cardp, null ());

	do idx = 1 to 4;
	     if sys_boot_info$iom_port_table (idx) >= 0
	     then do;
		     call make_card ("iom a 0 iom on", iom_cardp);
		     iom_card.tag = idx;
		     iom_card.port = sys_boot_info$iom_port_table (idx);
		     if sys_boot_info$imu_style_iom
		     then iom_card.model = "imu";
		     call config_$add (iom_cardp, null ());
		end;
	end;

	call make_card ("mem a 256. on", mem_cardp);	/* Bootload memory is always 256K first time through */
	mem_card.size = divide (sys_boot_info$bootload_mem_size, 1024, 26, 0);
	call config_$add (mem_cardp, null ());

	call make_card ("prph opca a 13. 6001. 80. on", prph_opc_cardp);
						/* OPC card for BOS console */
	prph_opc_card.chan = sys_boot_info$console_channel_number;
	prph_opc_card.iom = sys_boot_info$console_iom_number;
	prph_opc_card.model = sys_boot_info$console_model;

	call config_$add (prph_opc_cardp, null ());

	if substr (sys_boot_info$tape_mpc_fw_name, 1, 3) = "ipc" | sys_boot_info$tape_device_number = 0
	then do;					/* FIPS device */
		if sys_boot_info$tape_device_number = 0
		then call make_card ("prph tapa a 13. 1. 610. 1.", prph_tap_cardp);
		else do;
			call make_card ("prph tapa a 13. 1. 0. 0. 610. 1.", prph_tap_cardp);
			prph_tap_card.group (1).ndrives = sys_boot_info$tape_device_number;
		     end;
	     end;
	else do;					/* else devices start at 1. */
		if sys_boot_info$tape_device_number = 1
		then call make_card ("prph tapa a 13. 1. 610. 1.", prph_tap_cardp);
		else do;
			call make_card ("prph tapa a 13. 1. 0. 0. 610. 1.", prph_tap_cardp);
			prph_tap_card.group (1).ndrives = sys_boot_info$tape_device_number - 1;
		     end;
	     end;
	prph_tap_card.iom = sys_boot_info$tape_iom_number;
	prph_tap_card.chan = sys_boot_info$tape_channel_number;
	call config_$add (prph_tap_cardp, null ());

	call add_card ("prph dska a 13. 1. 0. 62. 501. 2.");
						/* make chantab slot and disk_seg devtab slots */

	call make_card ("clok 0. gmt 0.", clok_cardp);
	clok_card.zone = sys_boot_info$default_time_zone;
	call config_$add (clok_cardp, null ());


	call add_card ("sst 50. 25. 10. 4.");		/* Add the "constant" cards */
	call add_card ("tcd 4. 20. 20.");
	call add_card ("intk warm 0 boot");
	call add_card ("parm chwm hcpt");
	call add_card ("root dska 13");
	call make_card ("part dump dska 13", part_cardp);
	call config_$add (part_cardp, null ());
	do part = "bos", "conf", "log";
	     part_card.name = part;
	     call config_$add (part_cardp, null ());
	end;
	return;					/* All done */

/* Enter here after sys_boot_info is known to contain the good data */
/* on the RPV subsystem. */

disk:
     entry;

	root_cardp = null ();
	call config_$find (ROOT_CARD_WORD, root_cardp);
	disk_num = sys_boot_info$disk_device_number;
	sub_num = sys_boot_info$disk_device_sv;
	if sys_boot_info$disk_device_has_sv
	then root_card.volume (1).drive = convert (p99, disk_num) || valid_sv_array (sub_num);
	else root_card.volume (1).drive = convert (p99, disk_num);

	do part = "bos", "conf", "log", "dump";
	     part_cardp = null ();
	     call config_$find_2 (PART_CARD_WORD, part, part_cardp);
	     if sys_boot_info$disk_device_has_sv
	     then part_card.drive = convert (p99, disk_num) || valid_sv_array (sub_num);
	     else part_card.drive = convert (p99, disk_num);
	end;

	prph_dsk_cardp = null ();
	call config_$find_2 ("prph", "dska", prph_dsk_cardp);
						/* remove the dummy card put in to get channel slots */
	call config_$delete (prph_dsk_cardp);

	call io_chnl_util$name_to_iom (sys_boot_info$disk_mpc_chanid, disk_iom, disk_channel, (0));
						/* guaranteed ok */

/* Find RPV device type so we can see if the rpv is a shared spindle device
(requires defining both halves) */

	do idx = 1 to dimension (MODEL, 1) while (MODEL (idx) ^= sys_boot_info$disk_model_number);
	end;
	idx = MODELX (idx);				/* device type */
	if IS_FIPS_DEVICE ()
	then lowest_dev_number = 0;
	else lowest_dev_number = 1;

/* Of devices that are supported by Multics none are both fips and shared_spindle */

	if shared_spindle (idx)
	then do;
		if sys_boot_info$disk_device_number <= (lowest_dev_number + 1)
		then do;
			call make_card ("prph dska a 13. 1. 1. 2.", prph_dsk_cardp);
			prph_dsk_card.group (1).model = sys_boot_info$disk_model_number;
		     end;
		else do;
			call make_card ("prph dska a 13. 1. 0. 1. 1. 2.", prph_dsk_cardp);
			prph_dsk_card.group (1).ndrives =
			     round (sys_boot_info$disk_device_number, -1) - (lowest_dev_number + 1);
			prph_dsk_card.group (2).model = sys_boot_info$disk_model_number;
		     end;
	     end;
	else do;
		if sys_boot_info$disk_device_number = lowest_dev_number
		then do;
			call make_card ("prph dska a 13. 1. 1. 1.", prph_dsk_cardp);
			prph_dsk_card.group (1).model = sys_boot_info$disk_model_number;
		     end;
		else do;
			call make_card ("prph dska a 13. 1. 0. 1. 1. 1.", prph_dsk_cardp);
			prph_dsk_card.group (1).ndrives = sys_boot_info$disk_device_number - lowest_dev_number;
			prph_dsk_card.group (2).model = sys_boot_info$disk_model_number;
		     end;
	     end;
	prph_dsk_card.iom = disk_iom;
	prph_dsk_card.chan = disk_channel;
	call config_$add (prph_dsk_cardp, null ());

	return;


add_card:
     proc (P_card);

/* This procedure adds a single card to the config deck, by converting it and calling config_$add */

	declare (
	        P_card		 char (*) varying,
	        P_cardp		 pointer
	        )			 parameter;

	declare code		 fixed bin (35);


	call cv_config_card_ ((P_card), addr (card_image), code);
	if code ^= 0
	then call syserr (CRASH, "init_early_config: Cannot add card to config deck: ^a", P_card);

	call config_$add (addr (card_image), null ());

	return;					/* End of add_card */


make_card:
     entry (P_card, P_cardp);

/* This entry converts a string to a config card image, and sets P_cardp to point to it. */

	call cv_config_card_ ((P_card), addr (card_image), code);
	if code ^= 0
	then call syserr (CRASH, "init_early_config: Cannot add card to config deck: ^a", P_card);

	P_cardp = addr (card_image);
	return;					/* End of add_card */

     end add_card;


IS_FIPS_DEVICE:
     proc () returns (bit (1));

/*     The theory here is all drives on a channel must be either fips or non
       fips, but not mixed. Therefore look at sys_boot_info$disk_model_number
       and check config_data_ for device_0_valid  */

	dcl     i			 fixed bin;

	do i = 1 to config_data_$disk_drive_model_names.count;
	     if config_data_$disk_drive_model_names.names (i).model = sys_boot_info$disk_model_number
	     then return (config_data_$disk_drive_model_names.names (i).device_0_valid);
	end;
	return ("0"b);
     end IS_FIPS_DEVICE;				/* format: off */
%page; %include config_data_dcls;
%page; %include config_deck;
%page; %include config_clok_card;
%page; %include config_iom_card;
%page; %include config_intk_card;
%page; %include config_cpu_card;
%page; %include config_mem_card;
%page; %include config_part_card;
%page; %include config_prph_opc_card;
%page; %include config_prph_tap_card;
%page; %include config_prph_dsk_card;
%page; %include config_mpc_card;
%page; %include config_root_card;
%page; %include fs_dev_types;
%page; %include io_chnl_util_dcls;
%page; %include syserr_constants;
%page;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   init_early_config: Cannot add card to config deck: CARD.

   S: $crash

   T: $init

   M: The config_deck being generated during the early (hardware inspection)
   pass of bce is damaged.  This can be either a hardware or software
   problem.

   A: $reboot

   END MESSAGE DOCUMENTATION */

	end init_early_config;




		    init_empty_root.pl1             11/11/89  1107.2r w 11/11/89  0815.8       51354



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */



/* format: style2 */

init_empty_root:
     procedure (Pvtx, Code);



	dcl     Pvtx		 fixed bin (17);	/* Physical Volume Table index */
	dcl     Code		 fixed bin (35);	/* error Code */



/*  This procedure initializes a disk for which a PVT entry has already been created.
   It is passed the PVT index and a pointer to an area that has been initialized
   with the data to be stored in the disk label. This procedure sets up
   the label, and calls init_vol_header_ to write it out and set up everything else.

   Modified by B. Greenberg 06/25/76 for init_vol_header_, fixing some bugs as well.
   Modified by J. Bongiovanni, March 1982, for new PVTE, RVTC card
   Modified BIM 10/82 for fill_vol_extents_$cold_rpv
   Modified by Keith Loepere to set the times right even when the clock hasn't been set yet.
*/


/****^  HISTORY COMMENTS:
  1) change(86-01-15,Fawcett), approve(86-04-11,MCR7383),
     audit(86-06-07,GDixon), install(86-07-17,MR12.0-1097):
     Add support for subvolumes and change the args to init_vol_header_.
                                                   END HISTORY COMMENTS */



	dcl     good_clock		 fixed bin (71);	/* Value of clock made reasonable */
	dcl     dev_type		 fixed bin;	/* device type index */
	dcl     num_pages		 fixed bin;	/* Number of records in paging area on this volume */
	dcl     n_vtoce		 fixed bin;	/* number of VTOC entries in VTOC */
	dcl     baseadd		 fixed bin;	/*  base address of paging */
	dcl     thing		 char (20);	/* For error message */
	dcl     1 label_buffer	 aligned like label;


	dcl     addr		 builtin;
	dcl     bit		 builtin;
	dcl     clock		 builtin;
	dcl     convert		 builtin;
	dcl     substr		 builtin;
	dcl     unspec		 builtin;

	dcl     sys_info$access_class_ceiling
				 bit (72) aligned external;
	dcl     sys_info$first_reasonable_time
				 fixed bin (71) ext static;
	dcl     sys_info$last_reasonable_time
				 fixed bin (71) ext static;

	dcl     error_table_$action_not_performed
				 fixed bin (35) ext static;

	dcl     cv_fsdisk_error_	 entry (fixed bin (35));
	dcl     init_vol_header_	 entry (fixed bin, fixed bin, ptr, entry, char (*), fixed bin, fixed bin,
				 fixed bin, fixed bin (35));
	dcl     fill_vol_extents_$cold_rpv
				 entry (ptr, fixed bin, fixed bin, fixed bin, fixed bin, bit (1) aligned,
				 fixed bin);

	dcl     write_disk		 entry (fixed bin, fixed bin, ptr, fixed bin (35));
	dcl     ioa_		 entry options (variable);
	dcl     bce_error		 entry options (variable);

	dcl     ME		 char (32) init ("init_empty_root") int static options (constant);


	Code = 0;
	labelp = addr (label_buffer);
	unspec (label) = ""b;

	good_clock = clock ();
	if good_clock < sys_info$first_reasonable_time | good_clock > sys_info$last_reasonable_time
	then good_clock = sys_info$first_reasonable_time;

	pvtep = addr (addr (pvt$array) -> pvt_array (Pvtx));
	dev_type = pvte.device_type;			/* get the device type index */
	label.version = 1;
	label.mfg_serial = "rpv";			/* fake serial no */
	label.pvid = substr (bit (good_clock, 71), 36, 36);
	good_clock = good_clock + 10;
	label.lvid = substr (bit (good_clock, 71), 36, 36);
	good_clock = good_clock + 10;
	label.lv_name = "root";
	label.pv_name = "rpv";
	label.time_registered = good_clock;
	label.max_access_class = sys_info$access_class_ceiling;
	label.min_access_class = ""b;
	label.Multics = Multics_ID_String;
	label.root.here = "1"b;			/* Root pack. */
	label.root.disk_table_vtocx = -1;
	label.root.disk_table_uid = ""b;
	label.root_vtocx = 0;
	label.shutdown_state = 0;
	label.esd_state = 0;
	if pvte.is_sv
	then do;
		label.number_of_sv = pvte.num_of_svs;
		label.this_sv = pvte.sv_num;
		label.vol_size = rec_per_sv (dev_type);
		label.sub_vol_name = valid_sv_array (pvte.sv_num);
	     end;
	else do;
		label.vol_size = rec_per_dev (dev_type);
		label.sub_vol_name = " ";
	     end;

	call fill_vol_extents_$cold_rpv (labelp, -1 /* no lace command */, n_vtoce, baseadd, num_pages, "0"b, dev_type);

	call ioa_ ("^/^a: Begin rpv initialization. This will take some time.", ME);
	call init_vol_header_ (Pvtx, dev_type, labelp, write_disk, thing, n_vtoce, baseadd, num_pages, Code);
	call cv_fsdisk_error_ (Code);

	if Code ^= 0				/* let caller deal with this */
	then do;
		call bce_error (Code, "^a: Error writing ^a on ^a.", ME, thing,
		     DEVICE_NAME ((pvte.devname), (pvte.logical_area_number), (label.sub_vol_name)));
		Code = error_table_$action_not_performed;
		return;
	     end;

	call ioa_ ("^a: rpv initialized; ^d records.", ME, num_pages);

	return;


DEVICE_NAME:
     procedure (subsys, device, sv_name) returns (char (8));
	declare subsys		 char (4);
	declare sv_name		 char (1);
	declare device		 fixed bin;
	declare p99		 picture "99";

	return (subsys || "_" || convert (p99, device) || sv_name);
     end DEVICE_NAME;

/* format: off */

%page;%include disk_pack;
%page;%include fs_dev_types;
%page;%include fs_vol_label;
%page;%include pvte;

/* BEGIN MESSAGE DOCUMENTATION


   END MESSAGE DOCUMENTATION */

     end init_empty_root;




		    init_partitions.pl1             11/11/89  1107.2r w 11/11/89  0815.8       71568



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */

/* format: style2 */

init_partitions:
     proc ();

/* format: off */

/* *	This procedure reads all the PART cards in the config deck, checks them against
   *	pack labels, 
   *	This used to be in init_pvt.
   *
   *	11/28/80, W. Olin Sibert
   *      7/82 BIM remove fixed bin (9), merge with stocks etc. 
   *         and flush wired_hardcore_data stuff.
   *	'82 for english error codes
   */

/****^  HISTORY COMMENTS:
  1) change(86-01-15,Fawcett), approve(86-04-11,MCR7383),
     audit(86-07-07,GDixon), install(86-07-17,MR12.0-1097):
     Change the format of part card for subvolumes.
  2) change(86-06-05,GJohnson), approve(86-06-05,MCR7387),
     audit(86-06-10,Martinson), install(86-07-17,MR12.0-1091):
     Correct error message documentation.
  3) change(88-03-05,Beattie), approve(88-05-31,MCR7864),
     audit(88-05-13,Brunelle), install(88-05-31,MR12.2-1046):
     Initialize pointer to pvte earlier so error messages will work.
                                                   END HISTORY COMMENTS */

/* format: on */

	dcl     P99		 picture "99" based;
	dcl     pvtx		 fixed bin;
	dcl     part_id		 char (4) aligned;	/* System-defined name of partition */
	dcl     part_name		 char (4) aligned;	/* Name of partition to use on this pack */
	dcl     part_idx		 fixed bin;
	dcl     code		 fixed bin (35);
	dcl     problem		 char (64);
	dcl     drive_no		 fixed bin;
	dcl     sv_no		 fixed bin;
	dcl     sv_idx		 fixed bin;
	dcl     label_buffer	 (512) fixed bin (71) automatic;
						/* Buffer for label reading */

	dcl     config_$find	 entry (char (4) aligned, pointer);
	dcl     read_disk_label	 entry (fixed bin, ptr, char (*), fixed bin (35));
	dcl     syserr		 entry options (variable);
	dcl     syserr$error_code	 entry options (variable);

	dcl     VALID_NUMBERS	 char (10) int static options (constant) init ("0123456789");
	dcl     WHOAMI		 char (32) internal static options (constant) init ("init_partitions:");

	dcl     (addr, bin, convert, index, null, rtrim, substr, verify)
				 builtin;


	labelp = addr (label_buffer);
	pvtp = addr (pvt$);
	pvt_arrayp = addr (pvt.array);

	part_cardp = null ();
GET_NEXT_PART_CARD:
	call config_$find (PART_CARD_WORD, part_cardp);
	if part_cardp = null ()
	then goto FOUND_ALL_PART_CARDS;		/* All done */

	part_id = part_card.name;			/* Find out which partition this is defining */

	if part_card.n_fields = 4
	then part_name = part_card.real_name;		/* Possibly the partition being defined actually */
						/* has a different name, so check first */
	else part_name = part_id;			/* But if none specified, then it's the same as the ID */

	if part_card.n_fields > 4
	then call syserr (BEEP, "^a Ignoring ""^a ^d."" on ^a part card.", WHOAMI, cold_part_card.highlow,
		cold_part_card.nrec, part_id);	/* Complain if this is a leftover cold boot card */

	sv_idx = verify (rtrim (part_card.drive), VALID_NUMBERS);
						/* check for non-numeric character */
	if sv_idx = 0
	then do;					/* non-subvolume device */
		drive_no = bin (part_card.drive, 17);
		sv_no = -1;
	     end;
	else if sv_idx > 1
	then do;					/* possible subvolume device */
		drive_no = bin (substr (part_card.drive, 1, sv_idx - 1), 17);
		sv_no = index (valid_sv_string, substr (rtrim (part_card.drive), sv_idx)) - 1;
		if sv_no = -1			/* bad subvolume indicator */
		then goto invalid_drive;
	     end;
	else do;					/* no valid drive number */
invalid_drive:
		call syserr (CRASH, "^a: Invalid device, ^a_^a, on ^a part card.", WHOAMI, part_card.subsystem,
		     part_card.drive, part_id);
		goto GET_NEXT_PART_CARD;		/* In case someone types GO */
	     end;

	do pvtx = 1 to pvt.n_entries
	     while (pvt_array (pvtx).devname ^= part_card.subsystem | pvt_array (pvtx).logical_area_number ^= drive_no
	     | pvt_array (pvtx).sv_num ^= sv_no);	/* Now, try to find the right volume */
	end;

	if pvtx > pvt.n_entries
	then do;					/* Sorry, not there */
		call syserr (CRASH, "^a Unable to locate ^a_^a for ^a partition.", WHOAMI, part_card.subsystem,
		     part_card.drive, part_id);
		goto GET_NEXT_PART_CARD;		/* In case someone types GO */
	     end;

READ_LABEL:
	call read_disk_label (pvtx, labelp, problem, code);
	if code ^= 0
	then do;
		call syserr$error_code (CRASH, code, "Error reading ^a_^a label. ^a", WHOAMI, part_card.subsystem,
		     part_card.drive, problem);
		goto READ_LABEL;			/* retry label read if GO typed */
	     end;

	pvtep = addr (pvt_array (pvtx));

	if label.nparts = 0
	then do;
		call syserr (CRASH, "^a There are no partitions in the label for ^a_^a^[^a^;^s^] (pvtx ^d).", WHOAMI,
		     pvte.devname, convert (P99, pvte.logical_area_number), pvte.is_sv, pvte.sv_name, pvtx);
		goto GET_NEXT_PART_CARD;		/* In case someone types GO */
	     end;

	do part_idx = 1 to label.nparts while (part_name ^= label.parts (part_idx).part);
						/* Search the label for the one we want */
	end;

	if part_idx > label.nparts
	then do;
		call syserr (CRASH, "^a part ^a^[ for part ^a^;^s^] not in label of ^a_^a^[^a^;^s^] (pvtx ^d)",
		     WHOAMI, part_name, (part_name ^= part_id), part_id, pvte.devname,
		     convert (P99, pvte.logical_area_number), pvte.is_sv, pvte.sv_name, pvtx);
		goto GET_NEXT_PART_CARD;		/* In case someone types GO */
	     end;

	pvte.permanent = "1"b;			/* Protect it against demounting */

	goto GET_NEXT_PART_CARD;


/* We come here when all is done. By rights, we ought to complain about missing
   required partitions here, but that logic isn't designed yet.
   */

FOUND_ALL_PART_CARDS:
	return;					/* All done */
%page;
%include pvt;
%page;
%include pvte;
%page;
%include fs_dev_types;
%page;
%include fs_vol_label;
%page;
%include config_part_card;
%page;
%include syserr_constants;

/* BEGIN MESSAGE DOCUMENTATION

Message:
init_partitions: Ignoring COLD_SPEC on PART_NAME part card.

S:     $beep

T:     $init

M:     Cold boot partition specifications were found for partition
PART_NAME, and will be ignored.

Message:
init_partitions: Invalid device, DISK_DRIVE, on PART_NAME part card.

S:     $crash

T:     $init

M:     An invalid drive definition has been found for the PART_NAME
part card.

A:     Fix PART card.

Message:
init_partitions: Unable to locate DISK_DRIVE for PART_NAME partition.

S:     $crash

T:     $init

M:     Partition PART_NAME is specified in the config deck for a non
existent DISK_DRIVE.

A:     Fix PART and/or PRPH DSK cards.

Message:
init_partitions: Error reading DISK_DRIVE label. PROBLEM ERROR_MESSAGE

S:     $crash

T:     $init

M:     An error has been detected attempting to read the label
of DISK_DRIVE.

A:     Correct problem and type "go" to retry the read.

Message:
init_partition: There are no partitions in the label for DISK_DRIVE (pvtx PVTX).

S:    $crash

T:    $init

M:    DISK_DRIVE has been specified on a part card, but has no partitions
defined in its label.

A:    Fix the config deck.

Message:
init_partition: part PART_NAME not in label of DISK_DRIVE (pvtx PVTX).

S:    $crash

T:    $init

M:    A PART card specified DISK_DRIVE as the location of partition PART_NAME,
but the label of DISK_DRIVE does not define it.

A:    Fix the config deck.

Message:
init_partition: part PART_NAME for part PART_ID not in label of DISK_DRIVE (pvtx PVTX).

S:    $crash

T:    $init

M:    A PART card specified DISK_DRIVE as the location of partition PART_NAME,
but the label of DISK_DRIVE does not define it.

A:    Fix the config deck.

END MESSAGE DOCUMENTATION */

     end init_partitions;




		    init_pvt.pl1                    11/11/89  1107.2r w 11/11/89  0815.8      137853



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(85-09-09,Farley), approve(85-09-09,MCR6979),
     audit(86-03-08,CLJones), install(86-03-21,MR12.0-1033):
     Add IPC FIPS card and
     allow FIPS device number zero.
  2) change(86-01-09,Fawcett), approve(86-04-11,MCR7383),
     audit(86-07-07,GDixon), install(86-07-17,MR12.0-1097):
     Add subvolume support for MSU3380 and MSU3390.
  3) change(86-06-05,GJohnson), approve(86-06-05,MCR7387),
     audit(86-06-10,Martinson), install(86-07-17,MR12.0-1091):
     Correct error message documentation.
                                                   END HISTORY COMMENTS */


/* format: style2 */
init_pvt:
     procedure;

/* format: off */
/* *	INIT_PVT
   *
   *	This procedure initializes the Physical Volume Table to describe all the configured
   *	disk drives. It does this by looking at all the PRPH DSKx cards in the config deck.
   *	It expect the PVT to have already been allocated by get_io_segs, which went through
   *	much the same sort of drive-counting exercise to do so. This procedure does no I/O,
   *	but only sets up the table. It is equivalent in function to the early part of the
   *	old init_pvt, which was split into many separate programs.
   *
   *       HISTORY
   *      
   *	Keith Loepere 10/83 to not set write_limit for early initialization.
   *	E. N. Kittlitz 9/83 to allow drives up to 63, 32 drives per ss.
   *      BIM 7/82 to merge WOS's changes back against stocks and NPML.
   *      collect_free_core called from real_initializer, etc.
   *
   *      February 1982 by J. Bongiovanni for record stocks
   *      June 1981 by C. Hornig to eliminate PML.
   *      Modified 12/21/80 WOS to set sst.write_limit from number of disk subsystems (moved
   *        from make_segs_paged), and to zero fsmap SDWs on entry to allow for multiple calls.
   *	Modified 11/28/80, W. Olin Sibert, for Bootload Multics, and better error detection.
   *	Modified 11/27/80, WOS, to split from old init_pvt (to which earlier history refers)
   *	Modified	4/79, by Michael R. Jordan, for proper MSU500/501/509 initialization,
   *	   and to detect some configuration errors.
   *	Modified	2/79, by Michael R. Jordan, for MSU500 support.
   *	Modified	7/78, by BSG, for MANY hardcore partitions
   *	Modified	3/77, by THVV, for more vol maps than will fit in one segment
   *	Modified	6/76, by D. R. Vinograd, to initialize Volume Dumper variables
   *	Modified throughout 1975, by THVV & BSG, for NSS.
   *	Modified 12/74, by THVV, for NSS
   */
/* format: on */

	dcl     char4		 char (4) aligned;
	dcl     dcp		 (32) pointer unaligned;
						/* Array of pointers to PRPH DSKx card for each subsystem */

	dcl     device_type		 fixed bin;
	dcl     drive_idx		 fixed bin;
	dcl     driveno		 fixed bin;	/* Index of drive being configured */
	dcl     group_idx		 fixed bin;
	dcl     max_driveno		 fixed bin;
	dcl     nd		 fixed bin;	/* Number of disk subsystems */
	dcl     pri_pvtep		 ptr;
	dcl     pri_tx		 fixed bin;
	dcl     partition		 char (4);
	dcl     ss_drive_count	 fixed bin;	/* number of disks in subsystem under construction */
	dcl     subsys		 (32) char (4) aligned;
						/* Array of subsystem names */
	dcl     subsys_idx		 fixed bin;
	dcl     sv_cur		 fixed bin;
	dcl     swap		 bit (1) aligned;
	dcl     tx		 fixed bin;	/* PVTX of PVTE currently being assigned */

	dcl     sst$write_limit	 fixed bin (35) ext static;

	dcl     config_$find	 entry (char (4) aligned, ptr);
	dcl     config_$find_parm	 entry (char (4) aligned, ptr);

	dcl     page$init		 ext entry (fixed bin, ptr);
	dcl     syserr		 entry options (variable);

	dcl     WHOAMI		 char (32) internal static options (constant) init ("init_pvt");
	dcl     MAX_DRIVES_PER_SUBSYSTEM
				 fixed bin init (32) int static options (constant);

	dcl     (
	        VOLMAP_LOCK_WAIT_CONSTANT
				 init ("444000000000"b3),
	        VOLMAP_IDLE_WAIT_CONSTANT
				 init ("445000000000"b3),
	        VTOC_MAP_LOCK_WAIT_CONSTANT
				 init ("446000000000"b3)
	        )			 bit (36) aligned int static options (constant);


	dcl     (addr, addrel, clock, divide, hbound, max, null, ptr, size, substr)
				 builtin;


%page;
/* Check setting and operation of system clock */

/* Initialization */

	pvtp = addr (pvt$);				/* Also locate world */
	pvt_arrayp = addr (pvt.array);
	pvt.time_of_bootload = clock ();
	pvt.volmap_lock_wait_constant = VOLMAP_LOCK_WAIT_CONSTANT;
	pvt.volmap_idle_wait_constant = VOLMAP_IDLE_WAIT_CONSTANT;
	pvt.vtoc_map_lock_wait_constant = VTOC_MAP_LOCK_WAIT_CONSTANT;

	pvt.root_pvid = ""b;			/* Initialize root id */
	pvt.root_pvtx = -1;
	pvt.root_vtocx = -1;			/* not found it yet */

/* Find all PRPH DSKn cards, and generate the PVT indices. */

	nd = 0;					/* Count subsystems */
	prph_dsk_cardp = null;
NEXT_DISK_CARD:
	call config_$find (PRPH_CARD_WORD, prph_dsk_cardp);
						/* Find subsystem description */
	if prph_dsk_cardp ^= null
	then do;					/* Count up this subsystem */
		if substr (prph_dsk_card.name, 1, 3) ^= "dsk"
		then goto NEXT_DISK_CARD;

		do subsys_idx = 1 to nd;		/* Check for duplicates */
		     if subsys (subsys_idx) = prph_dsk_card.name
		     then call syserr (CRASH, "^a: Duplicate prph ^a card.", WHOAMI, prph_dsk_card.name);
		end;

		nd = nd + 1;			/* Found appropriate card. */
		if nd > hbound (subsys, 1)
		then /* Too many subsystems configured. */
		     call syserr (CRASH, "^a: Too many disk subsystems configured. Limit is ^d.", WHOAMI,
			hbound (subsys, 1));

		subsys (nd) = prph_dsk_card.name;	/* Save in scratch */
		dcp (nd) = prph_dsk_cardp;		/* .. */
		goto NEXT_DISK_CARD;		/* Scan whole deck. */
	     end;

	if nd = 0
	then /* Must be some subsystems */
	     call syserr (CRASH, "^a: no PRPH DSKn cards", WHOAMI);

/* Sort the subsystems into canonical order */

	swap = "1"b;				/* Simple interchange sort */
	do while (swap);				/* .. often there will be only one */
	     swap = "0"b;
	     do subsys_idx = 1 to nd - 1;
		if subsys (subsys_idx) > subsys (subsys_idx + 1)
		then do;
			swap = "1"b;		/* interchange */
			prph_dsk_cardp = dcp (subsys_idx);
			dcp (subsys_idx) = dcp (subsys_idx + 1);
			dcp (subsys_idx + 1) = prph_dsk_cardp;

			char4 = subsys (subsys_idx);
			subsys (subsys_idx) = subsys (subsys_idx + 1);
			subsys (subsys_idx + 1) = char4;
		     end;
	     end;
	end;


/* Setup pointers in stock_seg before initializing any hardcore partition */

	stock_segp = addr (stock_seg$);
	stock_seg.record_stock_arrayp = ptr (stock_segp, size (stock_seg));
	stock_seg.vtoce_stock_arrayp =
	     addrel (stock_seg.record_stock_arrayp, stock_seg.n_stock_entries * stock_seg.record_stock_size);


/* Generate PVT */

	tx = 0;					/* "tx" is the current PVT index */
SUBSYS_LOOP:
	do subsys_idx = 1 to nd;			/* Loop over subsystems */
	     prph_dsk_cardp = dcp (subsys_idx);		/* Get ptr to PRPH DSKn card */
	     if IS_FIPS_DEVICE ()
	     then do;
		     driveno = -1;			/* FIPS, will be zero. */
		     max_driveno = 31;
		end;
	     else do;
		     driveno = 0;			/* normal, will be one. */
		     max_driveno = 63;
		end;
	     ss_drive_count = 0;
GROUP_LOOP:
	     do group_idx = 1 to hbound (prph_dsk_card_array.group, 1);
						/* Loop through all its drives */
		if prph_dsk_card.group (group_idx).ndrives = -1
						/* An error on the config card. */
		then call syserr (CRASH, "^a: Missing ndrives field on config card for ^a subsystem.", WHOAMI,
			prph_dsk_card.name);

		if prph_dsk_card.group (group_idx).model = -1
		then call syserr (CRASH, "^a: Missing model field on config card for ^a subsystem.", WHOAMI,
			prph_dsk_card.name);
		if prph_dsk_card.group (group_idx).model = 0
		then do;				/* Nonexistent drive */

			driveno = driveno + prph_dsk_card.group (group_idx).ndrives;
			goto NEXT_DRIVE_GROUP;	/* Skip over the nonconfigured drives */
		     end;

		do device_type = 1 to hbound (MODEL, 1)
		     while (prph_dsk_card.group (group_idx).model ^= MODEL (device_type));
		end;
		if device_type > hbound (MODEL, 1)
		then do;				/* .. check model number */
			call syserr (CRASH, "init_pvt: Unknown model number ^d on prph ^a",
			     prph_dsk_card.group (group_idx).model, prph_dsk_card.name);
		     end;
		device_type = MODELX (device_type);	/* Set device type */

DRIVE_LOOP:
		do drive_idx = 1 to prph_dsk_card.group (group_idx).ndrives;
						/* Generate a PVTE for each possible drive */
		     driveno = driveno + 1;		/* Contiguous alloc of drive nos */

		     if driveno > max_driveno		/* check IDCW unit limit */
		     then call syserr (CRASH, "^a: ^a contains a drive number higher than ^d.", WHOAMI,
			     prph_dsk_card.name, max_driveno);
		     ss_drive_count = ss_drive_count + 1;
		     if ss_drive_count > MAX_DRIVES_PER_SUBSYSTEM
		     then call syserr (CRASH, "^a: More than ^d drives defined for ^a.", WHOAMI,
			     MAX_DRIVES_PER_SUBSYSTEM, prph_dsk_card.name);
		     tx = tx + 1;			/* Generate PVTX */
		     pvtep = addr (pvt_array (tx));	/* Get ptr to PVT entry */
		     pvte.devname = prph_dsk_card.name; /* .. and fill in */
		     pvte.logical_area_number = driveno;/* .. */
		     pvte.device_type = device_type;	/* .. */
		     pvte.storage_system = "1"b;	/* Until told otherwise */
		     pvte.curn_dmpr_vtocx (*) = -1;
		     pvte.volmap_stock_ptr = null ();
		     pvte.vtoc_map_stock_ptr = null ();
		     pvte.is_sv = (number_of_sv (device_type) >= 2);
		     pvte.num_of_svs = number_of_sv (device_type);
		     pvte.removable_pack = media_removable (device_type);
		     pvte.records_per_cyl = rec_per_cyl (device_type);
		     pri_tx = tx;
		     pri_pvtep = pvtep;
		     if pvte.is_sv
		     then do;			/* build first subvolume pvte */
			     pvte.sv_num = 0;	/* number of this subvolume */
			     pvte.sv_name = valid_sv_array (pvte.sv_num);
			     pvte.record_factor = pvte.sv_num * rec_per_cyl (device_type);
			     call page$init (pri_tx, prph_dsk_cardp);
						/* Turn on disk DIM for drive */
			     do sv_cur = 2 to number_of_sv (device_type);
				tx = tx + 1;	/* make another pvt entry */
				pvtep = addr (pvt_array (tx));
				pvte = pri_pvtep -> pvte;
						/* just like the first  except for */
				pvte.sv_num = sv_cur - 1;
						/* number of this subvolume */
				pvte.sv_name = valid_sv_array (pvte.sv_num);
				pvte.record_factor = pvte.sv_num * rec_per_cyl (device_type);

			     end;
			end;
		     else do;
			     pvte.sv_num = -1;
			     pvte.record_factor = 0;
			     pvte.sv_name = " ";
			     call page$init (pri_tx, prph_dsk_cardp);
						/* Turn on disk DIM for drive */
			end;

		end DRIVE_LOOP;
NEXT_DRIVE_GROUP:
	     end GROUP_LOOP;
	end SUBSYS_LOOP;


	pvt.n_entries = tx;				/* Set size of PVT */

	if sys_info$collection_1_phase = SERVICE_INITIALIZATION
	then do;					/* otherwise, use value set in init_sst */
		sst$write_limit = 53 + max (0, 47 * (nd - 1));
						/* Olin's magic formula for sst.write_limit */

		call config_$find_parm ("wlim", parm_ptr);
						/* See if the default should be overridden */
		if parm_ptr ^= null ()
		then /* A parameter was specified */
		     if (numeric_parm.value < 2000) & (numeric_parm.value > 4)
		     then /* And it looks plausible */
			sst$write_limit = numeric_parm.value;
		     else call syserr (BEEP, "^a: Invalid parm wlim value ^d. Default of ^d used.", WHOAMI,
			     numeric_parm.value, sst$write_limit);
	     end;
	return;					/* PVT is initialized */
						/* format: off */

%page;
IS_FIPS_DEVICE:
     proc () returns (bit (1));

/*     The theory here is all drives on a channel must be either fips or non
       fips, but not mixed. Therefore look at the first non-zero model number
       and check config_data_ for device_0_valid  */

dcl (i, j) fixed bin;

     do j = 1 to hbound (prph_dsk_card.group,1);
        if prph_dsk_card.group(j).model ^= 0 then do;
	 do i = 1 to config_data_$disk_drive_model_names.count;
	    if config_data_$disk_drive_model_names.names (i).model =
	       prph_dsk_card.group (j).model then
	       return (config_data_$disk_drive_model_names.names (i).device_0_valid);
	    end;
	 end;
        end;
     return ("0"b);
     end IS_FIPS_DEVICE;
%page; %include collection_1_phases;
%page; %include config_prph_dsk_card;
%include config_prph_card;
%include config_parm_card;
%page; %include config_data_dcls;
%page; %include fs_dev_types;
%page; %include pvt;
%page; %include pvte;
%page; %include stock_seg;
%page; %include syserr_constants;
%page;

/* BEGIN MESSAGE DOCUMENTATION


    Message:
    init_pvt: Duplicate prph DISK_NAME card.

    S:	$crash

    T:	$init

    M:	Two different PRPH cards define DISK_NAME. 

    A:	Fix the config deck.

    Message:
    init_pvt: no PRPH DSKn cards

    S:	$crash

    T:	$init

    M:	No PRPH cards describing disk subsystems were found in the CONFIG deck.

    A:	Correct the CONFIG deck to include the correct PRPH cards to describe
    the disk subsystems present, and reboot.


    Message:
    init_pvt: XXXX contains a drive number higher than N.

    S:	$crash

    T:	$init

    M:	The PRPH card for disk subsystem XXXX specified disk(s) with addresses 
    larger than tha maximum allowable device number, N.

    A:	$recover
    Correct the configuration deck and reboot.

    Message:
    init_pvt: More than N drives defined for XXXX.

    S:	$crash

    T:	$init

    M:	The PRPH card for disk subsystem XXXX specified more than the maximum
    allowable number of disk drives.

    A:	$recover
    Correct the configuration deck and reboot.

    Message:
    init_pvt: Too many disk subsystems configured. Limit is NUMBER.

    S:	$crash

    T:	$init

    M:	More than NUMBER subsystems are defined. Only NUMBER are allowed.

    A:	Rearrange the config deck for disks and try again.

    Message:
    init_pvt: Missing ndrives field on config card for DISK subsystem.

    S:	$crash

    T:	$init

    M:	The PRPH DSK card for DISK lacks the ndrives parameter for
    some model.

    A:	Fix the config deck.

    Message:
    init_pvt: Unknown model MODEL on PRPH DISK.

    S:	$crash

    T:	$init

    M:	The model number MODEL specified somewhere on the prph DISK card
    is not a legal model number.

    A:	Fix the config deck.


    Message:
    init_pvt: Missing model MODEL on PRPH DISK.

    S:	$crash

    T:	$init

    M:	There was no model number specified on the prph DISK card.

    A:	Fix the config deck.

    Message:
    init_pvt: Invalid parm wlim value WLIM. Default of DEFAULT used.

    S:	$beep

    T:	$init

    M:	An unreasonable value (WLIM) was found on a PARM WLIM
    card. DEFAULT has be substituted.

    A:	Fix the config deck.

   END MESSAGE DOCUMENTATION */

     end init_pvt;




		    init_root_vols.pl1              11/11/89  1107.2r w 11/11/89  0815.8      237726



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(74-12-01,VanVleck), approve(), audit(), install():
      Modified by THVV for NSS.
  2) change(75-01-01,VanVleck), approve(), audit(), install():
      Modified throughout 1975 by THVV and BSG for NSS.
  3) change(77-03-01,VanVleck), approve(), audit(), install():
      Modified for more vol maps than will fit in one segment.
  4) change(78-07-01,Greenberg), approve(), audit(), install():
      Modified for MANY hardcore partitions.
  5) change(79-02-01,MJordan), approve(), audit(), install():
      Modified by Michael R. Jordan for MSU500 support.
  6) change(79-04-01,MJordan), approve(), audit(), install():
      Modified for proper MSU500/501/509 initialization, and to detect
      some configuration errors.
  7) change(80-11-27,Sibert), approve(), audit(), install():
      Modified by W. Olin Sibert to split from old init_pvt (to which
      earlier history refers).
  8) change(80-11-28,Sibert), approve(), audit(), install():
      Modified for Bootload Multics and more error detection.
  9) change(82-07-01,Margulies), approve(), audit(), install():
      Modified by BIM to remove references to fsmap and fsdct.
 10) change(82-10-01,Margulies), approve(), audit(), install():
      Modified to return error code if the RPV takes I/O errors.
 11) change(83-03-01,Loepere), approve(), audit(), install():
      Modified by KPL to find or create bce and file partitions.
 12) change(84-03-01,Loepere), approve(), audit(), install():
      Modified to do the right thing on bce passes wrt other hardcore part
      disks.
 13) change(84-09-01,ABall), approve(), audit(), install():
      Modified by Allen Ball to have it check in each pass that the rpv
      in sys_boot_info matched that on the config card.
 14) change(84-12-01,Loepere), approve(), audit(), install():
      Modified by Keith Loepere to add LOG partition to the list of partitions
      to be created on first bootload.
 15) change(85-03-28,Margulies), approve(), audit(), install():
      Modified for root pv's without partitions.
 16) change(85-12-05,Lippard), approve(85-12-02,MCR7309),
     audit(86-07-08,GDixon), install(86-07-17,MR12.0-1097):
      Modified by Jim Lippard to set new pvt bit (root_lv) for all
      root pv's so that accept_rpv will accept root pv's without
      partitions.
 17) change(85-12-20,Fawcett), approve(86-04-11,MCR7383),
     audit(86-07-08,GDixon), install(86-07-17,MR12.0-1097):
     Add subvolume support.
 18) change(86-06-05,GJohnson), approve(86-06-05,MCR7387),
     audit(86-06-10,Martinson), install(86-07-17,MR12.0-1091):
     Correct error message documentation.
                                                   END HISTORY COMMENTS */

/* format: style2 */

init_root_vols:
     procedure (code);

	dcl     code		 fixed bin (35) parameter;

	dcl     1 root_vol_loc_info	 aligned,		/* Array of locations for root volumes */
		2 roots		 (20),
		  3 subsys	 char (4),	/* Subsystem and drive number for each volume */
		  3 drive		 fixed bin,
		  3 subvol	 fixed bin;	/* with an HC partition */

	dcl     subsys_name		 char (4) aligned;
	dcl     problem		 char (64);
	dcl     drive_name		 char (4) aligned;
	dcl     drive_no		 fixed bin (8) unal;
	dcl     sv_no		 fixed bin;
	dcl     n_roots_found	 fixed bin;	/* Number of volumes defined on ROOT card(s) */
	dcl     curtime		 fixed bin (71);	/* When we got started */
	dcl     sv_idx		 fixed bin;
	dcl     root_idx		 fixed bin;
	dcl     vol_idx		 fixed bin;

	dcl     tx		 fixed bin;

	dcl     1 LABEL		 aligned like label;


	dcl     sst$root_pvtx	 fixed bin external static;
	dcl     pvt$root_pvtx	 fixed bin external static;
	dcl     pvt$root_pvid	 bit (36) aligned external static;
	dcl     pvt$root_lvid	 bit (36) aligned external static;
	dcl     pvt$prev_shutdown_state
				 fixed bin external static;
	dcl     pvt$prev_esd_state	 fixed bin external static;
	dcl     pvt$disk_table_vtocx	 fixed bin external static;
	dcl     pvt$disk_table_uid	 bit (36) aligned external static;
	dcl     pvt$n_entries	 fixed bin external static;
	dcl     pvt$root_vtocx	 fixed bin external static;

	dcl     config_$find	 entry (char (4) aligned, pointer);

	dcl     init_empty_root	 entry (fixed bin, fixed bin (35));
	dcl     init_hc_part	 entry (fixed bin, fixed bin (18), fixed bin (18));
	dcl     make_sdw$thread_hcp	 entry (fixed bin);
	dcl     read_disk_label	 entry (fixed bin, ptr, char (*), fixed bin (35));
	declare write_disk		 entry (fixed bin, fixed bin (18), ptr, fixed bin (35));

	dcl     (
	        syserr,
	        syserr$error_code
	        )			 entry options (variable);
	dcl     create_rpv_partition	 entry (fixed bin, ptr, fixed bin, char (4), fixed bin (35));

	dcl     (
	        error_table_$bad_arg,
	        error_table_$bad_volid,
	        error_table_$invalid_elsize,
	        error_table_$noalloc,
	        error_table_$noarg,
	        error_table_$nopart,
	        error_table_$too_many_names
	        )			 fixed bin (35) ext static;

	dcl     sys_boot_info$assume_config_deck
				 bit (1) external;
	dcl     sys_boot_info$config_part_frec
				 fixed bin (18) external;
	dcl     sys_boot_info$disk_device_has_sv
				 bit (1) aligned external;
	dcl     sys_boot_info$disk_device_sv
				 fixed bin (17) external;
	dcl     sys_boot_info$disk_device_number
				 fixed bin (6) external;
	dcl     sys_boot_info$rpv_cold_boot
				 bit (1) aligned ext static;

	dcl     ME		 char (16) internal static options (constant) init ("init_root_vols");
	dcl     VALID_NUMBERS	 char (10) int static options (constant) init ("0123456789");


	dcl     (addr, bin, clock, convert, divide, hbound, index, null, rtrim, substr, verify)
				 builtin;


	code = 0;
	curtime = clock ();

	labelp = addr (LABEL);
	pvt_arrayp = addr (pvt$array);


/* Locate all the volumes to have HC parts to be used at bootload time. */

	n_roots_found = 0;
	root_cardp = null;
FIND_MORE_ROOT_CARDS:
	call config_$find (ROOT_CARD_WORD, root_cardp);
	if root_cardp = null
	then goto ALL_ROOT_CARDS_GOTTEN;

	do vol_idx = 1 to hbound (root_card_array.volume, 1);
						/* Scan the card. */
	     subsys_name = root_card.volume (vol_idx).subsystem;
						/* Pick up ssname */
	     drive_name = root_card.volume (vol_idx).drive;

	     sv_idx = verify (rtrim (drive_name), VALID_NUMBERS);
						/* check for non-numeric character */
	     if sv_idx = 0
	     then do;				/* non-subvolume device */
		     drive_no = bin (drive_name, 17);
		     sv_no = -1;
		end;
	     else if sv_idx > 1
	     then do;				/* possible subvolume device */
		     drive_no = bin (substr (drive_name, 1, sv_idx - 1), 17);
		     sv_no = index (valid_sv_string, substr (rtrim (drive_name), sv_idx)) - 1;
		     if sv_no = -1			/* bad subvolume indicator */
		     then goto invalid_drive;
		end;
	     else do;				/* no valid drive number */
invalid_drive:
		     call syserr (CRASH, "^a: Invalid device on root card ^a_^a.", ME, subsys_name, drive_name);
		     code = error_table_$bad_arg;	/* In case someone types GO */
		     goto RETURN;
		end;

	     n_roots_found = n_roots_found + 1;

	     if n_roots_found > hbound (root_vol_loc_info.roots, 1)
	     then do;
		     call syserr (CRASH, "^a: Maximum of ^d RLV vols has been exceeded.", ME, n_roots_found - 1);
		     code = error_table_$too_many_names;/* In case someone types GO */
		     goto RETURN;
		end;

	     do root_idx = 1 to n_roots_found - 1;	/* Check for duplications */
		if (subsys_name = root_vol_loc_info.roots (root_idx).subsys)
		     & (drive_no = root_vol_loc_info (root_idx).drive) & (sv_no = root_vol_loc_info (root_idx).subvol)
		then do;
			call syserr (CRASH, "^a: ^a_^a appears twice on root cards.", ME, subsys_name, drive_name);
			code = error_table_$bad_arg;	/* In case someone types GO */
			goto RETURN;
		     end;
	     end;

	     root_vol_loc_info.roots (n_roots_found).subsys = subsys_name;
						/* Copy to table. */
	     root_vol_loc_info.roots (n_roots_found).drive = drive_no;
	     root_vol_loc_info.roots (n_roots_found).subvol = sv_no;
						/* Check to make sure that it matches the one in sys_boot_info. */
	     if n_roots_found = 1
	     then if ^sys_boot_info$assume_config_deck
		     & ((sys_boot_info$disk_device_number ^= root_vol_loc_info.roots (1).drive)
		     | (sys_boot_info$disk_device_sv ^= root_vol_loc_info.roots (1).subvol))
		then do;

			call syserr (CRASH,
			     "^a: RPV specified in the configuration deck (^a) does not match sys_boot_info (^d^[^a^]).",
			     ME, drive_name, sys_boot_info$disk_device_number, sys_boot_info$disk_device_has_sv,
			     sys_boot_info$disk_device_sv);
			code = error_table_$bad_arg;	/* In case someone types GO */
			goto RETURN;
		     end;
	     if sys_info$collection_1_phase ^= SERVICE_INITIALIZATION
	     then go to ALL_ROOT_CARDS_GOTTEN;		/* only one root vol (rpv) for bce */
	end;

	goto FIND_MORE_ROOT_CARDS;


ALL_ROOT_CARDS_GOTTEN:
	if n_roots_found = 0
	then do;
		call syserr (CRASH, "^a: No root card.", ME);
		code = error_table_$noarg;		/* In case someone types GO */
		goto RETURN;
	     end;

	do root_idx = 1 to n_roots_found;		/* Now, find all the HC partitions */
	     subsys_name = root_vol_loc_info (root_idx).subsys;
						/* Copy out for easier reference */
	     drive_no = root_vol_loc_info (root_idx).drive;
	     sv_no = root_vol_loc_info (root_idx).subvol;
	     do tx = 1 to pvt$n_entries;		/* Find the right pvte */
		pvtep = addr (pvt_array (tx));
		if (pvte.devname = subsys_name) & (pvte.logical_area_number = drive_no) & (pvte.sv_num = sv_no)
		then goto FOUND_ROOT_VOL_PVTE;	/* This is the one */
	     end;

	     call syserr (CRASH, "^a: root card specifies nonexistent drive ^a.", ME,
		DEVICE_NAME (subsys_name, drive_no, sv_no));
	     code = error_table_$bad_arg;		/* In case someone types GO */
	     goto RETURN;

FOUND_ROOT_VOL_PVTE:
	     if root_idx = 1
	     then pvte.rpv = "1"b;			/* RPV is defined to be first vol named on */
						/* the first ROOT card. */
	     pvte.root_lv = "1"b;

	     call INIT_HC_PART;			/* Enable the supervisor paging partition */

	     if pvte.rpv
	     then call ENABLE_RPV;			/* Set special info if this is the RPV */
	end;					/* Of loop through root vol specs */

	if pvt$root_vtocx = -1
	then do;					/* Did we find the root? */
		call syserr (CRASH, "^a: RPV not found.", ME);
		code = error_table_$bad_arg;		/* In case someone types GO */
		goto RETURN;
	     end;
RETURN:
	return;					/* all done */


INIT_HC_PART:
     proc;

/* Seek out a hardcore partition on this volume.	There ought be one.  
   Allocate and initialize the map for that hc part, thread into PVT. */

	dcl     part_idx		 fixed bin;
	dcl     bce_part_idx	 fixed bin;
	dcl     file_part_idx	 fixed bin;
	dcl     log_part_idx	 fixed bin;
	dcl     baseadd		 fixed bin (18);
	dcl     totrec		 fixed bin (18);
	dcl     hc_part_idx		 fixed bin;
	dcl     DEFAULT_BCE_PART_SIZE	 fixed bin init (2200) static options (constant);
	dcl     DEFAULT_FILE_PART_SIZE fixed bin init (255) static options (constant);
	dcl     DEFAULT_LOG_PART_SIZE	 fixed bin init (256) static options (constant);

	if sys_boot_info$rpv_cold_boot & pvte.rpv
	then do;					/* Init the vol. */
		call init_empty_root (tx, code);
		if code ^= 0			/* I/O error on drive */
		then go to RETURN;

/* sys_boot_info$rpv_cold_boot is turned off in real_initializer, after */
/* the config deck is written onto the RPV. */

	     end;

READ_LABEL:
	call read_disk_label (tx, labelp, problem, code);
	if code ^= 0				/* guaranteed to mean that there was an I/O error */
	then do;
		call syserr$error_code (CRASH, code, "^a: Error reading ^a label. ^a", ME,
		     DEVICE_NAME (pvte.devname, pvte.logical_area_number, pvte.sv_num), problem);
		go to READ_LABEL;			/* retry read if "go" typed. */
	     end;
	hc_part_idx = PART_SEARCH ("hc", labelp);

	if hc_part_idx = -1 & pvte.rpv
	then do;
		call syserr (CRASH, "^a: No part hc on RPV volume ^a.", ME,
		     DEVICE_NAME (pvte.devname, pvte.logical_area_number, pvte.sv_num));
		code = error_table_$nopart;		/* In case someone types GO */
		goto RETURN;
	     end;

	if pvte.rpv
	then do;
		part_idx = PART_SEARCH ("conf", labelp);
		if part_idx = -1
		then call ADD_CONF_PART (hc_part_idx, labelp);
		else sys_boot_info$config_part_frec = labelp -> label.parts (part_idx).frec;

		bce_part_idx = PART_SEARCH ("bce ", labelp);
		if bce_part_idx ^= -1
		then if labelp -> label.parts (bce_part_idx).nrec < BCE_PART_LTH
		     then do;
			     call syserr (CRASH, "^a: bce partition is ^d records, must be ^d.", ME,
				labelp -> label.parts (bce_part_idx).nrec, BCE_PART_LTH);
			     code = error_table_$invalid_elsize;
						/* In case someone types GO */
			     goto RETURN;
			end;

		file_part_idx = PART_SEARCH ("file", labelp);

		log_part_idx = PART_SEARCH ("log ", labelp);

		if bce_part_idx = -1 | file_part_idx = -1 | log_part_idx = -1
		then call ADD_BM_PARTS;
	     end;

/* Copy parameters for HC part into PVT */

	if hc_part_idx > 0 /* yes, it has a partition */ & sys_info$collection_1_phase = SERVICE_INITIALIZATION
	then do;
		baseadd = label.parts (hc_part_idx).frec;
		totrec = label.parts (hc_part_idx).nrec;

		call init_hc_part (tx, baseadd, totrec);

/* Thread the hardcore part PVTE's. */

		call make_sdw$thread_hcp (tx);

		pvte.hc_part_used = "1"b;		/* See accept_fs_disk */
	     end;

	pvte.permanent = "1"b;			/* No demount. */
	return;


ADD_CONF_PART:
     procedure (hc_partx, labelp);
	declare hc_partx		 fixed bin;
	declare labelp		 pointer;
	declare conf_partx		 fixed bin;

	call syserr (ANNOUNCE, "^a: Adding config (conf) partition to rpv.", ME);

	conf_partx = labelp -> label.nparts + 1;
	if conf_partx > hbound (labelp -> label.parts, 1)
	then do;
		call syserr (CRASH, "^a: No room in rpv label for conf partition.", ME);
		code = error_table_$noalloc;		/* In case someone types GO */
		goto RETURN;
	     end;
	labelp -> label.nparts = conf_partx;
	labelp -> label.parts (conf_partx).part = "conf";
	labelp -> label.parts (conf_partx).frec =
	     (labelp -> label.parts (hc_partx).frec + labelp -> label.parts (hc_partx).nrec) - 4;
						/* shave off */
	labelp -> label.parts (conf_partx).nrec = 4;
	labelp -> label.parts (hc_partx).nrec = labelp -> label.parts (hc_partx).nrec - 4;
WRITE_LABEL:
	call write_disk (tx, (LABEL_ADDR), labelp, code);
	if code ^= 0
	then do;
		call syserr$error_code (CRASH, code, "^a: Error writing rpv label on ^a.", ME,
		     DEVICE_NAME (pvte.devname, pvte.logical_area_number, pvte.sv_num));
		goto WRITE_LABEL;			/* retry write, if "go" typed. */
	     end;
	sys_boot_info$config_part_frec = labelp -> label.parts (conf_partx).frec;
	return;
     end ADD_CONF_PART;

ADD_BM_PARTS:
     proc;
	dcl     first_new_part	 char (4);	/* name of first part to add */
	dcl     last_part_idx	 fixed bin;	/* index in label for last part to add */
	dcl     partition_start	 fixed bin;	/* record number thereof */
	dcl     total_part_size	 fixed bin;	/* to be added */

	call syserr (ANNOUNCE, "^a: Adding ^[bce ^;^]^[file ^;^]^[log ^;^]partition(s) to rpv.", ME, bce_part_idx = -1,
	     file_part_idx = -1, log_part_idx = -1);

	total_part_size = 0;
	first_new_part = "";
	last_part_idx = labelp -> label.nparts;
	if bce_part_idx = -1
	then do;
		total_part_size = total_part_size + DEFAULT_BCE_PART_SIZE;
		last_part_idx = last_part_idx + 1;
		if first_new_part = ""
		then first_new_part = "bce ";
	     end;
	if file_part_idx = -1
	then do;
		total_part_size = total_part_size + DEFAULT_FILE_PART_SIZE;
		last_part_idx = last_part_idx + 1;
		if first_new_part = ""
		then first_new_part = "file";
	     end;
	if log_part_idx = -1
	then do;
		total_part_size = total_part_size + DEFAULT_LOG_PART_SIZE;
		last_part_idx = last_part_idx + 1;
		if first_new_part = ""
		then first_new_part = "log ";
	     end;
	if last_part_idx > hbound (labelp -> label.parts, 1)
	then do;
		call syserr (CRASH, "^a: No room in rpv label for partitions.", ME);
		code = error_table_$noalloc;		/* In case someone types GO */
		goto RETURN;
	     end;

	call create_rpv_partition (tx, labelp, total_part_size, first_new_part, code);
	if code ^= 0
	then do;
		call syserr$error_code (CRASH, code, "^a: Error adding partitions to rpv on ^a.", ME,
		     DEVICE_NAME (pvte.devname, pvte.logical_area_number, pvte.sv_num));
		goto RETURN;			/* In case someone types GO */
	     end;

/* Trim space from one partition for others. */

	partition_start = labelp -> label.parts (labelp -> label.nparts).frec;
	labelp -> label.nparts = labelp -> label.nparts - 1;
	if bce_part_idx = -1
	then do;
		labelp -> label.nparts, bce_part_idx = labelp -> label.nparts + 1;
		labelp -> label.parts (bce_part_idx).nrec = DEFAULT_BCE_PART_SIZE;
		labelp -> label.parts (bce_part_idx).part = "bce ";
		labelp -> label.parts (bce_part_idx).frec = partition_start;
		partition_start = partition_start + DEFAULT_BCE_PART_SIZE;
	     end;
	if file_part_idx = -1
	then do;
		labelp -> label.nparts, file_part_idx = labelp -> label.nparts + 1;
		labelp -> label.parts (file_part_idx).nrec = DEFAULT_FILE_PART_SIZE;
		labelp -> label.parts (file_part_idx).part = "file";
		labelp -> label.parts (file_part_idx).frec = partition_start;
		partition_start = partition_start + DEFAULT_FILE_PART_SIZE;
	     end;
	if log_part_idx = -1
	then do;
		labelp -> label.nparts, log_part_idx = labelp -> label.nparts + 1;
		labelp -> label.parts (log_part_idx).nrec = DEFAULT_LOG_PART_SIZE;
		labelp -> label.parts (log_part_idx).part = "log ";
		labelp -> label.parts (log_part_idx).frec = partition_start;
		partition_start = partition_start + DEFAULT_LOG_PART_SIZE;
	     end;

WRITE_LABEL:
	call write_disk (tx, (LABEL_ADDR), labelp, code); /* show trimmed part to disk */
	if code ^= 0
	then do;
		call syserr$error_code (CRASH, code, "^a: Error writing rpv label on ^a.", ME,
		     DEVICE_NAME (pvte.devname, pvte.logical_area_number, pvte.sv_num));
		goto WRITE_LABEL;			/* retry write, if "go" typed. */
	     end;
     end ADD_BM_PARTS;
     end INIT_HC_PART;


ENABLE_RPV:
     procedure;

/* This procedure is called to set up the RPV */
/* Implicit  parameters: tx, device_type */
/* Also fills the location of the bce partition in sys_boot_info */


	dcl     bce_partx		 fixed bin;
	dcl     sys_boot_info$bce_part_frec
				 external fixed bin (18);
	dcl     sys_boot_info$bce_part_nrec
				 external fixed bin (18);

	pvt$root_pvtx = tx;
	sst$root_pvtx = tx;

READ_RPV_LABEL:
	call read_disk_label (tx, labelp, problem, code); /* Get label from disk pack */
	if code ^= 0
	then do;
		call syserr$error_code (CRASH, code, "^a: Error reading RPV label on ^a. ^a", ME,
		     DEVICE_NAME (pvte.devname, pvte.logical_area_number, pvte.sv_num), problem);
		go to READ_RPV_LABEL;		/* retry read if "go" typed. */
	     end;

	if ^label.root.here
	then do;
		call syserr (CRASH, "^a: ^a is not the rpv, but rather is ^a.", ME,
		     DEVICE_NAME (pvte.devname, pvte.logical_area_number, pvte.sv_num), label.pv_name);
		code = error_table_$bad_volid;	/* In case someone types GO */
		go to RETURN;
	     end;

	bce_partx = PART_SEARCH ("bce ", labelp);
	if bce_partx = -1
	then sys_boot_info$bce_part_frec = -1;		/* None defined */
	else do;
		sys_boot_info$bce_part_frec = label.parts (bce_partx).frec;
		sys_boot_info$bce_part_nrec = label.parts (bce_partx).nrec;
	     end;

	pvt$root_pvid = label.pvid;			/* This IS the root */
	pvte.pvid = label.pvid;
	pvte.lvid = label.lvid;
	pvt$root_vtocx = label.root.root_vtocx;
	pvt$root_lvid = label.lvid;

	pvt$prev_shutdown_state = label.root.shutdown_state;
	pvt$prev_esd_state = label.root.esd_state;

	pvt$disk_table_vtocx = label.root.disk_table_vtocx;
	pvt$disk_table_uid = label.root.disk_table_uid;

	return;
     end ENABLE_RPV;
%page;
DEVICE_NAME:
     procedure (subsys, drive, sv) returns (char (8));
	declare subsys		 char (4) aligned;
	declare drive		 fixed bin (8) unal;
	declare p99		 picture "99";
	declare sv		 fixed bin;
	if sv = -1
	then return (subsys || "_" || convert (p99, drive) || " ");
	else return (subsys || "_" || convert (p99, drive) || valid_sv_array (sv));
     end DEVICE_NAME;


PART_SEARCH:
     procedure (part, labelp) returns (fixed bin);
	declare part		 character (4);
	declare part_idx		 fixed bin;
	declare labelp		 pointer;

	do part_idx = 1 to labelp -> label.nparts while (labelp -> label.parts (part_idx).part ^= part);
						/* Seek out HC part. */
	end;
	if part_idx <= labelp -> label.nparts
	then return (part_idx);
	else return (-1);
     end PART_SEARCH;

/* format: off */
%page; %include disk_pack;
%page; %include pvt;
%page; %include pvte;
%page; %include collection_1_phases;
%page; %include config_root_card;
%page; %include syserr_constants;
%page; %include fs_vol_label;
%page; %include fs_dev_types;
%page; %include bce_partition_layout;

/* BEGIN MESSAGE DOCUMENTATION

     Message:
     init_root_vols: Invalid device on root card DISK_VOL.

     S: $crash

     T: $init

     M: A root card has been found with an invalid DISK_VOL.

     A: Change the config deck and try again.

     Message:
     init_root_vols: Maximum of LIMIT RLV vols has been exceeded.

     S: $crash

     T: $init

     M: The "root" card in the config deck specified more RLV volumes
     than the system can handle.

     A: Change the config deck and try again.

     Message:
     init_root_vols: DISK_VOL appears twice on root cards.

     S: $crash

     T: $init

     M: The volume DISK_VOL appears more than once on the ROOT
     config card(s).

     A: Fix the config deck and try again.

     Message:
     init_root_vols: RPV specified in the configuration deck (DRIVE) does not match sys_boot_info (DRIVE).

     S: $crash

     T: $init

     M: The RPV defined on the root card is not the same as the RPV
     that is currently being used.

     A: Fix the config deck and try again.

     Message:
     init_root_vols: No root card.

     S: $crash

     T: $init

     M: No "root" card(s) were found in the config deck. At least
     one must be present, defining the RPV and other RLV volumes.

     A: Fix the config deck and reboot.

     Message:
     init_root_vols: root card specifies nonexistent drive DISK_VOL.

     S: $crash

     T: $init

     M: The volume DISK_VOL, specified in the config deck, is not
     defined by the prph dskX cards.

     A: Fix the config deck and reboot.

     Message:
     init_root_vols: RPV not found.

     S: $crash

     T: $init

     M: None of the disk volumes specified in the "root" card(s)
     admitted to being the RPV.

     A: Check to be sure the drive on which the RPV is mounted is specified
     first on the "root" card(s).

     Message:
     init_root_vols: Error reading DISK_VOL label. PROBLEM ERROR_MESSAGE

     S: $crash

     T: $init

     M: An error has been detected attempting to read the label
     of DISK_VOL.

     A: Correct problem and type "go" to retry the read.

     Message:
     init_root_vols: No part hc on RPV volume DISK_VOL.

     S: $crash

     T: $init

     M: Disk DISK_VOL was specified on a "root" card as the RPV,
     but does not have a hardcore (hc) partition. 

     A: The "root" card is incorrect, or the wrong pack is mounted on
     the first drive described by the "root" cards.

     Message:
     init_root_vols: bce partition is XXX records, must be YYY.

     S: $crash

     T: $init

     M: The bce partition defined on the rpv is not sufficiently large.

     A: Rebuild the rpv to have a large enough bce partition.
     $contact

     Message:
     init_root_vols: Adding config (conf) partition to rpv.

     S: $info

     T: $init

     M: No conf partition was found on the rpv.  It will be created by
     extracting 4 records from the hc partition.

     A: $ignore

     Message:
     init_root_vols: No room in rpv label for conf partition.

     S: $crash

     T: $info

     M: The partition map for the rpv did not have sufficient room to
     add the conf partition.

     A: The rpv will need to be rebuilt.
     $contact

     Message:
     init_root_vols: Error writing rpv label on DISK_VOL. ERROR_MESSAGE

     S: $crash

     T: $init

     M: An i/o prevented updating the rpv label to show the new partitions.

     A: Correct problem and type "go" to retry the write.

     Message:
     init_root_vols: Adding {bce} {file} {log} partition(s) to rpv.

     S: $info

     T: $init

     M: The rpv does not contain the listed partitions.  The pages of
     the rpv are being arranged to add these partitions.  This operation
     takes several minutes.

     A: $ignore

     Message:
     init_root_vols: No room in rpv label for partitions.

     S: $crash

     T: $init

     M: The rpv label does not have enough room in the partition map for
     the new bce, file or log partitions.

     A: The rpv will need to be rebuilt.
     $contact

     Message:
     init_root_vols: Error adding partitions to rpv on DISK_VOL. ERROR_MESSAGE

     S: $crash

     T: $init

     M: It was not possible to add the new partitions to the rpv.  This
     message will be preceeded by a more informative message.

     A: Depending on the previous message, either a reboot should be
     attempted or the rpv will need to be rebuilt.

     Message:
     init_root_vols: Error reading RPV label on DISK_VOL. PROBLEM ERROR_MESSAGE

     S: $crash

     T: $init

     M: An error has been detected attempting to read the label
     of the RPV.

     A: Correct problem and type "go" to retry the read.

     Message:
     init_root_vols: DISK_VOL is not the rpv, but rather is VOLUME.

     S: $crash

     T: $init

     M: The label for the RPV is inconsistent. label.root.here
     does not agree with other data, or an incorrect pack is
     mounted on the first drive specified by the "root" card.

     A: Reload/restore, or patch the RPV label back together or
     correctly mount the RPV.

END MESSAGE DOCUMENTATION */

end init_root_vols;




		    init_sst.pl1                    11/11/89  1107.2r w 11/11/89  0815.8      157014



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


/* format: style4,insnl,delnl */
init_sst:
     procedure;

/* This procedure is called early in initialization to set up the sst:
   the page table words, the ast entries, and the core map are initialized.
   It is assumed that bootload_loader has loaded all supervisor segments in a block
   of contiguous core beginning with the end of the physical record buffer, and has loaded
   all initialization segments in a contiguous block of core at the top of core.
   The sst is allocated as high as possible on the bootload scu, but below
   initialization segments.

   Last Modified: (Date and Reason)
   85-03-08 Keith Loepere for the real covert event limits.
   85-02-12 Keith Loepere for another try at setting controller abs_wired.
   85-01-08 Keith Loepere to add covert channel variables.
   84-05-04 Keith Loepere for fix to setting abs_wired for memory controllers.
   84-01-05 BIM to finish below.
   831220 by E. N. Kittlitz for pc$segmove variables
   November 1983 by Keith Loepere for bce_sst_sizes.
   September 1983 by Keith Loepere for paged sst and core_map; also to 
	write_limit correctly for early initialization.
   07/20/82 BIM to redo WOS's early initialization entrypoint
   and memory clearing tricks for Bootload Multics.
   06/21/82 by E. N. Kittlitz to move core map.
   12/18/81 by J. Bongiovanni to remove pdmap, add ast hash table
   11/21/80 by J. Bongiovanni to allocate sst high on bootload scu
   2/19/79 by D. Spector to set sst.write_limit
   8/16/77 by B. Greenberg to obey mem card limits.
   2/9/76	by S. Webber for get_main and new reconfiguration stuff
   04/16/75 by BSG for SST name table on top of New Storage System
   10/03/71 by RHG to add PAGE card to config deck
   09/22/71 by RHG to set cmep->cme.contr earlier
   08/27/71 by Richard H. Gumpertz for page multi-level
*/

/* Automatic */

dcl  base fixed bin (18);				/* base page number (1024 word block) of system controller */
dcl  cm_size fixed bin (18);				/* size of core map (words) */
dcl  cmp ptr;
dcl  coresize fixed bin (18);				/* number of pages (max) in core */
dcl  early_call bit (1) aligned;
dcl  i fixed bin;
dcl  initbase fixed bin (18);				/* base page no for init segments */
dcl  memory_address fixed bin (26);
dcl  n_astes fixed bin;				/* total number of ASTEs */
dcl  n_buckets fixed bin;				/* number of AST hast table buckets */
dcl  next_available ptr;
dcl  page_no fixed bin (18);
dcl  pool_idx fixed bin;
dcl  scu_top fixed bin (18);				/* page number of high page on bootload scu */
dcl  size_mod_1024 fixed bin (18, -10);
dcl  sizes (0:3) fixed bin (18);			/* array for AST pool sizes */
dcl  sst_size fixed bin (18);
dcl  sst_absadr fixed bin (26);
dcl  total_base fixed bin (18);			/* page number of begin of sst/cm segments */
dcl  total_pages fixed bin (18);			/* number of pages in sst & cmp */
dcl  total_size fixed bin (21);			/* number of words in sst & cmp */
dcl  total_top fixed bin (18);			/* page number of end of cmp */
dcl  suptop fixed bin (18);				/* top page number for supervisor segments */
dcl  top fixed bin (18);				/* top page number of memory module */
dcl  uid_mask bit (36) aligned;			/* mask to strip out low-order bits of uid */

dcl  (cm_sdw, sst_sdw) fixed bin (71);
dcl  1 local_sst_card aligned like sst_card;

/* Static */

/* dcl  debug bit (1) aligned init ("1"b) static options (constant); /* build unpaged sst, core_map */ 
dcl  AVG_HT_DEPTH fixed bin int static options (constant) init (5);
						/* desired avg AST hash table depth */
dcl  HT_SIZES (6) fixed bin int static options (constant)	/* allowable AST hash table sizes */
	init (64, 128, 256, 512, 1024, 2048);
dcl  HT_UID_MASKS (6) bit (36) aligned int static options (constant)
						/* corresponding masks to strip out low-order uid bits */
	init ("000000000077"b3, "000000000177"b3, "000000000377"b3, "000000000777"b3, "000000001777"b3,
	"000000003777"b3);
dcl  PTS (0:3) fixed bin static init (4, 16, 64, 256) options (constant);
						/* Global constants */

dcl  WHOAMI char (8) init ("init_sst") int static options (constant);

/* Builtins */

dcl  (addr, addrel, baseno, divide, hbound, lbound, max, min, bit, bin, null, size, sum, unspec) builtin;

/* External */

dcl  core_map$ ext bit (36) aligned;
dcl  slt$ ext bit (36) aligned;
dcl  sys_boot_info$bce_sst_sizes (0:3) fixed bin ext static;
dcl  sys_boot_info$bootload_mem_size fixed bin (26) ext static;
dcl  unpaged_page_tables$ ext static;

/* Entries */

dcl  absadr entry (ptr, fixed bin (35)) returns (fixed bin (26));
dcl  config_$init_card entry (char (4) aligned, ptr);
dcl  config_$add entry (ptr, ptr);
dcl  config_$find_parm entry (char (4) aligned, ptr);
dcl  freecore entry (fixed bin (18));
dcl  get_main entry (ptr, fixed bin (18), fixed bin (71));
dcl  get_main$given_address entry (ptr, fixed bin (26), fixed bin (18), fixed bin (71));
dcl  init_aste_pools entry;
dcl  pmut$swap_sdw entry (ptr, ptr);
dcl  syserr entry options (variable);
dcl  config_$find entry (char (4) aligned, ptr);


early:
     entry;

/* This entrypoint is called to set up an SST for the early environment, */
/* where there is only sys_boot_info$bootload_mem_size available. */
/* This may or may not turn out to be the right SST setup for the */
/* returnable to system */

	call init_ptrs;				/* get seg ptrs to sst, core map, slt, etc. */

	early_call = "1"b;				/* Remember why we're here */

	sizes (*) = sys_boot_info$bce_sst_sizes (*);

	coresize = divide (sys_boot_info$bootload_mem_size, 1024, 26, 0);

	suptop = divide (slt.free_core_start + 1023, 1024, 18, 0);
						/* First page boundary after the wired supervisor */
	initbase = divide (slt.free_core_start + slt.free_core_size, 1024, 18, 0) - 1;
						/* first page boundary below the init segs */
	goto ALLOCATE_SST;


normal:
     entry;

/* This entrypoint is used for service boots. It pays attention to */
/* the config deck, rather than hoking the situation up */

	call init_ptrs;				/* get pointers to interesting places */

	early_call = "0"b;

/* Get storage for SST as function of SST card. */

	sst_cardp = null;
	call config_$find ("sst ", sst_cardp);		/* get SST card */
	if sst_cardp = null then do;
	     sst_cardp = addr (local_sst_card);		/* prepare to construct */
	     call config_$init_card (SST_CARD_WORD, sst_cardp);

	     sst_card.no_aste (0) = 400;
	     sst_card.no_aste (1) = 150;
	     sst_card.no_aste (2) = 50;		/* These add up to nice size */
	     sst_card.no_aste (3) = 20;		/* and Olin thought this needed to be this big */

	     do pool_idx = 1 to 4;
		sst_card.field_type (pool_idx) = CONFIG_DECIMAL_TYPE;
	     end;

	     call config_$add (sst_cardp, null);	/* add it in */


	     call syserr (BEEP, "^a: No SST card in config deck. One has been added: SST^2x^4(^d.^2x^)", WHOAMI,
		sst_card.no_aste);

	end;

	sizes (*) = sst_card.no_aste (*);		/* Copy them locally */


/* Now see how much storage has to be described in the core map */
/* Note that this code will work even if the supervisor segs */
/* overflow into a second controller. */


	suptop = divide (slt.free_core_start + 1023, 1024, 18, 0);
						/* First page boundary after the wired supervisor */
	initbase = divide (slt.free_core_start + slt.free_core_size, 1024, 18, 0) - 1;
						/* first page boundary below the init segs */

	scu_top = 0;
	coresize = 0;
	do i = 0 to 7;
	     if scs$controller_data (i).online | scs$controller_data (i).offline
						/* make sure controller is being used */
	     then do;
		coresize = max (coresize, scs$controller_data (i).size + scs$controller_data (i).base);
		if scs$controller_data (i).online then do;
		     base = scs$controller_data (i).base;
						/* starts at zero */
		     top = base + scs$controller_config_size (i) - 1;
						/* make zero based page number */
		     if base < suptop
		     then				/* controller abs-wired */
			if top > scu_top
			then scu_top = top;
		end;
	     end;
	end;


ALLOCATE_SST:					/* early and normal entrypoints join here, with coresize and other */
						/* handy variables set */
						/* Now see how big the Hash Table gets */

	n_astes = sum (sizes);			/* builtins are good things */

	n_buckets = divide (n_astes, AVG_HT_DEPTH, 17);
	do i = 1 to hbound (HT_SIZES, 1) while (n_buckets > HT_SIZES (i));
	end;
	if i > hbound (HT_SIZES, 1)
	then i = hbound (HT_SIZES, 1);
	n_buckets = HT_SIZES (i);
	uid_mask = HT_UID_MASKS (i);

/* Now we know enough to get size of sst segment */

	sst_size = size (sst) + n_buckets;
	do i = 0 to 3;				/* now include AST/PT storage */
	     sst_size = sst_size + (size (aste) + PTS (i)) * sizes (i);
	end;

	cm_size = coresize * size (cme) + 8;		/* The 8 is for a backstop to detect invalid zero threads ! */

	size_mod_1024 = sst_size + 1023;
	sst_size = size_mod_1024;			/* compiler bug stops obvious builtin form */
						/* i.e., fixed (fixed (foo, 18, -10), 18, 0) makes bad code */
	size_mod_1024 = cm_size + 1023;
	cm_size = size_mod_1024;


	if early_call				/* dont know from controllers, just shtup it someplace */
	then do;
	     call get_main (sstp, sst_size, sst_sdw);
	     call get_main (cmp, cm_size, cm_sdw);
	     call pmut$swap_sdw (sstp, addr (sst_sdw));
	     call pmut$swap_sdw (cmp, addr (cm_sdw));
/*	     if debug then call make_unpaged; */
	end;
	else do;
	     total_size = sst_size + cm_size;
	     size_mod_1024 = total_size + 1023;
	     total_pages = divide (size_mod_1024, 1024, 18, 0);
						/* and shift down */
						/* size of sst & cm in pages */

	     total_top = min (scu_top, initbase);	/* allocate as high as possible on bootload scu */
						/* but below init segs */
	     total_base = total_top - total_pages + 1;	/* base of sst; we want to use pages total_top, total_top -1, ... total_top - (total_pages + 1) */
						/* which is total_pages pages */

	     if total_base < suptop
	     then call syserr (CRASH, "init_sst: insufficient main storage for sst_seg and core map.");
						/* crash the system */

	     memory_address = total_base * 1024;
	     call get_main$given_address (sstp, memory_address, sst_size, sst_sdw);
	     call pmut$swap_sdw (sstp, addr (sst_sdw));	/* and make it addressable */

	     memory_address = (total_base * 1024) + sst_size;
	     call get_main$given_address (cmp, memory_address, cm_size, cm_sdw);
	     call pmut$swap_sdw (cmp, addr (cm_sdw));	/* and make it addressable */
/*	     if debug then call make_unpaged; */
	end;					/* non-early case */

declare  1 CME (0:coresize - 1) aligned like cme based (cmp);

	addr (flagbox$) -> fgbx.sst_sdw = unspec (sst_sdw);	/* tell BOS about sst area */

/* Now we have the SST -- we can fill it in */

	sst.astsize = size (aste);			/* Set the size of an AST entry */
	sst.cmesize = size (cme);			/* And a CM entry */
	sst_absadr = absadr (addr (sst_seg$), (0));
	addr (unpaged_page_tables$) -> upt.sst_absloc, sst.ptwbase = sst_absadr;
	addr (unpaged_page_tables$) -> upt.sst_last_loc = sst_absadr + sst_size - 1;

	do i = 0 to 3;
	     sst.pts (i) = PTS (i);
	     sst.no_aste (i) = bit (sizes (i), 18);
	end;

/* Now set up the core map. All core map entries to an initial "deconfigured" state */

	begin;
declare  BACK_STOP (8) bit (36) aligned based (cmp);
	     BACK_STOP = (36)"1"b;
	end;
	cmp = addrel (cmp, 8);			/* Skip 8 words of -1's that force faults */
						/* when the tnreads are invalid */

	sst.cmp = cmp;				/* sst pointer */

	begin;
declare  1 TEMPLATE_CME aligned like cme;
	     unspec (TEMPLATE_CME) = ""b;
	     TEMPLATE_CME.fp, TEMPLATE_CME.bp = "777777"b3;
	     CME (*) = TEMPLATE_CME;			/* compiler is clever with these */
	end;

/* Now set up pointers, etc., to the AST hash table */

	next_available = addrel (sstp, size (sst));
	sst.ast_ht_ptr = next_available;
	sst.ast_ht_n_buckets = n_buckets;
	sst.ast_ht_uid_mask = uid_mask;
	next_available = addrel (next_available, n_buckets);

	sst.astap, astep = next_available;

/* Set up wait events */

	sst.astl_event = "400000000000"b3;
	sst.temp_w_event = "200000000000"b3;		/* Set up temp wire lock event */

	call init_aste_pools;			/* init all the ASTE's */


/* Now initialize core map entries for all the memory we know about */
/* Put completely unused pages into the free pool, leave the rest */
/* untouched, and also not threaded in */
/* Collect_free_core will set the perm_wired pages to have -1 threads, */
/* and worry about the rest. */

	if ^early_call
	then do i = 0 to 7;				/* go through all memory controllers */
	     base = scs$controller_data (i).base;
	     top = base + scs$controller_config_size (i) - 1;
	     if scs$controller_data (i).online | scs$controller_data (i).offline
	     then begin;				/* update core map and core usage map */
declare  1 THIS_CTRL_CME (0:top - base) aligned like cme defined (CME (base));

		scs$controller_data (i).abs_wired = (base < suptop);
						/* remember if controller is absolute wired */

		THIS_CTRL_CME.contr = bit (bin (i, 3));
	     end;
	end;
	else do i = lbound (scs$controller_data, 1) to hbound (scs$controller_data, 1);	/* go through all memory controllers */
	     base = scs$controller_data (i).base;
	     top = base + 511;			/* only 512k used */
	     if (scs$controller_data (i).online | scs$controller_data (i).offline) & base = 0
	     then begin;				/* we found our bootload controller */
declare  1 THIS_CTRL_CME (0:top - base) aligned like cme defined (CME (base));

		scs$controller_data (i).abs_wired = "1"b;
						/* remember if controller is absolute wired */
						/* So that freecore calls will reflect into abs_usuable */
		THIS_CTRL_CME.contr = bit (bin (i, 3));
	     end;
	end;

	if early_call 
	then do page_no = divide (slt.free_core_start + 1023, 1024, 24, 0)
		to divide (slt.free_core_start + slt.free_core_size - 1, 1024, 24, 0) - 1;
						/* dont free first page of PVT */
	     call freecore (page_no);
	end;
	else do page_no = suptop to total_base - 1, total_top + 1 to initbase - 1;
						/* Skip the SST, low memory, and initsegs */
	     call freecore (page_no);
	end;

	sst.space (*) = -1;				/* BACKSTOP */

/* Set write_limit to reasonable value.  Final setting will be done at end of init_pvt. */
	sst.write_limit = slt.free_core_size / 8192;	/* 1/8th memory */

/* setup for pc$segmove */

	sst.segmove_lock.pid = ""b;
declare  SEGM char (4) init ("segm") int static options (constant);
	sst.segmove_lock.event = unspec (SEGM);
	sst.segmove_lock.notify = "0"b;
	sst.segmove_io_limit = 20;
	sst.segmove_found_synch = 0;
	sst.segmove_synch_disappeared = 0;
	sst.segmove_max_tries = 0;
	sst.segmove_astep, sst.segmove_old_addr_astep, sst.segmove_new_addr_astep = null;
						/* no pc segmove in progress */
	sst.segmove_pvtx, sst.segmove_vtocx = 0;

	sst.seg_state_change_limit = 256;		/* covert channel limits */
	sst.max_seg_state_change_bw = 50;
	sst.audit_seg_state_change_bw = 5;
	return;


/* Procedure to get things both entrypoints want */

init_ptrs:
     procedure;
	sstp = addr (sst_seg$);
	sstnp = addr (sst_names_$);
	sltp = addr (slt$);
	cmp = addr (core_map$);
     end init_ptrs;

/* routine to make sst and core_map unapged for BOS' sake */
/* make_unpaged:
     procedure;
	call sdw_util_$dissect (addr (sst_sdw), addr (sdwi));
	sdwi.paged = "0"b;
	sdwi.address = absadr (sstp, (0));
	call sdw_util_$construct (addr (sst_sdw), addr (sdwi));
	call pmut$swap_sdw (sstp, addr (sst_sdw));

	call sdw_util_$dissect (addr (cm_sdw), addr (sdwi));
	sdwi.paged = "0"b;
	sdwi.address = absadr (cmp, (0));
	call sdw_util_$construct (addr (cm_sdw), addr (sdwi));
	call pmut$swap_sdw (cmp, addr (cm_sdw));
	return;
     end; */

/* format: off */

%page; %include flagbox;
%page; %include null_addresses;
%page; %include scs;
%page; %include config_sst_card;
%include config_parm_card;
%include config_deck;
%page; %include sst;
%page; %include aste;
%page; %include slt;
%page; %include slte;
%page; %include cmp;
%page; %include sdw_info;
%page; %include sstnt;
%page; %include syserr_constants;
%page; %include unpaged_page_tables;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   init_sst: No SST card in config deck. One has been added: SST N N N N

   S:   $beep

   T:   $init

   M:   No SST card was found in the config deck. ASTE pool sizes
   of N N N N have been set as defaults.

   Message:
   init_sst: insufficient storage available for sst_seg and core map.

   S:     $crash

   T:	$init

   M:	Not enough main storage was available to create the sst_seg during
   initialization.  The system tape may be bad, or the configuration
   may be too small, or the system parameters specified in the
   configuration deck may be incorrect or inconsistent with the amount
   of main storage available.

   A:	$recover
   Check the configuration and the CONFIG deck
   $boot_tape

   END MESSAGE DOCUMENTATION */

     end init_sst;




		    init_toehold.pl1                11/11/89  1107.2r w 11/11/89  0816.1      159732



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */

init_toehold: procedure;

/* init_toehold.pl1 -- fills in the static data in toehold.alm and saves the
   bootload Multics image. */

/* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */

/* This program is IOM/IMU dependent. */

/* BIM 11/82 */
/* Modified 8/83 Keith Loepere for absolute mode toehold, saving of "crash" image to disk */
/* Modified 3/84 kpl for saving safe_config_deck */
/* Modified 8/84 Chris Jones for new disk dim. */
/* Modified 10/84 kpl to fix stupid bug in loop limits. */
/* Modified 3/85 Keith Loepere to fix config deck saving now that 
   move_non_perm_wired_segs works. */
/* Modified 4/85 by RAF to support the larger 3380 disk drives */

/****^  HISTORY COMMENTS:
  1) change(85-09-09,Fawcett), approve(85-09-09,MCR6979),
     audit(86-02-13,GDixon), install(86-03-21,MR12.0-1033):
     Support IBM FIPS disk drives.
  2) change(86-03-12,Fawcett), approve(86-04-11,MCR7383),
     audit(86-06-07,GDixon), install(86-07-17,MR12.0-1097):
     Add support for subvolumes, MSU3380 and MSU3390.
  3) change(87-04-14,Farley), approve(87-07-06,MCR7717),
     audit(87-07-13,Lippard), install(87-07-17,MR12.1-1043):
     Changed to make sure toehold.seeks_used was set to the higher of the two
     dcw lists.
                                                   END HISTORY COMMENTS */

dcl  Config_deck_size	        fixed bin init (4) static options (constant);
dcl  Max_pages_in_segment	        fixed bin init (256) static options (constant);
dcl  Pages_per_dcw		        fixed bin init (4) static options (constant);
dcl  Toehold_size		        fixed bin init (2) static options (constant);
dcl  Hardware_low_mem_page_size       fixed bin init (2) static options (constant);
dcl  absadr		        entry (pointer, fixed (35)) returns (fixed bin (26));
dcl  pc$flush		        entry;
dcl  pmut$camp		        entry;
dcl  ptw_util_$make_core	        entry (ptr, fixed bin (26));
dcl  save_handler_mc	        entry (ptr);
dcl  sdw_util_$get_address	        entry (ptr, fixed bin (26));
dcl  syserr		        entry options (variable);
dcl  syserr$error_code	        entry options (variable);
dcl  write_disk$write_disk_no_test    entry (fixed bin, fixed bin (18), ptr, fixed bin (35));

dcl  abs_seg0$		        (0:255) bit (36 * 1024) aligned external;
dcl  config_deck$		        external;
dcl  dseg$		        (0:2047) fixed bin (71) external aligned;
dcl  emergency_shutdown$	        external;
dcl  fault_vector$		        external;
dcl  int_unpaged_page_tables$	        external;
dcl  pvt$root_pvtx		        fixed bin external static;
dcl  safe_config_deck$	        external;
dcl  sys_boot_info$bce_part_frec      fixed bin external static;
dcl  sys_boot_info$config_part_frec   fixed bin external static;
dcl  sys_boot_info$safe_config_deck_frec fixed bin external static;
dcl  toehold_data$		        external static bit (36) aligned;

dcl  abs_seg_pt_abs_addr	        fixed bin (26);
dcl  code			        fixed bin (35);
dcl  disk_channel_number	        fixed bin (7);
dcl  disk_iom_number	        fixed bin (3);
dcl  disk_iom_port_number	        fixed bin (3);
dcl  disk_device_number	        fixed bin (6);
dcl  fault_vector_abs_addr	        fixed bin (26);
dcl  iom_mailbox_abs_addr	        fixed bin (26);
dcl  old_memory_state	        fixed bin;
dcl  records_to_do		        fixed bin (18);
dcl  rpv_devt		        fixed bin;
dcl  running_address	        fixed bin;
dcl  running_seeks		        fixed bin;
dcl  running_record		        fixed bin (18);
dcl  sx			        fixed bin;
dcl  toehold_abs_addr	        fixed bin (18);
dcl  toehold_page_addr	        fixed bin;

dcl  abs_seg_pt		        (0:255) bit (36) aligned based (abs_seg_pt_ptr); /* for abs_seg0 */
dcl  abs_seg_pt_ptr		        ptr;

dcl  1 (seek_idcw_template, data_idcw_template)
			        aligned like idcw;

dcl  (addr, addrel, currentsize, dimension, divide, hbound, lbound, max, min, mod, ptr, segno, unspec) builtin;
%page;
	if sys_boot_info$bce_part_frec = -1
	     then call syserr (CRASH, "init_toehold: No ""bce"" partition on rpv. Rebuild the RPV to add one.");

	toehold_abs_addr = absadr (addr (toehold$), (0));
	toehold_page_addr = divide (toehold_abs_addr, 1024, 17);
	toehold_ptr = addr (toehold$);
	fault_vector_abs_addr = absadr (addr (fault_vector$), (0));
	iom_mailbox_abs_addr = absadr (addr (iom_mailbox$), (0));

	sys_boot_info$safe_config_deck_frec = divide (absadr (addr (safe_config_deck$), (0)), 1024, 16)
	     + sys_boot_info$bce_part_frec + CRASH_HANDLER_RECORDX;
						/* find this before safe_config_deck is moved in memory */

	toehold.memory_state = 0;			/* contents invalid */

	call find_rpv;				/* io paths to rpv */

	toehold.esd_segnum = segno (addr (emergency_shutdown$));

	unspec (seek_idcw_template) = IDCW_INIT_STRING;
	seek_idcw_template.command = seek_command (rpv_devt); /* Seek */
	seek_idcw_template.device = disk_device_number;
	seek_idcw_template.ext_ctl = "0"b;
	seek_idcw_template.control = PROCEED;
	seek_idcw_template.chan_cmd = SINGLE_RECORD;
	unspec (data_idcw_template) = unspec (seek_idcw_template);

/* write command = "31"b3; read command = "25"b3 */

	data_idcw_template.ext_ctl = "1"b;		/* data is anyplace */
	data_idcw_template.control = TERMINATE;

	unspec (toehold.save_dcws) = ""b;
	unspec (toehold.handler_dcws) = ""b;

	dcw_list_ptr = addr (toehold.save_dcws);
	toehold.dcws_per_cyl = divide (rec_per_cyl (rpv_devt) + (Pages_per_dcw - 1), Pages_per_dcw, 17);
	toehold.seeks_used = 1;			/* set here so that the dcw_list_size will be correct */
	toehold.dcw_list_size = currentsize (dcw_list);	/* this is used by toehold */
	running_seeks = 0;
	running_address = Hardware_low_mem_page_size;
	running_record = sys_boot_info$bce_part_frec + SAVED_IMAGE_RECORDX + running_address;
	records_to_do = toehold_page_addr - running_address;

/* don't save, restore iom_mailbox or toehold */

	do while (records_to_do > 0);
	     running_seeks = running_seeks + 1;
	     call process_one_cylinder (running_seeks, addr (toehold.save_dcws));
	end;

	running_address = toehold_page_addr + Toehold_size;
	running_record = sys_boot_info$bce_part_frec + SAVED_IMAGE_RECORDX + running_address;
	records_to_do = Max_pages_in_segment + Max_pages_in_segment - running_address;

	do while (records_to_do > 0);
	     running_seeks = running_seeks + 1;
	     call process_one_cylinder (running_seeks, addr (toehold.save_dcws));
	end;

	toehold.seeks_used = running_seeks;		/* remember seeks used for save_dcws */

/* now list to read in config deck and handler */

	running_seeks = 0;
	running_record = sys_boot_info$config_part_frec;
	running_address = divide (absadr (addr (config_deck$), (0)), 1024, 18);
	records_to_do = Config_deck_size;

	do while (records_to_do > 0);
	     running_seeks = running_seeks + 1;
	     call process_one_cylinder (running_seeks, addr (toehold.handler_dcws));
	end;

	running_address = toehold_page_addr + Toehold_size;
	running_record = sys_boot_info$bce_part_frec + CRASH_HANDLER_RECORDX + running_address;
	records_to_do = Max_pages_in_segment + Max_pages_in_segment - running_address;

	do while (records_to_do > 0);
	     running_seeks = running_seeks + 1;
	     call process_one_cylinder (running_seeks, addr (toehold.handler_dcws));
	end;

	toehold.seeks_used = max (running_seeks, toehold.seeks_used);
						/* remember longest of the two lists */
%page;

/* save fault_vector and iom_mailbox in toehold_data for handler */

	unspec (addrel (addr (toehold_data$), fault_vector_abs_addr) -> fv) =
	     unspec (addr (fault_vector$) -> fv);

	unspec (addrel (addr (toehold_data$), iom_mailbox_abs_addr) -> iom_mailbox_seg) =
	     unspec (addr (iom_mailbox$) -> iom_mailbox_seg);

/* save "crash" handler to disk */

	call pc$flush;
	call sdw_util_$get_address (addr (dseg$ (segno (addr (abs_seg0$)))), abs_seg_pt_abs_addr); /* build segment onto high 256k mem */
	abs_seg_pt_ptr = ptr (addr (int_unpaged_page_tables$), abs_seg_pt_abs_addr - absadr (addr (int_unpaged_page_tables$), (0)));

	do running_address = 0 to Max_pages_in_segment - 1;
	     call ptw_util_$make_core (addr (abs_seg_pt (running_address)), (running_address + Max_pages_in_segment) * 1024);
	end;
	call pmut$camp;

	do running_address = Max_pages_in_segment + Max_pages_in_segment - 1 to Max_pages_in_segment by -1; /* save backwards is faster */
	     running_record = sys_boot_info$bce_part_frec + CRASH_HANDLER_RECORDX + running_address;
	     call write_disk$write_disk_no_test (pvt$root_pvtx, running_record, addr (abs_seg0$ (running_address - Max_pages_in_segment)), code);
	     if code ^= 0 then call syserr$error_code (CRASH, code, "init_toehold: Unable to save bootload Multics image to disk.");
	end;

	do running_address = 0 to Max_pages_in_segment - 1; /* low mem */
	     call ptw_util_$make_core (addr (abs_seg_pt (running_address)), running_address * 1024);
	end;
	call pmut$camp;

	do running_address = Max_pages_in_segment - 1 to toehold_page_addr + Toehold_size by -1; /* don't save toehold (or what's below it) */
	     running_record = sys_boot_info$bce_part_frec + CRASH_HANDLER_RECORDX + running_address;
	     call write_disk$write_disk_no_test (pvt$root_pvtx, running_record, addr (abs_seg0$ (running_address)), code);
	     if code ^= 0 then call syserr$error_code (CRASH, code, "init_toehold: Unable to save bootload Multics image to disk.");
	end;

	call save_handler_mc (addr (toehold$));

/* must be done as soon as possible after disk save */

/* We get here at two different times.  The first case is when init_toehold
was called from real_initializer.  At this time, we simply continue on from
this point with filling in the toehold.  In the second case, we have just
crashed/shut down, and the toehold has restarted bce.  When restarting bce, it
transfers to the last location it knows, which was the last instruction in
save_handler_mc, thus returning us here.  In this case, we must quickly get out
of here and back to real_initializer, who will know what to do (reinitialize
bce).  Thus, this operation is the last thing done here in init_toehold.

This whole thing is done since bce must be restarted with the stack history
basically intact, since from the reinitialized bce we may want to re-boot
Multics, which depends on the normal flow of control, including the sequence
of calls leading up to real_initializer. */

/* toehold will be declared valid (memory_state set) in real_initializer */

	return;
%page;
save_safe_config_deck: entry;

/* Save the safe config deck into the crash handler for future possible 
failure of bce */

	toehold_ptr = addr (toehold$);

	old_memory_state = toehold.memory_state;
	toehold.memory_state = 0;			/* while finding rpv */

	call find_rpv;				/* find new io paths */

	toehold.memory_state = old_memory_state;

	do running_record = sys_boot_info$safe_config_deck_frec + Config_deck_size - 1 to sys_boot_info$safe_config_deck_frec by -1;
	     call write_disk$write_disk_no_test (
		pvt$root_pvtx, running_record,
		addrel (addr (safe_config_deck$), 1024 * (running_record - sys_boot_info$safe_config_deck_frec)), code);
	     if code ^= 0 then call syserr$error_code (BEEP, code, "init_toehold: Unable to save safe_config_deck to disk.");
	end;
	return;
%page;
process_one_cylinder:
     procedure (cx, p_dcw_list_ptr);
dcl  cx			        fixed bin;		/* dcw_list cylinder index */
dcl  p_dcw_list_ptr		        ptr;
dcl  full_tallys		        fixed bin;
dcl  i			        fixed bin;
dcl  records_to_do_here	        fixed bin (18);
dcl  residue		        fixed bin;

	dcw_list_ptr = p_dcw_list_ptr;
	dcw_list (cx).seek_idcw = unspec (seek_idcw_template);
	data_idcw_template.ext = ext_value (running_address);
	dcw_list (cx).data_idcw = unspec (data_idcw_template);
	dcw_list (cx).seek_addresses = sector (running_record);
	dcw_ptr = addr (dcw_list (cx).seek_dcw);
	unspec (dcw) = IOTD_INIT_STRING;
	dcw.address = absadr (addr (dcw_list.seek_addresses (cx)), (0));
	dcw.tally = 1;

/**** First calculate the limit of records we can write into the */
/**** current cylinder. This cannot come out 0 */

	records_to_do_here = min (records_to_do, rec_per_cyl (rpv_devt) - mod (running_record, rec_per_cyl (rpv_devt)));

/**** Then correct for the 256K boundary, which occurs when we go from page */
/**** 255 to page 256. */

	if ext_value (running_address) < 1 & ext_value (running_address + records_to_do_here) ^< 1
	     then records_to_do_here = Max_pages_in_segment - running_address; /* if running_addr is 255 (256'th page), do that 1 record */

/**** Now fill in the dcws */

	if mod (records_to_do_here, Pages_per_dcw) = 0
	then do;
	     full_tallys = divide (records_to_do_here, Pages_per_dcw, 18, 0);
	     residue = 0;
	end;
	else do;
	     full_tallys = divide (records_to_do_here, Pages_per_dcw, 18, 0);
	     residue = mod (records_to_do_here, Pages_per_dcw);
	end;

	do i = 1 to full_tallys;
	     dcw_ptr = addr (dcw_list (cx).data_dcws (i));
	     unspec (dcw) = IOTP_INIT_STRING;
	     dcw.address = mod (running_address, Max_pages_in_segment) * 1024;
	     dcw.tally = 0;				/* 4096 */
	     running_address = running_address + Pages_per_dcw;
	     running_record = running_record + Pages_per_dcw;
	end;
	if residue = 0
	     then dcw.type = IOTD;			/* ptr left at last one */
	else do;
	     dcw_ptr = addr (dcw_list (cx).data_dcws (i));/* i is 1 past */
	     unspec (dcw) = IOTD_INIT_STRING;
	     dcw.address = mod (running_address, Max_pages_in_segment) * 1024;
	     dcw.tally = residue * 1024;
	     running_address = running_address + residue;
	     running_record = running_record + residue;
	end;

	records_to_do = records_to_do - records_to_do_here;

/***** WHEW --- all set up */
     end process_one_cylinder;




/* rpv_devt is a global parameter of this */

sector:
     procedure (Record) returns (fixed bin (35));
dcl  Record		        fixed bin (18);
dcl  devadd		        fixed bin (18);
dcl  record_offset		        fixed bin (18);
	if pvte.is_sv then do;
						/* convert the subvolume devadd to the real devadd */

	     record_offset = mod (Record, pvte.records_per_cyl);
	     devadd = ((Record - record_offset) * pvte.num_of_svs) +
		pvte.record_factor + record_offset;
	end;
	else devadd = Record;
	return ((divide (devadd, rec_per_cyl (rpv_devt), 18, 0) * sect_per_cyl (rpv_devt))
	     + (mod (devadd, rec_per_cyl (rpv_devt)) * sect_per_rec (rpv_devt)));
     end sector;

ext_value:
     procedure (Address) returns (fixed bin);
dcl  Address		        fixed bin;

	return (divide (Address, Max_pages_in_segment, 18, 0));
     end ext_value;
%page;
find_rpv: proc;

/* find out about rpv, in particular, paths to it */

	pvt_arrayp = addr (pvt$array);
	pvtep = addr (pvt_array (pvt$root_pvtx));
	rpv_devt = pvte.device_type;
	disk_device_number = pvte.logical_area_number;

/* find the main channel to this disk. */

	disksp = addr (disk_seg$);
	iom_data_ptr = addr (iom_data$);
	do sx = 1 to disk_data.subsystems while (disk_data.name (sx) ^= pvte.devname);
	end;
	diskp = ptr (disksp, disk_data.offset (sx));

	do toehold.n_paths_used = 1 to min (dimension (toehold.paths, 1), disktab.nchan);
	     cp = addr (ptr (disksp, disktab.channels) -> disk_channel_table (toehold.n_paths_used));
	     disk_iom_number = iom_data.per_device (chantab.chx).iom;
	     disk_channel_number = iom_data.per_device (chantab.chx).channel;

	     do disk_iom_port_number = lbound (scs$port_data, 1) to hbound (scs$port_data, 1)
		while (scs$port_data (disk_iom_port_number).assigned ^= IOM_PORT
		| scs$port_data (disk_iom_port_number).iom_number ^= disk_iom_number);
	     end;

	     toehold.paths (toehold.n_paths_used).port_number = disk_iom_port_number;
	     toehold.paths (toehold.n_paths_used).iom_number = disk_iom_number;
	     toehold.paths (toehold.n_paths_used).channel_number = disk_channel_number;

	     pcw_ptr = addr (toehold.paths (toehold.n_paths_used).pcw);
	     unspec (pcw) = PCW_INIT_STRING;
	     pcw.command = "40"b3;			/* reset status */
	     pcw.device = disk_device_number;
	     pcw.ext = 0;
	end;
	toehold.n_paths_used = toehold.n_paths_used - 1;	/* do went 1 too far */
	return;
     end;
%page; %include dskdcl;
%page; %include fault_vector;
%page; %include fs_dev_types;
%page; %include io_chnl_util_dcls;
%page; %include iom_chan_control_words;
%page; %include iom_data;
%page; %include pvte;
%page; %include scs;
%page; %include syserr_constants;
%page; %include toehold_save_dcls_;
%page;
/* BEGIN MESSAGE DOCUMENTATION

   Message:
   init_toehold: No "bce" partition on rpv. Rebuild the RPV to add one.

   S: $crash

   T: $init

   M:  The partition used to hold the bootload command environment is
   missing from the rpv.  

   A:  A rebuild of the rpv is necessary.

   Message:
   init_toehold: Unable to save bootload Multics image to disk.

   S: $crash

   T: $init

   M: An i/o error prevented the establishment of the bce crash handler.

   Message:
   init_toehold: Unable to save safe_config_deck to disk.

   S: $beep

   T: $init

   M: The safe_config_deck, used to re-establish bce when a failure of bce 
   itself occurs, could not be updated to disk.  A future failure of bce may 
   be catastrophic.

   A: Try performing a reinitialize operation, making sure that the config 
   deck is perfect.

   END MESSAGE DOCUMENTATION */

     end init_toehold;




		    io_config_init.pl1              11/11/89  1107.2r w 11/11/89  0816.1      130212



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */

/****^  HISTORY COMMENTS:
  1) change(85-09-09,Farley), approve(85-09-09,MCR6979),
     audit(86-01-16,CLJones), install(86-03-21,MR12.0-1033):
     Support FIPS, and add
     a controller entry for FIPS devs.
  2) change(86-06-05,GJohnson), approve(86-06-05,MCR7387),
     audit(86-06-10,Martinson), install(86-07-11,MR12.0-1091):
     Correct error message documentation.
                                                   END HISTORY COMMENTS */

/* Initialize io_config_data segment from config deck. */
/* Written March 1984 by Chris Jones. */
/* Modified July 1984 by Paul Farley for FIPS devices */
/* Modified June 1985 by Paul Farley to add a controller entry for FIPS devs */
/* Modified Sept 1985 by Paul Farley to add a channel & device entries for MCAs */

/* format: style4,delnl,insnl,indattr,ifthen,dclind10 */
io_config_init:
     proc;

dcl	chan_idx		   fixed bin;
dcl	dev_idx		   fixed bin;
dcl	iom_idx		   fixed bin;
dcl	mpc_idx		   fixed bin;

dcl	(i, j)		   fixed bin;

dcl	dev_num		   fixed bin;
dcl	dev_num_string	   pic "99";

dcl	config_$find	   entry (char (4) aligned, ptr);
dcl	config_$find_2	   entry (char (4) aligned, char (4) aligned, ptr);
dcl	ioi_config$find_base_channel
			   entry (char (8) aligned) returns (char (8) aligned);
dcl	ioi_config$find_controller_card
			   entry (char (8) aligned) returns (ptr);
dcl	syserr		   entry options (variable);


dcl	(addr, divide, hbound, lbound, max, min, null, ptr, substr, translate, unspec)
			   builtin;

/****
      The data structure is built by passing over the config deck.  First all the IOMs are found and put in the
      tables, then a pass is made over the MPCs, filling in controller entries.
      channel entries.  Then a pass is made over prph and chnl cards, filling in
      device entries and channel entries.
****/

	io_config_data_ptr = addr (io_config_data$);
	io_config_device_table_ptr = ptr (io_config_data_ptr, io_config_data.device_table_offset);
	io_config_channel_table_ptr = ptr (io_config_data_ptr, io_config_data.channel_table_offset);
	io_config_controller_table_ptr = ptr (io_config_data_ptr, io_config_data.controller_table_offset);
	io_config_iom_table_ptr = ptr (io_config_data_ptr, io_config_data.iom_table_offset);
	iom_idx, mpc_idx, chan_idx, dev_idx = 0;

	io_config_data.version = IO_CONFIG_DATA_VERSION_1;
	io_config_data.p_clock = 0;
	iom_table.version = IO_CONFIG_IOM_TABLE_VERSION_1;
	unspec (iom_table.iom_entry) = ""b;
	controller_table.version = IO_CONFIG_CONTROLLER_TABLE_VERSION_1;
	unspec (controller_table.controller_entry) = ""b;
	channel_table.version = IO_CONFIG_CHANNEL_TABLE_VERSION_1;
	unspec (channel_table.channel_entry) = ""b;
	device_table.version = IO_CONFIG_DEVICE_TABLE_VERSION_1;
	unspec (device_table.device_entry) = ""b;

/**** IOM loop ****/

	iom_cardp = null ();
	call config_$find (IOM_CARD_WORD, iom_cardp);
	do iom_idx = lbound (iom_table.iom_entry, 1) to hbound (iom_table.iom_entry, 1) while (iom_cardp ^= null ());
	     iom_table.iom_entry (iom_idx).name = substr ("ABCD", iom_card.tag, 1);
	     iom_table.iom_entry (iom_idx).comment = iom_card.model;
	     iom_table.iom_entry (iom_idx).configured = (iom_card.state = "on");
	     if iom_card.model = "imu" | iom_card.model = "iioc" then do;
						/* Create entries for the MCA */
		call fill_in_next_channel_entry (iom_card.tag, 3);
						/* make a channel entry */
		dev_idx = dev_idx + 1;		/* and a device entry */
		device_table.device_entry (dev_idx).name = "mca" || substr ("abcd", iom_card.tag, 1);
		device_table.device_entry (dev_idx).comment = "mca";
		device_table.device_entry (dev_idx).configured = iom_table.iom_entry (iom_idx).configured;
		device_table.device_entry (dev_idx).pchan_idx (1) = channel_idx_from_numbers (iom_card.tag, 3);
	     end;
	     call config_$find (IOM_CARD_WORD, iom_cardp);
	end;

/**** Controller loop */

	mpc_cardp = null ();
	call config_$find (MPC_CARD_WORD, mpc_cardp);
	do mpc_idx = lbound (controller_table.controller_entry, 1)
	     to hbound (controller_table.controller_entry, 1) while (mpc_cardp ^= null ());
	     controller_table.controller_entry (mpc_idx).name = mpc_card.name;
	     controller_table.controller_entry (mpc_idx).comment = "";
	     call config_$find (MPC_CARD_WORD, mpc_cardp);
	end;


/**** PRPH and CHNL loops ****/

/**** First fill in all the channel_table entries. ****/

	prph_cardp = null ();
	call config_$find (PRPH_CARD_WORD, prph_cardp);
	do while (prph_cardp ^= null ());
	     if (device_type (prph_cardp) = "dsk") | (device_type (prph_cardp) = "tap") then do;
/**** There is an assumption here that dsk and tap cards are identically laid out. ****/
		prph_dsk_cardp, prph_tap_cardp = prph_cardp;
		chnl_cardp = null ();
		call config_$find_2 (CHNL_CARD_WORD, prph_card.name, chnl_cardp);
		do i = 0 to prph_dsk_card.nchan - 1;
		     call fill_in_next_channel_entry (prph_dsk_card.iom, prph_dsk_card.chan + i);
		end;
		if chnl_cardp ^= null () then
		     do i = lbound (chnl_card_array.group, 1) to hbound (chnl_card_array.group, 1);
		     do j = 0 to chnl_card_array.group (i).nchan - 1;
			call fill_in_next_channel_entry (chnl_card_array.group (i).iom,
			     chnl_card_array.group (i).chan + j);
		     end;
		end;
	     end;
	     else call fill_in_next_channel_entry (prph_card.iom, prph_card.chan);
	     call config_$find (PRPH_CARD_WORD, prph_cardp);
	end;

	channel_table.n_channels = chan_idx;		/* get_io_segs may have allocated too many */
	call fill_in_base_channel_indices;

/**** Now the device portion of the loop ****/

	begin;

dcl	configured	   bit (1) aligned;
dcl	template_pchan_array   (lbound (null () -> device_entry_template.pchan_idx, 1):
			   hbound (null () -> device_entry_template.pchan_idx, 1)) fixed bin;
dcl	fips		   bit (1) aligned;
dcl	chanid		   char (8) aligned;
dcl	code		   fixed bin (35);

	     prph_cardp = null ();
	     call config_$find (PRPH_CARD_WORD, prph_cardp);
	     do while (prph_cardp ^= null ());
		call io_chnl_util$iom_to_name (prph_card.iom, (prph_card.chan), chanid, code);
		if code ^= 0 then
		     call syserr (CRASH, "io_config_init: Invalid iom or channel number on prph ^a card.",
			prph_card.name);
		ipc_cardp = ioi_config$find_controller_card (chanid);
		if ipc_cardp ^= null () then		/* There may be IPC cards that are not controllers and there for not fips */
		     fips = (ipc_card.type = IPC_FIPS);
		else fips = "0"b;
		prph_dsk_cardp, prph_tap_cardp = prph_cardp;
		chnl_cardp = null ();
		call config_$find_2 (CHNL_CARD_WORD, prph_card.name, chnl_cardp);

		call fill_in_pchan_array;
		configured = "0"b;
		do i = lbound (template_pchan_array, 1) to hbound (template_pchan_array, 1) while (^configured);
		     if template_pchan_array (i) ^= 0 then
			if channel_table.channel_entry (template_pchan_array (i)).configured then
			     configured = "1"b;
		end;

		if (device_type (prph_cardp) = "dsk") | (device_type (prph_cardp) = "tap") then do;
		     dev_idx = dev_idx + 1;
		     if fips then
			device_table.device_entry (dev_idx).name = prph_dsk_card.name;
		     else device_table.device_entry (dev_idx).name = prph_dsk_card.name || "_00";
		     device_table.device_entry (dev_idx).comment = "controller";
		     device_table.device_entry (dev_idx).pchan_idx (*) = template_pchan_array (*);
		     device_table.device_entry (dev_idx).configured = configured;
		     if fips then
			dev_num = 0;		/* devices start at 0 */
		     else dev_num = 1;		/* devices start at 1 */
		     do i = lbound (prph_dsk_card_array.group, 1) to hbound (prph_dsk_card_array.group, 1);
			if prph_dsk_card_array.group (i).model ^= 0 then
			     do dev_num = dev_num to dev_num + prph_dsk_card_array.group (i).ndrives - 1;
			     dev_idx = dev_idx + 1;
			     dev_num_string = dev_num;
			     device_table.device_entry (dev_idx).name = prph_dsk_card.name || "_" || dev_num_string;
			     device_table.device_entry (dev_idx).comment = "";
			     device_table.device_entry (dev_idx).pchan_idx (*) = template_pchan_array (*);
			     device_table.device_entry (dev_idx).configured = configured;
			end;
			else dev_num = dev_num + prph_dsk_card_array.group (i).ndrives;
		     end;
		end;
		else do;
		     dev_idx = dev_idx + 1;
		     device_table.device_entry (dev_idx).name = prph_card.name;
		     device_table.device_entry (dev_idx).comment = "";
		     device_table.device_entry (dev_idx).pchan_idx (*) = template_pchan_array (*);
		     device_table.device_entry (dev_idx).configured = configured;
		end;
		call config_$find (PRPH_CARD_WORD, prph_cardp);
	     end;

fill_in_pchan_array:
     proc;

dcl	pchan_array_idx	   fixed bin;

	template_pchan_array (*) = 0;
	pchan_array_idx = lbound (template_pchan_array, 1);
	if device_type (prph_cardp) = "tap" | device_type (prph_cardp) = "dsk" then do;
	     do j = 0 to prph_dsk_card.nchan - 1;
		call add_to_pchan_array (channel_idx_from_numbers (prph_dsk_card.iom, prph_dsk_card.chan + j));
	     end;
	     if chnl_cardp ^= null () then
		do i = lbound (chnl_card_array.group, 1) to hbound (chnl_card_array.group, 1);
		do j = 0 to chnl_card_array.group (i).nchan - 1;
		     call add_to_pchan_array (channel_table
			.
			channel_entry (
			channel_idx_from_numbers (chnl_card_array.group (i).iom, chnl_card_array.group (i).chan + j)
			).base_channel_idx);
		end;
	     end;
	end;
	else call add_to_pchan_array (channel_table
		.channel_entry (channel_idx_from_numbers (prph_card.iom, (prph_card.chan))).base_channel_idx);

add_to_pchan_array:
	proc (chan_idx);

dcl	chan_idx		   fixed bin parameter;

dcl	i		   fixed bin;
dcl	pchan_idx		   fixed bin;

	     pchan_idx = channel_table.channel_entry (chan_idx).base_channel_idx;
	     do i = lbound (template_pchan_array, 1) to pchan_array_idx - 1;
		if template_pchan_array (i) = pchan_idx then
		     return;
	     end;
	     template_pchan_array (pchan_array_idx) = pchan_idx;
	     pchan_array_idx = pchan_array_idx + 1;

	end add_to_pchan_array;

     end fill_in_pchan_array;

	end;

fill_in_next_channel_entry:
     proc (iom, chan);

dcl	iom		   fixed bin (3) parameter;
dcl	chan		   fixed bin (8) parameter;

dcl	chanid		   char (8) aligned;
dcl	i		   fixed bin;

	i = channel_idx_from_numbers (iom, (chan));
	if (i >= lbound (channel_table.channel_entry, 1)) & (i <= chan_idx) then
	     return;				/* already in table */

	chan_idx = chan_idx + 1;			/* use next entry */
	call io_chnl_util$iom_to_name (iom, (chan), chanid, (0));
	channel_table.channel_entry (chan_idx).name = chanid;
	channel_table.channel_entry (chan_idx).comment = "";
	channel_table.channel_entry (chan_idx).controller_idx = controller_idx_from_chanid (chanid);
	i = iom_idx_from_chanid (chanid);
	channel_table.channel_entry (chan_idx).iom_idx = i;
	if iom_table.iom_entry (i).configured then do;
	     channel_table.channel_entry (chan_idx).configured = "1"b;
	     iom_table.iom_entry (i).n_configured_channels = iom_table.iom_entry (i).n_configured_channels + 1;
	end;

     end fill_in_next_channel_entry;

fill_in_base_channel_indices:
     proc;

dcl	chan_idx		   fixed bin;
dcl	chanid		   char (8) aligned;

	do chan_idx = lbound (channel_table.channel_entry, 1) to hbound (channel_table.channel_entry, 1);
	     chanid = ioi_config$find_base_channel (channel_table.channel_entry (chan_idx).name);
	     if chanid = "" then
		chanid = channel_table.channel_entry (chan_idx).name;
	     channel_table.channel_entry (chan_idx).base_channel_idx = channel_idx_from_chanid (chanid);
	end;

     end fill_in_base_channel_indices;

iom_idx_from_chanid:
     proc (chanid) returns (fixed bin);

dcl	chanid		   char (8) aligned parameter;

dcl	iom_idx		   fixed bin;

dcl	iom_name		   char (8) aligned;

	iom_name = translate (substr (chanid, 1, 1), "ABCD", "abcd");
	do iom_idx = hbound (iom_table.iom_entry, 1) to lbound (iom_table.iom_entry, 1) by -1
	     while (iom_table.iom_entry (iom_idx).name ^= iom_name);
	end;
	return (iom_idx);

     end iom_idx_from_chanid;

controller_idx_from_chanid:
     proc (chanid) returns (fixed bin);

dcl	chanid		   char (8) aligned;

	mpc_cardp = ioi_config$find_controller_card (chanid);
	if mpc_cardp = null () then
	     return (lbound (controller_table.controller_entry, 1) - 1);

	do mpc_idx = hbound (controller_table.controller_entry, 1) to lbound (controller_table.controller_entry, 1)
	     by -1 while (controller_table.controller_entry (mpc_idx).name ^= mpc_card.name);
	end;
	return (mpc_idx);

     end controller_idx_from_chanid;

channel_idx_from_numbers:
     proc (iom, chan) returns (fixed bin);

dcl	iom		   fixed bin (3);
dcl	chan		   fixed bin (9);

dcl	chanid		   char (8) aligned;

	call io_chnl_util$iom_to_name (iom, (chan), chanid, (0));
	goto channel_idx_common;

channel_idx_from_chanid:
     entry (arg_chanid) returns (fixed bin);

dcl	arg_chanid	   char (8) aligned;

dcl	chan_idx		   fixed bin;

	chanid = arg_chanid;
channel_idx_common:
	do chan_idx = hbound (channel_table.channel_entry, 1) to lbound (channel_table.channel_entry, 1) by -1
	     while (chanid ^= channel_table.channel_entry (chan_idx).name);
	end;
	return (chan_idx);

     end channel_idx_from_numbers;

device_type:
     proc (cardp) returns (char (3));

dcl	cardp		   ptr parameter;

	return (substr (cardp -> prph_card.name, 1, 3));

     end device_type;

/* format: off */
%include config_chnl_card; %page;
%include config_iom_card; %page;
%include config_ipc_card; %page;
%include config_mpc_card; %page;
%include config_prph_card; %page;
%include config_prph_dsk_card; %page;
%include config_prph_tap_card; %page;
%include io_chnl_util_dcls; %page;
%include io_config_data; %page;
%include syserr_constants; %page;

/* BEGIN MESSAGE DOCUMENTATION


    Message:
    io_config_init: Invalid iom or channel number on prph NAME card.

    S:    $crash

    T:	$init

    M:    The iom number or the channel number is invalid on the prph card
    that defines NAME. 

    A:    Fix the config deck.

   END MESSAGE DOCUMENTATION */

/* format: on */

     end io_config_init;




		    ioi_init.pl1                    11/11/89  1107.2r w 11/11/89  0816.1      218538



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1983 *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(85-09-09,Farley), approve(85-09-09,MCR6979),
     audit(86-01-16,CLJones), install(86-03-21,MR12.0-1033):
     Support FIPS and IMU.
                                                   END HISTORY COMMENTS */

/* IOI_INIT - Initialization for the I/O Interfacer. */
/* Rewritten March 1983 by Chris Jones. */
/* Modified January 1984 by Chris Jones for io reconfiguration. */
/* Modified May 1984 by Paul Farley for IPC cards (e.g. FIPS) */
/* Modified April 1984 by Tom Oke for dynamic channel table. */
/* Modified September 1984 by Chris Jones to init device_type for chnl cards */
/* Modified 1984-08-10 BIM for direct channels (sort of) */
/* Modified Nov 1984 by Paul Farley to be able to set the
   gte.detailed_status_cmd to "00"b3 when the IOM is a "imu" or "iioc".. */
/* Modified Jan 1985 by Paul Farley to add MCA (found in IMUs) entries. */
/* Modified Jan 1985 by Paul Farley to change IPC cards to FIPS cards. */
/* Modified June 1985 by Paul Farley to make sure a dte is created for device
   "00" of a FIPS string, when no device "00" is configured. */
/* Modified Sept 1985 by Paul Farley to add setting of a new dte.controller flag. */

/* format: style4,delnl,insnl,indattr,ifthen,dclind10 */
ioi_init:
     procedure;

dcl	adding_controller_dte  bit (1);
dcl	chanid		   char (8) aligned;	/* the converted name of a channel */
dcl	code		   fixed bin (35);		/* error code */
dcl	ctx		   fixed bin;		/* used to index thru ctes */
dcl	device_number	   fixed bin;
dcl	device_type	   char (4);		/* e.g. "dsk", "tap", or "rdr" */
dcl	gtx		   fixed bin;		/* used to index thru gtes */
dcl	itx		   fixed bin;		/* used to index thru ites */
dcl	high_ctx		   fixed bin;		/* index of the highest cte in use */
dcl	high_dtx		   fixed bin;		/* index of the highest dte in use */
dcl	high_gtx		   fixed bin;		/* index of the highest gte in use */
dcl	high_itx		   fixed bin;		/* index of the highest ite in use */
dcl	statusp		   ptr;			/* pointer to where io_manager stores status */
dcl	iom_model_array	   (8) char (4) aligned;	/* array of model numbers by TAG. */


dcl	config_$find	   entry (char (4) aligned, ptr);
dcl	ioi_config$find_base_channel
			   entry (char (8) aligned) returns (char (8) aligned);
dcl	ioi_config$find_controller_card
			   entry (char (8) aligned) returns (ptr);
dcl	ioi_masked$interrupt   entry (fixed bin (35), fixed bin (3), bit (36) aligned);
dcl	ioi_page_table$init	   entry;
dcl	syserr		   entry options (variable);
dcl	syserr$error_code	   entry options (variable);

dcl	ME		   char (32) static options (constant) init ("ioi_init");

dcl	(addr, bin, bit, divide, hbound, lbound, max, min, null, ptr, rel, string, substr, unspec)
			   builtin;

	idp = addr (ioi_data$);			/* get pointer to data base */
	io_config_data_ptr = addr (io_config_data$);
	io_config_iom_table_ptr = ptr (io_config_data_ptr, io_config_data.iom_table_offset);
	io_config_controller_table_ptr = ptr (io_config_data_ptr, io_config_data.controller_table_offset);
	io_config_channel_table_ptr = ptr (io_config_data_ptr, io_config_data.channel_table_offset);
	io_config_device_table_ptr = ptr (io_config_data_ptr, io_config_data.device_table_offset);
	disksp = addr (disk_seg$);

	high_ctx, high_dtx, high_gtx, high_itx = 0;

	iom_model_array (*) = "";
	iom_cardp = null ();
	call config_$find (IOM_CARD_WORD, iom_cardp);	/* start looking for all IOMs */
	do while (iom_cardp ^= null ());
	     high_itx = high_itx + 1;
	     itep = addr (ioi_data.it (high_itx));
	     unspec (ite) = ""b;
	     ite.tag = iom_card.tag;
	     ite.model = iom_card.model;
	     iom_model_array (ite.tag) = iom_card.model;
	     ite.deleted = (iom_card.state = "off");
	     ite.iom_table_idx = iom_table_idx_from_tag (ite.tag);
	     call config_$find (IOM_CARD_WORD, iom_cardp);/* on to the next one */
	end;

	prph_cardp = null ();
	call config_$find (PRPH_CARD_WORD, prph_cardp);	/* start looking for all devices */
	do while (prph_cardp ^= null ());
	     device_type = substr (prph_card.name, 1, 3);
	     prph_dsk_cardp, prph_tap_cardp = prph_cardp; /* base the special structures */
	     call allocate_gte (prph_card.name);	/* set up a group entry */
/**** At this point, all the constant information (that requiring none or little calculation) is set in the gte ****/
	     if (device_type = "dsk") | (device_type = "tap") then
		gte.mplex = "1"b;
	     call io_chnl_util$iom_to_name (prph_card.iom, (prph_card.chan), chanid, code);
	     if code ^= 0 then
		call syserr$error_code (CRASH, code, "^a: Unable to get the name of iom ^d channel ^d.", ME,
		     prph_card.iom, prph_card.chan);
	     gte.ipc = IS_ON_IMU (prph_card.iom);
	     mpc_cardp = ioi_config$find_controller_card (chanid);
	     if mpc_cardp ^= null () then do;		/* found the channel on a controller */
		gte.psia = "1"b;			/* the only interface we currently know */
		ipc_cardp = mpc_cardp;
		gte.fips = (ipc_card.word = IPC_CARD_WORD) & (ipc_card.type = IPC_FIPS);
	     end;
	     gte.detailed_status_cmd = extended_status_command ();
	     gte.ascii_dtst = ascii_detailed_status ();
	     call setup_log_status_info;
	     call allocate_dtes_from_prph_card;
	     call allocate_ctes_from_prph_card;
	     call config_$find (PRPH_CARD_WORD, prph_cardp);
						/* get next card */
	end;

/**** Now pick up all the channels described via chnl cards ****/

	chnl_cardp = null ();
	call config_$find (CHNL_CARD_WORD, chnl_cardp);
	do while (chnl_cardp ^= null ());
	     device_type = substr (chnl_card.name, 1, 3);
	     if find_gte () then
		call allocate_ctes_from_chnl_card;
	     call config_$find (CHNL_CARD_WORD, chnl_cardp);
	end;

/**** Next, find the base logical channel for every channel (we had to wait until they're all allocated). ****/

	do ctx = lbound (ioi_data.ct, 1) to hbound (ioi_data.ct, 1);
	     ctep = addr (ioi_data.ct (ctx));
	     chanid = ioi_config$find_base_channel (cte.chanid);
	     cte.base_ctep = cte_offset (chanid);
	     if cte.base_ctep = ""b then
		cte.base_ctep = rel (ctep);
	end;

/**** Now find all the storage system channels, devices, and groups and mark them as such ****/

	do gtx = lbound (ioi_data.gt, 1) to hbound (ioi_data.gt, 1);
	     gtep = addr (ioi_data.gt (gtx));
	     device_type = substr (gte.name, 1, 3);
	     if device_type = "dsk" then		/* found one */
		call setup_disk_sharing;
	end;

/**** Now assign all non-storage system channels which are multiplexed. ****/

	do gtx = lbound (ioi_data.gt, 1) to hbound (ioi_data.gt, 1);
	     gtep = addr (ioi_data.gt (gtx));
	     if gte.mplex & (gte.disk_data_subsystem_idx = 0) then do;
		do ctep = ptr (idp, gte.ctep) repeat ptr (idp, cte.next_ctep) while (rel (ctep));
		     if ^cte.deleted then do;
			call io_manager$assign (cte.chx, cte.chanid, ioi_masked$interrupt, bin (rel (ctep)),
			     statusp, code);
			if code ^= 0 then
			     call syserr$error_code (CRASH, code, "^a: Unable to assign channel ^a.", ME,
				cte.chanid);
			cte.statusp = statusp;
			cte.ioi_use = "1"b;
		     end;
		end;
	     end;
	end;

/**** Now create entries for all configured MCAs (in the IMUs). ****/

	do itx = lbound (ioi_data.it, 1) to hbound (ioi_data.it, 1);
	     itep = addr (ioi_data.it (itx));
	     if ite.model = "imu" | ite.model = "iioc" then do;
		call allocate_gte ("mca" || substr ("abcd", ite.tag, 1));
		gte.psia = "1"b;			/* works like psia */
		gte.n_devices = 1;
		call allocate_ctes (ite.tag, 3, 1);
		device_number = 1;
		adding_controller_dte = "0"b;
		call allocate_next_dte;
	     end;
	end;

/**** Set up the I/O page tables. ****/

	call ioi_page_table$init;

/* Set up the reset status IDCW */

	idcwp = addr (ioi_data.rss_idcw);
	string (idcw) = ""b;
	idcw.command = "40"b3;			/* reset status command */
	idcw.code = "7"b3;				/* identify this as an IDCW */
	idcw.chan_cmd = "02"b3;			/* non-data transfer type command */
	idcw.count = "01"b3;			/* only do this once at a time */

	ioi_data.setup = "1"b;			/* OK for polling to run now. */
	return;
%page;

/* Routine to allocate a group table entry.  It checks for the existence for the gte first, and complains
   if it already exists.  If not, it allocates one and fills in the easy stuff, returning with gtep
   pointing to the relevant gte. */

allocate_gte:
     proc (prph_name);


dcl	current_gtx	   fixed bin;
dcl	prph_name		   char (4) aligned;

	do current_gtx = 1 to high_gtx;
	     gtep = addr (ioi_data.gt (current_gtx));
	     if gte.name = prph_name then
		call syserr (CRASH, "^a: Duplicate ""prph ^a"" card found.", ME, gte.name);
	end;
	high_gtx = high_gtx + 1;
	gtep = addr (ioi_data.gt (high_gtx));
	gte.lock = ""b;				/* not locked */
	gte.name = prph_name;			/* get name from prph card */
	gte.dtep, gte.ctep = ""b;			/* no devices or channels yet */
	string (gte.flags) = ""b;			/* default all flags to off */
	gte.n_devices = 0;
	gte.pending_connects = 0;			/* no work to do yet */
	gte.disk_data_subsystem_idx = 0;		/* not necessarily a disk subsystem */

     end allocate_gte;

/* Routine to find an already allocated gte (it uses the name from a chnl card, which are processed after all
   prph cards).  Crashes if the gte not found.  In case we want to to something different, it pretends to carry on. */

find_gte:
     proc () returns (bit (1) aligned);

dcl	current_gtx	   fixed bin;

	do current_gtx = 1 to ioi_data.ngt;
	     gtep = addr (ioi_data.gt (current_gtx));
	     if chnl_card.name = gte.name then
		return ("1"b);			/* found it */
	end;
	call syserr (CRASH, "^a: No matching ""prph ^a"" found for ""chnl ^a"".", ME, chnl_card.name, chnl_card.name);
	return ("0"b);

     end find_gte;

/* Routine to return the extended status command to use for a given device type, if it knows it. */

extended_status_command:
     proc () returns (bit (6));

	if gte.fips then
	     return ("00"b3);
	else if device_type = "dsk" then
	     return ("22"b3);
	else if device_type = "tap" then
	     return ("50"b3);
	else if (device_type = "prt") | (device_type = "rdr") | (device_type = "pun") | (device_type = "ccu") then
	     return ("03"b3);
	else return ("00"b3);

     end extended_status_command;

/* Routine to return true if the device in question returns its extended status with the channel in ASCII
   mode.  If so, we re-pack it at interrupt side to resemble normal IOM channels.  Currently, EURCs
   are the only controllers which behave this way. */

ascii_detailed_status:
     proc () returns (bit (1) aligned);

dcl	i		   fixed bin;

	if mpc_cardp ^= null () then
	     if substr (mpc_card.name, 1, 3) = "urp" then /* a unit record mpc */
		do i = 1 to hbound (eurc_model_numbers, 1);
		if mpc_card.model = eurc_model_numbers (i) then
		     return ("1"b);
	     end;
	return ("0"b);

     end ascii_detailed_status;

/* Routine to setup the index to the log_status_info structure.  There is one of these per device type,
   telling whether or not a particular status is to be logged in the syserr log.  If, for some reason,
   there is no structure for this device type, the index is left at 0 and the interrupt side uses
   a heuristic to decide whether or not to log. */

setup_log_status_info:
     proc;

dcl	log_status_info_idx	   fixed bin;

	io_log_infop = addr (io_log_status_info$io_log_status_info);
	do log_status_info_idx = 1 to io_log_info.ndev;
	     logp = addr (io_log_info.log_entry (log_status_info_idx));
	     if log.dev_name = device_type then do;
		gte.io_log_info_index = log_status_info_idx;
		return;
	     end;
	end;
	gte.io_log_info_index = 0;

     end setup_log_status_info;

/* Routine which allocates the device table entries given a prph card and an already setup gte. */

allocate_dtes_from_prph_card:
     proc;

dcl	group_idx		   fixed bin;

	adding_controller_dte = "0"b;
	if gte.fips then
	     device_number = 0;			/* devices start at zero */
	else device_number = 1;			/* devices start at 1, controller at 0 */
	if (device_type = "tap") | (device_type = "dsk") then do;
						/* NOTE THE ASSUMPTION THAT THE CARDS LOOK ALIKE */
	     do group_idx = lbound (prph_tap_card_array.group, 1) to hbound (prph_tap_card_array.group, 1);
		if prph_tap_card_array.group (group_idx).model ^= 0 then do;
		     do device_number = device_number
			to device_number + prph_tap_card_array.group (group_idx).ndrives - 1;
			call allocate_next_dte;
		     end;
		end;
		else device_number = device_number + prph_tap_card_array.group (group_idx).ndrives;
	     end;
	     adding_controller_dte = "1"b;
	     device_number = 0;			/* make one for the controller */
	     call allocate_next_dte;
	end;
	else call allocate_next_dte;
	return;

     end allocate_dtes_from_prph_card;

allocate_next_dte:
     proc;

dcl	device_name	   char (32);
dcl	device_number_string   pic "99";

	if gte.mplex & ^(gte.fips & adding_controller_dte) then do;
	     device_number_string = device_number;
	     device_name = gte.name || "_" || device_number_string;
	end;
	else device_name = gte.name;
	high_dtx = high_dtx + 1;
	dtep = addr (ioi_data.dt (high_dtx));
/**** now fill in all of the info ****/
	unspec (dte) = ""b;				/* wipe it clean */
	if gte.dtep = ""b then do;			/* if this is the first device we've seen in this group */
	     gte.dtep = rel (dtep);			/* nowhere else it could point */
	     dte.next_dtep = rel (dtep);		/* circular list */
	end;
	else do;					/* link it into the circular list */
	     dte.next_dtep = ptr (dtep, gte.dtep) -> dte.next_dtep;
						/* thread it into the linked list */
	     ptr (dtep, gte.dtep) -> dte.next_dtep = rel (dtep);
	     gte.dtep = rel (dtep);			/* this is the new head */
	end;
	dte.gtep = rel (gtep);			/* remember our group */
	dte.channel_required = "";			/* no channel requirement by default */
	dte.workspace_ptr = null ();
	dte.workspace_astep = null ();
	dte.ptp = null ();
	dte.in_use = "1"b;				/* assume it's available for IOI */
	dte.device = bit (bin (device_number, 6), 6);	/* remember which device we are */
	dte.lock.event = unspec (IOI_DEVICE_LOCK_EVENT_TEMPLATE) || rel (dtep);
						/* set event for locking and unlocking */
	dte.device_table_idx = device_table_idx_from_name (device_name);
	if dte.device_table_idx = 0 then
	     call syserr (CRASH, "^a: Couldn't find device_table_idx for device ""^a"".", ME, device_name);

	dte.deleted = ^device_table.device_entry (dte.device_table_idx).configured;
	if device_type = "fnp" | device_type = "dia" then
	     dte.direct = "1"b;
	dte.controller = adding_controller_dte;

/**** Check for duplicate devices ****/
	do dtep = ptr (idp, dte.next_dtep) repeat ptr (idp, dte.next_dtep) while (rel (dtep) ^= gte.dtep);
	     if bit (bin (device_number, 6), 6) = dte.device & ^adding_controller_dte then
		call syserr (CRASH, "^a: Multiple definitions of device ^a found.", ME, device_name);
	end;

     end allocate_next_dte;

/* Routine to allocate the channel table entries described on a prph card */

allocate_ctes_from_prph_card:
     proc;

	if device_type = "tap" | device_type = "dsk" then /* NOTE THAT WE ASSUME THE CARDS ARE THE SAME FORMAT */
	     call allocate_ctes (prph_dsk_card.iom, prph_dsk_card.chan, prph_dsk_card.nchan);
	else call allocate_ctes (prph_card.iom, prph_card.chan, 1);

     end allocate_ctes_from_prph_card;

/* Routine to allocate the channel table entries described on a chnl card */

allocate_ctes_from_chnl_card:
     proc;

dcl	group_idx		   fixed bin;

	do group_idx = lbound (chnl_card_array.group, 1) to hbound (chnl_card_array.group, 1);
	     call allocate_ctes (chnl_card_array.group (group_idx).iom, chnl_card_array.group (group_idx).chan,
		chnl_card_array.group (group_idx).nchan);
	end;

     end allocate_ctes_from_chnl_card;

/* Routine which allocates the ctes.  gtep must be pointing at the group table entry for these channels. */

allocate_ctes:
     proc (iomno, channo, nchans);

dcl	channo		   fixed bin (8) parameter;
dcl	iomno		   fixed bin (3) parameter;
dcl	nchans		   fixed bin parameter;

dcl	ch_idx		   fixed bin;
dcl	iterp		   bit (18);
dcl	itx		   fixed bin;
dcl	this_channel	   fixed bin (7);

/**** Find the ite for this IOM. ****/

	do itx = 1 to high_itx while (ioi_data.it (itx).tag ^= iomno);
	end;
	if itx > high_itx then do;
	     call syserr (CRASH, "^a:  No iom card found for the ^a subsystem.", ME, gte.name);
	     iterp = ""b;				/* really won't help, but... */
	end;
	else iterp = rel (addr (ioi_data.it (itx)));

/**** We loop through the channels in descending order.  This is so the channels will end up
      on the queue in ascending order (we push them on one at a time).  This is necessary so
      that we will use the base channel of a physical channel first.  We must do THAT to
      ensure that it is unmasked when there is a possibility of a special interrupt happening. ****/

	do ch_idx = nchans - 1 to 0 by -1;
	     high_ctx = high_ctx + 1;			/* use next cte */
	     ctep = addr (ioi_data.ct (high_ctx));
	     unspec (cte) = ""b;			/* scrub it before using */
	     cte.next_ctep = gte.ctep;		/* link this cte onto the gte's list */
	     cte.itep = iterp;
	     gte.ctep = rel (ctep);
	     cte.gtep = rel (gtep);			/* remember our group */
	     this_channel = channo + ch_idx;
	     call io_chnl_util$iom_to_name (iomno, this_channel, cte.chanid, code);
	     if code ^= 0 then
		call syserr$error_code (CRASH, code, "^a: Unable to get the name of IOM ^d channel ^d.", ME, iomno,
		     this_channel);
	     cte.channel_table_idx = channel_table_idx_from_name (cte.chanid);
	     cte.deleted = ^channel_table.channel_entry (cte.channel_table_idx).configured;
	     cte.direct = (device_type = "fnp") | (device_type = "dia");

/**** Check for duplicate channels ****/
	     do ctep = ptr (idp, cte.next_ctep) repeat ptr (idp, cte.next_ctep) while (rel (ctep));
		if cte.chanid = ptr (idp, gte.ctep) -> cte.chanid then
		     call syserr (CRASH, "^a: Multiple definitions of channel ^a found for subsystem ^a.", ME,
			cte.chanid, gte.name);
	     end;
	end;

     end allocate_ctes;

cte_offset:
     proc (chanid) returns (bit (18));

dcl	chanid		   char (8) aligned parameter;

dcl	ctx		   fixed bin;

	do ctx = lbound (ioi_data.ct, 1) to hbound (ioi_data.ct, 1);
	     if (addr (ioi_data.ct (ctx)) -> cte.chanid) = chanid then
		return (rel (addr (ioi_data.ct (ctx))));
	end;
	return (""b);

     end cte_offset;

iom_table_idx_from_tag:
     proc (tag) returns (fixed bin);

dcl	tag		   fixed bin (3) parameter;

dcl	name		   char (1);
dcl	i		   fixed bin;

	name = substr ("ABCD", tag, 1);
	do i = lbound (iom_table.iom_entry, 1) to hbound (iom_table.iom_entry, 1);
	     if iom_table.iom_entry (i).name = name then
		return (i);
	end;
	return (lbound (iom_table.iom_entry, 1) - 1);

     end iom_table_idx_from_tag;

device_table_idx_from_name:
     proc (name) returns (fixed bin);

dcl	name		   char (*) parameter;

dcl	i		   fixed bin;

	do i = lbound (device_table.device_entry, 1) to hbound (device_table.device_entry, 1);
	     if device_table.device_entry (i).name = name then
		return (i);
	end;
	return (lbound (device_table.device_entry, 1) - 1);

     end device_table_idx_from_name;

channel_table_idx_from_name:
     proc (name) returns (fixed bin);

dcl	name		   char (8) aligned parameter;

dcl	i		   fixed bin;

	do i = lbound (channel_table.channel_entry, 1) to hbound (channel_table.channel_entry, 1);
	     if channel_table.channel_entry (i).name = name then
		return (i);
	end;
	return (lbound (channel_table.channel_entry, 1) - 1);

     end channel_table_idx_from_name;

/* Routine which returns TRUE if the PRPH is on an IMU */

IS_ON_IMU:
     proc (iomno) returns (bit (1));

dcl	iomno		   fixed bin (3) parameter;
dcl	itx		   fixed bin;

/**** Find the ite for this IOM. ****/

	do itx = 1 to high_itx while (ioi_data.it (itx).tag ^= iomno);
	end;
	if itx > high_itx then
	     return ("0"b);
	if ioi_data.it (itx).model = "imu" | ioi_data.it (itx).model = "iioc" then
	     return ("1"b);
	else return ("0"b);
     end IS_ON_IMU;

/* Routine which initializes the disk databases in ioi_data.  It assumes that disk_seg is already setup, and
   that disk_control has assigned to itself all channels for all disks.  It sets up so that later we can usurp
   any channels we need for udsk activity. gtep is assumed to be pointing to the gte for the disk subsystem */

setup_disk_sharing:
     proc;

dcl	ctx		   fixed bin;

	call find_disktab;				/* locate the disktab for this subsystem */
	mpc_cardp = null ();
	do ctx = lbound (null () -> disk_channel_table, 1) + disktab.nchan - 1
	     to lbound (null () -> disk_channel_table, 1) by -1;
						/* iterate in order of increasing priority */
	     cp = addr (ptr (diskp, disktab.channels) -> disk_channel_table (ctx));
	     if chantab.chanid ^= "" then do;		/* if the channel is known to disk_control */
		call find_matching_cte;		/* get ctep pointing to the right place */
		cte.statusp = chantab.statusp;	/* copy this info */
		cte.chx = chantab.chx;
		cte.disktab_ctx = ctx;		/* so we can find this later */
		chantab.ioi_ctx = bin (rel (ctep));	/* so disk_control can find us later */
		if mpc_cardp = null () then
		     mpc_cardp = ioi_config$find_controller_card (cte.chanid);
		else if mpc_cardp ^= ioi_config$find_controller_card (cte.chanid) then
		     gte.dual_controller = "1"b;
	     end;
	end;

find_disktab:
	proc;

dcl	dtx		   fixed bin;

	     do dtx = lbound (disk_data.array, 1) to hbound (disk_data.array, 1);
		if disk_data.array (dtx).name = gte.name then do;
		     gte.disk_data_subsystem_idx = dtx; /* so we can find this entry later */
		     diskp = ptr (disksp, disk_data.array (dtx).offset);
		     return;
		end;
	     end;
	     call syserr (CRASH, "^a: No entry for ^a found in disk_data.", ME, gte.name);

	end find_disktab;

find_matching_cte:
	proc;

	     do ctep = ptr (idp, gte.ctep) repeat ptr (idp, cte.next_ctep) while (rel (ctep));
		if cte.chanid = chantab.chanid then
		     return;
	     end;
	     call syserr (CRASH, "^a: No cte found for channel ^a.", ME, chantab.chanid);

	end find_matching_cte;

     end setup_disk_sharing;

%include ioi_data;
%page;
%include io_config_data;
%page;
%include config_iom_card;
%page;
%include config_mpc_card;
%page;
%include config_ipc_card;
%page;
%include config_prph_card;
%page;
%include config_prph_tap_card;
%page;
%include config_prph_dsk_card;
%page;
%include config_chnl_card;
%page;
%include dskdcl;
%page;
%include io_chnl_util_dcls;
%page;
%include io_manager_dcls;
%page;
%include io_log_status_info;
%page;
%include iom_pcw;
%page;
%include eurc_model_numbers;
%page;
%include syserr_constants;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   ioi_init: ERROR_CODE  Unable to get the name of name of iom IOMNO channel CHANNO.

   S:	$crash

   T:	$init

   M:	An attempt to generate the name of logical channel CHANNO of iom
   IOMNO failed.

   A:	$config


   Message:
   ioi_init: ERROR_CODE  Unable to assign channel CHANID.

   S:	$crash

   T:	$init

   M:	A logical channel could not be assigned to IOI.
   $err

   A:	$contact


   Message:
   ioi_init: Duplicate "prph NAME" card found.

   S:	$crash

   T:	$init

   M:	$msg

   A:	$config


   Message:
   ioi_init: No matching "prph NAME" found for "chnl NAME".

   S:	$crash

   T:	$init

   M:	$msg

   A:	$config


   Message:
   ioi_init: Multiple definitions of device NAME found.

   S:	$crash

   T:	$init

   M:	$msg

   A:	$config


   Message:
   ioi_init: Multiple definitions of channel CHANID found for subsystem NAME.

   S:	$crash

   T:	$init

   M:	$msg

   A:	$config


   Message:
   ioi_init: No entry for NAME found in disk_data.

   S:	$crash

   T:	$init

   M:	$err

   A:	$contact


   Message:
   ioi_init: No cte found for channel CHANID.

   S:	$crash

   T:	$init

   M:	$err

   A:	$contact


   END MESSAGE DOCUMENTATION */

     end ioi_init;




		    iom_data_init.pl1               11/11/89  1107.2rew 11/11/89  0816.1       92367



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */

/* iom_data_init - a system initialization routine to set up
   the data bases used by the iom_manager.
   First written in August 1971 by R F Mabee.
   Converted for followon hardware July 27, 1972 by R. F. Mabee
   Last modified 02/24/77 by Noel I. Morris
   Modified for paged IOM by C. Hornig November 1980.
   More paged IOM by C. Hornig, March 1982.
   Modified for channel reconfiguration by Chris Jones, January 1984.
   Modified to remove support for non-paged-mode IOMs by Chris Jones, August 1984
   Modified to init system fault channel of unconfigured IOMs by M. Pandolf, November 1984
   Modified to init iom_data$imw_lock and iom_data$n_intr_procs by M. Pandolf, January 1985
*/


/****^  HISTORY COMMENTS:
  1) change(86-01-06,Fawcett), approve(86-04-11,MCR7351),
     audit(86-06-07,GDixon), install(86-07-17,MR12.0-1097):
     Change iom_card model from "nsa" to "iom".
                                                   END HISTORY COMMENTS */


/* format: style4,delnl,insnl,indattr,ifthen,dclind10 */
iom_data_init:
     procedure;

dcl	i		   fixed bin;
dcl	errcode		   fixed bin (35);
dcl	iom_no		   fixed bin (3);
dcl	iom_name		   char (1) aligned;
dcl	found_iom		   bit (1) aligned;

dcl	absadr		   entry (ptr, fixed bin (35)) returns (fixed bin (26));
dcl	config$find	   entry (char (4) aligned, ptr);
dcl	iom_overhead$init	   entry (fixed bin (3), fixed bin (35));
dcl	iom_overhead$init_without_assign
			   entry (fixed bin (3), fixed bin (35));
dcl	syserr		   entry options (variable);

dcl	1 cow		   based aligned,
	  2 unused	   bit (33) unaligned,
	  2 port		   uns fixed bin (3) unaligned;

dcl	iom_int_mask	   (4) bit (72) aligned static options (constant)
			   init ("088800000888800000"b4, "044400000444400000"b4, "022200000222200000"b4,
			   "011100000111100000"b4);

dcl	(addr, binary, bit, hbound, lbound, null, substr, unspec)
			   builtin;

	iom_data_ptr = addr (iom_data$);		/* Get pointer to iom_data segment. */
	iom_mailbox_seg_ptr = addr (iom_mailbox$);	/* Get pointer to iom_mailbox segment. */

/* Set up some constant items. */

	unspec (iom_mailbox_seg) = ""b;

	idcwp = addr (iom_data.stop_dcw);		/* Make DCW to stop any channel. */
	idcw.code = "111"b;				/* Make it an instruction DCW. */
	idcw.chan_cmd = "000010"b;			/* Non-data transfer. */

	lpwp = addr (iom_data.stop_lpw);		/* LPW to use iom_data.stop_dcw. */
	lpw.dcw_addr = abs_addr_18 (addr (iom_data.stop_dcw));
	lpw.nc = "1"b;				/* Keep reusing same DCW. */

	scwp = addr (iom_data.stop_scw);		/* SCW to use iom_data.stop_status */
	scw.address = abs_addr_18 (addr (iom_data.stop_status));

	iom_data.imw_lock = 1;			/* init to OK-to-process-interrupts */
	iom_data.n_intr_procs = 0;			/* no one in interrupt handler yet */

	do i = 1 to iom_data.n_devices;		/* initialize per_device */
	     scwp = addr (iom_data.per_device (i).scw);	/* SCW's */
	     scw.address = abs_addr_18 (addr (iom_data.per_device (i).status));
	end;

	do iom_no = lbound (iom_data.per_iom, 1) to hbound (iom_data.per_iom, 1);
	     lpwp = addr (iom_data.per_iom (iom_no).connect_lpw);
	     lpwp -> lpw.dcw_addr =
		abs_addr_18 (addr (iom_mailbox_seg.iom_mailbox (iom_no).channel_mailbox (connect_channel).scw));
	     lpwp -> lpw.tal = "1"b;			/* Allow tally update and tally runout recognition. */
	     lpwp -> lpw.tally = "0001"b3;		/* Each connect will start a single channel. */

/* Initialize each channel_table and mailbox entry. */

	     do i = lbound (iom_mailbox_seg.iom_mailbox.channel_mailbox, 2)
		to hbound (iom_mailbox_seg.iom_mailbox.channel_mailbox, 2);
		iom_mailbox_seg.iom_mailbox (iom_no).channel_mailbox (i).lpw = iom_data.stop_lpw;
		iom_mailbox_seg.iom_mailbox (iom_no).channel_mailbox (i).scw = iom_data.stop_scw;
	     end;
	     call iom_overhead$init_without_assign (iom_no, errcode);
	end;

/* Now loop through the IOM config cards. */

	found_iom = "0"b;
	iom_cardp = null ();

config_loop:
	call config$find (IOM_CARD_WORD, iom_cardp);
	if iom_cardp = null () then do;		/* done at last */
	     if ^found_iom then
		call syserr (CRASH, "iom_data_init: No valid IOM cards found.");
	     return;
	end;

/* Validate CONFIG IOM card */

	if (iom_card.tag < lbound (iom_data.per_iom, 1)) | (iom_card.tag > hbound (iom_data.per_iom, 1)) then do;
	     call syserr (CRASH, "iom_data_init: Bad IOM tag ^d. IOM card ignored.", iom_card.tag);
	     goto config_loop;
	end;

	iom_no = iom_card.tag;
	iom_name = substr ("ABCD", iom_no);

	if iom_data.per_iom (iom_no).flags.configured then do;
	     call syserr (CRASH, "iom_data_init: Duplicate IOM ^a in config deck.", iom_name);
	     goto config_loop;
	end;

	if (iom_card.port < 0) | (iom_card.port > 7) then do;
	     call syserr (CRASH, "iom_data_init: Illegal port number ^d for IOM ^a.", iom_card.port, iom_name);
	     goto config_loop;
	end;

	if scs$port_data (iom_card.port).assigned > 0 then do;
	     call syserr (CRASH, "iom_data_init: IOM ^a reuses port ^d.", iom_name, iom_card.port);
	     goto config_loop;
	end;
	if iom_card.model = "nsa" then do;
	     call syserr (ANNOUNCE, "iom_data_init:", "IOM model of ""nsa"" for IOM ^a will be changed to ""iom"".",
		iom_card.tag);
	     iom_card.model = "iom";
	end;
	if (iom_card.model ^= "iom") & (iom_card.model ^= "iioc") & (iom_card.model ^= "imu") then do;
	     call syserr (CRASH, "iom_data_init: Bad model ""^a"" for IOM ^a. IOM card ignored.", iom_card.model,
		iom_name);
	     goto config_loop;
	end;

	if (iom_card.state ^= "on") & (iom_card.state ^= "off") then do;
	     call syserr (CRASH, "iom_data_init: Bad state ""^a"" for IOM ^a. IOM card ignored.", iom_card.state,
		iom_name);
	     goto config_loop;
	end;

	found_iom = "1"b;
	iom_data.per_iom (iom_no).flags.configured = "1"b;
	iom_data.per_iom (iom_no).flags.on_line = (iom_card.state = "on");
	iom_data.per_iom (iom_no).model = iom_card.model;
	addr (iom_data.per_iom (iom_no).cow) -> cow.port, iom_data.per_iom (iom_no).port = iom_card.port;

	scs$port_data (iom_card.port).assigned = IOM_PORT;
	scs$port_data (iom_card.port).iom_number = iom_no;

/* enable the IOM ports and interrupt cells */

/* Do something to open up the port */

	scs$open_level = scs$open_level | iom_int_mask (iom_no);

/* Set up the handler and mailbox for the system fault channel. */

	if iom_data.per_iom (iom_no).on_line then do;
	     call iom_overhead$init (iom_no, errcode);
	     if errcode ^= 0 then
		call syserr (CRASH, "iom_data_init: Unable to assign overhead channel for IOM ^d.", iom_no);
	end;
	go to config_loop;


/* * * * * * * * * * ABS_ADDR_18 * * * * * * * * * */

abs_addr_18:
     procedure (P) returns (bit (18) aligned);
dcl	P		   ptr parameter;
dcl	address		   fixed bin (26);
dcl	ec		   fixed bin (35);

	address = absadr (P, ec);
	if ec ^= 0 then
	     call syserr (CRASH, "iom_data_init: Error from absadr.");
	if address > (262144 - 4096) then
	     call syserr (CRASH, "iom_data_init: Data not in low 256K.");
	return (bit (binary (address, 18)));
     end abs_addr_18;

%include config_iom_card;
%page;
%include iom_data;
%page;
%include iom_dcw;
%include iom_lpw;
%include iom_pcw;
%include iom_scw;
%page;
%include io_manager_dcls;
%page;
%include scs;
%page;
%include syserr_constants;

/*	BEGIN MESSAGE DOCUMENTATION

   Message:
   iom_data_init: No valid IOM cards found.

   S: $crash

   T: $init

   M: There were no valid IOM cards in the configuration deck.

   A: Correct configuration deck and reboot.


   Message:
   iom_data_init: Bad IOM tag TAG. IOM card ignored.

   S: $crash

   T: $init

   M: An IOM card contained an IOM tag other than A, B, C, or D.

   A: Correct configuration deck and reboot.


   Message:
   iom_data_init: Illegal port number PORT for IOM TAG.

   S: $crash

   T: $init

   M: The IOM card for IOM TAG contained an illegal port number.
   The port number must be between 0 and 7.

   A: Correct configuration deck and reboot.


   Message:
   iom_data_init: IOM TAG reuses port PORT.

   S: $crash

   T: $init

   M: IOM TAG has been given the same port as some other active module (CPU or IOM).

   A: Correct configuration deck and reboot.


   Message:
   iom_data_init: Bad model MODEL for IOM TAG.  IOM card ignored.

   S: $crash

   T: $init

   M: The model field for IOM TAG was not recognized.

   A: Correct configuration deck and reboot.


   Message:
   iom_data_init: Bad state STATE for IOM TAG.  IOM card ignored.

   S: $crash

   T: $init

   M: The state for IOM TAG was neither "on" or "off".

   A: Correct configuration deck and reboot.


   Message:
   IOM model of "nsa" for IOM TAG will be changed to "iom".

   S: $announce

   T: $init

   M: The model field of this IOM card should be "iom".  The system will
      correct it for this boot.

   A: Correct configuration deck before next boot.


   Message:
   iom_data_init: Error from absadr.

   S: $crash

   T: $init

   M: $err

   A: $contact


   Message:
   iom_data_init: Data not in low 256K.

   S: $crash

   T: $init

   M: The IOM data bases are not located in the low 256K of memory.
   $err

   A: Correct configuration deck and reboot.


   Message:
   iom_data_init: Duplicate IOM TAG in config deck.

   S: $crash

   T: $init

   M: Two IOM cards specifying IOM tag TAG were found
   in the configuration deck.

   A: Correct configuration deck and reboot.


   Message:
   iom_data_init: Unable to assign overhead channel for IOM TAG.

   S: $crash

   T: $init

   M: Could not set up overhead channel handlers for IOM TAG.
   $err

   A: $contact


   END MESSAGE DOCUMENTATION */

     end iom_data_init;




		    load_disk_mpcs.pl1              11/11/89  1107.2rew 11/11/89  0816.1       47385



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */

/* format: style4,indattr,ifthenstmt,ifthen,idind35,^indcomtxt */

load_disk_mpcs: proc;

/* get firmware into (non-bootload) disk mpcs
Keith Loepere, March 1984 */
/* Modified 10/84 by Allen Ball to check all channels before deciding an mpc is
dead.  Also to handle -chnl option of bce_fwload. */
/* Modified 11/84 by Keith Loepere to understand controllers with all deleted channels. */


/****^  HISTORY COMMENTS:
  1) change(86-04-22,Farley), approve(86-07-18,MCR7439),
     audit(86-08-18,Fawcett), install(86-10-20,MR12.0-1189):
     Changed to initialize all possible ss_info.flags.
                                                   END HISTORY COMMENTS */


dcl  addr				builtin;
dcl  bce_command_processor_		entry (char (*), entry (ptr, char (*), fixed bin (35)) returns (entry), ptr, fixed bin (35));
dcl  bce_fwload			entry (ptr);
dcl  bce_query			entry options (variable);
dcl  code				fixed bin (35);
dcl  config_$find			entry (char (4) aligned, ptr);
dcl  dimension			builtin;
dcl  divide			builtin;
dcl  error_table_$io_not_configured	fixed bin (35) ext;
dcl  hc_load_mpc$test_controller	entry (char (8) aligned, fixed bin (35));
dcl  io_chnl_util$iom_to_name		entry (fixed bin (3), fixed bin (7), char (8) aligned, fixed bin (35));
dcl  ioa_				entry () options (variable);
dcl  max				builtin;
dcl  me				char (14) init ("load_disk_mpcs") static options (constant);
dcl  mpc_chanid			char (8) aligned;
dcl  mpc_names			char (128) var;
dcl  1 my_ss_info			aligned like ss_info;
dcl  line				char (80);
dcl  null				builtin;
dcl  rtrim			builtin;
dcl  string			builtin;
dcl  substr			builtin;
dcl  syserr			entry options (variable);
%page;
	ss_info_ptr = addr (my_ss_info);
	ss_info.request_table_ptr = null;
	ss_info.abort_label = RE_ASK;
	ss_info.name = me;
	ss_info.arg_list_ptr = null;
	ss_info.info_ptr = null;
	string (ss_info.flags) = ""b;
	ss_info.flags.forbid_semicolons = "1"b;

RE_CHECK:
	call check_mpcs;
	if mpc_names = "" then return;

RE_ASK:
	call bce_query (line, "Enter disk mpc names to be loaded,
or ""none"" or ""abort"" or ""all"": ");

	if line = "none" then return;
	else if line = "abort" then call syserr (CRASH, "load_disk_mpcs: Operator aborted disk MPC loading.");
	else if line = "all" then line = "load " || mpc_names; /* command of all names */
	else line = "load " || rtrim (line);		/* make it a command */
	call bce_command_processor_ (line, command_finder, ss_info_ptr, code);
	if code ^= 0 then do;
	     if code ^= 100 then call ioa_ ("Bad syntax in line.");
	     go to RE_ASK;
	end;

	go to RE_CHECK;
%page;
command_finder: proc (Info_ptr, command, code) returns (entry);

dcl  Info_ptr			pointer;
dcl  command			char (*);
dcl  code				fixed bin (35);

	code = 0;
	return (bce_fwload);
     end;
%page;
check_mpcs: proc;

dcl  all_channels_deleted		bit (1);
dcl  mpc_card_array_index		fixed bin;
dcl  running			bit (1);

/* Generate list of names of dead mpcs. */

	mpc_names = "";
	mpc_cardp = null;
	call config_$find (MPC_CARD_WORD, mpc_cardp);
	do while (mpc_cardp ^= null);
	     if substr (mpc_card.name, 1, 3) = "msp" then do;
		running = "0"b;
		all_channels_deleted = "1"b;		/* if all channels get io_not_configured then mpc is not connected anyway */
		do mpc_card_array_index = 1 to dimension (mpc_card_array.port, 1) while (^running);
		     call io_chnl_util$iom_to_name ((mpc_card_array.port.iom (mpc_card_array_index)), (mpc_card_array.port.chan (mpc_card_array_index)), mpc_chanid, code);
		     if code = 0 then do;
			call hc_load_mpc$test_controller (mpc_chanid, code);
			if code = 0 then running = "1"b;
			if code ^= error_table_$io_not_configured then all_channels_deleted = "0"b;
		     end;
		end;
		if ^all_channels_deleted then
		     if ^running then mpc_names = mpc_names || mpc_card.name || " "; /* add to list needing firmware */
	     end;
	     call config_$find (MPC_CARD_WORD, mpc_cardp);
	end;
	if mpc_names ^= "" then call syserr (ANNOUNCE, "load_disk_mpcs: Disk mpc(s): ^a
appear not to be operating.", mpc_names);
	return;
     end;
%page; %include bce_subsystem_info_;
%page; %include config_mpc_card;
%page; %include syserr_constants;
%page;
/* BEGIN MESSAGE DOCUMENTATION

   Message:
   load_disk_mpcs: Disk mpc(s): NAMES
   appear not to be operating.

   S: $announce

   T: $init

   M: The named disk mpcs, listed in the config deck, did not respond to
   a "request status" control order.  They are believed not to be operating; 
   in particular, firmware should probably be loaded into them.

   Message:
   load_disk_mpcs: Operator aborted disk MPC loading.

   S: $crash

   T: $init

   M: The operator answered "abort" when requested to supply disk mpcs to be
   loaded.  This will cause a return to the previous bce command level.

   END MESSAGE DOCUMENTATION */

     end;




		    load_mst.pl1                    11/11/89  1107.2r w 11/11/89  0816.1      215568



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-06-05,GJohnson), approve(86-06-05,MCR7387),
     audit(86-06-10,Martinson), install(86-07-11,MR12.0-1091):
     Correct error message documentation.
                                                   END HISTORY COMMENTS */


load_mst: proc;

/* format: style4,indattr,ifthenstmt,ifthen,idind35,^indcomtxt */

/* This program reads in collection 1.2 and takes the segments called
foo.ascii and puts them into the bootload file system.  Collection 1.5 is
read in and built into the address space.  Collections 2.0 and
3.0 are then read into the mst area of the bce partition for warm boots. */

/* Initially code by Keith Loepere April Fools Day 1983.  (That was a Friday).
Modified by Keith Loepere, October 1983 for collection 2 and 3 reading to disk.
Modified by Keith Loepere, July 1984 to set sentinel in bkpt_page.
Modified by Keith Loepere, January 1985, for allow permanent collection 1.5 segs. */

dcl  addr				builtin;
dcl  addrel			builtin;
dcl  ai_linkage$			external static;
dcl  as_linkage$			external static;	/* combined linkage segments */
dcl  baseptr			builtin;
dcl  bce_abs_seg$add		entry (fixed bin (15));
dcl  1 bce_command_seg_info		aligned static,	/* description of bce commands on disk 
	- a call to init_commands threads these into the address space */
       2 pre_linked			bit (1) aligned,	/* else must pre-link at init_commands time */
       2 number			fixed bin init (0),
       2 entries			(100),
         3 segnum			fixed bin (15),
         3 starting_record		fixed bin (18),	/* on disk */
         3 length			fixed bin,	/* in pages */
         3 permanent		bit (1) aligned;	/* copy into perm seg */
dcl  bin				builtin;
dcl  bit				builtin;
dcl  bootload_fs_$flush_sys		entry;
dcl  bootload_fs_$put_ptr		entry (char (*), fixed bin (21), bit (1) aligned, ptr, fixed bin (35));
dcl  code				fixed bin (35);
dcl  1 control_word			aligned based,	/* MST control word */
     ( 2 type			fixed bin (17),	/* control word type */
       2 count			fixed bin (18) uns
       )				unaligned;	/* count of words following */
dcl  copy				bit (9437184 /* 256 * 1024 * 36 */) aligned based; /* used to make copy of coll 1.5 seg into perm one */
dcl  copying_sdw			fixed bin (71);	/* sdw to make copy with - has rw access */
dcl  definitions_$			ext;		/* definitions segment */
dcl  dimension			builtin;
dcl  disk_mst_seg$			bit (9437184 /* 256 * 1024 * 36 */) aligned ext; /* used to map onto mst area of disk */
dcl  disk_mst_seg_sdw		fixed bin (71);	/* sdw for disk_mst_seg */
dcl  divide			builtin;
dcl  expect_defs			bit (1) aligned;	/* definitions expected switch */
dcl  expect_link			bit (1) aligned;	/* linkage section expected switch */
dcl  header_area			(1000) fixed bin (35); /* area into which segment header is read */
dcl  header_ptr			ptr;		/* pointer to header area */
dcl  index			builtin;
dcl  last_sltep			ptr;		/* pointer to previous slt entry */
dcl  length			builtin;
dcl  link_ptr			ptr;		/* pointer to linkage section */
dcl  load_control_word		entry (fixed bin, fixed bin (18)) variable; /* entry variable to get a control word from mst, possibly saving it in mst disk area */
dcl  load_header			entry (ptr, fixed bin (18)) variable; /* entry variable to read a segment header from the mst, possibly saving it to mst disk area */
dcl  load_segment			entry (ptr, fixed bin (18)) variable; /* entry variable to read a segment from the mst saving it where appropriate */
dcl  1 lot$			ext like lot;	/* linkage offset table */
dcl  make_sdw			entry (fixed bin (15), fixed bin (71), ptr, ptr);
dcl  make_sdw$no_pages		entry (fixed bin (15), fixed bin (71), ptr, ptr);
dcl  map_onto_disk			entry (fixed bin, fixed bin (18), fixed bin, ptr, bit (1) aligned);
dcl  mod				builtin;
dcl  next_partition_word		fixed bin (26);	/* next word in mst area to receive mst tape word */
dcl  null				builtin;
dcl  page_table			(0:255) bit (36) aligned based (ptp); /* for disk_mst_seg */
dcl  partition_left			fixed bin (26);	/* words left in mst disk area */
dcl  pc$cleanup			entry (ptr);
dcl  pc_wired$write			entry (ptr, fixed bin, fixed bin);
dcl  perm_seg_astep			ptr;
dcl  perm_seg_ptp			ptr;
dcl  perm_seg_sdw			fixed bin (71);	/* used for permanent copy made of coll 1.5 segs */
dcl  pmut$camp			entry;
dcl  pmut$swap_sdw			entry (ptr, ptr);
dcl  pre_link_hc			entry;
dcl  ptp				ptr;		/* ptr to page table for disk_mst_seg */
dcl  ptw_num			fixed bin;	/* loop var on page table creations */
dcl  ptw_util_$make_disk		entry (ptr, fixed bin (20));
dcl  ptw_util_$make_null_disk		entry (ptr, fixed bin (20));
dcl  pvt$root_pvtx			fixed bin ext;
dcl  rtrim			builtin;
dcl  sdw_util_$set_access		entry (ptr, bit (4) unal);
dcl  seg_number			fixed bin (15);	/* segment number of segment being loaded */
dcl  seg_ptr			ptr;		/* pointer to segment being loaded */
dcl  segno			builtin;
dcl  size				builtin;
dcl  slot_num			fixed bin;	/* in bce_command_seg_info */
dcl  slt$				external static;
dcl  slt_manager$build_entry		entry (ptr) returns (ptr);
dcl  start_partition_record		fixed bin (20);	/* first mst record that disk_mst_seg maps onto */
dcl  substr			builtin;
dcl  sys_boot_info$bce_part_frec	fixed bin (20) ext;
dcl  sys_boot_info$bce_part_nrec	fixed bin (20) ext;
dcl  sys_boot_info$mst_past_bce_frec	fixed bin (20) ext;
dcl  syserr			entry options (variable);
dcl  syserr$error_code		entry options (variable);
dcl  tape_reader			entry (ptr, fixed bin (18));
dcl  text_no			fixed bin (15);	/* text segment number */
dcl  text_ptr			ptr;		/* pointer to text segment */
dcl  wi_linkage$			external static;
dcl  wordno			builtin;
dcl  ws_linkage$			external static;
%page;
/* Start by reading collection 1.2 into the file partition. */

	load_control_word = read_control_word;
	load_header = tape_reader;
	load_segment = load_file_segment;
	call load_collection;			/* collection 1.2! */
	call bootload_fs_$flush_sys;			/* force out file sys */

	next_partition_word = 0;
	start_partition_record = 0;
	partition_left = (sys_boot_info$bce_part_nrec - MST_AREA_RECORDX) * 1024;
	call make_sdw$no_pages (segno (addr (disk_mst_seg$)), disk_mst_seg_sdw, astep, ptp);
	aste.pvtx = pvt$root_pvtx;
	call pmut$swap_sdw (addr (disk_mst_seg$), addr (disk_mst_seg_sdw));

/* Load in bce commands (collection 1.5).  They are activated later (init_commands). */

	bce_command_seg_info.number = 0;
	bce_command_seg_info.pre_linked = "0"b;

	expect_defs = "0"b;				/* Initialize the control switches */
	expect_link = "0"b;

	sltp = addr (slt$);				/* Get a pointer to SLT structure. */
	lotp = addr (lot$);				/* Get a pointer to the LOT. */
	definitions_ptr = addr (definitions_$);

	load_control_word = read_control_word;
	load_header = tape_reader;
	load_segment = load_command_seg;
	call load_collection;
	sys_boot_info$mst_past_bce_frec = sys_boot_info$bce_part_frec + MST_AREA_RECORDX + start_partition_record;

/* Now read in collections 2.0 and 3.0 to disk. */

	aste.csl, aste.msl = "0"b;
	load_control_word = save_control_word;
	load_header = save_header;
	load_segment = load_mst_segment;
	call load_collection;			/* collection 2.0 */
	call load_collection;			/* collection 3.0 */
	call pc$cleanup (astep);			/* force write pages left */

	call syserr (ANNOUNCE, "load_mst: ^d. out of ^d. pages used in disk mst area.",
	     divide (next_partition_word + 1023, 1024, 20), sys_boot_info$bce_part_nrec - MST_AREA_RECORDX);

	disk_mst_seg_sdw = 0;			/* cleanup */
	call pmut$swap_sdw (addr (disk_mst_seg$), addr (disk_mst_seg_sdw));
	return;
%page;
init_commands: entry;

/* Build astes for bce command segs.  Pre-link them if necessary. */

	do slot_num = 1 to bce_command_seg_info.number;
	     call map_onto_disk (pvt$root_pvtx, bce_command_seg_info.starting_record (slot_num), bce_command_seg_info.length (slot_num), baseptr (bce_command_seg_info.segnum (slot_num)), "1"b);
	     call bce_abs_seg$add (bce_command_seg_info.segnum (slot_num));
	end;
	if ^bce_command_seg_info.pre_linked then do;
	     call pre_link_hc;
	     bce_command_seg_info.pre_linked = "1"b;
	end;
	return;
%page;
make_permanent: entry;

/* Build permanent astes for permanent collection 1.5 segs.  Copy the disk
version into permanent segment. */

	sltp = addr (slt$);
	call make_sdw$no_pages (segno (addr (disk_mst_seg$)), disk_mst_seg_sdw, astep, ptp);
	aste.pvtx = pvt$root_pvtx;
	call pmut$swap_sdw (addr (disk_mst_seg$), addr (disk_mst_seg_sdw));

	do slot_num = 1 to bce_command_seg_info.number;
	     if bce_command_seg_info.permanent (slot_num) then do;
		do ptw_num = 0 to bce_command_seg_info.length (slot_num) - 1; /* establish disk area */
		     call ptw_util_$make_disk (addr (page_table (ptw_num)), bce_command_seg_info.starting_record (slot_num) + ptw_num);
		end;
		aste.csl, aste.msl = bit (bin (bce_command_seg_info.length (slot_num), 9), 9);
		call pmut$camp;

/* copy this seg into perm seg */

		seg_number = bce_command_seg_info.segnum (slot_num);
		sltep = addr (slt.seg (seg_number));
		slte.abs_seg = "0"b;		/* We don't manage disk anymore */
		call make_sdw (seg_number, perm_seg_sdw, perm_seg_astep, perm_seg_ptp);
		copying_sdw = perm_seg_sdw;
		call sdw_util_$set_access (addr (copying_sdw), "1010"b); /* force rw onto copy */

		seg_ptr = baseptr (seg_number);
		call pmut$swap_sdw (seg_ptr, addr (copying_sdw));

		substr (seg_ptr -> copy, 1, 36 * 1024 * bce_command_seg_info.length (slot_num)) =
		     substr (disk_mst_seg$, 1, 36 * 1024 * bce_command_seg_info.length (slot_num));

		call pmut$swap_sdw (seg_ptr, addr (perm_seg_sdw)); /* set real sdw */
		call pc_wired$write (perm_seg_astep, 0, -1); /* Flush to disk */
		call pc$cleanup (astep);		/* cleanup disk_mst_seg */
	     end;
	end;

	disk_mst_seg_sdw = 0;			/* cleanup */
	call pmut$swap_sdw (addr (disk_mst_seg$), addr (disk_mst_seg_sdw));
	return;
%page;
load_collection: proc;

/* Routine, given the entry variables load_control_word, load_header and
load_segment, which reads from the mst and puts the entities into their
proper places. */

dcl  count			fixed bin (18);	/* length of record on MST */
dcl  type				fixed bin;	/* type of record on MST */

	header_ptr = addr (header_area);		/* Generate pointer to header area. */

/* Read control word and dispatch on it. */

	call load_control_word (type, count);		/* Read a control word. */
	do while (type ^= 2);
	     if type ^= 0 then call syserr (CRASH, "load_mst: unknown control type ^d", type);

/* Process header record. */

	     if count > size (header_area) then		/* Error if header is too large ... */
		call syserr (CRASH, "load_mst: bad header size ^d", count);
						/* ... or too small. */

	     call load_header (header_ptr, count);	/* Read in the header. */

	     call load_control_word (type, count);	/* Read in next control word. */
	     if type ^= 1 then			/* It must be a segment control word. */
		call syserr (CRASH, "load_mst: unexpected control type ^d", type);

	     call load_segment (header_ptr, count);	/* Load in the segment. */
	     call load_control_word (type, count);	/* next thing */
	end;

/* Process collection record. */

	call load_control_word (type, count);		/* Read the collection mark. */
	return;
     end;
%page;
load_command_seg: proc (header_ptr, count);

/* Read in a collection 1.5 object.  Place it on disk or thread linkage areas
accordingly.  Build the table bce_command_seg_info. The equivalent of 
segment_loader from collection 2.0. */

dcl  count			fixed bin (18) parameter; /* length of record on MST */
dcl  header_ptr			ptr parameter;	/* to mst seg info */

	if header_ptr -> slte.link_sect then do;
	     if ^expect_link then call syserr (CRASH, "load_mst: Unexpected linkage.");
	     expect_link = "0"b;			/* Turn off switch. */
	     expect_defs = "1"b;			/* Defs should come next. */

	     if last_sltep -> slte.combine_link then do;
		if last_sltep -> slte.link_sect_wired then
		     if last_sltep -> slte.init_seg then hclsp = addr (wi_linkage$);
		     else hclsp = addr (ws_linkage$);
		else if last_sltep -> slte.init_seg then hclsp = addr (ai_linkage$);
		else hclsp = addr (as_linkage$);
		seg_ptr = hclsp -> hc_linkage_seg.next_free_ptr; /* Get pointer to end of combined linkage. */
		hclsp -> hc_linkage_seg.next_free_ptr = addrel (seg_ptr, count + mod (count, 2)); /* Update pointer to next free even loc. */

		call tape_reader (seg_ptr, count);	/* Read in the linkage section into place. */
	     end;

	     else call load_bce_segment;

	     link_ptr = seg_ptr;			/* Save pointer to linkage. */
	     lot.lp (text_no) = link_ptr;		/* Set LOT entry. */
	     link_ptr -> linkage_header.segment_number = text_no;
						/* Save text segment number in linkage header. */
	end;

	else if header_ptr -> slte.defs then do;
	     if ^expect_defs then call syserr (CRASH, "load_mst: Unexpected defs.");
	     expect_defs = "0"b;

	     seg_ptr = definitions.next_free_ptr;	/* Get pointer to end of definitions. */
	     definitions.next_free_ptr = addrel (seg_ptr, count); /* Update pointer to next free. */

	     call tape_reader (seg_ptr, count);		/* Read definitions into place. */

	     definitions.dot (text_no).offset = wordno (seg_ptr);
	     definitions.dot (text_no).length = count;	/* Fill in offset table entry. */

	     link_ptr -> linkage_header.def_ptr = seg_ptr;/* Set correct defs pointer. */
	end;

	else do;					/* Must be text, or something. */
	     if expect_link | expect_defs then call syserr (CRASH, "load_mst: Missing linkage or defs.");
	     expect_link = header_ptr -> slte.link_provided; /* Set switch. */

	     call load_bce_segment;			/* Load in the segment. */
	     text_ptr = seg_ptr;			/* Save pointer to the text. */
	     text_no = segno (text_ptr);		/* Also, get text segment number. */
	end;

	last_sltep = sltep;				/* Save pointer to last SLT entry. */

	return;
%page;
load_bce_segment: proc;

/* Load a segment into the next set of pages in mst area on disk. */

dcl  seg_len			fixed bin;

	     seg_ptr = slt_manager$build_entry (header_ptr); /* Build new entry in SLT. */
	     if seg_ptr = null () then call syserr (CRASH, "load_mst: error from slt_manager$build_entry");

	     seg_number = segno (seg_ptr);		/* Get segment number of new segment. */

	     sltep = addr (slt.seg (seg_number));
	     slte.abs_seg = "1"b;			/* We manage disk. */
	     seg_len, slte_uns.max_length = slte_uns.cur_length;
	     if substr (slte.access, 2, 1) then do;	/* e access => breakpoinatble */
		slte.breakpointable = "1"b;
		slte_uns.cur_length, slte_uns.max_length, seg_len = seg_len + 1;
	     end;

	     bce_command_seg_info.number = bce_command_seg_info.number + 1;
	     if bce_command_seg_info.number > dimension (bce_command_seg_info.entries, 1) then call syserr (CRASH, "load_mst: too many bce command segments.");
	     if seg_len * 1024 > partition_left then call syserr (CRASH, "load_mst: Out of space in mst area of bce partition.");

	     bce_command_seg_info.segnum (bce_command_seg_info.number) = seg_number;
	     bce_command_seg_info.starting_record (bce_command_seg_info.number) = sys_boot_info$bce_part_frec + MST_AREA_RECORDX + start_partition_record;
	     bce_command_seg_info.length (bce_command_seg_info.number) = seg_len;
	     bce_command_seg_info.permanent (bce_command_seg_info.number) = ^slte.temp_seg;

	     do ptw_num = 0 to seg_len - 1;		/* establish disk area */
		call ptw_util_$make_null_disk (addr (page_table (ptw_num)), sys_boot_info$bce_part_frec + MST_AREA_RECORDX + start_partition_record + ptw_num);
	     end;
	     aste.csl, aste.msl = bit (bin (seg_len, 9), 9);
	     call pmut$camp;
	     start_partition_record = start_partition_record + seg_len;
	     next_partition_word = next_partition_word + seg_len * 1024;
	     partition_left = partition_left - seg_len * 1024;

	     call tape_reader (addr (disk_mst_seg$), count); /* Slurp in the new segment. */

	     if slte.breakpointable then		/* place sentinel to avoid nulling of bkpt_page */
		addrel (addr (disk_mst_seg$), (seg_len - 1) * 1024) -> bkpt_page.sentinel = BKPT_page_sentinel;

	     call pc$cleanup (astep);			/* Flush to disk */
	     return;
	end;
     end;
%page;
load_file_segment: proc (header_ptr, count);

/* entry to load a segment from the mst into a slot in the bce file system. */

dcl  count			fixed bin (18);	/* number of words to read */
dcl  file_length			fixed bin (21);	/* file lth in chars */
dcl  file_name			char (32);	/* after stripping optional suffix */
dcl  file_name_lth			fixed bin;	/* length of file_name trimmed */
dcl  header_ptr			ptr;		/* to slte/nameseg entry pair */

	sltep = header_ptr;
	namep = addrel (sltep, size (slte));
	file_name_lth = length (rtrim (segnam.names (1).name)); /* trim optional ".ascii" suffix */
	if index (segnam.names (1).name, ".ascii") = file_name_lth - length (".ascii") + 1 then file_name_lth = file_name_lth - length (".ascii");
	file_name = substr (segnam.names (1).name, 1, file_name_lth);
	file_length = divide (slte_uns.bit_count, 9, 21); /* determine char lth */
	if divide (file_length + 3, 4, 18) < count then file_length = count * 4; /* num words used by bc less than words on tape - bc lied */
	seg_ptr = null;
	call bootload_fs_$put_ptr (file_name, file_length, "0"b, seg_ptr, code); /* find ptr to room in file space */
	if seg_ptr = null then call syserr$error_code (ANNOUNCE, code, "load_mst: ^a can't be placed into file partition.", segnam.names (1).name);
	call tape_reader (seg_ptr, count);		/* read into allocated space */
	return;
     end;
%page;
load_mst_segment: proc (header_ptr, count);

/* read segment from mst appending onto mst area */

dcl  count			fixed bin (18);	/* words to read */
dcl  header_ptr			ptr;		/* to slte/name_seg entry pair */
dcl  segment_ptr			ptr;		/* dummy returned ptr to seg read */

	call read_and_save (segment_ptr, count);
	return;
     end;
%page;
read_and_save: proc (saved_ptr, count);

/* Read a count number of words from the tape.  Append it to what is in the 
partition.  Return a pointer to these words (paged area). The idea is to build 
a paged segment onto the set of pages within which the segment will be loaded.
A pointer to the actual area is returned. */

dcl  count			fixed bin (18);	/* number of words to read and save */
dcl  last_partition_record		fixed bin (20);	/* record holding last word of where newly read in words would go */
dcl  last_partition_word		fixed bin (26);	/* last word used in partition by this new read block */
dcl  saved_ptr			ptr;		/* return ptr to words read */

	if partition_left < count then call syserr (CRASH, "load_mst: Out of space in mst area of bce partition.");

	last_partition_word = next_partition_word + count - 1;
	last_partition_record = divide (last_partition_word, 1024, 20);
	if last_partition_record - start_partition_record > 255 then do;

/* We can't grow our abs seg to hold this new unit.
Flush the old to disk and re-map the abs seg. */

	     call pc$cleanup (astep);
	     start_partition_record = divide (next_partition_word, 1024, 20);
	     call ptw_util_$make_disk (addr (page_table (0)), sys_boot_info$bce_part_frec + MST_AREA_RECORDX + start_partition_record); /* keep old page */
	     aste.csl, aste.msl = "000000001"b;
	end;

/* grow abs seg to encompass new words */

	do ptw_num = bin (aste.csl, 9) to last_partition_record - start_partition_record;
	     call ptw_util_$make_null_disk (addr (page_table (ptw_num)), sys_boot_info$bce_part_frec + MST_AREA_RECORDX + start_partition_record + ptw_num);
	end;
	aste.csl, aste.msl = bit (bin (last_partition_record - start_partition_record + 1, 9), 9);
	call pmut$camp;

	saved_ptr = addrel (addr (disk_mst_seg$), next_partition_word - start_partition_record * 1024);
	call tape_reader (saved_ptr, count);		/* read into mst area */
	partition_left = partition_left - count;	/* gobble space */
	next_partition_word = last_partition_word + 1;
	return;
     end;
%page;
read_control_word: proc (type, count);

/* read a control word from the mst */

dcl  count			fixed bin (18);	/* count of following record */
dcl  1 my_control_word		aligned like control_word;
dcl  type				fixed bin;	/* control word type */

	call tape_reader (addr (my_control_word), 1);
	type = my_control_word.type;
	count = my_control_word.count;
	return;
     end;
%page;
save_control_word: proc (type, count);

/* read a control word from the mst and save in mst area */

dcl  count			fixed bin (18);	/* count field */
dcl  type				fixed bin;	/* type field */
dcl  word_ptr			ptr;		/* ptr to word read and saved */

	call read_and_save (word_ptr, 1);
	type = word_ptr -> control_word.type;
	count = word_ptr -> control_word.count;
	return;
     end;
%page;
save_header: proc (header_ptr, count);

/* read in and save a segment header from the mst */

dcl  count			fixed bin (18);	/* count of words to read */
dcl  header_ptr			ptr;		/* ptr to area in which to read */
dcl  header_read			(count) bit (36) aligned based; /* what read */
dcl  read_ptr			ptr;		/* ptr to area saved in mst area */

	call read_and_save (read_ptr, count);
	header_ptr -> header_read = read_ptr -> header_read;
	return;
     end;
%page; %include aste;
%page; %include bce_breakpoint_page;
%page; %include bce_partition_layout;
%page; %include hc_definitions_seg;
%page; %include hc_linkage_seg;
%page; %include lot;
%page; %include mc;
%page; %include object_link_dcls;
%page; %include slt;
%page; %include slte;
%page; %include syserr_constants;
%page;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   load_mst: Out of space in mst area of bce partition.

   S: $crash

   T: $init

   M: There is not enough room in the mst area of the bce partition to
   hold collections 2.0 and 3.0.

   A: The size of this area will need to be increased.
   $boot_tape

   Message:
   load_mst: NAME can't be placed into file partition.

   S: $crash

   T: $init

   M: An error occurred while adding the named file from the mst into the
   bootload Multics file system.

   A: $recover
   $boot_tape

   Message:
   load_mst: unexpected control type TTT

   S: $crash

   T: $init

   M: A segment control word was found out of sequence on the bootload tape.

   A: $recover
   $boot_tape

   Message:
   load_mst: bad header size SSS

   S: $crash

   T: $init

   M: A bad segment header was found on the bootload tape.

   A: $recover
   $boot_tape

   Message:
   load_mst: unknown control type TTT

   S: $crash

   T: $init

   M: A bad segment control word was found on the bootload tape.

   A: $recover
   $boot_tape

   Message:
   load_mst: XXX. out of WWW. pages used in disk mst area.

   S: $info

   M: This message shows the amount of the mst area of the bce partition that 
   is used to hold the mst.

   A: $ignore
   $boot_tape

   Message:
   load_mst: Unexpected DEFS/LINKAGE

   S: $crash

   T: $init

   M: A linkage or definitions section was found out of sequence in the mst source.

   A: $recover
   $boot_tape

   Message:
   load_mst: Missing linkage or defs.

   S: $crash

   T: $init

   M: A linkage or definitions section which should be in the
   mst source appears to be missing.

   A: $recover
   $boot_tape

   Message:
   load_mst: error from slt_manager$build_entry

   S: $crash

   T: $init

   M: $err

   A: $recover
   $boot_tape

   Message:
   load_mst: too many bce command segments.

   S: $crash

   T: $init

   M: An exceptionally large number of segments appeared in collection 1.5.
   This probably indicates an error in the mst.

   A: $recover
   $boot_tape

   END MESSAGE DOCUMENTATION */

     end;




		    make_segs_paged.pl1             11/11/89  1107.2r w 11/11/89  0816.1      122886



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


/* format: style2 */

make_segs_paged:
     proc;


/* 	last modified (date, by whom and reason):

    1/85 by Keith Loepere to recognize segments already paged.
   12/83 by Keith Loepere for breakpoint page support 
   9/83 by Keith Loepere to tolerate paged, wired segments
   7/82 BIM -- use stack_frame patch to remove need for special
   pmut swap/copy entry; rationalize names, slte_uns, flush gtpd.
   6/21/82 by E. N. Kittlitz to move core map.
   12/21/80 by W. Olin Sibert, to move setting of sst.write_limit into
      init_pvt, move high water mark announcement into (new) announce_chwm,
      and move call to collect_free_core into init_collection_1.
    8/24/79 by J. A. Bush to set the max length of the sstnt in the slte
      based on the number of aste entries
    2/19/79 by D. Spector to set sst. write_limit when done

    8/02/77 by Greenberg for pc_wired-calling.
    4/22/77 by B. Greenberg to stop special-casing prds, when it became
      deciduous.
    2/06/76 by S. Webber for new reconfiguration

   12/08/75 by Bernard Greenberg for pre-withdraw system wherein nothing
      gets truncated at shutdown time, for all is withdrawn against the
      hardcore partition.
    9/04/75 by Greenberg to gtpd sst_names_.
    4/16/75 by BSG for AST name table, in New Storage System.
    2/10/75 by Andre Bensoussan for New Storage System.

   10/08/74 by B. Greenberg for SST name table.
    7/18/74 by Mike Grady to rename this make_segs_paged from update_sst_pl1
      and move wiring code to make_sdw to remove aste.iw bit and allow
      certain collection 2 wired segs to be unthreaded.
    4/09/74 by S.Webber to wire down only first part of bound_sss_wired_
    3/19/74 by Bernard Greenberg for collect_free_core mechanism

   11/01/73 by RE Mullen: to v2pl1
    6/27/72 by Craig Jensen: to convert this code for the follow-on 645.
    4/06/72 by clj: to free up pages immediately after they are no longer
      needed; rather than waiting until the end of update_sst_pl1; this
      avoided some memory overflows which were occurring during the
      execution of the aste_create loop.
   */

	dcl     tsdw		 fixed bin (71);
	dcl     page_size		 fixed bin (18);

	dcl     sstnt_no		 fixed bin;
	dcl     dseg_no		 fixed bin;

	dcl     new_dbr		 fixed bin (71);
	dcl     new_seg_sdw		 fixed bin (71);

	dcl     abs_seg_ptr		 ptr;
	dcl     seg_ptr		 ptr;

	dcl     1 sorted_segs	 (0:300) aligned automatic,
						/* Array of seg. nos. sorted by their abs. mem. addr. */
		2 segnum		 fixed bin,
		2 add		 fixed bin (26);

	dcl     k			 fixed bin;
	dcl     idx		 fixed bin;
	dcl     segnum		 fixed bin;

	dcl     current_address	 fixed bin (26) aligned;
						/* Addr. of first word of current seg. */
	dcl     current_page	 fixed bin;	/* Page no. in which first word of current seg. resides. */
	dcl     high_page_to_free	 fixed bin;	/* Page no. of highest page in mem. yet to be freed. */
	dcl     seg_size		 fixed bin (19);	/* Size in words of current seg. */
	dcl     nsegs		 fixed bin;	/* No. of entries in the array; sorted_seg_nos. */
	dcl     new_address		 fixed bin (26) aligned;
						/* New value to be assigned to curloc. */

	dcl     dseg$		 (0:1023) fixed bin (71) external static;
						/* initializer's dseg */
	dcl     ds_seg$		 (0:1023) fixed bin (71) external static;
						/* new dseg being created for initializer */
	dcl     abs_seg$		 ext;		/* window seg through which copies are made */
	dcl     slt$		 ext;

	dcl     1 sst$level		 (0:3) aligned external,
		2 ausedp		 bit (18) unaligned,
		2 no_aste		 fixed bin (18) uns unal;

	dcl     sys_info$page_size	 fixed bin ext;
	dcl     pds$dstep		 bit (18) aligned ext;
	dcl     unpaged_page_tables$	 aligned ext;

	dcl     absadr		 entry (ptr, fixed bin (35)) returns (fixed bin (26));
	dcl     freecore		 entry (fixed bin);
	dcl     get_ptrs_$given_astep	 entry (ptr) returns (fixed bin (71));
	dcl     make_sdw		 entry (fixed bin, fixed bin (71), ptr, ptr);
	dcl     make_sdw$unthreaded	 entry (fixed bin, fixed bin (71), ptr, ptr);
	dcl     pc_wired$write	 entry (ptr, fixed bin, fixed bin);
	dcl     pmut$swap_sdw	 entry (ptr, ptr);
	dcl     pmut$ldbr		 entry (fixed bin (71));
	dcl     sdw_util_$get_size	 entry (pointer, fixed bin (19));
	dcl     sdw_util_$get_address	 entry (pointer, fixed bin (26));
	dcl     sdw_util_$set_access	 entry (pointer, bit (4) unaligned);
	dcl     syserr		 entry options (variable);
	dcl     thread$out		 entry (ptr, bit (18));

	dcl     (addr, baseno, baseptr, bin, bit, currentsize, divide, max, null, ptr, rel, segno, string, sum, unspec)
				 builtin;

	upt_ptr = addr (unpaged_page_tables$);
	abs_seg_ptr = addr (abs_seg$);
	sltp = addr (slt$);				/* Get a pointer to the SLT */
	sstnp = addr (sst_names_$);
	sstnt_no = bin (baseno (sstnp), 18);
	dseg_no = bin (baseno (addr (dseg$)), 18);
	page_size = sys_info$page_size;		/* Copy Page Size to Stack. */

/* Get an ASTE for the initializer's dseg, fill in values */

	call make_sdw$unthreaded (dseg_no, tsdw, astep, (null ()));
	pds$dstep = rel (astep);			/* Set rel pointer to chain of dseg's */

	call pmut$swap_sdw (addr (ds_seg$), addr (tsdw));

	ds_seg$ (dseg_no) = tsdw;			/* fill in SDW for dseg in new dseg being built */
	new_dbr = tsdw;				/* save descriptor segment base register */

	sltep = addr (slt.seg (sstnt_no));		/* get ptr to slte for sstnt */
	sstnt.nentries = sum (sst$level.no_aste);	/* get total number of astes */
	slte_uns.max_length = divide (currentsize (sstnt) + (page_size - 1), page_size, 9, 0);
						/* set the max length (in pages) */


/* Create an array which lists the segment nos. of the pageable segments; these segment nos. are
   sorted by the addresses of these segments. */

	nsegs = 0;				/* Init. no. segs. in this array. */
	do segnum = slt.first_sup_seg to slt.last_sup_seg, slt.first_init_seg to slt.last_init_seg;
	     sltep = addr (slt.seg (segnum));		/* get pointer to this seg's SLTE */
	     if (^slte.paged) | slte.abs_seg | slte.layout_seg
	     then do;				/* copy SDW directly if funny segment */
		     ds_seg$ (segnum) = dseg$ (segnum);
		     goto CHECK_NEXT_SEGMENT;
		end;

	     if dseg$ (segnum) = 0
	     then new_address = 0;			/* null seg */
	     else do;
		     call sdw_util_$get_address (addr (dseg$ (segnum)), new_address);
		     if new_address >= upt.sst_absloc & new_address <= upt.sst_last_loc
		     then do;			/* already paged */
			     ds_seg$ (segnum) = dseg$ (segnum);
			     goto CHECK_NEXT_SEGMENT;
			end;
		     new_address = absadr (baseptr (segnum), (0));
						/* real mem address */
		end;

	     nsegs = nsegs + 1;			/* Increm. no. segs. in array being built. */
	     if nsegs > hbound (sorted_segs, 1)
	     then /* Did array overflow? */
		call syserr (CRASH, "make_segs_paged: sorted_segs array overflowed.");

	     sorted_segs (nsegs).segnum = segnum;	/* Remember segnum and address in the array */
	     sorted_segs (nsegs).add = new_address;

	     do idx = nsegs to 1 by -1;		/* Scan the sorted array for the proper slot for "segnum". */
		if new_address > sorted_segs (idx).add
		then /* is the idx'th slot the right one? */
		     goto SLOT_FOUND;		/* Yes, exit from this loop. */
		sorted_segs (idx) = sorted_segs (idx - 1);
						/* Otherwise, bubble up */
	     end;

	     idx = 0;				/* If the loop falls out, first slot is the one sought. */

SLOT_FOUND:
	     sorted_segs (idx + 1).segnum = segnum;	/* Add the new segment in the right place. */
	     sorted_segs (idx + 1).add = new_address;

CHECK_NEXT_SEGMENT:
	end;					/* End of loop sorting segment addresses */


/* Make each of the pageable segments pageable by moving them to the pageable region in memory. */

	high_page_to_free = -1;			/* Indicate that this variable has to be initialized. */
LOOP_DOWN_SEGS:
	do idx = nsegs to 1 by -1;			/* Process the segment with the highest addr. next */
						/* so that region of memory can be freed without having */
						/* to be concerned if following portions of the last page */
						/* of the segment are still in use. */
	     segnum = sorted_segs (idx).segnum;		/* Get the seg. no. of highest seg. not yet freed. */
	     sltep = addr (slt.seg (segnum));		/* get pointer to this seg's SLTE */
	     seg_ptr = baseptr (segnum);		/* Get ptr. to seg. to be copied. */

	     if segnum = dseg_no
	     then goto SKIP;

	     call make_sdw (segnum, tsdw, astep, (null ()));
						/* Get the AST entry and the SDW */
	     if astep = null ()
	     then goto SKIP;			/* Don't attempt to allocate abs segs. */

/* Now move the i'th segment */

	     ds_seg$ (segnum) = tsdw;			/* fill in new SDW into new dseg */
	     if dseg$ (segnum) = 0
	     then do;				/* no prev segment (so don't free) */
		     call pmut$swap_sdw (seg_ptr, addr (tsdw));
						/* but new sdw (from make_sdw) good - clean up new seg */
		     call pc_wired$write (astep, 0, -1);
		     go to SKIP;
		end;


/* Having put the right thing into the new dseg, one might think that */
/* a copy of the contents is all that is needed. However, it is also */
/* neccessary to swap the old dseg (that is still in use) over to the */
/* paged copy, so that the storage can be freed. */

	     new_address = absadr (baseptr (segnum), (0));/* Get addr. of first word in original seg */
	     call sdw_util_$get_size (addr (dseg$ (segnum)), seg_size);
						/* Get size of seg. (in words). */

	     new_seg_sdw = tsdw;			/* save it with correct access */
	     call sdw_util_$set_access (addr (tsdw), "1010"b);
						/* Make the abs-seg RW */
	     call pmut$swap_sdw (addr (abs_seg$), addr (tsdw));

	     if slte_uns.breakpointable
	     then begin;
		     declare (from_bkpt_page_ptr, to_bkpt_page_ptr)
					      ptr;
		     declare (from_breakpoint_ptr, to_breakpoint_ptr)
					      ptr;
		     declare bkpt_num	      fixed bin;

		     seg_size = seg_size - 1024;	/* handle bkpt page separately */

/* We must copy over breakpoints set in this seg.
For wired segs this will overwrite the breakpoints with themselves in
breakpoint_page$, but this won't hurt. */

		     from_bkpt_page_ptr = addrel (seg_ptr, seg_size);
		     to_bkpt_page_ptr = addrel (abs_seg_ptr, seg_size);
		     do bkpt_num = 1 to dimension (from_bkpt_page_ptr -> bkpt_page.bkpts, 1);
			from_breakpoint_ptr = addr (from_bkpt_page_ptr -> bkpt_page.bkpts (bkpt_num));
			to_breakpoint_ptr = addr (to_bkpt_page_ptr -> bkpt_page.bkpts (bkpt_num));
			if segno (from_breakpoint_ptr -> breakpoint.original_instr_ptr) = segnum
			then to_breakpoint_ptr -> breakpoint = from_breakpoint_ptr -> breakpoint;
		     end;
		end;

/* When we process our own stack, the return address for pmut$swap_sdw */
/* would land in the old copy only. So it is filled in by hand here, */
/* which is just overwritten for all other segs. */

	     stackframeptr () -> stack_frame.return_ptr = codeptr (PMUT_RETURN_HERE);
	     begin;
		declare from		 (seg_size) bit (36) aligned based (seg_ptr);
		declare to		 (seg_size) bit (36) aligned based (abs_seg_ptr);
		to = from;
	     end;
	     call pmut$swap_sdw (seg_ptr, addr (new_seg_sdw));
PMUT_RETURN_HERE:
	     call pc_wired$write (astep, 0, -1);	/* Get it out to disk */

/* Free the pages of the old ith seg. */

	     current_address = new_address;		/* Get addr. of first word in seg. i. */
	     current_page = divide (current_address + page_size - 1, page_size, 12, 0);
						/* Get page no. of page into which
						   current_address points. */
	     high_page_to_free = divide (current_address + seg_size - 1, page_size, 12, 0);
						/* No, get the highest page no. */
	     do k = current_page to high_page_to_free;	/* Loop to free all pages now available. */
		call freecore (k);			/* Free a page. */
	     end;
SKIP:
	end LOOP_DOWN_SEGS;

/* Now switch over to the new descriptor segment */

	call pmut$ldbr (new_dbr);			/* switch to the new paged dseg */
	addr (flagbox$) -> fgbx.hc_dbr = unspec (new_dbr);

	tsdw = 0;
	call pmut$swap_sdw (addr (abs_seg$), addr (tsdw));/* cleanup */

	sstnt.names = "";				/* touch all the names, initialize them, and withdraw the pages */

	return;


/* format: off */
%page; %include aste;
%page; %include bce_breakpoint_page;
%page; %include flagbox;
%page; %include mc;
%page; %include slt;
%page; %include slte;
%page; %include sstnt;
%page; %include stack_frame;
%page; %include syserr_constants;
%page; %include unpaged_page_tables;

/*  */

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   make_segs_paged: sorted_segs array overflowed.

   S: $crash

   T: $init

   M: The number of paged segments in collection 1 is larger than
   the internal buffer in the program make_segs_paged required to
   sort them by main memory address. This indicates an error in
   construction of the system (i.e., too many header entries), or
   may be symptomatic of main memory or CPU hardware problems.

   A: If this recurs, revert to a previous system tape. No emergency
   shutdown is needed. 

   END MESSAGE DOCUMENTATION */

	end make_segs_paged;




		    move_non_perm_wired_segs.pl1    11/11/89  1107.2r w 11/11/89  0816.1      113391



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */



/****^  HISTORY COMMENTS:
  1) change(86-05-13,GJohnson), approve(86-05-13,MCR7387),
     audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056):
     Correct error message documentation.
                                                   END HISTORY COMMENTS */


/* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */

move_non_perm_wired_segs:
     procedure;

/* bootload_loader loads collection 1 into an artficially restricted */
/* memory area, currently the first 512K of absolute addresses. */
/* In a service environment, this may conflict with the desired */
/* layout of the low controller -- SST and Core Map high, firmware */
/* and I/O buffers low. Thus init_segs and to-be-made-paged segs */
/* are moved into high memory by this program, where bootstrap1 */
/* used to put them. This program does not work on dseg, or the 
unpaged page tables, but these won't be moved, anyway. */
/* BIM 7/82 */
/* Modified 9/83 by Keith Loepere for paged, wired segment support */
/* Modified 12/83 by Keith Loepere for breakpoint page support. */
/* Modified 10/84 by Allen Ball to fix a bad call to syserr. */
/* Modified 3/85 by Keith Loepere for one more attempt to tell apart the
   segments that should be moved from those that shouldn't. */

declare  int_unpaged_page_tables$	  ext static;
declare  unpaged_page_tables$		  ext static;
declare  slt$			  ext static;

declare  absadr			  entry (ptr, fixed bin (35)) returns (fixed bin (26));
declare  config_$find		  entry (char (4) aligned, pointer);
declare  pmut$camp			  entry;
declare  pmut$swap_sdw		  entry (ptr, ptr);
declare  ptw_util_$make_core		  entry (ptr, fixed bin (26));
declare  rsw_util$port_info		  entry (fixed bin (3), bit (1) aligned, fixed bin (17), fixed bin (17), fixed bin (3));
declare  sdw_util_$construct		  entry (ptr, ptr);
declare  sdw_util_$dissect		  entry (ptr, ptr);
declare  sdw_util_$get_address	  entry (ptr, fixed bin (26));
declare  syserr			  entry options (variable);

declare  top			  fixed bin (18);	/* K words of it */
declare  new_free_core_size		  fixed bin (26);	/* words of it */
declare  new_abs_sdw		  fixed bin (71);
declare  port_base			  fixed bin;
declare  port_size			  fixed bin;
declare  port_tag			  fixed bin (3);
declare  port_enabled		  bit (1) aligned;
declare  port_interlaced		  fixed bin (3);

declare  (init_segnum, sup_segnum)
				  fixed bin (18);

declare  sys_boot_info$bootload_mem_size
				  fixed bin (26) ext static;
declare  sys_boot_info$contig_mem_size
				  fixed bin (26) ext static;

declare  ME			  char (32) init ("move_non_perm_wired_segs") int static options (constant);

%include config_mem_card;
%include sdw_info;

declare  upt_absloc			  fixed bin (26);
declare  iupt_absloc		  fixed bin (26);
declare  abs_page_table_absloc	  fixed bin (26);
declare  abs_page_table_ptr		  ptr;
declare  abs_seg$			  ext static;	/* for referencing new address for copy */
declare  abs_seg0$			  ext static;	/* for copying paged segments */
declare  abs_seg_ptr		  pointer;
declare  old_abs_seg_sdw		  fixed bin (71);

declare  1 abs_si			  aligned like sdw_info;
declare  1 (init_si, sup_si)		  aligned like sdw_info;

declare  dseg$			  (0:4095) fixed bin (71) ext;
declare  (addr, baseno, baseptr, bin, null, segno, substr)
				  builtin;

%page; %include stack_frame;
%page; %include syserr_constants;
%page; %include slt;
%page; %include slte;


	sltp = addr (slt$);
	top = 0;
	port_size = 0;
	port_base = 0;

	mem_cardp = null;
	do while ("1"b);				/* a goto will leave the loop */
NEXT_CARD:
	     call config_$find (MEM_CARD_WORD, mem_cardp);
	     if mem_cardp = null then go to DONE_LOOP;

	     if mem_card.state = "off" then go to NEXT_CARD;

	     port_tag = mem_card.tag - 1;

	     call rsw_util$port_info (port_tag, port_enabled, port_base, port_size, port_interlaced);

	     if ^port_enabled then call syserr (CRASH, "^a: mem ^a on in config, but port off.", ME,
		     substr ("abcdefgh", mem_card.tag, 1));

	     if port_size > mem_card.size then port_size = mem_card.size; /* obey config */
	     if port_size < mem_card.size then call syserr (CRASH, "^a: mem ^a size ^dK in config, ^dK on port.", ME, substr ("abcdefgh", (port_tag), 1), mem_card.size, port_size);

	     if port_base > top then go to DONE_LOOP;	/* hit a hole */

	     top = top + port_size;			/* count in new data */
	end;					/* loop to next mem card */

DONE_LOOP:
	if top = 0 then call syserr (CRASH, "^a: no main memory configured.", ME);

	sys_boot_info$contig_mem_size = top * 1024;

	if sys_boot_info$contig_mem_size <= sys_boot_info$bootload_mem_size then return;

/* This free core size will have each high-loaded segment subtracted */
/* from it as it is moved into its new home. */

	new_free_core_size = sys_boot_info$contig_mem_size - slt.free_core_start;

	iupt_absloc = absadr (addr (int_unpaged_page_tables$), (0));
	call sdw_util_$get_address (addr (dseg$ (segno (addr (abs_seg0$)))), abs_page_table_absloc);
	abs_page_table_ptr = ptr (addr (int_unpaged_page_tables$), abs_page_table_absloc - iupt_absloc);

/* set up some static data about abs_seg$ */

	old_abs_seg_sdw = dseg$ (bin (baseno (addr (abs_seg$)), 18));
						/* saved sdw */

/* Now the segments that were loaded high are to be moved up, */
/* starting from the highest. */
/* bootload_loader was known to */
/* start at the top and work down, but to intersperse init_seg's */
/* and paged segs. Thus by working up the two lists of SLTE's */
/* we can get the ordered list */

	init_segnum = slt.first_init_seg - 1;
	sup_segnum = slt.first_sup_seg - 1;

/* Here they start out faulted. When we find a seg to move, we */
/* turn off the faulted bit. When we move it, we turn it back on. */

	unspec (init_si), unspec (sup_si) = ""b;
	init_si.faulted, sup_si.faulted = "1"b;		/* for do loops */

	do while ("1"b);				/* exited in middle with goto */
	     if init_segnum <= slt.last_init_seg then do while (init_si.faulted);
		init_segnum = init_segnum + 1;
		if init_segnum > slt.last_init_seg then go to NO_MORE_INIT;
		sltep = addr (slt.seg (init_segnum));
		if slte_uns.layout_seg | slte_uns.abs_seg then init_si.faulted = "1"b;
		else do;
		     call sdw_util_$dissect (addr (dseg$ (init_segnum)), addr (init_si));
		     if ^init_si.faulted then do;
			init_si.address = absadr (baseptr (init_segnum), (0));
			if init_si.address <= slt.free_core_start + slt.free_core_size then init_si.faulted = "1"b;
		     end;				/* move anybody in high memory */
		end;
	     end;

NO_MORE_INIT:					/* Now we have the topmost non-abs-seg init_seg disected, and segnum in init_segnum */
	     if sup_segnum <= slt.last_sup_seg then do while (sup_si.faulted);
		sup_segnum = sup_segnum + 1;
		if sup_segnum > slt.last_sup_seg then go to NO_MORE_SUP;
		sltep = addr (slt.seg (sup_segnum));
		if slte_uns.layout_seg | slte_uns.abs_seg then sup_si.faulted = "1"b; /* force it to be ignored */
		else do;
		     call sdw_util_$dissect (addr (dseg$ (sup_segnum)), addr (sup_si));
		     if ^sup_si.faulted then do;
			sup_si.address = absadr (baseptr (sup_segnum), (0));
			if sup_si.address <= slt.free_core_start + slt.free_core_size then sup_si.faulted = "1"b;
		     end;				/* move anybody in high memory */
		end;
	     end;

NO_MORE_SUP:
	     if (sup_segnum > slt.last_sup_seg & init_segnum > slt.last_init_seg) | (sup_si.faulted & init_si.faulted) then go to DONE_MOVE;

/* Now the two si structures contain the lowest segnum'd (and by implication  */
/* highest addr'd) sdw's */
/* if we have run out of either, their address will show as zero */

	     if sup_si.faulted | (^init_si.faulted & (init_si.address > sup_si.address)) then do; /* they CANNOT both be faulted */
		call MOVE (init_segnum, init_si);
		init_si.faulted = "1"b;
	     end;
	     else do;
		call MOVE (sup_segnum, sup_si);
		sup_si.faulted = "1"b;
	     end;
	end;					/* loop moving segments */

DONE_MOVE:
	slt.free_core_size = new_free_core_size;	/* update SLT header */
	new_abs_sdw = 0;
	call pmut$swap_sdw (addr (abs_seg$), addr (new_abs_sdw));
	return;

MOVE:
     procedure (segnum, si);
declare  segnum			  fixed bin (18);
declare  1 si			  aligned like sdw_info;
declare  new_abs_sdw		  fixed bin (71);
declare  new_address		  fixed bin (26);
declare  new_seg_sdw		  fixed bin (71);
declare  old_seg_sdw		  fixed bin (71);
declare  page			  fixed bin;
declare  page_table_absloc		  fixed bin (26);
declare  page_table_ptr		  ptr;

declare  seg_ptr			  pointer;
declare  copy_the_seg		  (si.size) bit (36) aligned based;

	seg_ptr = baseptr (segnum);

/* First, allocate some space */

	if si.paged then do;

/* paged segment; build paged abs_seg0 onto it and move. */

	     sltep = addr (slt.seg (segnum));		/* subtract off breakpoint page from amt to move */
	     if slte.breakpointable then si.size = si.size - 1024;

	     call sdw_util_$get_address (addr (dseg$ (segnum)), page_table_absloc);
	     page_table_ptr = ptr (addr (int_unpaged_page_tables$), page_table_absloc - iupt_absloc);

	     new_address = new_free_core_size + slt.free_core_start - si.size;

/* copy page table to abs seg page table with new addresses */

	     do page = 0 to divide (si.size, 1024, 17) - 1;
		call ptw_util_$make_core (addrel (abs_page_table_ptr, page), new_address + page * 1024);
	     end;
	     call pmut$camp;
	     abs_seg_ptr = addr (abs_seg0$);

	     new_free_core_size = new_free_core_size - si.size;
	     old_seg_sdw = dseg$ (segnum);
	     new_seg_sdw = dseg$ (segno (abs_seg_ptr));
	end;
	else do;

/* Simple unpaged segment; build unpaged abs_seg onto it and move. */

	     unspec (abs_si) = ""b;			/* no attributes when we rearrange it */
	     abs_si.read, abs_si.write = "1"b;		/* always RW for copying */
	     abs_si.address = new_free_core_size + slt.free_core_start - si.size;
	     new_free_core_size = new_free_core_size - si.size;
	     abs_si.size = si.size;

	     call sdw_util_$construct (addr (new_abs_sdw), addr (abs_si));

	     si.address = abs_si.address;		/* move it */
	     call sdw_util_$construct (addr (new_seg_sdw), addr (si));

	     call pmut$swap_sdw (abs_seg_ptr, addr (new_abs_sdw));
	     abs_seg_ptr = addr (abs_seg$);
	end;

/* Move the contents */

/* Now move the real segment onto the new copy */
/* if it is this program's text that just got moved, it is pure, and all is 
/* jolly. */
/* inzr_stk0, though, is another kettle of fish. If we swapped its sdw */
/* with the return address put on it after the copy, the return */
/* address would vanish.  So we patch the return address in in advance */

	stackframeptr () -> stack_frame.return_ptr = codeptr (PMUT_RETURN_HERE);
						/* please */

	abs_seg_ptr -> copy_the_seg = seg_ptr -> copy_the_seg;

	call pmut$swap_sdw (seg_ptr, addr (new_seg_sdw));

PMUT_RETURN_HERE:
	;
	if si.paged then do;

/* We now have both abs_seg$ and the seg in question pointing to the abs_seg0
page table and the new memory.  We need to fix up the orig seg's page table
and get it's sdw back to pointing there. */

	     do page = 0 to divide (si.size, 1024, 17) - 1;
		call ptw_util_$make_core (addrel (page_table_ptr, page), new_address + page * 1024);
	     end;
	     call pmut$camp;
	     call pmut$swap_sdw (seg_ptr, addr (old_seg_sdw));
	end;

	return;
     end MOVE;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   move_non_perm_wired_segs: mem TAG on in config deck, but port off.

   S:  $crash

   T:  $init

   M:  Memory controller TAG is specified ON on its MEM card,
   but its port is disabled on the bootload CPU.

   A:  Enable the port or set the MEM OFF and reboot.

   Message:
   move_non_perm_wired_segs: mem TAG size nK in config, mK on port.

   S:  $crash

   T:  $init

   M:  Memory controller TAG has a size of nK in the config deck,
   but the address assignment and port size switches specify mK.

   A:  Fix the switches or config deck and reboot.

   Message:
   move_non_perm_wired_segs: no main memory configured.

   S:  $crash

   T:  $init

   M:  No MEM cards were found ON in the config deck.

   A:  Fix the config deck and reboot.

   END MESSAGE DOCUMENTATION */

     end move_non_perm_wired_segs;




		    read_disk_label.pl1             11/11/89  1107.2r w 11/11/89  0816.1       32409



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */
/* format: style2 */

read_disk_label:
     procedure (a_pvtx, a_labelp, a_reason, a_code);

/* format: off */

/* *	This procedure reads the label of the disk owned by the specified pvt.
   *
   *	Modified 11/28/80, W. Olin Sibert, to extract from init_pvt and make standalone
   *	   also to add improved error diagnostics
   *     BIM 7/82 remove fixed bin (9), new pvte.
   *     BIM 10/82 no more crashes.
   */

/* format: on */

	dcl     (
	        a_pvtx		 fixed bin,
	        a_labelp		 pointer,
	        a_reason		 char (*),
	        a_code		 fixed bin (35)
	        )			 parameter;

	dcl     code		 fixed bin (35);
	dcl     n_tries		 fixed bin;

	dcl     sys_info$first_reasonable_time
				 fixed bin (71) external static;
	dcl     sys_info$last_reasonable_time
				 fixed bin (71) external static;

	dcl     cv_fsdisk_error_	 entry (fixed bin (35));
	dcl     read_disk		 entry (fixed bin, fixed bin, pointer, fixed bin (35));

	dcl     syserr$error_code	 entry options (variable);
	dcl     MAX_TRIES		 fixed bin internal static options (constant) init (5);
	dcl     ME		 char (32) internal static options (constant) init ("read_disk_label");

	dcl     addr		 builtin;

	declare (
	        error_table_$fsdisk_not_ready,
	        error_table_$fsdisk_phydev_err,
	        error_table_$fsdisk_bad_label,
	        error_table_$fsdisk_old_label
	        )			 fixed binary (35) external static;


	pvt_arrayp = addr (pvt$array);
	pvtep = addr (pvt_array (a_pvtx));
	labelp = a_labelp;

	n_tries = 0;
	a_code = 0;
	a_reason = "";

TRY_READING_AGAIN:
	n_tries = n_tries + 1;			/* Don't do it too many times */
	code = 0;

	call read_disk (a_pvtx, LABEL_ADDR, labelp, code);
	call cv_fsdisk_error_ (code);

/* retry device errors; the drive may not be all the way here yet */
	if code = error_table_$fsdisk_not_ready | code = error_table_$fsdisk_phydev_err
	then if n_tries < MAX_TRIES
	     then do;
		     do code = 100000 to 0 by -1;	/* wait a bit */
		     end;
		     goto TRY_READING_AGAIN;
		end;
	     else do;
		     a_reason = "Error persisted after retries.";
		     a_code = code;
		     return;
		end;
	else if code ^= 0
	then do;					/* some code that indicates logic error */
		call syserr$error_code (CRASH, code, "^a: Cannot read label of ^a ^d: ^a.", ME, pvte.devname,
		     pvte.logical_area_number);
	     end;

/* Label is read in */

	if label.Multics ^= Multics_ID_String
	then do;
		a_code = error_table_$fsdisk_bad_label;
		a_reason = "Label sentinel was incorrect.";
		return;
	     end;

	if label.version ^= 1
	then do;
		a_code = error_table_$fsdisk_old_label;
		return;
	     end;

	if (label.time_registered < sys_info$first_reasonable_time) /* Label probably damaged, or prehistoric */
	     | (label.time_registered > sys_info$last_reasonable_time)
	then do;
		a_code = error_table_$fsdisk_bad_label;
		a_reason = "Unreasonable time in label.";
		return;
	     end;

	return;					/* We have made it through all the obstacles */


/* format: off */
%page; %include disk_pack;
%page; %include fs_vol_label;
%page; %include pvte;
%page; %include syserr_constants;

	end read_disk_label;




		    save_handler_mc.alm             11/11/89  1107.2r   11/11/89  0816.1       22896



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1987                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1984 *
" *                                                         *
" ***********************************************************
	segdef	save_handler_mc
"
" Routine to save into the toehold the machine conditions needed
" to restart bootload Multics.  Keith Loepere, in '83.  
"
" Called with a pointer to the toehold.

" This program is used in concert with init_toehold and with toehold.  The
" idea is that the toehold needs a way to re-invoke bce.  To do this, it reads
" in the memory image of bce saved by init_toehold.  It restores certain
" processor registers, saved by this program and then transfers to bce.

" Subtleties:
"
" The toehold returns to bce by returning here, into save_handler_mc.  This is
" because it is the safest place to which to return, since the state of memory
" and the processor was saved here, and only accurately describes this point in
" time.
"
" When the toehold returns here, we simply return, as we did when called from
" init_toehold.  We thus end up in init_toehold, who is smart enough to tell
" that it is really the toehold that found its way there, and so it quickly
" starts the process of running the initialization pass needed to restart bce.
"
" Since init_toehold saves the memory before calling this program, the return
" data stored into memory by calling this program does not appear on disk.  So,
" we save in unused locations in the toehold data that information needed to
" reconstruct the return data in our caller's (init_toehold) stack frame so we
" may return to it.

"
	include	stack_frame
	include	toehold_save_dcls_
"
save_handler_mc:
	epp1	pr0|2,*			" to toehold$
	epp1	pr1|0,*
	ldaq	pr6|stack_frame.return_ptr	" we must save these
					" pointers since they were
					" stored into the stack after
					" it was written to disk
	staq	pr1|toehold.handler_mc+mc.scu+4
	ldaq	pr6|stack_frame.operator_ptr
	staq	pr1|toehold.handler_mc+mc.scu+6
	spri	pr1|toehold.handler_mc+mc.prs
	sreg	pr1|toehold.handler_mc+mc.regs_word
	spl	pr1|toehold.handler_mc+mc.eis_info
	sdbr	pr1|toehold.bce_dbr
	scpr	pr1|toehold.bce_mode_reg,06	" mode and cache mode reg
	sti	pr1|toehold.handler_mc+mc.scu+2
	tsp0	*+1				" get return addr
	spri0	pr1|toehold.handler_mc+mc.scu+0
	short_return
	end




		    scas_init.pl1                   11/11/89  1107.2rew 11/11/89  0816.1      291078



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


/* SCAS_INIT - Initialize the System Controller Addressing Segment.
   7/24/69 - Noel I. Morris
   Modified for follow-on 8/72 by C. L. Jensen & N. I. Morris
   Modified 2/76 by Noel I. Morris for 4MW SCU and new reconfig
   Modified 2/79 by Bernard S. Greenberg for port expanders/8 cpus.
   Modified 6/79 by Mike Grady to improve mem/port config checks
   Modified 12/79 by Mike Grady to fix bugs in above change
   Modified 9/08/80 by J. A. Bush for the DPS8/70M CPU
   Modified 01/04/81, W. Olin Sibert, to convert to new config cards and for
   scs$scas_page_table.
   Modified January 1981 by C. Hornig to enable ports.
   Modified by J. Bongiovanni April 1981 for anti-hog switch setting
   Modified April 1982 by J. Bongiovanni to check CPU data switches
   Modified 7/82 BIM merge in the Sibert changes.
   Modified 10/82 BIM to not set the mask instructions to rmcm/smcm
   until AFTER setting the port enable bits.
   Modified 8/83 K. Loepere for bootload Multics toehold
   Modified 9/83 E. N. Kittlitz to not enable scu port for an OFF IOM.
   Modified 4/84 K. Loepere to be less fussy when initializing for bce.
   Modified 8/84 K. Loepere to keep cpu ports on bootload scu enabled 
   after crash.
*/


/****^  HISTORY COMMENTS:
  1) change(88-07-27,Farley), approve(88-10-05,MCR7968),
     audit(88-10-10,Beattie), install(88-10-14,MR12.2-1166):
     Added check for new rcerr_addscu_memoverlap error code.
                                                   END HISTORY COMMENTS */

%page;

/* format: style4,delnl,insnl,tree,ifthenstmt,indnoniterend */
scas_init:
     procedure;

dcl  (i, j) fixed bin,				/* iteration variables */
     found bit (1) aligned,				/* useful indicator bit */
     dps8 bit (1) aligned,				/*  dps8 indicaor used for checking mem tags */
     n_cpus fixed bin,				/* count of CPU config cards */
     n_mems fixed bin,				/* count of MEM config cards */
     cport fixed bin (3),				/* port index of SCU port of CPU being configured */
     masks_found (4) bit (1) unal,			/* used in interrupt cpu assignment */
     exp_port fixed bin (2),				/* port expander subport index */
     tag fixed bin (3),				/* tag from CPU or MEM card */
     errtag fixed bin (3),				/* tag of CPU or mask in error */
     enabled bit (1) aligned,				/* port enabled bit */
     base fixed bin (17),				/* system controller base address */
     size fixed bin (17),				/* system controller size */
     interlace fixed bin (3),				/* memory interlace type */
     expected_base fixed bin (17),			/* expected base by config deck */
     code fixed bin (35),				/* error code */
     cpu_low_port fixed bin,				/* low-order cpu port			*/
     cpu_high_port fixed bin,				/* high-order cpu port			*/
     cpu_ports bit (36) aligned,			/* mask for cpu ports			*/
     iom_low_port fixed bin,				/* low-order iom port			*/
     iom_high_port fixed bin,				/* high-order iom port			*/
     iom_ports bit (36) aligned,			/* mask for iom ports			*/
     toehold_abs fixed bin (24),			/* absolute address of toehold */
     severity fixed bin;				/* for syserr calls (implies whether we try to fix up errors) */

declare  1 sdwi aligned like sdw_info;
declare  tsdw fixed bin (71);

dcl  tag_letter (0:7) char (1) aligned static init ("A", "B", "C", "D", "E", "F", "G", "H");
						/* for message */
dcl  (
     ALL_ONES bit (36) aligned init ("777777777777"b3),
     MAX_CYCLE_GROUP fixed bin init (5),
     XED_INHIB bit (18) init ("717200"b3)
     ) int static options (constant);

dcl  1 cdata like scs$controller_data based (cdp) aligned,	/* single element of array */
     cdp ptr,					/* pointer to the above */
     1 pdata like scs$processor_data based (pdp) aligned,	/* single element of array */
     pdp ptr;					/* pointer to the above */

dcl  scas$ ext,
     toehold$ ext;

dcl  privileged_mode_ut$swap_sdw entry (ptr, ptr),
     absadr entry (ptr, fixed bin (35)) returns (fixed bin (24)),
     init_scu entry (fixed bin (3), fixed bin (3), fixed bin (35)),
     rsw_util$port_info entry (fixed bin (3), bit (1) aligned, fixed bin (17), fixed bin (17), fixed bin (3)),
     rsw_util$set_rsw_mask entry (fixed bin (3), bit (1) aligned),
     rsw_util$init_rsw_mask entry (fixed bin (3), bit (1) aligned),
     scr_util$set_port_enable_bit entry (fixed bin (3), bit (1)),
     scr_util$set_port_enable entry (fixed bin (3), bit (1)),
     scr_util$set_cfg entry (fixed bin (3)),
     sdw_util_$construct entry (ptr, ptr),
     mask_instruction$smcm entry returns (bit (36) aligned),
     mask_instruction$rmcm entry returns (bit (36) aligned),
     config_$find entry (char (4) aligned, ptr),
     syserr entry options (variable);

dcl  (addr, binary, bin, bit, divide, hbound, null, rel, string, substr, unspec) builtin;
%page;
	if ((sys_info$collection_1_phase = EARLY_INITIALIZATION) | (sys_info$collection_1_phase = BOOT_INITIALIZATION)
	     | (sys_info$collection_1_phase = SERVICE_INITIALIZATION))
	then severity = CRASH;
	else severity = ANNOUNCE;

/* Initialize SCAS to contain 32 SDW's with DF3. */

	unspec (scs$scas_page_table) = ""b;		/* Clear it out first */
	do i = 0 to 31;				/* Go through the page table. */
	     addr (scs$scas_page_table (i)) -> l68_ptw.df_no = "11"b;
						/* DF3 */
	end;					/* cause signalled crawlout on touching bad page */

	unspec (sdwi) = ""b;			/* Construct the SCAS SDW */
	sdwi.address = absadr (addr (scs$scas_page_table), code);
	if code ^= 0 then call syserr (CRASH, "scas_init: Error from absadr setting up SCAS.");
	sdwi.read = "1"b;				/* RW access */
	sdwi.write = "1"b;
	sdwi.paged = "1"b;				/* SCAS is a "paged" segment */
	sdwi.size = 32 * 1024;			/* 32 pages */

	call sdw_util_$construct (addr (tsdw), addr (sdwi));
						/* Do it */

	call privileged_mode_ut$swap_sdw (addr (scas$), addr (tsdw));
						/* Pop it in */

/* Require port enable bits for all unused processor ports to be set correctly. */

	do tag = 0 to 7;
	     call rsw_util$set_rsw_mask (tag, "1"b);
	end;


/* Fill in processor switch template info by copying rsw data read in scs_and_clock_init. */

	scs$processor_switch_template = scs$processor_switch_data;

/* Compute the proper value for the CPU data switches. Print a warning if
   they're not set to this. */

	toehold_abs = absadr (addr (toehold$), code);
	scs$processor_data_switch_value = bit (bin (toehold_abs, 18), 18) || XED_INHIB;
	if sys_info$collection_1_phase = EARLY_INITIALIZATION | sys_info$collection_1_phase = BOOT_INITIALIZATION
	     | sys_info$collection_1_phase = SERVICE_INITIALIZATION
	then if scs$processor_switch_data (0) ^= scs$processor_data_switch_value
	     then call syserr (ANNOUNCE, "scas_init: CPU data switches are ^w, should be ^w",
		     scs$processor_switch_data (0), scs$processor_data_switch_value);


/* Set up for computation of cycle port template */

	iom_low_port, cpu_low_port = 36;
	iom_high_port, cpu_high_port = -1;
	iom_ports, cpu_ports = "0"b;
%page;
/* Get info about each configured CPU. */

	n_cpus = 0;				/* Initialize count of CPU's. */
	found = "0"b;				/* Clear bootload CPU found indicator. */
	dps8 = "0"b;				/* clear dps8 indicator flag */

	do i = 0 to 7;				/* Mark all potential CPU's as halted. */
	     scs$processor_data (i).halted_cpu = "1"b;
	end;

	cpu_cardp = null ();			/* Initialize config deck pointer. */
cpu_loop:
	call config_$find (CPU_CARD_WORD, cpu_cardp);	/* Look for CPU card. */
	if cpu_cardp = null () then go to cpu_loop_end;	/* If null pointer, no more CPU cards. */
	n_cpus = n_cpus + 1;			/* Count a CPU. */

	tag = cpu_card.tag - 1;			/* Get expected CPU tag. */
	if (tag < 0) | (tag > 7)
	then					/* Make sure tag is legit. */
	     call syserr (CRASH, "scas_init: Illegal tag on ^a config card.", CPU_CARD_WORD);

	pdp = addr (scs$processor_data (tag));		/* Get pointer to data block for this CPU. */
	if pdata.offline
	then					/* If we already saw config card for this CPU ... */
	     call syserr (CRASH, "scas_init: ^a ^a appears twice in config deck.", CPU_CARD_WORD, tag_letter (tag));

	if tag = scs$bos_processor_tag then do;		/* If this is CPU running ... */
	     found = "1"b;				/* Indicate bootload CPU found. */
	     if cpu_card.state ^= "on  " then do;	/* Config card should not lie. */
		call syserr (severity, "scas_init: Config card for bootload ^a ^a is ^a, must be on.", CPU_CARD_WORD,
		     tag_letter (tag), cpu_card.state);
		cpu_card.state = "on";		/* Try to fix */
		end;
	     rswp = addr (scs$processor_switch_data (2)); /* get ptr to rsw (2) data */
	     if dps8_rsw_2.cpu_type > 0 then dps8 = "1"b; /* set flag for checking memories */
	     end;
	else if cpu_card.type = "dps8" then dps8 = "1"b;	/*  set switch for checking memory tags */

	cport = cpu_card.port;			/* Get controller port. */

	if cport < cpu_low_port then cpu_low_port = cport;
	if cport > cpu_high_port then cpu_high_port = cport;

	if cpu_card.expander_port ^= -1 then do;	/* Expander port */
	     exp_port = cpu_card.expander_port - 1;	/* Get the subport #. */
	     if (exp_port < 0 | exp_port > 3)
	     then call syserr (CRASH, "scas_init: Illegal expander subport tag on CPU ^a config card.",
		     tag_letter (tag));
	     if tag = scs$bos_processor_tag
	     then call syserr (CRASH, "scas_init: Bootload CPU may not be on an expander port.");
	     do i = 0 to 7;				/* Search for duplication. */
		if scs$processor_data (i).offline then do;
						/* Already filled ? */
		     if scs$processor_data (i).controller_port = cport then do;
			if ^scs$expanded_ports (cport)
			then call syserr (CRASH,
				"scas_init: SCU port ^d configured as both expanded and non-expanded.", cport);
			if scs$processor_data (i).expander_port = exp_port
			then call syserr (CRASH,
				"scas_init: CPU ^a and CPU ^a both configured for port ^d subport ^a.",
				tag_letter (tag), tag_letter (i), cport, tag_letter (cport));
			end;
		     end;
	     end;
	     scs$cow (tag).expander_port = exp_port;	/*  Set necessary flags */
	     scs$cow (tag).expanded_port = "1"b;
	     scs$cow (tag).expander_command = "0"b3;	/* Set connect command */
	     pdata.expanded_port = "1"b;
	     scs$expanded_ports (cport) = "1"b;
	     pdata.expander_port = exp_port;
	     end;
	else if scs$expanded_ports (cport)
	     then call syserr (CRASH, "scas_init: SCU port ^d configured as both expanded and non-expanded port.",
		     cport);
	pdata.controller_port = cport;		/* Get it in the processor data. */
	scs$cow (tag).controller_port = cport;
	scs$cow_ptrs (tag).rel_cow_ptr = rel (addr (scs$cow (tag).cow));
						/* Set up indexable ptrs. */
	scs$cow_ptrs (tag).tag = "00"b3;		/* No indirection. */
	pdata.offline = "1"b;			/* Set offline state. */

	if sys_info$collection_1_phase = CRASH_INITIALIZATION
						/* keep all on cpu's enabled on bootload scu */
	then if cpu_card.state = "on  " then call scr_util$set_port_enable_bit (cport, "1"b);
	go to cpu_loop;				/* Look for next CPU card. */

cpu_loop_end:
	if n_cpus < 1
	then					/* Must be at least one card. */
	     call syserr (CRASH, "scas_init: No ^a config card.", CPU_CARD_WORD);

	if ^found then call syserr (CRASH, "scas_init: No config card for bootload ^a.", CPU_CARD_WORD);
%page;
/* Get info about each configured System Controller. */

	n_mems = 0;				/* Initialize number of controllers. */
	found = "0"b;				/* Initialize switch. */
	expected_base = 0;				/* Count config deck size */

	mem_cardp = null ();			/* Initialize config card pointer. */
mem_loop:
	call config_$find ("mem ", mem_cardp);		/* Look for a MEM card. */
	if mem_cardp = null () then go to mem_loop_end;	/* Exit loop when no more MEM cards. */
	n_mems = n_mems + 1;			/* Increment number of system controllers. */

	tag = mem_card.tag - 1;			/* Get CPU port of controller. */
	if (tag < 0) | (tag > 7)
	then					/* Make sure tag is legitimate. */
	     call syserr (CRASH, "scas_init: Illegal tag on ^a config card.", MEM_CARD_WORD);

	if dps8
	then					/* if  a dps8 cpu in config deck... */
	     if tag > 3
	     then call syserr (CRASH,			/* only  MEM tags A, B, C, and D are allowed */
		     "scas_init: ^a ^a. Tags greater than ""D"" not supported by DPS8 CPUs", MEM_CARD_WORD,
		     tag_letter (tag));

	cdp = addr (scs$controller_data (tag));		/* Get pointer to correct element of array. */
	if cdata.online | cdata.offline
	then					/* See if controller already found. */
	     call syserr (CRASH, "scas_init: ^a ^a appears twice in config deck.", MEM_CARD_WORD, tag_letter (tag));

	if mem_card.state = "on  "
	then					/* See if controller is online. */
	     cdata.online = "1"b;			/* Controller is online. */
	else if mem_card.state = "off "
	     then					/* See if it's offline. */
		cdata.offline = "1"b;		/* Indicate controller offline. */
	     else					/* If neither on nor off ... */
		call syserr (CRASH, "scas_init: Config card for ^a ^a is neither on nor off.", MEM_CARD_WORD,
		     tag_letter (tag));

	call rsw_util$port_info (tag, enabled, base, size, interlace);
						/* Get info from processor switches. */

	if base = 0 then do;			/* Test for low-order controller. */
	     if found
	     then					/* If more than one low-order system controller ... */
		call syserr (CRASH, "scas_init: More than one low-order MEM.");
	     else do;
		found = "1"b;			/* Set the switch. */
		if cdata.offline then do;		/* Must not be offline. */
		     call syserr (severity, "scas_init: Config card for bootload ^a indicates unit is offline.",
			MEM_CARD_WORD);
		     mem_card.state = "on";
		     cdata.offline = "0"b;		/* Try to fix */
		     cdata.online = "1"b;
		     end;
		end;
	     end;

	if cdata.online & ^enabled then do;		/* If controller is online but not enabled ... */
	     call syserr (severity, "scas_init: MEM ^a is not enabled.", tag_letter (tag));
	     mem_card.state = "off";			/* Try to fix */
	     cdata.online = "0"b;
	     cdata.offline = "1"b;
	     end;
	call rsw_util$init_rsw_mask (tag, (cdata.online));/* Set mask for checking processor switches. */

	cdata.size = size;				/* Set size of memory. */
	cdata.base = base;				/* Set base of memory. */
	if sys_info$collection_1_phase > SERVICE_INITIALIZATION
	then scs$controller_config_size (tag) = 512;	/* Officially recognize only 512k during crash */
	else scs$controller_config_size (tag) = mem_card.size;
						/* Save for init_sst. */

	if base < expected_base
	then call syserr (CRASH, "scas_init: MEM ^a address assignment disagrees with config deck.", tag_letter (tag));
	if mem_card.size > size
	then					/* More specified than is possible */
	     call syserr (CRASH, "scas_init: Size too large on config card for MEM ^a.", tag_letter (tag));

	expected_base = base + size;			/* Set up for next controller */

	cdata.ext_interlaced = (interlace ^= 0);	/* Indicate if memory is interlaced with another. */
	cdata.four_word = (interlace = 4);		/* Indicate if two or four word interlace. */

	if cdata.online then do;			/* If controller is available now ... */
	     call init_scu (tag, errtag, code);		/* Initialize it. */
	     if code ^= 0
	     then					/* Check for error. */
		if /* case */ code = rcerr_addscu_size
		then call syserr (CRASH, "scas_init: MEM ^a has more memory than indicated by CPU switches.",
			tag_letter (tag));
		else if code = rcerr_addscu_dup_mask
		then call syserr (CRASH, "scas_init: MEM ^a has duplicate mask assignments to CPU ^a.",
			tag_letter (tag), tag_letter (errtag));
		else if code = rcerr_addscu_no_mask
		then call syserr (CRASH, "scas_init: MEM ^a has no mask assigned to CPU ^a.", tag_letter (tag),
			tag_letter (errtag));
		else if code = rcerr_addscu_bad_mask
		then call syserr (CRASH, "scas_init: MEM ^a has mask ^a assigned to non-processor port.",
			tag_letter (tag), tag_letter (errtag));
		else if code = rcerr_addscu_manual
		then call syserr (CRASH, "scas_init: MEM ^a is not in PROGRAM mode.", tag_letter (tag));
		else if code = rcerr_addscu_oldexpand
		then call syserr (CRASH, "scas_init: MEM ^a is an old SCU with port expander", tag_letter (tag));
		else if code = rcerr_addscu_bigconfig
		then				/* Config more than real mem, die */
		     call syserr (CRASH, "scas_init: Size too large on config card for MEM ^a.", tag_letter (tag));
		else if code = rcerr_addscu_memoverlap
		then				/* Mem store size or switches wrong */
		     call syserr (CRASH, "scas_init: Possible memory address overlap in MEM ^a.", tag_letter (tag));


	     end;
	if sys_info$collection_1_phase > SERVICE_INITIALIZATION then go to mem_loop_end;
						/* only low 512k memory officially counts during crash */
	go to mem_loop;				/* Iterate for next MEM card. */

mem_loop_end:
	if n_mems < 1
	then					/* Must be at least one card. */
	     call syserr (CRASH, "scas_init: No ^a config card.", MEM_CARD_WORD);

	if ^found then call syserr (CRASH, "scas_init: No config card for bootload ^a.", MEM_CARD_WORD);
%page;
/* Check to make sure that bootload CPU port is correct. */

	scrp = addr (scs$cfg_data (scs$interrupt_controller));
						/* Get pointer to RSCR CFG data for bootload controller. */
	if bin (scr_cfg1.port_no, 4) ^= scs$processor_data (scs$bos_processor_tag).controller_port
	then call syserr (CRASH, "scas_init: CPU config card specifies wrong controller port number.");

/* Make sure that no unconfigured port is enabled. */
/* Unless we are in early initialization, when this is normal. */

	if ^(sys_info$collection_1_phase = EARLY_INITIALIZATION | sys_info$collection_1_phase > SERVICE_INITIALIZATION)
	then do tag = 0 to 7;			/* Test all ports. */
	     if ^scs$controller_data (tag).offline & ^scs$controller_data (tag).online then do;
		call rsw_util$port_info (tag, enabled, base, size, interlace);
		if enabled
		then				/* If unused port is enabled ... */
		     call syserr (severity,
			"scas_init: MEM ^a is not in the configuration, but is enabled by the CPU switches.",
			tag_letter (tag));
		end;
	end;
%page;
/* enable all the IOM's */

	iom_data_ptr = addr (iom_data$);
	do tag = 0 to 7;
	     if scs$port_data (tag).assigned = IOM_PORT then do;
		if iom_data.per_iom (scs$port_data (tag).iom_number).flags.on_line
		then				/* someday this will be an scs flag */
		     call scr_util$set_port_enable_bit (tag, "1"b);
		if tag < iom_low_port then iom_low_port = tag;
		if tag > iom_high_port then iom_high_port = tag;
		end;
	end;

/* and the BOS processor */

	call scr_util$set_port_enable (binary (scs$processor_data (scs$bos_processor_tag).controller_port, 3), "1"b);

%page;
/* Determine which CPU's have assigned masks. */

	cdp = addr (scs$controller_data (scs$interrupt_controller));
						/* Get pointer to info for bootload controller. */

	string (masks_found) = "0000"b;		/* Found no masks. */
	do i = 0 to 7;				/* Look at all CPU's. */
	     pdp = addr (scs$processor_data (i));	/* Get pointer to correct array element. */
	     if pdata.offline then do;
		do j = 1 to 4;			/* If CPU is to be used, look at masks. */
		     if cdata.eima_data (j).mask_assigned & ^masks_found (j)
		     then if cdata.eima_data (j).mask_assignment = pdata.controller_port then do;
			     masks_found (j) = "1"b;
			     pdata.interrupt_cpu = "1"b;
			     scs$set_mask (i) = mask_instruction$smcm ();
			     scs$read_mask (i) = mask_instruction$rmcm ();
			     scs$mask_ptr (i) = addr (scs$port_addressing_word (scs$interrupt_controller));
			     end;
		end;
		end;
	end;


/* Check to make sure that bootload CPU has mask assigned to it. */

	if ^scs$processor_data (scs$bos_processor_tag).interrupt_cpu
	then call syserr (CRASH, "scas_init: Bootload CPU has no system controller mask assigned.");
%page;



/* Setup to set cyclic port priority switches (anti-hog).  The strategy
   is to put all IOMs on a cyclic priority group, all bulk stores on
   a cyclic priority group, and all CPUs on a cyclic priority group.
   This can only be done if the ranges of ports within each group
   do not overlap.  The following checks for overlap.  */


	substr (iom_ports, iom_low_port + 1, iom_high_port - iom_low_port + 1) =
	     substr (ALL_ONES, 1, iom_high_port - iom_low_port + 1);
	substr (cpu_ports, cpu_low_port + 1, cpu_high_port - cpu_low_port + 1) =
	     substr (ALL_ONES, 1, cpu_high_port - cpu_low_port + 1);

	if (iom_ports & cpu_ports) = ""b		/* no overlap				*/
	then do;
	     call set_cycle_group (iom_low_port, iom_high_port);
	     call set_cycle_group (cpu_low_port, cpu_high_port);
	     scs$set_cycle_switches = "1"b;
	     do i = 0 to hbound (scs$controller_data, 1); /* set switches on all active SCUs		*/
		if scs$controller_data (i).online then call scr_util$set_cfg (bin (i));
	     end;
	     end;
	else do;					/* cannot set switches			*/
	     scs$set_cycle_switches = "0"b;
	     call syserr (ANNOUNCE,
		"scs_init: CPU/IOM port range overlap. Using manual settings for cycle port priority.");
	     end;

	return;
%page;
/* SET_CYCLE_GROUP - internal procedure to setup cfg bits for a cycle (anti-hog)
   group											*/

set_cycle_group:
     proc (low_port, high_port);

dcl  low_port fixed bin;
dcl  high_port fixed bin;

dcl  middle_port fixed bin;


	if high_port <= low_port then return;
	if high_port - low_port > MAX_CYCLE_GROUP then do;/* too many for one group			*/
	     middle_port = low_port + divide (high_port - low_port - 1, 2, 17);
						/* split evenly, with larger group higher */
	     call set_cycle_group (low_port, middle_port);
	     call set_cycle_group (middle_port + 1, high_port);
	     end;
	else substr (scs$cycle_priority_template, low_port + 1, high_port - low_port) =
		substr (ALL_ONES, 1, high_port - low_port);

     end set_cycle_group;
%page;
%include collection_1_phases;
%page;
%include config_mem_card;
%page;
%include config_cpu_card;
%page;
%include iom_data;
%page;
dcl  ptp pointer;
%include "ptw.l68";
%page;
%include rcerr;
%page;
%include rsw;
%page;
%include scr;
%page;
%include scs;
%page;
%include sdw_info;
%page;
%include syserr_constants;
%page;
/* BEGIN MESSAGE DOCUMENTATION

   Message:
   scas_init: Illegal tag on CPU config card.

   S:	$crash

   T:	$init

   M:	One or more CPU cards is incorrect. Tag must be one of A, B, C, D, E, F, G, H.

   A:	Correct the configuration or the configuration deck, and reboot.


   Message:
   scas_init: CPU X appears twice in config deck.

   S:	$crash

   T:	$init

   M:	The configuration deck is incorrect.

   A:	Correct the the configuration deck and reboot.


   Message:
   scas_init: Config card for bootload CPU indicates unit is offline.

   S:	$crash

   T:	$init

   M:	The configuration deck is incorrect.

   A:	Correct the configuration or the configuration deck, and reboot.


   Message:
   scas_init: Config card for CPU X is neither on nor off.

   S:	$crash

   T:	$init

   M:	The configuration deck is incorrect.

   A:	Correct the the configuration deck and reboot.


   Message:
   scas_init: No CPU config card.

   S:	$crash

   T:	$init

   M:	The configuration deck is incorrect.

   A:	Correct the the configuration deck and reboot.


   Message:
   scas_init: No config card for bootload CPU.

   S:	$crash

   T:	$init

   M:	The configuration deck is incorrect.

   A:	Correct the configuration or the configuration deck, and reboot.


   Message:
   scas_init: Illegal tag on MEM config card.

   S:	$crash

   T:	$init

   M:	The configuration deck is incorrect. Tag must be one of A, B, C, D, E, F, G, H.

   A:	Correct the the configuration deck and reboot.

   Message:
   "scas_init:  MEM Y. Tags greater than "D" not supported by DPS8 CPUs",

   S:	$crash

   T:	$init

   M:	The physical configuration or the configuration deck is incorrect. DPS8 CPUs
   have only 4 memory ports, therefore Multics systems comprised of DPS8 cpus or
   mixed systems of DPS, L68 and DPS8 cpus can only have 4 memories configured.
   (i.e. Memory tags A, B, C, and D).

   A:	Correct the physical configuration and/or the configuration deck and reboot.


   Message:
   scas_init: MEM Y appears twice in config deck.

   S:	$crash

   T:	$init

   M:	The configuration deck is incorrect.

   A:	Correct the the configuration deck and reboot.


   Message:
   scas_init: Config card for MEM Y is neither on nor off.

   S:	$crash

   T:	$init

   M:	The configuration deck is incorrect.

   A:	Correct the the configuration deck and reboot.


   Message:
   scas_init: More than one low-order MEM.

   S:	$crash

   T:	$init

   M:	The configuration deck is incorrect.

   A:	Correct the the configuration deck and reboot.


   Message:
   scas_init: Config card for bootload MEM indicates unit is offline.

   S:	$crash

   T:	$init

   M:	The configuration deck is incorrect.

   A:	Correct the the configuration deck and reboot.


   Message:
   scas_init: MEM X is not enabled.

   S:	$crash

   T:	$init

   M:	The bootload CPU does not have MEM X enabled.

   A:	Correct the configuration or the configuration deck, and reboot.


   Message:
   scas_init: Size too large on config card for MEM Y.

   S:	$crash

   T:	$init

   M:	Either the PORT SIZE plug on the free edge of the PQ board
   of the bootload CPU does not agree with the configuration deck, or the
   actual amount of memory present in MEM Y does not agree with the
   config deck.


   A:	Correct the configuration or the configuration deck, and reboot.


   Message:
   scas_init: MEM Y has more memory than indicated by CPU switches.

   S:	$crash

   T:	$init

   M:	The PORT SIZE plug on the free edge of the PQ board
   of the bootload CPU does not agree with the STORE SIZE switch on MEM Y.

   A:	Correct the configuration and reboot.


   Message:
   scas_init: MEM Y has duplicate mask assignments to CPU X.

   S:	$crash

   T:	$init

   M:	The EXECUTE INTERRUPT MASK ASSIGNMENT
   or MASK/PORT ASSIGNMENT on memory Y is incorrect.

   A:	Correct the configuration and reboot.


   Message:
   scas_init: MEM Y has no mask assigned to CPU X.

   S:	$crash

   T:	$init

   M:	The EXECUTE INTERRUPT MASK ASSIGNMENT
   or MASK/PORT ASSIGNMENT on memory Y is incorrect.

   A:	Correct the configuration and reboot.


   Message:
   scas_init: MEM Y address assignment disagrees with config deck.

   S:	$crash

   T:	$init

   M:	The address assignment of memory Y, as read from the
   address assignment switches on the maintenance panel of the bootload CPU,
   disagrees with the address assignment
   of this memory as indicated by the relative position of its MEM card in
   the configuration deck.

   A:	If the configuration deck is wrong, correct it and reboot. If the
   configuration deck is correct, check all address assignment
   switches on processors, IOMs, and the Bulk Store Controller, correct them,
   reboot bce, and reboot.

   Message:
   scas_init: MEM Y has mask Z assigned to non-processor port.

   S:	$crash

   T:	$init

   M:	The EXECUTE INTERRUPT MASK ASSIGNMENT
   or MASK/PORT ASSIGNMENT on memory Y is incorrect.

   A:	Correct the configuration and reboot.


   Message:
   scas_init: MEM Y is not in PROGRAM mode.

   S:	$crash

   T:	$init

   M:	The MODE switch for memory Y is incorrect.

   A:	Correct the configuration and reboot.


   Message:
   scas_init: No MEM config card.

   S:	$crash

   T:	$init

   M:	The configuration deck is incorrect.

   A:	Correct the the configuration deck and reboot.


   Message:
   scas_init: No config card for bootload MEM

   S:	$crash

   T:	$init

   M:	The configuration deck is incorrect.

   A:	Correct the the configuration deck and reboot.


   Message:
   scas_init: Possible memory address overlap in MEM Y.

   S:	$crash

   T:	$init

   M:	This indicates that the lower store size does not agree with
   the actual memory available in the store unit.  A possible example
   of this is when the lower store is actually in two store units
   (A and A1) and the secondary unit (A1) is not enabled.

   A:	Correct the configuration and reboot.


   Message:
   scas_init: CPU config card specifies wrong controller port number.

   S:	$crash

   T:	$init

   M:	The configuration deck is incorrect.

   A:	Correct the configuration or the configuration deck, and reboot.


   Message:
   scas_init: Bootload CPU has no system controller mask assigned.

   S:	$crash

   T:	$init

   M:	No memory assigns a mask register to the bootload CPU.

   A:	Correct the configuration and reboot.


   Message:
   scas_init: MEM Y is not in the configuration, but is enabled by the CPU switches.

   S:	$crash

   T:	$init

   M:	The bootload CPU enables memory Y.
   But there is no MEM card for this memory.

   A:	Correct the configuration or the configuration deck, and reboot.


   Message:
   scas_init: Illegal expander subport tag on CPU X config card.

   S:	$crash

   T:	$init

   M:	A CPU config card, for CPU X, specifies an illegal value
   for a port-expander subport.  The only legal values for
   expander subports are A, B, C, and D.

   A:	Correct the config deck and reboot.


   Message:
   scas_init: Bootload CPU may not be on an expander port.

   S:	$crash

   T:	$init

   M:	The CPU config card for the bootload CPU indicates
   that the bootload CPU is on an expanded port.  This is not
   permitted.

   A:	Correct the configuration or the configuration deck, and reboot.

   Message:
   scas_init: SCU port P configured as both expanded and non-expanded.

   S:	$crash

   T:	$init

   M:	CPU configuration cards imply that Port P on SCU's
   (P is the port number, from 0 to 7) is both an expander port
   (by being named as the CPU port in a CPU card with an
   expander_port field), and not an expander port (by being named
   in one that has none).

   A:	Correct the configuratin deck and reboot.

   Message:
   scas_init: CPU X and CPU Y both configured for port P subport S

   S:	$crash

   T:	$init

   M:	The CPU CONFIG cards for CPU's X and Y both indicate that
   they are connected to subport S of expanded SCU port P.
   This is clearly impossible.

   A:	Correct the configuration deck and reboot.

   Message:
   scas_init: MEM X is an old SCU with port expander

   S:	$crash

   T:	$init

   M:	System controller X is an old-style SCU, but configuration cards
   indicate that it has at least one expanded port, because there is
   a CPU on an expanded port in the system.  Old-style system controllers
   may not have expanded ports.

   A:	The configuration deck is in error. Fix it and reboot.

   Message:
   scs_init: CPU/IOM port range overlap. Using manual settings for cycle port priority.

   S:     $info

   T:	$init

   M:	The cycle port priority on the SCUs cannot be set optimally because
   the range of port numbers for CPUs and IOMs overlap.  The
   manual settings of the cycle port priority switches on the SCUs will
   be used instead.  The system may experience problems as a result, with
   the typical symptom being op-not-complete faults at random times
   by CPUs with higher port numbers (lower SCU port priority).

   A:     Continue to operate the system normally, but consult with
   Field Engineering personnel.  If possible, the system should be
   reconfigured so that the range of port numbers of IOMs
   and CPU do not overlap.  Further, CPU should be on higher-numbered
   ports than IOMs and Bulk Stores.

   Message:
   scas_init: CPU data switches are XXXXXXXXXXXX, should be YYYYYYYYYYYY

   S:     $info

   T:	$init

   M:	The CPU data switches are not set properly. The proper values are
   displayed.

   A:     The incorrect value will prevent returning to bce on that CPU
   by means of EXECUTE SWITCHES. Certain incorrect values will activate
   software debugging traps. The switches should be corrected. This
   can be done while the CPU is running.


   END MESSAGE DOCUMENTATION */

     end scas_init;




		    scs_and_clock_init.pl1          11/11/89  1107.2rew 11/11/89  0816.1      128214



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */




/****^  HISTORY COMMENTS:
  1) change(86-05-13,GJohnson), approve(86-05-13,MCR7387),
     audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056):
     Correct error message documentation.
  2) change(87-10-19,Farley), approve(88-02-26,MCR7795),
     audit(88-03-03,Fawcett), install(88-03-15,MR12.2-1035):
     Changed early setting of sys_info$time_zone and constant to a default
     setting from the MST in sys_boot_info$default_time_zone and constant.
                                                   END HISTORY COMMENTS */


/* format: style2 */

scs_and_clock_init:
     procedure ();

/* *	SCS_AND_CLOCK_INIT
   *
   *	Initialize preliminary scs variables and the Calendar Clock Software.
   *
  *	Modified 11/73, RE Mullen, converted to v2pl1
   *	Modified 02/02/76, Noel I. Morris, for reasons unknown.
  *	Modified 11/28/80 W. Olin Sibert, to check operation of clock (code moved
   *	   from init_pvt), and crash if no CLOK card.
   *	Modified 01/07/81, WOS, to move some initializations from scs.cds to here.
   Modified 9/03/80 by J. A. Bush for the DPS8/70M CPU
   Modified January 1981 by  C. Hornig to init proc. start int. cell.
   Modified January 1982 by J. A. Bush to set RSW2 compare masks for cpu type
   and DPS8M interlace info bits
   Modified April 1982 by J. Bongiovanni to read all switches (0 through 4)
   Cleaned up in '82 for bootload Multics.
   Modified September 1983, Keith Loepere to make early scas paged.
   Modified August 1984, JAFalksen to initialize time_defaults
   Modified January 1985, Keith Loepere, to move date/time powerup into paged
	initialization.
   */

/* Variables */

	dcl     base		 fixed bin (17);	/* base address of controller */
	dcl     early_call		 bit (1) aligned;	/* Whether this is the first time */
	dcl     enabled		 bit (1) aligned;	/* processor port enabled bit */
	dcl     idx		 fixed bin (3);	/* iteration variable */
	dcl     interlace		 fixed bin (3);	/* memory interlace type */
	dcl     lang_index		 fixed bin;	/* for looking up time zone */
	dcl     malfunction		 char (40) varying; /* A complaint about the clock */
	dcl     max_scu		 fixed bin;	/* max number of SCUs - 1 -- depends on sys type */
	dcl     new_scas_sdw	 fixed bin (71);
	dcl     old_scas_sdw	 fixed bin (71);
	dcl     port		 fixed bin (3);	/* bootload processor port */
	dcl     size		 fixed bin (17);	/* size of controller */
	dcl     scs_size		 fixed bin;
	dcl     1 sdwi		 aligned like sdw_info;
	dcl     time_later		 fixed bin (71);	/* For checking the clock */
	dcl     time_now		 fixed bin (71);	/* For checking the clock */
	dcl     zone_index		 fixed bin;	/* for looking up time zone */

/* Based */

	dcl     based_scs		 (scs_size) bit (36) aligned based;
						/* Overlay for clearing */

/* Entries */

	dcl     absadr		 entry (ptr, fixed bin (35)) returns (fixed bin (26));
	dcl     config_$find	 entry (char (4) aligned, ptr);
	dcl     date_time_$set_time_defaults
				 entry;
	dcl     mask_instruction$ldaq	 entry returns (bit (36) aligned);
	dcl     mask_instruction$staq	 entry returns (bit (36) aligned);
	dcl     pmut$rsw		 entry (fixed bin, bit (36) aligned);
	dcl     pmut$swap_sdw	 entry (pointer, pointer);
	dcl     prds_init		 entry (ptr, fixed bin (3), ptr);
	dcl     ptw_util_$make_core	 entry (ptr, fixed bin (26));
	dcl     rsw_util$port_info	 entry (fixed bin (3), bit (1) aligned, fixed bin (17), fixed bin (17),
				 fixed bin (3));
	dcl     scr_util$read_cfg	 entry (fixed bin (3));
	dcl     sdw_util_$construct	 entry (pointer, pointer);
	dcl     syserr		 entry options (variable);

/* External */

	dcl     dseg$		 (0:1023) fixed bin (71) external static;
	dcl     prds$		 fixed bin external static;
	dcl     prds$simulated_mask	 fixed bin (71) external static;
	dcl     scas$		 fixed bin external static;
	dcl     scs$end_of_scs	 fixed bin external static;
	dcl     scs$start_of_scs	 fixed bin external static;
	dcl     sys_boot_info$default_time_zone
				 char (4) unaligned external static;
	dcl     sys_boot_info$default_time_zone_delta
				 fixed bin (71) external static;
	dcl     sys_info$clock_	 bit (36) aligned external static;
	dcl     sys_info$time_correction_constant
				 fixed bin (71) external static;
	dcl     sys_info$time_zone	 char (4) aligned external static;

/* Constants */

	dcl     WHOAMI		 char (32) internal static init ("scs_and_clock_init");

/* Misc */

	dcl     (addr, baseno, binary, bit, clock, length, null, unspec, wordno)
				 builtin;
%page;

/* This entrypoint does no less than the normal entrypoint -- in fact, a bit */
/* more. It fills in the port on the CPU config card. */

scs_and_clock_init$early:
     entry ();

	early_call = "1"b;
	goto INIT_COMMON;


scs_and_clock_init$normal:
     entry ();

	early_call = "0"b;
	goto INIT_COMMON;

INIT_COMMON:					/* First, initialize data in the SCS. This used to be done by scs.cds
   when the segment was created, but now that it gets created more than once,
   this data must be set each time.
   */
	scs_size = wordno (addr (scs$end_of_scs)) - wordno (addr (scs$start_of_scs)) + 1;
	unspec (addr (scs$start_of_scs) -> based_scs) = ""b;
						/* Clear it out */

	scs$idle_aptep (*) = null ();

	do port = 0 to 7;
	     scs$port_addressing_word (port) = bit (binary (port, 3));
	end;
%page;

/* Next, figure out some things about our CPU, necessarily the bootload CPU */
/* Read switches 1 and 2 into the scs safestore area, to be later used by scas_init */

	call pmut$rsw (0, scs$processor_switch_data (0));
	call pmut$rsw (1, scs$processor_switch_data (1));
	call pmut$rsw (2, scs$processor_switch_data (2));

/* Get our processor tag (necessarily the bootload CPU) from switches. */

	rswp = addr (scs$processor_switch_data (2));	/* Set pointer to info. */
	scs$bos_processor_tag = dps_rsw_2.cpu_num;	/* Remember our CPU tag. */
	if dps8_rsw_2.cpu_type > 0
	then /* if DPS8 CPU... */
	     max_scu = 3;				/* can be only 4 scus */
	else do;					/* DPS or L68 CPU */
		max_scu = 7;			/* 8 possible SCUs */

/* read switches 3 and 4 if DPS or L68 CPU */

		call pmut$rsw (3, scs$processor_switch_data (3));
		call pmut$rsw (4, scs$processor_switch_data (4));
	     end;

	if early_call
	then do;					/* Make a CPU card */
		cpu_cardp = null ();
		call config_$find (CPU_CARD_WORD, cpu_cardp);
						/* Guaranteed to be there */

		cpu_card.tag = scs$bos_processor_tag + 1;
	     end;

	call prds_init (addr (prds$), scs$bos_processor_tag, null ());
						/* Fill in variables in the prds, too. */
	rswp = addr (scs$processor_switch_mask (2));	/* Get pointer to mask for checking processor switches. */
	dps_rsw_2.fault_base = "1111111"b;		/* Compare the fault base switches. */
	dps_rsw_2.cpu_num = 7;			/* Compare the processor number. */
	dps_rsw_2.cpu_type = 3;			/* Compare cpu types */
	dps8_rsw_2.interlace_info (*) = "1"b;		/* and dps8 interlace bits */
%page;

/* Initialize controller mask instructions and pointers. */

	do port = 0 to 7;				/* Set up dummy read and set mask instructions. */
	     scs$read_mask (port) = mask_instruction$ldaq ();
	     scs$set_mask (port) = mask_instruction$staq ();
	     scs$mask_ptr (port) = addr (prds$simulated_mask);
						/* Set pointer to dummy mask. */
	end;					/* Set up processor start interrupt for cell 0 */

	scs$processor_start_int_no = 0;
	scs$processor_start_pattern = "400000000000"b3;
	scs$processor_start_mask = "400000000000000000000000"b3;

	scs$number_of_masks = 3;


/* Find the low-order system controller. */

	do port = 0 to max_scu;			/* Search for low-order controller. */
	     call rsw_util$port_info (port, enabled, base, size, interlace);
						/* Get info for this processor port. */
	     if enabled & (base = 0)
	     then do;				/* If this is low-order port ... */
		     scs$interrupt_controller = port;	/* Save the port number. */
		     sys_info$clock_ = bit (scs$interrupt_controller);
						/* Set indirect word for reading clock. */
		     goto FOUND_LOW_SCU;		/* Now we can use the clock builtin with impunity, */
		end;				/* since sys_info contains appropriate defaults for */
	end;					/* time_correction_constant (zero, that is) */

	call syserr (CRASH, "^a: No SCU port is assigned address zero.", WHOAMI);

FOUND_LOW_SCU:
	if early_call
	then do;					/* Fix up the MEM card */

/* We must make the SCAS pseudo-operative in order to be able to call scr_util 
   to find out about ports. To this end, we make its SDW temporarily describe 
   the first (max_scu + 1) pages of memory, by simply constructing an SDW for 
   it. */

		unspec (sdwi) = ""b;
		sdwi.flags.paged = "1"b;
		sdwi.size = 1024 * (max_scu + 1);
		sdwi.read = "1"b;
		sdwi.write = "1"b;
		sdwi.address = absadr (addr (scs$scas_page_table), (0));
		do idx = 0 to max_scu;
		     call ptw_util_$make_core (addr (scs$scas_page_table (idx)), idx * 1024);
		end;
		call sdw_util_$construct (addr (new_scas_sdw), addr (sdwi));

		old_scas_sdw = dseg$ (binary (baseno (addr (scas$)), 18));
		call pmut$swap_sdw (addr (scas$), addr (new_scas_sdw));

		mem_cardp = null ();
		call config_$find (MEM_CARD_WORD, mem_cardp);
						/* Guaranteed to be there */
		mem_card.tag = 1 + port;

		call scr_util$read_cfg (port);	/* Initialize its info */
		cpu_card.port = scs$controller_data (port).mask_assignment (1);

		unspec (scs$controller_data (port)) = ""b;
						/* Clear it out to avoid confusing */
		unspec (scs$cfg_data (port)) = ""b;	/* scas_init later on */

		call pmut$swap_sdw (addr (scas$), addr (old_scas_sdw));
						/* Restore the old SDW */
	     end;
%page;
	if sys_info$collection_1_phase = SERVICE_INITIALIZATION
	then do;
		time_now = clock ();		/* Prepare to see whether the clock is working */
		do idx = 1 to 10 while (7 ^= 3);	/* Waste a few microseconds */
		end;

		time_later = clock ();

		malfunction = "";			/* Figure out what to say about it */
		if time_later < time_now
		then malfunction = "is running backwards!";
		else if time_later = time_now
		then malfunction = "is stopped.";
		else if time_later < (time_now + 10)
		then /* Must take at least ten microseconds */
		     malfunction = "is running too slowly.";
		else if time_later > (time_now + 1000)
		then /* And not more than 1000 */
		     malfunction = "is running too fast.";

		if length (malfunction) > 0
		then call syserr (CRASH, "^a: SCU clock on port ^o ^a.", WHOAMI, scs$interrupt_controller,
			malfunction);
	     end;

/* Set up the clock with default data.  The correct time zone gets set later. */

	sys_info$time_zone = sys_boot_info$default_time_zone;
	sys_info$time_correction_constant = sys_boot_info$default_time_zone_delta;

	return;					/* init_clocks will later set all the clocks */
%page;
date_time:
     entry;

/* set up the date time software. */


/* Now set up the rest of the info for clock reading */

	clok_cardp = null ();
	call config_$find (CLOK_CARD_WORD, clok_cardp);	/* Look for CLOK config card. */
	if clok_cardp = null ()
	then if sys_info$collection_1_phase = SERVICE_INITIALIZATION
	     then call syserr (CRASH, "^a: No CLOK card.", WHOAMI);
	     else do;
		     sys_info$time_zone = sys_boot_info$default_time_zone;
		     sys_info$time_correction_constant = sys_boot_info$default_time_zone_delta;
		end;
	else do;
		sys_info$time_zone = clok_card.zone;	/* use values from config card */
		do lang_index = 1 to ti_zone.number_lang;
		     do zone_index = 1 to ti_zone.number_zone;
			if ti_zone.short (lang_index, zone_index) = clok_card.zone
			then go to found_zone;
		     end;
		end;
		call syserr (CRASH, "^a: The zone on the CLOK card is not in time_info_.", WHOAMI);
found_zone:
		sys_info$time_correction_constant = ti_zone.delta (lang_index, zone_index);
	     end;

	call date_time_$set_time_defaults;		/* power up! */
	return;

/* format: off */
%page; %include collection_1_phases;
%page; %include config_clok_card;
%page; %include config_cpu_card;
%page; %include config_mem_card;
%page; %include rsw;
%page; %include scs;
%page; %include sdw_info;
%page; %include syserr_constants;
%page; %include time_names;
/* format: on */

/* BEGIN MESSAGE DOCUMENTATION

Message:
scs_and_clock_init: No SCU port is assigned address zero.

S:        $crash

T:        $init

M:        None of the system controllers in the config deck appear
to have a base address of zero.

A:        Check the config deck and bootload processor port assignment
and address switches.


Message:
scs_and_clock_init: SCU clock on port NUMBER MALFUNCTION.

S:        $crash

T:        $init

M:        The calendar clock in the bootload SCU seems to be
malfunctioning, as specified by MALFUNCTION.

A:        Fix the SCU, or configure another SCU as low order.

Message:
scs_and_clock_init: No CLOK card.

S:        $crash

T:        $init

M:        No CLOK card was found in the config deck. One is required.

A:        Add a CLOK card to the config deck.

Message:
scs_and_clock_init: The zone on the CLOK card is not in time_info_.

S:        $crash

T:        $init

M:        The zone named on the CLOK card is not found in time_info_, the
system's time information database.  The system cannot run
unless a known zone is specified.

A:        Update the CLOK card so that it contains a proper zone name.  If
the zone you need is not known to the system, time_info_.cds
will have to be updated, a new system tape generated, and then
booting from that tape.  time_info_ contains at least 1 name for
each hour around the world.  You may select a named zone near
the one you need, just to get the system up to be able to change
time_info_.
  
END MESSAGE DOCUMENTATION */

     end scs_and_clock_init;




		    set_smic_pattern.pl1            11/11/89  1107.2r w 11/11/89  0807.4       14265



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */
/* SET_SMIC_PATTERN - Procedure to Create SMIC Patttern from Interrupt Cell Number.
	coded 8/26/74 by Noel I. Morris	*/


/* ******************************************************
   *                                                    *
   *                                                    *
   * Copyright (c) 1972 by Massachusetts Institute of   *
   * Technology and Honeywell Information Systems, Inc. *
   *                                                    *
   *                                                    *
   ****************************************************** */


set_smic_pattern: proc (cell) returns (bit (36) aligned);

dcl  cell fixed bin (5);				/* interrupt cell number */


dcl  smic_word bit (36) aligned;			/* SMIC pattern */

dcl (mod, substr) builtin;


		/*  */

	smic_word = "0"b;				/* Clear pattern initially. */
	substr (smic_word, mod (cell, 16) + 1, 1) = "1"b;	/* Turn on appropriate bit. */
	substr (smic_word, 36, 1) = (cell >= 16);	/* Set low-order bit appropriately. */

	return (smic_word);				/* Return completed pattern. */


     end set_smic_pattern;




		    tape_reader.pl1                 11/11/89  1107.2rew 11/11/89  0816.1       69219



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */




/****^  HISTORY COMMENTS:
  1) change(86-06-05,GJohnson), approve(86-06-05,MCR7387),
     audit(86-06-10,Martinson), install(86-07-11,MR12.0-1091):
     Correct error message documentation.
                                                   END HISTORY COMMENTS */


/* TAPE_READER - Multics Standard Tape Reading Procedure for Initialization.
	recoded into PL/1 - 8/27/73 by N. I. Morris			*/
/* BIM 7/82 tape_io renamed to boot_tape_io */

tape_reader: proc (p, n);

	dcl     p			 ptr,		/* pointer to target data buffer */
	        n			 fixed bin (18);	/* # of words to read */

	dcl     (cur_p, cur_dp, cur_tp) ptr,		/* ptrs to current record header, data, trailer */
	        exprec		 fixed bin (18),	/* next expected record number */
	        datap		 ptr,		/* ptr to current position in target data */
	        count		 fixed bin (18),	/* # of words remaining to be transferred */
	        words_left		 fixed bin (18),	/* # of words remaining in tape buffer */
	        copy_words		 fixed bin (18),	/* # of words to be copied */
	        nrecs		 fixed bin,	/* # of records read before good record encountered */
	        retries		 fixed bin,	/* # of times tape backspaced to retry */
	        majstat		 fixed bin (5),	/* major status from tape I/O operation */
	        checksum		 bit (36) aligned,	/* tape record checksum */
	        i			 fixed bin;	/* iteration variable */

	dcl     tape_count		 fixed bin static;	/* count of tape drives used */

	dcl     data		 (copy_words) fixed bin (35) based; /* structure for copying data */

	dcl     1 physical_record_buffer$ ext,		/* physical record buffer */
	        ( 2 index		 fixed bin (17),	/* index into current buffer */
		2 pad		 fixed bin (17)) unal,
		2 cur_rec		 (1040) fixed bin;	/* current record */

	dcl     (addr, addrel, divide, min, substr) builtin;

	dcl     syserr		 ext entry options (variable),
	        (boot_tape_io$read,
	        boot_tape_io$backspace,
	        boot_tape_io$rewind,
	        tape_checksum_	 entry (ptr, ptr),
	        (boot_tape_io$init_tape,
	        boot_tape_io$final_tape)) entry;


%include mstr;



/*  */

	datap = p;				/* Get pointer to data target. */
	count = n;				/* Get # of words to be read. */

	cur_p = addr (physical_record_buffer$.cur_rec);	/* Get pointer to current record header. */
	cur_dp = addr (cur_p -> mstr.data);		/* Get pointer to current record data. */

reader_loop:
	words_left = divide (cur_p -> mstr_header.data_bits_used, 36, 18, 0) - physical_record_buffer$.index;
						/* Compute # of words remaining in tape buffer. */
	if words_left = 0 then do;			/* If current buffer is used up ... */
		cur_tp = addr (cur_p -> mstr.trail);	/* Get a pointer to current record trailer. */
		exprec = cur_tp -> mstr_trailer.tot_rec + 1; /* Compute next expected record number. */
		call get_next_buffer;		/* Refill the record buffer. */
		physical_record_buffer$.index = 0;	/* Reset index to buffer. */
		go to reader_loop;			/* Now use new record. */
	     end;

	copy_words = min (count, words_left);		/* Copy as many words as possible. */
	count = count - copy_words;			/* Decrement count of remaining words to copy. */
	if copy_words > 0 then datap -> data = addrel (cur_dp, physical_record_buffer$.index) -> data;
						/* Copy the data. */
	physical_record_buffer$.index = physical_record_buffer$.index + copy_words;
						/* Increment tape buffer index. */
	datap = addrel (datap, copy_words);		/* Bump the target data pointer. */
	if count > 0 then go to reader_loop;		/* Continue, if any words remaining. */

	return;					/* All finsihed.  Return to caller. */


/*  */

get_next_buffer: proc;


	retries = 0;				/* Initialize retry count. */

retry:	if retries > 64 then /* Give up after 64 tries. */
	     call syserr (1, "tape_reader: Unable to read system tape.");
	nrecs = 0;				/* Initialize record count. */

again:	nrecs = nrecs + 1;				/* Count one record. */

eof:	call do_io (boot_tape_io$read, "001100000010000"b); /* Read a tape record. */
	if majstat ^= 0 then do;			/* If non-zero major status ... */
		if majstat = 3 then /* If device data alert ... */
		     go to again;			/* Try reading again. */
		if majstat = 4 then /* If EOF ... */
		     go to eof;
		if majstat = 11 then /* If MPC device data alert ... */
		     go to again;
	     end;

	if cur_p -> mstr_header.c1 ^= header_c1 | /* Compare check bit patterns. */
	     cur_p -> mstr_header.c2 ^= header_c2 |
	     cur_tp -> mstr_trailer.c1 ^= trailer_c1 |
	     cur_tp -> mstr_trailer.c2 ^= trailer_c2 then
	     go to again;

	call tape_checksum_ (cur_p, addr (checksum));	/* Compute record checksum. */
	if checksum ^= cur_p -> mstr_header.checksum then
	     go to again;				/* Check the checksum. */
	if cur_p -> mstr_header.flags.admin then /* If administrative record ... */
	     go to admin_record;			/* Handle it properly. */
validate:
	if cur_tp -> mstr_trailer.tot_rec < exprec then
	     go to retry;				/* If we backspaced too much. */
	if cur_tp -> mstr_trailer.tot_rec > exprec then
	     go to back_up;				/* If we read too much. */

	return;					/* Record OK.  Return. */


admin_record:
	if cur_p -> mstr_header.flags.eor then /* If end of reel ... */
	     go to validate;
	go to again;				/* Otherwise, ignore as spurious. */


back_up:	retries = retries + 1;			/* Count another attempt. */
	do i = 1 to nrecs + 2;			/* Back the tape up. */
	     call do_io (boot_tape_io$backspace, "000110000000000"b);
	     if majstat = 5 then go to retry;		/* If at BOT, retry reading. */
	end;
	go to retry;

     end get_next_buffer;

/*  */

init: entry;

	call boot_tape_io$init_tape;			/* Initialize tape I/O package. */
	tape_count = 0;				/* Initialize count of tapes. */
	return;					/* Return to caller. */


final: entry;

	call do_io (boot_tape_io$rewind, (15)"0"b);	/* Rewind the last tape. */
	call boot_tape_io$final_tape;			/* Turn off the tape I/O package. */
	return;



do_io: proc (e, s);

	dcl     e			 entry (fixed bin (5)), /* boot_tape_io entry to call */
	        s			 bit (15) aligned;	/* control bits for examining major status */


call:	call e (majstat);				/* Call boot_tape_io routine. */

	if majstat ^= 0 then /* If tape error ... */
	     if majstat >= 16 then /* If power off bit is on ... */
		go to call;			/* Try over again. */
	     else if substr (s, majstat, 1) then /* If control bit on ... */
		return;				/* Let caller handle this. */
	     else if majstat <= 2 then /* If attention or busy ... */
		go to call;			/* Try again. */
	     else /* Otherwise ... */
		call syserr (1, "tape_reader: bad major status = ^o", majstat);

	return;


     end do_io;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   tape_reader: unable to read system tape

   S: $crash

   T: $init

   M: The bootload tape is unreadable.

   A: $boot_tape

   Message:
   tape_reader: bad_major_status: SSS

   S: $crash

   T: $init

   M: The bootload tape is unreadable.

   A: $boot_tape
   Try another tape drive.

   END MESSAGE DOCUMENTATION */

     end tape_reader;




		    bull_copyright_notice.txt       08/30/05  1008.4r   08/30/05  1007.3    00020025

                                          -----------------------------------------------------------


Historical Background

This edition of the Multics software materials and documentation is provided and donated
to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. 
as a contribution to computer science knowledge.  
This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology,
Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull
and Bull HN Information Systems Inc. to the development of this operating system. 
Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970),
renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership
of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for 
managing computer hardware properly and for executing programs. Many subsequent operating systems
incorporated Multics principles.
Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., 
as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. .

                                          -----------------------------------------------------------

Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without
fee is hereby granted,provided that the below copyright notice and historical background appear in all copies
and that both the copyright notice and historical background and this permission notice appear in supporting
documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining
to distribution of the programs without specific prior written permission.
    Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc.
    Copyright 2006 by Bull HN Information Systems Inc.
    Copyright 2006 by Bull SAS
    All Rights Reserved
