



		    disk_reader.pl1                 11/11/89  1138.5rew 11/11/89  0801.1       46872



/****^  ***********************************************************
        *                                                         *
        * 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 */


disk_reader: proc (data_ptr, data_lth);

/* Routine to read a specified number of words from the mst area on disk.
This routine replaces tape_reader as far as segment_loader and load_system
are concerned.
Initially coded October 1983 by Keith Loepere. */

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

dcl  Max_pages		        fixed bin init (256) static options (constant); /* max in a hardware segment */
dcl  addr			        builtin;
dcl  addrel		        builtin;
dcl  data_lth		        fixed bin (18) parameter;/* in words, desired */
dcl  data_ptr		        ptr parameter;	/* to user's area */
dcl  disk_mst_seg$		        external;		/* abs_seg mapped onto mst disk area */
dcl  disk_mst_seg_astep	        ptr static;
dcl  disk_mst_seg_sdw	        fixed bin (71);
dcl  divide		        builtin;
dcl  make_sdw$no_pages	        entry (fixed bin (15), fixed bin (71), ptr, ptr);
dcl  min			        builtin;
dcl  mst_area_left		        fixed bin (26) static;/* number of words left to read */
dcl  next_mst_word		        fixed bin (26) static;/* next word (within disk_mst_seg) to read */
dcl  page_table		        (0:255) bit (36) aligned based (ptp);
dcl  pc$cleanup		        entry (ptr);
dcl  pmut$camp		        entry;
dcl  pmut$swap_sdw		        entry (ptr, ptr);
dcl  ptp			        ptr static;		/* to page table for disk_mst_seg */
dcl  ptw_num		        fixed bin;		/* loop counter */
dcl  ptw_util_$make_disk	        entry (ptr, fixed bin (20));
dcl  pvt$root_pvtx		        fixed bin external;
dcl  segno		        builtin;
dcl  start_partition_record	        fixed bin (20) static;/* first record described by disk_mst_seg */
dcl  sys_boot_info$bce_part_frec      fixed bin (20) external;
dcl  sys_boot_info$bce_part_nrec      fixed bin (20) external;
dcl  sys_boot_info$mst_past_bce_frec  fixed bin (20) external;
dcl  syserr		        entry options (variable);
dcl  user_area		        (user_area_lth) bit (36) aligned based (user_area_ptr);
dcl  user_area_lth		        fixed bin (18);
dcl  user_area_ptr		        ptr;
dcl  user_data_lth		        fixed bin (18);	/* space needed yet */

	if mst_area_left < data_lth then call syserr (CRASH, "disk_reader: Attempt to read past end of mst area.");

	user_area_ptr = data_ptr;
	user_data_lth = data_lth;
	do while (user_data_lth > 0);
	     user_area_lth = min (user_data_lth, Max_pages * 1024 - next_mst_word);
	     user_area = addrel (addr (disk_mst_seg$), next_mst_word) -> user_area;
	     user_data_lth = user_data_lth - user_area_lth;
	     user_area_ptr = addrel (user_area_ptr, user_area_lth);
	     mst_area_left = mst_area_left - user_area_lth;
	     next_mst_word = next_mst_word + user_area_lth;
	     if next_mst_word = Max_pages * 1024 then do;
		call pc$cleanup (disk_mst_seg_astep);
		call advance_mst_seg;
	     end;
	end;
	return;
%page;
init: entry;

/* Initially set up disk_mst_seg onto the mst area of disk. */

	call make_sdw$no_pages (segno (addr (disk_mst_seg$)), disk_mst_seg_sdw, disk_mst_seg_astep, ptp);
	disk_mst_seg_astep -> aste.pvtx = pvt$root_pvtx;
	call pmut$swap_sdw (addr (disk_mst_seg$), addr (disk_mst_seg_sdw));
	start_partition_record = sys_boot_info$mst_past_bce_frec - Max_pages;
	mst_area_left = (sys_boot_info$bce_part_frec + sys_boot_info$bce_part_nrec - sys_boot_info$mst_past_bce_frec) * 1024;
	next_mst_word = 0;
	call advance_mst_seg;
	return;
%page;
final: entry;

/* free disk_mst_seg */

	call pc$cleanup (disk_mst_seg_astep);	/* free coremap entries */
	disk_mst_seg_sdw = 0;
	call pmut$swap_sdw (addr (disk_mst_seg$), addr (disk_mst_seg_sdw));
	return;
%page;
advance_mst_seg: proc;

/* Map the disk_mst_seg onto the next set of pages in the mst area. */

	start_partition_record = start_partition_record + Max_pages;
	next_mst_word = 0;
	do ptw_num = 0 to min (Max_pages, divide (mst_area_left + 1023, 1024, 20)) - 1;
	     call ptw_util_$make_disk (addr (page_table (ptw_num)), start_partition_record + ptw_num);
	end;
	call pmut$camp;
	return;
     end;
%page; %include aste;
%page; %include bce_partition_layout;
%page; %include syserr_constants;
%page;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   disk_reader: Attempt to read past end of mst area.

   S: $crash

   T: $init

   M: An attempt was made to read more data from the mst area of disk than was
   placed there from the MST.  This is most likely the result of an MST
   misformed originally.

   A: $recover
   $boot_tape

   END MESSAGE DOCUMENTATION */

     end;




		    hc_load_mpc.pl1                 11/11/89  1138.5rew 11/11/89  0800.0      218691



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

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

hc_load_mpc: procedure (MPC_chanid, FW_seg_ptr, FW_seg_length, Reason, Code);

/* HC_LOAD_MPC -- given a chanid and firmware segment, */
/*                use io_manager or IOI to boot an mpc */
/* Modified for urc support, Keith Loepere 1/84 */
/* Modified for test_controller, Keith Loepere 3/84 */
/* Modified for IMU power off retries, Paul Farley 7/84 */
/* Modified to not hang when supplied a non-existant MPC, Keith Loepere, 3/85 */

/****^  HISTORY COMMENTS:
  1) change(85-09-09,Farley), approve(85-09-09,MCR6979),
     audit(86-02-25,Coppola), install(86-03-21,MR12.0-1033):
     extend POF retries to 20 seconds, (add POF to test_controller entry).
  2) change(86-03-27,Farley), approve(86-07-18,MCR7471),
     audit(86-08-18,Fawcett), install(86-10-20,MR12.0-1189):
     Convert to use IOI when necessary, now that it is at BCE.
  3) change(86-07-07,Farley), approve(86-07-18,MCR7471),
     audit(86-08-18,Fawcett), install(86-10-20,MR12.0-1189):
     Changed to check DAU after firmware load to see if really operational. DAU
     continues to do initialization after good FW load terminate, so OPI may
     not be up yet.
  4) change(86-08-14,Farley), approve(86-10-24,MCR7529),
     audit(86-10-28,Fawcett), install(86-10-28,MR12.0-1200):
     Extended post firmware load status test to ALL DISK MPCs, as it has been
     found that they all have the timing window, but very small.
  5) change(87-05-06,Farley), approve(87-07-07,MCR7725),
     audit(87-07-09,Rauschelbach), install(87-07-15,MR12.1-1041):
     Corrected the placement of port_mask in the io_buffer. Was getting 13/03
     (check sum errors) from the URP MPCs. Also changed the "Data" structure in
     BOOT_SECTION to be zero based, since "fw_seg" is zero based.
  6) change(87-05-29,Farley), approve(87-07-07,MCR7725),
     audit(87-07-09,Rauschelbach), install(87-07-15,MR12.1-1041):
     Changed to only use io_buffer (removed all references to dcw_list). Now
     have IO_buf_data_wds variable to define the size of the io_buffer.
  7) change(88-02-23,Farley), approve(88-02-23,MCR7793),
     audit(88-02-24,Fawcett), install(88-03-01,MR12.2-1029):
     Changed the DISK_MPC procedure to return TRUE if no MPC card is found,
     when the initialization state is 1 (in BCE @ collection 1).  This is
     because very early in the boot cycle there is no MPC card, but a wait is
     still needed for the disk mpc.
                                                   END HISTORY COMMENTS */

dcl  Code				fixed bin (35) parameter;
dcl  FW_seg_length			fixed bin (18) parameter;
dcl  FW_seg_lengths			(*) fixed bin (18) parameter;
dcl  FW_seg_ptr			pointer parameter;
dcl  FW_seg_ptrs			(*) ptr parameter;
dcl  MPC_chanid			char (8) aligned parameter;
dcl  Reason			character (*) parameter;

dcl  EIGHT_PAGES			fixed bin init (8192) static options (constant);
dcl  FIVE_SECOND			fixed bin (71) init (5000000) static options (constant);
dcl  HALF_SECOND			fixed bin (71) init (500000) static options (constant);
dcl  MPCW				character (4) aligned init ("MPCw") internal static options (constant);
dcl  ONE_SECOND			fixed bin (71) init (1000000) static options (constant);
dcl  PRIV				bit (1) aligned init ("1"b) static options (constant);
dcl  TEST_CONTROLLER_EVENT		char (4) init ("tsdc") static options (constant);
dcl  TWENTY_SECOND			fixed bin (71) init (20000000) static options (constant);
dcl  ZERO_PAGES			fixed bin init (0) static options (constant);

dcl  FWID				character (8);
dcl  FWOVERLAY			character (8);
dcl  FWREV			character (8);
dcl  IOI_attached			bit (1);
dcl  IOI_chnl			fixed bin (7);
dcl  IOI_event			fixed bin (71);
dcl  IOI_index			fixed bin;
dcl  IOI_iom			fixed bin (3);
dcl  IOI_pcw			bit (36) aligned;
dcl  IO_buf_data_wds		fixed bin;
dcl  IO_buf_wired			bit (1);
dcl  MPC_name			char (8) aligned;
dcl  astep			pointer;
dcl  control_store_length		fixed bin (18);
dcl  control_store_ptr		pointer;
dcl  event			fixed bin (35);
dcl  finish			fixed bin (71);
dcl  fw_overlay			fixed bin;
dcl  fw_seg_count			fixed bin;
dcl  fw_seg_length			fixed bin (18);
dcl  fw_seg_lengths_ptr		ptr;
dcl  fw_seg_num			fixed bin;
dcl  fw_seg_ptr			ptr;
dcl  fw_seg_ptrs_ptr		ptr;
dcl  groupx			fixed bin;
dcl  1 ima			aligned like io_manager_arg;
dcl  io_buffer_ptr			pointer;
dcl  max_wait			fixed bin (71);
dcl  needs_booting			(2:17) bit (1);	/* overlay for this la hasn't been booted (org of 2 since "la" 1 is main firmware) */
dcl  portx			fixed bin;	/* mpc card port index */
dcl  read_write			bit (1) aligned;
dcl  read_write_length		fixed bin (18);
dcl  read_write_ptr			pointer;
dcl  time				fixed bin (71);

dcl  fw_seg			(0:fw_seg_length) bit (36) based (fw_seg_ptr);
dcl  fw_seg_lengths			(fw_seg_count) fixed bin (18) based (fw_seg_lengths_ptr);
dcl  fw_seg_ptrs			(fw_seg_count) ptr based (fw_seg_ptrs_ptr);
dcl  1 io_buffer			aligned based (io_buffer_ptr),
						/* The ioi workspace */
       2 idcw			bit (36),
       2 dcw			(2) bit (36),
       2 pad			(5) bit (36),
       2 status			like istat,	/* mod-8 */
       2 port_mask			bit (36),		/* Urmpc port mask for device firmware */
						/* NOTE: port_mask must be just prior to data */
       2 data			(IO_buf_data_wds) bit (36);

dcl  absadr			entry (ptr, fixed bin (35)) returns (fixed bin (26));
dcl  bcd_to_ascii_			entry (bit (*), character (*));
dcl  config_$find			entry (char (4) aligned, ptr);
dcl  get_ptrs_$given_segno		entry (fixed bin (15), pointer);
dcl  io_chnl_util$name_to_iom
				entry (char (8) aligned, fixed bin (3), fixed bin (7), fixed bin (35));
dcl  ioa_				entry options (variable);
dcl  ioa_$rsnnl			entry options (variable);
dcl  ioi_assignment$assign
				entry (fixed bin, char (*) aligned, fixed bin (71), bit (1) aligned, fixed bin (35));
dcl  ioi_assignment$unassign
				entry (fixed bin, fixed bin (35));
dcl  ioi_connect			entry (fixed bin, fixed bin (18), fixed bin (35));
dcl  ioi_connect$ioi_connect_pcw	entry (fixed bin, fixed bin (18), bit (36) aligned, fixed bin (35));
dcl  ioi_set$channel_required
				entry (fixed bin, fixed bin (3), fixed bin (7), fixed bin (35));
dcl  ioi_set$max_workspace
				entry (fixed bin, fixed bin (18), fixed bin (35));
dcl  ioi_set$status			entry (fixed bin, fixed bin (18), fixed bin (8), fixed bin (35));
dcl  ioi_set$workspace		entry (fixed bin, ptr, fixed bin (18), fixed bin (35));
dcl  pc_abs$unwire_abs		entry (ptr, fixed bin (9), fixed bin (35));
dcl  pc_abs$wire_abs_contig		entry (ptr, fixed bin (9), fixed bin (9), fixed bin (35));
dcl  pxss$addevent			entry (fixed bin (35));
dcl  pxss$notify			entry;
dcl  pxss$wait			entry;
dcl  syserr			entry options (variable);

dcl  cleanup			condition;

dcl  error_table_$bad_arg		fixed bin (35) external static;
dcl  error_table_$bad_channel		fixed bin (35) external static;
dcl  error_table_$device_not_active	fixed bin (35) external static;
dcl  error_table_$io_no_permission	fixed bin (35) ext static;
dcl  error_table_$seg_not_found	fixed bin (35) ext static;
dcl  error_table_$timeout		fixed bin (35) external static;
dcl  sys_info$initialization_state	fixed bin external static;

dcl  (addr, addrel, baseno, binary, bin, bit, clock, dimension, divide, lbound,
     hbound, max, min, null, rel, size, string, substr, unspec) builtin;
%page;
	fw_seg_count = 1;
	fw_seg_ptrs_ptr = addr (FW_seg_ptr);
	fw_seg_lengths_ptr = addr (FW_seg_length);
	go to join;

urc: entry (MPC_chanid, FW_seg_ptrs, FW_seg_lengths, Reason, Code);

	fw_seg_count = dimension (FW_seg_ptrs, 1);
	fw_seg_ptrs_ptr = addr (FW_seg_ptrs);
	fw_seg_lengths_ptr = addr (FW_seg_lengths);

join:
	Code = 0;
	Reason = "";
	needs_booting (*) = "1"b;

/***** ATTACH THE MPC ******/

	unspec (ima) = ""b;
	unspec (event) = unspec (MPCW);
	ima.ptp, ima.dcw_pair_ptr = null;
	io_buffer_ptr = null;
	IOI_attached = "0"b;
	IOI_pcw = ""b;
	IO_buf_wired = ""b;
	IO_buf_data_wds = EIGHT_PAGES;		/* Most that can be loaded with 2 DCW's */
	on cleanup call CLEANUP;

	call io_manager$assign (ima.chx, MPC_chanid, pxss$notify, event, io_status_word_ptr, Code);
	if Code ^= 0 then
	     if Code = error_table_$io_no_permission then do; /* iom_data.per_device.in_use = "1"b */
		call IOI_ATTACH;
		if Code ^= 0 then return;
		IOI_attached = "1"b;
	     end;
	     else return;

	if IOI_attached then pcwp = addr (IOI_pcw);
	else pcwp = addr (ima.pcw);
	pcw.code = "7"b3;
	pcw.mask = "1"b;
	pcw.control = "11"b;

	if ^IOI_attached then do;
	     allocate io_buffer set (io_buffer_ptr);
	     if sys_info$initialization_state > 1 /* guaranteed A-W-C in collection 1 */ then do;
		call get_ptrs_$given_segno (binary (baseno (io_buffer_ptr), 15), astep);
		call pc_abs$wire_abs_contig (astep, divide (bin (rel (io_buffer_ptr), 18), 1024, 9, 0),
		     divide (1023 + size (io_buffer), 1024, 9, 0), Code);
		if Code ^= 0 then call syserr (CRASH, "hc_load_mpc: Could not abs_wire buffer.");
		IO_buf_wired = "1"b;
	     end;
	end;

	unspec (io_buffer) = ""b;

	idcwp = addr (io_buffer.idcw);
	idcw.code = "7"b3;
	idcw.chan_cmd = "02"b3;

	if IOI_attached then call IOI_DC_RESET;
	else do;
	     ima.listp = addr (io_buffer.idcw);

	     call CONNECT_NO_WAIT;			/* we get no status back */
	end;

/* Now we need to spin for a second. How long is that ? */

	finish = clock () + ONE_SECOND;		/* set 1 sec timer */
	max_wait = clock () + TWENTY_SECOND;		/* set 20 second timer */

	do while (clock () < finish);			/* TickTock */
	end;

/**** So much for the DC_RESET/BTLT phase */

	do fw_seg_num = 1 to fw_seg_count;
	     fw_seg_ptr = fw_seg_ptrs (fw_seg_num);
	     fw_seg_length = fw_seg_lengths (fw_seg_num);
	     if fw_seg_ptr = null then go to next_overlay;

	     if fw_seg (fw_seg_length) ^= MPCBOT /* small gullibility check */ then do;
		Code = error_table_$bad_arg;		/* ?? */
		go to RETURN;
	     end;

/**** the - 1, in the following line, is there since we are starting
      at the last word of the structure, not the word afterwards */

	     trailer_ptr = addrel (addr (fw_seg (fw_seg_length)), -(size (fw_trailer) - 1));

	     unspec (io_buffer) = ""b;

	     control_store_ptr = fw_seg_ptr;
	     if fw_seg_num > 1 then do;		/* urc overlays */
		if ^needs_booting (fw_seg_num) then go to next_overlay;
		io_buffer.port_mask = "0"b;
		do fw_overlay = fw_seg_num to fw_seg_count;
		     if needs_booting (fw_overlay) & (fw_seg_ptr = fw_seg_ptrs (fw_overlay)) then do;
			substr (io_buffer.port_mask, fw_overlay, 1) = "1"b; /* this la uses this overlay */
			needs_booting (fw_overlay) = "0"b;
		     end;
		end;
		control_store_length = fw_seg_length - 9;
		read_write_ptr = null;
		read_write = "0"b;
	     end;
	     else if fw_trailer.rw_start = 0 then do;
		control_store_length = fw_seg_length - 9;
		read_write_ptr = null;
		read_write = "0"b;
	     end;
	     else do;
		read_write = "1"b;
		control_store_length = fw_trailer.rw_start;
		read_write_ptr = addr (fw_seg (fw_trailer.rw_start));
		read_write_length = fw_seg_length - fw_trailer.rw_start - 9; /* -10 + 1, actually */
	     end;

/* We will assume correct checksum in this implementation. */

	     call bcd_to_ascii_ (fw_trailer.id_name, FWID);
	     call bcd_to_ascii_ (fw_trailer.rev_level, FWREV);
	     call bcd_to_ascii_ (fw_trailer.overlay, FWOVERLAY);

	     if sys_info$initialization_state <= 1 then
		call ioa_ ("hc_load_mpc: Booting channel ^a with ^a Revision ^a^[ Overlay ^a^;^s^].", MPC_chanid,
		     FWID, substr (FWREV, 5, 2), fw_seg_num ^= 1, substr (FWOVERLAY, 1, 4));
	     else call syserr (ANNOUNCE, "hc_load_mpc: Booting channel ^a with ^a Revision ^a^[ Overlay ^a^;^s^].",
		     MPC_chanid, FWID, substr (FWREV, 5, 2), fw_seg_num ^= 1, substr (FWOVERLAY, 1, 4));

/**** Time to do the actual load */

	     idcwp = addr (io_buffer.idcw);
	     idcw.code = "7"b3;

	     if fw_seg_num = 1 then do;
		idcw.command = "10"b3;
	     end;
	     else do;				/* urc overlay */
		idcw.command = "36"b3;
		idcw.device = "01"b3;
		idcw.chan_cmd = "40"b3;
	     end;
	     call BOOT_SECTION ("Control Store", control_store_ptr, control_store_length, fw_seg_num ^= 1);

	     if read_write then do;
		unspec (io_buffer) = ""b;
		idcwp = addr (io_buffer.idcw);
		idcw.code = "7"b3;
		idcw.command = "11"b3;
		call BOOT_SECTION ("Read Write", read_write_ptr, read_write_length, "0"b);
	     end;
next_overlay:
	end;

	if DISK_MPC ()				/* special test for disk mpcs */
	     then call TEST_MPC (TWENTY_SECOND);

RETURN:
	call CLEANUP;
	return;

BOOT_SECTION: procedure (Name, Data_ptr, Data_length, Urc);

dcl  Data_length			fixed bin (18) parameter;
dcl  Data_ptr			ptr parameter;
dcl  Name				char (*) parameter;
dcl  Urc				bit (1) aligned parameter;

dcl  Data				(0:Data_length) bit (36) based;

dcl  data_absadr			fixed bin (26);
dcl  tally_length			fixed bin (12);
dcl  to_do			fixed bin;

	string (ima.pcw) = ""b;

	addr (io_buffer.data) -> Data = Data_ptr -> Data; /* Copy to low 256 K */

	dcwp = addr (io_buffer.dcw (1));

	if Urc then do;
	     to_do = Data_length + 1;
	     data_absadr = absadr (addr (io_buffer.port_mask), (0));
	end;
	else do;
	     to_do = Data_length;
	     data_absadr = absadr (addr (io_buffer.data), (0));
	end;
	if data_absadr + to_do > 1024 * 256 then call syserr (CRASH, "hc_load_mpc: data buffer not in low 256K");
	if IOI_attached then data_absadr = data_absadr - absadr (addr (io_buffer), (0));
						/* relatize for IOI */
	do while (to_do > 0);
	     string (dcw) = ""b;
	     dcw.address = bit (bin (data_absadr, 18), 18);
	     tally_length = min (to_do, 4096);
	     to_do = to_do - tally_length;
	     data_absadr = data_absadr + tally_length;
	     if tally_length = 4096 then tally_length = 0;
	     dcw.tally = bit (tally_length, 12);
	     dcw.type = "01"b;			/* IOTP */
	     if to_do > 0 then dcwp = addr (io_buffer.dcw (2));
	end;
	dcw.type = "00"b;				/* IOTD */

