



		    bce_alm_die.alm                 11/11/89  1135.9r   11/11/89  0837.1        8127



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1987                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1984 *
" *                                                         *
" ***********************************************************
	segdef	bce_alm_die

" Kill ourselves (bce) off, irretrievably.  Keith Loepere, Jan 84.
" Made a better die, Keith Loepere, Jan 85.

bce_alm_die:
	inhibit	on
	lda	2048*4,dl		" clobber toehold
	epp	bp,toehold$0	" prevents exceuting switches
	mlr	(),(pr,rl)
	desc9a	0,0
	desc9a	bp|0,al

	lda	128*4,dl		" clobber fault_vector
	epp	bp,fault_vector$0	" prevents future faults from
	mlr	(),(pr,rl)	" reentering bce
	desc9a	0,0
	desc9a	bp|0,al

	dis
	tra	-1,ic		" DIE!!!
	end




		    bce_check_abort.pl1             11/11/89  1135.9rew 11/11/89  0839.0       27351



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

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

bce_check_abort: proc;

/* Check to see if the operator wants us to abort (unsolicited request key).
If so, ask operator (at console) to what extent he wants to abort.
Keith Loepere, November 1983. */


/****^  HISTORY COMMENTS:
  1) change(86-04-22,Farley), approve(86-07-18,MCR7439),
     audit(86-08-18,Fawcett), install(86-10-20,MR12.0-1189):
     Added check of ss_info.flags.request_handling_opr_aborts to see if
     handling required.
                                                   END HISTORY COMMENTS */


dcl  Abort		        char (7) static options (constant) init ("Abort? ");
dcl  Unknown_response	        char (18) static options (constant) init ("Unknown response.
");
dcl  bce_data$console_get_line        entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35)) variable ext;
dcl  bce_data$console_put_chars       entry (ptr, ptr, fixed bin, fixed bin (35)) variable ext;
dcl  bce_data$subsys_info_ptr	        ptr external;
dcl  buffer		        char (16);
dcl  buffer_read		        char (n_read) based (addr (buffer));
dcl  n_read		        fixed bin;
dcl  (addr, length)		        builtin;
dcl  request_abort_		        condition;
dcl  sub_request_abort_	        condition;
dcl  sys_boot_info$at_bce_cl	        bit (1) aligned external;
dcl  wired_hardcore_data$abort_request bit (1) aligned external;

	if ^wired_hardcore_data$abort_request then return;
	if ^sys_boot_info$at_bce_cl then return;
	if bce_data$subsys_info_ptr -> ss_info.flags.request_handling_opr_aborts then return;
query:	wired_hardcore_data$abort_request = "0"b;
	call bce_data$console_put_chars (addr (bce_data$console_put_chars), addr (Abort), length (Abort), (0));
	call bce_data$console_get_line (addr (bce_data$console_get_line), addr (buffer), length (buffer), n_read, (0));
	n_read = n_read - 1;			/* no nl */
	if buffer_read = "n" | buffer_read = "no" then return; /* false alarm */
	else if buffer_read = "y" | buffer_read = "yes" then signal sub_request_abort_;
	else if buffer_read = "request" | buffer_read = "req" | buffer_read = "r" then signal sub_request_abort_;
	else if buffer_read = "command" | buffer_read = "com" | buffer_read = "c" then signal request_abort_;
	else if buffer_read = "all" | buffer_read = "a" then go to bce_data$subsys_info_ptr -> ss_info.abort_label;
	else do;
	     call bce_data$console_put_chars (addr (bce_data$console_put_chars), addr (Unknown_response), length (Unknown_response), (0));
	     go to query;
	end;
%page; %include bce_subsystem_info_;
     end;




		    bce_console_io.pl1              11/11/89  1135.9r w 11/11/89  0839.0       38214



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */
/* BCE_CONSOLE_IO.PL1 bootload command environment console io */
/* Wrapper for odcdm_ for the command environment */
/* Written by BIM sometime in '82 */
/* Modified 830620 for new ocdcm_ interface... -E. A. Ranzenbach
/* Simplified 8/83 by Keith Loepere, for new bce switches */
/* Modified 11/83 by Keith Loepere to loop waiting for non-zero input line */
/* Modified 12/83 by Keith Loepere for put_chars_alert */
/* Modified 840418 to zero console io before filling... -E. A. Ranzenbach */
/* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */

bce_console_io:
     procedure;

/* Entrypoints are get_line, put_chars */

/* This program loops on the console by calling ocdcm until */
/* it returns success */

dcl  Buffer_ptr		        ptr parameter;
dcl  Buffer_len		        fixed bin parameter;
dcl  Buffer		        char (Buffer_len) based (Buffer_ptr);
dcl  Code			        fixed bin (35) parameter;
dcl  Switch_ptr		        ptr parameter;
dcl  N_read		        fixed bin parameter;

dcl  bce_check_abort	        entry;
dcl  oc_trans_input_	        entry (ptr, fixed bin, fixed bin, ptr, fixed bin);
dcl  oc_trans_output_	        entry (ptr, fixed bin (21), fixed bin (21), ptr, fixed bin (19), fixed bin (17), bit (1) aligned);
dcl  ocdcm_$priority_io	        entry (ptr);

dcl  alert		        bit (1) aligned;
dcl  cont			        bit (1) aligned;
dcl  cur_ptr		        pointer;
dcl  internal_buffer	        char (256) aligned;
dcl  1 my_console_io	        aligned like console_io;
dcl  n_done		        fixed bin (21);
dcl  n_to_send		        fixed bin (19);
dcl  n_to_write		        fixed bin (21);

dcl  addcharno		        builtin;
dcl  addr			        builtin;
dcl  length		        builtin;
dcl  min			        builtin;
dcl  substr		        builtin;
dcl  unspec		        builtin;
%page;

/* For now, assume that we will always be called with a big enough */
/* buffer to hold an entire input line, converted. */

get_line:
     entry (Switch_ptr, Buffer_ptr, Buffer_len, N_read, Code);
	Code = 0;

read:	unspec (my_console_io) = ""b;
	console_io_ptr = addr (my_console_io);
	console_io.event_chan = 0;			/* build the I/O..*/
	console_io.read = "1"b;
	console_io.alert = "0"b;
	console_io.sequence_no = 0;

	call ocdcm_$priority_io (console_io_ptr);	/* do the input...*/
	if console_io.leng = 0 then go to read;	/* wait for non-null line */

	call oc_trans_input_ (addr (internal_buffer), length (internal_buffer), N_read, addr (console_io.text), (console_io.leng));

	substr (Buffer, 1, min (length (Buffer), N_read)) =
	     substr (internal_buffer, 1, min (length (Buffer), N_read));

	return;

put_chars:
     entry (Switch_ptr, Buffer_ptr, Buffer_len, Code);

	alert = "0"b;
	go to put;

put_chars_alert:
     entry (Switch_ptr, Buffer_ptr, Buffer_len, Code);

	alert = "1"b;
put:
	internal_buffer = "";
	n_to_write = length (Buffer);			/* so they want trailing blanks ! */
	cont = "0"b;
	cur_ptr = addr (Buffer);
	do while (n_to_write > 0);

/* The unused arguments are an output word count and a type flag */

	     call bce_check_abort;
	     call oc_trans_output_ (cur_ptr, n_to_write, n_done, addr (internal_buffer), n_to_send, 80, cont);
						/* cont is input_output */

	     unspec (my_console_io) = ""b;
	     console_io_ptr = addr (my_console_io);

	     console_io.event_chan = 0;		/* build the I/O..*/
	     console_io.read = "0"b;
	     console_io.alert = alert;
	     console_io.sequence_no = 0;
	     console_io.leng = n_to_send;
	     console_io.text = substr (internal_buffer, 1, n_to_send * 4);

	     call ocdcm_$priority_io (console_io_ptr);	/* do the output */

	     n_to_write = n_to_write - n_done;
	     cur_ptr = addcharno (cur_ptr, n_done);
	end;
	Code = 0;
	return;
%page;
%include oc_data;
     end bce_console_io;




		    bce_continue.pl1                11/11/89  1135.9rew 11/11/89  0839.0       20286



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


/****^  HISTORY COMMENTS:
  1) change(87-02-26,Farley), approve(87-04-15,MCR7661),
     audit(87-04-21,Fawcett), install(87-04-28,MR12.1-1028):
     Added check for fgbx.io_reconfig, which will be on when an attempted I/O
     reconfiguration may corrupt memory (e.g. adding an IOM).
                                                   END HISTORY COMMENTS */


bce_continue: proc;

/* return to Multics; also return to bos.
Keith Loepere, January 1984. */

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

dcl  addr			        builtin;
dcl  com_err_		        entry () options (variable);
dcl  pmut$special_bce_return	        entry (bit (72) aligned);
dcl  ssenb		        bit (1) aligned;
dcl  sys_boot_info$assume_config_deck bit (1) aligned external;
dcl  1 toehold$		        aligned like toe_hold external;
dcl  unspec		        builtin;

	if ^ (sys_info$collection_1_phase = CRASH_INITIALIZATION | sys_info$collection_1_phase = BCE_CRASH_INITIALIZATION) then do;
	     call com_err_ (0, "continue", "No image to restart.");
	     return;
	end;
	fgbxp = addr (flagbox$);
	if fgbx.io_reconfig then do;
	     call com_err_ (0, "continue", "Not allowed to restart. Memory may have been corrupted.");
	     return;
	end;

	ssenb = fgbx.rtb.ssenb;		/* zero all rtb except ssenb */
	unspec (fgbx.rtb) = "0"b;
	fgbx.rtb.ssenb = ssenb;
	call pmut$special_bce_return (toehold$.entry_sequences (TOE_HOLD_RESTART_ENTRY));
	return;

bce_bos: entry;

	if ^sys_boot_info$assume_config_deck then do;
	     call com_err_ (0, "bos", "BOS is not present.");
	     return;
	end;
	call pmut$special_bce_return (toehold$.entry_sequences (TOE_HOLD_BOS_MULTICS_ENTRY));
	return;