/***** The buffer is set up */

retry_the_connect:
	ima.listp = addr (io_buffer.idcw);

	unspec (io_status_word) = ""b;
	if IOI_attached then call IOI_CONNECT;
	else call CONNECT;

	if ^io_status_word.t then do;
	     Code = error_table_$timeout;
	     Reason = Name;
	     go to RETURN;
	end;
	if io_status_word.power then do;
	     if clock () < max_wait then do;		/* retry power offs for awhile */
		finish = clock () + HALF_SECOND;	/* 1/2 second pause */
		do while (clock () < finish);		/* TickTock */
		end;
		goto retry_the_connect;
	     end;
	     Code = -1;
	     Reason = "Power off status booting " || Name;
	     go to RETURN;
	end;

	if (io_status_word.major ^= ""b) | (io_status_word.sub ^= ""b) | (io_status_word.channel_stat ^= ""b)
	     | (io_status_word.central_stat ^= ""b) then do;
	     call ioa_$rsnnl ("IOM status ^.3b booting ^a.", Reason, (0), string (io_status_word), Name);
	     Code = -2;
	     go to RETURN;
	end;

	return;
     end BOOT_SECTION;

CONNECT: procedure;

dcl  wait_flag			bit (1) aligned;

	wait_flag = "1"b;
	go to COMMON;

CONNECT_NO_WAIT: entry;

	wait_flag = "0"b;

COMMON:
	unspec (io_status_word) = ""b;

	call io_manager$connect_abs (ima);

	if ^wait_flag then return;

	do while (^io_status_word.t);			/* Noel swears something will come back */
	     call pxss$addevent (event);
	     call pxss$wait;
	end;
	return;
     end CONNECT;
%page;
CLEANUP:
     procedure;

	if IOI_attached then call IOI_DETACH;
	else do;
	     if ima.chx ^= 0 then call io_manager$unassign (ima.chx, (0));
	     if io_buffer_ptr ^= null then do;
		if IO_buf_wired then call pc_abs$unwire_abs (astep, divide (bin (rel (io_buffer_ptr), 18), 1024, 9, 0),
			divide (1023 + size (io_buffer), 1024, 9, 0));
		free io_buffer;
	     end;
	end;
	return;
     end CLEANUP;
%page;
/**** Procedure to locate the "mpc" card that has a BASE iom/channel equal
      to the one being loaded. Once found, if the name = "mspX" TRUE is
      returned.  Else if the system is in an early state then TRUE is
      returned, else FALSE. */

DISK_MPC:
     procedure returns (bit (1));

	if ^IOI_attached then call io_chnl_util$name_to_iom (MPC_chanid, IOI_iom, IOI_chnl, Code);
						/* break down chanid if not already done */
	mpc_cardp = null;
	call config_$find (MPC_CARD_WORD, mpc_cardp);
	do while (mpc_cardp ^= null);
	     do portx = 1 to hbound (mpc_card.port, 1) while (mpc_card.iom (portx) ^= -1);
		if mpc_card.iom (portx) = IOI_iom & mpc_card.chan (portx) <= IOI_chnl
		     & mpc_card.chan (portx) + mpc_card.nchan (portx) > IOI_chnl then do;
		     if substr (mpc_card.name, 1, 3) = "msp" then return ("1"b);
		     else return (""b);
		end;
	     end;
	     call config_$find (MPC_CARD_WORD, mpc_cardp);
	end;
	if sys_info$initialization_state <= 1 then return ("1"b);
	else return (""b);
     end DISK_MPC;
%page;
test_controller: entry (MPC_chanid, Code);

	unspec (ima) = ""b;
	IOI_attached = ""b;
	IO_buf_wired = ""b;				/* won't use data area, so don't need to wire */
	IO_buf_data_wds = ZERO_PAGES;			/* no data required */
	unspec (event) = unspec (TEST_CONTROLLER_EVENT);
	call io_manager$assign (ima.chx, MPC_chanid, pxss$notify, event, io_status_word_ptr, Code);
	if Code ^= 0 then
	     if Code = error_table_$io_no_permission then do; /* iom_data.per_device.in_use = "1"b */
		call IOI_ATTACH;
		if Code ^= 0 then return;
		IOI_attached = "1"b;
	     end;
	     else return;

	io_buffer_ptr = null ();

	on cleanup call CLEANUP;

	if ^IOI_attached then allocate io_buffer set (io_buffer_ptr);

	call TEST_MPC (FIVE_SECOND);

	call CLEANUP;
	return;
%page;
/**** Procedure to issue request status connects to an MPC to check to
      see if it is operational. It will retry power-off statuses for upto
      P_pof_retry_time micro seconds. */

TEST_MPC:
     procedure (P_pof_retry_time);
dcl  P_pof_retry_time		fixed bin (71) parameter;

	max_wait = clock () + P_pof_retry_time;		/* set POF timer */

try_test_connect:
	unspec (io_buffer) = ""b;
	idcwp = addr (io_buffer.idcw);
	idcw.command = "40"b3;			/* request status */
	idcw.code = "7"b3;
	idcw.chan_cmd = "02"b3;			/* nondata */

	ima.ptp, ima.dcw_pair_ptr = null ();
	ima.listp = addr (io_buffer.idcw);

	unspec (io_status_word) = ""b;

	if IOI_attached then call IOI_CONNECT;
	else do;
	     call io_manager$connect_abs (ima);

	     time = clock ();
	     do while (^io_status_word.t & (clock () < (time + ONE_SECOND)));
	     end;					/* a second should be enough to wait for status */
	end;

	if io_status_word.t & io_status_word.power & (clock () < max_wait) then goto try_test_connect; /* retry POFs */

	Code = error_table_$device_not_active;		/* assume for now */
	if io_status_word.t then
	     if io_status_word.power = "0"b & io_status_word.major = "0"b4 & io_status_word.sub = "00"b3
		& io_status_word.central_stat = "0"b3 & io_status_word.channel_stat = "0"b3 then Code = 0;
	return;
     end TEST_MPC;
%page;
/**** Procedure to attach the MPC though IOI. This is required after
      ioi_init has assigned all the IOM channels to IOI. */

IOI_ATTACH:
     procedure;

	call SETUP_IOI_POSTING;
	if Code ^= 0 then return;

	unspec (IOI_event) = ""b;
	substr (unspec (IOI_event), 37, 36) = unspec (event);
	call io_chnl_util$name_to_iom (MPC_chanid, IOI_iom, IOI_chnl, Code);
						/* break down channel ID */
	if Code ^= 0 then return;
	MPC_name = FIND_MPC_NAME ();			/* find subsystem name for this channel */
	if MPC_name = "" then do;			/* oops, none found */
	     Code = error_table_$bad_channel;
	     return;
	end;
	call ioi_assignment$assign (IOI_index, MPC_name, IOI_event, PRIV, Code);
	if Code ^= 0 then return;

	call ioi_set$max_workspace (IOI_index, size (io_buffer), Code);
	if Code ^= 0 then goto error_detach;

	call ioi_set$workspace (IOI_index, io_buffer_ptr, size (io_buffer), Code);
						/* create the workspace */
	if Code ^= 0 then goto error_detach;

	call ioi_set$channel_required (IOI_index, IOI_iom, IOI_chnl, Code);
	if Code ^= 0 then goto error_detach;

	call ioi_set$status (IOI_index, bin (rel (addr (io_buffer.status)), 18), 1, Code);
	if Code ^= 0 then goto error_detach;

	io_status_word_ptr = addr (io_buffer.status.iom_stat);
	return;
%skip (5);
/**** Entry to detach the MPC. */

IOI_DETACH:
     entry;

error_detach:
	call ioi_assignment$unassign (IOI_index, (0));	/* don't worry about error code */
	ioi_post_area.number = 0;			/* reset IOI posting */
	return;
     end IOI_ATTACH;
%page;
/* Procedure to issue the firmware load connect via IOI. */

IOI_CONNECT:
     procedure;
dcl  send_pcw_to_IOI		bit (1);

	send_pcw_to_IOI = ""b;
	goto connect_common;

/**** Entry to issue the mask/reset (pcw) connect. */

IOI_DC_RESET:
     entry;
	send_pcw_to_IOI = "1"b;

connect_common:
	call SETUP_POST_BUF;
	if send_pcw_to_IOI
	     then call ioi_connect$ioi_connect_pcw (IOI_index, bin (rel (addr (io_buffer.idcw)), 18), IOI_pcw, Code);
						/* Do mask/reset connect */
	else call ioi_connect (IOI_index, bin (rel (addr (io_buffer.idcw)), 18), Code); /* Do normal connect */
	if Code ^= 0 then return;
	call WAIT_FOR_STATUS;
	return;
     end IOI_CONNECT;
%page;
/**** Procedure to locate either the "prph" or "chnl" card that has a
      BASE iom/channel equal to the one desired. Once found the subsystem
      name concatinated with "_00" is returned. */

FIND_MPC_NAME:
     procedure returns (char (8));

	prph_cardp = null;
	call config_$find (PRPH_CARD_WORD, prph_cardp);
	do while (prph_cardp ^= null);
	     if prph_card.iom = IOI_iom & prph_card.chan = IOI_chnl then do;
						/* base chnl on this mpc */
		return (prph_card.name || "_00");
	     end;
	     call config_$find (PRPH_CARD_WORD, prph_cardp);
	end;

	chnl_cardp = null;
	call config_$find (CHNL_CARD_WORD, chnl_cardp);
	do while (chnl_cardp ^= null);
	     do groupx = lbound (chnl_card_array.group, 1) to hbound (chnl_card_array.group, 1);
		if chnl_card.group (groupx).iom = IOI_iom & chnl_card.group (groupx).chan = IOI_chnl then do;
						/* base chnl on this mpc */
		     return (chnl_card.name || "_00");
		end;
	     end;
	     call config_$find (CHNL_CARD_WORD, chnl_cardp);
	end;

	return ("");				/* Not found.. */
     end FIND_MPC_NAME;
%page;
/**** Procedure to locate the IOI posting segment and get it setup for
      handling the firmware load interrupts. */

SETUP_IOI_POSTING:
     procedure;

	ioi_post_area_ptr = addr (bce_ioi_post_seg$);
	if ioi_post_area_ptr = null () then do;
	     Code = error_table_$seg_not_found;
	     return;
	end;
	unspec (ioi_post_area) = ""b;
	ioi_post_area.number = 1;
	Code = 0;
	return;
     end SETUP_IOI_POSTING;
%skip (2);
/**** Procedure to setup a posting buffer for an IO that is going to
      be issued. */

SETUP_POST_BUF:
     procedure;


	io_post_buffer_ptr = addr (ioi_post_area.buffer (1));
	unspec (io_post_buffer) = ""b;
	io_post_buffer.ev_chn = IOI_event;
	io_post_buffer.state = IO_OUTSTANDING;
	return;
     end SETUP_POST_BUF;
%skip (2);
/**** Procedure to wait for a terminate interrupt from an I/O connect. */

WAIT_FOR_STATUS:
     procedure;

	io_post_buffer_ptr = addr (ioi_post_area.buffer (1));
	do while (io_post_buffer.state ^= IO_COMPLETE);
	end;
	return;
     end WAIT_FOR_STATUS;
%page; %include bce_ioi_post_area;
%page; %include config_chnl_card;
%page; %include config_mpc_card;
%page; %include config_prph_card;
%page; %include firmware_trailer;
%page; %include io_manager_dcls;
%page; %include io_status_word;
%page; %include ioi_stat;
%page; %include iom_dcw;
%page; %include iom_pcw;
%page; %include syserr_constants;
%page;
/*	BEGIN MESSAGE DOCUMENTATION

Message:
hc_load_mpc: Could not abs_wire buffer.

S:	$crash

T:	$init

M:	$err

A:	$contact

Message:
hc_load_mpc: Booting channel CHNL with FWID Revision REV
hc_load_mpc: Booting channel CHNL with FWID Revision REV Overlay FWOVERLAY

S:	$info

T:	$init

M:	$ignore

A:	$config

Message:
hc_load_mpc: data buffer not in low 256K

S:	$crash

T:	$init

M:	$err

A:	$contact

	END MESSAGE DOCUMENTATION */

     end hc_load_mpc;




		    init_hc_part.pl1                11/11/89  1138.5r w 11/11/89  0801.1       68112



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


/****^  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 */


init_hc_part:
     proc (pvtx, frec, nrec);

/* Hardcore Partition Management

   init_hc_part establishes all structures necessary for paging to
          operate against the Hardcore Partition on a specified
	device. These structures include the PVTE, volmap_seg,
	and record_stock. One or more records at the beginning
	of the partition are used as a fake Volume Map.

   init_hc_part$terminate_hc_part terminates allocation against the
          Hardcore Partition. It is called immediately before
	enabling the File System.

  This program will require modification for the new Volume Map
  format. To facilitate this, those functions which are dependent
  on Volume Map format are embodied in separate subroutines.


  Written March 1982 by J. Bongiovanni
*/

/*  Parameter  */

	dcl     pvtx		 fixed bin;	/* Index of PVTE for device */
	dcl     frec		 fixed bin (18);	/* First record of HC PART of device */
	dcl     nrec		 fixed bin (18);	/* Number of records in HC PART */

/*  Automatic  */

	dcl     null_sdw		 fixed bin (71);	/* To clear volmap_abs_seg when done */
	dcl     p99		 pic "99";
	dcl     ptp		 ptr;		/* Pointer to page table */
	dcl     temp_sdw		 fixed bin (71);	/* SDW for volmap_abs_seg */
	dcl     vol_pagex		 fixed bin;

/*  Static  */

	dcl     ALL_FREE		 bit (36) aligned int static options (constant) init ("377777777770"b3);
	dcl     RECORDS_PER_PAGE	 fixed bin int static options (constant) init (1024 * 32);

/*  External  */

	dcl     sst$pts		 (0:3) fixed bin external;
	dcl     1 sst$level		 (0:3) aligned external,
		2 ausedp		 bit (18) unal,
		2 no_aste		 bit (18) unal;
	dcl     volmap_abs_seg$	 external;

/*  Entry  */

	dcl     make_sdw$unthreaded	 entry (fixed bin, fixed bin (71), ptr, ptr);
	dcl     page$cleanup entry (ptr);
	dcl     page$drain_record_stock entry (ptr);
	dcl     pmut$swap_sdw	 entry (ptr, ptr);
	dcl     ptw_util_$make_null_disk entry (ptr, fixed bin (17));
	dcl     stock_man$allocate_record_stock entry (ptr, ptr);
	dcl     stock_man$free_record_stock	 entry (ptr, ptr);
	dcl     syserr		 entry options (variable);
	dcl     thread$cin		 entry (ptr, bit (18));

/*  Builtin  */

	dcl     addr		 builtin;
	dcl     addrel		 builtin;
	dcl     baseno		 builtin;
	dcl     bin		 builtin;
	dcl     convert		 builtin;
	dcl     divide		 builtin;
	dcl     null		 builtin;
	dcl     substr		 builtin;

%page;
	pvt_arrayp = addr (pvt$array);
	pvtep = addr (pvt_array (pvtx));
	vol_mapp = addr (volmap_abs_seg$);
	null_sdw = 0;

	n_volmap_pages = get_volmap_size ();
	if nrec < n_volmap_pages
	then call syserr (CRASH, "init_hc_part: HC PART on dsk^a_^a too small",
		pvte.devname, convert (p99, pvte.logical_area_number));

	call make_sdw$unthreaded (bin (baseno (addr (volmap_abs_seg$))), temp_sdw, astep, ptp);
	if astep = null ()
	then call syserr (CRASH, "init_hc_part: Unable to get ASTE for HC PART volmap");
	call pmut$swap_sdw (addr (volmap_abs_seg$), addr (temp_sdw));
	if sst$pts (bin (aste.ptsi)) < n_volmap_pages
	then call syserr (CRASH, "init_hc_part: volmap_abs_seg size too small");
	aste.pvtx = pvtx;
	aste.volmap_seg = "1"b;
	pvte.volmap_astep = astep;
	pvte.volmap_seg_sdw = temp_sdw;

	call stock_man$allocate_record_stock (pvtep, record_stockp);

/* Withdraw addresses for the Volume Map by hand */

	do vol_pagex = 1 to n_volmap_pages;
	     call ptw_util_$make_null_disk (addrel (ptp, vol_pagex - 1), frec - 1 + vol_pagex);
	end;

	pvte.baseadd = frec + n_volmap_pages;
	pvte.totrec = nrec - n_volmap_pages;
	pvte.nleft = nrec - n_volmap_pages;

	call init_record_stock;
	call init_volmap;

	call pmut$swap_sdw (addr (volmap_abs_seg$), addr (null_sdw));

	return;
%page;
terminate_hc_part: entry (pvtx);

	pvt_arrayp = addr (pvt$array);
	pvtep = addr (pvt_array (pvtx));
	astep = pvte.volmap_astep;
	record_stockp = pvte.volmap_stock_ptr;

	call page$drain_record_stock (pvtep);
	call stock_man$free_record_stock (pvtep, record_stockp);

	call page$cleanup(astep);

	aste_part.two = "0"b;
	call thread$cin (astep, sst$level (bin (aste.ptsi)).ausedp);

	pvte.nleft, pvte.baseadd, pvte.totrec = 0;
	pvte.volmap_astep = null ();
	pvte.volmap_seg_sdw = 0;

	return;


%page;
/* Internal procedure to compute the number of pages needed for the
   Volume Map  */

get_volmap_size:
     proc returns (fixed bin);

	return (divide (bin (rel (addr (vol_map.bit_map (divide (nrec + 31, 32, 17) + 1)))) + 1023, 1024, 17));

     end get_volmap_size;
%page;
/* Internal procedure to initialize the record stock */

init_record_stock:
     proc;

	dcl     base		 fixed bin;
	dcl     bias		 fixed bin;
	dcl     left		 fixed bin;
	dcl     ox		 fixed bin;


	record_stock.n_volmap_pages = n_volmap_pages;
	record_stock.target = record_stock.n_in_stock;	/* Withdraw only, no deposit */
	
	do ox = 1 to hbound (record_stock.old_volmap_page, 1);
	     record_stock.old_volmap_page (ox).last = 0;
	end;

	base = frec + n_volmap_pages;
	left = nrec - n_volmap_pages;
	bias = 64 * 32;				/* Old Volume Map kludge */
	do ox = 1 repeat ox + 1 while (ox <= n_volmap_pages & left > 0);
	     record_stock.volmap_page (ox).n_free = min (RECORDS_PER_PAGE - bias, left);
	     record_stock.volmap_page (ox).baseadd = base - bias;
	     left = left - record_stock.volmap_page (ox).n_free;
	     base = base + RECORDS_PER_PAGE;
	     bias = 0;				/* Kludge for first page */
	end;

     end init_record_stock;
%page;
/* Internal procedure to initialize the fake Volume Map, indicating
   that all records in the Hardcore Partition (except those subverted
   for the Map itself) are free */

init_volmap:
     proc;

	dcl     bmx		 fixed bin;
	dcl     n_bitmap_words	 fixed bin;
	dcl     n_rem_bits		 fixed bin;


	n_bitmap_words = divide (nrec - n_volmap_pages, 32, 17);

	do bmx = 1 to n_bitmap_words;
	     vol_map.bit_map (bmx) = ALL_FREE;
	end;

	n_rem_bits = mod (nrec - n_volmap_pages, 32);
	if n_rem_bits > 0
	then do bmx = 1 to n_rem_bits;
		substr (vol_map.bit_map (n_bitmap_words + 1), bmx + 1, 1) = "1"b;
	     end;

	return;

     end init_volmap;
%page; %include aste;
%page; %include pvte;
%page; %include stock_seg;
%page; %include syserr_constants;
%page; %include vol_map;

%page;
/* BEGIN MESSAGE DOCUMENTATION

   Message:
   init_hc_part: HC PART on dskX_NN too small

   S:     $crash

   T:     $init

   M:	The Hardcore Partition on the device indicated is unreasonably
   small, as it does not contain sufficient space to hold the bit map
   describing it.

   A:	Recreate the partition and reboot.


   Message:
   init_hc_part: volmap_abs_seg size too small

   T:     $init

   S:	$crash

   M:	The maximum length of volmap_abs_seg on the MST header is not
   sufficient to access an entire Volume Map.

   A:	Recreate the MST with a larger maximum length for volmap_abs_seg
   and reboot.

   END MESSAGE DOCUMENTATION */

     end init_hc_part;




		    initial_error_handler.pl1       11/11/89  1138.5rew 11/11/89  0801.1       19368



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1983 *
        *                                                         *
        *********************************************************** */
/* initial_error_handler -- default handler for the initialization env. */
/* format: style2 */
initial_error_handler:
     procedure (MC_ptr, Condition_name, WC_ptr, Info_ptr, Continue_flag);

	declare (MC_ptr, WC_ptr, Info_ptr)
				 pointer parameter;
	declare Condition_name	 character (*) parameter;
	declare Continue_flag	 bit (1) aligned;
	declare recursion		 bit (1) internal static init ("0"b);
	declare (ppr, tpr)		 pointer;
	declare (baseptr, null, pointer)
				 builtin;
	declare scs$sys_trouble_pending
				 fixed bin ext;
          declare 1 prds$sys_trouble_data aligned like mc external;
	declare sys_trouble		 entry;
	declare syserr		 entry options (variable);
%include syserr_constants;
%include mc;
%include condition_info_header;


/* For now, this program just replaces sys_trouble$unexp_fault */

	scs$sys_trouble_pending = -6;			/* unexpected fault */

	if recursion
	then call sys_trouble;			/* No message */

	recursion = "1"b;

	if Info_ptr ^= null
	then do;
		condition_info_header_ptr = Info_ptr;
		if condition_info_header.quiet_restart	/* only one respected for now */
		then do;
			recursion = "0"b;
			return;
		     end;
	     end;


	mcp = MC_ptr;
	if mcp ^= null
	then do;
	          prds$sys_trouble_data = mc;
		scup = addr (mc.scu);
		ppr = pointer (baseptr ("000"b || scu.ppr.psr), scu.ilc);
		tpr = pointer (baseptr ("000"b || scu.tpr.tsr), scu.ca);

		call syserr (CRASH, "initial_error_handler: ^a condition by ^p referencing ^p; MC at ^p.",
		     Condition_name, ppr, tpr, MC_ptr);

	     end;
	else call syserr (CRASH, "initial_error_handler: ^a condition.", Condition_name);

	call sys_trouble;
     end initial_error_handler;




		    initialize_faults.pl1           11/11/89  1138.5r   11/11/89  0800.0      157599



/****^  ***********************************************************
        *                                                         *
        * 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.      *
        *                                                         *
        *********************************************************** */


/* This procedure is called three times by the Multics initializer.
   It initializes the fault and interrupt mechanism by setting pointers
   in the fim, the wired_fim, the iom_interrupt, the pds, the prds, and the fault vector.
   The procedures restart_fault, and emergency_shutdown
   are also initialized.

   Last Modified: (Date and reason)

   01/06/84 by Keith Loepere for drl special drls in bce (breakpoints) and for pmut$cam_both.
   10/21/83 by Keith Loepere for hardcore_sct_seg$hardcore_sct_seg (in bound seg).
   05/17/83 by E. N. Kittlitz for drl_entry.
   09/22/82 by BIM to reorganize to signal in collection 1.
   08/10/82 by BIM to eliminate the zero out entirely.
   07/14/82 by BIM to change bootstrap1 to bound_bootload_1.
   06/25/82 by E. N. Kittlitz to move core map.
   03/19/81 by J. A. Bush during DPS8/70M debug to 0 out bootstrap1's SDW
   02/23/81 by J. Bongiovanni for fast connect code
   12/01/80 by C. Hornig for new interrupt mechanism.
   08/27/80 by J. A. Bush for  DPS8/70M
   08/13/79 by J. A. Bush for new signal_entry & parity_entry of fim
   05/10/79 by BSG for shared stack_0's.
   08/09/77 by Bernard Greenberg to reinstate derail fault  vector
   06/10/77 by Melanie Weaver to set up signaller and sct handler
   2/08/76 by Noel I. Morris for new reconfig
   01/06/75 at 21:07:50 by R F Mabee.  Removed crock setting signal_ptr in stack.
   4/25/74 by B. Greenberg for cache system
   2/74 by S. Webber for privileged-mode page control
   8/10/73 by R.Snyder to read switches to get bootload memory rather than believe MEM card.
   5/18/73 by R.Snyder to cause initialize interrupts to be ignored in general.
   7/26/71 by rhg to divert sys_trouble interrupts to special ii entry
   7/26/71 by RHG to make cell number reading off config deck be mod 64
   rather than pds$page_fault_data+32
   7/24/71 by RHG to use ii$paging_interrupt_entry, ii$pageable_interrupt_entry, scs$interrupt_state
   7/16/71 by Richard H. Gumpertz to fix initialization of pointers in prds, pds
   coded May 1970 by Roger R. Schell
*/


/* format: style2,^indattr */
initialize_faults:
     procedure;

/* Declaration of external references we want to get pointers to */

	dcl     sctptr ptr;
	dcl     sctp (0:1023) ptr unal based;

	dcl     core_map$ ext bit (36);
	dcl     copy_on_write_handler_$copy_on_write_handler_ ext entry;
	dcl     dseg$ (0:4095) fixed bin (71) ext;
	dcl     emergency_shutdown$ ext bit (36);
	dcl     fault_vector$ ext bit (36);
	dcl     fim$drl_entry entry ext;
	dcl     fim$onc_start_shut_entry entry ext;
	dcl     fim$parity_entry entry ext;
	dcl     fim$signal_entry entry ext;
	dcl     fim$access_violation_entry entry ext;
	dcl     fim$primary_fault_entry entry ext;
	dcl     hardcore_sct_seg$hardcore_sct_seg ext fixed bin;
	dcl     iom_interrupt$interrupt_entry entry ext;
	dcl     isot_fault_handler_$isot_fault_handler_ ext entry;
	dcl     lot_fault_handler_$lot_fault_handler_ ext entry;
	dcl     pds$stack_0_ptr ptr ext;
	dcl     1 pds$fim_data aligned like mc external;
	dcl     1 pds$page_fault_data aligned like mc external;
	dcl     1 pds$signal_data aligned like mc external;
	dcl     1 prds$fim_data aligned like mc external;
	dcl     prds$fast_connect_code entry external;
	dcl     1 prds$ignore_data aligned like scu external;
          dcl     prds$ignore_pl (8) bit (36) aligned external;
	dcl     1 prds$interrupt_data aligned like mc external;
	dcl     1 prds$sys_trouble_data aligned like mc external;
	dcl     return_to_ring_0_$restart_fault_ptr ptr ext;
	dcl     signal_$signal_ entry external;
	dcl     tc_data$ bit (36) aligned external;
	dcl     wired_fim$xec_fault entry external;
	dcl     wired_fim$unexp_fault entry external;
	dcl     wired_fim$ignore entry external;
	dcl     page_fault$fault entry external;
	dcl     wired_fim$timer_runout entry external;

	dcl     (
	        emergency_shutdown$lp,
	        emergency_shutdown$pp,
	        fim$prs,
	        fim$scu,
	        fim$sig_prs,
	        fim$sig_scu,
	        fim$lp,
	        iom_interrupt$iilink,
	        iom_interrupt$prds_prs,
	        iom_interrupt$prds_scu,
	        page_fault$my_lp,
	        pds$apt_ptr,
	        restart_fault$,
	        restart_fault$lp,
	        restart_fault$scu,
	        wired_fim$prs,
	        wired_fim$scuinfo,
	        wired_fim$trouble_prs,
	        wired_fim$trouble_scuinfo,
	        wired_fim$int_scuinfo,
	        wired_fim$ignore_pl,
	        wired_fim$ignore_scuinfo,
	        wired_fim$my_linkage_ptr,
	        page_fault$cme_offsets,
	        page_fault$pf_prs,
	        page_fault$pf_scuinfo
	        ) pointer external;


	dcl     cme_offsets (0:size (cme) - 1) ptr based (addr (page_fault$cme_offsets));

	dcl     lot$ (0:1023) pointer unaligned external static;

	dcl     privileged_mode_ut$cam_both ext entry,	/* to clear our associative memory */
	        privileged_mode_ut$set_mask entry (bit (72) aligned, fixed bin (71)),
						/* to set memory controller masks */
	        privileged_mode_ut$ldt ext entry (fixed bin);
						/* to load timer register */
	dcl     sdw_util_$get_access entry (ptr, bit (4) unaligned);
	dcl     sdw_util_$set_access entry (ptr, bit (4) unaligned);


	dcl     (
	        ignore_ptr,				/* pointer to FIM entry to ignore */
	        ignore_d_ptr,			/* pointer to place in PRDS for ignored SCU data */
	        primary_trap,
	        primary_scup,
	        signal_trap,
	        signal_scup,
	        onc_trap,
	        onc_scup,
	        unexp_trap,
	        unexp_scup,
	        p
	        ) ptr;

	dcl     i fixed bin (5);			/* loop index */
	dcl     access bit (4);			/* saved access of procedure segment */

	dcl     (addr, baseno, baseptr, codeptr, fixed, null, ptr, size) builtin;

	declare (
	        initialize_faults_data$primary_one,
	        initialize_faults_data$primary_two,
	        initialize_faults_data$signal_one,
	        initialize_faults_data$signal_two,
	        initialize_faults_data$onc_one,
	        initialize_faults_data$onc_two
	        ) (0:31) bit (1) unaligned ext static;



/* FAULT_INIT_ONE - Initialize Fault and Interrupt Mechanism
   and Set Up Fault Vector for Remainder of Initialization */

fault_init_one:
     entry;

/* initialize pointers that we will need */

	call GET_STANDARD_POINTERS;


	do i = 0 to 31;				/* first set up all faults and interrupts the same */

	     if initialize_faults_data$primary_one (i)
	     then do;
		     fv.f_tra_ptr (i) = primary_trap;
		     fv.f_scu_ptr (i) = primary_scup;
		end;
	     else if initialize_faults_data$signal_one (i)
	     then do;
		     fv.f_tra_ptr (i) = signal_trap;
		     fv.f_scu_ptr (i) = signal_scup;
		end;
	     else if initialize_faults_data$onc_one (i)
	     then do;
		     fv.f_tra_ptr (i) = onc_trap;
		     fv.f_scu_ptr (i) = onc_scup;
		end;
	     else do;				/* otherwise unaccounted for */
		     fv.f_tra_ptr (i) = unexp_trap;
		     fv.f_scu_ptr (i) = unexp_scup;
		end;


	     fv.i_tra_ptr (i) = ignore_ptr;		/* ignore all interrupts */
	     fv.i_scu_ptr (i) = ignore_d_ptr;		/* put SCU data where we can find it */

	end;

	fv.f_tra_ptr (FAULT_NO_LUF) = ignore_ptr;	/* ignore lockup faults */
	fv.f_scu_ptr (FAULT_NO_LUF) = ignore_d_ptr;	/* put SCU data where we can find it */

	fv.f_tra_ptr (FAULT_NO_TRO) = ignore_ptr;
	fv.f_scu_ptr (FAULT_NO_TRO) = ignore_d_ptr;

/* Execute faults have special meaning. */
	fv.f_tra_ptr (FAULT_NO_EXF) = codeptr (wired_fim$xec_fault);
	fv.f_scu_ptr (FAULT_NO_EXF) = addr (prds$sys_trouble_data.scu);

/* set up for page faults */
	fv.f_tra_ptr (FAULT_NO_DF1) = codeptr (page_fault$fault);
	fv.f_scu_ptr (FAULT_NO_DF1) = addr (pds$page_fault_data.scu);

/* set up for df0 (seg faults) */
	fv.f_tra_ptr (FAULT_NO_DF0) = codeptr (fim$primary_fault_entry);
	fv.f_scu_ptr (FAULT_NO_DF0) = addr (addr (pds$fim_data) -> mc.scu (0));

/* entry for connect faults */
	fv.f_tra_ptr (FAULT_NO_CON) = codeptr (prds$fast_connect_code);
	fv.f_scu_ptr (FAULT_NO_CON) = addr (prds$fim_data.scu);

/* direct derail faults to a special entry */

	fv.f_tra_ptr (FAULT_NO_DRL) = addr (fim$drl_entry);

/* initialize the FIM */

	call set_access (fim$prs);
	fim$prs = addr (pds$fim_data);		/* Set pointer to place for pointer regs. */
	fim$scu = addr (pds$fim_data.scu);		/* Set pointer to place for SCU data. */
	fim$sig_prs = addr (pds$signal_data);		/* Set ptr for signal_data ptr regs. */
	fim$sig_scu = addr (pds$signal_data.scu);	/* Set ptr for signal_data SCU data. */
	call set_lp (fim$lp);			/* Store linkage pointer and set access. */

/* initialize the Interrupt Interceptor */

	call set_access (iom_interrupt$prds_prs);

	iom_interrupt$prds_prs = addr (prds$interrupt_data);
						/* Set pointer for SPRI in the PRDS */
	iom_interrupt$prds_scu = addr (prds$interrupt_data.scu);
						/* Set pointer for SCU in the PRDS */
	call set_lp (iom_interrupt$iilink);		/* Store linkage ptr. */

/* initialize wired_fim */

	call set_access (wired_fim$prs);

	wired_fim$prs = addr (prds$fim_data);		/* Set pointer to place for pointer registers. */
	wired_fim$scuinfo = addr (prds$fim_data.scu);	/* Set pointer to place for SCU data. */

/* Set machine condition pointer for wired_sys_trouble. */
	wired_fim$trouble_prs = addr (prds$sys_trouble_data);
						/* Set pointer to place for pointer registers. */
	wired_fim$trouble_scuinfo = addr (prds$sys_trouble_data.scu);
						/* Set pointer to place for SCU data. */

	wired_fim$int_scuinfo = addr (pds$page_fault_data.scu);
						/* Set pointer in wired_fim. */

	wired_fim$ignore_pl = addr (prds$ignore_pl);
	wired_fim$ignore_scuinfo = ignore_d_ptr;	/* Set pointer for ignoring faults. */

	call set_lp (wired_fim$my_linkage_ptr);		/* store linkage pointer */

/* initialize Page Fault Handler */

	call set_access (page_fault$my_lp);

	page_fault$pf_prs = addr (pds$page_fault_data);	/* save pointer to place for pointer registers */
	page_fault$pf_scuinfo = addr (pds$page_fault_data.scu);
						/* save pointer to place for SCU data */
	cmep = null;
	do i = 0 to size (cme) - 1;			/* set up C.M. ITS pointers */
	     cme_offsets (i) = ptr (addr (core_map$), i);
	end;
	call set_lp (page_fault$my_lp);		/* store linkage pointer for page */

/* initialize restart_fault */

	call set_access (restart_fault$scu);
	restart_fault$scu = addr (pds$signal_data.scu);	/* Set RCU pointer for restart_fault. */
	call set_lp (restart_fault$lp);		/* store linkage pointer */

/* initialize emergency_shutdown */

	call set_access (emergency_shutdown$lp);
	emergency_shutdown$pp = addr (emergency_shutdown$);
						/* save pointer to itself */
	call set_lp (emergency_shutdown$lp);		/* store linkage pointer */

	pds$apt_ptr = addr (tc_data$);		/* set pointer so that pxss can work */


/* Initialize return_to_ring_0_$restart_fault_ptr for returns to ring zero */

	call set_access (return_to_ring_0_$restart_fault_ptr);
						/* allow stores to rr0_ */
	return_to_ring_0_$restart_fault_ptr = addr (restart_fault$);
						/* store pointer to restart_fault */
	call restore_access;			/* restore old rr0_ access */

/* What follows used to be signal_init */

/* Fill in inzr_stk0 stack base. init_stack_0 will fill in others */

	pds$stack_0_ptr = stackbaseptr ();		/* Allow fim to work, interim. */
	stackbaseptr () -> stack_header.signal_ptr = codeptr (signal_$signal_);
	stackbaseptr () -> stack_header.unwinder_ptr = null;
						/* take a fault */
	stackbaseptr () -> stack_header.sct_ptr = addr (hardcore_sct_seg$hardcore_sct_seg);

/* Put a standard for scu/tra pair in the vector for derail. Bootstrap1 has been leaving it lying around
   as an immediate RTB up till now for clean crashes. */

	fv.fpair (FAULT_NO_DRL).scu = rel (addr (fv.f_scu_ptr (FAULT_NO_DRL))) || "657220"b3;
						/* fv seg is at 0 abs. */
	fv.fpair (FAULT_NO_DRL).tra = rel (addr (fv.f_tra_ptr (FAULT_NO_DRL))) || "710220"b3;

	scs$faults_initialized = "1"b;		/* Mark faults as initialized. */
	return;


/* INTERRUPT_INIT - Set Up Interrupt Vector for Multics Operation. */

interrupt_init:
     entry;

/* initialize pointers */

	fvp = addr (fault_vector$);			/* Get pointer to fault vector. */

/* turn off all interrupts */

	call privileged_mode_ut$set_mask (scs$sys_level, 0);
						/* Make sure no interrupts come in. */
						/* set up SCU pointer for the PRDS */
	fv.i_tra_ptr (*) = codeptr (iom_interrupt$interrupt_entry);
	fv.i_scu_ptr (*) = addr (prds$interrupt_data.scu);

/* Open the memory controller mask */

	call privileged_mode_ut$set_mask (scs$open_level, 0);
						/* Open mask for all interrupts. */

	return;					/* Interrupts are under weigh. */


/* FAULT_INIT_TWO -- reset some fault vector assignments for file system */
/*	           operations */

fault_init_two:
     entry;


	call GET_STANDARD_POINTERS;

/* set the timer to give us time to change fault vector */

	call privileged_mode_ut$ldt (-1);		/* Load the timer register. */

/* Direct most faults to the FIM. */

	do i = 0 to 31;				/* Loop. */

	     if initialize_faults_data$primary_two (i)
	     then do;
		     fv.f_tra_ptr (i) = primary_trap;
		     fv.f_scu_ptr (i) = primary_scup;
		end;
	     else if initialize_faults_data$signal_two (i)
	     then do;
		     fv.f_tra_ptr (i) = signal_trap;
		     fv.f_scu_ptr (i) = signal_scup;
		end;
	     else if initialize_faults_data$onc_two (i)
	     then do;
		     fv.f_tra_ptr (i) = onc_trap;
		     fv.f_scu_ptr (i) = onc_scup;
		end;
		else if i > 25 & i < 31
		then do;
			fv.f_tra_ptr (i) = unexp_trap;
			fv.f_scu_ptr (i) = unexp_scup;
		     end;		     
	end;

/* direct access violations to a special entry */

	fv.f_tra_ptr (FAULT_NO_ACV) = codeptr (fim$access_violation_entry);
	fv.f_scu_ptr (FAULT_NO_ACV) = primary_scup;

/* direct derail faults to a special entry */

	fv.f_tra_ptr (FAULT_NO_DRL) = addr (fim$drl_entry);

/* Direct timer runouts to special handler. */

	fv.f_tra_ptr (FAULT_NO_TRO) = codeptr (wired_fim$timer_runout);
	fv.f_scu_ptr (FAULT_NO_TRO) = addr (prds$fim_data.scu);

/* direct parity errors to a special entry */

	fv.f_tra_ptr (FAULT_NO_PAR) = codeptr (fim$parity_entry);
	fv.f_scu_ptr (FAULT_NO_PAR) = primary_scup;

/* Fill in the ring zero static handlers. This can only be called after */
/* collection 2 is loaded */

	sctptr = addr (hardcore_sct_seg$hardcore_sct_seg);

	sctptr -> sctp (no_write_permission_sct_index) = codeptr (copy_on_write_handler_$copy_on_write_handler_);
	sctptr -> sctp (isot_fault_sct_index) = codeptr (isot_fault_handler_$isot_fault_handler_);
	sctptr -> sctp (lot_fault_sct_index) = codeptr (lot_fault_handler_$lot_fault_handler_);

	return;
%page;
/* SET_LP - Store Linkage Pointer and Set Proper Access. */

set_lp:
     proc (link_ptr);				/* Entry to set text-embedded linkage pointers */

	dcl     link_ptr ptr;			/* cell to contain linkage pointer */

	dcl     segno fixed bin (15);			/* segment number of segment */
	dcl     target_ptr ptr;			/* pointer to segment whose linkage we want */

	target_ptr = addr (link_ptr);			/* for set_lp we want our own linkage */

	segno = fixed (baseno (target_ptr), 18);	/* compute segment number */
	link_ptr = lot$ (segno);			/* Generate pointer to linkage section. */


	call restore_access;			/* restore proper seg access */

	return;

     end set_lp;



/* SET_ACCESS/RESTORE_ACCESS - Set Write Access to Procedure and Reset Later. */

set_access:
     procedure (textp);				/* proc to set write access */

	dcl     segno fixed bin (15);
	dcl     textp ptr;				/* any pointer residing in text segment */

	segno = fixed (baseno (addr (textp)), 18);	/* get segment number */
	call sdw_util_$get_access (addr (dseg$ (segno)), access);
						/* save old access */
	call sdw_util_$set_access (addr (dseg$ (segno)), access | RW_ACCESS);
						/* allow writing */
	call privileged_mode_ut$cam_both;		/* make sure it takes */

	return;


restore_access:
     entry;					/* to be called after set_access has been called */

	call sdw_util_$set_access (addr (dseg$ (segno)), access);
						/* restore old access */
	call privileged_mode_ut$cam_both;		/* make sure that takes */

	return;


     end set_access;


GET_STANDARD_POINTERS:
     procedure;

	fvp = addr (fault_vector$);
	ignore_ptr = codeptr (wired_fim$ignore);
	ignore_d_ptr = addr (prds$ignore_data);

/* initialize SCU and TRA pointers for faults and interrupts */

	primary_trap = codeptr (fim$primary_fault_entry);
	primary_scup = addr (pds$fim_data.scu);
	signal_trap = codeptr (fim$signal_entry);
	signal_scup = addr (pds$signal_data.scu);
	onc_trap = codeptr (fim$onc_start_shut_entry);
	onc_scup = primary_scup;
	unexp_trap = codeptr (wired_fim$unexp_fault);
	unexp_scup = addr (prds$sys_trouble_data.scu);
     end;

%page;
%include cmp;
%include fault_vector;
%include mc;
%include scs;
%include static_handlers;
%include stack_header;
%include access_mode_values;
     end initialize_faults;




		    initialize_faults_data.cds      11/11/89  1138.5rew 11/11/89  0801.1       29574



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Bull Inc., 1987                *
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1983 *
   *                                                         *
   *********************************************************** */
/* initialize_faults_data.cds -- control bits for initialize_faults */
/* format: style2 */

initialize_faults_data:
     procedure;

	declare 1 if_data		 aligned,
		2 primary_one	 (0:31) bit (1) unaligned,
		2 pad_align1	 bit (0) aligned,
		2 signal_one	 (0:31) bit (1) unaligned,
		2 pad_align2	 bit (0) aligned,
		2 onc_one		 (0:31) bit (1) unaligned,
		2 pad_align3	 bit (0) aligned,
		2 primary_two	 (0:31) bit (1) unaligned,
		2 pad_align4	 bit (0) aligned,
		2 signal_two	 (0:31) bit (1) unaligned,
		2 pad_align5	 bit (0) aligned,
		2 onc_two		 (0:31) bit (1) unaligned;

	declare create_data_segment_	 entry (ptr, fixed bin (35));
	declare com_err_		 entry () options (variable);
	declare code		 fixed bin (35);
	declare PADSTAR		 (1) char (32) init ("pad*") int static options (constant);