%page; %include collection_1_phases;
%page; %include flagbox;
%page; %include toe_hold;
     end;




		    bce_data.cds                    11/11/89  1135.9rew 11/11/89  0837.1       20736



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Bull Inc., 1987                *
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1984 *
   *                                                         *
   *********************************************************** */
/* BCE_DATA.CDS data for the Bootload Command Environment */
/* BIM 8/82 */
/* Modified by Keith Loepere various times in 83 for bce switches */
/* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */

bce_data:
     procedure;


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

declare  1 bce_data_static		  aligned,

/* bce switches--- these must be in entry-ptr order */

	 2 console_put_chars	  entry,
	 2 console_put_chars_data_ptr   ptr init (null),

	 2 console_get_line		  entry,
	 2 console_get_line_data_ptr    ptr init (null),

	 2 console_alert_put_chars	  entry,
	 2 console_alert_put_chars_data_ptr ptr init (null),

	 2 get_line		  entry,
	 2 get_line_data_ptr	  ptr init (null),

	 2 put_chars		  entry,
	 2 put_chars_data_ptr	  ptr init (null),

	 2 error_put_chars		  entry,
	 2 error_put_chars_data_ptr	  ptr init (null),

           2 exec_com_get_line	  entry,
	 2 command_abs_data_ptr	  pointer init (null),

/* miscelaneous */

	 2 free_area_ptr		  pointer init (null),
	 2 subsys_info_ptr		  pointer init (null),
	 2 number_of_temp_segs	  fixed bin;

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

	CDSA.sections (1).p = null ();
	CDSA.sections (1).len = 0;
	CDSA.sections (2).p = addr (bce_data_static);
	CDSA.sections (2).len = size (bce_data_static);
	CDSA.sections (2).struct_name = "bce_data_static";
	CDSA.seg_name = "bce_data";
	CDSA.num_exclude_names = 1;
	CDSA.exclude_array_ptr = addr (PADSTAR);
	CDSA.have_static = "1"b;
	CDSA.switches.have_text = "0"b;
	call create_data_segment_ (addr (CDSA), code);
	if code ^= 0
	then call com_err_ (code, "bce_data");
	return;
     end bce_data;




		    bce_die.pl1                     11/11/89  1135.9r w 11/11/89  0839.0       17424



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

/* kill ourselves off.
Keith Loepere, January 1984. */

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

dcl  P_ss_info_ptr		        ptr parameter;
dcl  arg			        char (arg_len) based (arg_ptr);
dcl  arg_count		        fixed bin;
dcl  arg_len		        fixed bin (21);
dcl  arg_ptr		        ptr;
dcl  bce_alm_die		        entry;
dcl  bce_query$yes_no	        entry options (variable);
dcl  code			        fixed bin (35);
dcl  com_err_		        entry () options (variable);
dcl  cu_$arg_count_rel	        entry (fixed bin, ptr, fixed bin (35));
dcl  cu_$arg_ptr_rel	        entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr);
dcl  me			        char (3) static options (constant) init ("die");
dcl  request_abort_		        condition;
dcl  yes_no		        bit (1);

	ss_info_ptr = P_ss_info_ptr;
	call cu_$arg_count_rel (arg_count, ss_info.arg_list_ptr, code);
	if code ^= 0 then go to arg_error;
	if arg_count > 0 then do;
	     call cu_$arg_ptr_rel (1, arg_ptr, arg_len, code, ss_info.arg_list_ptr);
	     if arg = "-force" | arg = "-fc" then call bce_alm_die;
	     else go to arg_error;
	     if arg_count > 1 then do;
arg_error:	call com_err_ (code, me, "Usage is: die {-force | -fc}");
		return;
	     end;
	end;
	call bce_query$yes_no (yes_no, "Do you really wish bce to die? ");
	if yes_no then call bce_alm_die;
	else signal request_abort_;
%page; %include bce_subsystem_info_;
     end;





		    bce_error.pl1                   11/11/89  1135.9r w 11/11/89  0839.1       38682



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */
/* BCE_ERROR -- com_err_ replacement for bootload environment */
/* BIM '82 */
/* Modified by Keith Loepere in 8/83 for new bce switches */
/* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */

bce_error:
     procedure (Code) /* options (variable) */;

declare  Code			  fixed bin (35) parameter;
declare  Me			  char (*) parameter;

declare  1 error_code		  aligned,
	 2 pad_segno		  bit (18) unaligned, /* for now, assume error_table_ */
	 2 error_table_offset	  fixed bin (18) uns unal;
declare  picture_code		  pic "------------9";

declare  etep			  pointer;

declare  1 error_table_entry		  aligned based (etep),
	 2 length			  fixed bin (9) unsigned unaligned,
	 2 message		  character (0 refer (error_table_entry.length)) unaligned;

declare  length			  builtin;
declare  pointer			  builtin;
declare  unspec			  builtin;

declare  n_args			  fixed bin;
declare  message_buffer		  char (512);
declare  work_buffer		  char (work_buffer_len) based (work_buffer_ptr);
declare  work_buffer_len		  fixed bin;
declare  work_buffer_ptr		  ptr;
declare  string_len			  fixed bin (21);
declare  tcode			  fixed bin (35);

declare  first_ioa_arg		  fixed bin;

declare  arg_list_ptr_		  entry () returns (pointer);
declare  cu_$arg_count		  entry (fixed bin, fixed bin (35));
declare  ioa_$general_rs		  entry (ptr, fixed bin, fixed bin, char (*), fixed bin (21), bit (1) aligned,
				  bit (1) aligned);
declare  bce_data$error_put_chars
				  entry (ptr, ptr, fixed bin, fixed bin (35)) external variable;
declare  error_table_$		  bit (36) aligned external static;
%page;
	work_buffer_ptr = addr (message_buffer);
	work_buffer_len = length (message_buffer);
	first_ioa_arg = 2;
	goto join;

com_err:
     entry (Code, Me);				/* options (variable); for com_err_ support */
	work_buffer_ptr = addr (message_buffer);
	work_buffer_len = length (message_buffer);
	string_len = length (rtrim (Me));
	substr (work_buffer, 1, string_len) = substr (Me, 1, string_len);
	substr (work_buffer, string_len + 1, 2) = ": ";
	work_buffer_ptr = addcharno (work_buffer_ptr, string_len + 2);
	work_buffer_len = work_buffer_len - (string_len + 2);
	first_ioa_arg = 3;

join:
	if Code ^= 0
	then do;
	     unspec (error_code) = unspec (Code);
	     if error_code.pad_segno ^= "077777"b3
	     then do;
		substr (work_buffer, 1, 5) = "Code ";
		picture_code = Code;
		string_len = length (ltrim (picture_code));
		substr (work_buffer, 6, string_len) =
		     substr (picture_code, length (picture_code) - string_len + 1, string_len);
		work_buffer_ptr = addcharno (work_buffer_ptr, 5 + string_len);
		work_buffer_len = work_buffer_len - (5 + string_len);
	     end;
	     else do;
		etep = pointer (addr (error_table_$), error_code.error_table_offset);
		substr (work_buffer, 1, error_table_entry.length) = error_table_entry.message;
		work_buffer_ptr = addcharno (work_buffer_ptr, error_table_entry.length);
		work_buffer_len = work_buffer_len - (error_table_entry.length);
	     end;
	     substr (work_buffer, 1, 1) = " ";
	     work_buffer_ptr = addcharno (work_buffer_ptr, 1);
	     work_buffer_len = work_buffer_len - 1;
	end;
	call cu_$arg_count (n_args, tcode);
	if n_args >= first_ioa_arg 
	then do;
	     call ioa_$general_rs (arg_list_ptr_ (), first_ioa_arg, first_ioa_arg + 1, work_buffer, string_len, "0"b, "0"b);
	     work_buffer_ptr = addcharno (work_buffer_ptr, string_len);
	     work_buffer_len = work_buffer_len - string_len;
	end;
	substr (work_buffer, 1, 1) = "
";
	work_buffer_ptr = addcharno (work_buffer_ptr, 1);
	work_buffer_len = work_buffer_len - 1;

	work_buffer_ptr = addr (message_buffer);
	work_buffer_len = length (message_buffer) - work_buffer_len;
	call bce_data$error_put_chars (addr (bce_data$error_put_chars), addr (work_buffer), length (work_buffer), (0));
	return;
     end bce_error;




		    bce_esd.pl1                     11/11/89  1135.9rew 11/11/89  0839.1       21708



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


/****^  HISTORY COMMENTS:
  1) change(87-02-26,Farley), approve(87-04-15,MCR7661),
     audit(87-04-21,Fawcett), install(87-04-28,MR12.1-1028):
     Added check for fgbx.io_reconfig that is turned on whenever an I/O
     reconfiguration can cause memory to be corrupted.  Thus no emergency
     shutdown should be attempted, because it would only propagate the
     corruption.
                                                   END HISTORY COMMENTS */


bce_esd: proc (info_ptr);

/* Routine to modify machine conditions so as to invoke esd.
Written August 1983 by Keith Loepere. */
/* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */

dcl  bce_continue		        entry (ptr);
dcl  com_err_		        entry options (variable);
dcl  emergency_shutdown$	        entry;
dcl  info_ptr		        ptr parameter;
dcl  1 toehold$		        aligned external like toe_hold;
dcl  (addr, bin, bit, codeptr, segno, string, wordno) builtin;
%page; %include collection_1_phases;
%page; %include flagbox;
%page; %include toe_hold;

	fgbxp = addr (flagbox$);
	if ^fgbx.ssenb then do;
	     call com_err_ (0, "esd", "Storage system not enabled.  esd not performed.");
	     return;
	end;

	if fgbx.io_reconfig then do;
	     call com_err_ (0, "esd", "Emergency shutdown is prohibited due to possible memory corruption.");
	     sys_info$collection_1_phase = BOOT_INITIALIZATION;
	     toehold$.memory_state = At_bce__boot;
	     return;
	end;

	mc_state_ptr = addr (toehold$.multics_state);
	mcp = addr (mc_state.mc_);
	scup = addr (mc.scu);
	scu.ppr.prr = "000"b;
	scu.ppr.psr = bit (bin (segno (codeptr (emergency_shutdown$)), 15), 15);
	scu.ppr.p = "1"b;
	string (scu.apu) = "0"b;
	scu.fault_cntr = "0"b;

	scu.ilc = bit (bin (wordno (codeptr (emergency_shutdown$)), 18), 18);
	string (scu.ir) = "0"b;
	scu.ir.bm = "1"b;

	mc_state.interrupt = "0"b;
	mc_state.cfg = "0"b;

	call bce_continue (info_ptr);			/* won't return */
     end;




		    bce_execute_command_.pl1        11/11/89  1135.9r w 11/11/89  0839.1       41193



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */
/* bce_execute_command_ -- use map_over_requests_ to find the request desired.
Call it appropriately. */