%include fault_vector;
%include cds_args;
	declare 1 CDSA		 aligned like cds_args;
	declare (null, size, string, unspec)
				 builtin;


	unspec (if_data) = ""b;

	if_data.primary_one (FAULT_NO_CMD) = "1"b;
	if_data.primary_one (FAULT_NO_TRB) = "1"b;

	if_data.primary_two = if_data.primary_one;

	if_data.primary_two (FAULT_NO_DF0) = "1"b;
	if_data.primary_two (FAULT_NO_F2) = "1"b;

	if_data.signal_one (FAULT_NO_ACV) = "1"b;
	if_data.signal_one (FAULT_NO_STR) = "1"b;
	if_data.signal_one (FAULT_NO_MME) = "1"b;
	if_data.signal_one (FAULT_NO_F1) = "1"b;
	if_data.signal_one (FAULT_NO_DRL) = "1"b;
	if_data.signal_one (FAULT_NO_LUF) = "1"b;
	if_data.signal_one (FAULT_NO_IPR) = "1"b;
	if_data.signal_one (FAULT_NO_OFL) = "1"b;
	if_data.signal_one (FAULT_NO_DIV) = "1"b;
	if_data.signal_one (FAULT_NO_DF0) = "1"b;
	if_data.signal_one (FAULT_NO_DF1) = "1"b;
	if_data.signal_one (FAULT_NO_DF2) = "1"b;
	if_data.signal_one (FAULT_NO_DF3) = "1"b;
	if_data.signal_one (FAULT_NO_MME2) = "1"b;
	if_data.signal_one (FAULT_NO_MME3) = "1"b;
	if_data.signal_one (FAULT_NO_MME4) = "1"b;
	if_data.signal_one (FAULT_NO_F2) = "1"b;
	if_data.signal_one (FAULT_NO_F3) = "1"b;

	if_data.signal_two = if_data.signal_one;

	if_data.signal_two (FAULT_NO_DF0) = "0"b;
	if_data.signal_two (FAULT_NO_DF1) = "0"b;
	if_data.signal_two (FAULT_NO_DF2) = "0"b;
	if_data.signal_two (FAULT_NO_ACV) = "0"b;
	if_data.signal_two (FAULT_NO_F2) = "0"b;

	if_data.onc_one (FAULT_NO_SDF) = "1"b;
	if_data.onc_one (FAULT_NO_SUF) = "1"b;
	if_data.onc_one (FAULT_NO_ONC) = "1"b;


	unspec (CDSA) = ""b;
	CDSA.sections (1).p = addr (if_data);
	CDSA.sections (1).len = size (if_data);
	CDSA.sections (2).p = null;
	CDSA.sections (2).len = 0;
	CDSA.sections (1).struct_name = "if_data";
	CDSA.num_exclude_names = 1;
	CDSA.exclude_array_ptr = addr (PADSTAR);
	CDSA.have_text = "1"b;
	CDSA.seg_name = "initialize_faults_data";

	call create_data_segment_ (addr (CDSA), code);
	if code ^= 0
	then call com_err_ (code, "initialize_faults_data");
	return;

     end initialize_faults_data;




		    make_sdw.pl1                    11/11/89  1138.5r w 11/11/89  0801.1      130824



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


make_sdw: proc (a_segno, a_tsdw, a_astep, a_ptp);

/*	Last Modified: (Date and Reason)
   09/22/71 by Richard H. Gumpertz to change null devadds to include rel(ptp) for page
   08/--/71 by David R. Vinograd for page multi-level
   02/12/74 by Bernard S. Greenberg for 6180 cache
   04/09/74 by Bernard S. Greenberg for TBLS card
   07/17/74 by Mike Grady to move code to temp wire pages and
     look for pds and pl1_operators_
   02/10/75 by Andre Bensoussan for the new storage system.
   07/09/75 by Greenberg, incorporating 1/6/75 change by Mabee
     making SDW parameters 'like', instead of fixed (71).
   12/08/75 by Greenberg for pre-withdraw against HC partition
   07/20/78 by Greenberg for multi-vol HC part.
   01/31/79 by D. Spector to allocate deciduous segments on root phys vol
   03/22/81, W. Olin Sibert, for ADP PTWs and SDWs
   04/16/81, WOS, to make parameters fixed bin (71) again, use sdw_util_
   02/28/82, J. Bongiovanni, to eliminate use of FSDCT, add entries
             thread_hcp, reset_hcp
   08/11/82, J. Bongiovanni, to eliminate RLV parasites.
   10/18/82, BIM, $no_pages, entry for establishing segs on partitions
   04/06/83, KPL, bug fix to $no_pages to fill in length fields in aste
   12/13/83, KPL, for adding breakpoint page to executable segments.
   07/12/84, KPL, for setting sentinel in breakpoint page.
   */

	dcl     a_segno		 fixed bin (18) parameter;
	dcl     a_tsdw		 fixed bin (71) parameter;
	dcl     a_ptp		 pointer parameter;
	dcl     a_astep		 pointer parameter;
	dcl     a_pvtx		 fixed bin parameter;

	dcl     (error_table_no, pdsno, dsegno, pl1_ops_no, pl1_ops_pages, no_pages_wired) fixed bin;
	dcl     (ptsi, loopcnt)	 fixed bin;
	dcl     pvtx		 fixed bin;
	dcl     temp_sdw		 fixed bin (71);
	dcl     save_pts		 fixed bin;
	dcl     dummy		 fixed bin;
	dcl     asp		 ptr;
	dcl     pts		 fixed bin (9);
	dcl     (i, j)		 fixed bin;
	dcl     unthreaded		 bit (1) aligned;	/* Switch is on if unthreaded entry */
	dcl     no_pages		 bit (1) aligned;

	dcl     1 sdwi		 aligned like sdw_info automatic;

	dcl     seg		 (0:262143) fixed bin based aligned;
	dcl     bfword		 (0:1) fixed bin based;

	dcl     hcp_thread		 fixed bin int static init (0);
	dcl     hcp_first		 fixed bin int static init (0);

	dcl     abs_seg$		 external static;
	dcl     breakpoint_page$	 external static;
	dcl     dseg$		 external static;
	dcl     name_table$		 external static;
	dcl     pds$		 external static;
	dcl     slt$		 external static;

	dcl     pl1_operators_$end_pl1_operators fixed bin external static;
	dcl     error_table_$	 external static;
	dcl     sys_info$system_type	 fixed bin external static;

	dcl     absadr		 entry (ptr, fixed bin (35)) returns (fixed bin (26));
	dcl     config_$find	 entry (char (4) aligned, ptr);
	dcl     get_ptrs_$given_astep	 ext entry (ptr) returns (fixed bin (71));
	dcl     pmut$swap_sdw	 entry (ptr, ptr);
	dcl     ptw_util_$make_core    entry (pointer, fixed bin (26));
	dcl     ptw_util_$make_null	 entry (pointer, bit (22) aligned);
	dcl     ptw_util_$set_wired	 entry (pointer);
	dcl     sdw_util_$construct	 entry (pointer, pointer);
	dcl     sdw_util_$dissect	 entry (pointer, pointer);
	dcl     syserr		 ext entry options (variable);
	dcl     thread$cin		 ext entry (ptr, bit (18));
	dcl     thread$out		 ext entry (ptr, bit (18));

	dcl     (addr, addrel, baseno, bin, bit, divide, fixed, hbound, max, null, ptr, rel, string, substr) builtin;

/*  */

	unthreaded = "0"b;				/* This is not the unthreaded entry */
	no_pages = "0"b;
	goto MAKE_SDW_COMMON;


unthreaded: entry (a_segno, a_tsdw, a_astep, a_ptp);	/* Entry for unthreaded AST entry */

	unthreaded = "1"b;
	no_pages = "0"b;
	goto MAKE_SDW_COMMON;

no_pages: entry (a_segno, a_tsdw, a_astep, a_ptp);
	no_pages = "1"b;
	unthreaded = "0"b;				/* thread in ! */

MAKE_SDW_COMMON:

	sstp = addr (sst_seg$);
	pvt_arrayp = addr (pvt$array);
	sltp = addr (slt$);
	sltep = addr (slt.seg (a_segno));		/* Set pointer to slt entry. */
	asp = addr (abs_seg$);			/* Used to withdraw seg */

	pdsno = fixed (baseno (addr (pds$)), 17);
	dsegno = fixed (baseno (addr (dseg$)), 17);
	pl1_ops_no = fixed (baseno (addr (pl1_operators_$end_pl1_operators)), 17);
	pl1_ops_pages = divide (fixed (rel (addr (pl1_operators_$end_pl1_operators)), 18) + 1023, 1024, 17, 0);
	error_table_no = fixed (baseno (addr (error_table_$)), 17);

	namep = ptr (addr (name_table$), slte.names_ptr); /* get ptr to name */
	do i = 1 to hbound (table_corresp, 1);		/* scan variable size table names */
	     if table_corresp (i).slt_name = namep -> segnam.name (1)
	     then do tbcp = null repeat (tbcp);		/* scan config deck for size spec */
		     call config_$find (tbl_card_name, tbcp); /* get a card */
		     if tbcp = null then go to no_card; /* no more in deck */
		     do j = 1 to hbound (tbls_card.tbl_spec, 1); /* scan this card */
			if tbls_card.tbl_name (j) = table_corresp (i).card_name then do;
				pts, save_pts = tbls_card.cur_length (j); /* get length from card */
				slte_uns.max_length =
				     max (pts, slte_uns.max_length);
				slte_uns.cur_length = pts; /* set from card */
				go to got_pts;
			     end;
		     end;
		end;
	end;

no_card:	pts = max (slte_uns.max_length, slte_uns.cur_length); /* get page table size */
	if (pts = 0 | (slte.abs_seg & ^ no_pages)) & ^unthreaded then do; /* No aste for abs segs unless user insists */
						/* If void seg, don't create unless forced */
						/* Avoid routine creation of abs segs */
		a_astep, a_ptp = null ();		/* Don't try using it */
		a_tsdw = 0;			/* Quick segfault */
		return;
	     end;

	if ^ slte.breakpointable & ^ no_pages & substr (slte_uns.access, 2, 1) then do;/* execute => breakpointable */
	     slte_uns.breakpointable = "1"b;
	     slte_uns.max_length = slte_uns.max_length + 1;
	     slte_uns.cur_length = slte_uns.cur_length + 1;
	     pts = pts + 1;
	end;
	save_pts = pts;

got_pts:	do i = 3 to 0 by -1 while (sst.pts (i) >= pts);	/* find correct page table pool */
	end;

	ptsi = i + 1;
	loopcnt = 0;				/* zero counter */
	pts = sst.pts (ptsi);			/* specify page table size */

	do astep = ptr (sstp, sst.ausedp (ptsi)) /* look for an ASTE for the segment */
	     repeat ptr (sstp, aste.fp) /* skip to next ASTE for free one */
	     while (aste.usedf & /* until it's free or */
	     loopcnt <= fixed (sst.no_aste (ptsi), 17));	/* there are no more ASTE's */
	     loopcnt = loopcnt + 1;			/* how many times through the loop */
	end;

	if loopcnt > fixed (sst.no_aste (ptsi), 18) then /* too many times; pool is empty */
	     call syserr (1, "make_sdw: aste pool ^d too small", ptsi);

	call thread$out (astep, sst.ausedp (ptsi));	/* thread the entry out of the used list */
	do i = 0 to sst.astsize - 2;			/* zero the AST entry */
	     astep -> bfword (i) = 0;
	end;

/*  */

	aste.usedf = "1"b;				/* mark it as being used */
	a_ptp = addrel (astep, sst.astsize);		/* get a pointer to the page table */

	if slte.wired then do;			/* if this a temp wired seg */
		if a_segno = pdsno then no_pages_wired = 1; /* wire first page of pds */
		else if a_segno = dsegno then no_pages_wired = 1; /* wire first page of dseg */
		else if a_segno = pl1_ops_no then no_pages_wired = pl1_ops_pages; /* wire just the first few pages */
		else if a_segno = error_table_no then no_pages_wired = 1;
		else no_pages_wired = save_pts;	/* otherwise wire all pages */
		sst.wired = sst.wired + no_pages_wired;
	     end;
	else no_pages_wired = 0;

	do i = 0 to pts - 1;			/* initialize the page table array for the entry */
	     call ptw_util_$make_null (addrel (a_ptp, i), make_sdw_null_addr);
	     if i < no_pages_wired then call ptw_util_$set_wired (addrel (a_ptp, i));
	end;

	if slte_uns.breakpointable then
	     if no_pages_wired > 0 then do;		/* wired seg - use breakpoint_page */
	          call ptw_util_$make_core (addrel (a_ptp, save_pts - 1), absadr (addr (breakpoint_page$), (0)));
		call ptw_util_$set_wired (addrel (a_ptp, save_pts - 1));
		if no_pages_wired = save_pts then sst.wired = sst.wired - 1;  /* wired was one too high from counting all pages as new wired pages */
	     end;

	if ^unthreaded				/* If threaded.. */
	then if slte.temp_seg then call thread$cin (astep, sst.atempp);
	     else if slte.branch_required then call thread$cin (astep, sst.ausedp (ptsi));
	     else if slte.init_seg then call thread$cin (astep, sst.ainitp);
	     else if slte.wired then do;		/* if this is wired then */
		     unthreaded = "1"b;		/* don't thread it */
		     aste.hc = "1"b;		/* and mark as hardcore */
		end;
	     else aste.hc = "1"b;

	a_tsdw = get_ptrs_$given_astep (astep);		/* Get initial SDW, */
	call sdw_util_$dissect (addr (a_tsdw), addr (sdwi)); /* and find out what's in it now */
	sdwi.size = save_pts * 1024;			/* Set the size as appropriate for a paged segment */
	string (sdwi.access) = slte.access;		/* Access from SLT entry */
	if sys_info$system_type = L68_SYSTEM then /* And cache, if appropriate */
	     sdwi.cache = slte.cache;
	call sdw_util_$construct (addr (a_tsdw), addr (sdwi)); /* and put it all back together again */

	aste.nqsw = "1"b;				/* turn on no quota switch */
	aste.dnzp = "1"b;				/* never null hardcore pages */
	aste.ddnp = "1"b;				/* Never report prewithdrawns to free */
	aste.strp = bit (a_segno, 18);		/* store segment number in AST */
	aste.ehs = "1"b;				/* Turn entry hold switch on if appropriate */
	aste.hc_sdw = "1"b;				/* sdw for a hardcore seg so no trailer */
	aste.vtocx = -1;				/* VTOCE-less segment */

	a_astep = astep;

/* If disk abs seg, don't attempt to prewithdraw pages. */

	if no_pages then aste.csl, aste.records = bit (bin (slte_uns.cur_length, 9), 9);  /* so status_, et al, know about it */

	if slte.abs_seg | no_pages then return;		/* If abs_seg forced, don't prewithdraw */
						/* or if pages are to be supplied by the caller */

/* Allocate a volume with a hardcore partition for the segment. */

	if hcp_thread = 0 then do;			/* This gets interesting. */
		if sst.root_pvtx = 0 then do;		/* PVT created before init-pvt */
			aste.pvtx = -1;		/* Cause a fault if used. */
			return;
		     end;
		call syserr (1, "make_sdw: no hardcore partitions available.");
	     end;

/* Allocate deciduous segments on root phys vol */
	if slte.branch_required then do;
		pvtx = sst.root_pvtx;
		pvtep = addr (pvt_array (pvtx));
		goto got_pvtx;
	     end;

	do pvtx = hcp_thread repeat pvte.brother_pvtx;
	     pvtep = addr (pvt_array (pvtx));
	     if pvte.nleft >= save_pts then go to got_pvtx;
	     if pvte.brother_pvtx = hcp_thread then call syserr
		     (1, "make_sdw: out of hardcore partition for ^a.", namep -> segnam.name (1));
	end;
got_pvtx:
	hcp_thread = pvte.brother_pvtx;		/* Keep chain rotating */
	aste.pvtx = pvtx;				/* This is where seg will go. */
	aste.hc_part = "1"b;			/* Uses a hardcore partition */

/* Touch all the pages, causing withdrawing nulled addresses against hc partition */

	call pmut$swap_sdw (asp, addr (a_tsdw));
	do i = 0 to save_pts - 1;			/* real cur length */
	     dummy = asp -> seg (i * 1024);		/* touch for nulled withdraw */
	end;

	if slte.breakpointable then do;		/* set sentinel in bkpt_page (keeps page from being nulled) */
	     sdwi.access.write = "1"b;
	     call sdw_util_$construct (addr (temp_sdw), addr (sdwi)); /* force access */
	     call pmut$swap_sdw (asp, addr (temp_sdw));
	     addrel (asp, (save_pts - 1) * 1024) -> bkpt_page.sentinel = BKPT_page_sentinel;
	end;

	temp_sdw = 0;
	call pmut$swap_sdw (asp, addr (temp_sdw));	/* clear slot */

	return;

%page;
/* Entries to manage allocation from the Hardcore Partition

   thread_hcp adds a PVTE index to the thread

   reset_hcp terminates allocation from the Hardcore Partition
*/

thread_hcp:
     entry (a_pvtx);

	pvt_arrayp = addr (pvt$array);
	if hcp_thread = 0				/* This is the first pvtx */
	then hcp_thread, hcp_first = a_pvtx;
	else do;
		pvt_array (hcp_thread).brother_pvtx = a_pvtx;
		hcp_thread = a_pvtx;
	     end;

	pvt_array (a_pvtx).brother_pvtx = hcp_first;

	return;


reset_hcp:
     entry;

	hcp_thread, hcp_first = 0;
	return;


%page; %include aste;
%page; %include bce_breakpoint_page;
%page; %include mc;
%page; %include null_addresses;
%page; %include pvte;
%page; %include sdw_info;
%page; %include slt;
%page; %include slte;
%page; %include sst;
%page; %include system_types;
%page; %include variable_tables;

/*  */

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   make_sdw: XXXk ast pool to small.

   S: $crash

   T: $init

   M: There were not enough AST entries of size XXX k to allocate
   the permanent AST entries of the supervisor.

   A: Increase the number of AST entries of that size, as specified on
   the SST CONFIG card, substantially, and reboot.

   Message:
   make_sdw: no hardcore partitions available.

   S: $crash

   T: $init

   M: No hardcore partitions were defined on any of the packs on the drives
   specified by the ROOT CONFIG card. At least the RPV must have a hardcore
   partition.  Supervisor segments cannot be created.

   A: If this is a cold boot, which is most likely, the RPV was
   initialized without a hardcore partition.  It must be reinitialized.
   Check the PART HC CONFIG card, one of which must describe the RPV
   during a cold boot, and reboot.  If this is not a cold boot, the RPV
   has been damaged, and volume recovery must be undertaken.

   Message:
   make_sdw: out of hardcore partition for SEGNAME.

   S: $crash

   T: $init

   M: In attempting to allocate space for hardcore segment SEGNAME, no
   more room could be found in any of the defined hardcore partitions.

   A: If this is a cold boot, redefine the hardcore partition of the RPV
   to be larger.  At least 1000 (decimal) records is recommended.  Change
   the PART HC CONFIG card describing the RPV to indicate this, and
   reboot.  If this is not a cold boot, this situation is highly unlikely
   and indicates damage to one or more RLV volume labels.  Volume
   recovery for part or all of the RLV should be undertaken.

   END MESSAGE DOCUMENTATION */

     end make_sdw;




		    map_onto_disk.pl1               11/11/89  1138.5rew 11/11/89  0801.1       21609



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */
map_onto_disk: proc (pvtx, first_record, num_records, seg_ptr, contents_valid);

/* Utility procedure to map a segment onto a specified area of disk.
Written October 1983, Keith Loepere. */

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

dcl  addr			        builtin;
dcl  bin			        builtin;
dcl  bit			        builtin;
dcl  contents_valid		        bit (1) aligned parameter; /* 0 => contents of disk are not important, map using nulled addresses */
dcl  first_record		        fixed bin (20) parameter; /* first record on disk to map */
dcl  make_sdw$no_pages	        entry (fixed bin (15), fixed bin (71), ptr, ptr);
dcl  num_records		        fixed bin parameter;	/* num records to map */
dcl  page			        fixed bin;		/* loop index */
dcl  page_table		        (0:num_records - 1) bit (36) aligned based (ptp);
dcl  partition_sdw		        fixed bin (71);	/* for created segment */
dcl  pmut$swap_sdw		        entry (ptr, ptr);
dcl  ptp			        pointer;		/* to page table for segment */
dcl  ptw_util_$make_disk	        entry (ptr, fixed bin (20));
dcl  ptw_util_$make_null_disk	        entry (ptr, fixed bin (20));
dcl  pvtx			        fixed bin parameter;	/* pvtx of disk to map */
dcl  seg_ptr		        ptr parameter;	/* ptr to resultant segment */
dcl  segno		        builtin;
%page;

/* Get an ASTE that describes the segment, with a page table full of null 
addresses. Then make it point to the disk. */

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

	aste.pvtx = pvtx;
	aste.msl, aste.csl, aste.records = bit (bin (num_records, 9), 9);

	do page = 0 to num_records - 1;
	     if contents_valid then call ptw_util_$make_disk (addr (page_table (page)), page + first_record);
	     else call ptw_util_$make_null_disk (addr (page_table (page)), page + first_record);
	end;

	call pmut$swap_sdw (seg_ptr, addr (partition_sdw));
	return;
%page; %include aste;
     end;




		    pre_link_hc.pl1                 11/11/89  1138.5r w 11/11/89  0801.1       31671



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

/* Snap all the links in the hardcore. */
/* Written November 1982 by C. Hornig */

dcl  definitions_$ external;
dcl  lot$ external;
dcl  slt$ external;

dcl  get_defptr_ entry (ptr, ptr, ptr, ptr, fixed bin (35));
dcl  slt_manager$get_seg_ptr entry (char (32) aligned) returns (ptr);

dcl  segno fixed bin (15);

/* * * * * * * * * * PRE_LINK_HC * * * * * * * * * */

	definitions_ptr = addr (definitions_$);
	lotp = addr (lot$);
	sltp = addr (slt$);

	do segno = slt.first_sup_seg to slt.last_sup_seg;
	     call process_seg;
	end;

	do segno = slt.first_init_seg to slt.last_init_seg;
	     call process_seg;
	end;

	return;

/* * * * * * * * * * PROCESS_SEG * * * * * * * * * * */

process_seg:
     procedure;

dcl  (lp, dp, link_ptr, tgtp) ptr;
dcl  link_offset fixed bin (18);

	if unspec (lot.lp (segno)) = ""b then return;

	lp = lot.lp (segno);			/* linkage section */
	dp = lp -> header.def_ptr;			/* definitions */

	do link_offset = binary (lp -> header.stats.begin_links, 18) by 2
	     to binary (lp -> header.stats.block_length, 18) - 1;

	     link_ptr = addrel (lp, link_offset);
	     if link_ptr -> link.ft2 ^= "46"b3 then goto next_link;
						/* only look at unsnapped links */
	     tgtp = null ();
	     exp_ptr = addrel (dp, link_ptr -> link.exp_ptr);
						/* find exp word */
	     type_ptr = addrel (dp, exp_word.type_relp);	/* and type pair */
	     if type_pair.type = LINK_SELF_BASE
	     then if type_pair.segname_relp = SECTION_TEXT then tgtp = baseptr (segno);
		else if type_pair.segname_relp = SECTION_LINK then tgtp = lp;
		else goto next_link;
	     else if type_pair.type = LINK_REFNAME_BASE then call find_seg;
	     else if (type_pair.type = LINK_REFNAME_OFFSETNAME) | (type_pair.type = LINK_CREATE_IF_NOT_FOUND) then do;
		call find_seg;
		call find_def;
		end;
	     else goto next_link;

	     tgtp = addrel (tgtp, exp_word.expression);
	     addr (tgtp) -> link.modifier = link_ptr -> link.modifier;
	     link_ptr -> link = addr (tgtp) -> link;

next_link:
	end;

	return;

/* * * * * * * * * FIND_SEG * * * * * * * * */

find_seg:
	procedure;

	     tgtp = slt_manager$get_seg_ptr ((addrel (dp, type_pair.segname_relp) -> acc_string.string));
	     if tgtp = null () then goto next_link;
	     return;
	end find_seg;

/* * * * * * * * * FIND_DEF * * * * * * * * * */

find_def:
	procedure;

dcl  code fixed bin (35);

	     call get_defptr_ (addrel (definitions_ptr, definitions.dot (binary (baseno (tgtp), 15)).offset),
		addrel (dp, type_pair.segname_relp), addrel (dp, type_pair.offsetname_relp), def_ptr, code);
	     if code ^= 0 then goto next_link;

	     if definition.class = CLASS_TEXT then ;
	     else if definition.class = CLASS_LINKAGE then tgtp = lot.lp (binary (baseno (tgtp), 15));
	     else goto next_link;

	     tgtp = addrel (tgtp, definition.thing_relp);

	     return;
	end find_def;
%page;
%include definition_dcls;

     end process_seg;

%include hc_definitions_seg;
%include linkdcl;
%include lot;
%include slt;

     end pre_link_hc;




		    real_initializer.pl1.pmac       11/11/89  1138.5rew 11/11/89  0800.0      339858



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

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

/* WARNING: THIS PROGRAM MUST BE RUN THROUGH PL1_MACRO BEFORE COMPILATION */

real_initializer:
     procedure;

/* *	REAL_INITIALIZER
   *
   *	This is the driving procedure for Multics initialization. It is called from
   *	initializer, a component of bound_active_1 which exists solely to call this
   *	program, so this program can be an init-seg and get deleted. Because it is
   *	essentially an extension of initializer itself, it calls itself initializer.
   *
   *      As of this program's installation, the collection structure
   *      of the MST is as follows:
   *      "collection" 0:
   *        - the bootable label, if booted from tape (bootload_tape_label)
   *        - bound_bootload_0, which:
   *            & sets up a fault environment
   *	      & loads tape firmware as needed, finding in in collection 0.5
   *            & loads collection 1.0
   *            & transfers to bootload_1 which
   *	         sets up the pl1 environment, and calls initializer, 
   *	         which calls us.
   *        - other segments at fixed absolute locations, such as the
   *	     flagbox, and iom_mailbox.
   *       collection 0.5
   *        - firmware images for tape mpc's. bound_bootload_0 reads through
   *          these until it finds the one it wants, and then uses it
   *          to boot the MPC. It and all other are then discarded.

   *       collection 1.0
   *        - formerly collection 1. Programs to initialize paging and io.
   *          they include this program, and are called by it.
   *       collection 1.2
   *	  - runcoms, config decks, etc for bootload Multics command level.
   *	    They are loaded after the loading of collection 1.0 but before 
   *	    entering any user subsystems.  They are paged.
   *	 collection 1.5
   *	  - programs paged off the bce partition for use by bce.

   *       collection 2.0:
   *        - formerly collection 2. The hardcore file system and relatives.
   *
   *       collection 3.0:
   *        - user ring programs neccessary for a cold boot.
   *
   *     This program can be called on in a number of situations.
   *     First, there either is or is not a config deck available.
   *        This is indicated by the value of sys_boot_info$assume_config
   *        deck.
   *     Second, there are three possible initializations to be performed:
   *      - service Multics. Complete initialization and return
   *        to initializer.pl1 for the call out to ring 1.
   *      - Collection 1 command level. Complete initialization as
   *        far as making segs paged, but use a special partition
   *        on the RPV other than the HC partition. Store an image
   *        of the unpaged collection 1 environment on disk to be
   *        returned to in case of a crash, before making_segs_paged.
   *      - cool boot without BOS, and therefore
   *        without a config deck. This happens iff sys_boot_info$assume_config
   *        deck is off. Fabricate a minimal config, asking the operator
   *        (or trusting sys_boot_info) for the RPV model, device, and channel,
   *        load firmware into the rpv disk mpc. Read a config deck from
   *        the config partition on the RPV, then start one of the other
   *        two initializations using the real config deck.
   *
*****************************************************************************
****** JOURNALIZATION *******************************************************
*****************************************************************************
   *
   *      Modification history:
   *	80-12-21, W. Olin Sibert: Split out of initializer.pl1
   *      82-07-01, BIM: Partially rethought, and brought up to date with 
   *         current version of initializer.pl1 (mr10.0)
   *      82-08-01, BIM: Metering and check_stop added back.
   *      82-08-12, JJB: RLV parasites expunged, scavenger added 
   *      83-02-05, ENK: kst_util$garbage_collect
   *      83-04-15, KPL: bootload command level, (through 5/84).
   *	83-06-20, E. A. Ranzenbach: Modified for ocdcm_$init_all_consoles
   *	   and ocdcm_$reconfigure.
   * 	83-06-26, CLJ: Deleted iobm stuff
   *	84-08-20, KPL: Modified to not call scs_and_clock_init
   *	   when shutting down bce.
   *	84-10-17, WOS: Modified for new init_syserr_log and to initialize
   *	   syserr log names in ring zero instead of AS initialization.
   *      84-11-09, ADB: Added entry point collection_2 and collection_3 to
   *         make setting breakpoints in bce probe easier.
   *	85-01-09, Keith Loepere: fix retry_rpv.
   *	85-01-23, Keith Loepere: power up date/time software in paged bce;
   *	   permanent collection 1.5 segs.
   */

/****^  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.
  2) change(86-09-05,Farley), approve(86-07-18,MCR7439),
     audit(86-09-24,Fawcett), install(86-10-20,MR12.0-1189):
     To move IOI into collection 1.0, so that it will be available
     at BCE. Also reset sys_info$service_system. Added missing MESSAGE doc.
                                                   END HISTORY COMMENTS */

/****     MEMORY LAYOUT ISSUES:
   *      when this program is called, all of collection 1 has
   *      been loaded into the first 512K of absolute memory.
   *      init-segs and to-be-made-paged segs are high, and
   *      everything else (perm-wired segs) are low.
   *      
   *      Depending on what kind of initialization we are up to,
   *      this may need rearrangement.
   *
   *      If service is to be booted, the high segments are relocated
   *      to actually high memory, leaving the low memory to be used
   *      for the sst and core map (which want to be high in the low 
   *      controller).
   *      
   *      If we are booting the command environment, everything is left as is, 
   *      since the returnable-to system will be a pre-make-segs-paged
   *      core image, and it wants to be restricted to 512K.
   *      
   *      If there is no config deck at all, then we have no idea 
   *      memory is around, and there is no choice but to stay in 512K.
   *	Once the config deck has been read, all memory obtained with
   *      get_main is returned, and a command environment initialization is 
   *      undertaken.
   *      
   *      If the config deck is changed, initialization to store
   *      the returnable-to system is repeated.
   *      
   *      To turn a command environment into a service boot, the special
   *      segments, if any, are deleted, the memory allocated with
   *      get_main is returned, and a service initialization is undertaken.

   */

%set STOP_NUM to 0;

dcl  addr				builtin;
dcl  baseptr			builtin;
dcl  bin				builtin;
dcl  binary			builtin;
dcl  null				builtin;
dcl  pointer			builtin;
dcl  substr			builtin;

dcl  code				fixed bin (35);
dcl  done_one_initialization		bit (1) aligned;
dcl  meter_initialization		bit (1) aligned;
dcl  parm_ptr			pointer;
dcl  ready_to_y_and_s		bit (1) aligned;
dcl  saved_free_core_size		fixed bin (24);
dcl  saved_free_core_start		fixed bin (24);	/* Saved state of the SLT core allocation marks */
dcl  saved_iupt_lth			fixed bin;	/* allocations in int_unpaged_page_tables */
dcl  saved_upt_lth			fixed bin;	/* in unpaged_page_tables */
dcl  yell_and_scream		bit (1) aligned;

dcl  bce_abs_seg$free		entry;
dcl  config_$find			entry (char (4) aligned, pointer);
dcl  config_$find_parm		entry (char (4) aligned, pointer);
dcl  condition_			entry (char (*), entry);
dcl  initial_error_handler		entry;
dcl  ocdcm_$reconfigure		entry (char (4), fixed bin (17), fixed bin (35));
dcl  pmut$set_mask			entry (bit (72) aligned);
dcl  pmut$trace_rsw			entry (bit (36) aligned);
dcl  syserr			entry options (variable);
dcl  syserr$error_code		entry options (variable);

dcl  active_all_rings_data$system_id	char (32) ext static;
dcl  active_all_rings_data$version_id	char (32) ext static;
dcl  bce_request_table_$bce_request_table_ ext static;
dcl  config_deck$			(4096) bit (36) aligned ext static;
dcl  int_unpaged_page_tables$		ext static;
dcl  safe_config_deck$		(4096) bit (36) aligned ext static;
dcl  scs$sys_level			bit (72) aligned external static;
dcl  slt$				fixed bin external static;
dcl  sys_boot_info$assume_config_deck	bit (1) aligned external; /* implies BOS, by the way */
dcl  sys_boot_info$boot_without_query	bit (1) aligned external static;
dcl  sys_boot_info$bootload_mem_size	fixed bin (26) ext static;
dcl  sys_boot_info$config_has_been_modified bit (1) aligned ext static;
dcl  sys_boot_info$contig_mem_size	fixed bin (26) ext static;
dcl  sys_boot_info$rpv_cold_boot	bit (1) aligned external static;
dcl  sys_boot_info$system_type	fixed bin external static;
dcl  sys_info$initialization_state	fixed bin external static;
dcl  sys_info$service_system		bit (1) aligned external static;
dcl  sys_info$system_type		fixed bin external static;
dcl  1 toehold$			aligned external like toe_hold;
dcl  unpaged_page_tables$		ext static;
%page;

/* The programs called to to actual intitialization-like things. */

dcl  accept_rpv			entry;
dcl  announce_chwm$after		entry;
dcl  announce_chwm$before		entry;
dcl  bce_get_to_command_level		entry (ptr);
dcl  collect_free_core		entry;
dcl  dbm_man$init			entry;
dcl  debug_check$copy_card		entry;
dcl  delete_segs$temp		entry;
dcl  dir_lock_init			entry;
dcl  disk_reader$init		entry;
dcl  disk_reader$final		entry;
dcl  establish_config_deck		entry;
dcl  establish_temp_segs		entry;
dcl  find_file_partition		entry;
dcl  find_rpv_subsystem		entry;
dcl  fnp_init			entry;
dcl  get_io_segs			entry;
dcl  getuid$init			entry;
dcl  init_bce$paged			entry;
dcl  init_bce$wired			entry;
dcl  init_branches			entry;
dcl  init_dm_journal_seg		entry;
dcl  init_early_config		entry;
dcl  init_hardcore_gates		entry;
dcl  init_lvt			entry;
dcl  init_partitions		entry;
dcl  init_pvt			entry;
dcl  init_root_dir			entry;
dcl  init_root_vols			entry (fixed bin (35));
dcl  init_scavenger_data		entry;
dcl  init_sst$early			entry;
dcl  init_sst$normal		entry;
dcl  init_sst_name_seg		entry;
dcl  init_stack_0			entry;
dcl  init_str_seg			entry;
dcl  init_sys_var			entry;
dcl  init_toehold			entry;
dcl  init_toehold$save_safe_config_deck entry;
dcl  init_vtoc_man			entry;
dcl  initialize_faults$fault_init_one	entry;
dcl  initialize_faults$fault_init_two	entry;
dcl  initialize_faults$interrupt_init	entry;
dcl  io_config_init			entry;
dcl  ioi_init			entry;
dcl  ioi_page_table$init		entry;
dcl  iom_data_init			entry;
dcl  kst_util$garbage_collect		entry (fixed bin (35));
dcl  load_disk_mpcs			entry;
dcl  load_mst			entry;
dcl  load_mst$init_commands		entry;
dcl  load_mst$make_permanent		entry;
dcl  load_system			entry;
dcl  make_segs_paged		entry;
dcl  move_non_perm_wired_segs		entry;
dcl  ocdcm_$init_all_consoles		entry;
dcl  pre_link_hc			entry;
dcl  read_disk$init			entry;
dcl  scas_init			entry;
dcl  scs_and_clock_init$date_time	entry;
dcl  scs_and_clock_init$early		entry;
dcl  scs_and_clock_init$normal	entry;
dcl  segment_loader			entry;
dcl  init_syserr_log		entry;
dcl  syserr_seg_manager$initialize_log_names entry;
dcl  tape_reader$final		entry;
dcl  tape_reader$init		entry;
dcl  tc_init			entry;
dcl  tc_init$early			entry;
dcl  tc_init$part_2			entry;
dcl  tc_init$start_other_cpus		entry;
%page;
/* Set up debugging flags */

	done_one_initialization = "0"b;
	meter_initialization = "0"b;
	yell_and_scream = "0"b;

	sys_info$system_type = sys_boot_info$system_type;
	addr (unpaged_page_tables$) -> upt.sst_absloc = 0;
	addr (unpaged_page_tables$) -> upt.sst_last_loc = 0; /* so we don't confuse page table lookers */

	addr (flagbox$) -> fgbx.return_to_bce_command = "";

	if sys_boot_info$assume_config_deck then do;	/* if we came from BOS */
	     parm_ptr = null;
	     call config_$find_parm ("mtin", parm_ptr);
	     meter_initialization = (parm_ptr ^= null);

	     parm_ptr = null ();
	     call config_$find_parm ("erly", parm_ptr);
	     if parm_ptr ^= null () then sys_boot_info$assume_config_deck = "0"b;
	end;

/* Whatever the task at hand, set up fault handling */
/* The prds, set up by a call from scs_and_clock_init, is */
/* needed. */

/*	if meter_initialization then call initial_meters$init; */

/* Everyone is interested in the SLT */

	sltp = addr (slt$);

/* This cannot have any effect until faults are initialized */

	call condition_ ("any_other", initial_error_handler);

/* First see if we need to do an exceptional initialization to */
/* Find the config deck. */

	ready_to_y_and_s = "0"b;

	sys_info$service_system = "0"b;
	sys_info$initialization_state = 1;
	sys_info$collection_1_phase = EARLY_INITIALIZATION;

	if sys_boot_info$assume_config_deck then do;

/* When running BOS, we turn on rpv_cold_boot so that the normal pass */
/* of init_root_vols will format the root. When not running BOS, */
/* this is done in the early initialization pass. */

	     intk_cardp = null ();
	     call config_$find (INTK_CARD_WORD, intk_cardp);
	     if intk_cardp = null () then call syserr (CRASH, "initializer: intk card missing.");
	     sys_boot_info$rpv_cold_boot = (intk_card.warm_or_cold = "cold");
	     intk_card.warm_or_cold = "warm";

/* warm/cold here implies that of bce.  warm/cold of service is decided in boot
command */

%set STOP_NUM to STOP_NUM + 1;

	     call check_stop (STOP_NUM, "scs_and_clock_init$normal");
	     call scs_and_clock_init$normal;		/* may get called again to reflect config deck changes */

	     sys_info$collection_1_phase = BOOT_INITIALIZATION;
	end;

bootload_Multics:
	if sys_info$collection_1_phase ^= SERVICE_INITIALIZATION then do;
	     call collection_1;
	     if toehold$.memory_state = At_bce__shutdown then do; /*  return from a previous boot */
		call TURN_OFF$$masked;
		sys_info$collection_1_phase = SHUT_INITIALIZATION; /* start up again */
	     end;
	     else if toehold$.memory_state = At_bce__crash then do;
		call TURN_OFF$$masked;
		if toehold$.multics_state.old_memory_state = At_bce__early then sys_info$collection_1_phase = RE_EARLY_INITIALIZATION;
		else if toehold$.multics_state.old_memory_state = At_bce__boot then sys_info$collection_1_phase = BCE_CRASH_INITIALIZATION;
		else sys_info$collection_1_phase = CRASH_INITIALIZATION; /*  we made it far enough to feel config_deck was not the crash cause */
	     end;
	     else do;				/* normal pass completion */
		call TURN_OFF;
		if sys_info$collection_1_phase = EARLY_INITIALIZATION then
		     sys_info$collection_1_phase = BOOT_INITIALIZATION;
		else sys_info$collection_1_phase = SERVICE_INITIALIZATION;
	     end;
	     go to bootload_Multics;
	end;

/* Perform normal initialization. */

	call collection_1;
%page;
collection_1:
     proc;

/* Repeated collection 1 initialization.  This is run 4 times (for 
corresponding values of sys_info$collection_1_phase.  First to find the
config deck.  Second, to set up the crash handler and command environments.
Fourth for service.  The first uses limited everything.  The second uses 
limited memory (and sst).  The fourth uses all. 
The "third" time is when we shutdown and crash, to rebuild tables. */

collection_1_start:
	if sys_info$collection_1_phase = RE_EARLY_INITIALIZATION | sys_info$collection_1_phase = BCE_CRASH_INITIALIZATION then
	     config_deck$ = safe_config_deck$;

	sys_boot_info$config_has_been_modified = "0"b;	/* set when modified, forces query when booting service */

	ready_to_y_and_s = "0"b;

	saved_free_core_start = slt.free_core_start;
	saved_free_core_size = slt.free_core_size;
	saved_iupt_lth = addr (int_unpaged_page_tables$) -> upt.current_length;
	saved_upt_lth = addr (unpaged_page_tables$) -> upt.current_length;
	sys_boot_info$contig_mem_size = sys_boot_info$bootload_mem_size;
						/* for the benefit of announce_chwm */

	if sys_info$collection_1_phase = EARLY_INITIALIZATION then do;

%set STOP_NUM to STOP_NUM + 1;

	     call check_stop (STOP_NUM, "init_early_config");
	     call init_early_config;			/* Fill in console, clock default, tape mpc, itk, sst, tcd, */
						/* bootload cpu, mem, iom and dummy rpv subsystem */
	end;

%set STOP_NUM to STOP_NUM + 1;

RETRY_RPV:
	if sys_info$collection_1_phase = EARLY_INITIALIZATION then do;
						/* The early entrypoint is as the normal, except that it fills in */
						/* port number on the cpu card. */
	     call check_stop (STOP_NUM, "scs_and_clock_init$early");
	     call scs_and_clock_init$early;
	end;
	else do;
	     call check_stop (STOP_NUM, "scs_and_clock_init$normal");
	     call scs_and_clock_init$normal;		/* get new clok card if there is one */
	end;

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "initialize_faults$fault_init_one");
	call initialize_faults$fault_init_one;

%set STOP_NUM to STOP_NUM + 1;

	if sys_info$collection_1_phase = SERVICE_INITIALIZATION then do;
	     call check_stop (STOP_NUM, "move_non_perm_wired_segs");
	     call move_non_perm_wired_segs;		/* use memory, move segs, fix SLT header */
	end;

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "get_io_segs");
	call get_io_segs;				/* Allocate the disk_seg, pvt, iom_data, and ioi_data */
						/* appropriately for the configuration */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "iom_data_init");
	call iom_data_init;				/* Initialize the iom_data for all configured devices. */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "ocdcm_$init_all_consoles");
	call ocdcm_$init_all_consoles;

	parm_ptr = null;
	call config_$find_parm ("loud", parm_ptr);
	yell_and_scream = (parm_ptr ^= null);

	ready_to_y_and_s = "1"b;

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "scas_init");
	call scas_init;				/* Set up the SCAS again */