/* format: style2 */

/* Written by Benson Margulies or someone who programs like him.
Modified the last possible day of 1983 to allow Multics requests within bce
by Keith Loepere. */

bce_execute_command_:
     procedure (Info_ptr, Request, Arg_list_ptr, Code);

	declare Request		 char (*);
	declare Info_ptr		 pointer;	/* to ss_info */
	declare Arg_list_ptr	 pointer;	/* from command_processor_ */
	declare Code		 fixed bin (35);
	declare execute_entry	 entry (ptr) variable;
	declare 1 p_info		 aligned,	/* passed to CHECK_ONE */
		2 request_name	 char (32) unaligned,
		2 found		 entry (pointer);

	declare arg_count		 fixed bin;
	declare 1 entry_variable	 aligned,	/* template thereof */
		2 code_ptr	 pointer,
		2 env_ptr		 pointer;

	declare Global_RQ_data_ptr	 pointer;	/* global to FOUND */
	declare bce_map_over_requests_ entry (entry, ptr, ptr);
	declare cu_$af_arg_count_rel	 entry (fixed bin, fixed bin (35), ptr);
	declare cu_$generate_call	 entry (entry, ptr);
	declare error_table_$active_function
				 fixed bin (35) ext static;
	declare error_table_$bad_command_name
				 fixed bin (35) ext static;
	declare error_table_$not_act_fnc 
				 fixed bin (35) ext static;

	declare 1 bce_flags		 aligned based (addr (rq_data.flags)),
		2 system_flags	 bit (15) unal,	/* our own interpretation of rq_data.flags for bce */
		2 valid_at_early	 bit (1) unal,
		2 valid_at_boot	 bit (1) unal,
		2 valid_at_crash	 bit (1) unal;

	declare (addr, null, pointer, unspec)
				 builtin;
%page;
	Code = 0;
	ss_info_ptr = Info_ptr;
	ss_info.arg_list_ptr = Arg_list_ptr;
	p_info.request_name = Request;
	p_info.found = FOUND;

	call bce_map_over_requests_ (CHECK_ONE, addr (p_info), ss_info.request_table_ptr);

/**** Get here if not found ****/

	Code = error_table_$bad_command_name;
	return;

CHECK_ONE:
     procedure (Request_data_ptr, Info_ptr);

	declare Request_data_ptr	 pointer;	/* to ssu_ request table */
	declare Info_ptr		 pointer;

	declare 1 info		 based (Info_ptr) aligned like p_info; /* passed structure providing command name */
	declare nx		 fixed bin; /* name index */

	rq_data_ptr = Request_data_ptr;
	if sys_info$collection_1_phase = BCE_CRASH_INITIALIZATION then
	     if ^ (bce_flags.valid_at_boot | bce_flags.valid_at_crash) then return;
	     else;
	else if sys_info$collection_1_phase = CRASH_INITIALIZATION then
	     if ^ bce_flags.valid_at_crash then return;
	     else;
	else if sys_info$collection_1_phase = EARLY_INITIALIZATION then
	     if ^ bce_flags.valid_at_early then return;
	     else;
	else if sys_info$collection_1_phase = BOOT_INITIALIZATION then
	     if ^ bce_flags.valid_at_boot then return;
	     else;

	request_name_list_ptr = pointer (rq_data_ptr, rq_data.namelist_loc);
	do nx = 1 to request_name_list.n_names;
	     if request_name_list.name (nx) = info.request_name
	     then call info.found (rq_data_ptr);	/* never returns */
	end;

     end CHECK_ONE;

FOUND:
     procedure (Request_data_ptr);
	declare Request_data_ptr	 pointer;

	Global_RQ_data_ptr = Request_data_ptr;
	go to FOUND_LABEL;				/* nonlocal up the wazzu */
     end FOUND;

FOUND_LABEL:
	rq_data_ptr = Global_RQ_data_ptr;
	call cu_$af_arg_count_rel (arg_count, Code, Arg_list_ptr);
	if Code = 0 then  /* active function usage */
	     if ^ rq_data.allow_af then do;
		Code = error_table_$not_act_fnc;
		return;
	     end;
	     else;
	else if ^ rq_data.allow_command then do;
		Code = error_table_$active_function;
		return;
	     end;
	Code = 0;
	entry_variable.code_ptr = pointer (rq_data_ptr, rq_data.code_loc);
	entry_variable.env_ptr = null ();
	unspec (execute_entry) = unspec (entry_variable);

/* call routine with arg_list supplied depending on object type */

	if rq_data.multics_request then call cu_$generate_call (execute_entry, ss_info.arg_list_ptr);
	else call execute_entry (ss_info_ptr);
	return;

%include "_ssu_request_table";
%include "_ssu_request_data";
%include bce_subsystem_info_;
%include collection_1_phases;
     end bce_execute_command_;




		    bce_fwload.pl1                  11/11/89  1135.9r w 11/11/89  0839.1      108072



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

/* bce routine to load, upon command, a given mpc.
Keith Loepere, January 1984. */

/* modified October of 1984 to add -channel argument - Allen Ball. */

/* format: style4,initcol1,indattr,declareind8,dclind4,idind36,ifthenstmt,ifthen,^indproc,delnl,insnl */

dcl addr				builtin;
dcl arg				char (arg_len) based (arg_ptr);
dcl arg_count			fixed bin;	/* number of mpcs */
dcl arg_len			fixed bin (21);
dcl arg_num			fixed bin;	/* loop counter */
dcl arg_ptr			ptr;
dcl baseno			builtin;
dcl bin				builtin;
dcl character			builtin;
dcl code				fixed bin (35);
dcl com_err_			entry () options (variable);
dcl config_$find			entry (char (4) aligned, ptr);
dcl config_$find_2			entry (char (4) aligned, char (4) aligned, ptr);
dcl cu_$arg_count_rel		entry (fixed bin, ptr, fixed bin (35));
dcl cu_$arg_ptr_rel			entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr);
dcl cv_dec_check_			entry (char (*), fixed bin (35)) returns (fixed bin (35));
dcl dimension			builtin;
dcl divide			builtin;
dcl fw_modules			(16) char (8);	/* names of fw modules to load */
dcl fw_module_count			fixed bin;	/* number of modules */
dcl hc_load_mpc			entry (char (8) aligned, ptr, fixed bin (18), char (*), fixed bin (35));
dcl hc_load_mpc$urc			entry (char (8) aligned, (*) ptr, (*) fixed bin (18), char (*), fixed bin (35));
dcl increment			fixed bin;
dcl index				builtin;
dcl ioa_				entry () options (variable);
dcl ltrim				builtin;
dcl max				builtin;
dcl me				char (6) static options (constant) init ("fwload");
dcl mpc_chanid			char (8) aligned;	/* iom/channel name */
dcl mpc_name			char (4) aligned;	/* as in mspa */
dcl null				builtin;
dcl p_ss_info_ptr			ptr parameter;
dcl preferred_mpc_chanid		char (8) aligned;
dcl slt$				external;
dcl slt_manager$get_seg_ptr		entry (char (32) aligned) returns (ptr);
dcl substr			builtin;
dcl translate			builtin;
%page;
	ss_info_ptr = p_ss_info_ptr;
	call cu_$arg_count_rel (arg_count, ss_info.arg_list_ptr, code);
	if code ^= 0 | arg_count < 1 then do;
usage:
	     call com_err_ (code, me, "Usage: fwload mpc_names {args}");
	     return;
	end;
	do arg_num = 1 repeat arg_num + increment while (arg_num <= arg_count);
	     preferred_mpc_chanid = "";
	     increment = 1;
	     call cu_$arg_ptr_rel (arg_num, arg_ptr, arg_len, code, ss_info.arg_list_ptr);
	     mpc_name = arg;
	     if arg_num + 2 <= arg_count then do;
		call cu_$arg_ptr_rel (arg_num + 1, arg_ptr, arg_len, code, ss_info.arg_list_ptr);
		if substr (arg, 1, 1) = "-" then do;	/* It must be a control argument. */
		     if arg = "-channel" | arg = "-chnl" then do;
			call cu_$arg_ptr_rel (arg_num + 2, arg_ptr, arg_len, code, ss_info.arg_list_ptr);
			if code = 0 then do;
			     preferred_mpc_chanid = arg;
			     increment = 3;
			end;
			else do;
			     call ioa_ ("^a: A channel must be specified.", me);
			     return;
			end;
		     end;
		     else do;
			call ioa_ ("^a: ^a is not a recognized option.", me, arg);
			return;
		     end;
		end;
	     end;
	     if find_mpc (mpc_chanid, mpc_name, fw_modules, fw_module_count, mpc_cardp) then do;
		if preferred_mpc_chanid ^= "" then do;
		     if validate_primary_channel (preferred_mpc_chanid, mpc_cardp) then
			call load_mpc (preferred_mpc_chanid, mpc_name, fw_modules, fw_module_count);
		     else do;
			call ioa_ ("^a: Channel ^a is not a primary channel for ^a.", me, preferred_mpc_chanid,
			     mpc_name);
			return;
		     end;
		end;
		else call load_mpc (mpc_chanid, mpc_name, fw_modules, fw_module_count);
	     end;
	     else do;
		call ioa_ ("^a: ^a is not a valid mpc.", me, mpc_name);
		return;
	     end;
	end;
	return;