%set STOP_NUM to STOP_NUM + 1;

	if sys_info$collection_1_phase ^= SERVICE_INITIALIZATION then do;
	     call check_stop (STOP_NUM, "tc_init$early");
	     call tc_init$early;
	end;
	else do;
	     call check_stop (STOP_NUM, "tc_init");
	     call tc_init;
	end;

%set STOP_NUM to STOP_NUM + 1;

	if sys_info$collection_1_phase = SERVICE_INITIALIZATION then do;
	     call check_stop (STOP_NUM, "init_sst$normal");
	     call init_sst$normal;			/* Set up the full sized SST, with table sizes determined */
	end;
	else do;
	     call check_stop (STOP_NUM, "init_sst$early");
	     call init_sst$early;
	end;

	call debug_check$copy_card;			/* not worth a stop */

	if sys_info$collection_1_phase = EARLY_INITIALIZATION
	     | sys_info$collection_1_phase = BOOT_INITIALIZATION
	     | sys_info$collection_1_phase = SERVICE_INITIALIZATION then
	     call announce_chwm$before;		/* from the config deck, and announce the size of memory. */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "disabling slt allocation");
	slt.free_core_start, slt.free_core_size = 0;	/* no more SLT mem allocations */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "initialize_faults$interrupt_init");
	call initialize_faults$interrupt_init;

%set STOP_NUM to STOP_NUM + 1;

	if ^done_one_initialization then do;
	     call check_stop (STOP_NUM, "init_bce$wired");/* Bootload Command Environment */
	     call init_bce$wired;
	end;

	if sys_info$collection_1_phase = EARLY_INITIALIZATION then do;

/* This call locates the RPV either via sys_boot_info or */
/* operator query, as needed. it fills in the config */
/* ROOT card, and fixes the fields in the prph dska and appropriate mpc */
/* and (someday) mpcs cards. After it is called, paging can really be setup */

%set STOP_NUM to STOP_NUM + 1;

	     call check_stop (STOP_NUM, "find_rpv_subsystem");
	     call find_rpv_subsystem;
	end;

	if ^((sys_info$collection_1_phase = SERVICE_INITIALIZATION) |
	     (sys_info$collection_1_phase = EARLY_INITIALIZATION) |
	     (sys_info$collection_1_phase = BOOT_INITIALIZATION & sys_boot_info$assume_config_deck)) then do;

%set STOP_NUM to STOP_NUM + 1;

	     call check_stop (STOP_NUM, "load_disk_mpcs");
	     call load_disk_mpcs;
	end;

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "init_pvt");
	call init_pvt;

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "read_disk$init");
	call read_disk$init;			/* This has to come AFTER init_pvt */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "init_root_vols");
	call init_root_vols (code);
	if code ^= 0 then
	     if sys_info$collection_1_phase = EARLY_INITIALIZATION then do;
		sys_boot_info$boot_without_query = "0"b;
		call TURN_OFF;
		go to RETRY_RPV;
	     end;
	     else call syserr (CRASH, "initializer: bad root volume.");

%set STOP_NUM to STOP_NUM + 1;

	if sys_info$collection_1_phase ^= SERVICE_INITIALIZATION then do;

	     call check_stop (STOP_NUM, "establish_temp_segs");
	     call establish_temp_segs;

%set STOP_NUM to STOP_NUM + 1;

	     call check_stop (STOP_NUM, "find_file_partition");
	     call find_file_partition;

	     if ^done_one_initialization then do;

%set STOP_NUM to STOP_NUM + 1;

		call check_stop (STOP_NUM, "tape_reader$init");
		call tape_reader$init;		/* Initialize the tape reading package. */

%set STOP_NUM to STOP_NUM + 1;

		call check_stop (STOP_NUM, "load_mst");
		call load_mst;

%set STOP_NUM to STOP_NUM + 1;

		call check_stop (STOP_NUM, "tape_reader$final");
		call tape_reader$final;
	     end;

%set STOP_NUM to STOP_NUM + 1;

	     call check_stop (STOP_NUM, "load_mst$init_commands");
	     call load_mst$init_commands;		/* and get into addr space
						load_mst$make_permanent is the counterpart for service pass */

%set STOP_NUM to STOP_NUM + 1;

	     if ^done_one_initialization then do;
		call check_stop (STOP_NUM, "init_bce$paged");
		call init_bce$paged;		/* and add to bce_data switches */
	     end;
	end;
	else do;

%set STOP_NUM to STOP_NUM + 1;

	     call check_stop (STOP_NUM, "load_mst$make_permanent");
	     call load_mst$make_permanent;		/* move coll 1.5 perm segs into coll 2 */
	end;

	sys_boot_info$rpv_cold_boot = "0"b;		/* in case it was on; we are done with special cold boot operations */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "scs_and_clock_init$date_time");
	call scs_and_clock_init$date_time;		/* power up the date/time software */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "io_config_init");
	call io_config_init;			/* initialize io_config_data */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "ioi_init");
	call ioi_init;				/* Initialize the I/O Interfacer. */

%set STOP_NUM to STOP_NUM + 1;

	if sys_info$collection_1_phase = SHUT_INITIALIZATION then
	     sys_info$collection_1_phase = BOOT_INITIALIZATION;

	safe_config_deck$ = config_deck$;		/* config_deck$ is good, save for crashing */

	if ^done_one_initialization then do;
	     done_one_initialization = "1"b;		/* don't redo per-system initializations (set before saving toehold) */

/* Set up crash handler. */

	     call check_stop (STOP_NUM, "init_toehold");
	     call init_toehold;
	     if toehold$.memory_state = At_bce__crash | toehold$.memory_state = At_bce__shutdown then return; /* return to bce returns to image saved here */
	end;
	else if sys_info$collection_1_phase = EARLY_INITIALIZATION | sys_info$collection_1_phase = BOOT_INITIALIZATION | sys_info$collection_1_phase = SERVICE_INITIALIZATION then do;
	     call check_stop (STOP_NUM, "init_toehold$save_safe_config_deck");
	     call init_toehold$save_safe_config_deck;
	end;

	if sys_info$collection_1_phase = RE_EARLY_INITIALIZATION then
	     sys_info$collection_1_phase = EARLY_INITIALIZATION;

	if sys_info$collection_1_phase = EARLY_INITIALIZATION then
	     toehold$.memory_state = At_bce__early;
	else if sys_info$collection_1_phase = BOOT_INITIALIZATION then
	     toehold$.memory_state = At_bce__boot;
	else if sys_info$collection_1_phase = SERVICE_INITIALIZATION then
	     toehold$.memory_state = Multics;

	if sys_info$collection_1_phase = EARLY_INITIALIZATION | sys_info$collection_1_phase = BOOT_INITIALIZATION | sys_info$collection_1_phase = CRASH_INITIALIZATION | sys_info$collection_1_phase = BCE_CRASH_INITIALIZATION then do;

%set STOP_NUM to STOP_NUM + 1;

	     call check_stop (STOP_NUM, "bce_get_to_command_level");
	     call bce_get_to_command_level (addr (bce_request_table_$bce_request_table_));

	     if sys_info$collection_1_phase = BCE_CRASH_INITIALIZATION then do; /* operator decided to boot again */
		sys_info$collection_1_phase = BOOT_INITIALIZATION;
		toehold$.memory_state = At_bce__boot;
	     end;

/* As of now, the Early Initialization has completed its task. */
	end;

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "establish_config_deck");
	call establish_config_deck;			/* read in the config deck */

	if sys_info$collection_1_phase = SERVICE_INITIALIZATION then do;

%set STOP_NUM to STOP_NUM + 1;

	     call check_stop (STOP_NUM, "init_partitions");
	     call init_partitions;

%set STOP_NUM to STOP_NUM + 1;

	     call check_stop (STOP_NUM, "make_segs_paged");
	     call make_segs_paged;			/* Make all pageable segments paged */

%set STOP_NUM to STOP_NUM + 1;

	     call check_stop (STOP_NUM, "collect_free_core");
	     call collect_free_core;			/* and collect all unused core */
	     call announce_chwm$after;		/* Announce the results */
	end;
	return;

     end collection_1;
%page;

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "delete_segs$temp 1");
	call delete_segs$temp;			/* Delete collection one temp segs */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "disk_reader$init");
	call disk_reader$init;

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "segment_loader 2.0");
	call segment_loader;			/* Load collection 2 */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "pre_link_hc 2.0");
	call pre_link_hc;				/* prelink collection 2 */
%page;
/* COLLECTION TWO */

collection_2:
     entry;					/* This will make setting breakpoints in bce_probe easier. */


	sys_info$initialization_state = 2;		/* Begin collection 2 */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "initialize_faults$fault_init_two");
	call initialize_faults$fault_init_two;

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "getuid$init");
	call getuid$init;				/* set up UID generator */
%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "init_vtoc_man");
	call init_vtoc_man;				/* Set up vtoc_man's buffers */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "dbm_man$init");
	call dbm_man$init;				/* Init the volume dumper's bit map. */


%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "init_scavenger_data");
	call init_scavenger_data;

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "init_dm_journal_seg");
	call init_dm_journal_seg;


%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "init_sys_var");
	call init_sys_var;				/* Set some system variables */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "dir_lock_init");
	call dir_lock_init;

%set STOP_NUM to STOP_NUM + 1;

/* ioi_page_table$init is also called by ioi_init, but this call is
   needed to have it switch over to using io_page_table_seg. */

	call check_stop (STOP_NUM, "ioi_page_table$init");
	call ioi_page_table$init;			/* setup standard io_page_table_seg */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "fnp_init");
	call fnp_init;				/* make tty_buf SDW before tc_init$part_2 */

/* *	After this point, changes to the hardcore descriptor segment may
   *	not be reflected in idle process and hproc descriptor segments.
   */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "tc_init$part_2");
	call tc_init$part_2;			/* Stage 2 of traffic control initialization */


%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "init_syserr_log");
	call init_syserr_log ();

	call syserr (LOG, "initializer: Multics ^a (^a) syserr logging initialized", active_all_rings_data$system_id,
	     active_all_rings_data$version_id);


%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "init_str_seg");
	call init_str_seg;				/* Initialize the trailer seg */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "init_sst_name_seg");
	call init_sst_name_seg;			/* Set up the SST name table */


%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "init_hardcore_gates");
	call init_hardcore_gates;			/* initialize linkage pointers in gates */

/* The permanent file system has not been touched up to this point.
   Everything has been placed in the hc partition.		*/


%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "accept_rpv");
	call accept_rpv;				/* Flush PD, salvage, load vol map */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "init_lvt");
	call init_lvt;				/* get LVT in order */

	call condition_ ("bad_dir_", bad_dir_handler);
	call condition_ ("seg_fault_error", seg_fault_handler);

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "init_root_dir");
	call init_root_dir;				/* Make the "root" known. */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "kst_util$garbage_collect");
	call kst_util$garbage_collect ((0));		/* Clean up the KST after salvaging */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "init_branches");
	call init_branches;				/* Set up branches for init. and per-process segs. */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "syserr_seg_manager$initialize_log_names");
	call syserr_seg_manager$initialize_log_names ();

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "init_stack_0");
	call init_stack_0;

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "delete_segs$temp 2.0");
	call delete_segs$temp;			/* Delete collection 2 temp segs */
%page;

/*
   Initialize collection 3.
*/
	sys_info$initialization_state = 3;		/* Begin collection 3 */

collection_3:
     entry;					/* This will make setting breakpoints in bce_probe easier. */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "load_system");
	call load_system;				/* Load collection 3. */

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "disk_reader$final");
	call disk_reader$final;

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "tc_init$start_other_cpus");


	call tc_init$start_other_cpus;		/* Start up additional CPUs */
	sys_info$initialization_state = 4;		/* Begin normal operation (collection 4) */
	sys_info$service_system = "1"b;

%set STOP_NUM to STOP_NUM + 1;

	call check_stop (STOP_NUM, "init_proc");

	return;
%page;
bad_dir_handler:
     procedure (a_mcp, a_condition, a_infop, a_wcp, a_continue);

dcl  a_mcp			pointer parameter;
dcl  a_condition			char (*) parameter;
dcl  a_infop			pointer parameter;
dcl  a_wcp			pointer parameter;
dcl  a_continue			bit (1) aligned parameter;

dcl  ppr				pointer;
dcl  tpr				pointer;

dcl  pvt$root_pvtx			fixed bin ext;

	pvt_arrayp = addr (pvt$array);
	pvt_array (pvt$root_pvtx).vol_trouble_count = pvt_array (pvt$root_pvtx).vol_trouble_count + 1;


CRASH_BAD_DIR:
	call syserr (CRASH, "initializer: bad_dir_ signal raised.");
	goto CRASH_BAD_DIR;



seg_fault_handler:
     entry (a_mcp, a_condition, a_infop, a_wcp, a_continue);

	mcp = a_mcp;
	scup = addr (mc.scu);
	ppr = pointer (baseptr (binary (scu.psr, 15)), scu.ilc);
	tpr = pointer (baseptr (binary (scu.tsr, 15)), scu.ca);

CRASH_SEG_FAULT:
	call syserr$error_code (CRASH, mc.errcode, "initializer: Segment fault error by ^p referencing ^p:", ppr, tpr);
	goto CRASH_SEG_FAULT;

     end bad_dir_handler;

check_stop:
     procedure (P_Stop_Number, About_To);
dcl  P_Stop_Number			fixed bin;
dcl  About_To			char (*);
dcl  cpu_switches			bit (36) aligned;
dcl  call_bce			entry;
dcl  stop_number			fixed bin;
dcl  Stop_Number			fixed bin;

	Stop_Number = P_Stop_Number + 1000 * sys_info$collection_1_phase;

/*	if meter_initialization then call initialization_meters$entry (Stop_Number, About_To); */

	if yell_and_scream & ready_to_y_and_s then call syserr (ANNOUNCE, "initializer: ^d^20t^a^2xstate ^d^2xphase ^d.", Stop_Number, About_To, sys_info$initialization_state, sys_info$collection_1_phase);

	call pmut$trace_rsw (cpu_switches);
	if substr (cpu_switches, 1, 9) = "123"b3 then do;
	     stop_number = BCD (substr (cpu_switches, 10, 24));
	     if stop_number = Stop_Number then do;
		if yell_and_scream & ready_to_y_and_s then call syserr (ANNOUNCE, "initializer: ^a check_stop.", About_To);
		call call_bce;
	     end;
	end;

BCD:
	procedure (Bits) returns (fixed bin);

declare  Bits			    bit (24);
declare  digits			    (4) fixed bin;
declare  digits_bits		    (4) bit (6) unaligned defined (Bits);

	     digits = bin (digits_bits, 6);		/* Aggregate */
	     return (digits (1) * 1000 + digits (2) * 100 + digits (3) * 10 + digits (4));
	end BCD;

     end check_stop;

TURN_OFF: procedure;

dcl  not_masked			bit (1) aligned init ("0"b);

	not_masked = "1"b;

TURN_OFF$$masked: entry;				/* We are already masked; also, our masks may be screwed up so don't try masking. */

	ready_to_y_and_s = "0"b;
	if not_masked then call ocdcm_$reconfigure ("", SUSPEND_CONSOLE_SERVICE, (0)); /* deactivate the console... */
	addr (syserr_data$syserr_area) -> sd.ocdcm_init_flag = "0"b; /* PANIC */

	call bce_abs_seg$free;			/* release SDWs */

	if not_masked then call pmut$set_mask (scs$sys_level);
	call initialize_faults$fault_init_one;

	addr (int_unpaged_page_tables$) -> upt.current_length = saved_iupt_lth;
	addr (unpaged_page_tables$) -> upt.current_length = saved_upt_lth;
	slt.free_core_start = saved_free_core_start;
	slt.free_core_size = saved_free_core_size;
	addr (unpaged_page_tables$) -> upt.sst_absloc = 0;
	addr (unpaged_page_tables$) -> upt.sst_last_loc = 0; /* so we don't confuse page table lookers */
	return;
     end TURN_OFF;
%page; %include collection_1_phases;
%page; %include config_intk_card;
%page; %include flagbox;
%page; %include opc_reconfig_options;
%page; %include pvt;
%page; %include pvte;
%page; %include slt;
%page; %include syserr_constants;
%page; %include syserr_data;
%page; %include toe_hold;
%page; %include unpaged_page_tables;
%page;
/* BEGIN MESSAGE DOCUMENTATION

   Message:
   initializer: intk card missing.

   S: $crash

   T: $init

   M: No "intk" card was found in the config deck.

   A: $config

   Message:
   initializer: Bad root volume.

   S: $crash

   T: $init

   M: A volume specified on a ROOT card was found ill formatted by
   init_root_vols.

   A: $recover

   Message:
   initializer: Multics SYSID (VERSION) syserr logging initialized.

   S: $log

   T: $init

   M: This is the first syserr message produced by every bootload.  It is
   produced as soon as the syserr logging mechanism is made operative, which
   insures that it is the first message logged for every bootload.  It
   identifies the system ID and version of the running system.

   A: $ignore

   Message:
   initializer: bad_dir_ signal raised

   S: $crash

   T: $init

   M: During system bootload, directory control has encountered an invalid
   directory.  This usually occurs due to damage to the root or to
   >system_control_1.  The RPV is automatically scheduled for volume salvage.

   A: $recover

   Message:
   initializer: Segment fault error by PPPP referencing PPPP: ERROR

   S: $crash

   T: $init

   M: During system bootload, a segment fault error has occurred.  This
   usually indicates running out of room on the RLV.  A BOOT RPVS may recover
   some of this space.  The procedure causing the error and the segment being
   referenced are identified, along with the error message.

   A: $recover

   Message:
   initializer: STOP_NUM  ENTRY_TO_CALL  state ISTATE  phase CPHASE.

   S: $beep

   T: $init

   M: The "loud" config parm is currently enabled.  This message gives the
   current stop number (STOP_NUM), that can be used to stop the initialization
   process and return to BCE before calling ENTRY_TO_CALL.  The current values
   of sys_info$initialization_state (ISTATE) and sys_info$collection_1_phase
   (CPHASE) are also given.

   A: $ignore

   Message:
   initializer: ENTRY_TO_CALL check_stop.

   S: $beep

   T: $init

   M: The initializer has detected that the first nine data switches on the CPU
   contain an octal "123" and the STOP number of the entry to be called and the
   current collection_1_phase match the other CPU data switches.  The
   initializer calls BCE after displaying this message, but before actually
   calling the entry.  The CPU data switches have the following usage:
   .spf;.inl +10;.unl +9
   0  -  8: must be set to an octal "123" for any other switches to be valid.
   .unl +9
   9  - 14: area for the BCD value of the collection_1_phase to stop in.
   .unl +9
   15 - 20: area for the BCD hundreds digit of the STOP number.
   .unl +9
   21 - 26: area for the BCD tens digit of the STOP number.
   .unl +9
   27 - 32: area for the BCD ones digit of the STOP number.
   .unl +9
   33 - 35: not used or checked.
   .inl -10

   A: Execute any BCE functions desired. Modify the setting of the CPU data
   switches as required. Execute the BCE "go" function to resume initialization.

   END MESSAGE DOCUMENTATION */
     end real_initializer;




		    segment_loader.pl1              11/11/89  1138.5r w 11/11/89  0801.1       97029



/****^  ***********************************************************
        *                                                         *
        * 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 */
segment_loader:
     proc;

/* format: off */

/* SEGMENT_LOADER - Loader for Multics Initialization.

   The segment loader will be called to load a collection from
   the Multics System Tape (MST).
   All segments contained in the MST collection
   will be loaded. When a collection mark is found on MST,
   the segment loader will return to its caller.

   Written 06/05/67, Noel I. Morris
   Modified 03/29/76, Noel I. Morris for loading separate defs.
   Modified 08/02/77, Bernard S. Greenberg for aste.gtpd and flush.
   Modified 04/06/81, W. Olin Sibert, to update for ADP SDWs and sdw_util_
   Modified 6/82 BIM boot_tape_io, hc_linkage_seg, hc_definitions_seg.
   Modified '82 CAH to have pre linking done externally, also slt_manager change.
   Modified 10/83 by Keith Loepere for warm boot from disk.
   */

/* format: on */
	dcl     header_area		 (1000) fixed bin (35);
						/* area into which segment header is read */
	dcl     header_ptr		 ptr;		/* pointer to header area */
	dcl     type		 fixed bin (17);	/* type of record on MST */
	dcl     count		 fixed bin (17);	/* length of record on MST */
	dcl     seg_ptr		 ptr;		/* pointer to segment being loaded */
	dcl     text_ptr		 ptr;		/* pointer to text segment */
	dcl     text_no		 fixed bin (18);	/* text segment number */
	dcl     link_ptr		 ptr;		/* pointer to linkage section */
	dcl     seg_number		 fixed bin (18);	/* segment number of segment being loaded */
	dcl     expect_link		 bit (1) aligned;	/* linkage section expected switch */
	dcl     expect_defs		 bit (1) aligned;	/* definitions expected switch */
	dcl     control_ptr		 ptr;		/* pointer to control word */
	dcl     last_sltep		 ptr;		/* pointer to previous slt entry */
	dcl     tsdw		 fixed bin (71);
	dcl     reading_sdw		 fixed bin (71);
	dcl     ptp		 ptr;

	dcl     1 control_word	 aligned,		/* MST control word */
	        ( 2 type		 fixed bin (17),	/* control word type */
		2 count		 fixed bin (17)
		)		 unaligned;	/* count of words following */


	dcl     as_linkage$		 external static;	/* combined linkage segments */
	dcl     ws_linkage$		 external static;
	dcl     ai_linkage$		 external static;
	dcl     wi_linkage$		 external static;

	dcl     slt$		 external static;

	dcl     1 lot$		 ext like lot;	/* linkage offset table */

	dcl     definitions_$	 ext;		/* definitions segment */

	dcl     make_sdw		 entry (fixed bin (18), fixed bin (71), ptr, ptr);
	dcl     pc_wired$write	 entry (ptr, fixed bin, fixed bin);
	dcl     pmut$swap_sdw	 entry (ptr, ptr);
	dcl     sdw_util_$set_access	 entry (pointer, bit (4) unaligned);
	dcl     slt_manager$build_entry
				 entry (ptr) returns (ptr);
	dcl     syserr		 entry options (variable);
	dcl     disk_reader		 entry (ptr, fixed bin (17));

	dcl     (addr, addrel, baseno, bin, mod, null, rel, size)
				 builtin;


	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_$);

	header_ptr = addr (header_area);		/* Generate pointer to header area. */

	control_ptr = addr (control_word);		/* Generate pointer to control word. */