%page;
find_mpc:
     proc (mpc_chanid, mpc_name, fw_modules, fw_module_count, p_mpc_cardp) returns (bit (1) aligned);

/* search the config deck for an mpc so as to know what channel and module is
   needed - also find peripherals for urcs */

dcl code				fixed bin (35);
dcl fw_modules			(16) char (8) parameter;
dcl fw_module_count			fixed bin parameter;
dcl fw_module_num			fixed bin;	/* loop counter */
dcl mpc_chanid			char (8) aligned parameter;
						/* iom/channel */
dcl mpc_name			char (4) aligned parameter;
						/* as in mspa */
dcl mpc_type_letter			char (1);		/* code letter for mpc type, d t or u */
dcl overlay_name			char (4);		/* firmware module type to overlay */
dcl p_mpc_cardp			ptr parameter;

/* find the mpc */

	mpc_cardp = null;
	call config_$find_2 (MPC_CARD_WORD, mpc_name, mpc_cardp);
	if mpc_cardp = null then go to mpc_error;
	p_mpc_cardp = mpc_cardp;

	call io_chnl_util$iom_to_name ((mpc_card.port (1).iom), (mpc_card.port (1).chan), mpc_chanid, code);
	if code ^= 0 then do;
mpc_error:
	     call com_err_ (0, me, "No such mpc ^a.", mpc_name);
	     return ("0"b);
	end;

/* find the firmware type */

	fw_module_count = 1;
	if substr (mpc_name, 1, 3) = "msp" then mpc_type_letter = "d";
	else if substr (mpc_name, 1, 3) = "mtp" then mpc_type_letter = "t";
	else if substr (mpc_name, 1, 3) = "urp" then mpc_type_letter = "u";
	else do;
	     call com_err_ (0, me, "Unrecognizable mpc type for mpc ^a", mpc_name);
	     return ("0"b);
	end;
	fw_modules (1) = mpc_type_letter || ltrim (character (mpc_card.model));
	if mpc_type_letter ^= "u" then return ("1"b);	/* non urcs have just the main firmware */

/* urc - we must find peripherals on it */

	fw_module_count = 1 + mpc_card.port (1).nchan;
	do fw_module_num = 2 to fw_module_count;
	     fw_modules (fw_module_num) = "none";	/* for now */
	end;

	prph_cardp = null;
	call config_$find ("prph", prph_cardp);
	do while (prph_cardp ^= null);
	     if (prph_card.iom = mpc_card.port (1).iom) &
		((mpc_card.port (1).chan <= prph_card.chan)
		& (prph_card.chan < mpc_card.port (1).chan + mpc_card.port (1).nchan)) then do;
						/* prph on this mpc */
		if substr (prph_card.name, 1, 3) = "prt" then overlay_name = "pr4";
		else if substr (prph_card.name, 1, 3) = "rdr" then overlay_name = "crz";
		else if substr (prph_card.name, 1, 3) = "pun" then overlay_name = "cpz";
		else if substr (prph_card.name, 1, 3) = "ccu" then overlay_name = "crp";
		else overlay_name = "none";
		fw_module_num = prph_card.chan - mpc_card.port (1).chan + 2;
		if fw_modules (fw_module_num) ^= "ccu" then fw_modules (fw_module_num) = overlay_name;
						/* ccu over-rides crz crp */
	     end;
	     call config_$find ("prph", prph_cardp);
	end;
	return ("1"b);
     end;
%page;
load_mpc:
     proc (mpc_chanid, mpc_name, fw_modules, fw_module_count);

dcl controller_fwid			char (32) aligned;	/* name of firmware object */
dcl fw_module_count			fixed bin parameter;
dcl fw_modules			(16) char (8) parameter;
dcl fw_seg_lengths			(16) fixed bin (18);/* argument to hc_load_mpc of firmware object lengths */
dcl fw_seg_num			fixed bin;	/* loop counter */
dcl fw_seg_ptrs			(16) ptr;		/* arg to hc_load_mpc */
dcl mpc_chanid			char (8) aligned parameter;
						/* iom/channel */
dcl mpc_model			fixed bin;	/* decimal mpc type */
dcl mpc_name			char (4) aligned parameter;
						/* as in mspa */
dcl mpc_overlay			char (8);		/* firmware code for overlay */
dcl mpc_type			char (8);		/* model in ascii, with model and type letter code */
dcl mpc_type_index			fixed bin;	/* loop counter */
dcl problem			char (64);	/* load failure message */
dcl var_fw_seg_lengths		(fw_module_count) fixed bin (18) based (addr (fw_seg_lengths));
						/* arrays so as to pass (*) dim to hc_load_mpc */
dcl var_fw_seg_ptrs			(fw_module_count) ptr based (addr (fw_seg_ptrs));

/* find the real firmware objects */

	do fw_seg_num = 1 to fw_module_count;
	     if fw_seg_num = 1 then do;		/* main firmware */
		mpc_type = fw_modules (1);
		mpc_model = cv_dec_check_ (substr (mpc_type, 2), code);
		if code ^= 0 then go to bad_mpc;
		if substr (mpc_type, 1, 1) = "d" then do;
		     do mpc_type_index = 1 to config_data_$mpc_msp_model_names.count
			while (mpc_model ^= config_data_$mpc_msp_model_names.names (mpc_type_index).model);
		     end;
		     if mpc_type_index > config_data_$mpc_msp_model_names.count then go to bad_mpc;
		     controller_fwid = "fw." || config_data_$mpc_msp_model_names.names (mpc_type_index).fw_tag;
		end;
		else if substr (mpc_type, 1, 1) = "t" then do;
		     do mpc_type_index = 1 to config_data_$mpc_mtp_model_names.count
			while (mpc_model ^= config_data_$mpc_mtp_model_names.names (mpc_type_index).model);
		     end;
		     if mpc_type_index > config_data_$mpc_mtp_model_names.count then go to bad_mpc;
		     controller_fwid = "fw." || config_data_$mpc_mtp_model_names.names (mpc_type_index).fw_tag;
		end;
		else if substr (mpc_type, 1, 1) = "u" then do;
		     do mpc_type_index = 1 to config_data_$mpc_urp_model_names.count
			while (mpc_model ^= config_data_$mpc_urp_model_names.names (mpc_type_index).model);
		     end;
		     if mpc_type_index > config_data_$mpc_urp_model_names.count then go to bad_mpc;
		     controller_fwid = "fw." || config_data_$mpc_urp_model_names.names (mpc_type_index).fw_tag;
		end;
		else do;
bad_mpc:
		     call com_err_ (0, me, "Unrecognizable mpc type ^a for mpc ^a", mpc_type, mpc_name);
		     return;
		end;
	     end;
	     else do;				/* urc overlay */
		mpc_overlay = fw_modules (fw_seg_num);
		if mpc_overlay = "none" then
		     controller_fwid = "none";
		else do;
		     if mpc_overlay = "pr4" then controller_fwid = "fw.urcmpc.u400";
		     else if mpc_overlay = "crp" | mpc_overlay = "crz" | mpc_overlay = "cpz" then
			controller_fwid = "fw.urcmpc.ucrp";
		     else do;
			call com_err_ (0, me, "Unrecogniable overlay name ^a for mpc ^a", mpc_overlay, mpc_name);
			return;
		     end;
		end;
	     end;

/* name found, find object */

	     if controller_fwid ^= "none" then do;
		fw_seg_ptrs (fw_seg_num) = slt_manager$get_seg_ptr (controller_fwid);
		if fw_seg_ptrs (fw_seg_num) = null then do;
		     call com_err_ (0, me, "Firmware ^a not available for model ^a mpc.", controller_fwid, mpc_type);
		     return;
		end;
		sltp = addr (slt$);
		sltep = addr (slt.seg (bin (baseno (fw_seg_ptrs (fw_seg_num)), 18)));
		fw_seg_lengths (fw_seg_num) = divide (slte_uns.bit_count, 36, 24, 0) - 1;
	     end;
	     else do;
		fw_seg_ptrs (fw_seg_num) = null;
		fw_seg_lengths (fw_seg_num) = 0;
	     end;
	end;

/* load it! */

	if fw_module_count = 1 then
	     call hc_load_mpc (mpc_chanid, fw_seg_ptrs (1), fw_seg_lengths (1), problem, code);
	else call hc_load_mpc$urc (mpc_chanid, var_fw_seg_ptrs, var_fw_seg_lengths, problem, code);
	if code ^= 0 then call com_err_ (code, me, "^a booting mpc ^a", problem, mpc_name);
	return;
     end;
%page;
validate_primary_channel:
     proc (p_mpc_chanid, p_mpc_cardp) returns (bit (1));

dcl channel			fixed bin (8);
dcl code				fixed bin (35);
dcl iom				fixed bin (3);
dcl mpc_chanid			char (8) aligned;
dcl mpc_port_index			fixed bin;
dcl p_mpc_chanid			char (8) aligned parameter;
dcl p_mpc_cardp			ptr parameter;

	mpc_chanid = p_mpc_chanid;
	mpc_cardp = p_mpc_cardp;
	iom = index ("ABCD", translate (substr (mpc_chanid, 1, 1), "ABCD", "abcd"));
	channel = cv_dec_check_ (substr (mpc_chanid, 2), code);
	if code ^= 0 then return ("0"b);
	do mpc_port_index = 1 to dimension (mpc_card_array.port, 1);
	     if (mpc_card_array.port (mpc_port_index).iom = iom) & 
		(mpc_card_array.port (mpc_port_index).chan = channel) then return ("1"b);
	end;
	return ("0"b);
     end;
%page;
%include bce_subsystem_info_;
%page;
%include config_data_dcls;
%page;
%include config_mpc_card;
%page;
%include config_prph_card;
%page;
%include io_chnl_util_dcls;
%page;
%include slt;
%page;
%include slte;
     end;





		    bce_get_to_command_level.pl1    11/11/89  1135.9r w 11/11/89  0839.1       71874



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

/* Calls sets up appropriate ss_info structure for bootload Multics and calls
bce_listen_.  Also contains miscelaneous return to real_initializer code.
Written sometime in 1983 by Keith Loepere. */

/* Modified September of 1984 by Allen Ball to check and see if the storage 
system is enabled before querying the operator. */

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

dcl  Boot_label		        label static;	/* used for aborting command level (the method to continue initialization and therefore boot) */
dcl  Info_ptr		        ptr parameter;
dcl  NL			        char (1) static options (constant) init ("
");
dcl  addr			        builtin;
dcl  arg			        char (arg_len) based (arg_ptr);
dcl  arg_count		        fixed bin;
dcl  arg_len		        fixed bin (21);
dcl  arg_ptr		        ptr;
dcl  bce_data$console_put_chars       entry (ptr, ptr, fixed bin, fixed bin (35)) ext variable;
dcl  bce_data$console_alert_put_chars entry (ptr, ptr, fixed bin, fixed bin (35)) ext variable;
dcl  bce_data$subsys_info_ptr	        ptr external;
dcl  bce_entry		        bit (1) aligned;	/* bce as opposed to boot command */
dcl  bce_listen_		        entry (ptr, char (*));
dcl  bce_query		        entry options (variable);
dcl  bce_query$yes_no	        entry options (variable);
dcl  clock_set		        bit (1) aligned;	/* false => must call init_clocks */
dcl  code			        fixed bin (35);
dcl  com_err_		        entry () options (variable);
dcl  cu_$arg_count_rel	        entry (fixed bin, ptr, fixed bin (35));
dcl  cu_$arg_ptr_rel	        entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr);
dcl  dimension		        builtin;
dcl  error_table_$bad_arg	        fixed bin (35) ext static;
dcl  force		        bit (1) aligned;	/* user used -force */
dcl  i			        fixed bin;		/* loop var */
dcl  init_clocks		        entry (bit (1) aligned);
dcl  ioa_			        entry () options (variable);
dcl  ioa_$nnl		        entry () options (variable);
dcl  length		        builtin;
dcl  1 my_ss_info		        aligned like ss_info;
dcl  request_abort_		        condition;
dcl  request_table_ptr	        ptr parameter;
dcl  saved_max_seg_size	        fixed bin (18);	/* saved value of sys_info$max_seg_size (we change it to bce buffer size) */
dcl  string		        builtin;
dcl  sys_boot_info$at_bce_cl	        bit (1) aligned ext static;
dcl  1 sys_boot_info$bce_intk_card    aligned ext static like intk_card;
dcl  sys_boot_info$config_has_been_modified bit (1) aligned ext static;
dcl  sys_info$bce_max_seg_size        fixed bin (18) ext static;
dcl  sys_info$max_seg_size	        fixed bin (18) ext static;
dcl  1 toehold$		        aligned external like toe_hold;
dcl  unspec		        builtin;
dcl  yes_no		        bit (1);

	saved_max_seg_size = sys_info$max_seg_size;
	sys_info$max_seg_size = sys_info$bce_max_seg_size;/* lie about size of pagable segs */
	my_ss_info.request_table_ptr = request_table_ptr;
	Boot_label = BOOT;
	my_ss_info.name = "bce";
	string (my_ss_info.flags) = "0"b;
	bce_data$subsys_info_ptr = addr (my_ss_info);
	fgbxp = addr (flagbox$);
	if fgbx.mess then do;
	     if fgbx.alert then call bce_data$console_alert_put_chars (addr (bce_data$console_alert_put_chars), addr (fgbx.message), length (fgbx.message), code);
	     else call bce_data$console_put_chars (addr (bce_data$console_put_chars), addr (fgbx.message), length (fgbx.message), code);
	     call bce_data$console_put_chars (addr (bce_data$console_put_chars), addr (NL), length (NL), code);
	     fgbx.mess = "0"b;
	end;
	sys_boot_info$at_bce_cl = "1"b;
	if fgbx.breakpoint then do;
	     call ioa_ ("Entering probe.");
	     call bce_listen_ (addr (my_ss_info), "probe");
	end;
	else if fgbx.manual_crash then call bce_listen_ (addr (my_ss_info), "");
	else call bce_listen_ (addr (my_ss_info), fgbx.return_to_bce_command);
	go to BOOT;

reinitialize: entry (Info_ptr);

	clock_set = "1"b;
	force = "0"b;

	ss_info_ptr = Info_ptr;
	call cu_$arg_count_rel (arg_count, ss_info.arg_list_ptr, code);
	if code ^= 0 then do;
	     call com_err_ (code, "reinitialize");
	     signal request_abort_;
	end;

	do i = 1 to arg_count;
	     call cu_$arg_ptr_rel (i, arg_ptr, arg_len, code, ss_info.arg_list_ptr);
	     if arg = "-force" | arg = "-fc" then force = "1"b;
	     else if arg = "-time" | arg = "-tm" then clock_set = "0"b;
	     else do;
		call com_err_ (error_table_$bad_arg, "reinitialize", "^a", arg);
		return;
	     end;
	end;

	fgbxp = addr (flagbox$);
	if ^force then
	     if sys_info$collection_1_phase = CRASH_INITIALIZATION then
		if fgbx.rtb.ssenb then do;
		     call bce_query$yes_no (yes_no, "Memory contains a valid Multics image.  Do you wish to destroy it? ");
		     if ^yes_no then signal request_abort_;
		end;

	if ^clock_set then call init_clocks (clock_set);
	if ^clock_set then return;

	sys_info$collection_1_phase = EARLY_INITIALIZATION; /* makes next phase boot phase */
	toehold$.memory_state = At_bce__early;
	go to Boot_label;

boot: entry (Info_ptr);				/* The command that leaves command level */

	bce_entry = "0"b;
	go to boot_join;

bce: entry (Info_ptr);				/* continue booting bce */

	bce_entry = "1"b;