/* Read control word and dispatch on it. */

loop:
	call read_control_word (type, count);		/* Read a control word. */
	if type = 2
	then go to collection;
	else if type ^= 0
	then call syserr (CRASH, "segment_loader: unknown control type ^d", type);

/* Process header record. */

	if count > size (header_area)
	then /* Error if header is too large ... */
	     call syserr (CRASH, "segment_loader: bad header size ^d", count);
						/* ... or too small. */

	call disk_reader (header_ptr, count);		/* Read in the header. */

	call read_control_word (type, count);		/* Read in next control word. */
	if type ^= 1
	then /* It must be a segment control word. */
	     call syserr (CRASH, "segment_loader: unexpected control type ^d", type);

	if header_ptr -> slte.link_sect
	then do;					/* If this is a linkage segment... */
		if ^expect_link
		then /* If unexpected ... */
		     call syserr (CRASH, "segment_loader: 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 linkage may be combined ... */
			if last_sltep -> slte.link_sect_wired
			then /* If linkage is wired ... */
			     if last_sltep -> slte.init_seg
			     then /* If text is init seg ... */
				hclsp = addr (wi_linkage$);
						/* Use wired_init_linkage. */
			     else /* If text is sup seg ... */
				hclsp = addr (ws_linkage$);
						/* Use wired_sup_linkage. */
			else /* If linkage is not wired ... */
			     if last_sltep -> slte.init_seg
			then /* If text is init seg ... */
			     hclsp = addr (ai_linkage$);
						/* Use active_init_linkage. */
			else /* If text is sup seg ... */
			     hclsp = addr (as_linkage$);
						/* Use active_sup_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 disk_reader (seg_ptr, count);
						/* Read in the linkage section into place. */
		     end;

		else /* If linkage not to be combined ... */
		     call load_segment;		/* Load in the 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 this is a definitions segment ... */
		if ^expect_defs
		then /* If unexpected ... */
		     call syserr (CRASH, "segment_loader: 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 disk_reader (seg_ptr, count);	/* Read definitions into place. */

		definitions.dot (text_no).offset = bin (rel (seg_ptr), 18);
		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 /* Must not expect anything else. */
		     call syserr (CRASH, "segment_loader: Missing linkage or defs.");
		expect_link = header_ptr -> slte.link_provided;
						/* Set switch. */

		call load_segment;			/* Load in the segment. */
		text_ptr = seg_ptr;			/* Save pointer to the text. */
		text_no = bin (baseno (text_ptr), 18);	/* Also, get text segment number. */
	     end;

	last_sltep = sltep;				/* Save pointer to last SLT entry. */

	go to loop;				/* Continue. */

/* Process collection record. */

collection:
	call read_control_word (type, count);		/* Read the collection mark. */

	return;					/* Return to caller. */
%page;
/* LOAD_SEGMENT - Build a segment and read it in from disk. */

load_segment:
     proc;

	seg_ptr = slt_manager$build_entry (header_ptr);	/* Build new entry in SLT. */
	if seg_ptr = null ()
	then call syserr (CRASH, "segment_loader: error from slt_manager$build_entry");

	seg_number = bin (baseno (seg_ptr), 15);	/* Get segment number of new segment. */

	sltep = addr (slt.seg (seg_number));

	call make_sdw (seg_number, tsdw, astep, ptp);	/* Get an AST entry */
	if astep = null ()
	then return;				/* abs-seg */

	reading_sdw = tsdw;				/* get copy of SDW for disk reader */
	call sdw_util_$set_access (addr (reading_sdw), "1010"b);
						/* Force RW access while we're reading */
	call pmut$swap_sdw (seg_ptr, addr (reading_sdw)); /* place SDW in DSEG */

	aste.gtpd = "1"b;				/* Keep off PD until flushed */

	call disk_reader (seg_ptr, count);		/* Slurp in the new segment. */

	call pmut$swap_sdw (seg_ptr, addr (tsdw));	/* store real SDW in DSEG */

	call pc_wired$write (astep, 0, -1);		/* Flush to disk */

	aste.gtpd = "0"b;				/* PD migration ok now */

	return;


     end load_segment;


/* READ_CONTROL_WORD - Read a control word from MST. */

read_control_word:
     proc (type, count);

	dcl     type		 fixed bin (17),	/* control word type */
	        count		 fixed bin (17);	/* count of following record */


	call disk_reader (control_ptr, 1);		/* Read in the control word. */

	type = control_word.type;			/* Return the type. */
	count = control_word.count;			/* Return the count. */

	return;


     end read_control_word;				/* format: off */

%page; %include hc_linkage_seg; %include hc_definitions_seg;
%page; %include aste;
%page; %include slt;
%page; %include slte;
%page; %include object_link_dcls;
%page; %include lot;
%page; %include syserr_constants;

  

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   segment_loader: unknown control type TTT

   S: $crash

   T: $init

   M: A bad segment control word was found in the mst source.

   A: $recover
   $boot_tape

   Message:
   segment_loader: bad header size: SSS

   S: $crash

   T: $init

   M: A bad segment header was found in the mst source.

   A: $recover
   $boot_tape

   Message:
   segment_loader: unexpected control type: TTT

   S: $crash

   T: $init

   M: A segment control word was found out of sequence in the mst source.

   A: $recover
   $boot_tape

   Message:
   segment_loader: 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:
   segment_loader: 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:
   segment_loader: error from slt_manager$build_entry

   S: $crash

   T: $init

   M: $err

   A: $recover
   $boot_tape

   END MESSAGE DOCUMENTATION */


     end segment_loader;




		    slt_manager.pl1                 11/11/89  1138.5r w 11/11/89  0801.1       37188



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

/* SLT manager for Collection 1 Initialization. */
/* Written November 1982 by C. Hornig */
/* Modified January 1983 by K. Loepere to build and use name ht */

dcl  Header_ptr ptr parameter;

dcl  name_table$ external;
dcl  slt$ external;

dcl  hash_index_ entry (ptr, fixed bin (35), fixed bin (35), fixed bin (35))
     returns (fixed bin (35));

dcl  (tsltep, tnamep, tpathp, taclp) ptr;
dcl  segment_no fixed bin (15);
dcl  namex fixed bin;
dcl  hash_value fixed bin;  		/* what name hashes to */
dcl  name_num fixed bin;		/* loop index for names */
dcl 1 name_entry aligned like segnam.names based (name_entry_ptr);
dcl  name_entry_ptr ptr;

dcl  size builtin;
%page;
build_entry:
     entry (Header_ptr) returns (ptr);

	names_ptr = addr (name_table$);		/* establish addressability */
	sltp = addr (slt$);

	tsltep = Header_ptr;			/* header begins with SLTE */
	tnamep = addrel (tsltep, size (tsltep -> slte));	/* followed by names */

	if tsltep -> slte.branch_required then do;	/* and (optionally) path and ACL */
	     tpathp = addrel (tnamep, currentsize (tnamep -> segnam));
	     taclp = addr (tpathp -> path.acls);
	     end;

	if tsltep -> slte.init_seg			/* pick a segment number */
	then segment_no, slt.last_init_seg = slt.last_init_seg + 1;
	else segment_no, slt.last_sup_seg = slt.last_sup_seg + 1;

	sltep = addr (slt.seg (segment_no));		/* use this from now on */
	slte = tsltep -> slte;			/* copy in the SLTE */
	slte_uns.segno = segment_no;			/* save the segment number */

	namep = allocate_nt (currentsize (tnamep -> segnam));
						/* allocate space for a name */
	segnam.count = tnamep -> segnam.count;		/* set the count */
	segnam = tnamep -> segnam;			/* copy the rest */
	slte.names_ptr = rel (namep);			/* set up ptr in SLTE */

	if slte.branch_required then do;		/* more work */
	     pathp = allocate_nt (currentsize (tpathp -> path) - 1);
						/* space for the pathname */
	     path.size = tpathp -> path.size;
	     path = tpathp -> path;
	     slte.path_ptr = rel (pathp);

	     if slte.acl_provided then do;
		aclp = allocate_nt (currentsize (taclp -> acls));
						/* and for ACL's */
		acls.count = taclp -> acls.count;
		acls = taclp -> acls;
		end;
	     end;

	do name_num = 1 to segnam.count;		/* hash in names */
	     hash_value = hash_index_ (addr (segnam.names (name_num).name), 
		length (segnam.names (name_num).name), 0,
		dimension (name_seg.ht, 1));
	     segnam.names (name_num).hp = name_seg.ht (hash_value);  /* thread in list */
	     name_seg.ht (hash_value) = rel (addr (segnam.names (name_num)));
	     segnam.names (name_num).segno = bit (fixed (segment_no, 12), 12);
	end;

	return (baseptr (segment_no));

/* * * * * * * * * ALLOCATE_NT * * * * * * * * */

allocate_nt:
     procedure (Words) returns (ptr);

dcl  Words fixed bin;
dcl  ntp ptr;

	ntp = ptr (names_ptr, name_seg.next_loc);
	name_seg.next_loc = rel (addrel (ntp, Words));
	return (ntp);
     end allocate_nt;
%page;
/* * * * * * * * * * GET_SEG_PTR * * * ** * * * * */

get_seg_ptr:
     entry (Name) returns (ptr);

dcl  Name char (32) aligned parameter;

	sltp = addr (slt$);
	names_ptr = addr (name_table$);

	hash_value = hash_index_ (addr (Name), length (Name), 0,
	     dimension (name_seg.ht, 1));
	do name_entry_ptr = ptr (names_ptr, name_seg.ht (hash_value))
	     repeat (ptr (names_ptr, name_entry.hp))
		while (rel (name_entry_ptr));	/* scan down names that hash alike */
	     if name_entry.name = Name then return (baseptr (fixed (name_entry.segno, 12)));  /* until (if) we find actual match */
	end;
	return (null ());
%page;
%include slt;
%include slte;

     end slt_manager;




		    tc_init.pl1                     11/11/89  1138.5rew 11/11/89  0800.0      268641



/****^  ***********************************************************
        *                                                         *
        * 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 */
tc_init:
     proc;

/* This program initializes the various traffic controller data bases, the idle process
   data bases, and starts up the traffic controller. The entry part_2 is called after paging is
   operative and after the initializer's descriptor segment has all permanent hardcore SDW's filled
   in. It creates the idle processes and turns ON multiprogramming after starting the bootload cpu.
   The entry start_other_cpus is called late in initialization to get the other processors running.
*/

/* Last modified (date and reason):
   5/11/77 by RE Mullen for concurrent scheduler
   2/4/76	by S. Webber rewrite for new reconfiguration
   4/20/77 by B. Greenberg for PRDS renaming
   6/21/77 by M. Weaver to move template_pds stuff to part_2
   5/10/79 by B. Greenberg for stack_0 sharing
   10/29/80 by M. Pierret for pin_weight and io_priority
   3/5/81 by J. Bongiovanni for site-settable prds size
   11/11/81 by J. A. Bush to display contents of bootload cpu ID PROM (DPS8 CPU)
   before adding  other cpus whose state is "ON".
   04/04/81 by W. Olin Sibert, to remove direct SDW hacking
   01/09/81 by W. Olin Sibert, to make it runnable twice for Bootload Multics.
   4/27/82 by J. Bongiovanni for wcte.interactive_q, gv_integration
   7/15/82 by BIM to merge Siberts changes with Bongiovanni's.
   8/13/82 by BIM to fiddle, once again, with PID's.
   9/17/82 by J. Bongiovanni for tc_data$abort_ips_mask
   2/16/83 by E. N. Kittlitz for hex floating point.
   6/27/83 by Keith Loepere for early entrypoint.
   830728 by E. A. Ranzenbach for operator console polling time.
   10/4/83 by Keith Loepere for paged idle_pdses and idle_dsegs.
   84.11.15 by M. Pandolf to include hc_lock.
   11/05/84 by Keith Loepere to rename terminate  to terminate_.
   Modified 1984-11-12 by E. Swenson for IPC event channel validation.
   The value of apte.ipc_r_offset is initialized here for the
   Initializer process.
   Modified March 1985 by Keith Loepere to fix a bug in multiple pass init.
*/

/* Automatic */

dcl  early_call bit (1) aligned;
dcl  n_words fixed bin (18);
dcl  first_segno fixed bin;
dcl  processor_index fixed bin;
dcl  prdsp ptr;
dcl  no_apt fixed bin;
dcl  no_itt fixed bin;
dcl  tc_data_size fixed bin (18);
dcl  tc_data_no fixed bin;
dcl  tc_data_header_no fixed bin;
dcl  tc_data_header_ptr pointer;
dcl  tsdw fixed bin (71);
dcl  i fixed bin;
dcl  template_pds_size fixed bin (18);
dcl  idle_pds_p ptr;
dcl  aptp ptr;
dcl  aptx fixed bin;
dcl  ittp ptr;
dcl  ittx fixed bin;
dcl  tsize fixed bin (18);
dcl  time fixed bin (71);
dcl  code fixed bin (35);
dcl  prds_name char (32);
dcl  prds_length_kw fixed bin;
dcl  cpu_model char (13) aligned;			/* storage for cpu model number (from ID PROM) */
dcl  cpu_serial char (13) aligned;			/* storage for cpu serial number (from ID PROM) */
dcl  cpu_ship_date char (8) aligned;			/* storage for cpu ship date (from ID PROM) */
dcl  table_value fixed bin;

dcl  dseg_no fixed bin static;
dcl  pds_no fixed bin static;
dcl  prds_no fixed bin static;
dcl  template_pds_p ptr static;
dcl  tag fixed bin static;
dcl  idle_dsegs_sdw fixed bin (71) internal static;	/* pointers and SDWs for idle_dsegs$ and idle_pdses */
dcl  idle_pdses_sdw fixed bin (71) internal static;
dcl  idle_dsegs_p ptr static;
dcl  idle_pdses_p ptr static;
dcl  dseg_size fixed bin (18) internal static;		/* Amount to actually copy into idle dseg */
dcl  pds_size fixed bin (18) static;

dcl  header (n_words) fixed bin based;
dcl  copy_id bit (36) aligned based;
dcl  copy_ptr ptr based;
dcl  copy_group_id char (32) aligned based;
dcl  copy_pds (pds_size) fixed bin based;
dcl  copy_dseg (0:255) fixed bin (71) based;		/* stop copying before init segs */
dcl  1 apt (1) aligned like apte based (aptp);
dcl  1 itt (1) aligned based (ittp),
       2 fp bit (18) unaligned,
       2 bp bit (18) unaligned,
       2 filler (7) fixed bin;

dcl  append$branchx
	entry (char (*), char (*), fixed bin (5), (3) fixed bin, char (*), fixed bin, fixed bin, fixed bin,
	fixed bin (35));
dcl  chname$cfile entry (char (*), char (*), char (*), char (*), fixed bin (35));
dcl  config_$find entry (char (4) aligned, ptr);
dcl  config_$find_table entry (char (4) aligned, fixed bin);
dcl  delentry$dfile entry (char (*), char (*), fixed bin (35));
dcl  getuid entry returns (bit (36) aligned);
dcl  get_main entry (ptr, fixed bin (18), fixed bin (71));
dcl  get_ptrs_$given_segno entry (fixed bin) returns (ptr);
dcl  grab_aste$prewithdraw entry (ptr, fixed bin (19), fixed bin (35)) returns (ptr);
dcl  init_processor$init entry;
dcl  init_processor$return entry ext;
dcl  initiate entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35));
dcl  pmut$swap_sdw entry (ptr, ptr);
dcl  privileged_mode_ut$read_id_prom entry (char (*) aligned, fixed bin);
dcl  pxss$get_entry entry (ptr);
dcl  sdw_util_$construct entry (ptr, ptr);
dcl  sdw_util_$dissect entry (ptr, ptr);
dcl  start_cpu entry (fixed bin, fixed bin (35));
dcl  syserr entry options (variable);
dcl  syserr$error_code entry options (variable);
dcl  terminate_$teseg entry (ptr, fixed bin (1), fixed bin (35));
dcl  thread$cin entry (ptr, bit (18) unaligned);

dcl  active_all_rings_data$stack_base_segno fixed bin (18) ext;
dcl  dseg$ (0:1023) fixed bin (71) external static;
dcl  error_table_$noentry external fixed bin (35);
dcl  idle_pdses$ (0:16383) fixed bin external static;
dcl  idle_dsegs$ (0:8191) fixed bin (71) external static;	/* All the idle process DSEGs */
dcl  prds$ ext;
dcl  prds$processor_tag fixed bin (3) external;
dcl  slt$ ext;
dcl  sys_info$hfp_exponent_available bit (1) aligned external;
dcl  sys_info$quit_mask bit (36) aligned external;
dcl  sys_info$susp_mask bit (36) aligned external;
dcl  sys_info$term_mask bit (36) aligned external;
dcl  sys_info$system_type fixed bin external static;
dcl  tc_data$ ext;
dcl  tc_data$prds_length fixed bin (19) external;
dcl  tc_data_header$ fixed bin external static;

dcl  pds$ ext;
dcl  pds$apt_ptr ptr ext;
dcl  pds$data fixed bin ext;
dcl  pds$lock_id bit (36) aligned external;
dcl  pds$dstep bit (18) aligned ext;
dcl  pds$initial_procedure ptr ext;
dcl  pds$process_group_id char (32) ext;
dcl  pds$processid bit (36) aligned ext;
dcl  pds$stack_0_ptr ptr ext;
dcl  pds$stack_0_sdwp ptr ext;
dcl  pds$trace ext;

dcl  template_pds$ ext;
dcl  template_pds$quota_inhib fixed bin external;
dcl  template_pds$save_history_regs bit (1) aligned external;
dcl  template_pds$apt_ptr ptr ext;
dcl  template_pds$initial_procedure ptr ext;
dcl  template_pds$process_group_id char (32) ext;
dcl  template_pds$processid bit (36) aligned ext;
dcl  template_pds$stack_0_sdwp ptr ext;
dcl  template_pds$stack_0_ptr ptr ext;

dcl  LETTERS char (8) internal static options (constant) init ("ABCDEFGH");
dcl  PRDS_DIR char (32) internal static options (constant) init (">system_library_1");
dcl  RW_mode fixed bin (5) internal static options (constant) init (01010b);
dcl  seg_rb (3) fixed bin internal static options (constant) init (0, 0, 0);

dcl  (addr, addrel, baseno, baseptr, bin, binary, bit, clock, divide, hbound, lbound, max, min, null, ptr, rel, size,
     string, substr, unspec) builtin;
%page;
	early_call = "0"b;
	go to part_1;

early:
     entry;
	early_call = "1"b;

part_1:
	tcmp = addr (tc_data$);			/* get necessary pointers, etc. */
	idle_pdses_p = addr (idle_pdses$);
	idle_dsegs_p = addr (idle_dsegs$);
	tc_data_no = bin (baseno (tcmp), 18);
	tc_data_header_ptr = addr (tc_data_header$);
	tc_data_header_no = binary (baseno (tc_data_header_ptr), 18);
	pds_no = bin (baseno (addr (pds$)), 18);
	dseg_no = bin (baseno (addr (dseg$)), 18);
	prds_no = bin (baseno (addr (prds$)), 18);

	if dseg$ (tc_data_header_no) = 0 then do;	/* First time - make header valid */
	     addr (addr (slt$) -> slt.seg (tc_data_no)) -> slte.paged = "0"b;
						/* Force to low memory */
	     call pmut$swap_sdw (tc_data_header_ptr, addr (dseg$ (tc_data_no)));
	     end;

	n_words = bin (rel (addr (tcm.apt)), 18);
	tag = scs$bos_processor_tag;

	if early_call then do;
	     no_apt = 4;
	     no_itt = 20;
	     end;
	else do;
	     tcd_cardp = null ();
	     call config_$find (TCD_CARD_WORD, tcd_cardp);/* get TCD card for sizes of APT and ITT. */
	     if tcd_cardp = null () then do;		/* not found, use defaults */
		no_apt = tc_data_header_ptr -> tcm.apt_size;
		no_itt = tc_data_header_ptr -> tcm.itt_size;
		end;
	     else do;				/* use values from card */
		no_apt = tcd_card.no_apt;
		no_itt = tcd_card.no_itt;
		end;
	     end;

/* Now, allocate the new tc_data in wired memory. The header specifies it as paged, since
   the header is created as a cds and must be copied into the wired tc_data. The first time
   this code is executed, the tc_data_header segment will be created (defined in the header
   as a zero length fabricated segment) as a segment defining the version of tc_data read
   from the tape, which contains only the tc_data header. Subsequently, tc_data is allocated
   in wired memory, and the header (defined by tc_data_header) is copied into it.
*/

	tc_data_size = n_words + no_apt * size (apt) + no_itt * size (itt);

	call get_main (tcmp, tc_data_size, tsdw);	/* get storage for tc_data */
	call pmut$swap_sdw (tcmp, addr (tsdw));		/* copy tc_data into new storage */
	tcmp -> header = tc_data_header_ptr -> header;	/* copy header */

/* We are now using the new wired version of tc_data. */

	tcm.apt_size = no_apt;
	tcm.itt_size = no_itt;

	tcm.system_type = sys_info$system_type;		/* Remember this fellow here */