boot_join:
	ss_info_ptr = Info_ptr;

	clock_set = (sys_info$collection_1_phase ^= EARLY_INITIALIZATION);
	force = "0"b;

	intk_cardp = addr (sys_boot_info$bce_intk_card);
	unspec (intk_card) = "0"b;
	intk_card.word = INTK_CARD_WORD;
	intk_card.n_fields = 2;
	intk_card.field_type (1) = CONFIG_STRING_TYPE;
	intk_card.warm_or_cold = "warm";		/* for now */
	intk_card.field_type (2) = CONFIG_DECIMAL_TYPE;
	intk_card.boot_drive = 0;
	do i = 1 to dimension (intk_card.parms, 1);
	     unspec (intk_card.parms (i)) = EMPTY_FIELD;
	end;

	if ^bce_entry then do;
	     call cu_$arg_count_rel (arg_count, ss_info.arg_list_ptr, code);
	     if code ^= 0 then do;
		call com_err_ (code, "boot");
		signal request_abort_;
	     end;

	     do i = 1 to arg_count;
		call cu_$arg_ptr_rel (i, arg_ptr, arg_len, code, ss_info.arg_list_ptr);
		if arg = "-force" | arg = "-fc" then force = "1"b;
		else if arg = "-cold" then intk_card.warm_or_cold = "cold";
		else if arg = "-time" | arg = "-tm" then clock_set = "0"b;
		else do;
		     intk_card.n_fields = intk_card.n_fields + 1;
		     if intk_card.n_fields > 14 then do;
			call com_err_ (0, "boot", "Too many options.");
			return;
		     end;
		     intk_card.parms (intk_card.n_fields - 2) = arg;
		     intk_card.field_type (intk_card.n_fields) = CONFIG_STRING_TYPE;
		end;
	     end;

	     if ^force then do;
		if intk_card.warm_or_cold = "cold" then do;
		     call bce_query$yes_no (yes_no, "Do you really wish to boot cold and there by destroy the system hierarchy? ");
		     if ^yes_no then signal request_abort_;
		end;
		if sys_boot_info$config_has_been_modified then do;
		     call bce_query$yes_no (yes_no, "The config deck has been modified.
Do you wish to boot service without reinitializing bce? ");
		     if ^yes_no then signal request_abort_;
		end;
	     end;
	end;

	if ^clock_set then call init_clocks (clock_set);
	if ^clock_set then return;

	goto Boot_label;				/* actually performs the boot */

BOOT:
	sys_info$max_seg_size = saved_max_seg_size;
	sys_boot_info$at_bce_cl = "0"b;
	fgbxp = addr (flagbox$);
	unspec (fgbx.rtb) = "0"b;
	return;
%page; %include bce_subsystem_info_;
%page; %include collection_1_phases;
%page; %include config_deck;
%page; %include config_intk_card;
%page; %include flagbox;
%page; %include toe_hold;
     end;




		    bce_ioi_post.pl1                11/11/89  1135.9rew 11/11/89  0839.1       30663



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

/* format: style4,declareind10,dclind10,idind20,indattr,delnl,insnl,tree,ifthenstmt */

bce_ioi_post:
     proc (ioi_event_channel, ioi_message);

/****^  HISTORY COMMENTS:
  1) change(86-09-05,Farley), approve(86-07-18,MCR7439),
     audit(86-09-24,Fawcett), install(86-10-20,MR12.0-1189):
     Program to post an I/O complete for IOI at BCE.
                                                   END HISTORY COMMENTS */

	if sys_info$service_system			/* shouldn't be here */
	then call syserr (CRASH, "bce_ioi_post: System not at correct level to post I/O completion.");
	ioi_post_area_ptr = addr (bce_ioi_post_seg$);
	imp = addr (ioi_message);
	do bufx = 1 to ioi_post_area.number;
	     if ioi_post_area.buffer (bufx).ev_chn = ioi_event_channel then do;
		io_post_buffer_ptr = addr (ioi_post_area.buffer (bufx));
		if imess.level = "7"b3 then do;
		     if io_post_buffer.state ^= WAITING_SPECIAL then goto next_post_buffer;
		     io_post_buffer.message = ioi_message;
		     io_post_buffer.state = SPECIAL_ARRIVED;
		end;
		else if io_post_buffer.state ^= IO_OUTSTANDING
		     then goto next_post_buffer;
		     else do;
			io_post_buffer.message = ioi_message;
			io_post_buffer.state = IO_COMPLETE;
		     end;
		return;
	     end;
next_post_buffer:
	end;
crash:
	if imess.level = "1"b3
	then call syserr (ANNOUNCE,
		"bce_ioi_post: Unexpected System Fault.^/^14xioi_event_channel: ^24.3b^/^14xioi_message: ^24.3b",
		unspec (ioi_event_channel), unspec (ioi_message));
	else if imess.level ^= "7"b3			/* ignore unwanted specials, but crash on others.. */
	     then call syserr (CRASH,
		     "bce_ioi_post: Error posting I/O event.^/^14xioi_event_channel: ^24.3b^/^14xioi_message: ^24.3b",
		     unspec (ioi_event_channel), unspec (ioi_message));
	return;
%page;
dcl	based_bin		fixed bin based;
dcl	bufx		fixed bin;
dcl	ioi_event_channel	fixed bin (71) parameter;
dcl	ioi_message	fixed bin (71) parameter;
dcl	sys_info$service_system
			bit (1) aligned external static;
dcl	syserr		entry options (variable);
%page;
%include bce_ioi_post_area;
%page;
%include ioi_stat;
%page;
%include syserr_constants;
%page;
/* BEGIN MESSAGE DOCUMENTATION

   Message:
   bce_ioi_post: System not at correct level to post I/O completion.

   S: $crash

   T: $init

   M: The flag sys_info$service_system indicates that the system is up and
   should be posting I/O completions via pxss$io_wakeup, not this program.
   $err

   A: $notify

   Message:
   bce_ioi_post: Unexpected System Fault.
   ioi_event_channel: CCCCCCCCCCCC ioi_message: MMMMMMMMMMMM

   S: $crash

   T: $init

   M: $err

   A: $notify

   Message:
   bce_ioi_post: Error posting i/o completion.
   ioi_event_channel: CCCCCCCCCCCC ioi_message: MMMMMMMMMMMM

   S: $crash

   T: $init

   M: No posting buffer was found in an "I/O outstanding" state for the
   above event channel.
   $err

   A: $notify

   END MESSAGE DOCUMENTATION */

     end bce_ioi_post;




		    bce_list_requests_.pl1          11/11/89  1135.9r w 11/11/89  0839.1       25830



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */
/* bce_list_requests_.pl1 -- Benson Margulies for bce environment */
/* Modified the last possible day of 1983 by Keith Loepere for multics 
requests. */
/* format: style2 */

bce_list_requests_:
     procedure (Info_ptr);

	declare Info_ptr		 pointer;
	declare bce_map_over_requests_ entry (entry, ptr, ptr);
	declare ioa_		 entry () options (variable);
	declare abort_label		 label static;
	declare sub_request_abort_	 condition;

	declare (addr, null, pointer)	 builtin;

	call ioa_ ("List of requests:^/");
	abort_label = abort;
	call bce_map_over_requests_ (PRINT, null (), Info_ptr -> ss_info.request_table_ptr);
abort:	return;

PRINT:
     procedure (Request_data_ptr, Info_ptr);

	declare Request_data_ptr	 pointer;
	declare Info_ptr		 pointer;
	declare info_ptr		 pointer;
	declare info_length		 fixed bin (21);
	declare info_string		 char (info_length) based (info_ptr);
	declare NULL_STRING		 char (0) int static options (constant) init ("");
	declare nx		 fixed bin;

	declare 1 bce_flags		 aligned based (addr (rq_data.flags)),
		2 system_flags	 bit (15) unal,
		2 valid_at_early	 bit (1) unal,
		2 valid_at_boot	 bit (1) unal,
		2 valid_at_crash	 bit (1) unal;

	rq_data_ptr = Request_data_ptr;

	if rq_data.dont_list then return;

	if sys_info$collection_1_phase = BCE_CRASH_INITIALIZATION then
	     if ^ (bce_flags.valid_at_boot | bce_flags.valid_at_crash) then return;
	     else;
	else if sys_info$collection_1_phase = CRASH_INITIALIZATION then
	     if ^ bce_flags.valid_at_crash then return;
	     else;
	else if sys_info$collection_1_phase = EARLY_INITIALIZATION then
	     if ^ bce_flags.valid_at_early then return;
	     else;
	else if sys_info$collection_1_phase = BOOT_INITIALIZATION then
	     if ^ bce_flags.valid_at_boot then return;
	     else;

	request_name_list_ptr = pointer (rq_data_ptr, rq_data.namelist_loc);

	info_ptr = pointer (rq_data_ptr, rq_data.info_string.loc);
	info_length = rq_data.info_string.lth;
	if info_length = 0
	then info_ptr = addr (NULL_STRING);

	on sub_request_abort_ go to abort_label;
	call ioa_ ("^a^21t^a", request_name_list.name (1), info_string);
	do nx = 2 to request_name_list.n_names;
	     call ioa_ ("  ^a", request_name_list.name (nx));
	end;

	return;
     end PRINT;
%include bce_subsystem_info_;
%include collection_1_phases;
%include "_ssu_request_table";
%include "_ssu_request_data";
     end bce_list_requests_;




		    bce_listen_.pl1                 11/11/89  1135.9r w 11/11/89  0839.1       23841



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */
/* bce_listen_ -- listener for BCE command level and subsystems */
/* BIM '82*/
/* Modified 8/83 by K. Loepere for new bce switches */
/* Modified 9/83 by K. Loepere for initial command */
/* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */

bce_listen_:
     procedure (Info_ptr, initial_command);

declare  bce_data$get_line		  ext variable entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35));
declare  bce_execute_command_		  entry (ptr, char (*), ptr, fixed bin (35));
declare  bce_ready$nnl		  entry (char (*));
declare  com_err_			  entry options (variable);
declare  command_processor_$subsys_execute_line entry (char (*), ptr, entry, ptr, char (*), fixed bin (35));
declare  error_table_$bad_command_name    fixed bin (35) ext;
declare  wired_hardcore_data$abort_request bit (1) aligned external;

declare  code			  fixed bin (35);
declare  n_read			  fixed bin;
declare  request_line		  char (136);
declare  request_line_read		  char (n_read) based (addr (request_line));
declare  Info_ptr			  pointer;
declare  initial_command		  char (*);

declare  request_abort_		  condition;
declare  sub_request_abort_		  condition;

declare  (addr, length, null, rtrim)	  builtin;
%include bce_subsystem_info_;
%page;

	ss_info_ptr = Info_ptr;
	ss_info.abort_label = new_command;
	request_line = initial_command;
	n_read = length (rtrim (request_line));
	on request_abort_ go to new_command;
	on sub_request_abort_ go to new_command;
	do while ("1"b);
	     if request_line_read ^= "" then do;
		call command_processor_$subsys_execute_line (ss_info.name, ss_info_ptr, bce_execute_command_, null (), request_line_read, code);
		if code ^= 0 then
		     if code = error_table_$bad_command_name then call com_err_ (0, "bce", "Unrecognizable request.  Type lr for a list of requests.");
		     else if code = 100 then;
		     else call com_err_ (code, "bce_listen_: ");
	     end;
new_command:   wired_hardcore_data$abort_request = "0"b;  /* everything running has finished */
	     call bce_ready$nnl (ss_info.name);
	     call bce_data$get_line (addr (bce_data$get_line), addr (request_line), length (request_line), n_read, code);
	end;
	return;
     end;




		    bce_map_over_requests_.pl1      11/11/89  1135.9r w 11/11/89  0839.1       10809



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

/* format: style2 */

/* Routine for bce that runs (maps) a specified procedure over each entry of
   a bce ssu_-style request table.  Written in the past by Benson Margulies. */

bce_map_over_requests_:
     procedure (Procedure, Info_ptr, Request_table_ptr);

	declare Procedure		 entry (pointer, pointer) variable parameter;
	declare Info_ptr		 pointer;
	declare Request_table_ptr	 pointer;

	declare rq_idx		 fixed bin;

	declare addr		 builtin;

	rqt_ptr = Request_table_ptr;
	do rq_idx = 1 to rqt.n_requests;
	     rq_data_ptr = addr (rqt.requests (rq_idx));
	     call Procedure (rq_data_ptr, Info_ptr);
	end;
	return;

%include "_ssu_request_table";
%include "_ssu_request_data";
     end bce_map_over_requests_;




		    bce_query.pl1                   11/11/89  1135.9r w 11/11/89  0839.1       32508



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */
/* Question asking utility for bootload command environment */
/* This is like a VERY simple command_query_ */
/* BIM 10/82 */
/* Modified by Keith Loepere in 8/83 for new bce switches */

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

/* declare bce_query entry options (variable) */
/* call bce_query (answer, cs, arg1, arg2, arg3, ...) */
/* Where:             */
/*         answer   (Output) is a NONvarying string */
/*         cs       (Input) is the control string */
/*         argN     (Input) are the ioa args */

/* If only one argument is given, then this is equivalent to get_line */
/* The entry bce_query$get_line is a direct way of asking for that */

/* declare bce_query$yes_no entry options (variable) */
/* call bce_query$yes_no (yes_or_no, cs, arg1, ..., argN) */

/* declare bce_query$get_line entry (char (*)); */
/* call bce_query$get_line (response); */

bce_query:
     procedure (Answer) /* options (variable) */;

declare  arg_count_			  entry returns (fixed bin);
declare  cu_$arg_list_ptr		  entry returns (pointer);
declare  ioa_$general_rs		  entry (ptr, fixed bin, fixed bin, char (*), fixed bin (21), bit (1) aligned,
				  bit (1) aligned);
declare  bce_data$error_put_chars	  ext entry (ptr, ptr, fixed bin, fixed bin (35)) variable;
declare  bce_data$get_line		  ext entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35)) variable;

declare  Answer			  char (*);
declare  Yes_No			  bit (1);

declare  requery 			  char (25) static options (constant) init ("Please answer yes or no: ");

declare  buffer			  char (256);
declare  used			  fixed bin (21);
declare  yes_no			  bit (1);
declare  just_get			  bit (1) aligned;
declare  n_read			  fixed bin;
declare  (substr, length, addr)	  builtin;

declare  arg_list_ptr		  pointer;
%page;

	yes_no = "0"b;
	just_get = (arg_count_ () < 2);
	go to COMMON;


get_line:
     entry (Answer);

	yes_no = "0"b;
	just_get = "1"b;
	go to COMMON;

yes_no:
     entry (Yes_No);

	yes_no = "1"b;
	just_get = (arg_count_ () < 2);

COMMON:
	arg_list_ptr = cu_$arg_list_ptr ();
	if ^just_get
	then do;
	     buffer = "";
	     call ioa_$general_rs (arg_list_ptr, 2, 3, buffer, used, "0"b, "0"b);
	     call bce_data$error_put_chars (addr (bce_data$error_put_chars), addr (buffer), (used), (0));
	end;

	buffer = "";				/* wont hurt if ^yes_no */

	if yes_no
	then do while (buffer = "");
	     call bce_data$get_line (addr (bce_data$get_line), addr (buffer), length (buffer), n_read, (0));
	     buffer = substr (buffer, 1, n_read - 1 /* strip NL*/);
	     if buffer = "yes" | buffer = "y"
	     then go to RETURN_YES;
	     else if buffer = "no" | buffer = "n"
	     then go to RETURN_NO;
	     call bce_data$error_put_chars (addr (bce_data$error_put_chars), addr (requery), length (requery), (0));
	     buffer = "";
	end;

/* Here on only if ^yes_no */

	Answer = "";
	buffer = "";
	call bce_data$get_line (addr (bce_data$get_line), addr (buffer), length (buffer), n_read, (0));
	Answer = substr (buffer, 1, n_read - 1 /* strip NL */);
	return;

RETURN_YES:
	Yes_No = "1"b;
	return;
RETURN_NO:
	Yes_No = "0"b;
	return;
     end bce_query;




		    bce_request_table_.alm          11/11/89  1135.9r w 11/11/89  0837.1       96615



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

" HISTORY COMMENTS:
"  1) change(85-09-09,Farley), approve(85-09-09,MCR6979),
"     audit(86-02-27,Coppola), install(86-03-21,MR12.0-1033):
"     added lock_mca,
"      unlock_mca requests.
"  2) change(86-01-01,Farley), approve(86-07-18,MCR7439),
"     audit(86-08-18,Fawcett), install(86-10-20,MR12.0-1189):
"     Add save and restore requests.
"  3) change(86-09-23,Fawcett), approve(86-09-23,MCR7533),
"     audit(86-10-21,Farley), install(86-10-22,MR12.0-1193):
"     Add copy_disk in the correct order.
"                                                      END HISTORY COMMENTS

	name	bce_request_table_

" ssu_-style request table of bce requests.
" Written by one or more of Olin Sibert, Charlie Hornig, Benson Margulies 
" and Keith Loepere (last one to touch it).
" Aug 1984 JAFalksen - removed date_time_after, time_after, date_time_valid
"		date_time_before, time_before, date_time_equal,time_equal
"		because they are no longer in equal_b
" November of 1984, Allen Ball to add test_disk and display_disk_label.
" January 1985: Keith Loepere: config_deck_edit_ smart enough to run at crash.

	include	ssu_request_macros

	begin_table bce_request_table_

	bool	flags.valid_early,000004	"use some unused flags for us
	bool	flags.valid_boot,000002
	bool	flags.valid_crash,000001
	bool	flags.valid_all,000007
	bool	flags.valid_non_crash,000006

	request	alert,
		bce_alert$bce_alert,
		(),
		(Write an alert message on the console.),
		flags.allow_command+flags.valid_all

	request	bce,
		bce_get_to_command_level$bce,
		(),
		(Continue booting bce.),
		flags.allow_command+flags.valid_early

	request	bce_state,
		bce_state$bce_state,
		(bces),
		(Return the current state of bce.),
		flags.allow_both+flags.valid_all

	request	boot,
		bce_get_to_command_level$boot,
		(),
		(Boot Multics.),
		flags.allow_command+flags.valid_boot

	request	bos,
		bce_bos$bce_bos,
		(),
		(Return to bos, if present.),
		flags.allow_command+flags.valid_all

	request	config_edit,
		config_deck_edit_$config_deck_edit_,
		(config),
		(Enter the config deck editor.),
		flags.allow_command+flags.valid_all

	request	continue,
		bce_continue$bce_continue,
		(go),
		(Restart the interrupted Multics image.),
		flags.allow_command+flags.valid_crash

	request	copy_disk,
		bce_copy_disk$bce_copy_disk,
		(cd),
		(Copy one PV to another.),
		flags.allow_command+flags.valid_all

	request	delete,
		bootload_fs_cmds_$delete,
		(dl),
		(Delete a bootload file.),
		flags.allow_command+flags.valid_all

	request	die,
		bce_die$bce_die,
		(),
		(Abort bce.),
		flags.allow_command+flags.valid_all

	request	display_disk_label,
		bce_display_disk_label$bce_display_disk_label,
		(ddl),
		(Find disk label and display, if readable.),
		flags.allow_command+flags.valid_all

	request	dump,
		bce_dump$bce_dump,
		(),
		(Create a dump of Multics in the dump partition.),
		flags.allow_command+flags.valid_all

	request	emergency_shutdown,
		bce_esd$bce_esd,
		(esd),
		(Perform an emergency shutdown of Multics.),
		flags.allow_command+flags.valid_crash

	request	exec_com,
		bce_exec_com_$bce_exec_com_,
		(ec),
		(Execute a file of bootload Multics commands.),
		flags.allow_both+flags.valid_all

	request	fwload,
		bce_fwload$bce_fwload,
		(fw),
		(Load firmware into an mpc.),
		flags.allow_command+flags.valid_boot+flags.valid_crash

	request	get_flagbox,
		bce_get_flagbox$bce_get_flagbox,
		(gfb),
		(Get the value of a flagbox variable.),
		flags.allow_both+flags.valid_all

	request	init_files,
		bootload_fs_cmds_$init,
		(),
		(Initialize the bootload file system.),
		flags.allow_command+flags.valid_all

	request	list,
		bootload_fs_cmds_$list,
		(ls),
		(List bootload files.),
		flags.allow_command+flags.valid_all

	request	list_requests,
		bce_list_requests_$bce_list_requests_,
		(lr),
		(List bootload requests.),
		flags.allow_command+flags.valid_all

	request	lock_mca,
		bce_lock_mca$bce_lock_mca,
		(),
		(Disable MCA input through console.),
		flags.allow_command+flags.valid_boot+flags.valid_crash

	request	print,
		bootload_fs_cmds_$print,
		(pr),
		(Print a bootload file.),
		flags.allow_command+flags.valid_all

	request	probe,
		bce_probe$bce_probe,
		(pb),
		(Examine/modify the Multics image.),
		flags.allow_command+flags.valid_all

	request	qedx,
		bootload_qedx$bootload_qedx,
		(qx),
		(Edit bootload text file.),
		flags.allow_command+flags.valid_all

	request	reinitialize,
		bce_get_to_command_level$reinitialize,
		(reinit),
		(Re-perform Multics initialization.),
		flags.allow_command+flags.valid_crash+flags.valid_boot

	request	rename,
		bootload_fs_cmds_$rename,
		(rn),
		(Rename a bootload file.),
		flags.allow_command+flags.valid_all

	request	restore,
		bce_save$bce_restore,
		(),
		(Restore Physical Volumes from BCE Save Tapes.),
		flags.allow_command+flags.valid_boot

	request	save,
		bce_save$bce_save,
		(),
		(Save Physical Volumes to BCE Save Tapes.),
		flags.allow_command+flags.valid_boot

	request	set_flagbox,
		bce_set_flagbox$bce_set_flagbox,
		(sfb),
		(Set the value of a flagbox variable.),
		flags.allow_both+flags.valid_all

	request	severity,
		bce_severity$bce_severity,
		(),
		(Returns the severity or completeness of a bce request.),
		flags.allow_both+flags.valid_all

	request	shutdown_state,
		bce_shutdown_state$bce_shutdown_state,
		(sds),
		(Returns the shutdown state of the storage system.),
		flags.allow_both+flags.valid_all


	request	test_disk,
		bce_test_disk$bce_test_disk,
		(td),
		(Test disk by reading and/or writing pages.),
		flags.allow_command+flags.valid_all

	request	unlock_mca,
		bce_lock_mca$bce_unlock_mca,
		(),
		(Enable MCA input through console.),
		flags.allow_command+flags.valid_boot+flags.valid_crash

	request	query,bce_query_af$bce_query_af,(),(),flags.allow_both+flags.dont_list+flags.valid_all
	request	response,bce_response_af$bce_response_af,(),(),flags.allow_both+flags.dont_list+flags.valid_all

	multics_request	after,(af),(),substr$after,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	and,(),(),equal$and,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	before,(be),(),substr$before,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	bool,(),(),substr$bool,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	ceil,(),(),plus$ceil,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	collate,(),(),substr$collate,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	collate9,(),(),substr$collate9,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	copy_characters,(cpch),(),substr$copy_characters,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	decat,(),(),substr$decat,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	divide,(),(),plus$divide,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	equal,(),(),equal$equal,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	floor,(),(),plus$floor,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	greater,(),(),equal$greater,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	high,(),(),substr$high,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	high9,(),(),substr$high9,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	index,(),(),substr$index,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	length,(ln),(),substr$length,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	less,(),(),equal$less,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	low,(),(),substr$low,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	lower_case,(lowercase),(),substr$lower_case,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	ltrim,(),(),substr$ltrim,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	max,(),(),plus$max,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	min,(),(),plus$min,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	minus,(),(),plus$minus,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	mod,(),(),plus$mod,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	nequal,(),(),equal$nequal,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	ngreater,(),(),equal$ngreater,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	nless,(),(),equal$nless,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	not,(),(),equal$not,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	or,(),(),equal$or,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	plus,(),(),plus$plus,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	quotient,(),(),plus$quotient,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	reverse,(rv),(),substr$reverse,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	reverse_after,(rvaf),(),substr$reverse_after,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	reverse_before,(rvbe),(),substr$reverse_before,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	reverse_decat,(rvdecat),(),substr$reverse_decat,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	reverse_index,(rvindex),(),substr$reverse_index,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	reverse_search,(rvsrh),(),substr$reverse_search,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	reverse_verify,(rvverify),(),substr$reverse_verify,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	rtrim,(),(),substr$rtrim,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	search,(srh),(),substr$search,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	substr,(),(),substr$substr,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	times,(),(),plus$times,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	trunc,(),(),plus$trunc,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	upper_case,(uppercase),(),substr$upper_case,flags.allow_both+flags.dont_list+flags.valid_all
	multics_request	verify,(),(),substr$verify,flags.allow_both+flags.dont_list+flags.valid_all

	end_table	bce_request_table_
	end




		    bootload_disk_io.pl1            11/11/89  1135.9r w 11/11/89  0839.1       51381



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