/* Init WCTE's, then setup first two for self and others respectively. */


	do i = 0 to 16;
	     tcm.wcte (i).fp, tcm.wcte (i).bp = rel (addr (tcm.wcte (i)));
	     tcm.wcte (i).mnbz = "1"b;		/* Make this a sentinel */
	     tcm.wcte (i).resp1 = 2 * 1024 * 1024;
	     tcm.wcte (i).quantum1 = 1024 * 1024;
	     tcm.wcte (i).resp2 = 64 * 1024 * 1024;
	     tcm.wcte (i).quantum2 = 2 * 1024 * 1024;
	     tcm.wcte (i).realtime = 0;
	     tcm.wcte (i).purging = 1;
	     tcm.wcte (i).maxel = 0;			/* 0 means no limit */
	     tcm.wcte (i).nel = 0;
	     tcm.wcte (i).pin_weight = 1;
	     tcm.wcte (i).flags.io_priority = "0"b;
	     tcm.wcte (i).flags.interactive_q = "1"b;
	end;



	tcm.credits_per_scatter = 512 * 1024;		/* passout this many credits this often */
						/* credits are in microseconds */
	tcm.wcte (0).flags.defined = "1"b;
	tcm.wcte (0).flags.io_priority = "1"b;
	tcm.wcte (0).minf = 256 * 1024;		/* 50% for Initializer if need be. */
	tcm.wcte (0).resp1, tcm.wcte (0).resp2 = 256 * 1024;
						/* within 1/4 sec */
	tcm.wcte (0).quantum1, tcm.wcte (0).quantum2 = 2 * 1024 * 1024;
						/* give 2 sec */
	tcm.wcte (0).pin_weight = 3;			/* This number may have to be tuned */
	tcm.wcte (0).realtime = 1;
	tcm.wcte (1).flags.defined = "1"b;
	tcm.wcte (1).minf = 512 * 1024;		/* and 100% for everybody else. */
						/* The initializer does not generate credits */
	tcm.min_wct_index = rel (addr (tcm.wcte (0)));
	tcm.max_wct_index = rel (addr (tcm.wcte (1)));

/* Now set up the APT */

	aptp = ptr (tcmp, n_words);			/* APT is right after header */
	tcm.empty_q = rel (aptp);			/* thread first into empty list */
	do aptx = 1 to no_apt - 1;
	     apt (aptx).fp = rel (addr (apt (aptx + 1)));
	     apt (aptx).lock = "777777"b3;		/* init to unlocked, anyting but zero */
	end;
	apt (no_apt).lock = "777777"b3;		/* init to unlocked, anyting but zero */

	tcm.stat (0) = no_apt;			/* all processes are empty */

/* Now do the ITT */

	tcm.used_itt = 0;
	ittp = addr (apt (no_apt + 1));
	do ittx = 1 to no_itt - 1;
	     itt (ittx).fp = rel (addr (itt (ittx + 1)));
	end;
	itt (no_itt).fp = (18)"1"b;			/* head -1 when all itte taken, 0 means locked */
	tcm.itt_free_list = rel (ittp);
	tcm.cid2 = divide (no_itt - no_apt, 2, 18, 0);
	tcm.cid3 = divide (no_itt - no_apt, 3, 18, 0);
	tcm.cid4 = divide (no_itt - no_apt, 4, 18, 0);

/* Fill in data from SCHD card. */

	schd_cardp = null ();			/* search for config card */
	call config_$find (SCHD_CARD_WORD, schd_cardp);
	if schd_cardp ^= null () then do;		/* if found */
	     tcm.working_set_factor = schd_card.ws_factor;
	     tcm.tefirst = schd_card.tefirst * 125000;
	     tcm.telast = schd_card.telast * 125000;
	     tcm.timax = schd_card.timax * 125000;
	     if schd_card.min_eligible > 0 then tcm.min_eligible = schd_card.min_eligible * 262144;
	     if schd_card.max_eligible > 0
	     then if schd_card.max_eligible * 262144 >= tcm.min_eligible
		then tcm.max_eligible = schd_card.max_eligible * 262144;
	     if schd_card.max_max_eligible > 0 & schd_card.max_max_eligible < 1000
	     then tcm.max_max_eligible = schd_card.max_max_eligible * 262144;
	     else tcm.max_max_eligible = tcm.max_eligible + (10 * 262144);
	     end;

	if (tcm.max_eligible + tcm.max_stopped_stack_0 * 262144) <= tcm.max_max_eligible
	     & tcm.min_eligible <= tcm.max_eligible
	then ;					/* All OK */
	else call syserr (1, "Inconsistent SCHD config card values.");

	tcm.gv_integration = 4 * tcm.telast;

	tcm.abort_ips_mask = sys_info$quit_mask | sys_info$susp_mask | sys_info$term_mask;

/* Set up the length of the prds, either from the slt or the TBLS Config Card				*/

	sltep = addr (addr (slt$) -> slt.seg (prds_no));
	prds_length_kw = max (slte_uns.cur_length, slte_uns.max_length);
						/* default */

	call config_$find_table ("prds", table_value);	/* See if a TBLS PRDS card is to be found */
	if (table_value >= 0) & (table_value < prds_length_kw)
	then call syserr (ANNOUNCE, "tc_init: Size of PRDS on TBLS card too small; ^d KW will be used.", prds_length_kw)
		;

	if table_value > 0 then prds_length_kw = min (255, table_value);
						/* Don't let it be too big */
						/* else just stick with default */

	tcm.prds_length = 1024 * prds_length_kw;
	slte_uns.cur_length, slte_uns.max_length = prds_length_kw;

/* Allocate the stack_0_data segment */

	sdtp = addr (stack_0_data$);
	stack_0_data_init_number_of_stacks = divide (tcm.max_max_eligible, 262144, 17, 0);
	call get_main (sdtp, size (sdt), tsdw);
	call pmut$swap_sdw (sdtp, addr (tsdw));
	sdt.num_stacks = stack_0_data_init_number_of_stacks;
	unspec (sdt) = ""b;
	sdt.num_stacks = stack_0_data_init_number_of_stacks;

/* Allocate the APT entries for the initializer and the idle processes.
   Also figure out the total size of idle_dsegs and idle_pdses. */

	tsize = 0;
	call pxss$get_entry (aptep);
	pds$apt_ptr = aptep;
	do i = 0 to 7;
	     if scs$processor_data (i).offline then do;	/* All cpus are flagged as offline at this point */
		call pxss$get_entry (aptep);
		scs$idle_aptep (i) = aptep;
		tsize = tsize + 1;
		end;
	end;

/* Now get the DSEGs and PDSs for the idle procs */

/* Now get enough storage for the PDSes and DSEGs */

	if sys_info$system_type = ADP_SYSTEM then do;	/* For the ADP, because of cache sharing/overlap problems */
	     dseg_size = 2048;			/* each of these must be two pages. No further special */
	     pds_size = 2048;			/* casing need be done, since the initialization DSEG and */
	     end;					/* PDS are already this large */

	else do;					/* otherwise one page is more than enough */
	     dseg_size = 1024;
	     pds_size = 1024;
	     end;

	call get_main (idle_dsegs_p, tsize * dseg_size, idle_dsegs_sdw);

	call get_main (idle_pdses_p, tsize * pds_size, idle_pdses_sdw);

	call pmut$swap_sdw (idle_dsegs_p, addr (idle_dsegs_sdw));
	call pmut$swap_sdw (idle_pdses_p, addr (idle_pdses_sdw));
	return;
%page;
part_2:
     entry;

/* This entry is called after the initializer's DSEG is filled in and after paged segments
   have their ASTE's. It completes initialization of the traffic controller, starts the
   bootload CPU, and turns on multiprogramming. */

	tcmp = addr (tc_data$);

/* Now initialize the template_pds segment */

	template_pds_size = bin (rel (addr (pds$data)), 18);
						/* get size to copy */
	tcm.pdscopyl = template_pds_size;		/* save for later process creations */

	template_pds_p = addr (template_pds$);		/* get pointer to template_pds */

/* Now fill in some variables in template_pds */

	template_pds$quota_inhib = 0;
	template_pds$save_history_regs = "0"b;
	template_pds$stack_0_ptr = baseptr (active_all_rings_data$stack_base_segno);
	template_pds$stack_0_sdwp = addr (dseg$ (binary (baseno (template_pds$stack_0_ptr))));
	template_pds$processid = "444444444444"b3;
	template_pds$apt_ptr = null ();
	template_pds$process_group_id = "Idle.SysControl.z";
	template_pds$initial_procedure = null ();

	processor_index = -1;
	do i = lbound (scs$processor_data, 1) to hbound (scs$processor_data, 1);
						/* loop through all possible processors */
	     if scs$processor_data (i).offline then do;	/* Only do it for configurable CPUs */
						/* All cpus are flagged as offline at this point */
		processor_index = processor_index + 1;
		first_segno = processor_index * divide (dseg_size, 2, 17, 0);
						/* index, in idle_dsegs$, of first SDW for this */
		addr (idle_dsegs$ (first_segno)) -> copy_dseg = addr (dseg$) -> copy_dseg;
						/* idle process */

		idle_pds_p = addr (idle_pdses$ (processor_index * pds_size));
		idle_pds_p -> copy_pds = template_pds_p -> copy_pds;
						/* copy virgin pds */

		addrel (idle_pds_p, rel (addr (pds$processid))) -> copy_id = rel (scs$idle_aptep (i)) || "555555"b3;
		addrel (idle_pds_p, rel (addr (pds$apt_ptr))) -> copy_ptr = scs$idle_aptep (i);
		addrel (idle_pds_p, rel (addr (pds$stack_0_ptr))) -> copy_ptr = addr (prds$);
		addrel (idle_pds_p, rel (addr (pds$stack_0_sdwp))) -> copy_ptr =
		     addr (dseg$ (binary (baseno (addr (prds$)))));
		substr (addrel (idle_pds_p, rel (addr (pds$process_group_id))) -> copy_group_id, 17, 1) =
		     substr ("abcdefgh", i + 1, 1);
		addrel (idle_pds_p, rel (addr (pds$trace))) -> trace.last_available = 4;
		addrel (idle_pds_p, rel (addr (pds$trace))) -> trace.next_free = 0;

		call shrink_sdw (idle_dsegs_sdw, processor_index * dseg_size, dseg_size, tsdw);
		idle_dsegs$ (first_segno + dseg_no) = tsdw;
		scs$idle_aptep (i) -> apte.dbr = tsdw;

		call shrink_sdw (idle_pdses_sdw, processor_index * pds_size, pds_size, tsdw);
		idle_dsegs$ (first_segno + pds_no) = tsdw;
		end;
	end;

/* Now initialize the initializer process */

	pds$initial_procedure = addr (init_processor$return);
	aptep = pds$apt_ptr;
	pds$processid = rel (aptep) || (18)"1"b;
	pds$stack_0_sdwp = addr (dseg$ (binary (baseno (pds$stack_0_ptr))));
	tcm.initializer_id = pds$processid;
	apte.wct_index = tcm.min_wct_index;
	apte.deadline = clock ();
	call thread$cin (aptep, tcm.eligible_q_head.fp);
	apte.loaded = "1"b;
	apte.eligible = "1"b;
	apte.state = bit (bin (2, 18), 18);
	apte.dbr = dseg$ (dseg_no);
	apte.processid = pds$processid;
	apte.lock_id = getuid ();
	pds$lock_id = apte.lock_id;
	apte.timax = 0;
	apte.pds = rel (get_ptrs_$given_segno (pds_no));
	apte.dseg = pds$dstep;

/**** Here we set up apte.ipc_r_offset for the Initializer process.  This
      is an 18-bit unsigned integer used by IPC to validate event channel
      names in conjunction with apte.ipc_r_factor.  This latter number
      is determined later, in init_proc.  This is done on order to provide
      an undeterministic delay between the initialization of these two
      numbers in order to make it difficult to guess one given the other. */

	apte.ipc_r_offset = binary (substr (bit (binary (clock (), 54), 54), 37, 18), 18);

/**** Set the value of apte.ipc_r_factor to zero for debugging purposes
      so that we can determine whether it is getting set or not later. */

	apte.ipc_r_factor = 0;

	aptep = scs$idle_aptep (tag);
	apte.prds = rel (get_ptrs_$given_segno (prds_no));

	tcm.stat (2) = 1;				/* one process is ready */
	tcm.wcte (0).nel = 1;			/* one eligible in wc zero */

/* Now set up miscellaneous tc_data variables */

	tcm.n_eligible = 1;
	time = clock ();				/* get current time */
	tcm.next_alarm_time = time;
	tcm.opc_polling_time = time;
	tcm.disk_polling_time = time;
	tcm.tape_polling_time = time;
	tcm.volmap_polling_time = time;
	tcm.initialize_time = time;
	tcm.define_wc_time = time;
	tcm.nto_check_time = time;
	tcm.nto_delta = 30000000;			/* nto every 30 to 60 sec */

/* Now finish up creating the first idle process */

	call init_processor$init;			/* Initialize variables. */

	call start_cpu (tag, code);			/* Now start bootload CPU idle process. */
	if code ^= 0 then call syserr (CRASH, "tc_init: Cannot start up first idle process. Check switches.");

	tcm.wait_enable = 1;

	return;
%page;
shrink_sdw:
     proc (old_sdw, base, bound, new_sdw);

dcl  old_sdw fixed bin (71) parameter;
dcl  base fixed bin (24) parameter;
dcl  bound fixed bin (18) parameter;
dcl  new_sdw fixed bin (71) parameter;

dcl  1 sdwi aligned like sdw_info automatic;


	call sdw_util_$dissect (addr (old_sdw), addr (sdwi));
						/* Take the old one apart */
	sdwi.address = sdwi.address + divide (base, 1024, 26);
						/* Alter the base and bounds appropriately
						   (update the ptw address by n ptws) */
	sdwi.size = bound;
	call sdw_util_$construct (addr (new_sdw), addr (sdwi));
						/* And put it back */

     end shrink_sdw;
%page;
start_other_cpus:
     entry;

/* This entry is called late in initialization to start any
   CPUs in the configuration that are marked as online in
   the config deck */

/* first, if the bootload cpu is a DPS8M, enter the contents of the ID PROM in
   the syserr_log. We could not do it earlier in initialization beause syserr
   logging was not enabled. */

	if scs$processor_data (tag).cpu_type > 0
	then					/* if DPS8 cpu... */
	     if addr (scs$processor_switch_data (2)) -> dps8_rsw_2.id_prom then do;
						/* and id prom present */
		call privileged_mode_ut$read_id_prom (cpu_model, 0);
						/* get cpu model from ID PROM */
		call privileged_mode_ut$read_id_prom (cpu_serial, 13);
						/* get cpu serial # from ID PROM */
		call privileged_mode_ut$read_id_prom (cpu_ship_date, 26);
						/* get ship date from ID PROM */
		call syserr (4, "CPU ^a: Model #: ^a; Serial #: ^a; Ship date: ^a.",
						/* log info from id prom */
		     substr ("ABCDEFGH", tag + 1, 1), cpu_model, cpu_serial, cpu_ship_date);
		end;

/* second, delete all old prds's, to guard against changes in prds format from one bootload to the next. */


	do i = 1 to 8;
	     prds_name = "cpu_" || substr (LETTERS, i, 1) || ".prds";
	     call delentry$dfile (PRDS_DIR, prds_name, code);
	     if code ^= 0
	     then if code = error_table_$noentry then code = 0;
	     if code = 0 then do;
		if i - 1 = prds$processor_tag then do;	/* This processor. */
		     call chname$cfile (PRDS_DIR, "prds", "prds", prds_name, code);
		     if code ^= 0
		     then call syserr$error_code (ANNOUNCE, code, "tc_init: could not rename prds to ^a.", prds_name);
		     end;
		end;
	     else call syserr$error_code (ANNOUNCE, code, "tc_init: could not delete old ^a.", prds_name);
	end;

	cpu_cardp = null ();
	sys_info$hfp_exponent_available = "1"b;		/* let's pretend there are no L68s */
other_loop:
	call config_$find (CPU_CARD_WORD, cpu_cardp);
	if cpu_cardp = null () then return;		/* Return after all cards examined. */

	i = cpu_card.tag - 1;

/* Create and entry-hold the PRDS for all but the bootload CPU. This has already been done for
   the bootload PRDS, which is deciduous. Save the astep result in the idle APTE. */

	if i ^= tag then do;			/* Don't do bootload. */
	     prds_name = "cpu_" || substr (LETTERS, i + 1, 1) || ".prds";
	     call append$branchx (PRDS_DIR, prds_name, RW_mode, seg_rb, pds$process_group_id, 0, 0, 0, code);
	     if code = 0
	     then call initiate (PRDS_DIR, prds_name, "", 0, 0, prdsp, code);
	     else prdsp = null ();
	     if code = 0
	     then scs$idle_aptep (i) -> apte.prds = rel (grab_aste$prewithdraw (prdsp, tc_data$prds_length, code));
	     if code ^= 0 then do;
		call syserr$error_code (ANNOUNCE, code, "tc_init: cannot create ^a. This CPU may not be added.",
		     prds_name);
		cpu_card.state = "off";		/* avoid trying to start it. */
		scs$idle_aptep (i) = null ();		/* Cause easy crawlout later */
		end;
	     if prdsp ^= null () then call terminate_$teseg (prdsp, (0), code);
	     end;
	if cpu_card.state = "on"
	then					/* If CPU is to be added ... */
	     if i ^= tag then do;			/* If not the bootload processor ... */
		call start_cpu (i, code);
		if code ^= 0
		then call syserr (ANNOUNCE, "tc_init: Could not start CPU ^a.", substr ("ABCDEFGH", cpu_card.tag, 1));
		end;
	if cpu_card.type ^= "dps8"
	then					/* oh well */
	     sys_info$hfp_exponent_available = "0"b;	/* no mixed configurations for hex fp */
	go to other_loop;				/* Loop. */

/* format: off */
%page; %include stack_0_data;
%page; %include sys_trace;
%page; %include apte;
%page; %include sdw_info;
%page; %include tcm;
%page; %include hc_lock;
%page; %include scs;
%page; %include slt;
%page; %include slte;
%page; %include config_cpu_card;
%page; %include config_schd_card;
%page; %include config_tcd_card;
%page; %include syserr_constants;
%page; %include system_types;
%page; %include rsw;
%page;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   tc_init: No valid processor tags on CPU cards.

   S: $crash

   T: $init

   M: No CPU CONFIG cards contained valid (A - H) CPU tags. Normally this message will
   not appear if the bootload CPU is mis-specified, as this error will be detected by
   scas_init, and thus this may be indicative of a supervisor logic problem.

   A: Check that all CPU CONFIG cards are correct. If not, perform an emergency
   shutdown, correct them, and reboot. If so, be sure to get a dump and contact
   system programming personnel.

   Message:
   tc_init: Cannot start up first idle process. Check switches.

   S: $crash

   T: $init

   M: The idle process for the bootload CPU could not be started. This may be
   an error in setting of configuration switches, or may be indicative of a logic problem in the
   supervisor.

   A: Perform an emergency shutdown. Check all main module configuration switches.
   If a problem was corrected, reboot. Otherwise, be sure to get a dump and contact
   the systems programming staff.

   Message:
   tc_init: Could not rename prds to PRDSNAME. ERRORMESSAGE

   S: $info

   T: $init

   M: The segment "prds" in >system_library_1 could not be renamed to PRDSNAME, which
   is the correct name for the PRDS for the bootload processor.
   ERRORMESSAGE is a standard error_table_ message.

   A: Notify the system programming staff. Action should be taken by the programming staff to rename this
   segment. If the problem cannot be sorted out, avoid reconfiguring the bootload
   CPU during this bootload.

   Message:
   tc_init: Could not delete old PRDSNAME. ERRORMESSAGE

   S: $info

   T: $init

   M: The old PRDS PRDSNAME from the previous bootload, in >system_library_1, could not
   be deleted. When the CPU whose tag is part of PRDSNAME is added, the old PRDS will be used.
   ERRORMESSAGE is a standard error_table_ message.

   A: $notify

   Message:
   tc_init: Could not start CPU CPUTAG.

   S: $info

   T: $init

   M: The CPU whose tag is CPUTAG could not be automatically started by system bootload.

   A: Check all configuration switches on CPU and main memory modules, especially
   the CPU STEP switch on the CPU which could not be added, and its port
   enable switches. If all switches were correct, add the CPU via the addcpu command.

   Message:
   tc_init: cannot create cpu_X.prds. This CPU may not be added. ERROR_MESSAGE

   S: $info

   T: $init

   M: A difficulty was encountered in creating the PRDS for a configurable CPU.
   Later attempts to add this CPU will fail.  It will be marked as "off" in the CONFIG deck.

   A: $inform
   When the problem has been remedied, shut down and reboot, and then add this CPU.

   Message:
   tc_init: Inconsistent SCHD config card values.

   S: $crash

   T: $init

   M: The SCHD config card is not in the correct format, or some values
   are out of acceptable range. In particular, the value of min_eligible
   cannot exceed that of max_eligible; also, the value of max_eligible plus
   the max number of stopped stack_0's (default = 4) cannot exceed
   max_max_eligible.

   A: Check the SCHD config card (refer to the MOH) and correct. Re-boot the
   system.

   Message:
   tc_init: Size of PRDS on TBLS card too small; XXX KW will be used.

   S: $info

   T: $init

   M: The size of the PRDS specified on the TBLS card in the Configuration Deck
   is smaller than the size of the PRDS defined in the MST header.  The size of
   the PRDS will be that defined in the MST header.  Further, the TBLS card in
   the Configuration Deck has been changed to reflect the minimum size of the
   PRDS

   Message:
   CPU CPUTAG: Model #: MODEL; Serial #: SERIAL; Ship date: YY/MM/DD.

   S: $log

   T: When the bootload CPU is a DPS8, whose tag is CPUTAG is "added" to
   the system.

   M: The MODEL, SERIAL and YY/MM/DD information is read from the DPS8 cpu's ID PROM.
   It is intended to be used as historical information
   for identifing CPUs, regardless of what their current tag is assigned as.

   A: $ignore


   END MESSAGE DOCUMENTATION */


     end tc_init;






		    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