/****^  HISTORY COMMENTS:
  1) change(86-01-17,Fawcett), approve(86-01-17,MCR7220),
     audit(86-06-17,Farley), install(86-07-17,MR12.0-1097):
     Keith Loepere for async operation, support of bce_copy_disk.
  2) change(86-05-20,Fawcett), approve(86-05-20,MCR7383),
     audit(86-06-17,Farley), install(86-07-17,MR12.0-1097):
     Changed to add support for MSU3380 and MUS3390
                                                   END HISTORY COMMENTS */

bootload_disk_io$read: proc (a_pvtx, a_record_num, a_n_records, a_buffer_ptr, a_code);

/* Routine to use dctl to perform a disk read/write for bce performance.
Written February 1985 by Keith Loepere.
Modified March 1985 by Keith Loepere for async operation. */

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

/* Parameters */

dcl  a_buffer_num			fixed bin parameter;/* disk_post slot, actually */
dcl  a_buffer_ptr			ptr parameter;	/* to wired memory area, must be at a page boundary */
dcl  a_code			fixed bin (35) parameter;
dcl  a_n_records			fixed bin parameter;/* must be 1-4 */
dcl  a_pvtx			fixed bin parameter;
dcl  a_record_num			fixed bin (18) parameter;

/* Variables */

dcl  async			bit (1) aligned;
dcl  buffer_address			fixed bin (26);
dcl  buffer_num			fixed bin;
dcl  code				fixed bin (35);
dcl  last_poll_time			fixed bin (71) static;
dcl  n_sectors			fixed bin;
dcl  old_mask			bit (72) aligned;
dcl  pvtx				fixed bin;
dcl  read_not_write			bit (1) aligned;
dcl  record_num			fixed bin (18);

/* Entries */

dcl  absadr			entry (ptr, fixed bin (35)) returns (fixed bin (24));
dcl  dctl$bootload_read		entry (fixed bin, fixed bin (26), bit (18) aligned, fixed bin, fixed bin);
dcl  dctl$bootload_write		entry (fixed bin, fixed bin (26), bit (18) aligned, fixed bin, fixed bin);
dcl  disk_control$disk_run		entry;
dcl  pmut$set_mask			entry (bit (72) aligned, bit (72) aligned);

/* Constants */

dcl THIRTY_SEC fixed bin (35) init (30000000) static options(constant);
		   

/* External */

dcl  error_table_$fsdisk_phydev_err	fixed bin (35) ext static;
dcl  error_table_$not_done		fixed bin (35) ext static;
dcl  scs$sys_level			bit (72) aligned ext;

/* Misc */

dcl  (addr, bit, clock)		builtin;
%page;
	read_not_write = "1"b;
	buffer_num = 1;
	async = "0"b;
	go to join;

bootload_disk_io$write: entry (a_pvtx, a_record_num, a_n_records, a_buffer_ptr, a_code);

	read_not_write = "0"b;
	buffer_num = 1;
	async = "0"b;
	go to join;

bootload_disk_io$queue_read: entry (a_pvtx, a_record_num, a_n_records, a_buffer_ptr, a_buffer_num, a_code);

	read_not_write = "1"b;
	buffer_num = a_buffer_num;
	async = "1"b;
	go to join;

bootload_disk_io$queue_write: entry (a_pvtx, a_record_num, a_n_records, a_buffer_ptr, a_buffer_num, a_code);

	read_not_write = "0"b;
	buffer_num = a_buffer_num;
	async = "1"b;

join:

/* get those args into wired storage! */

	a_code = 0;
	pvtx = a_pvtx;
	pvt_arrayp = addr (pvt$array);
	pvtep = addr (pvt_array (pvtx));
	record_num = a_record_num;
	n_sectors = sect_per_rec (pvte.device_type) * a_n_records;

	buffer_address = absadr (a_buffer_ptr, code);

	disk_post_area_ptr = addr (bootload_disk_post_seg$);

	if ^async then disk_post_area.number = buffer_num;
	disk_post_area.buffer_coreadd (buffer_num) = buffer_address;
	disk_post_area.disk_complete (buffer_num) = "0"b;
	disk_post_area.disk_error_code (buffer_num) = 0;

/* wire down for dctl call */

	call pmut$set_mask (scs$sys_level, old_mask);	/* <+><+><+><+> */

	if read_not_write then call dctl$bootload_read (pvtx, buffer_address, bit (record_num, 18), 0, n_sectors);
	else call dctl$bootload_write (pvtx, buffer_address, bit (record_num, 18), 0, n_sectors);

	call pmut$set_mask (old_mask, (""b));		/* <-><-><-><-> */

	last_poll_time = clock;			/* start running timeout from now */

	if async then do;
	     a_code = 0;
	     return;
	end;

/* wait for i/o */

	do while (^disk_post_area.disk_complete (buffer_num));
	     if clock > last_poll_time + THIRTY_SEC then do;
		call pmut$set_mask (scs$sys_level, old_mask); /* <+><+><+><+> */

		call disk_control$disk_run;		/* poll disk for lost interrupt */

		call pmut$set_mask (old_mask, (""b));	/* <-><-><-><-> */

		last_poll_time = clock;
	     end;
	end;

	code = disk_post_area.disk_error_code (buffer_num);
	if code ^= 0 then code = error_table_$fsdisk_phydev_err;
	disk_post_area.number = 0;

	a_code = code;
	return;
%page;
bootload_disk_io$test_done: entry (a_buffer_num, a_code);

	buffer_num = a_buffer_num;

/* look for done */

	disk_post_area_ptr = addr (bootload_disk_post_seg$);
	if ^disk_post_area.disk_complete (buffer_num) then
	     if clock > last_poll_time + THIRTY_SEC then do;
		call pmut$set_mask (scs$sys_level, old_mask); /* <+><+><+><+> */

		call disk_control$disk_run;		/* poll disk for lost interrupt */

		call pmut$set_mask (old_mask, (""b));	/* <-><-><-><-> */

		last_poll_time = clock;
	     end;

	if ^disk_post_area.disk_complete (buffer_num) then code = error_table_$not_done;
	else do;
	     code = disk_post_area.disk_error_code (buffer_num);
	     if code ^= 0 then code = error_table_$fsdisk_phydev_err;
	end;

	a_code = code;
	return;
%page; %include bootload_post_area;
%page; %include pvte;
%page; %include fs_dev_types_sector;
     end;




		    init_bce.pl1                    11/11/89  1135.9r w 11/11/89  0839.1       25965



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */
/* INIT_BCE.PL1 -- initialize the bootload_command_environment */
/* BIM 8/82 */
/* Modified by Keith Loepere in 83 for exec_com, file_out support */
/* Modified by Keith Loepere in March 85 to set bce cp_data_. */
/* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */

init_bce:
     procedure;

declare  1 AI			  aligned like area_info;
declare  fa1_ptr			  pointer;

declare  bce_data$console_alert_put_chars entry variable ext;
declare  bce_data$console_get_line	  entry variable ext;
declare  bce_data$console_put_chars	  entry variable ext;
declare  bce_data$error_put_chars	  entry variable ext;
declare  bce_data$exec_com_get_line	  entry variable ext;
declare  bce_data$free_area_ptr	  pointer ext;
declare  bce_data$get_line		  entry variable ext;
declare  bce_data$put_chars		  entry variable ext;
declare  dseg$			  (0:4095) fixed bin (71) ext;
declare  free_area_1$		  ext static bit (36) aligned;

declare  bce_console_io$get_line	  entry;
declare  bce_console_io$put_chars	  entry;
declare  bce_console_io$put_chars_alert	  entry;
declare  bce_exec_com_input		  entry;
declare  define_area_		  entry (ptr, fixed bin (35));
declare  sdw_util_$get_size		  entry (ptr, fixed bin (18));

declare  null			  builtin;
declare  stackbaseptr		  builtin;
%page;
wired: entry;					/* init all references to wired data */

	unspec (AI) = ""b;
	AI.version = 1;
	AI.owner = "";
	fa1_ptr = addr (free_area_1$);
	call sdw_util_$get_size (addr (dseg$ (bin (baseno (fa1_ptr)))), AI.size);
	AI.areap = fa1_ptr;
	AI.zero_on_free = "1"b;

	call define_area_ (addr (AI), (0));
	bce_data$free_area_ptr, stackbaseptr () -> stack_header.user_free_ptr, stackbaseptr () -> stack_header.system_free_ptr = fa1_ptr;

	bce_data$console_get_line, bce_data$get_line = bce_console_io$get_line;
	bce_data$console_put_chars, bce_data$put_chars = bce_console_io$put_chars;
	bce_data$console_alert_put_chars = bce_console_io$put_chars_alert;
	bce_data$error_put_chars = bce_console_io$put_chars;
	return;

paged: entry;					/* references to paged data */

	bce_data$exec_com_get_line = bce_exec_com_input;

	cp_data_$scratch_release_factor = 1;		/* temporary segments in BCE are a scarce resource */
	addr (cp_data_$permanent_scratch_segment_list) -> permanent_scratch_segment_list.n_scratch_segments = 1;
	return;
%page; %include area_info;
%page; %include cp_data_;
%page; %include stack_header;
     end init_bce;






		    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
