



		    call_ec_.pl1                    11/11/89  1102.8rew 11/11/89  0808.7      153756



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


/*   The purpose of this program is to trap, handle, and report conditions
     signalled while executing an exec_com, and resume execution with the
     next line of the exec_com without aborting it. The callers of this program
     may supply a varying number of arguments just as would be supplied to
     exec_com itself.  A pointer to an argument list is provided for the
     purpose of calling the exec_com_ subroutine which will subsequently
     initiate the processing of the exec_com input lines.  If an error is
     encountered while this interface is being called by a daemon process
     all messages will be placed in the system logs via signal_io_ and
     printed on the message coordinator terminal.  If an error is encountered
     while running in an interactive user process the messages will be
     printed on the user terminal via ioa_.  A temporary command_processor
     and active_functon_processor are established here to determine whether
     the condition error is resulting from a command or active function. The
     process' command_processor and active_function_processor will be restored
     to its original before exiting this program.  An asdump will be created
     in the process' working directory for error conditions other than
     command_error and/or active_function_error.
*/
     

     

/****^  HISTORY COMMENTS:
  1) change(87-03-05,Parisek), approve(87-07-23,MCR7716),
     audit(87-07-30,Fawcett), install(87-08-11,MR12.1-1079):
     Program to handle condition errors encountered while executing an
     exec_com. Display error data and continue execution after conditions
     are encountered.
  2) change(87-08-12,Parisek), approve(87-08-12,PBF7716),
     audit(87-08-12,Fawcett), install(87-08-13,MR12.1-1085):
     Changed call to trace_stack to call as_dump_ and only make this call for
     unusual error conditions.
  3) change(87-08-18,Parisek), approve(87-08-18,PBF7716),
     audit(87-09-03,Farley), install(87-09-10,MR12.1-1104):
     Define constant values and check pointer validity before referencing them.
  4) change(87-09-18,Parisek), approve(87-09-18,PBF7716),
     audit(87-09-18,Farley), install(87-09-21,MR12.1-1111):
     Implement a counter that increments each time an error is reported and if
     this counter reaches five, then return thus aborting the exec_com.
                                                   END HISTORY COMMENTS */

call_ec_:
	proc options (variable);

    dcl   argp                          ptr,
          argl                          fixed bin(21),
          arg                           char(argl) based(argp),
          arg_count                     fixed bin,
	arg_list_ptr                  ptr;

    dcl	RETURN_FALSE_AF_VALUE	label variable,
	code			fixed bin(35),
	error_counter                 fixed bin,	/* Count number of reported errors */
	ec_arg                        char(168),
	ec_dir                        char(168),
	ec_entry                      char(32),
	ec_path                       char(168),
	iop                           ptr,
	last_active_string_len	fixed bin(21),
	last_active_string_ptr	ptr,
	last_command_line_len	fixed bin(21),
	last_command_line_ptr	ptr,
	lg_status                     char(100) aligned,
	old_cp			entry (ptr, fixed bin(21), fixed bin(35)) variable,
	old_eval			entry (ptr, char(*), fixed bin, char(*) var, fixed bin(35)) variable,
         (seg_name, seg_name2, seg_name3)
				char(500) aligned,
	seg_ptr			ptr,
	st_status                     char(8) aligned;

    dcl	last_active_string		char(last_active_string_len)
				based(last_active_string_ptr),
	last_command_line		char(last_command_line_len)
				based(last_command_line_ptr);

    dcl  1 ec_info                      aligned like exec_com_info;

    dcl  (addr, length, null, rtrim, substr)
				builtin;

    dcl  (any_other, cleanup, command_abort_, linkage_error, signal_io_)
				condition;

    dcl	com_err_                      entry options (variable),
          condition_interpreter_	entry (ptr, ptr, fixed bin, fixed bin, ptr, char(*), ptr, ptr),
	continue_to_signal_		entry (fixed bin(35)),
	convert_status_code_          entry (fixed bin(35), char(8) aligned, char(100) aligned),
	cu_$arg_count                 entry (fixed bin, fixed bin(35)),
	cu_$arg_ptr_rel               entry (fixed bin, ptr, fixed bin(21), fixed bin(35), ptr),
	cu_$arg_list_ptr              entry (ptr),
	cu_$get_command_processor	entry (entry),
	cu_$get_evaluate_active_string
				entry (entry),
	cu_$make_entry_value          entry (ptr, entry),
	cu_$set_command_processor	entry (entry),
	cu_$set_evaluate_active_string
				entry (entry),
	exec_com_			entry (char(*), char(*), char(*), ptr, fixed bin(35)),
	expand_pathname_              entry (char(*), char(*), char(*), fixed bin(35)),
	find_condition_frame_	entry (ptr) returns(ptr),
	find_condition_info_	entry (ptr, ptr, fixed bin(35)),
	get_ppr_			entry (fixed bin, ptr, ptr, char(500) aligned, char(500) aligned,
				     char(500) aligned),
	ioa_$ioa_switch               entry() options(variable),
	ioa_$rsnnl		entry() options(variable),
	pathname_			entry (char(*), char(*)) returns(char(168)),
	sc_signal_io_handler_         entry (),
	as_dump_                      entry (char (*));
	
	
    dcl   FALSE			init("0"b) bit(1) int static options(constant),
       	NL			char(1) int static options(constant) init("
");

/* External */

    dcl   iox_$user_io                  ptr ext static;

/* Constants */

    dcl   ACTIVE_FUNCT_ERROR_TYPE       fixed bin int static options (constant) init (2),
	ALL_OTHERS_TYPE               fixed bin int static options (constant) init (3),
	COMMAND_ERROR_TYPE            fixed bin int static options (constant) init (1),
	FIRST_EC_ARG                  fixed bin int static options (constant) init (2),
	MAX_ERROR_CNT                 fixed bin int static options (constant) init (5),
	MAX_ERROR_INFO                fixed bin int static options (constant) init (2);
%page;

	if iox_$user_io = null then do;
	     call com_err_ (0, "call_ec_", "iox_$user_io is null");
						/* Have caller handle this with an asdump */
	     return;
	end;
	else iop = iox_$user_io;

	call cu_$get_command_processor (old_cp);
	call cu_$get_evaluate_active_string (old_eval);
	on cleanup call janitor();

	call cu_$arg_count (arg_count, code);		/* If we get any bad codes we'll signal command_error and get an asdump */
	if code ^= 0 then do;
	     call com_err_ (code, "call_ec_", "From cu_$arg_count.");
	     return;
	end;
	call cu_$arg_list_ptr (arg_list_ptr);

	ec_path, ec_arg = "";
	call cu_$arg_ptr_rel (1, argp, argl, code, arg_list_ptr);
	if code ^= 0 then do;
	     call com_err_ (code, "call_ec_", "From cu_$arg_ptr_rel.");
	     return;
	end;
	ec_path = (arg);
	call expand_pathname_ (ec_path, ec_dir, ec_entry, code);
	if code ^= 0 then do;
	     call com_err_ (code, "call_ec_", "From expand_pathname_.");
	     return;
	end;
	ec_path = pathname_ (ec_dir, rtrim(ec_entry) || ".ec");

	last_command_line_ptr, last_active_string_ptr = null;

	on signal_io_ call sc_signal_io_handler_ ();

	error_counter = 0;				/* Init */
	on any_other begin;
	     error_counter = error_counter + 1;
	     call handle_ec_conditions ();
	     if error_counter = MAX_ERROR_CNT then do;
		call ioa_$ioa_switch (iop, "Aborting the exec_com due to too many error conditions.");
		goto EXIT;
	     end;
	end;
	


	call cu_$set_command_processor (call_cp);
	call cu_$set_evaluate_active_string (call_eval);
	ec_info.version = exec_com_info_version_1;
	ec_info.arg_list_ptr = arg_list_ptr;
	ec_info.first_arg = FIRST_EC_ARG;
	ec_info.execute_line = call_cp;
	ec_info.eval_string = call_eval;
	call cu_$make_entry_value (null (), ec_info.ready);
	call cu_$make_entry_value (null (), ec_info.set_ready_mode);
	call cu_$make_entry_value (null (), ec_info.error);

	call exec_com_ (rtrim(ec_path), "", "call_ec_", addr (ec_info), code);
	if code ^= 0 then
	     call com_err_ (code, "call_ec_", "From exec_com_.");

EXIT:	call janitor();
	return;

%page;
handle_ec_conditions:
          proc ();

    dcl	type			fixed bin(2);

	 call find_condition_info_ (null, addr(ci), code);
	 if code = 0 then do;
	      if ci.condition_name = "command_abort_" then do;
		 call begin_error_message(type, "");
		 call ioa_$ioa_switch (iop, "
Error: command_abort_ signalled by call_ec_ not handled by command_processor_.
******************************");
	      end;
	      else				/* Pass thru standard conditions which should be	*/
		 if ci.condition_name = "alrm"	/* handled by the default error handler.	*/
		 | ci.condition_name = "command_question"
		 | ci.condition_name = "cput"
		 | ci.condition_name = "dm_shutdown_scheduled_"
		 | ci.condition_name = "dm_shutdown_warning_"
		 | ci.condition_name = "dm_user_shutdown_"
		 | ci.condition_name = "end_file"
		 | ci.condition_name = "end_page"
		 | ci.condition_name = "finish"
		 | ci.condition_name = "mme2"
		 | ci.condition_name = "storage"
		 | ci.condition_name = "quit"
		 | ci.condition_name = "sus_"
		 | ci.condition_name = "system_shutdown_scheduled_"
		 | ci.condition_name = "trm_" then
		 call continue_to_signal_ (code);
	      else
		 if condition_default_restart() then do;
						/* Don't signal command_abort_ for errors which	*/
						/* are default_restartable.			*/
		      if ci.condition_name = "command_error" then do;
			 call begin_error_message(type, ci.condition_name);
			 if ci.info_ptr ^= null then
			      if ci.info_ptr->com_af_error_info.errmess_ptr ^= null then do;
				 call ioa_$ioa_switch (iop, "^/^a",
				      com_err_message);
				 ci.info_ptr -> com_af_error_info.print_sw = FALSE;
			      end;
		      end;
		      else do;
			 call begin_error_message(type, ci.condition_name);
			 if ci.info_ptr ^= null then
			      call condition_interpreter_(null, null, 0, 3,
				 ci.mc_ptr, (ci.condition_name),
				 ci.wc_ptr, ci.info_ptr);
		      end;
		      call end_error_message (type, "continues");
		 end;
		 else do;				/* Diagnose all other, unexpected conditions.	*/
		      if ci.condition_name = "active_function_error" then do;
			 call begin_error_message(type, ci.condition_name);
			 if ci.info_ptr ^= null then
			      call ioa_$ioa_switch (iop, "^a",
			      com_err_message);
			 if type = ACTIVE_FUNCT_ERROR_TYPE then do;
			      call end_error_message (type,
				 "continues by returning ""false"" as the
active function value");
			      go to RETURN_FALSE_AF_VALUE;
			 end;
			 else do;
			      if ci.info_ptr ^= null then 
				 ci.info_ptr -> com_af_error_info.print_sw = FALSE;
			      call end_error_message (type, "continues");
			 end;
		      end;
		      else do;
			 call as_dump_ (rtrim(ci.condition_name) || " condition encountered.");
			 call begin_error_message(type, ci.condition_name);
			 if condition_quiet_restart()	
						/* Specially handle conditions that 		*/
			      then do;		/* condition_interpreter_ is silent for.	*/
			      if ci.loc_ptr ^= null then do;
				 seg_ptr = ci.user_loc_ptr;
				 on linkage_error begin;
						/* get_ppr_ may call routines unavailable	*/
				      call format_name (seg_ptr, seg_name);
				      seg_name2, seg_name3 = "";
						/* at the time.  If an error occurs, use 	*/
				      go to QUIET_REVERT;
						/* format_name as a backup name-getter.		*/
				 end;
				 call get_ppr_ (MAX_ERROR_INFO, find_condition_frame_(null),
				      addr(ci), seg_name, seg_name2, seg_name3);
QUIET_REVERT:			 revert linkage_error;
				 call ioa_$ioa_switch (iop,  
				      "^/Error: ^a at ^a ^a ^a",
				      ci.condition_name, seg_name, seg_name2,
				      seg_name3);
			      end;
			      else do;
				 call ioa_$ioa_switch (iop,
				      "Error: ^a at UNKNOWN LOCATION.",
				      ci.condition_name);
			      end;
			       
			      if ci.condition_name = "stringsize" then
				 call end_error_message (type,
				 "continues with truncation of the string");
			      else
				 call end_error_message (type, "continues");
			 end;
			 else do;
			      call condition_interpreter_(null, null, 0, 3,
				 ci.mc_ptr, (ci.condition_name),
				 ci.wc_ptr, ci.info_ptr);
			      call end_error_message (type,
				 "continues with the next line of the exec_com");
			      if last_command_line_ptr ^= null then
				 signal command_abort_;
						/* Then abort the current command line of the ec. */
			 end;
		      end;
		 end;
	      end;
        end handle_ec_conditions;

%page;
begin_error_message:
	proc (case, condition_name);
	
    dcl	case			fixed bin(2),
	condition_name		char(*) varying;

	if last_command_line_ptr ^= null then do;
	   case = COMMAND_ERROR_TYPE;
	   call ioa_$ioa_switch (iop, "
******************************
While executing the command line:
   ^a^[^;
^]in ^a.ec, an unexpected ^[^a condition^;error^s^] occurred:",
	   last_command_line,
	   substr(last_command_line,length(last_command_line),length(NL))=NL,
	   ec_entry, condition_name^="", condition_name);
	   end;
	else
	if last_active_string_ptr ^= null then do;
	   case = ACTIVE_FUNCT_ERROR_TYPE;
	   call ioa_$ioa_switch (iop, "
******************************
While evaluating the active string:
   ^a^[^;
^]in ^a.ec, an unexpected ^[^a condition^;error^s^] occurred:",
	      last_active_string,
	      substr(last_active_string,length(last_active_string),
	          length(NL))=NL, ec_entry, condition_name^="",
	      condition_name);
	   end;
	else do;
	   case = ALL_OTHERS_TYPE;
	   call ioa_$ioa_switch (iop, "
******************************
An unexpected ^[^a condition^;error^s^] occurred in ^a.ec:",
	      condition_name^="", condition_name, ec_entry);
	   end;
	if ci.condition_name = "io_error" then do;
	     call convert_status_code_ (ci.info_ptr -> io_error_info.status.code, st_status, lg_status);
	     call ioa_$ioa_switch (iop, "Status returned by ""io_error"" condition is: ^a", rtrim(lg_status));
	end;
	return;

end_error_message:
	entry (case, further_action);
	
    dcl	further_action		char(*);
	
	call ioa_$ioa_switch (iop, "
^[Execution of the command^;Evaluation of the active string^;Execution^] ^a.
******************************^/", case, further_action);

	end begin_error_message;

%page;
call_cp:	proc (Aline_ptr, Aline_len, Acode);

    dcl	Aline_ptr			ptr,
	Aline_len			fixed bin(21),
	Acode			fixed bin(35);

	last_command_line_ptr = Aline_ptr;
	last_command_line_len = Aline_len;
	call old_cp (Aline_ptr, Aline_len, Acode);
	last_command_line_ptr = null;
	end call_cp;

%page;
call_eval:
       	proc (Ainfo_ptr, Aactive_string, Astring_type, Areturn_value, Acode);

    dcl	Ainfo_ptr			ptr,
	Aactive_string		char(*),
	Astring_type		fixed bin,
	Areturn_value		char(*) varying,
	Acode			fixed bin(35);

	last_active_string_ptr = addr(Aactive_string);
	last_active_string_len = length(Aactive_string);
	RETURN_FALSE_AF_VALUE = RETURN_FALSE;
	call old_eval (Ainfo_ptr, Aactive_string, Astring_type,
	   Areturn_value, Acode);
	last_active_string_ptr = null;
	return;
RETURN_FALSE:
	Areturn_value = "false";
	Acode = 0;
	last_active_string_ptr = null;
	end call_eval;

%page;
condition_default_restart:
	proc () returns(bit(1));
	if ci.info_ptr ^= null then
	   return (ci.info_ptr -> condition_info_header.default_restart);
	else
	   return (FALSE);

condition_quiet_restart:
	entry () returns(bit(1));
	if ci.info_ptr ^= null then
	   return (ci.info_ptr -> condition_info_header.quiet_restart);
	else
	   return (FALSE);
	end condition_default_restart;
       
%page;
format_name:
     proc (p, name);

	dcl     p			 ptr;
	dcl     code		 fixed bin (35);
	dcl     find_pathname_	 entry (ptr, ptr, fixed bin (35));
	dcl     name		 char (500) aligned;
	dcl     1 name_info		 aligned like find_pathname_info automatic;


	call find_pathname_ (p, addr (name_info), code);

	if name_info.component_ename ^= ""
	then /* use name from bindmap */
	     call ioa_$rsnnl ("^a^a (^a^a^a^a^a)^a", name, 0, name_info.component_ename, name_info.adjusted_offset,
		name_info.dirname, name_info.gt_char, name_info.real_ename, name_info.real_offset,
		name_info.pdir_string, name_info.offset_msg);
	else call ioa_$rsnnl ("^a^a^a^a^a^a", name, 0, name_info.dirname, name_info.gt_char, name_info.real_ename,
		name_info.real_offset, name_info.pdir_string, name_info.offset_msg);

	return;
     end format_name;

%page;
janitor:	proc;
	call cu_$set_command_processor (old_cp);
	call cu_$set_evaluate_active_string (old_eval);
	end janitor;
%page;
%include com_af_error_info;

    dcl	com_err_message		char(ci.info_ptr->com_af_error_info.errmess_lth)
				based(ci.info_ptr->com_af_error_info.errmess_ptr);
%page;
%include condition_info;

    dcl	1 ci			aligned like condition_info;

%page;
%include condition_info_header;
%page;
%include exec_com_info;
%page;
%include find_pathname_info;
%page;
%include io_error_info;
%page;
%include iox_modes;
%page;

	end call_ec_;




		    lock_mca.pl1                    11/11/89  1102.8r   11/11/89  0808.7       46386



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

/****^  HISTORY COMMENTS:
  1) change(86-01-09,Fawcett), approve(86-03-26,MCR7359),
     audit(86-09-05,Lippard), install(86-09-16,MR12.0-1159):
     Allow the MCA operator interface to be  either disabled (locked) or
     enabled (unlocked). Main part of code taken from bce_lock_mca.pl1
                                                   END HISTORY COMMENTS */


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

lock_mca: proc;

dcl  Me				char (10);
dcl  P99				pic "99" based;
dcl  V1				char (4) static options (constant) init ("1.00");
dcl  MCA_LOW_NUM			fixed bin (17) static options (constant) init (0);
dcl  MCA_HIGH_NUM			fixed bin (17) static options (constant) init (31);
dcl  a_sci_ptr			ptr parameter;
dcl  arg_count			fixed bin;
dcl  arg				char (arg_len) based (arg_ptr);
dcl  arg_len			fixed bin (21);
dcl  arg_ptr			ptr;
dcl  args_expected			fixed bin;
dcl  code				fixed bin (35);
dcl  entry_var			entry variable;
dcl  lock_mca			bit (1);
dcl  mca_number			fixed bin (35);
dcl  mca_to_unlock			char (4);
dcl  sci_ptr			ptr;
dcl  standalone_invocation		bit (1);

dcl  com_err_			entry () options (variable);
dcl  cv_dec_check_			entry (char (*), fixed bin (35)) returns (fixed bin (35));
dcl  hphcs_$ocdcm_reconfigure		entry (char (4), fixed bin, fixed bin (35));
dcl  ssu_$abort_line		entry () options (variable);
dcl  ssu_$print_message		entry () options (variable);
dcl  ssu_$arg_count			entry (ptr, fixed bin);
dcl  ssu_$arg_ptr			entry (ptr, fixed bin, ptr, fixed bin (21));
dcl  ssu_$destroy_invocation		entry (ptr);
dcl  ssu_$standalone_invocation	entry (ptr, char (*), char (*), ptr, entry, fixed bin (35));


dcl  (convert, null)		builtin;
dcl  error_table_$wrong_no_of_args	fixed bin (35) ext static;
dcl  error_table_$not_privileged	fixed bin (35) ext static;


dcl  MAX_MCA			fixed bin (17) init (31) internal static options (constant);
dcl  MIN_MCA			fixed bin (17) init (0) internal static options (constant);


dcl  cleanup			condition;
dcl  linkage_error			condition;
%page;
	Me = "lock_mca";
	lock_mca = "1"b;
	standalone_invocation = "0"b;
	args_expected = 0;
	sci_ptr = null;
	goto common_standalone;

lock_mca$sc_lock_mca:
     entry (a_sci_ptr);

	Me = "lock_mca";
	standalone_invocation = "0"b;
	lock_mca = "1"b;
	args_expected = 0;
	sci_ptr = a_sci_ptr;
	goto join;

lock_mca$unlock_mca:
     entry;

	Me = "unlock_mca";
	standalone_invocation = "0"b;
	lock_mca = "0"b;
	sci_ptr = null;
	args_expected = 1;

common_standalone:

	on cleanup begin;
	     if sci_ptr ^= null then call ssu_$destroy_invocation (sci_ptr);
	end;
	call ssu_$standalone_invocation (sci_ptr, Me, V1, null (), abort_entry, code);
	if code ^= 0 then do;
	     call com_err_ (code, Me, "Could not create ssu_ invocation.");
	     goto DONE;
	end;
	standalone_invocation = "1"b;
	on linkage_error
	     call ssu_$abort_line (sci_ptr, error_table_$not_privileged, "^/Access to hphcs_ gate is required.");

	entry_var = hphcs_$ocdcm_reconfigure;
	revert linkage_error;

	goto join;

lock_mca$sc_unlock_mca:
     entry (a_sci_ptr);

	Me = "unlock_mca";
	standalone_invocation = "0"b;
	lock_mca = "0"b;
	args_expected = 1;
	sci_ptr = a_sci_ptr;
join:

	call ssu_$arg_count (sci_ptr, arg_count);
	if arg_count ^= args_expected then do;
	     if lock_mca then call ssu_$abort_line (sci_ptr, error_table_$wrong_no_of_args, "This command takes NO arguments.^/Usage: lock_mca");
	     else call ssu_$abort_line (sci_ptr, error_table_$wrong_no_of_args, "This command requires one argument.^/Usage: unlock_mca MCA_NUMBER");
	end;

	if lock_mca then do;
	     call hphcs_$ocdcm_reconfigure ("", LOCK_MCA_INPUT, code);
	     call ssu_$print_message (sci_ptr, code, "MCA interface^[ NOT^] locked.", (code ^= 0));
	     goto DONE;
	end;
	call ssu_$arg_ptr (sci_ptr, 1, arg_ptr, arg_len);
	mca_number = cv_dec_check_ (arg, code);
	if code ^= 0 | mca_number < MCA_LOW_NUM | mca_number > MCA_HIGH_NUM then
	     call ssu_$abort_line (sci_ptr, 0, "Illegal MCA number. ^[^a is not a decimal number.^] Range is ^d - ^d.", (code ^= 0), arg, MIN_MCA, MAX_MCA);

	mca_to_unlock = "M_" || convert (P99, mca_number);
	call hphcs_$ocdcm_reconfigure (mca_to_unlock, UNLOCK_MCA_INPUT, code);
	if code = 0 then
	     call ssu_$print_message (sci_ptr, code, "MCA(^a) interface unlocked.",
		convert (P99, mca_number));
	else call ssu_$abort_line (sci_ptr, code, "MCA(^a) interface NOT unlocked.",
		convert (P99, mca_number));

DONE:
	if standalone_invocation then
	     call ssu_$destroy_invocation (sci_ptr);
	return;


abort_entry:
     proc;

	goto DONE;

     end abort_entry;
%page; %include sc_subsystem_info_;
%page; %include opc_reconfig_options;
     end lock_mca;




		    sc_abort_line_util_.pl1         11/11/89  1102.8rew 11/11/89  0808.7       61191



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

/* *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
/*							       */
/* sc_abort_line_util_.pl1 --					       */
/*    Procedure to implement (hopefully) temporary sc feature of mapping     */
/* abort_line into "abort_request".  The reasons for this mapping are not    */
/* fully understood.					       */
/*							       */
/*    This procedure also contains the ssu_-replacable procedure for	       */
/* ssu_$invoke_request.  This replacement procedure sets up the label for    */
/* the abort_request function, and also performs masking of IPC event calls  */
/* on a per-request basis.  This masking must properly be done on a	       */
/* per-request basis.  Masking is done based upon the value of	       */
/* sc_request_flags.dont_mask_calls which is defined for each request in the */
/* sc_request_table_.					       */
/*							       */
/*    The sequence in which procedures are called in order to invoke a       */
/* request is as follows:					       */
/*							       */
/*    ssu_$listen						       */
/*     |__sc_execute_command_line_				       */
/*         |__check for special commands; if special		       */
/*	     |__INVOKE_SPECIAL_PROCEDURE			       */
/*	    if not special					       */
/*	     |__SSU's execute_command_line			       */
/*	         |__sc_abort_line_util_$invoke_request		       */
/*	            |__SSU's locate_request			       */
/*		  |__if event calls should be masked for this request    */
/*		  |   |__ipc_$mask_ev_calls			       */
/*		  |					       */
/*		  |__SSU's invoke_request			       */
/*		  |   |__sc_execute_command_line_$locate_request	       */
/*		  |   |   |__SSU's locate request		       */
/*		  |   |	|__check_restrictions		       */
/*		  |   |					       */
/*		  |   |__REQUEST PROCEDURE			       */
/*		  |					       */
/*		  |__if event calls were masked		       */
/*		      |__ipc_$unmask_ev_calls			       */
/*							       */
/* *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */

/* format: style2 */

sc_abort_line_util_:
     procedure;

/**** Modification history:
      Created 1985-02-01, BIM */
/**** Modified 1985-02-18, E. Swenson: to allow a "real" abort_line. */

/****^  HISTORY COMMENTS:
  1) change(87-02-22,GDixon), approve(87-05-25,MCR7680),
     audit(87-05-06,Parisek), install(87-08-05,MR12.1-1055):
     Moved per-request masking of IPC event calls from sc_execute_command_line_
     into our $invoke_request procedure.
  2) change(87-07-02,GDixon), approve(87-07-02,MCR7680),
     audit(87-05-06,Parisek), install(87-08-05,MR12.1-1055):
      A) Changed to determine whether to mask event calls, based upon
         per-request setting in sc_request_table_.
      B) Changed to unmask event calls based upon prior successful masking,
         rather than just a prior attempt to mask.
                                                   END HISTORY COMMENTS */

	declare P_sci_ptr		 pointer parameter;
	declare P_request_name	 char(*) parameter;
	declare P_arg_list_ptr	 ptr parameter;
	declare P_code		 fixed bin(35) parameter;

	declare cu_$arg_list_ptr	 entry returns (pointer);
	declare cu_$generate_call	 entry (entry, ptr);
	declare ipc_$mask_ev_calls	 entry (fixed bin (35));
	declare ipc_$unmask_ev_calls	 entry (fixed bin (35));
	declare ssu_$get_info_ptr	 entry (ptr) returns (ptr);
	declare ssu_$print_message	 entry () options (variable);

	declare 1 auto_request_data	 aligned like request_data automatic;
          declare code		 fixed bin(35);
	declare dont_mask		 bit(1);
	declare (masked_ev_calls_code, unmasked_ev_calls_code)
				 fixed bin (35);
	declare saved_abort_label	 label;
	declare sci_ptr		 pointer;

	declare addr		 builtin;
	declare cleanup		 condition;

	declare FALSE		init("0"b) bit(1) int static options(constant);

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */


abort_line:
     entry (P_sci_ptr);				/* and many other args. */

	call cu_$generate_call (ssu_$print_message, cu_$arg_list_ptr ());
						/* print the message */
	sci_ptr = P_sci_ptr;
	sc_subsystem_info_ptr = ssu_$get_info_ptr (sci_ptr);
	go to sc_subsystem_info.abort_request_label;	/* Nonlocal unwind */

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */


invoke_request:
     entry (P_sci_ptr, P_request_name, P_arg_list_ptr, P_code);

	sci_ptr = P_sci_ptr;
	sc_subsystem_info_ptr = ssu_$get_info_ptr (sci_ptr);
	saved_abort_label = sc_subsystem_info.abort_request_label;
	masked_ev_calls_code, unmasked_ev_calls_code = -1;
	on cleanup
	     begin;
		sc_subsystem_info.abort_request_label = saved_abort_label;
		if masked_ev_calls_code = 0 & unmasked_ev_calls_code ^= 0
		then call ipc_$unmask_ev_calls (unmasked_ev_calls_code);
	     end;
	sc_subsystem_info.abort_request_label = ABORT_REQUEST;

	dont_mask = FALSE;
	request_data_ptr = addr(auto_request_data);
	sc_rf_ptr = addr (request_data.user_flags);
	call sc_subsystem_info.real_locate_request (sci_ptr, P_request_name,
	   addr(request_data), code);
	if code = 0 then				/* nonzero code reported later by ssu_ */
	   dont_mask = sc_request_flags.dont_mask_calls;

	if ^dont_mask
	then call ipc_$mask_ev_calls (masked_ev_calls_code);

	call cu_$generate_call (sc_subsystem_info.real_invoke_request, cu_$arg_list_ptr ());

ABORT_REQUEST:
	sc_subsystem_info.abort_request_label = saved_abort_label;
	if masked_ev_calls_code = 0 & unmasked_ev_calls_code ^= 0
	then call ipc_$unmask_ev_calls (unmasked_ev_calls_code);
	return;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */


real_abort_line:
     entry (P_sci_ptr);				/* and some other arguments */

/**** This entry is used to get the normal MR11 ssu_$abort_line functionality.
      It is used by sc_requests_$sign_on in order to abort the entire command
      line rather than just aborting the current request. */

	sci_ptr = P_sci_ptr;
	sc_subsystem_info_ptr = ssu_$get_info_ptr (sci_ptr);
	call cu_$generate_call (sc_subsystem_info.real_abort_line, cu_$arg_list_ptr ());
	return;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */


 %include sc_subsystem_info_;
 %include "_ssu_request_data";
     end sc_abort_line_util_;






		    sc_admin_command_.pl1           03/03/92  1551.3r w 03/03/92  1548.6      222381



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

/****^  HISTORY COMMENTS:
  1) change(86-05-13,GJohnson), approve(86-05-13,MCR7387),
     audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056):
     Correct error message documentation.
  2) change(87-04-05,GDixon), approve(87-05-28,MCR7707),
     audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055):
     Allow force_reset and reset requests via sac sc_command. (phx20281)
  3) change(91-03-11,Vu), approve(91-03-11,MCR8241), audit(91-12-06,Zimmerman),
     install(92-03-03,MR12.5-1010):
     The sc_admin_command_ misidenfies itself as sc_admin_comamnd.
                                                   END HISTORY COMMENTS */


/* format: style2,idind30 */

sc_admin_command_:
     procedure (ASR_info_ptr, ASR_sender_ptr);

/**** This program handles requests from administrators for
      commands to be executed in the initializer process. */


/* Modified May 1982, E. N. Kittlitz. Cleanup */
/* Modified June 1982, E. N. Kittlitz. Fix command trailing NL handling */
/* Modified 1984-10-04 BIM to convert to as_request_ from old mechanism */
/* Modified 1984-11-03 BIM for new system control (ssu_) */
/* Modified 1984-12-20 BIM to unmask IPC in here. */
/* Modified 1985-01-07 BIM for access_control_name in sc_subsystem_info. */
/* Modified 1985-03-13 E. Swenson to make use Initializer.SysDaemon.* for 
   for access control checking during sac commands */
/* Modified 1985-03-25 EJ Sharpe, use flush_pending_output control rather
   than forcing it with null message after admin command completion. */
/* Modified 1985-04-23 E. Swenson to fix signal_io_ handler to not catch
   signals not caused by the sc_admin_command_ command line. */
/* Modified 1985-05-13 E. Swenson to fix the above fix.  Credits go to Mr.
   Sibert. */

/**** This procedure depends on sc_process_command_line_ to 
      reattach switches and do all that other complex stuff.
      However, this procedure has its own signal_io_ handler
      to over-ride the normal one. This handler traps input
      and logs output.

      Furthermore, this procedure has other condition handlers
      to handle other problems.

      NOTE
      Some provisions are made for a "dialog" mode.
      dialog mode is intended to be a two-way channel utilizing
      message segments. 

      dialog mode is intended to enter admin mode, NOT allow a 
      user process to dial up and become a message coordinator source.
*/

	declare (ASR_info_ptr, ASR_sender_ptr)
				        pointer parameter;

	dcl     acs_mode		        bit (36) aligned;
	dcl     code		        fixed bin (35);
	dcl     capture_output_ptr	        pointer;
	dcl     capture_output_length	        fixed bin (21);
	dcl     capture_overran	        bit (1) aligned;
	dcl     completion_string	        char (200);
	dcl     prev_iocb_name	        char (32);
	dcl     finish_signalled	        bit (1) aligned;
	dcl     evidence_of_error	        bit (1) aligned;
	dcl     ignore_io		        bit (1) aligned;
	dcl     sci_ptr		        pointer;
	dcl     message_string	        char (1000);
	dcl     test_switches	        bit (1) aligned;
	dcl     error_string	        char (100) aligned;
	dcl     unmask_count	        fixed bin;

	dcl     as_send_user_mail_	        entry (character (*), character (*), character (*), character (*),
				        character (*), bit (72) aligned, character (*));
	dcl     as_send_user_message_	        entry (character (*), character (*), character (*), character (*),
				        bit (72) aligned, character (*), bit (1) aligned);
	dcl     com_err_		        entry () options (variable);
	dcl     continue_to_signal_	        entry (fixed bin (35));
	dcl     convert_status_code_	        entry (fixed binary (35), character (8) aligned, character (100) aligned);
	dcl     cu_$get_cl_intermediary       entry (entry);
	dcl     cu_$set_cl_intermediary       entry (entry);
	dcl     cu_$reset_cl_intermediary     entry;
	dcl     default_error_handler_$wall   entry;
	dcl     find_condition_info_	        entry (pointer, pointer, fixed binary (35));
	dcl     get_group_id_	        entry () returns (char (32));
	dcl     get_temp_segment_	        entry (character (*), pointer, fixed binary (35));
	dcl     hcs_$wakeup		        entry (bit (36) aligned, fixed bin (71), bit (72) aligned, fixed bin (35))
				        ;
	dcl     ioa_		        entry () options (variable);
	dcl     ioa_$ioa_switch_nnl	        entry () options (variable);
	dcl     ioa_$ioa_switch	        entry () options (variable);
	dcl     ioa_$rsnnl		        entry () options (variable);
	dcl     ioa_$rsnp		        entry () options (variable);
	dcl     release_temp_segment_	        entry (character (*), pointer, fixed binary (35));
	dcl     sc_create_sci_	        entry (pointer, fixed binary (35));
	dcl     sc_create_sci_$destroy        entry (pointer);
	dcl     sc_process_command_line_$multics_command
				        entry (ptr, ptr, fixed bin (21));
	dcl     sc_ipc_mask_$unmask	        entry (fixed binary);
	dcl     sc_ipc_mask_$remask	        entry (fixed binary);
	dcl     ssu_$get_info_ptr	        entry (ptr) returns (ptr);
	dcl     sys_log_		        entry options (variable);
	dcl     sys_log_$error_log	        entry options (variable);
	dcl     up_sysctl_$check_acs	        entry (character (*), character (*), fixed binary, bit (36) aligned,
				        fixed binary (35));


	dcl     error_table_$recoverable_error
				        fixed bin (35) ext static;
	dcl     error_table_$as_sac_command_read
				        fixed bin (35) external static;
	dcl     error_table_$insufficient_access
				        fixed bin (35) ext static;
	dcl     error_table_$unimplemented_version
				        fixed bin (35) ext static;
	dcl     error_table_$unexpected_condition
				        fixed bin (35) ext static;
	dcl     error_table_$undefined_order_request
				        fixed bin (35) ext static;

	dcl     cleanup		        condition;
	dcl     command_error	        condition;
	dcl     any_other		        condition;
	dcl     finish		        condition;
	dcl     signal_io_		        condition;

	dcl     addcharno		        builtin;
	dcl     addr		        builtin;
	dcl     length		        builtin;
	dcl     min		        builtin;
	dcl     null		        builtin;
	dcl     substr		        builtin;
	dcl     unspec		        builtin;

	dcl     MAX_CAPTURE_LENGTH	        fixed bin (21) init (1024 * 240 * 4) int static options (constant);


	test_switches = "0"b;
	asr_admin_command_info_ptr = ASR_info_ptr;
	as_request_sender_ptr = ASR_sender_ptr;
	asr_replyp = addr (as_request_sender.reply_message);
	asr_reply_admin_command.code = 0;
	asr_reply_admin_command.flags = "0"b;

	if asr_admin_command_info.version ^= ASR_AC_VERSION_1
	then do;
		asr_reply_admin_command.code = error_table_$unimplemented_version;
		go to ERROR_NO_EXECUTION;
	     end;

/**** Does the user have access to do this? */

	call up_sysctl_$check_acs ("send_admin_command.acs", as_request_sender.group_id,
	     (as_request_sender.validation_level), acs_mode, code);
	if code ^= 0
	then do;
		call sys_log_$error_log (SL_LOG_SILENT, code, "sc_admin_command_", "Failed to check access for ^a.",
		     as_request_sender.group_id);
		asr_reply_admin_command.code = error_table_$insufficient_access;
		go to ERROR_NO_EXECUTION;
	     end;
	if (acs_mode & RW_ACCESS) ^= RW_ACCESS
	then do;
		call sys_log_ (SL_LOG_SILENT, "sc_admin_command_: Denied send_admin_command for ^a in ring ^d.",
		     as_request_sender.group_id, as_request_sender.validation_level);
		asr_reply_admin_command.code = error_table_$insufficient_access;
		go to ERROR_NO_EXECUTION;
	     end;

/**** Okay, the sucker is authorized. Now log the command line. */

	call sys_log_ (SL_LOG, "sc_admin_command_: ^a: ^a", as_request_sender.group_id, asr_admin_command_info.command);

	if ^(asr_admin_command_info.send_start_wakeup | asr_admin_command_info.send_completion_wakeup)
	then asr_admin_command_info.header.reply_channel = 0;
						/* inhibit as_request_sender_ reply wakeups in this case. */


	call ioa_$ioa_switch (sc_stat_$admin_log_iocb, "sc_admin_command_: ^a: ^a", as_request_sender.group_id,
	     asr_admin_command_info.command);


	ignore_io = "1"b;
	finish_signalled = "0"b;
	on signal_io_ call IO_SIGNAL_HANDLER;

/**** Okay, we are now signalling whenever I/O on user_i/o tries to happen */

	on finish
	     begin;
		finish_signalled = "1"b;
		code = error_table_$unexpected_condition;
		go to UNWIND_LABEL;
	     end;

	call cu_$set_cl_intermediary (CL_ENTRY);
	evidence_of_error = "0"b;
	on command_error
	     begin;
		evidence_of_error = "1"b;
	     end;

	ignore_io = "0"b;				/* all set */

	if asr_admin_command_info.send_start_wakeup
	then call SEND_START_WAKEUP;

	capture_output_ptr = null ();
	if asr_admin_command_info.send_completion_mail
	then call SETUP_CAPTURE_OUTPUT;

	begin;
	     declare 1 restrictions		   aligned like rcodebits;
	     restrictions = "1"b;			/* all powers */
	     restrictions.admin_mode = "0"b;		/* silly to allow sac to enter admin mode */
	     call sc_create_sci_ (sci_ptr, code);
	     if code ^= 0
	     then do;
		     call sys_log_$error_log (SL_LOG_SILENT, code, "sc_admin_command_",
			"Failed to create sci for execution of that command.");
		     go to UNWIND_NO_REMASK_LABEL;
		end;
	     sc_subsystem_info_ptr = ssu_$get_info_ptr (sci_ptr);
	     sc_subsystem_info.source_name = "sc_admin_command_";
	     sc_subsystem_info.restriction_flags = unspec (restrictions);
	     sc_subsystem_info.no_real_tty = "1"b;
	     sc_subsystem_info.real_iocb = null ();
	     sc_subsystem_info.mc_atep = null ();
	     sc_subsystem_info.access_control_name = get_group_id_ ();
	end;

	prev_iocb_name = "user_output";		/* assume vanilla output */
	call sc_ipc_mask_$unmask (unmask_count);
	on any_other call ANY_OTHER_HANDLER ();

	call sc_process_command_line_$multics_command (sci_ptr, addr (asr_admin_command_info.command),
	     length (asr_admin_command_info.command));	/* Execute the command. */
	call sc_ipc_mask_$remask (unmask_count);
	asr_reply_admin_command.code = 0;
	asr_reply_admin_command.flags = ""b;
	asr_reply_admin_command.command_completed = "1"b;
	asr_reply_admin_command.command_had_errors = evidence_of_error;
	go to RESTORE_RETURN;

UNWIND_LABEL:
	call sc_ipc_mask_$remask (unmask_count);
UNWIND_NO_REMASK_LABEL:
	if code ^= 0
	then asr_reply_admin_command.code = code;
	asr_reply_admin_command.flags = ""b;
	asr_reply_admin_command.flags.command_completed = "1"b;
	asr_reply_admin_command.flags.command_aborted = "1"b;


RESTORE_RETURN:
	ignore_io = "1"b;
	revert any_other;
	call cu_$reset_cl_intermediary;
	call sc_create_sci_$destroy (sci_ptr);
	if test_switches
	then do;
		call com_err_ (code, "sc_admin_command_$test_signal_handling", "Returned via unwind.");
		return;
	     end;

	if ^asr_admin_command_info.send_completion_wakeup
	then asr_admin_command_info.header.reply_channel = 0;
						/* prevent as_request_server_ from returning any wakeup */
	if code ^= 0
	then call convert_status_code_ (code, "", error_string);
	else error_string = "";
	call ioa_$rsnnl (
	     "Completed command^[ with errors^].^[ Finish condition signalled.^]^[ ^a^/^;^s^]^[ Command line aborted by error.^]",
	     completion_string, (0), asr_reply_admin_command.flags.command_had_errors, finish_signalled, code ^= 0,
	     error_string, asr_reply_admin_command.flags.command_aborted);

	call iox_$control (sc_stat_$admin_log_iocb, "flush_pending_output", null (), (0));
	call ioa_$ioa_switch (sc_stat_$admin_log_iocb, "sc_admin_command_: ^a", completion_string);
						/* log completion text */
	if asr_admin_command_info.send_completion_message
	then do;
		call ioa_$rsnnl (
		     "Completed command ^a^[ with errors^].^[ Finish condition signalled.^]^[ ^a^/^;^s^]^[ Command line aborted by error.^]",
		     message_string, (0),
		     substr (asr_admin_command_info.command, min (length (asr_admin_command_info.command), 50)),
		     asr_reply_admin_command.flags.command_had_errors, finish_signalled, code ^= 0, error_string,
		     asr_reply_admin_command.flags.command_aborted);

		call SEND_MESSAGE (asr_admin_command_info.mail_destination, completion_string);
	     end;
	if asr_admin_command_info.send_completion_mail
	then call SEND_COMPLETION_MAIL (completion_string);
						/* complex enough for a proc */
						/* this frees capture segment */

	return;

CL_ENTRY:
     procedure;
	code = error_table_$unexpected_condition;
	go to UNWIND_LABEL;
     end CL_ENTRY;
%page;
IO_SIGNAL_HANDLER:
     procedure;
	declare 1 CI		        aligned like condition_info;


/**** Check if this signal_io_ is for us.  If not, let someone else handle
      it. */

	if sc_stat_$admin_sci_ptr ^= sci_ptr
	then do;
		call continue_to_signal_ ((0));
		return;
	     end;

	if ignore_io
	then return;

	CI.version = condition_info_version_1;
	call find_condition_info_ (null (), addr (CI), (0));
	signal_io_info_ptr = CI.info_ptr;
	signal_io_info.returned_error_code = 0;

	if signal_io_info.operation = SGI_OP_GET_LINE
	then call GET_LINE;
	else if signal_io_info.operation = SGI_OP_GET_CHARS
	then call GET_CHARS;
	else if signal_io_info.operation = SGI_OP_PUT_CHARS
	then call PUT_CHARS;
	else if signal_io_info.operation = SGI_OP_POSITION
	then call POSITION;
	else if signal_io_info.operation = SGI_OP_CONTROL
	then call CONTROL;
	else if signal_io_info.operation = SGI_OP_MODES
	then call MODES;

	return;					/* If we get here, then we needn't unwind */

%page;

GET_LINE:
     procedure;

	call INPUT;
	return;
     end GET_LINE;

GET_CHARS:
     procedure;
	call INPUT;
	return;
     end GET_CHARS;

POSITION:
     procedure;
	call INPUT;
	return;
     end POSITION;

INPUT:
     procedure;

	code = error_table_$as_sac_command_read;
	go to UNWIND_LABEL;
     end INPUT;

MODES:
     procedure;

	signal_io_old_modes = "";
	return;
     end MODES;

PUT_CHARS:
     procedure;

	declare window_ptr		        pointer;
	declare window_length	        fixed bin (21);
	declare window		        char (window_length) based (window_ptr);

	if signal_io_info.iocb_ptr = iox_$error_output
	then evidence_of_error = "1"b;
	if test_switches
	then do;
		call ioa_ ("sc_admin_command_$test_signal_handling: ^a: ^a", signal_io_info.iocb_name,
		     signal_io_io_buffer);
		return;
	     end;
	if prev_iocb_name ^= signal_io_info.iocb_name
	then call ioa_$ioa_switch_nnl (sc_stat_$admin_log_iocb, "^/^a:^/^a", signal_io_info.iocb_name,
		signal_io_io_buffer);
	else call ioa_$ioa_switch_nnl (sc_stat_$admin_log_iocb, "^a", signal_io_io_buffer);
	prev_iocb_name = signal_io_info.iocb_name;	/* log it */
	if capture_output_ptr = null () /* not capturing */ | capture_overran
						/* more than we can mail */
	then return;

	window_ptr = addcharno (capture_output_ptr, capture_output_length);
	window_length = length (signal_io_io_buffer);
	capture_output_length = capture_output_length + window_length;
	if capture_output_length > MAX_CAPTURE_LENGTH
	then do;
		capture_overran = "1"b;		/* don't capture this message at all */
		capture_output_length = capture_output_length - window_length;
	     end;
	else window = signal_io_io_buffer;
	return;
     end PUT_CHARS;

CONTROL:
     procedure;

	if signal_io_order_name = "hangup"
	then return;
	if signal_io_order_name = "listen"
	then return;
	if signal_io_order_name = "quit_enable"
	then return;
	if signal_io_order_name = "quit_disable"
	then return;
	if signal_io_order_name = "start"
	then return;
	if signal_io_order_name = "printer_on"
	then return;
	if signal_io_order_name = "printer_off"
	then return;
	if signal_io_order_name = "read_status"
	then call INPUT;
	signal_io_info.returned_error_code = error_table_$undefined_order_request;
	return;
     end CONTROL;
     end IO_SIGNAL_HANDLER;


SEND_START_WAKEUP:
     procedure;

	if asr_admin_command_info.header.reply_channel = 0
	then return;
	declare 1 l_reply		        aligned like asr_reply_admin_command;
	l_reply.code = 0;
	l_reply.flags = ""b;
	l_reply.command_started = "1"b;

	call hcs_$wakeup (as_request_sender.process_id, asr_admin_command_info.header.reply_channel, unspec (l_reply),
	     (0));
	return;
     end SEND_START_WAKEUP;


test_signal_handling:
     entry;
	declare test_iocb		        pointer;
	declare default_cl_intermediary       entry (1 aligned, 2 bit (1) unaligned, 2 bit (35) unaligned) variable;
	declare 1 cli_flags		        aligned,
		2 reset		        bit (1) unaligned,
		2 pad		        bit (35) unaligned;

	test_switches = "1"b;
	ignore_io = "0"b;
	on signal_io_ call IO_SIGNAL_HANDLER;
	call iox_$attach_name ("test_sc_admin_command", test_iocb, "signal_io_", null (), (0));
	call iox_$open (test_iocb, Stream_input_output, "0"b, (0));
	call cu_$get_cl_intermediary (default_cl_intermediary);
	call cu_$set_cl_intermediary (NEW_COMMAND_LEVEL);
	cli_flags = "0"b;
	on cleanup call cu_$set_cl_intermediary (default_cl_intermediary);
	call default_cl_intermediary (cli_flags);
	return;

NEW_COMMAND_LEVEL:
     procedure (cl_flags);

	declare 1 cl_flags		        aligned,
		2 reset		        bit (1) unaligned,
		2 pad		        bit (35) unaligned;

	on signal_io_ call IO_SIGNAL_HANDLER;
	call default_cl_intermediary (cl_flags);
	return;
     end NEW_COMMAND_LEVEL;


ERROR_NO_EXECUTION:
	call NOTIFY_REFUSAL;
	return;

NOTIFY_REFUSAL:
     procedure;

/**** If the sender set ^start_wakeup, then perhaps we can notify
      of the problem via an interactive message or mail. */

	if asr_admin_command_info.send_start_wakeup
	then return;				/* Let as_request_server_ pother about it. */

	asr_admin_command_info.reply_channel = 0;	/* prevent reply */

	call convert_status_code_ (asr_reply_admin_command.code, "", error_string);
	message_string = "";
	call ioa_$rsnnl ("^a Admin command line refused. Command line was:^/ ^a^/", message_string, (0), error_string,
	     asr_admin_command_info.command);
	if asr_admin_command_info.send_completion_message
	then call SEND_MESSAGE (asr_admin_command_info.mail_destination, message_string);
	if asr_admin_command_info.send_completion_mail
	then call SEND_MAIL (asr_admin_command_info.mail_destination, "Admin command execution refused" /* subject */,
		message_string);
	if ^(asr_admin_command_info.send_completion_mail | asr_admin_command_info.send_completion_message)
	then call SEND_MESSAGE ("", message_string);	/* pick a destination out of the air */
	return;
     end NOTIFY_REFUSAL;

SEND_MESSAGE:
     procedure (Destination, Message);

	declare (Destination, Message)        char (*);

	call as_send_user_message_ ("sc_admin_command_", Destination, as_request_sender.group_id, Message,
	     as_request_sender.authorization, "Admin command server", "0"b);
	return;
     end SEND_MESSAGE;

SEND_MAIL:
     procedure (Destination, Subject, Message) options (non_quick);

	declare (Destination, Subject, Message)
				        char (*);

	declare format_document_$string       entry (character (*), character (*), fixed binary (21), pointer,
				        fixed binary (35));
	declare 1 fdo		        aligned like format_document_options;

	declare formatted_message	        char (1000);
	declare formatted_message_length      fixed bin (21);
	declare message_to_send	        char (formatted_message_length) based (addr (formatted_message));

	unspec (fdo) = ""b;
	fdo.version_number = format_document_version_2;
	fdo.indentation = 0;
	fdo.line_length = 65;
	fdo.switches.adj_sw = "1"b;
	fdo.switches.galley_sw = "1"b;
	fdo.switches.dont_compress_sw = "1"b;

	call format_document_$string (Message, formatted_message, formatted_message_length, addr (fdo), code);
	if code = error_table_$recoverable_error
	then code = 0;
	if code ^= 0
	then do;
		formatted_message = Message;
		formatted_message_length = length (Message);
	     end;

	call as_send_user_mail_ ("sc_admin_command_", Destination, as_request_sender.group_id, Subject, message_to_send,
	     as_request_sender.authorization, "Admin command server");
	return;
     end SEND_MAIL;

SEND_COMPLETION_MAIL:
     procedure (Trailer);

	declare Trailer		        char (*);	/* end to tack on to message */
	declare remaining_string	        char (MAX_CAPTURE_LENGTH + 1000 - capture_output_length)
				        based (remaining_ptr);
						/* the max is small enough that we always have some extra room */
	declare remaining_ptr	        pointer;
	declare added_length	        fixed bin (21);
	declare total_message	        char (capture_output_length) based (capture_output_ptr);
	declare subject		        char (asr_admin_command_info.command_length + 20);
						/* room for "succeeded: " */

	remaining_ptr = addcharno (capture_output_ptr, capture_output_length);
	call ioa_$rsnp ("^/^a^[^/The output (above) was truncated because it was too long to fit^/ in a mail message.",
	     remaining_string, added_length, Trailer, capture_overran);
	capture_output_length = capture_output_length + added_length;
						/* total in message */

	call ioa_$rsnnl ("^[Succeeded^;Failed^]: ^a", subject, (0),
	     ^asr_reply_admin_command.flags.command_aborted & asr_reply_admin_command.code = 0,
	     asr_admin_command_info.command);
	call as_send_user_mail_ ("sc_admin_command_", asr_admin_command_info.mail_destination,
	     as_request_sender.group_id, subject, total_message, as_request_sender.authorization,
	     "Admin command server");
	call release_temp_segment_ ("sc_admin_command_", capture_output_ptr, (0));
	return;
     end SEND_COMPLETION_MAIL;

SETUP_CAPTURE_OUTPUT:
     procedure;

	declare initial_message	        char (10000) aligned based (capture_output_ptr);
	call get_temp_segment_ ("sc_admin_command_", capture_output_ptr, (0));
	capture_output_length = 0;
	capture_overran = "0"b;
	call ioa_$rsnp ("Output of execution of admin command:^/^a^/", initial_message, capture_output_length,
	     asr_admin_command_info.command);
	return;
     end SETUP_CAPTURE_OUTPUT;
%page;
ANY_OTHER_HANDLER:
     procedure ();

/**** We really want the operation of default_error_handler_$wall for
      all conditions, except signal_io_, where we want the normal 
      signal_io_ handlers action.  So we peek at the condition being
      signaled -- if it is signal_io_, then we continue to signal.
      Otherwise we pass our work off to default_error_handler_$wall. */

	dcl     1 CI		        aligned like condition_info;
	dcl     code		        fixed bin (35);

	CI.version = condition_info_version_1;
	call find_condition_info_ (null (), addr (CI), code);
	if code = 0
	then if CI.condition_name = "signal_io_"
	     then do;
		     call continue_to_signal_ ((0));
		     return;
		end;
	call default_error_handler_$wall;		/* But note the CL intermediary */
	return;
     end ANY_OTHER_HANDLER;				/* format: off */
%page; %include as_data_;
%page; %include format_document_options;
%page; %include sc_stat_;
%page; %include sc_subsystem_info_;
%page; %include sys_log_constants;
%page; %include access_mode_values;
%page; %include as_request_header;
%page; %include as_requests;
%page; %include as_request_sender_;
%page; %include condition_info_header;
%page; %include signal_io_info;
%page; %include condition_info;
%page; %include iox_modes;
%page; %include iox_entries;
%page; %include mc_restriction_codes;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   sc_admin_command_: PERSON: COMMANDLINE

   S:	$sc

   T:	$run

   M:	A system administrator has sent a special command to the
   Initializer, which executes it in admin mode.

   A:	$ignore


   Message:
   sc_admin_command_: Failed to check access for USER.

   S:	$sc

   T:	$run

   M:	User USER requested the system to execute an admin command,
   but the system cound not determine their access to the admin_command
   acs.

   A:	$ignore


   Message:
   sc_admin_command_: Denied send_admin_command for USER in ring RING.

   S:	$sc

   T:	$run

   M:	User USER requested the system to execute an admin command,
   but lacked access to >sc1>admin_acs>admin_command.acs.

   A:	$ignore


   END MESSAGE DOCUMENTATION */

     end sc_admin_command_;




		    sc_admin_mode_.pl1              11/11/89  1102.8rew 11/11/89  0809.1       54018



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

/* format: style2,idind30 */

sc_admin_mode_:
     procedure;

/**** System control request to enter admin mode.
      This assumes that I/O switches are already set up reasonably. */

/**** Written 1984-11-02 BIM */


/****^  HISTORY COMMENTS:
  1) change(86-08-01,Swenson), approve(87-05-25,MCR7680),
     audit(87-02-19,GDixon), install(87-08-04,MR12.1-1055):
     Avoid calling hphcs_$syserr_error_code when running in system control test
     mode.
  2) change(87-02-19,GDixon), approve(87-05-25,MCR7680),
     audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055):
     Correct coding standard violations.
                                                   END HISTORY COMMENTS */


	declare cu_$arg_list_ptr	        entry returns (ptr);
	declare cu_$get_cl_intermediary       entry (entry);
	declare cu_$generate_call	        entry (entry, ptr);
	declare cu_$reset_command_processor   entry;
	declare cu_$set_cl_intermediary       entry (entry);
	declare default_error_handler_$wall   entry;
	declare get_group_id_	        entry () returns (char (32));
	declare hcs_$fs_search_set_wdir       entry (char (*), fixed bin (35));
	declare hphcs_$syserr_error_code      entry entry options (variable);
	declare ioa_		        entry options (variable);
	declare listen_		        entry (char (*) var);
	declare pnt_manager_$priv_get_entry   entry (char (*), pointer, fixed bin (35));
	declare read_password_	        entry (character (*), character (*));
	declare sc_ipc_mask_$unmask	        entry (fixed binary);
	declare sc_ipc_mask_$remask	        entry (fixed binary);
	declare sc_signal_io_handler_	        entry;
	declare scramble_		        entry (character (8)) returns (character (8));
	declare ssu_$abort_line	        entry () options (variable);
	declare ssu_$get_info_ptr	        entry (ptr) returns (ptr);
	declare ssu_$print_message	        entry () options (variable);
	declare sys_log_		        entry options (variable);

	declare code		        fixed bin (35);
	declare default_cl_intermediary       entry variable;
	declare remask_count	        fixed bin;
	declare saved_access_name	        char (32);
	declare sci_ptr		        pointer;
	declare w_password		        char (8);

	declare (addr, null)	        builtin;

	declare any_other		        condition;
	declare cleanup		        condition;
	declare finish		        condition;
	declare signal_io_		        condition;

	declare ssu_$null_label	        label ext static;


	sci_ptr = sc_stat_$admin_sci_ptr;

	if sc_stat_$admin_listener_switch
	then call ssu_$abort_line (sci_ptr, 0, "Admin mode busy.");

	call pnt_manager_$priv_get_entry (OPERATOR_ADMIN_MODE_USER_NAME, addr (PNTE), code);
	if code ^= 0
	then do;
		if ^sc_stat_$test_mode
		then call hphcs_$syserr_error_code (LOG, code,
			"admin: Could not retrieve admin password from the PNT to check admin password. Entering admin mode."
			);
		call ssu_$print_message (sci_ptr, code,
		     "Could not retrieve admin password from the PNT to check admin password. Entering admin mode.");
	     end;
	else if ^PNTE.has_password
	then ;					/* no password required */
	else do;
		call read_password_ ("Password", w_password);
		if ^(scramble_ (w_password) = PNTE.password)
		then do;
			call sys_log_ (SL_LOG_SILENT, "admin: incorrect admin mode password given.");
			call ssu_$abort_line (sci_ptr, 0, "Password incorrect.");
		     end;
	     end;


	call cu_$get_cl_intermediary (default_cl_intermediary);
	sc_subsystem_info_ptr = ssu_$get_info_ptr (sci_ptr);

	on finish go to FINISH_SIGNALLED;
	on any_other call default_error_handler_$wall;
	on signal_io_ call sc_signal_io_handler_;	/* make sure our handler takes */

	remask_count = 0;

	saved_access_name = sc_subsystem_info.access_control_name;

	on cleanup call clean;			/* Allow for nonlocal exit */

	sc_subsystem_info.access_control_name = get_group_id_ ();
						/* Act as the Initializer */

	call cu_$set_cl_intermediary (ADMIN_CL_INTERMEDIARY);
	sc_stat_$admin_listener_exit_label = RETURN;
	sc_stat_$admin_listener_switch = "1"b;
	call iox_$control (iox_$user_io, "quit_enable", null (), (0));
	call sc_ipc_mask_$unmask (remask_count);

	call listen_ ("");				/* This dosen't usually return, but... */
	go to RETURN;

admin_mode_exit:
ame:
     entry;

	if sc_stat_$admin_listener_switch
	then go to sc_stat_$admin_listener_exit_label;

	else call ioa_ ("""admin_mode_exit"" ignored.");	/* else ignore exit command */
	return;

RETURN:
	revert any_other;
	call clean;				/* borrow */
	return;

FINISH_SIGNALLED:
	revert any_other;
	call clean;
	call ssu_$abort_line (sci_ptr, 0, "finish condition signalled.");


ADMIN_CL_INTERMEDIARY:
     procedure;

	on signal_io_ call sc_signal_io_handler_;
	call cu_$generate_call (default_cl_intermediary, cu_$arg_list_ptr ());
	return;
     end ADMIN_CL_INTERMEDIARY;

clean:
     procedure;
	sc_subsystem_info.access_control_name = saved_access_name;
	call sc_ipc_mask_$remask (remask_count);
	call iox_$control (iox_$user_io, "quit_disable", null (), (0));
	call cu_$set_cl_intermediary (default_cl_intermediary);
	sc_stat_$admin_listener_switch = "0"b;
	sc_stat_$admin_listener_exit_label = ssu_$null_label;
	call hcs_$fs_search_set_wdir (sc_stat_$sysdir, (0));
	call cu_$reset_command_processor;
	return;
     end clean;

%include iox_entries;

%include pnt_entry;
	declare 1 PNTE		        aligned like pnt_entry;

%include sc_subsystem_info_;

%include sc_stat_;

%include special_person_names;

%include sys_log_constants;

%include syserr_constants;

     end sc_admin_mode_;




		    sc_command.pl1                  11/11/89  1102.8rew 11/11/89  0809.1       46818



/****^  ***********************************************************
        *                                                         *
        * 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,indcomtxt,idind30 */


sc_command:
     procedure options (variable);

/* *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
/*							       */
/* SC_COMMAND - command level interface to system control.		       */
/*    Concatenates its arguments and calls system_control_ subroutines to    */
/* execute.  Naturally, only works in the initializer process.	       */
/*    Used for commands executed from				       */
/*    .	system_start_up.ec					       */
/*    .	admin.ec						       */
/*    .	admin mode					       */
/*    .	send_admin_command					       */
/*							       */
/* This command is to be called ONLY in the system control admin	       */
/* environment. It insists that sc_stat_$admin_sci_ptr is non_null,	       */
/* defining the source of the x command or admin mode. Note that	       */
/* sc_admin_command_ sets admin_sci_ptr as well, so that sac sc_command      */
/* works.							       */
/*							       */
/* This procedure assumes that all I/O switches and handlers are already in  */
/* place. It handles no conditions, and just call ssu_$execute_line.	       */
/*							       */
/* This procedure creates a subsystem invocation all its own so that error   */
/* messages are prefaced with the actual request name.		       */
/*							       */
/* *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */

/* Created by THVV in antiquity. */
/* Modified to not add trailing blank by C. Hornig, November 1979 */
/* Cleaned up by E. N. Kittlitz, May 1982 */
/* 1984-12, BIM: SSU_ system control. */


/****^  HISTORY COMMENTS:
  1) change(87-02-19,GDixon), approve(87-05-25,MCR7680),
     audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055):
     Correct coding standard violations.  Use an automatic sc-command-line
     buffer instead of a based (allocated) buffer.
                                                   END HISTORY COMMENTS */


	dcl     arg_count		        fixed bin;
	dcl     al		        fixed bin (21);
	dcl     ap		        ptr;
	dcl     arg_list_ptr	        ptr;
	dcl     argument		        char (al) based (ap);
	dcl     argx		        fixed bin;
	dcl     buffer_length	        fixed bin (21);
	dcl     code		        fixed bin (35);
	dcl     sci_ptr		        pointer;
	dcl     test		        bit (1) aligned;

	dcl     com_err_		        entry () options (variable);
	dcl     cu_$arg_count	        entry (fixed bin, fixed bin (35));
	dcl     cu_$arg_list_ptr	        entry returns(ptr);
	dcl     cu_$arg_ptr		        entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
	dcl     cu_$arg_ptr_rel	        entry (fixed bin, ptr, fixed bin(21), fixed bin(35), ptr);
	dcl     sc_create_sci_	        entry (pointer, fixed binary (35));
	dcl     sc_create_sci_$destroy        entry (ptr);
	dcl     ssu_$execute_line	        entry (ptr, ptr, fixed bin (21), fixed bin (35));

	dcl     (addr, addwordno, length, null)
				        builtin;

	dcl     cleanup		        condition;

	dcl     SP		        char (1) int static options (constant) init (" ");

	test = "0"b;
	if sc_stat_$admin_sci_ptr = null ()
	then do;
		call com_err_ (0, "sc_command", "This command may only be called in the system control environment.");
		return;
	     end;
	sci_ptr = sc_stat_$admin_sci_ptr;
	go to COMMON;

test:
     entry;

	test = "1"b;
	sci_ptr = null;
	on cleanup call sc_create_sci_$destroy (sci_ptr);
	call sc_create_sci_ (sci_ptr, code);
	if code ^= 0
	then do;
		call com_err_ (code, "sc_command", "Failed to create test subsystem info.");
		return;
	     end;

COMMON:
	call cu_$arg_count (arg_count, code);
	if code ^= 0
	then do;
		call com_err_ (code, "sc_command");
		return;
	     end;

	buffer_length = 0;
	do argx = 1 to arg_count;
	     call cu_$arg_ptr (argx, ap, al, (0));
	     if argx > 1
	     then buffer_length = buffer_length + length (SP);
	     buffer_length = buffer_length + al;
	end;
	arg_list_ptr = cu_$arg_list_ptr();

DCL_BLOCK:
	begin;

	     dcl	   buffer			   char (buffer_length) varying;

	     buffer = "";
	     do argx = 1 to arg_count;
		call cu_$arg_ptr_rel (argx, ap, al, (0), arg_list_ptr);
		buffer = buffer || argument;
		buffer = buffer || SP;
	     end;

	     call ssu_$execute_line (sci_ptr, addwordno (addr (buffer), 1), length (buffer), code);
	     if test
	     then if code ^= 0
		then call com_err_ (code, "sc_command", "Error from ssu_$execute_line.");
	end DCL_BLOCK;

	if test
	then call sc_create_sci_$destroy (sci_ptr);

%include sc_stat_;
     end sc_command;




		    sc_create_sci_.pl1              11/11/89  1102.8rew 11/11/89  0809.1       45801



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

/* sc_create_sci_ -- create an invocation of the system control 
	        ssu invocation. */
/* format: style2,idind30 */

/**** Written 1984-11-01 BIM */
/**** Modified 1985-01-07, BIM: for access_control_name in sc_subsystem_info */
/**** Modified 1985-02-01, BIM: invoke_request to intercept abort_line */
/**** Modified 1985-02-18, E. Swenson: to save real abort_line routine */


/****^  HISTORY COMMENTS:
  1) change(87-02-22,GDixon), approve(87-05-25,MCR7680),
     audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055):
     Modified to correct coding standard violations.
                                                   END HISTORY COMMENTS */


sc_create_sci_:
     procedure (Sci_ptr, Code);

	declare Sci_ptr		        pointer;
	declare Code		        fixed bin (35);

	dcl     (addr, null)	        builtin;

	declare sc_get_error_name_	        entry;
	declare sc_execute_command_line_      entry;
	declare sc_execute_command_line_$locate_request
				        entry;
	declare sc_abort_line_util_$invoke_request
				        entry;
	declare sc_abort_line_util_$abort_line
				        entry;
	declare ssu_$create_invocation        entry (char (*), char (*), ptr, ptr, char (*), ptr, fixed bin (35));
	declare ssu_$destroy_invocation       entry (ptr);
	declare ssu_$cpescape_disabled        entry;
	declare ssu_$get_area	        entry (ptr, ptr, char (*), ptr);
	declare ssu_$set_info_ptr	        entry (ptr, ptr);
	declare ssu_$set_procedure	        entry (ptr, char (*), entry, fixed bin (35));
	declare ssu_$set_prompt_mode	        entry (ptr, bit (*));
	declare ssu_$get_procedure	        entry (ptr, char (*), entry, fixed bin (35));
	declare ssu_$add_request_table        entry (ptr, ptr, fixed bin, fixed bin (35));
	declare ssu_$add_info_dir	        entry (ptr, char (*), fixed bin, fixed bin (35));
	declare ssu_$null_label	        label ext static;

	declare sc_request_table_$system_control_requests
				        ext bit (36) aligned;

	declare ssu_request_tables_$standard_requests
				        bit (36) aligned ext static;
	declare sci_ptr		        pointer;


	call ssu_$create_invocation ("system_control", "", null (), null (), "", sci_ptr, Code);
	if Code ^= 0
	then return;

	call ssu_$add_request_table (sci_ptr, addr (sc_request_table_$system_control_requests), 1, Code);
	if Code ^= 0
	then return;
	call ssu_$add_request_table (sci_ptr, addr (ssu_request_tables_$standard_requests), 10000, Code);
	if Code ^= 0
	then return;
	call ssu_$add_info_dir (sci_ptr, sc_stat_$info_dir, 0, (0));
	call ssu_$add_info_dir (sci_ptr, ">documentation>ss>ssu_info_dirs>standard_requests", 10000, (0));

	call ssu_$set_procedure (sci_ptr, "cpescape", ssu_$cpescape_disabled, (0));
	call ssu_$set_procedure (sci_ptr, "get_subsystem_and_request_name", sc_get_error_name_, (0));
	begin;
	     declare temp_area_ptr		   pointer;
	     call ssu_$get_area (sci_ptr, null (), "", temp_area_ptr);
	     allocate sc_subsystem_info in (temp_area_ptr -> sc_ss_area);
	     sc_subsystem_info.area_ptr = temp_area_ptr;
	end;
	sc_subsystem_info.mc_atep = null ();
	sc_subsystem_info.real_iocb = null ();
	sc_subsystem_info.restriction_flags = (36)"1"b;
	sc_subsystem_info.flags = "0"b;
	sc_subsystem_info.source_name = "system_control";
	sc_subsystem_info.access_control_name = sc_stat_$unidentified_access_name;

	call ssu_$get_procedure (sci_ptr, "execute_line", sc_subsystem_info.real_execute_line, (0));
	call ssu_$set_procedure (sci_ptr, "execute_line", sc_execute_command_line_, (0));
	call ssu_$get_procedure (sci_ptr, "locate_request", sc_subsystem_info.real_locate_request, (0));
	call ssu_$set_procedure (sci_ptr, "locate_request", sc_execute_command_line_$locate_request, (0));
	call ssu_$get_procedure (sci_ptr, "invoke_request", sc_subsystem_info.real_invoke_request, (0));
	call ssu_$set_procedure (sci_ptr, "invoke_request", sc_abort_line_util_$invoke_request, (0));
	call ssu_$get_procedure (sci_ptr, "abort_line", sc_subsystem_info.real_abort_line, (0));
	call ssu_$set_procedure (sci_ptr, "abort_line", sc_abort_line_util_$abort_line, (0));

	sc_subsystem_info.hangup_entry = HANGUP_NOOP;
	sc_subsystem_info.abort_request_label = ssu_$null_label;
	call ssu_$set_info_ptr (sci_ptr, addr (sc_subsystem_info));
	call ssu_$set_prompt_mode (sci_ptr, DONT_PROMPT); /* in case someone gets the idea ... */
	Sci_ptr = sci_ptr;
	return;

destroy:
     entry (Sci_ptr);
	call ssu_$destroy_invocation (Sci_ptr);
	return;

HANGUP_NOOP:					/* in case noone sets anything better */
     entry;
	return;

%include sc_stat_;
%include sc_subsystem_info_;
%include ssu_prompt_modes;
     end sc_create_sci_;




		    sc_edit_motd_.pl1               11/11/89  1102.8rew 11/11/89  0809.1       26100



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

/* format: style2,idind30 */

/**** Guts of the "message" request, which allows the operator to 
      edit the MOTD. */

/**** Written 1984-11-01 BIM */


/****^  HISTORY COMMENTS:
  1) change(87-02-08,GDixon), approve(87-05-25,MCR7680),
     audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055):
     Fix coding standard violations.
                                                   END HISTORY COMMENTS */


sc_edit_motd_:
     procedure;
	dcl     code		        fixed bin (35);
	dcl     1 my_qedx_info	        aligned,
		2 header		        aligned like qedx_info.header,
		2 buffers		        aligned like qedx_info.buffers;
						/* just one */
	dcl     motd_pathname	        char (168); /* Path name for message of the day */
	dcl     motd_entryname	        char (32) int static init ("message_of_the_day") options (constant);
	dcl     saved_command_processor       entry variable;

	dcl     cu_$get_command_processor     entry (entry);
	dcl     cu_$set_command_processor     entry (entry);
	dcl     pathname_		        entry (character (*), character (*)) returns (character (168));
	dcl     qedx_		        entry (ptr, fixed bin (35));
	dcl     ssu_$print_message	        entry () options (variable);

	dcl     (addr, unspec)	        builtin;

	dcl     cleanup		        condition;

	call cu_$get_command_processor (saved_command_processor);
	on cleanup call cu_$set_command_processor (saved_command_processor);
	call cu_$set_command_processor (trap_editor_execute);
						/* Trap "E" requests. */
	motd_pathname = pathname_ (sc_stat_$sysdir, motd_entryname);
	unspec (my_qedx_info) = "0"b;
	qedx_info_ptr = addr (my_qedx_info);
	qedx_info.version = QEDX_INFO_VERSION_1;
	qedx_info.editor_name = "message";
	qedx_info.flags.no_rw_path = "1"b;
	qedx_info.flags.query_if_modified = "1"b;
	qedx_info.n_buffers = 1;
	qedx_info.buffers (1).buffer_name = "0";
	qedx_info.buffers (1).buffer_pathname = motd_pathname;
	qedx_info.buffers (1).flags.locked_pathname = "1"b;
	qedx_info.buffers (1).flags.default_read_ok = "1"b;
	qedx_info.buffers (1).flags.default_write_ok = "1"b;
	call qedx_ (qedx_info_ptr, code);

	call cu_$set_command_processor (saved_command_processor);
	return;					/* Done. */

trap_editor_execute:
     procedure;

	call ssu_$print_message (sc_stat_$admin_sci_ptr, 0, """e"" request not permitted.");

     end trap_editor_execute;

%include qedx_info;

%include sc_stat_;

     end sc_edit_motd_;




		    sc_exec_request_.pl1            11/11/89  1102.8rew 11/11/89  0806.8       27153



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

/* sc_exec_request_ -- calls exec_com for the x request */
/* format: style2,indcomtxt,idind30 */

/**** Written 1984-11-01 BIM */


/****^  HISTORY COMMENTS:
  1) change(87-02-22,GDixon), approve(87-05-25,MCR7680),
     audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055):
     Corrected coding standard violations.
                                                   END HISTORY COMMENTS */

sc_exec_request_:
     procedure (SCI_ptr, SSI_ptr);

	declare SCI_ptr		        pointer;
	declare SSI_ptr		        pointer;	/* subsystem info -- unused for now */

	declare cu_$make_entry_value	        entry (ptr, entry);
	declare exec_com_		        entry (character (*), character (*), character (*), pointer,
				        fixed binary (35));
	declare pathname_		        entry (character (*), character (*)) returns (character (168));
	declare sc_ipc_mask_$unmask	        entry (fixed binary);
	declare sc_ipc_mask_$remask	        entry (fixed binary);
	declare ssu_$arg_list_ptr	        entry (ptr, ptr);
	declare ssu_$abort_line	        entry () options (variable);

	declare code		        fixed bin (35);
	declare sci_ptr		        pointer;
	declare remask_count	        fixed bin;
	declare saved_access_name	        char (32);

	declare (addr, null, unspec)	        builtin;

	declare cleanup		        condition;


	sci_ptr = SCI_ptr;
	sc_subsystem_info_ptr = SSI_ptr;
	unspec (eci) = ""b;
	eci.version = exec_com_info_version_1;
	call ssu_$arg_list_ptr (sci_ptr, eci.arg_list_ptr);
	eci.first_arg = 1;
	call cu_$make_entry_value (null (), eci.execute_line);
	call cu_$make_entry_value (null (), eci.eval_string);
	call cu_$make_entry_value (null (), eci.ready);
	call cu_$make_entry_value (null (), eci.set_ready_mode);
	call cu_$make_entry_value (null (), eci.error);
	code = 0;
	remask_count = 0;
	saved_access_name = sc_subsystem_info.access_control_name;
	on cleanup
	     begin;
		call sc_ipc_mask_$remask (remask_count);
		sc_subsystem_info.access_control_name = saved_access_name;
	     end;
	sc_subsystem_info.access_control_name = sc_stat_$exec_access_name;
	call sc_ipc_mask_$unmask (remask_count);
	call exec_com_ (pathname_ (sc_stat_$sysdir, "admin.ec"), "", "exec", addr (eci), code);
	call sc_ipc_mask_$remask (remask_count);
	sc_subsystem_info.access_control_name = saved_access_name;
	if code ^= 0
	then call ssu_$abort_line (sci_ptr, code, "admin.ec");
	return;

%include exec_com_info;
	declare 1 eci		        aligned like exec_com_info;

%include sc_stat_;

%include sc_subsystem_info_;
     end sc_exec_request_;




		    sc_execute_command_line_.pl1    11/11/89  1102.8rew 11/11/89  0809.1      127305



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

/* format: style2,idind30 */

sc_execute_command_line_:
     procedure (Sci_ptr, Line_ptr, Line_lth, Code);

/* *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
/*							       */
/* ssu_ replaceable execute_line procedure for the system control	       */
/*      environment.					       */
/*							       */
/* This procedure has to peek at the request so as to determine whether it   */
/* is a "special" request which does not parse its argument.	       */
/*							       */
/* It also performs masking of ipc events during execution of SPECIAL        */
/* requests whose sc_request_table_ entries call for this service.	       */
/* sc_abort_line_util_$invoke_request masks for nonSPECIAL requests.	       */
/*							       */
/* The sequence in which procedures are called in order to invoke a request  */
/* is as follows:						       */
/*							       */
/*    ssu_$listen						       */
/*     |__sc_execute_command_line_				       */
/*         |__check for special commands; if special		       */
/*	     |__INVOKE_SPECIAL_PROCEDURE			       */
/*	    if not special					       */
/*	     |__SSU's execute_command_line			       */
/*	         |__sc_abort_line_util_$invoke_request		       */
/*	            |__SSU's locate_request			       */
/*		  |__if event calls should be masked for this request    */
/*		  |   |__ipc_$mask_ev_calls			       */
/*		  |					       */
/*		  |__SSU's invoke_request			       */
/*		  |   |__sc_execute_command_line_$locate_request	       */
/*		  |   |   |__SSU's locate request		       */
/*		  |   |	|__check_restrictions		       */
/*		  |   |					       */
/*		  |   |__REQUEST PROCEDURE			       */
/*		  |					       */
/*		  |__if event calls were masked		       */
/*		      |__ipc_$unmask_ev_calls			       */
/*							       */
/* *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
%page;
/**** Written 1984-11-01 BIM */
/**** Modified 1985-01-07, BIM: Changed to allow 
      installation_parms.require_operator_login to be changed on the fly. */
/**** Modified 1985-02-01, BIM: changed for mapping of abort_line into 
     "abort_request"  */
/**** Modified 1985-03-18, E. Swenson to fix sign_on aborts during special
      requests. */
/**** Modified 1985-04-17, E. Swenson to fix masking problems. */

/****^  HISTORY COMMENTS:
  1) change(86-08-01,Swenson), approve(87-05-25,MCR7680),
     audit(87-02-05,GDixon), install(87-08-05,MR12.1-1055):
     Modified to avoid modifying disk_table_ when running in system control
     test mode.
  2) change(87-02-05,GDixon), approve(87-05-25,MCR7690),
     audit(87-05-06,Parisek), install(87-08-05,MR12.1-1055):
     Modified for changes to mc_anstbl.incl.pl1.
  3) change(87-02-05,GDixon), approve(87-05-25,MCR7680),
     audit(87-05-06,Parisek), install(87-08-05,MR12.1-1055):
     Modified to correct coding standard violations.  Corrected failure to
     reset sc_subsystem_info.abort_request_label.  Moved masking of IPC event
     channels for nonSPECIAL requests from this procedure into
     sc_abort_line_util_$invoke_request.
  4) change(87-07-02,GDixon), approve(87-07-02,MCR7680),
     audit(87-05-06,Parisek), install(87-08-05,MR12.1-1055):
      A) Since our $locate_request is called by the SSU invoke_request
         procedure, which is called by sc_abort_line_util_$invoke_request,
         our $locate_request procedure cannot tell sc_abort_line_util_
         whether or not to mask event call channels.  It must make that
         decision itself, prior to calling the real SSU invoke_request.
      B) Since $locate_request no longer needs to communicate with
         sc_abort_line_util_, we can remove the
         sc_subsystem_info.dont_mask_calls element from the include file.
      C) We still do masking for SPECIAL procedures.  Make unmasking
         dependent upon whether masking was successfully done, rather than
         upon whether we tried to do masking.
      D) Call sc_abort_line_util_$real_abort_line to abort the entire request 
         line if a sign_on fails.
                                                   END HISTORY COMMENTS */

	declare Sci_ptr		        pointer;
	declare Line_ptr		        pointer;
	declare Line_lth		        fixed bin (21);
	declare Code		        fixed bin (35);

	declare disk_table_$general_mhv       entry (fixed binary (35));
	declare ipc_$mask_ev_calls	        entry (fixed bin (35));
	declare ipc_$unmask_ev_calls	        entry (fixed bin (35));
	declare sc_abort_line_util_$real_abort_line
				        entry options(variable);
	declare sc_ipc_mask_$unmask	        entry (fixed bin);
	declare sc_ipc_mask_$remask	        entry (fixed bin);
	declare ssu_$abort_line	        entry () options (variable);
	declare ssu_$execute_line	        entry (ptr, ptr, fixed bin (21), fixed bin (35));
	declare ssu_$get_info_ptr	        entry (ptr) returns (ptr);
	declare ssu_$print_message	        entry () options (variable);

	declare WHITESPACE		        char (6) aligned init ("
	 ") int static options (constant);		/* FF VT NL CR TAB SP */
	declare ssu_et_$null_request_line     fixed bin (35) ext static;

	declare begin_request_name	        fixed bin (21);
	declare code		        fixed bin (35);
	declare dont_mask		        bit (1) aligned;
	declare ip		        ptr defined (as_data_$rs_ptrs (0));
	declare 1 l_request_data	        aligned like request_data;
	declare (masked_ev_calls_code, unmasked_ev_calls_code)
				        fixed bin (35);
	declare remask_count	        fixed bin;	/* depth of ipc event masking */
	declare request_line_ptr	        pointer;
	declare request_line_lth	        fixed bin (21);
	declare request_line	        char (request_line_lth) based (request_line_ptr);
	declare request_name_lth	        fixed bin (21);
	declare rest_index		        fixed bin (21);
	declare special_command	        bit (1) aligned;
	declare ws_at_end		        fixed bin (21);

	dcl     (addr, length, null, reverse, search, string, substr, verify)
				        builtin;

	declare cleanup		        condition;
%page;

/* Program */

	sci_ptr = Sci_ptr;
	sc_subsystem_info_ptr = ssu_$get_info_ptr (sci_ptr);
	request_data_ptr = addr (l_request_data);	/* we have our own copy for special requests */

	request_line_ptr = Line_ptr;
	request_line_lth = Line_lth;

	begin_request_name = verify (request_line, WHITESPACE);
	if begin_request_name = 0
	then do;
		Code = ssu_et_$null_request_line;
		return;
	     end;

	request_name_lth = search (substr (request_line, begin_request_name), WHITESPACE);
	if request_name_lth = 0
	then request_name_lth = request_line_lth - begin_request_name + 1;
	else request_name_lth = request_name_lth - 1;	/* this cannot come out zero. */
	code = 0;

	special_command = "0"b;
	dont_mask = "0"b;				/* most commands mask while executing */

	call sc_subsystem_info
	     .
	     real_locate_request (sci_ptr, substr (request_line, begin_request_name, request_name_lth),
	     addr (request_data), code);
	if code = 0
	then do;
		sc_rf_ptr = addr (request_data.user_flags);
		if sc_request_flags.dont_parse_arguments
		then special_command = "1"b;
		if sc_request_flags.dont_mask_calls
		then dont_mask = "1"b;
	     end;

	if special_command
	then do;
		rest_index = verify (substr (request_line, begin_request_name + request_name_lth), WHITESPACE);
		if rest_index = 0
		then call INVOKE_SPECIAL_PROCEDURE ("");
		else do;
			ws_at_end = verify (reverse (request_line), WHITESPACE);
			if ws_at_end > 0
			then ws_at_end = ws_at_end - 1;

			begin;

/* format: off */
declare line_arg
        char (request_line_lth
             - (rest_index + begin_request_name + request_name_lth - 2)
             - ws_at_end
             ) /* flush the NL */
        defined (request_line)
        pos (rest_index + begin_request_name + request_name_lth - 1);

/* format: on */

			     call INVOKE_SPECIAL_PROCEDURE (line_arg);
			end;
		     end;
	     end;
	else do;
		call sc_subsystem_info.real_execute_line (sci_ptr, request_line_ptr, request_line_lth, code);
						/* this will call us to locate */
	     end;
	Code = code;

	return;
%page;
INVOKE_SPECIAL_PROCEDURE:
     procedure (rest_of_line) options (non_quick);

	declare rest_of_line	        char (*);

	declare saved_request_data_ptr        pointer;
	declare saved_executing_request       bit (1) aligned;
	declare saved_abort_request	        label;

	declare cu_$arg_list_ptr	        entry returns (ptr);

	saved_request_data_ptr = sci.request_processor_info.request_data_ptr;
	saved_executing_request = sci.executing_request;
	saved_abort_request = sc_subsystem_info.abort_request_label;

	masked_ev_calls_code, unmasked_ev_calls_code = -1;
	if ^dont_mask then
	on cleanup
	     begin;
		sci.request_processor_info.request_data_ptr = saved_request_data_ptr;
		sc_subsystem_info.abort_request_label = saved_abort_request;
		sci.executing_request = saved_executing_request;
		if masked_ev_calls_code = 0 & unmasked_ev_calls_code ^= 0
		then call ipc_$unmask_ev_calls (unmasked_ev_calls_code);
	     end;

	sci.request_processor_info.request_data_ptr = addr (request_data);
	sci.executing_request = "1"b;
	sc_subsystem_info.abort_request_label = ABORT_SPECIAL_REQUEST;

	call check_restrictions ();

	request_data.call_info.arg_list_ptr = cu_$arg_list_ptr ();
	request_data.call_info.arg_count = 1;
	request_data.call_info.af_sw = "0"b;
	request_data.call_info.rv_ptr = null ();
	request_data.call_info.rv_lth = 0;

	if ^dont_mask
	then call ipc_$mask_ev_calls (masked_ev_calls_code);

	call request_data.entry (sci_ptr, addr (sc_subsystem_info));

ABORT_SPECIAL_REQUEST:
	if masked_ev_calls_code = 0 & unmasked_ev_calls_code ^= 0
	then call ipc_$unmask_ev_calls (unmasked_ev_calls_code);
	sci.request_processor_info.request_data_ptr = saved_request_data_ptr;
	sci.executing_request = saved_executing_request;
	sc_subsystem_info.abort_request_label = saved_abort_request;

	return;
     end INVOKE_SPECIAL_PROCEDURE;
%page(2);
check_restrictions:
     procedure;

	declare sci_authority	        (1:36) bit (1) unaligned;

	declare SIGN_ON_COMMAND	        character (7) init ("sign_on") int static options (constant);

/**** This program expects request_data to be set up */


	sc_rf_ptr = addr (request_data.user_flags);
	string (sci_authority) = sc_subsystem_info.restriction_flags;

	if sc_request_flags.restriction_type ^= 0
	then if ^sci_authority (sc_request_flags.restriction_type)
	     then call ssu_$abort_line (sci_ptr, 0, "Terminal ^a lacks authority to execute the ^a command.",
		     sc_subsystem_info.source_name, request_data.full_name);

	if sc_request_flags.obsolete
	then call ssu_$print_message (sci_ptr, 0, "Warning: the ^a command is obsolete.", request_data.full_name);

	if sc_request_flags.requires_no_as & sc_stat_$Multics
	then call ssu_$abort_line (sci_ptr, 0,
		"The Answering Service is already initialized.^[ Type ""go"" to start Multics service.^]",
		^sc_stat_$Go);

	if sc_request_flags.requires_as & ^sc_stat_$Multics
	then call ssu_$abort_line (sci_ptr, 0,
		"The ^a request requires the Answering Service to be initialized.^/"
		|| "Type ""startup"" or ""multics"" to initialize it.", request_data.full_name);

	if ip ^= null ()
	then /* Is installations parms initiated? If not, assume no login required */
	     if ^(sc_request_flags.no_login_needed | sc_stat_$no_operator_login | sc_subsystem_info.mc_atep = null ()
		| ^installation_parms.require_operator_login)
	     then do;
		     if ^sc_subsystem_info.mc_atep -> mc_ate.signed_on
		     then do;
			     call ssu_$print_message (sci_ptr, 0, "You must sign on before using the ^a command.",
				request_data.full_name);

/**** We must unmask IPC event calls here to allow the answering service
      to function while an operator is being queried for his/her userid
      and password.  We may have been masked during a previous call to
      ssu_$execute_line on the stack. */

			     call sc_ipc_mask_$unmask (remask_count);

			     call ssu_$execute_line (sci_ptr, addr (SIGN_ON_COMMAND), length (SIGN_ON_COMMAND),
				code);

/**** Reset the IPC event call mask to whatever it was before we unmasked
      above. */

			     call sc_ipc_mask_$remask (remask_count);
			     if code ^= 0
			     then call sc_abort_line_util_$real_abort_line
			        (sci_ptr, code, "Failed to sign on.");
			end;
		end;

/**** We are prepared to execute command. Call disk_table_ as needed. */

	if ^sc_stat_$test_mode & sc_request_flags.complete_disks_first
	then do;
		call disk_table_$general_mhv (code);
		if code ^= 0
		then call ssu_$abort_line (sci_ptr, code, "Failed to mount logical volumes.");
	     end;
     end check_restrictions;
%page;
/**** Note -- caller supplies request_data */

locate_request:
     entry (Sci_ptr, Request_name, Request_data_ptr, Code);

	declare Request_name	        char (*);
	declare Request_data_ptr	        pointer;

	sci_ptr = Sci_ptr;
	sc_subsystem_info_ptr = ssu_$get_info_ptr (sci_ptr);
	call sc_subsystem_info.real_locate_request (sci_ptr, Request_name, Request_data_ptr, Code);
	if Code ^= 0
	then return;

	request_data_ptr = Request_data_ptr;
	call check_restrictions;			/* can we execute this? */
	if sc_request_flags.dont_parse_arguments
	then call ssu_$abort_line (sci_ptr, 0,
		"The ^a command was found in an invalid context.  Special^/"
		|| "commands may only occur at the beginning of lines.", request_data.full_name);
	return;

/* format: off */
%page; %include as_data_;
%page; %include installation_parms;
%page; %include mc_anstbl;
%page; %include sc_stat_;
%page; %include sc_subsystem_info_;
%page; %include "_ssu_sci";
%page; %include "_ssu_request_data";

     end sc_execute_command_line_;




		    sc_get_error_name_.pl1          11/11/89  1102.8rew 11/11/89  0806.8       11961



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

/* procedure used to replace ssu_$get_subsystem_and_request_name */
/* format: style2,idind30 */

/* Created 1984-12, BIM */


/****^  HISTORY COMMENTS:
  1) change(87-02-07,GDixon), approve(87-05-25,MCR7680),
     audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055):
     Modified to correct coding standard violations.
                                                   END HISTORY COMMENTS */


sc_get_error_name_:
     procedure (SCI_ptr) returns (char (72) varying);

	declare SCI_ptr		        pointer;

	dcl     (addr, rtrim)	        builtin;

	call ssu_check_sci (SCI_ptr);
	sci_ptr = SCI_ptr;
	if ^sci.executing_request
	then return ("system_control");
	else return (rtrim (sci.request_data_ptr -> request_data.full_name));

%include "_ssu_sci";

%include "_ssu_check_sci";

%include "_ssu_request_data";

     end sc_get_error_name_;




		    sc_init_.pl1                    10/17/90  1139.3rew 10/17/90  1137.5      250659



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1990   *
        *                                                         *
        * 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,idind30 */

sc_init_:
     procedure ();

/* SC_INIT_ - initialize system control */
/* probably removed from system_control_ by THVV sometime in the dim past.
   Updated to remove tty console support for new iox_, April 1981, Benson I. Margulies */
/* Changed to heed iox_ error codes for all streams, August 1981, E. N. Kittlitz */
/* added back >unb to search rules after it was backed out once. 8/26/81 Holmstedt */
/* pit_ refname added Benson I. Margulies 81/12. */
/* call_bce change Keith Loepere 8/83 */
/* 09/23/84 by R. Michael Tague:  Set up handler for system_shutdown_scheduled_
   and dm_system_shutdown_ IPS signals */
/* Modified 1984-10-08 BIM for demise of communications */
/* Modified 1984-10-27 by E. Swenson to rename >sc1>admin_log to >sc1>as_logs
   since this is what sc_stat_$log_dir says this directory is supposed to be
   called. */
/* Modified 1984-11-01 BIM for ssu_ */
/* 12/11/84 by R. Michael Tague:  Changed to use dm_misc_util_$shutdown_handler
   for the dm_system_shutodown_ IPS signal. */
/* Modified 1985-01-15, BIM: fixed to use syserr, not sys_log_, before
   as log is available. */
/* Modified 1985-03-27, E. Swenson: for forced emergency listener. */
/* Modified 1985-04-16, EJ Sharpe: for attempting log salvage on bad logs */

/****^  HISTORY COMMENTS:
  1) change(85-11-27,Herbst), approve(87-05-25,MCR7680),
     audit(87-01-08,GDixon), install(87-08-04,MR12.1-1055):
     Added static handler for system_message_.
  2) change(86-05-13,GJohnson), approve(86-05-13,MCR7387),
     audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056):
     Correct error message documentation.
  3) change(86-06-27,Swenson), approve(87-05-25,MCR7680),
     audit(87-01-08,GDixon), install(87-08-04,MR12.1-1055):
     Modified to support a test system control environment.
  4) change(86-12-03,Fawcett), approve(87-05-25,MCR7680),
     audit(87-01-08,GDixon), install(87-08-04,MR12.1-1055):
     Merged 2) with 1) & 3) DSA to MR12 conversion.
  5) change(87-01-08,GDixon), approve(87-01-08,PBF7479),
     audit(87-01-08,Fawcett), install(87-01-12,MR12.0-1268):
     Make Initializer properly handle asynchronous event call channels (to
     prevent wkp_ signals from causing as_dumps).
  6) change(87-02-06,GDixon), approve(87-05-25,MCR7680),
     audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055):
     Replace calls to the nonexistent kill_sc_process_ subroutine with calls to
     hphcs_$syserr_error_code.  Corrected error message documentation, and
     code which creates log and admin_log if they are not found.  Correct
     coding standard violations.
  7) change(90-09-24,Schroth), approve(90-09-24,MCR8212), audit(90-10-10,Vu),
     install(90-10-17,MR12.4-1047):
     Correct possible fatal linkage error if booting nosc.
                                                   END HISTORY COMMENTS */
%page;

/* DECLARATION OF EXTERNAL SYMBOLS */

	dcl     active_all_rings_data$initializer_tty
				        ext char (32);
						/* TTY channel ID for operator tty from boot deck. */
	dcl     active_all_rings_data$initializer_dim
				        ext char (32);
						/* always ocd_ */


/* DECLARATION OF BUILTIN FUNCTIONS */

	dcl     (addr, codeptr, hbound, max, null, rtrim, substr, unspec)
				        builtin;

/* Entries */

	dcl     com_err_		        entry () options (variable);
	dcl     config_$find	        entry (char (4) aligned, ptr);
	dcl     copy_on_write_handler_        entry ();
	dcl     cu_$cl		        entry options (variable);
	dcl     dm_misc_util_$shutdown_handler
				        entry ();
	dcl     get_pdir_		        entry () returns (char (168));
	dcl     hcs_$append_branchx	        entry (char (*), char (*), fixed bin (5), (3) fixed bin (3), char (*),
				        fixed bin (1), fixed bin (1), fixed bin (24), fixed bin (35));
	dcl     hcs_$chname_file	        entry (char (*), char (*), char (*), char (*), fixed bin (35));
	dcl     hcs_$fs_search_set_wdir       entry (char (*), fixed bin (35));
	dcl     hcs_$initiate	        entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr,
				        fixed bin (35));
	dcl     hcs_$initiate_search_rules    entry (ptr, fixed bin (35));
	dcl     hcs_$status_minf	        entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24),
				        fixed bin (35));
	dcl     hphcs_$call_bce	        entry;
	dcl     hphcs_$set_mask_ring	        entry;
	dcl     hphcs_$syserr	        entry options (variable);
	dcl     hphcs_$syserr_error_code      entry options (variable);
	dcl     ioa_		        entry () options (variable);
	dcl     ioa_$rsnnl		        entry () options (variable);
	dcl     iox_$init_standard_iocbs      entry;
	dcl     log_salvage_	        entry (char (*), char (*), ptr, fixed bin (35));
	dcl     log_write_$open	        entry (character (*), character (*), bit (1) aligned, pointer,
				        fixed binary (35));
	dcl     pathname_		        entry (char (*), char (*)) returns (char (168));
	dcl     pl1_resignaller_$establish_handlers
				        entry;
	dcl     sc_create_sci_	        entry (pointer, fixed binary (35));
	dcl     sct_manager_$set	        entry (fixed bin, entry, fixed bin (35));
	dcl     ssu_$get_info_ptr	        entry (ptr) returns (ptr);
	dcl     system_message_handler_       entry ();
	dcl     timer_manager_$cpu_time_interrupt
				        entry ();
	dcl     timer_manager_$alarm_interrupt
				        entry ();
	dcl     system_shutdown_handler_      entry ();
	dcl     wkp_signal_handler_	        entry ();
	dcl     unique_chars_	        entry (bit (*)) returns (char (15));

	dcl     (
	        error_table_$noentry,
	        error_table_$notadir
	        )			        fixed bin (35) ext static;

/* DECLARATION OF AUTOMATIC STORAGE VARIABLES */

	dcl     atd		        char (200); /* Attach description for master console */
	dcl     1 auto_log_salvage_arg        aligned like log_salvage_arg;
	dcl     code		        fixed bin (35);
						/* iox errcode */
	dcl     invoke_emergency_listener     bit (1);	/* should emergency listener be invoked */
	dcl     log_salv_code	        fixed bin (35);
						/* returned from log_salvage_ */
	dcl     log_salv_err_cnt	        fixed bin;	/* count of errors occurring on each log */
	dcl     log_salv_name	        char (32);	/* name of log being salvaged */
	dcl     type		        fixed bin (2);
						/* for status_minf */

/* Constant */

/* Here are the search rules used by the initializer process. */

	dcl     1 search_rules	        int static options (constant) aligned,
						/* The search rules structure from SWS */
		2 number		        fixed bin init (7),
		2 dirs		        (7) char (168)
				        init ("initiated_segments", "referencing_dir", "working_dir",
				        ">system_library_standard", ">system_library_1", ">system_library_tools",
						/* Important. answering service & opr cons */
				        ">system_library_unbundled");
						/* bound_mcs_init_ */

	declare DIR_RINGS		        (3) fixed bin (3) init (4, 5, 5) int static options (constant);
	dcl     ME		        char (32) initial ("sc_init_") internal static options (constant);
%page;
/* Program */

	invoke_emergency_listener = INVOKE_EMERGENCY_LISTENER ();
	if ^sc_stat_$test_mode
	then do;
		call pl1_resignaller_$establish_handlers;
		call sct_manager_$set (cput_sct_index, timer_manager_$cpu_time_interrupt, code);
		call sct_manager_$set (alrm_sct_index, timer_manager_$alarm_interrupt, code);
		call sct_manager_$set (no_write_permission_sct_index, copy_on_write_handler_, code);
		call sct_manager_$set (not_in_write_bracket_sct_index, copy_on_write_handler_, code);
		call sct_manager_$set (wkp_sct_index, wkp_signal_handler_, code);
		if ^invoke_emergency_listener
		then do;
			call sct_manager_$set (system_shutdown_scheduled_sct_index, system_shutdown_handler_, code);
			call sct_manager_$set (dm_shutdown_scheduled_sct_index, dm_misc_util_$shutdown_handler,
			     code);
			call sct_manager_$set (system_message_sct_index, system_message_handler_, code);
		     end;
	     end;

	code = 0;					/* ignore it */
	begin;
	     declare pp			   pointer;
	     pp = null ();
	     call hcs_$initiate (get_pdir_ (), "pit", "pit_", (0), (0), pp, code);
						/* the refname is important */
	     if pp = null ()
	     then do while ("1"b);
		     if ^sc_stat_$test_mode
		     then do;
			     call hphcs_$syserr_error_code (BEEP, code,
				"sc_init_: Could not initiate the PIT for the Initializer.");
			     call hphcs_$call_bce;
			end;
		     else do;
			     call com_err_ (code, ME, "Could not initiate the PIT for the Initializer.");
			     call cu_$cl ();
			end;
		end;
	     code = 0;
	end;

/**** make sure we are in >sc1 */
	call hcs_$fs_search_set_wdir ((sc_stat_$sysdir), code);
	if code ^= 0
	then if ^sc_stat_$test_mode
	     then call hphcs_$syserr_error_code (BEEP, code, "sc_init_: Could not set working directory to ^a.",
		     sc_stat_$sysdir);
	     else call com_err_ (code, ME, "Could not set working directory to ^a.", sc_stat_$sysdir);

	if sc_stat_$test_mode
	then do;
		call iox_$find_iocb ("master_i/o", sc_stat_$master_iocb, code);
		if code ^= 0
		then do;
			call com_err_ (code, ME, "Could not create master_i/o switch.");
			return;
		     end;
		call iox_$close (iox_$user_io, code);
		if code ^= 0
		then do;
			call com_err_ (code, ME, "Could not close user_i/o switch.");
			return;
		     end;
/**** Can't print an error message if any of these fail.  */
		call iox_$move_attach (iox_$user_io, sc_stat_$master_iocb, code);
		call iox_$open (sc_stat_$master_iocb, Stream_input_output, ""b, code);
		call iox_$attach_ptr (iox_$user_io, "syn_ master_i/o", codeptr (sc_init_), code);
	     end;
	else do;
		call hphcs_$set_mask_ring;		/* Set "initial ring" to 4 so timer_manager_ work */
		call hcs_$initiate_search_rules (addr (search_rules), code);
		if code ^= 0
		then call hphcs_$syserr_error_code (BEEP, code, "sc_init_: Error from initiate_search_rules");

		call iox_$init_standard_iocbs;
/**** sc_stat_$master_channel is only declared as a char(6) while
      active_all_rings_data$initializer_tty is declared char(32).  Note
      that the value of these character strings is always "otw_". */
		sc_stat_$master_channel = substr (active_all_rings_data$initializer_tty, 1, 6);

		atd = rtrim (active_all_rings_data$initializer_dim) || " " || sc_stat_$master_channel;
		call iox_$attach_name ("master_i/o", sc_stat_$master_iocb, atd, codeptr (sc_init_), code);
		if code ^= 0
		then call hphcs_$syserr_error_code (CRASH, code, "sc_init_: Error from iox_$attach master_i/o ^a",
			atd);			/* attach to console. */
		call iox_$open (sc_stat_$master_iocb, Stream_input_output, ""b, code);
		if code ^= 0
		then call hphcs_$syserr_error_code (CRASH, code,
			"sc_init_: Error from iox_$open master_i/o stream_input_output");

		call iox_$attach_name ("user_i/o", iox_$user_io, "syn_ master_i/o", codeptr (sc_init_), code);
		if code ^= 0
		then call hphcs_$syserr_error_code (CRASH, code,
			"sc_init_: Error from iox_$attach user_i/o syn_ master_i/o");
	     end;

/**** Here we check to see if the "nosc" parameter was specified on
      the BCE boot command line.  If so, we invoke the emergency
      listener.  This is useful in case we have problems with the
      logging software later on. */

	if invoke_emergency_listener
	then do;
		call hphcs_$syserr (BEEP,
		     "sc_init_: Invoking emergency listener because ""nosc"" parameter specified.");
		call EMERGENCY_LISTENER ();
	     end;

	call iox_$attach_name ("severity3", sc_stat_$sv3_iocb, "syn_ user_i/o", codeptr (sc_init_), code);
	if code ^= 0
	then go to SEVERITY_ERROR;
	call iox_$attach_name ("severity2", sc_stat_$sv2_iocb, "syn_ user_i/o", codeptr (sc_init_), code);
	if code ^= 0
	then go to SEVERITY_ERROR;
	call iox_$attach_name ("severity1", sc_stat_$sv1_iocb, "syn_ user_i/o", codeptr (sc_init_), code);
	if code ^= 0
	then go to SEVERITY_ERROR;

	call hcs_$status_minf (sc_stat_$sysdir, "as_logs", 1, type, (0), code);
	if code = 0 & type ^= 2
	then code = error_table_$notadir;
	if code ^= 0
	then do;
		if ^sc_stat_$test_mode
		then call hphcs_$syserr_error_code (BEEP, code,
			"sc_init_: ^a>as_logs does not exist or is not a directory.", sc_stat_$sysdir);
		else call com_err_ (code, ME, "^a>as_logs does not exist or is not a directory.", sc_stat_$sysdir);

		call hcs_$chname_file (sc_stat_$sysdir, "as_logs", "as_logs", "as_logs." || unique_chars_ (""b), code)
		     ;				/* rename if its there */
		if code = 0
		then if ^sc_stat_$test_mode
		     then call hphcs_$syserr (ANNOUNCE, "sc_init_: Renamed non-directory object ^a>as_logs.",
			     sc_stat_$sysdir);
		     else call com_err_ (code, ME, "Renamed non-directory object ^a>as_logs.", sc_stat_$sysdir);

		call hcs_$append_branchx (sc_stat_$sysdir, "as_logs", SMA_ACCESS_BIN, DIR_RINGS, "*.SysDaemon.*", 1,
		     0, 0, code);
		if code = 0
		then if ^sc_stat_$test_mode
		     then call hphcs_$syserr (ANNOUNCE, "sc_init_: Created ^a>as_logs", sc_stat_$sysdir);
		     else call ioa_ ("^a: Created ^a>as_logs.", ME, sc_stat_$sysdir);
	     end;

	sc_stat_$as_log_write_ptr = null ();
	call log_write_$open (sc_stat_$log_dir, "log", "0"b /* don't create */, sc_stat_$as_log_write_ptr, code);
	if code ^= 0
	then do;
		if code ^= error_table_$noentry
		then do;
			log_salv_err_cnt = 0;	/* for the benefit of ... */
			log_salv_name = "log";	/* ... print_log_salv_error */
			unspec (auto_log_salvage_arg) = ""b;
			log_salvage_arg_ptr = addr (auto_log_salvage_arg);
			log_salvage_arg.version = LOG_SALVAGE_ARG_VERSION_1;
			log_salvage_arg.reporter_proc = print_log_salv_error;
			call log_salvage_ (sc_stat_$log_dir, log_salv_name, log_salvage_arg_ptr, log_salv_code);
		     end;
		else log_salv_code = 0;
		if log_salv_code = 0
		then do;				/* try again */
			call log_write_$open (sc_stat_$log_dir, "log", "1"b /* create */, sc_stat_$as_log_write_ptr,
			     code);
		     end;
		if code ^= 0
		then do;				/* still didn't fly */
			if ^sc_stat_$test_mode
			then call hphcs_$syserr_error_code (BEEP, code,
				"sc_init_: Failed to open the AS log (^a>log).", sc_stat_$log_dir);
			else call com_err_ (code, ME, "Failed to open the AS log (^a>log).", sc_stat_$log_dir);
			call EMERGENCY_LISTENER;
		     end;

	     end;

/**** At this point we probably could use sys_log_, but syserr is surer */

	call ioa_$rsnnl ("log_output_ ^a>admin_log -no_create", atd, (0), sc_stat_$log_dir);
	sc_stat_$admin_log_iocb = null ();
	call iox_$attach_name ("admin_log_", sc_stat_$admin_log_iocb, (atd), codeptr (sc_init_), code);
	if code ^= 0				/* switches are set, we can sys_log_ */
	then do;
		if ^sc_stat_$test_mode
		then call hphcs_$syserr_error_code (BEEP, code, "sc_init_: Failed to attach admin_log log.");
		else call com_err_ (code, ME, "Failed to attach admin_log log.");
		call EMERGENCY_LISTENER;
	     end;

	call iox_$open (sc_stat_$admin_log_iocb, Stream_output, "1"b, code);
	if code ^= 0
	then do;
		if code ^= error_table_$noentry
		then do;
			log_salv_err_cnt = 0;	/* for the benefit of ... */
			log_salv_name = "admin_log";	/* ... print_log_salv_error */
			unspec (auto_log_salvage_arg) = ""b;
			log_salvage_arg_ptr = addr (auto_log_salvage_arg);
			log_salvage_arg.version = LOG_SALVAGE_ARG_VERSION_1;
			log_salvage_arg.reporter_proc = print_log_salv_error;
			call log_salvage_ (sc_stat_$log_dir, log_salv_name, log_salvage_arg_ptr, log_salv_code);
		     end;
		else log_salv_code = 0;
		if log_salv_code = 0
		then do;				/* try again */
			call iox_$detach_iocb (sc_stat_$admin_log_iocb, (0));
			sc_stat_$admin_log_iocb = null ();
			call ioa_$rsnnl ("log_output_ ^a>admin_log -create", atd, (0), sc_stat_$log_dir);
			call iox_$attach_name ("admin_log_", sc_stat_$admin_log_iocb, (atd), codeptr (sc_init_),
			     code);
			if code ^= 0		/* switches are set, we can sys_log_ */
			then do;
				if ^sc_stat_$test_mode
				then call hphcs_$syserr_error_code (BEEP, code,
					"sc_init_: Failed to attach admin_log log.");
				else call com_err_ (code, ME, "Failed to attach admin_log log.");
				call EMERGENCY_LISTENER;
			     end;
			call iox_$open (sc_stat_$admin_log_iocb, Stream_output, "1"b, code);
		     end;
		if code ^= 0
		then do;				/* still didn't fly */
			if ^sc_stat_$test_mode
			then call hphcs_$syserr_error_code (BEEP, code, "sc_init_: Failed to open admin_log log.");
			else call com_err_ (code, ME, "Failed to open admin_log log.");
			call iox_$detach_iocb (sc_stat_$admin_log_iocb, (0));
			call EMERGENCY_LISTENER;
		     end;
	     end;
	call iox_$control (sc_stat_$admin_log_iocb, "get_log_write_data_ptr", addr (sc_stat_$admin_log_write_ptr), code)
	     ;
	if code ^= 0
	then do;
		if ^sc_stat_$test_mode
		then call hphcs_$syserr_error_code (BEEP, code,
			"sc_init_: Failed to get log_write_ ptr for admin_log.");
		else call com_err_ (code, ME, "Failed to get log_write_ ptr for admin_log.");
		call EMERGENCY_LISTENER;
	     end;

	call sc_create_sci_ (sc_stat_$master_sci_ptr, code);
	if code ^= 0
	then do;
		if ^sc_stat_$test_mode
		then call hphcs_$syserr_error_code (BEEP, code,
			"sc_init_: Failed to create ssu invocation for system control.");
		else call com_err_ (code, ME, "Failed to create ssu invocation for system control.");
		call EMERGENCY_LISTENER;
	     end;

	sc_subsystem_info_ptr = ssu_$get_info_ptr (sc_stat_$master_sci_ptr);
	sc_subsystem_info.source_name = "otw_";
	sc_subsystem_info.real_iocb = sc_stat_$master_iocb;
	sc_subsystem_info.the_system_console = "1"b;
	return;

SEVERITY_ERROR:
	if ^sc_stat_$test_mode
	then call hphcs_$syserr (BEEP, "sc_init_: Failed to attach one of the severityN (1, 2, 3) switches.");
	else call com_err_ (code, ME, "Failed to attach one of the severityN (1, 2, 3) switches.");
	call EMERGENCY_LISTENER;
	return;
%page;
print_log_salv_error:
     procedure (P_msg);

	dcl     P_msg		        char (*) parameter;
	dcl     msg		        char (1024) varying;

	msg = P_msg;

	log_salv_err_cnt = log_salv_err_cnt + 1;

	if log_salv_err_cnt = 1
	then if ^sc_stat_$test_mode
	     then call hphcs_$syserr (SYSERR_PRINT_ON_CONSOLE, "sc_init_: Messages from log salvage of ^a:",
		     pathname_ (sc_stat_$log_dir, log_salv_name));
	     else call com_err_ (code, ME, "Messages from log salvage of ^a:",
		     pathname_ (sc_stat_$log_dir, log_salv_name));
	if ^sc_stat_$test_mode
	then call hphcs_$syserr (SYSERR_PRINT_ON_CONSOLE, "sc_init_ (log_salvage_): ^a", msg);
	else call com_err_ (code, ME, "^a", msg);
	return;
     end print_log_salv_error;

EMERGENCY_LISTENER:
     procedure;

/**** We have enough I/O switches for a primitive ADMIN mode. */

	declare default_error_handler_$wall   entry;
	declare any_other		        condition;
	declare listen_		        entry (character (*) var);

	on any_other call default_error_handler_$wall;

	call ioa_ ("sc_init_: A serious error was encountered setting up the system control");
	call ioa_ (" environment. The system will attempt to establish a Multics");
	call ioa_ (" listener level. You should repair the problem, and then type:");
	call ioa_ ("     ""hphcs_$shutdown"", and reboot the system.");


	call listen_ ("");
     end EMERGENCY_LISTENER;
%page;
INVOKE_EMERGENCY_LISTENER:
     procedure () returns (bit (1) aligned);

	dcl     i			        fixed bin;	/* loop index */

	if sc_stat_$test_mode
	then return ("0"b);
	intk_cardp = null ();
	call config_$find (INTK_CARD_WORD, intk_cardp);
	if intk_cardp = null ()
	then /* no INTK card? */
	     return ("0"b);				/* then no emergency listener */

/**** INTK card found, check for "nosc" parameter */

	do i = 1 to hbound (intk_card_array.parms, 1);
	     if intk_card.parms (i) = "nosc"
	     then return ("1"b);			/* yes, it was specified */
	end;

	return ("0"b);				/* parameter not found */

     end INVOKE_EMERGENCY_LISTENER;

/* format: off */
%page; %include access_mode_values;
%page; %include config_intk_card;
%page; %include iox_entries;
%page; %include iox_modes;
%page; %include log_salvage_arg;
%page; %include sc_stat_;
%page; %include sc_subsystem_info_;
%page; %include sys_log_constants;
%page; %include syserr_constants;
%page; %include static_handlers;
/* format: on */
%page;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   sc_init_:  ERROR_MESSAGE.  Error from iox_$attach master_i/o ATD

   S: $crash

   T: $init

   M: Some error was detected while attaching the master_i/o switch.
   ATD is the text of the attach description.  This error is usually caused
   by a hardware failure in the operator's console.  Correct the failure
   and reboot the system.

   A: $contact


   Message:
   sc_init_:  ERROR_MESSAGE.  Error from iox_$open master_i/o stream_input_output

   S: $crash

   T: $init

   M: Some error was detected while opening the master_i/o switch.
   This is usually caused by a hardware failure in the operator's console.
   Correct the failure and reboot the system.

   A: $contact

   Message:
   sc_init_:  ERROR_MESSAGE.  Error from iox_$attach user_i/o syn_ master_i/o

   S: $crash

   T: $init

   M: Some error was detected while attaching user_i/o as a synonym for the
   master_i/o switch in the Initializer process.  This is usually caused by a 
   hardware failure in the operator's console.  Correct the failure and reboot
   the system.

   A: $contact


   Message:
   sc_init_:  Invoking emergency listener because "nosc" parameter specified.

   S: $info

   T: $init

   M: The parm config card specified nosc (no system control).  This parameter
   requests that an emergency listener be entered to allow repair of >sc1 or
   other parts of the system hierarchy at the earliest possible point during 
   system initialization.  Once the repairs are made, shutdown the system by
   typing:  "hphcs_$shutdown" and then reboot the system.

   A: Repair the problem, shutdown the system, then reboot.


   Message:
   sc_init_:  Messages from log salvage of LOG_PATHNAME:

   S: $info

   T: $init

   M: Some error was detected in opening the admin or answering service
   log specified by LOG_PATHNAME.  A salvage was invoked to attempt
   correction of the problem.  One or more messages will succeed this
   message which describe inconsistancies found in the log, repairs
   which were made, or conditions which prevent automatic repair.
   These will be of the form "sc_init_: (log_salvage_) MESSAGE".

   A: $contact


   Message:
   sc_init_: Failed to attach one of the severityN (1, 2, 3) switches.

   S: $info

   T: $init

   M: The Initializer failed to make a syn_ for one of the three switches
   severity1, severity2, or severity3. There may be a problem with the
   system tape, the libraries, or the hardware.

   A: The system attempts to enter a primitive listener environment on
   the bootload console. You should diagnose and/or correct the problem
   and then reboot the system.

  
   Message: 
   sc_init_: A serious error was encountered setting up the system control
   environment. The system will attempt to establish a Multics
   listener level. You should repair the problem, and then type:
         "hphcs_$shutdown", and reboot the system.

   S: $info
 
   T: $init

   A: $contact


   Message:
   sc_init_: Cound not initiate the PIT for the Initializer.

   S:    $crash

   T:    $init

   M:    The Initializer has failed to initiate the segment "pit" in its
   process directory.  This could indicate problems with the bootload
   tape, the online libraries, or the hardware.

   A:    $contact


   Message:
   sc_init_: ERROR_MESSAGE.  Error from initiate_search_rules.

   S:	$beep

   T:	$init

   M:	The Initializer is attempting to set its search rules
   and has encountered an error.  This message may occur
   if an error has been introduced into the system tape,
   or it may indicate that one of the directories searched
   by the Initializer has been destroyed.

   A:	$contact

   Message:
   sc_init_: ERROR_MESSAGE.  Could not set working directory to PATH.

   S:     $beep

   T:	$init

   M:	Either some program is in error, or the directory
   PATH does not exist.

   A:	$contact
   Correct the problem, shut down, and reboot.


   Message:
   sc_init_: ERROR_MESSAGE.  >system_control_dir>as_logs does not exist or is not a directory.

   S:  $beep

   T:  $init

   M:  The directory >sc1>as_logs must exist for the ring 4 environment to
   be set up. 

   A:  The system continues operation, trying to repair the situation. 
   Subsequent messages indicate the success or failure of repairs.


   Message:
   sc_init_: Created >system_control_dir>as_logs

   S:  $beep

   T:  $init

   M:  The system has successfully created a new directory >sc1>as_logs.

   A: $ignore
   If this is not the first bootload of the system under MR11 or later,
   you may need to retrieve log segments lost in a crash into the new
   directory.


   Message:
   sc_init_: Renamed non-directory object >system_control_dir>as_logs.

   S:  $beep

   T:  $init

   M:  The system found something that was not a directory in the place
   of the directory >sc1>as_logs, and renamed it to permit a new directory
   to be created.

   A: $ignore


   Message:
   sc_init_: ERROR_MESSAGE.  Failed to attach admin_log log.

   S:  $beep

   T:  $init

   M:  The system failed to attach a switch to write information to the 
   admin log, >sc1>as_logs>admin_log. The segment >sc1>as_logs>admin_log may be
   damaged. The system enters a primitive Multics listener on the bootload
   console.

   A:  Repair the problem. You may have to delete or rename the segment
   >sc1>as_logs>admin_log.   Then shutdown and reboot.

   Message:
   sc_init_:  ERROR_MESSAGE.  Failed to open admin_log log.

   S:  $beep

   T:  $init

   M: The system failed to iox open the switch for the log >sc1>as_logs>admin_log.
   The segment >sc1>as_logs>admin_log may be damaged. The system enters
   a primitive Multics listener on the bootload console.   

   A:  Repair the problem.
   You may need to rename or delete the segment >sc1>as_logs>admin_log.
   Then shutdown and reboot.


   Message:
   sc_init_: ERROR_MESSAGE.  Failed to get log_write_ ptr for admin_log.

   S:  $beep

   T:  $init

   M:  This indicated an internal programming error. The online libraries
   may be damaged.

   A:  $contact


   Message:
   sc_init_: ERROR_MESSAGE.  Failed to open the AS log (>system_control_dir>as_logs>log).

   S:  $beep

   T:  $init

   M:  The system was unable to open the log >sc1>as_logs>log. This may 
   indicate damage to the segment >sc1>as_logs>log. The system enters a 
   primitive Multics listener on the bootload console.

   A:  Repair the problem. You may have to rename or delete >sc1>as_logs>log.
   Then shutdown and reboot.


   Message:
   sc_init_: Failed to create ssu invocation for system control.

   S:  $beep

   T:  $init

   M:  The system failed to set up the subsystem data structure for
   the bootload console. This indicates a programming error or trouble
   with the system libraries.

   A:  $contact

   END MESSAGE DOCUMENTATION */

     end sc_init_;




		    sc_ipc_mask_.pl1                11/11/89  1102.8r w 11/11/89  0807.4       14931



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */
/* sc_ipc_mask_.pl1 -- utility for getting to a guaranteed mask. */
/* format: style2 */

/* Modification history:
   Created 1984-12-05 BIM */

/**** NOTE: Normally, the AS runs masked while executing commands.
      it unmasks when it is executing an exec_com or entering admin mode,
      on the theory that the control point will not block in the middle
      of a database update. When sc_command is used signals are masked
      again for the duration. */


sc_ipc_mask_$unmask:
     procedure (P_remask_count);

	declare P_remask_count	 fixed bin;
	declare code		 fixed bin (35);

	declare ipc_$unmask_ev_calls	 entry (fixed bin (35));
	declare ipc_$mask_ev_calls	 entry (fixed bin (35));

	P_remask_count = 0;
	code = 0;
	do while (code = 0);
	     call ipc_$unmask_ev_calls (code);
	     if code = 0
	     then P_remask_count = P_remask_count + 1;
	end;
	return;

sc_ipc_mask_$remask:
     entry (P_remask_count);

	declare remask_count_up	 fixed bin;

	do remask_count_up = 1 to P_remask_count;	/* PL/I copies the limit */
	     call ipc_$mask_ev_calls ((0));
	     P_remask_count = P_remask_count - 1;	/* so this is safe */
	end;
	return;
     end sc_ipc_mask_$unmask;




		    sc_process_command_line_.pl1    11/11/89  1102.8rew 11/11/89  0809.2      160650



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

/* format: style2,idind30,indcomtxt */

/**** sc_process_command_line_.pl1

      THIS
      program is the common interface for all parts of the Initializer
      that read command lines from operators. It is responsible for
      creating an environment that mimics a normal user process
      and then executing the command line in that environment.

      FIRST
      it sets up the I/O switches, saves the old value of
      sc_stat_$admin_sci_ptr, and sets sc_stat_$admin_sci_ptr
      to the given sci_ptr. It sets user_i/o to signal_io_.
      The sc_signal_io_handler_ established in system_control_
      is depended on to handle I/O signals. sc_subsystem_info.real_iocb
      is assumed to be correct.

      SEND_ADMIN_COMMAND
      calls the special multics_command entrypoint which calls
      cu_$cp instead of ssu_$execute_line.

      SC_COMMAND
      does not call this. It assumes that it is called either in
      admin mode, which is entered through this program, or in
      the admin exec com, which is also entered via this program.
      sc_command call ssu_ directly.


      MASKING
      This program does not mask event calls. The rule for masking event
      calls is that the Initializer may never run an event_call handler
      while in one of its subsystems, for fear of recursion. initializer
      commands are presumed to enter the environment that requires this
      protection. Multics commands are not. Thus, masking takes place
      in sc_execute_command_line_ before entering the command, rather
      then in here.

      MEMOS
      and the like may NEVER be used in the Initializer process.
      when the alarm call handler goes off there is no code that will
      establish the correct environment.

      PROBE and DEBUG
      establish similiar limitations. Since there is a user_i/o
      (the system console) outside of this environment, careful use can
      be made to work.

      HISTORICAL NOTE
      This procedure includes the previous contents of admin_mode_,
      borrow_tty_from_mc_, and return_tty_to_mc_.
*/

sc_process_command_line_:
     procedure (SCI_ptr, Line_ptr, Line_lth);

/* Written 1984-10-26 BIM */
/* Modified 1985-01-07, BIM: MC access control, access name in sc_subsystem_info_ */
/* Modified 1985-01-30, E. Swenson: Fixed operator login. */
/* Modified 1985-04-01, E. Swenson: to do sign_out on hangup in mc_tty_. */
/* Modified 1985-04-05, E. Swenson: to handle abort_lines correctly and to
   not log extra NL in admin_log. */


/****^  HISTORY COMMENTS:
  1) change(86-08-01,Cox), approve(87-05-25,MCR7690), audit(87-03-13,GDixon),
     install(87-08-04,MR12.1-1055):
     Modified for change to mc_anstbl.incl.pl1.
  2) change(86-08-03,Swenson), approve(87-05-25,MCR7680),
     audit(87-03-13,GDixon), install(87-08-04,MR12.1-1055):
     Also changed to support system_control_ test mode.
  3) change(87-02-05,GDixon), approve(87-05-25,MCR7680),
     audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055):
     Also added System Message Documentation for calls to syserr and sys_log_.
     Made minor changes to improve code efficiency.
                                                   END HISTORY COMMENTS */


	declare SCI_ptr		        pointer;
	declare Line_ptr		        pointer;
	declare Line_lth		        fixed bin (21);

	declare code		        fixed bin (35);
	declare (ev_calls_masked_code, ev_calls_unmasked_code)
				        fixed bin (35);
	declare hungup		        bit (1) aligned;
	declare line_ptr		        pointer;
	declare line_lth		        fixed bin (21);
	declare multics_switch	        bit (1) aligned;
	declare old_mask		        bit (36) aligned;
	declare old_operator_name	        char (32);
	declare request_line	        char (line_lth) based (line_ptr);
	declare saved_user_io	        pointer;
	declare saved_user_input	        pointer;
	declare saved_error_output	        pointer;
	declare saved_user_output	        pointer;
	declare saved_admin_sci_ptr	        pointer;
	declare sci_ptr		        pointer;
	declare switch_unique	        char (30);
	declare test_switch		        bit (1) aligned;

/* Entries */

	dcl     com_err_		        entry () options (variable);
	declare continue_to_signal_	        entry (fixed binary (35));
	declare cu_$cp		        entry (ptr, fixed bin (21), fixed bin (35));
	declare hcs_$wakeup		        entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
	declare hcs_$set_ips_mask	        entry (bit (36) aligned, bit (36) aligned);
	declare hcs_$reset_ips_mask	        entry (bit (36) aligned, bit (36) aligned);
	declare hphcs_$syserr_error_code      entry options (variable);
	declare hphcs_$syserr	        entry options (variable);
	declare ioa_$ioa_switch	        entry () options (variable);
	declare iox_$init_standard_iocbs      entry;
	declare ipc_$decl_ev_wait_chn	        entry (fixed bin (71), fixed bin (35));
	declare ipc_$decl_event_call_chn      entry (fixed bin (71), entry, pointer, fixed bin, fixed bin (35));
	declare lg_ctl_$logout_operator       entry (ptr, char (*), char (*));
	declare mc_commands_$note_input       entry (char (*), pointer, fixed binary (35));

	declare mc_commands_$sign_out	        entry (pointer, character (*), fixed binary (35));
	declare ssu_$get_info_ptr	        entry (ptr) returns (ptr);
	declare ssu_$execute_line	        entry (ptr, ptr, fixed bin (21), fixed bin (35));
	declare sys_log_		        entry options (variable);
	declare unique_chars_	        entry (bit (*)) returns (char (15));

	dcl     ME		        char (32) initial ("sc_process_command_line_") internal static
				        options (constant);
	dcl     NL		        char (1) int static options (constant) init ("
");
	declare cleanup		        condition;
	declare any_other		        condition;

	dcl     addr		        builtin;
	dcl     clock		        builtin;
	dcl     codeptr		        builtin;
	dcl     null		        builtin;
	dcl     rtrim		        builtin;
	dcl     substr		        builtin;
%page;

	test_switch = "0"b;
	multics_switch = "0"b;
	go to COMMON;

/**** The test entrypoint does switches for a normal user process. */

test:
     entry (SCI_ptr, Line_ptr, Line_lth);

	multics_switch = "0"b;
	test_switch = "1"b;
	go to COMMON;

test_multics:
     entry (SCI_ptr, Line_ptr, Line_lth);

	multics_switch = "1"b;
	test_switch = "1"b;
	go to COMMON;

multics_command:
     entry (SCI_ptr, Line_ptr, Line_lth);

/**** SCI is required for Multics to find the real IOCB pointer. */

	multics_switch = "1"b;
	test_switch = "0"b;
COMMON:
	sci_ptr = SCI_ptr;
	line_ptr = Line_ptr;
	line_lth = Line_lth;
	code = 0;

	sc_subsystem_info_ptr = ssu_$get_info_ptr (sci_ptr);
	saved_admin_sci_ptr = sc_stat_$admin_sci_ptr;
	switch_unique = "sc" || unique_chars_ (""b);
	saved_user_io, saved_user_input, saved_user_output, saved_error_output = null ();
	ev_calls_masked_code = -1;
	ev_calls_unmasked_code = -1;
	on cleanup
	     begin;
		call RESTORE_ATTACHMENTS;
		sc_stat_$admin_sci_ptr = saved_admin_sci_ptr;
	     end;

	mc_atep = sc_subsystem_info.mc_atep;		/* this may be null */
	sc_subsystem_info.printer_offed = "0"b;		/* log suppression is only permitted within a command line */

/**** Depend on the system_control_ handler for signal_io_, which uses
      sc_stat_$admin_sci_ptr to find the right real_iocb. */

	call SAVE_ATTACHMENTS;			/* we could assume correct switches and */
						/* just depend on having the top signal handler. */
						/* this, however, saves us from file_output */

	sc_stat_$admin_sci_ptr = sci_ptr;

	if sc_stat_$mc_is_on & mc_atep ^= null ()
	then do;
		call mc_commands_$note_input (request_line, mc_atep, (0));
						/* broadcast input around */
		if mc_ate.signed_on & sc_stat_$Multics
		then do;
			if clock ()
			     > mc_ate.last_input_time
			     + (as_data_$rs_ptrs (0) -> installation_parms.operator_inactive_time * 1000 * 1000)
			then do;			/* passed the deadline, tough bananas */
				call mc_commands_$sign_out (mc_atep, old_operator_name, (0));
				sc_subsystem_info.access_control_name = sc_stat_$unidentified_access_name;
				call lg_ctl_$logout_operator (sc_subsystem_info_ptr, old_operator_name,
				     "autologout");

				call ioa_$ioa_switch (sc_subsystem_info.real_iocb,
				     "**********^2/     Operator ^a signed off due to inactivity.^2/**********^/",
				     old_operator_name);
			     end;
		     end;
		mc_ate.last_input_time = clock ();
	     end;

	if ^sc_subsystem_info.no_real_tty & mc_atep ^= null ()
						/* don't bother if sci has no associated terminal, assume caller logs */
	then do;					/* log in both logs for easy reading */
		call sys_log_ (SL_LOG_SILENT, " (input on ^a) ^a", mc_ate.real_tty_name, request_line);
		call ioa_$ioa_switch (sc_stat_$admin_log_iocb, " (input on ^a) ^a", mc_ate.real_tty_name,
		     rtrim (request_line, NL));
	     end;					/* and log it */

	sc_subsystem_info.hangup_entry = HANGUP;
	sc_subsystem_info.abort_request_label = ABORT_LABEL;
	hungup = "0"b;
	if multics_switch
	then call cu_$cp (line_ptr, line_lth, code);
	else do;
		call ssu_$execute_line (sci_ptr, line_ptr, line_lth, code);
		if sc_subsystem_info.real_iocb ^= null () & sc_subsystem_info.print_ready
		then do;
			if ^sc_stat_$Multics
			then call ioa_$ioa_switch (sc_subsystem_info.real_iocb, "Ready");
			else call ioa_$ioa_switch (sc_subsystem_info.real_iocb,
				"Ready^[ (^a)^;^s^]^[ (Not signed on.)^]", mc_ate.signed_on, mc_ate.personid,
				as_data_$rs_ptrs (0) -> installation_parms.require_operator_login
				& ^mc_ate.signed_on);
		     end;
	     end;

ABORT_LABEL:
	sc_stat_$admin_sci_ptr = saved_admin_sci_ptr;
	call RESTORE_ATTACHMENTS;
	if hungup
	then call sys_log_ (SL_LOG_BEEP, "sc_process_command_line_: Terminal ^a hung up during execution of command.",
		sc_subsystem_info.source_name);
	return;

HANGUP:
     procedure;

/**** unwind the entire command execution and return to the frame that
      started this command. */

	go to HANGUP_UNWIND;
     end HANGUP;

HANGUP_UNWIND:
	hungup = "1"b;
	go to ABORT_LABEL;
%page;
SAVE_ATTACHMENTS:
     procedure;

	old_mask = ""b;
	on any_other call ERROR_MASKED;

	call hcs_$set_ips_mask (""b, old_mask);

	if test_switch
	then do;					/* our caller is expected to have a signal_io_handler_ active */
		call iox_$find_iocb ("real_i/o", real_iocb, (0));
		call iox_$move_attach (iox_$user_io, real_iocb, (0));
		call iox_$attach_ptr (iox_$user_io, "syn_ real_iocb", codeptr (sc_process_command_line_), (0));
		sc_subsystem_info.real_iocb = real_iocb;
	     end;

	call save_switch (iox_$user_io, saved_user_io, "user_i/o");
	call save_switch (iox_$user_input, saved_user_input, "user_input");
	call save_switch (iox_$user_output, saved_user_output, "user_output");
	call save_switch (iox_$error_output, saved_error_output, "error_output");

	call attach_switch (iox_$user_io, "signal_io_");
	call iox_$init_standard_iocbs;		/* attaches syn_'s */

	if mc_atep ^= null ()
	then if ^mc_ate.the_system_console
	     then call ipc_$decl_ev_wait_chn (mc_ate.event, (0));

	call hcs_$reset_ips_mask (old_mask, old_mask);
     end SAVE_ATTACHMENTS;

RESTORE_ATTACHMENTS:
     procedure;

	on any_other call ERROR_MASKED;
	call hcs_$set_ips_mask (""b, old_mask);

	call restore_switch (saved_user_io, iox_$user_io);
	call restore_switch (saved_user_input, iox_$user_input);
	call restore_switch (saved_user_output, iox_$user_output);
	call restore_switch (saved_error_output, iox_$error_output);

	if test_switch
	then do;
		call iox_$detach_iocb (iox_$user_io, (0));
		call iox_$move_attach (real_iocb, iox_$user_io, (0));
		call iox_$destroy_iocb (real_iocb, (0));
	     end;
	else do;
		if mc_atep ^= null ()
		then if ^mc_ate.the_system_console
		     then do;
			     mc_ansp = sc_stat_$mc_ansp;
			     call ipc_$decl_event_call_chn (mc_ate.event, mc_anstbl.cons_cont_proc, addr (mc_ate),
				MC_PRIO, (0));
			     call hcs_$wakeup (mc_anstbl.mc_procid, mc_ate.queue_event, 0, code);
			end;
	     end;
	call hcs_$reset_ips_mask (old_mask, old_mask);
	return;
     end RESTORE_ATTACHMENTS;

save_switch:
     procedure (live_iocb, save_iocb, iocb_name);

	declare (live_iocb, save_iocb)        pointer;
	declare iocb_name		        char (32) varying;
	declare save_name		        char (32);

	save_name = rtrim (switch_unique) || iocb_name;
	call iox_$find_iocb (save_name, save_iocb, code);
	if code ^= 0
	then do;
		if ^sc_stat_$test_mode
		then call hphcs_$syserr_error_code (CRASH, code, "^a: Failed to find save iocb ^a.", ME, save_name);
		else call com_err_ (code, ME, "Failed to find save iocb ^a.", save_name);
	     end;
	call iox_$close (save_iocb, (0));
	call iox_$detach_iocb (save_iocb, (0));
	call iox_$move_attach (live_iocb, save_iocb, code);
	if code ^= 0
	then do;
		if ^sc_stat_$test_mode
		then call hphcs_$syserr_error_code (CRASH, code, "^a: Failed to move_attach iocb ^a.", ME, save_name);
		else call com_err_ (code, ME, "Failed to move_attach iocb ^a.", save_name);
	     end;
	return;
     end save_switch;

attach_switch:
     procedure (iocbp, atd);

	declare iocbp		        pointer;
	declare atd		        char (*);

	call iox_$attach_ptr (iocbp, atd, codeptr (sc_process_command_line_), code);
	if code ^= 0
	then do;
		if ^sc_stat_$test_mode
		then call hphcs_$syserr_error_code (CRASH, code,
			"^a: Could not attach switch ^a (@ ^p)^/using attach description: ^a.", ME,
			iocbp -> iocb.name, iocbp, atd);
		else call com_err_ (code, ME, "Could not attach switch ^a (@ ^p)^/using attach description: ^a.",
			iocbp -> iocb.name, iocbp, atd);
	     end;
	call iox_$open (iocbp, Stream_input_output, "0"b, code);
	if code ^= 0
	then do;
		if ^sc_stat_$test_mode
		then call hphcs_$syserr_error_code (CRASH, code,
			"^a: Could not open switch ^a for stream_input_output.", ME, iocbp -> iocb.name);
		else call com_err_ (code, ME, "Could not open switch ^a for stream_input_output.", iocbp -> iocb.name)
			;
	     end;
	return;
     end attach_switch;

restore_switch:
     procedure (saved_iocb, live_iocb);

	declare (saved_iocb, live_iocb)       pointer;

	call iox_$close (live_iocb, (0));
	call iox_$detach_iocb (live_iocb, (0));
	call iox_$move_attach (saved_iocb, live_iocb, code);
	if code ^= 0
	then do;
		if ^sc_stat_$test_mode
		then call hphcs_$syserr_error_code (CRASH, code, "^a: Could not restore attachment to switch ^a.", ME,
			live_iocb -> iocb.name);
		else call com_err_ (code, ME, "Could not restore attachment to switch ^a.", live_iocb -> iocb.name);
	     end;
	call iox_$destroy_iocb (saved_iocb, (0));
	return;
     end restore_switch;


ERROR_MASKED:
     procedure;

	if substr (old_mask, 36, 1) = "0"b
	then call continue_to_signal_ ((0));
	else do;
		if ^sc_stat_$test_mode
		then call hphcs_$syserr (CRASH, "^a: Error while reattaching critical I/O switches.", ME);
		else call com_err_ (0, ME, "Error while reattaching critical I/O switches.");
	     end;
	return;
     end ERROR_MASKED;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   (input on SWITCH_NAME) REQUEST_LINE

   S:	as (severity 0)

   T:	$response

   M:	Logs a REQUEST_LINE typed by the operator, or by another user via
   the send_admin_command or send_initializer_command commands.

   A:	$ignore

   Message:
   sc_process_command_line_: Terminal SOURCE_NAME hung up during execution of
   command.

   S:	as (severity 2)

   T:	$response

   M:	Reports that execution of an Initializer command was interrupted when
   the message coordinator terminal identified by SOURCE_NAME hung.

   A:	$ignore

   Message:
   sc_process_command_line_: ERROR_MESSAGE.  Failed to find save iocb NAME.

   S:	$sc

   T:	$response

   M:	$crashes  $err  ERROR_MESSAGE is the expansion of the system status
   code describing the actual error.

   A:	$contact

   Message:
   sc_process_command_line_: ERROR_MESSAGE.  Failed to move_attach iocb NAME.

   S:	$sc

   T:	$response

   M:	$crashes  $err  ERROR_MESSAGE is the expansion of the system status
   code describing the actual error.

   A:	$contact

   Message:
   sc_process_command_line_: ERROR_MESSAGE.  Could not attach switch NAME
   (@ LOC) using attach description DESCRIP.

   S:	$sc

   T:	$response

   M:	$crashes  $err  ERROR_MESSAGE is the expansion of the system status
   code describing the attach error.  LOC gives the location of the
   I/O Control Block (IOCB).

   A:	$contact

   Message:
   sc_process_command_line_: ERROR_MESSAGE.  Could not open switch NAME for
   stream_input_output.

   S:	$sc

   T:	$response

   M:	$crashes  $err  ERROR_MESSAGE is the expansion of the system status
   code describing the open error.

   A:	$contact

   Message:
   sc_process_command_line_: ERROR_MESSAGE.  Could not restore attachment to
   switch NAME.

   S:	$sc

   T:	$response

   M:	$crashes  $err  ERROR_MESSAGE is the expansion of the system status
   code describing the move_attach error.

   A:	$contact

   Message:
   sc_process_command_line_: Error while reattaching critical I/O switches.

   S:	$sc

   T:	$response

   M:	$crashes  $err

   A:	$contact

   END MESSAGE DOCUMENTATION */

%include as_data_;

%include as_wakeup_priorities;

%include installation_parms;
	declare ip		        pointer;

%include iocb;

%include iox_entries;

%include iox_modes;

%include mc_anstbl;

%include sc_stat_;

%include sc_subsystem_info_;

%include sys_log_constants;

%include syserr_constants;

     end sc_process_command_line_;




		    sc_request_table_.alm           11/11/89  1102.8rew 11/11/89  0807.4      169344



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

" HISTORY COMMENTS:
"  1) change(84-12-01,Margulies), approve(), audit(), install():
"     Initially written.
"  2) change(85-01-15,Swenson), approve(), audit(), install():
"     Correct "no_start_up" request.
"  3) change(85-04-01,Swenson), approve(), audit(), install():
"     Have "." not require sign_on and not require the AS to be started for
"     the stop_mpx command.
"  4) change(85-04-17,Swenson), approve(), audit(), install():
"     to fix masking problems.
"  5) change(86-01-09,MSharpe), approve(87-06-10,MCR7690),
"     audit(87-06-11,Parisek), install(87-08-04,MR12.1-1055):
"     Changed to find mc commands, process commands, and com_channel commands
"     in the newly created programs that hold them. (these commands were
"     previously in admin_).
"  6) change(86-01-09,Fawcett), approve(86-03-28,MCR7359),
"     audit(86-04-25,Lippard), install(86-09-16,MR12.0-1159):
"     Add requests lock_mca and unlock_mca.
"  7) change(86-04-30,GDixon), approve(86-09-26,MCR7499),
"     audit(86-10-10,Beattie), install(86-10-13,MR12.0-1182):
"     Allow the abs request to work prior to starting of the Answering Service
"     (ie, while at Standard level).
"  8) change(86-12-02,Fawcett), approve(87-06-10,MCR7690),
"     audit(87-06-11,Parisek), install(87-08-04,MR12.1-1055):
"     Merged 6) & 7) into the code for 5, DSA to MR12 convertion.
"  9) change(87-03-26,Lippard), approve(87-04-27,MCR7673),
"     audit(87-05-15,Fawcett), install(87-05-26,MR12.1-1036):
"     Add set_time_zone.
" 10) change(88-04-14,Farley), approve(88-05-26,MCR7880),
"     audit(88-05-31,Parisek), install(88-07-05,MR12.2-1052):
"     Added list_lv_attachments (llva) request.
"                                                      END HISTORY COMMENTS

" request table for system control environment

          name      sc_request_table_
          include   ssu_request_macros

          macro     obsolete_request

          request   &1,&2,(&3),(),(flags.dont_summarize,flags.dont_list,flags.allow_command),(sc_flags.obsolete,&4)
&end

          macro     obsolete_multics_request

          multics_request     &1,(&2),(),&3,(flags.dont_summarize,flags.dont_list,flags.allow_command),(sc_flags.obsolete,&4)
&end

	macro	admin_request
multics_request	&1,(&3),(&4),&2,(&5),(&6)
&end



" see sc_subsystem_info_.incl.pl1 and mc_restriction_codes.incl.pl1
" for definition of the following bits.

          bool      sc_flags.dont_parse_arguments,400000
          bool      sc_flags.obsolete,200000
          bool      sc_flags.dont_mask_calls,100000
          bool      sc_flags.requires_as,040000
          bool      sc_flags.requires_no_as,020000
          bool      sc_flags.complete_disks_first,010000
          bool      sc_flags.no_login_needed,004000
          bool      sc_flags.r_master_console,000001
          bool      sc_flags.r_as_control,000002
          bool      sc_flags.r_reset_sc,000003
          bool      sc_flags.r_reply,000004
          bool      sc_flags.r_edit_motd,000005
          bool      sc_flags.r_intercom,000006
          bool      sc_flags.r_mpx_control,000007
	bool	sc_flags.r_admin_mode,000010
          bool      sc_flags.r_rcp_control,000022
          bool      sc_flags.r_reconfig_system,000023
          bool      sc_flags.r_dump,000024
          bool      sc_flags.r_exec,000025
          bool      sc_flags.r_status,000026
          bool      sc_flags.r_daemon_control,000027
          bool      sc_flags.r_loginword,000030
          bool      sc_flags.r_mod_sysid,000031
          bool      sc_flags.r_down_ok,000032
          bool      sc_flags.r_warning,000033
          bool      sc_flags.r_set_maxu,000034
          bool      sc_flags.r_channel_control,000035
          bool      sc_flags.r_bump_user,000036
          bool      sc_flags.r_route_messages,000037
          bool      sc_flags.r_abs_control,000040


          begin_table         system_control_requests

          set_default_flags   (flags.allow_command),
                              (sc_flags.requires_as)

          set_default_multics_flags (flags.allow_command),
                              (sc_flags.requires_as)


admin_request abs,admin_$abs,(),
          (Control the absentee facility.),
          (default),
          (sc_flags.r_abs_control)

admin_request accept,operator_mc_cmds_$accept,(),
          (Accept a channel as a message coordinator terminal.),
          (default),
          (default,sc_flags.r_route_messages)

admin_request accept_vchn,operator_mc_cmds_$accept_vchn,(),
          (Accept a message coordinator virtual channel.),
          (default),
          (default,sc_flags.r_route_messages)

multics_request     add_lv,(alv),
          (Mount a logical volume for use.),
          disk_table_$mount_hvol,
          (default),
          (sc_flags.r_master_console)

multics_request   add_vol,(av),
          (Inform the system of the location of a physical volume.),
          disk_table_$accept,
          (default),
          (sc_flags.r_master_console)

request   admin,sc_admin_mode_$sc_admin_mode_,(),
          (Enter admin mode.),
          (default),
          (sc_flags.r_admin_mode,sc_flags.dont_mask_calls)

admin_request attach,operator_com_channel_cmds_$attach,(),
          (Attach a communications channel for use.),
          (default),
          (default,sc_flags.r_channel_control)

request   bce,sc_requests_$bce,(),
          (Return to BCE.),
          (default),
          (sc_flags.r_master_console)

admin_request bump,operator_process_cmds_$bump,(),
          (Bump an interactive user from the system.),
          (default),
          (default,sc_flags.r_as_control)

request   cripple,sc_requests_$cripple,(),
          (Stop the Answering Service in preparation for database reloads.),
          (default,flags.dont_summarize,flags.dont_list),
          (default,sc_flags.r_as_control)

multics_request     del_lv,(dlv),
          (Demount a logical volume.),
          disk_table_$demount_hvol,
          (default),
          (sc_flags.r_master_console)

multics_request     del_vol,(dv),
          (Demount a physical volume.),
          disk_table_$remove,
          (default),
	(sc_flags.r_master_console)

admin_request define,operator_mc_cmds_$define,(),
          (Define a new virtual console, or add a disposition to an existing one.),
          (default),
          (default,sc_flags.r_route_messages)

admin_request deroute,operator_mc_cmds_$deroute,(),
          (Remove a routine of a source stream.),
          (default),
          (default,sc_flags.r_route_messages)

admin_request detach,operator_process_cmds_$detach,(),
          (Forcibly detach a communications channel from a user.),
          (default),
          (default,sc_flags.r_channel_control)

admin_request down,admin_$down,(),
          (Sets, cancels, or prints the scheduled shutdown time.),
          (default),
          (default,sc_flags.r_down_ok)

admin_request drop,operator_mc_cmds_$drop,(),
          (Drop a channel from use as a message coordinator terminal.),
          (default),
          (default,sc_flags.r_route_messages)

request   exec,sc_exec_request_$sc_exec_request_,(x),
          (Executes an extended command.),
          (default),
          (sc_flags.r_exec)

request   force_reset,sc_requests_$force_reset,(),
          (Force reset Answering Service locks and masks.),
          (default),
          (sc_flags.r_reset_sc,sc_flags.dont_mask_calls)

request   go,sc_requests_$go,(),
          (Start answering lines.),
          (default),
          (default,sc_flags.r_as_control)

multics_request     hmu,(),
          (Prints the number of users logged in.),
          as_who$hmu,
          (default),
          (default,sc_flags.r_status)

multics_request     init_vol,(),
          (Initialize a new physical volume.),
          disk_table_$initialize_disk,
          (default),
          (sc_flags.r_master_console)

request   intercom,sc_requests_$intercom,(ic),
          (Send a message to another message coordinator terminal.),
          (default),
          (default,sc_flags.dont_parse_arguments,sc_flags.r_intercom)

multics_request     list_disks,(ld),
          (Status of all disk drives.),
          disk_table_$list,
          (default),
          (sc_flags.r_status)

multics_request     list_lv_attachments,(llva),
          (Status of logical volume attachments.),
          lv_request_$attach_list,
          (default),
          (sc_flags.r_status)

multics_request     list_vols,(lsv),
          (Status of storage system volumes.),
          list_vols$list_vols,
          (default),
          (sc_flags.r_status)

admin_request login,admin_$login,(logi),
          (Logs in a daemon process.),
          (default),
          (default,sc_flags.r_daemon_control)

admin_request logout,admin_$logout,(logo),
          (Logs out a daemon process.),
          (default),
          (default,sc_flags.r_daemon_control)

admin_request maxunits,admin_$maxunits,(maxu),
          (Set the maximum number of users who may login.),
          (default),
          (default,sc_flags.r_set_maxu)

multics_request   mc_list,(),
          (Lists message coordinator information.),
          mc_list$mc_list,
          (default),
          (default,sc_flags.r_status)

request   message,sc_requests_$message,(motd),
          (Edit the message of the day.),
          (default),
          (sc_flags.r_edit_motd)

request   multics,sc_requests_$multics,(mult),
          (Initialize the Answering Service for a special session.),
          (default),
          (sc_flags.requires_no_as,sc_flags.complete_disks_first,sc_flags.r_master_console)

request   no_start_up,sc_requests_$no_start_up,(ns),
          (Disables execution of the system_start_up exec_com.),
          (default),
          (sc_flags.requires_no_as,sc_flags.r_master_console)

request	quit,sc_requests_$quit,(),
	(Send a quit signal to a daemon process.),
	(default),
	(default,sc_flags.r_reply)

admin_request rcp,admin_$rcp,(),
          (Control RCP.),
          (default),
          (default,sc_flags.r_rcp_control)

request   reply,sc_requests_$reply,(r),
          (Send input to a daemon process.),
          (default),
          (default,sc_flags.dont_parse_arguments+sc_flags.r_reply)

admin_request reroute,operator_mc_cmds_$reroute,(),
          (Change the routing of a source stream.),
          (default),
          (default,sc_flags.r_route_messages)

admin_request route,operator_mc_cmds_$route,(),
          (Route a source stream to a virtual console.),
          (default),
          (default,sc_flags.r_route_messages)

request	sign_off,sc_requests_$sign_off,(),
	(Sign out as operator.),
	(default),
	(default)

request	sign_on,sc_requests_$sign_on,(),
	(Sign in as operator.),
	(default),
	(default,sc_flags.no_login_needed,sc_flags.dont_mask_calls)

admin_request redefine,operator_mc_cmds_$redefine,(),
          (Replace the disposition of a virtual console.),
          (default),
          (default,sc_flags.r_route_messages)

admin_request remove,operator_com_channel_cmds_$remove,(),
          (Remove a channel from use.),
          (default),
          (default,sc_flags.r_channel_control)

request   reset,sc_requests_$reset,(),
          (Reset some Answering Service locks and masks.),
          (default),
          (default,sc_flags.r_reset_sc)

multics_request     salvage_vol,(),
          (Physical volume salvage a volume.),
          salv_caller$packsalv,
          (default),
          (sc_flags.r_master_console)

request	set_time_zone,sc_requests_$set_time_zone,(stz),
	(Set the system time zone.),
	(default),
	(sc_flags.r_master_console)

request   shutdown,sc_requests_$shutdown,(shut),
          (Shut down the system.),
          (default),
          (sc_flags.r_master_console,sc_flags.dont_mask_calls)

request   startup,sc_requests_$startup,(star),
          (Start the Answering Service and begin answering lines.),
          (default),
          (sc_flags.requires_no_as,sc_flags.complete_disks_first,sc_flags.r_master_console)

admin_request stop,admin_$stop,(),
          (Bump users in preparation for system shutdown.),
          (default),
          (default,sc_flags.r_down_ok)

admin_request substty,operator_mc_cmds_$substty,(),
          (Substitute one message coordinator terminal for another.),
          (default),
          (default,sc_flags.r_route_messages)

admin_request sysid,admin_$sysid,(),
          (Changes the system ID.),
          (default),
          (default,sc_flags.r_mod_sysid)

admin_request terminate,operator_process_cmds_$terminate,(),
          (Forcibly terminate a process.),
          (default),
          (default,sc_flags.r_as_control)

admin_request unbump,operator_process_cmds_$unbump,(),
          (Cancel a bump of an interactive user.),
          (default),
          (default,sc_flags.r_as_control)

admin_request undefine,operator_mc_cmds_$undefine,(),
          (Remove a disposition from a virtual console.),
          (default),
          (default,sc_flags.r_route_messages)

obsolete_multics_request    load_fnp,,admin_$load_fnp,
          (default,sc_flags.r_mpx_control)

obsolete_multics_request    fdump_fnp,,admin_$fdump_fnp,
          (default,sc_flags.r_mpx_control)

obsolete_multics_request    start_fnp,,admin_$start_fnp,
          (default,sc_flags.r_mpx_control)

obsolete_multics_request    stop_fnp,,admin_$stop_fnp,
          (default,sc_flags.r_mpx_control)

multics_request     set_drive_usage,(sdu),
          (Change a disk between user I/O and Storage System use.),
          disk_table_$io_ss_reconfig,
          (default),
          (sc_flags.r_master_console)

multics_request     preload,(),
          (Preload a disk or tape volume.),
          rcp_op_cmnd_$preload,
          (default),
          (sc_flags.r_rcp_control)

multics_request     unload,(),
          (Unload a disk or tape volume.),
          rcp_op_cmnd_$unload,
          (default),
          (sc_flags.r_rcp_control)

obsolete_multics_request    dump_fnp,,admin_$dump_fnp,
          (default,sc_flags.r_mpx_control)

admin_request load_mpx,admin_$load_mpx,(),
          (Loads a multiplexer.),
          (default),
          (default,sc_flags.r_mpx_control)

admin_request dump_mpx,admin_$dump_mpx,(),
          (Dumps a multiplexer.),
          (default),
          (default,sc_flags.r_mpx_control)

admin_request start_mpx,admin_$start_mpx,(),
          (Starts a multiplexer.),
          (default),
          (default,sc_flags.r_mpx_control)

admin_request stop_mpx,admin_$stop_mpx,(),
          (Stops a multiplexer from accepting new calls.),
          (default),
          (sc_flags.r_mpx_control)

multics_request     add_pdir_volume,(),
          (Adds a logical volume to the set of pdir volumes.),
          pdir_volume_manager_$add_pdv,
          (default),
          (sc_flags.r_master_console)

multics_request     del_pdir_volume,(),
          (Deletes a logical volume from the set of pdir volumes.),
          pdir_volume_manager_$del_pdv,
          (default),
          (sc_flags.r_master_console)

multics_request     set_pdir_volumes,(),
          (Specifies the set of pdir logical volumes.),
          pdir_volume_manager_$set_pdv,
          (default),
          (sc_flags.r_master_console)

admin_request log,admin_$log,(),
          (Adds a message to the system log.),
          (default),
          (0)

admin_request shift,admin_$shift,(),
          (Changes the shift.),
          (default),
          (default,sc_flags.r_as_control)

admin_request disconnect,operator_process_cmds_$disconnect,(),
          (Forcibly disconnects a user from their terminal.),
          (default),
          (default,sc_flags.r_as_control)

multics_request     vacate_pdir_volume,(),
          (Moves all user process directories off of a logical volume.),
          pdir_volume_manager_$vac_pdv,
          (default),
          (default,sc_flags.r_master_console)

admin_request shutdown_mpx,admin_$shutdown_mpx,(),
          (Shuts down a multiplexer without dumping it.),
          (default),
          (default,sc_flags.r_mpx_control)

request   reconfigure,reconfigure$sc_reconfigure_request,(rcf),
	(Reconfigures system hardware.),
	(default),
	(sc_flags.r_reconfig_system)


request   lock_mca,lock_mca$sc_lock_mca,(),
	(Disable input to the MCAs.),
	(default),
	(sc_flags.r_reconfig_system)

request   unlock_mca,lock_mca$sc_unlock_mca,(),
	(Enable input to a selected MCA.),
	(default),
	(sc_flags.r_reconfig_system)

admin_request warn,admin_$warn,(w),
          (Sends a warning blast to a user.),
          (default),
          (default,sc_flags.r_as_control)

multics_request     who,(),
          (Lists logged in user.),
          as_who$long,
          (default),
          (default,sc_flags.r_status)

admin_request word,admin_$word,(),
          (Changes the login word and banner message.),
          (default),
          (default,sc_flags.r_loginword)

request	.,sc_requests_$self_identify,
	(),
	(Identify the signed-on operator.),
	(default),
	(sc_flags.no_login_needed)

request	help,ssu_requests_$help,
	(),
	(Obtain information on the operator commands.),
	(default),
	(sc_flags.dont_mask_calls)
		
obsolete_multics_request      addmain,,obs_reconfigure$addmain,
          (sc_flags.r_master_console)

obsolete_multics_request      addcpu,,obs_reconfigure$addcpu,
          (sc_flags.r_master_console)

obsolete_multics_request      addmem,,obs_reconfigure$addmem,
          (sc_flags.r_master_console)

obsolete_multics_request      adddev,,reconfigure_rcp$add_device,
          (sc_flags.r_master_console)

obsolete_multics_request      delmain,,obs_reconfigure$delmain,
          (sc_flags.r_master_console)

obsolete_multics_request      delcpu,,obs_reconfigure$delcpu,
          (sc_flags.r_master_console)

obsolete_multics_request      delmem,,obs_reconfigure$delmem,
          (sc_flags.r_master_console)

obsolete_multics_request      deldev,,reconfigure_rcp$del_device,
          (sc_flags.r_master_console)

	unknown_request	abbrev,(ab)
	unknown_request	execute,(e)
	unknown_request	exec_com,(ec)
	unknown_request	if
	unknown_request	ready,(rdy)
	unknown_request	ready_on,(rdn)
	unknown_request	ready_off,(rdf)
	unknown_request     subsystem_name
	unknown_request     subsystem_version
	unknown_request	debug_mode

          end_table system_control_requests
          end




		    sc_requests_.pl1                11/11/89  1102.8rew 11/11/89  0809.2      187020



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

/* format: style2 */

sc_requests_:
     procedure;

/**** SC_REQUESTS_
      ssu requests for the the system control subsystem.

      This program used to be execute_sc_command_.

      The smarts about setting up environments went to 
      sc_process_command_line_, and the commands landed here.  

      WHEN
      this procedure is entered, all I/O switches are correctly
      set up to allow reading and writing (or, in the case of sac,
      to abort appropriately).

      ALL
      the commands in here can be written as if they were executing
      in a normal user environment, just like the ones in admin_.

      THIS 
      procedure did not used to mask event calls, in spite of the
      clear requirement that anything that could conceivable block
      do so. Masking now takes place in sc_process_command_line_.
*/

/****
   Modified 01/82     B. I. Margulies. answer yes sc_command shut.
   Modified 01/02/82  E. N. Kittlitz.  added sc_stat_$Go.
   Modified 5/82	  E. N. Kittlitz.  New AS initialization.
   Modified 12/82	  E. N. Kittlitz.  Version 2 communications segment. encrypt admin password.
   Modified 1/83	  E. N. Kittlitz.  handle finish in admin mode.
   Modified 8/83	  K. Loepere       call_bce.
   Modified 1/84	  K. Loepere       make qedx_ the message editor.
   Rewritten for ssu_ 1984-10-26 BIM
   Modified 1985-01-08, BIM: mc access control, fix operator login for boot star.
   Modified 1985-01-28, E. Swenson: to call lg_ctl_ for login/logout messages.
   Modified 1985-01-29, E. Swenson: to fix operator login for boot star.
   Modified 1985-02-18, E. Swenson: to fix operator login for other problems.
*/

/****^  HISTORY COMMENTS:
  1) change(86-08-01,Cox), approve(87-05-25,MCR7690), audit(87-03-16,GDixon),
     install(87-08-03,MR12.1-1055):
     Modified to support virtual MC terminals.
  2) change(87-02-05,GDixon), approve(87-05-25,MCR7690),
     audit(87-05-06,Parisek), install(87-08-03,MR12.1-1055):
     Modified for a change to mc_anstbl.incl.pl1.  Correct coding standard
     violations.
  3) change(87-03-30,Lippard), approve(87-04-27,MCR7673),
     audit(87-05-15,Fawcett), install(87-05-26,MR12.1-1036):
     Added set_time_zone.
  4) change(87-06-10,GDixon), approve(87-04-27,MCR7673),
     audit(87-06-10,Parisek), install(87-08-03,MR12.1-1055):
      A) Merge changes 2 & 3.
      B) Add operator message documentation for the new call to sys_log_ in
         set_time_zone.
  5) change(87-06-23,Parisek), approve(87-06-23,MCR7690),
     audit(87-08-06,GDixon), install(87-08-11,MR12.1-1079):
     Correct an ioa_ control string error.
  6) change(87-07-17,Parisek), approve(87-07-17,MCR7716),
     audit(87-08-07,Fawcett), install(87-08-11,MR12.1-1079):
     Call call_ec_ subroutine instead of exec_com for executing the ssu.ec so
     errors can be detected, displayed and ec will continue execution.
                                                   END HISTORY COMMENTS */

	declare SCI_ptr		 pointer;
	declare SCI_info_ptr	 pointer;

	dcl     al		 fixed bin (21);
	dcl     ap		 pointer;
	dcl     arg_count		 fixed bin;
	dcl     argument		 char (al) based (ap);
	dcl     code		 fixed bin (35);
	dcl     destination		 char (32) varying;
	dcl     found_zone		 bit (1) aligned;
	dcl     lang_index		 fixed bin;
	dcl     message		 char (500);
	dcl     message_length	 fixed bin (21);
	dcl     operator_name	 char (32);
	dcl     old_name		 char (32);
	dcl     old_time_zone	 char (4) aligned;
	dcl     password		 char (8);
	dcl     reason		 char (100);
	dcl     sci_ptr		 pointer;
	dcl     temp_line		 char (500) varying;
	dcl     time_zone		 char (4) aligned;
	dcl     yea_shutdown	 bit (1) aligned;
	dcl     zone_index		 fixed bin;

	dcl     as_$as_init		 entry (fixed bin (35));
	dcl     as_$go		 entry (fixed bin (35));
	dcl     as_$reset		 entry ();
	dcl     as_$shut_ok		 entry (fixed bin (35));
	dcl     as_$startup		 entry (fixed bin (35));
	dcl     command_query_	 entry () options (variable);
	dcl     command_query_$yes_no	 entry options (variable);
	dcl     date_time_$set_zone	 entry (char (*), fixed bin (35));
	dcl     call_ec_		 entry options (variable);
	dcl     hphcs_$call_bce	 entry ();
	dcl     hphcs_$set_system_time_zone
				 entry (char (4) aligned, fixed bin (35));
	dcl     ioa_		 entry () options (variable);
	dcl     ioa_$rs		 entry () options (variable);
	dcl     ipc_$mask_ev_calls	 entry (fixed bin (35));
	dcl     ipc_$unmask_ev_calls	 entry (fixed bin (35));
	dcl     lg_ctl_$login_operator entry (ptr, bit (1) aligned, char (*), char (*));
	dcl     lg_ctl_$logout_operator
				 entry (ptr, char (*), char (*));
	dcl     mc_check_access_$quit	 entry (pointer, character (*), fixed binary (35));
	dcl     mc_check_access_$reply entry (pointer, character (*), fixed binary (35));
	dcl     mc_commands_$intercom	 entry (character (*) var, pointer, fixed bin (21), pointer, fixed binary (35));
	dcl     mc_commands_$quit_command
				 entry (char (*), ptr, fixed bin (35));
	dcl     mc_commands_$reply_command
				 entry (character (*) var, pointer, fixed bin (21), pointer, fixed binary (35));
	dcl     mc_commands_$sign_in	 entry (ptr, char (*), char (*));
	dcl     mc_commands_$sign_out	 entry (ptr, char (*), fixed bin (35));
	dcl     pnt_manager_$login_get_entry
				 entry (char (*), char (*), ptr, fixed bin (35));
	dcl     read_password_	 entry (character (*), character (*));
	dcl     restart_mc_ttys_	 entry;
	dcl     sc_abort_line_util_$real_abort_line
				 entry () options (variable);
	dcl     sc_admin_mode_	 entry;
	dcl     sc_edit_motd_	 entry;
	dcl     sc_ipc_mask_$remask	 entry (fixed binary);
	dcl     sc_ipc_mask_$unmask	 entry (fixed binary);
	dcl     scramble_		 entry (char (8)) returns (char (8));
	dcl     ssu_$abort_line	 entry () options (variable);
	dcl     ssu_$arg_count	 entry (ptr, fixed bin);
	dcl     ssu_$arg_ptr	 entry (ptr, fixed bin, ptr, fixed bin (21));
	dcl     ssu_$print_message	 entry () options (variable);
	dcl     sys_log_		 entry options (variable);
	dcl     sys_info$time_zone	 char (4) aligned ext static;

	dcl    (error_table_$id_not_found,
	        error_table_$noentry,
                  error_table_$unknown_zone)  fixed bin (35) ext static;

	dcl    (after, addr, before, byte, length, ltrim, null, rtrim)
     				 builtin;
	dcl     cleanup		 condition;

	dcl     (
	        GRANTED		 initial ("1"b),
	        DENIED		 initial ("0"b)
	        )			 bit (1) aligned internal static options (constant);

no_start_up:
     entry (SCI_ptr, SCI_info_ptr);
	call setup;

	sc_stat_$did_part1, sc_stat_$did_part2, sc_stat_$did_part3 = "1"b;
	return;

reply:
     entry (SCI_ptr, SCI_info_ptr);
	call setup;

/**** THIS IS A SPECIAL COMMAND -- called with one un-parsed argument. */

	if arg_count = 0
	then call ssu_$abort_line (sci_ptr, 0, "Usage: reply SOURCE LINE");

	call return_in_debug;
	call ssu_$arg_ptr (sci_ptr, 1, ap, al);
	temp_line = rtrim (ltrim (argument));
	destination = before (temp_line, " ");
	if destination = temp_line			/* no argument, all we have is a destination */
	then do;
		destination = temp_line;
		message = byte (10);
		message_length = 1;
	     end;
	else call ioa_$rs ("^a", message, message_length, after (temp_line, " "));

	call mc_check_access_$reply (sc_subsystem_info_ptr, (destination), code);
	if code = error_table_$noentry
	then call ssu_$abort_line (sci_ptr, code, "No MC ACS segment exists for the source ^a.", destination);
	else if code ^= 0
	then call ssu_$abort_line (sci_ptr, code, "Reply not permitted to message coordinator source ^a.", destination);

	call mc_commands_$reply_command (destination, addr (message), message_length, sc_subsystem_info.mc_atep, code);
	if code ^= 0
	then call ssu_$abort_line (sci_ptr, code, "Reply not sent to ^a.", destination);
	return;


admin:
     entry (SCI_ptr, SCI_info_ptr);

	call setup;
	if arg_count > 0
	then call ssu_$abort_line (sci_ptr, 0, "Usage: admin");

	call sc_admin_mode_;			/* sc_stat_ carries all needed parameters */
	return;

bce:
     entry (SCI_ptr, SCI_info_ptr);
	call setup;
	if arg_count > 0
	then call ssu_$abort_line (sci_ptr, 0, "Usage: bce");
	call return_in_debug;
	if ^sc_stat_$test_mode
	then call hphcs_$call_bce;			/* call bce. */
	return;

go:
     entry (SCI_ptr, SCI_info_ptr);

	call setup;

	if arg_count > 0
	then call ssu_$abort_line (sci_ptr, 0, "Usage: go");
	call return_in_debug;

GO_COMMON:
	sc_stat_$Go_typed = "1"b;			/* Indicate 'go' has been requested */
	if ^sc_stat_$did_part2
	then /* Execute system startup, second part. */
	     call call_system_start_up_ec ("part2");
	sc_stat_$did_part2 = "1"b;
	call as_$go (code);				/* Now make all lines answer. */
	if code ^= 0
	then call ssu_$abort_line (sci_ptr, code, "Answering Service startup failed.");

	sc_stat_$Go = "1"b;				/* set the AS listening flag */
	if ^sc_stat_$did_part3
	then /* Execute system startup, third part */
	     call call_system_start_up_ec ("part3");
	sc_stat_$did_part3 = "1"b;
	ip = as_data_$rs_ptrs (0);
	if installation_parms.require_operator_login
	then sc_stat_$no_operator_login = "0"b;		/* Close the gate */
	if installation_parms.vchn_requires_accept
	then sc_stat_$vchn_requires_accept = installation_parms.vchn_requires_accept;
						/* "login personid -op -vchn foo" must be accepted by
						   operator if personid is not signed on system console */
	return;

message:
     entry (SCI_ptr, SCI_info_ptr);			/* edit the MOTD */

	call setup;
	if arg_count > 0
	then call ssu_$abort_line (sci_ptr, 0, "Usage: message");

	call return_in_debug;

	call sc_edit_motd_;
	return;


multics:
     entry (SCI_ptr, SCI_info_ptr);

	call setup;
	if arg_count > 0
	then call ssu_$abort_line (sci_ptr, 0, "Usage: multics");

	call return_in_debug;

	sc_stat_$Multics_typed = "1"b;		/* indicate 'multics' has been requested */
	if ^sc_stat_$did_part1
	then /* Execute initial part of system startup. */
	     call call_system_start_up_ec ("part1");
	sc_stat_$did_part1 = "1"b;
	call as_$as_init (code);			/* Initialize answering service (special session). */

	if code ^= 0
	then call ssu_$abort_line (sci_ptr, code, "Fix problem and retry.");

	sc_stat_$Multics = "1"b;			/* set the Multics-session flag */
	return;


set_time_zone:
     entry (SCI_ptr, SCI_info_ptr);

	call setup;
	if arg_count ^= 1
	then call ssu_$abort_line (sci_ptr, 0, "Usage: stz zone");

	call ssu_$arg_ptr (sci_ptr, 1, ap, al);

	if al > length (time_zone)
	then call ssu_$abort_line (sci_ptr, error_table_$unknown_zone, "^a",
	     argument);

	time_zone = argument;

	found_zone = "0"b;				/* Validate zone.*/
	do lang_index = 1 to ti_zone.number_lang while (^found_zone);
	     do zone_index = 1 to ti_zone.number_zone while (^found_zone);
		if ti_zone.short (lang_index, zone_index) = time_zone
		then found_zone = "1"b;
	     end;					/* zones */
	end;					/* languages */

	if ^found_zone
	then call ssu_$abort_line (sci_ptr, error_table_$unknown_zone, "^a",
	     argument);

	call return_in_debug;

	old_time_zone = sys_info$time_zone;		/* Save old zone */

	call hphcs_$set_system_time_zone (time_zone, code);
	if code ^= 0				/* Set time zone */
	then call ssu_$abort_line (sci_ptr, code, "^a",	/* for the system*/
	     time_zone);

	call date_time_$set_zone ((time_zone), code);	/* Set zone for  */
	if code ^= 0				/* Initializer   */
	then call ssu_$abort_line (sci_ptr, code, "^a", time_zone);

	call sys_log_ (SL_LOG,			/* Log the change*/
	     "^a: Changed time zone from ^a to ^a.",
	     "sc_requests_ (set_time_zone)", old_time_zone, time_zone);
	return;


shutdown:
     entry (SCI_ptr, SCI_info_ptr);

	call setup;
	if arg_count > 0
	then call ssu_$abort_line (sci_ptr, 0, "Usage: shutdown");

	if sc_stat_$Multics
	then do;
		call as_$shut_ok (code);
		if code ^= 0
		then do;
			yea_shutdown = "0"b;
			call command_query_$yes_no (yea_shutdown, (0), "shutdown",
			     "These users will be logged off without any message. Use ""stop"" to warn and bump users",
			     "^d users still on. Do you want to shut down?  ", code);
			if ^yea_shutdown
			then return;
		     end;
	     end;
	go to sc_stat_$system_shutdown_label;

startup:
     entry (SCI_ptr, SCI_info_ptr);
	call setup;
	if arg_count > 0
	then call ssu_$abort_line (sci_ptr, 0, "Usage: startup");

	call return_in_debug;

	sc_stat_$Star_typed = "1"b;			/* indicate that someone typed 'startup'. */
	sc_stat_$Multics_typed = "1"b;
	if ^sc_stat_$did_part1
	then /* Execute first part of system startup */
	     call call_system_start_up_ec ("part1");
	sc_stat_$did_part1 = "1"b;

	call as_$startup (code);			/* Initialize answering service. (normal session) */
	if code ^= 0
	then return;
	sc_stat_$Multics = "1"b;			/* Get here, and library is loaded... */
	go to GO_COMMON;				/* join common code */


force_reset:
     entry (SCI_ptr, SCI_info_ptr);

	call setup;
	if arg_count > 0
	then call ssu_$abort_line (sci_ptr, 0, "Usage: force_reset");
	call return_in_debug;
	if sc_stat_$Multics
	then call as_$reset;
	go to RESET_COMMON;

reset:
     entry (SCI_ptr, SCI_info_ptr);

	call setup;
	if arg_count > 0
	then call ssu_$abort_line (sci_ptr, 0, "Usage: reset");
	call return_in_debug;

RESET_COMMON:
	call iox_$control (sc_stat_$master_iocb, "start", null, code);
	if sc_stat_$mc_is_on
	then call restart_mc_ttys_ ();		/* Kick all typers */
	code = 0;					/* Now get unmasked. */
	do while (code = 0);			/* .. by unmasking repeatedly. */
	     call ipc_$unmask_ev_calls (code);		/* unmask event call channels */
	end;
	return;

cripple:
     entry (SCI_ptr, SCI_info_ptr);
	call setup;
	if arg_count > 0
	then call ssu_$abort_line (sci_ptr, 0, "Usage: cripple");

	call ipc_$mask_ev_calls (code);		/* Stop all ipc signals, no dialups etc. */
	call ssu_$print_message (sci_ptr, 0, "Answering service crippled.");
	return;

intercom:						/** This is a SPECIAL request, called with 1 argument, the message */
     entry (SCI_ptr, SCI_info_ptr);
	call setup;

	if arg_count ^= 1
	then call ssu_$abort_line (sci_ptr, 0, "Usage: intercom DEST TEXT");

	call ssu_$arg_ptr (sci_ptr, 1, ap, al);
	temp_line = rtrim (ltrim (argument));
	destination = before (temp_line, " ");
	if destination = ""
	then do;
		destination = temp_line;
		message = byte (10);
		message_length = 1;
	     end;
	else call ioa_$rs ("^a", message, message_length, after (temp_line, " "));

	call mc_commands_$intercom (destination, addr (message), message_length, sc_subsystem_info.mc_atep, code);
	if code ^= 0
	then call ssu_$abort_line (sci_ptr, code, "Message not sent to ^a.", destination);
	return;

quit:
     entry (SCI_ptr, SCI_info_ptr);
	call setup;

	if arg_count ^= 1
	then call ssu_$abort_line (sci_ptr, 0, "Usage: quit SOURCE");
	call ssu_$arg_ptr (sci_ptr, 1, ap, al);
	call mc_check_access_$quit (sc_subsystem_info_ptr, argument, code);
	if code ^= 0
	then do;
		if code = error_table_$noentry
		then call ssu_$abort_line (sci_ptr, code, "No MC ACS segment for the message coodrinator source ^a.",
			argument);
		else call ssu_$abort_line (sci_ptr, code, "Quit not permitted to message coordinator source ^a.",
			argument);
	     end;
	call mc_commands_$quit_command (argument, sc_subsystem_info.mc_atep, code);
	if code ^= 0
	then call ssu_$abort_line (sci_ptr, code, "No quit signalled to ^a.", argument);
	return;

sign_on:
     entry (SCI_ptr, SCI_info_ptr);

	call setup;
	if arg_count > 1
	then call ssu_$abort_line (sci_ptr, 0, "Usage: sign_on OperatorName");
	if sc_subsystem_info.mc_atep = null ()
	then call sc_abort_line_util_$real_abort_line (sci_ptr, 0,
		"^a is not a terminal, so you cannot log in over it.", sc_subsystem_info.source_name);

	if arg_count = 0
	then do;
		query_info.version = query_info_version_6;
		operator_name = "";
		call command_query_ (addr (query_info), operator_name, "sign_on", "Operator name:");
		if operator_name = "QUIT" | operator_name = "quit"
		then call sc_abort_line_util_$real_abort_line (sci_ptr, 0, "sign_on aborted by quit.");
	     end;
	else do;
		call ssu_$arg_ptr (sci_ptr, 1, ap, al);
		operator_name = argument;
	     end;

	call read_password_ ("Password", password);
	if password = "quit" | password = "QUIT"
	then call sc_abort_line_util_$real_abort_line (sci_ptr, 0, "sign_on aborted by quit.");
	password = scramble_ (password);
	PNTE.version = PNT_ENTRY_VERSION_2;
	reason = "";
	call pnt_manager_$login_get_entry (operator_name, password, addr (PNTE), code);
	if code ^= 0
	then do;
		if code = error_table_$id_not_found
		then reason = "Unregistered name";
		else reason = "Bad password";
	     end;
	else if ^PNTE.flags.operator
	then reason = "Not operator";

	if reason ^= ""
	then do;
		call lg_ctl_$login_operator (sc_subsystem_info_ptr, DENIED, operator_name, reason);
		call sc_abort_line_util_$real_abort_line (sci_ptr, 0, "Login incorrect");
	     end;
	operator_name = PNTE.user_id;
	call mc_commands_$sign_in (sc_subsystem_info.mc_atep, operator_name, old_name);
	if old_name ^= ""
	then do;
		call ssu_$print_message (sci_ptr, 0, "^a signed out as operator.", old_name);
		call lg_ctl_$logout_operator (sc_subsystem_info_ptr, old_name, "sign_on");
	     end;
	sc_subsystem_info.access_control_name = rtrim (operator_name) || ".Operator.o";
	call ssu_$print_message (sci_ptr, 0, "^a signed on as operator on channel ^a.", operator_name,
	     sc_subsystem_info.source_name);
	call lg_ctl_$login_operator (sc_subsystem_info_ptr, GRANTED, operator_name, "sign_on");
	return;

sign_off:
     entry (SCI_ptr, SCI_info_ptr);
	call setup;

	if arg_count ^= 0
	then call ssu_$abort_line (sci_ptr, 0, "Usage: sign_off");
	if sc_subsystem_info.mc_atep = null ()
	then call ssu_$abort_line (sci_ptr, 0, "Not logged in.");
	call mc_commands_$sign_out (sc_subsystem_info.mc_atep, old_name, code);
	if code = 0
	then do;
		call lg_ctl_$logout_operator (sc_subsystem_info_ptr, old_name, "sign_off");
		call ssu_$print_message (sci_ptr, 0, "^a signed off.", old_name);
		sc_subsystem_info.access_control_name = sc_stat_$unidentified_access_name;
	     end;
	else call ssu_$abort_line (sci_ptr, 0, "No one is signed on to ^a.", sc_subsystem_info.source_name);
	return;

self_identify:
     entry (SCI_ptr, SCI_info_ptr);

	call setup;

	/*** Be nice and don't diagnose arguments */

	mc_atep = sc_subsystem_info.mc_atep;
	if mc_atep = null ()
	then call ioa_ ("system_control");
	else do;
		call ioa_ ("system_control:^[ channel ^a^[ (vchannel ^a)^;^s^]^;^3s^] ^[^a^;No operator^s^] signed on.",
		     ^mc_ate.the_system_console, mc_ate.real_tty_name, mc_ate.virtual, mc_ate.virtual_tty_name,
		     mc_ate.signed_on, mc_ate.personid);
	     end;
	return;
setup:
     procedure;

	sci_ptr = SCI_ptr;
	sc_subsystem_info_ptr = SCI_info_ptr;
	call ssu_$arg_count (sci_ptr, arg_count);
	return;
     end setup;

call_system_start_up_ec:
     procedure (P_arg1);

	declare P_arg1		 char (*);
	declare remask_count	 fixed bin;
	declare saved_access_control_name
				 char (32);

	remask_count = 0;
	saved_access_control_name = sc_subsystem_info.access_control_name;
	on cleanup
	     begin;
		call sc_ipc_mask_$remask (remask_count);
		sc_subsystem_info.access_control_name = saved_access_control_name;
	     end;

	call sc_ipc_mask_$unmask (remask_count);
	sc_subsystem_info.access_control_name = sc_stat_$exec_access_name;
	call call_ec_ ("system_start_up", P_arg1);
	call sc_ipc_mask_$remask (remask_count);
	return;
     end call_system_start_up_ec;

return_in_debug:
     procedure;

	declare ssu_$get_debug_mode	 entry (ptr) returns (bit (1) aligned);

	if ssu_$get_debug_mode (sci_ptr)
	then go to RETURN;
	return;
     end return_in_debug;

RETURN:
	return;

 %include as_data_;
 %include installation_parms;
	declare ip		 pointer;		/* req for above */
 %include iox_entries;
 %include mc_anstbl;
 %include pnt_entry;
	declare 1 PNTE		 aligned like pnt_entry;
 %include query_info;
 %include sc_stat_;
 %include sc_subsystem_info_;
 %include sys_log_constants;
 %include syserr_constants;
 %include time_names;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   sc_requests_ (set_time_zone): Changed time zone from OLD_ZONE to NEW_ZONE.

   S:	$sc

   T:	$run

   M:	This messages records that the set_time_zone operator request was
	given, and that the system default time zone was thereby changed 
	from OLD_ZONE to NEW_ZONE.

   A:	$ignore

   END MESSAGE DOCUMENTATION */

     end sc_requests_;




		    sc_shutdown_.pl1                11/11/89  1102.8rew 11/11/89  0809.2       17892



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

/* sc_shutdown_: procedure to shut down AS, SC; called from system_control_ */

/* format: style2,idind30 */

/**** This is a separate procedure so that the admin environment 
      can be completely unwound before it is called. */

/**** Written 1984-11-01 BIM */


/****^  HISTORY COMMENTS:
  1) change(86-08-01,Swenson), approve(87-05-25,MCR7680),
     audit(87-02-07,GDixon), install(87-08-04,MR12.1-1055):
     Avoid calling hphcs_$shutdown when running in system control test mode.
  2) change(87-02-07,GDixon), approve(87-05-25,MCR7680),
     audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055):
     Repair comments, clarify code.
  3) change(87-02-07,GDixon), approve(87-05-25,MCR7678),
     audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055):
     Use timer_manager_constants include file.
                                                   END HISTORY COMMENTS */


sc_shutdown_:
     procedure;

	declare as_$shutdown	        entry;
	declare hphcs_$shutdown	        entry;
	declare timer_manager_$sleep	        entry (fixed binary (71), bit (2));

	if sc_stat_$Multics
	then do;
		sc_stat_$shutdown_typed = "1"b;	/* publish our intention */
		call as_$shutdown;			/* turn off answering service. */
		call timer_manager_$sleep (2, RELATIVE_SECONDS);
						/* Let messages get typed */
	     end;
	if ^sc_stat_$test_mode
	then call hphcs_$shutdown;			/* Shut down file system and traffic control. */
	return;

 %include sc_stat_;
 %include timer_manager_constants;

     end sc_shutdown_;




		    sc_signal_handler_.pl1          11/11/89  1102.8rew 11/11/89  0809.2       47691



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



/****^  HISTORY COMMENTS:
  1) change(87-02-05,GDixon), approve(87-05-25,MCR7680),
     audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055):
     Correct coding standard violations, and remove unnecessary statements.
                                                   END HISTORY COMMENTS */


/**** The initializer's ring four base-of-stack handler.
      In admin mode proper, this is pre-empted by default_error_handler_$wall,
      and should never be called. That is, when sc_stat_$admin_listener_switch
      is "1"b. In the admin environment (sc_stat_$admin_sci_ptr ^= null)
      this is still the handler. This uses ssu_$abort_line to abort execution
      of a command, not the "abort" condition.
*/

/**** Written by the hidden Imam. */
/* Modified 1984-10-08 BIM for new admin mode */

/* format: style2,idind30,indcomtxt */

sc_signal_handler_:
     procedure;

	dcl     error_switch	        ptr;	/* Switch to write message on. */
	dcl     mp		        ptr;	/* ptr to allocated message */
	dcl     ml		        fixed bin (21);
						/* lth of message */
	dcl     msg_area		        area (512); /* area in which condition_interpreter puts message */
	dcl     string		        char (64) aligned;
						/* Basic fault message. */

	dcl     (addr, empty, null)	        builtin;

	dcl     as_$dump		        entry (char (*) aligned);
	dcl     condition_interpreter_        entry (ptr, ptr, fixed bin (21), fixed bin, ptr, char (*), ptr, ptr);
	dcl     find_condition_info_	        entry (ptr, ptr, fixed bin (35));
	dcl     ioa_$ioa_switch	        entry () options (variable);
	dcl     restart_mc_ttys_	        entry;
	dcl     ssu_$abort_line	        entry () options (variable);
	dcl     ssu_$get_info_ptr	        entry (ptr) returns (ptr);
	dcl     sys_log_		        entry options (variable);

/* First locate the condition frame which caused us to be invoked. */

	CI.version = condition_info_version_1;
	call find_condition_info_ (null (), addr (CI), (0));

	condition_info_header_ptr = CI.info_ptr;
	if condition_info_header_ptr ^= null ()
	then if condition_info_header.quiet_restart
	     then return;

/* QUIT signals are handled specially. We don't quit out of anything we can't restart. */

	if CI.condition_name = "quit"
	then return;

	if sc_stat_$admin_sci_ptr ^= null ()
	then do;
		sc_subsystem_info_ptr = ssu_$get_info_ptr (sc_stat_$admin_sci_ptr);
		if sc_subsystem_info.no_real_tty
		then error_switch = sc_stat_$admin_log_iocb;
		else error_switch = sc_subsystem_info.real_iocb;

	     end;
	else if sc_stat_$mc_is_on
	then error_switch = sc_stat_$mc_iocb;
	else error_switch = sc_stat_$master_iocb;

	if condition_info_header_ptr ^= null ()
	then if condition_info_header.default_restart
	     then do;
		     call get_message_string;
		     call iox_$put_chars (error_switch, mp, ml, (0));
		     return;
		end;

/**** There is no need to muck with switches, since sc_process_command_line_
      saves and restores. */

/* Make up error message. */

	string = "error: " || CI.condition_name;
	if sc_stat_$mc_is_on
	then call sys_log_ (SL_LOG_BEEP, "sc_signal_handler_: ^a", string);
	else call ioa_$ioa_switch (error_switch, "^a", string);

	if sc_stat_$Multics
	then call as_$dump (string);			/* Take nice dump. */

	call get_message_string;
	call iox_$put_chars (error_switch, mp, ml, (0));

/* The message is printed. Now try to reset the system control environment and bust out of here */

	call iox_$control (sc_stat_$master_iocb, "start", null, (0));
						/* Make sure we aren't missing a wakeup. */
	if sc_stat_$mc_is_on
	then call restart_mc_ttys_ ();		/* .. or set of wakeups */

	if sc_stat_$admin_sci_ptr ^= null ()
	then call ssu_$abort_line (sc_stat_$admin_sci_ptr, 0, "Execution aborted by error signal.");
	else go to sc_stat_$master_abort_label;		/* Return to console listener loop */

get_message_string:
     procedure;

	call condition_interpreter_ (addr (msg_area), mp, ml, 3, CI.mc_ptr, (CI.condition_name), CI.wc_ptr, CI.info_ptr)
	     ;
     end get_message_string;

%include condition_info_header;
%include condition_info;
	declare 1 CI		        aligned like condition_info;

%include iox_entries;

%include sc_stat_;

%include sc_subsystem_info_;

%include sys_log_constants;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   sc_signal_handler_: error: CONDITION_NAME

   S:	as (severity2)

   T:	$run

   M:	A CONDITION_NAME condition occurred while running an operator
	command.  An answering service dump has been taken to further
	describe the cause of the condition.

   A:	$notify_sa

   END MESSAGE DOCUMENTATION */

     end sc_signal_handler_;




		    sc_signal_io_handler_.pl1       11/11/89  1102.8rew 11/11/89  0809.2       48285



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

/* format: style2,idind30 */

/**** sc_signal_io_handler_
   Handler for signal_io_ in the system control environment.
   This program performs and logs the I/O requested via the signal.
*/

/**** Written 1984-11-01 BIM */
/**** Modified 1985-04-01, E. Swenson: add NL to "(printer masked)" entries. */


/****^  HISTORY COMMENTS:
  1) change(87-02-06,GDixon), approve(87-05-25,MCR7680),
     audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055):
     Correct coding standards violations.
                                                   END HISTORY COMMENTS */


sc_signal_io_handler_:
     procedure;

	declare 1 CI		        aligned like condition_info;
	declare code		        fixed bin (35);
	declare real_iocb		        pointer;

	declare (addr, null)	        builtin;

	declare find_condition_info_	        entry (pointer, pointer, fixed binary (35));
	declare ioa_$ioa_switch	        entry () options (variable);
	declare ioa_$ioa_switch_nnl	        entry () options (variable);
	declare ssu_$get_info_ptr	        entry (ptr) returns (ptr);

	declare error_table_$io_no_permission fixed bin (35) ext static;


	CI.version = condition_info_version_1;
	call find_condition_info_ (null (), addr (CI), code);
	if code ^= 0
	then return;
	if sc_stat_$admin_sci_ptr = null ()
	then return;
	sc_subsystem_info_ptr = ssu_$get_info_ptr (sc_stat_$admin_sci_ptr);
	real_iocb = sc_subsystem_info.real_iocb;
	if real_iocb = null ()
	then return;

	signal_io_info_ptr = CI.info_ptr;

	if signal_io_info.operation = SGI_OP_GET_LINE
	then call GET_LINE;
	else if signal_io_info.operation = SGI_OP_GET_CHARS
	then call GET_CHARS;
	else if signal_io_info.operation = SGI_OP_PUT_CHARS
	then call PUT_CHARS;
	else if signal_io_info.operation = SGI_OP_POSITION
	then call POSITION;
	else if signal_io_info.operation = SGI_OP_CONTROL
	then call CONTROL;
	else if signal_io_info.operation = SGI_OP_MODES
	then call MODES;

	return;					/* If we get here, then we needn't unwind */

%page;

GET_LINE:
     procedure;


	declare returned_string	        char (signal_io_info.returned_data_length)
				        based (signal_io_info.data_ptr);

	call ioa_$ioa_switch_nnl (sc_stat_$admin_log_iocb, "^/");
						/* in case of prompt */
	call iox_$get_line (real_iocb, signal_io_info.data_ptr, signal_io_info.data_length,
	     signal_io_info.returned_data_length, signal_io_info.returned_error_code);
	if signal_io_info.returned_error_code = 0 & signal_io_info.returned_data_length > 0
	then if ^sc_subsystem_info.printer_offed
	     then call ioa_$ioa_switch_nnl (sc_stat_$admin_log_iocb, "input: ^a", returned_string);
	     else call ioa_$ioa_switch (sc_stat_$admin_log_iocb, "input: (printer masked)");
	call check_hangup;
	return;
     end GET_LINE;

GET_CHARS:
     procedure;
	declare returned_string	        char (signal_io_info.returned_data_length)
				        based (signal_io_info.data_ptr);

	call iox_$get_chars (real_iocb, signal_io_info.data_ptr, signal_io_info.data_length,
	     signal_io_info.returned_data_length, signal_io_info.returned_error_code);
	if signal_io_info.returned_error_code = 0 & signal_io_info.returned_data_length > 0
	then if ^sc_subsystem_info.printer_offed
	     then call ioa_$ioa_switch_nnl (sc_stat_$admin_log_iocb, "input: ^a", returned_string);
	     else call ioa_$ioa_switch (sc_stat_$admin_log_iocb, "input: (printer masked)");
	call check_hangup;
	return;
     end GET_CHARS;

POSITION:
     procedure;
	call iox_$position (real_iocb, signal_io_info.position_type, (signal_io_info.position_amount),
	     signal_io_info.returned_error_code);
	call check_hangup;
	return;
     end POSITION;

MODES:
     procedure;

	call iox_$modes (real_iocb, signal_io_new_modes, signal_io_old_modes, signal_io_info.returned_error_code);
	call check_hangup;
	return;
     end MODES;

PUT_CHARS:
     procedure;

	call iox_$put_chars (real_iocb, signal_io_info.data_ptr, signal_io_info.data_length,
	     signal_io_info.returned_error_code);
	call ioa_$ioa_switch_nnl (sc_stat_$admin_log_iocb, "^a", signal_io_io_buffer);
	call check_hangup;
	return;
     end PUT_CHARS;

CONTROL:
     procedure;

	if signal_io_order_name = "printer_off"
	then sc_subsystem_info.printer_offed = "1"b;
	if signal_io_order_name = "printer_on"
	then sc_subsystem_info.printer_offed = "0"b;

	call iox_$control (real_iocb, signal_io_order_name, signal_io_info.control_order_info_ptr,
	     signal_io_info.returned_error_code);
	call check_hangup;
	return;
     end CONTROL;

check_hangup:
     procedure;

	if signal_io_info.returned_error_code = error_table_$io_no_permission
	then call sc_subsystem_info.hangup_entry (sc_stat_$admin_sci_ptr);
	return;
     end check_hangup;

%include condition_info;

%include condition_info_header;

%include iocb;

%include iox_entries;

%include signal_io_info;

%include sc_subsystem_info_;

%include sc_stat_;

     end sc_signal_io_handler_;




		    sc_stat_.alm                    11/11/89  1102.8rew 11/11/89  0807.4       47448



" ***********************************************************
" *                                                         *
" * 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.      *
" *                                                         *
" ***********************************************************

" These values are declared in sc_stat_.incl.pl1.
" Changes herein should be reflected therein.
" Written at an unknown time by the 12th Imam.
" Modified 1984-10-08 BIM for more admin goodies.
" Modified 1985-01-07 BIM for mc access control.


" HISTORY COMMENTS:
"  1) change(86-08-01,Cox), approve(87-05-28,MCR7690), audit(87-02-18,GDixon),
"     install(87-08-04,MR12.1-1055):
"     Added sc_stat_$vchn_requires_accept in support of virtual MC channels
"     for use by DSA.
"  2) change(87-02-18,GDixon), approve(87-05-28,MCR7680),
"     audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055):
"     Reorganized by type of data to improve readability.
"                                                      END HISTORY COMMENTS


	use	statc
	join	/link/statc

	segdef	Go		" segdefs are stored alphabetically
	segdef	Go_typed
	segdef	Multics
	segdef	Multics_typed
	segdef	Star_typed
	segdef	admin_listener_exit_label
	segdef	admin_listener_switch
	segdef	admin_log_iocb
	segdef	admin_log_write_ptr
	segdef	admin_sci_ptr
	segdef	as_log_write_ptr
	segdef	did_part1
	segdef	did_part2
	segdef	did_part3
	segdef	exec_access_name
	segdef	info_dir
	segdef	initzer_ttyp
	segdef	log_dir
	segdef	master_abort_label
	segdef	master_channel
	segdef	master_iocb
	segdef	master_sci_ptr
	segdef	mc_acs_dir
	segdef	mc_ansp
	segdef	mc_iocb
	segdef	mc_is_on
	segdef	no_operator_login
	segdef	shutdown_typed
	segdef	sv1_iocb
	segdef	sv2_iocb
	segdef	sv3_iocb
	segdef	sysdir
	segdef	system_shutdown_label
	segdef	test_mode
	segdef	unidentified_access_name
	segdef	vchn_requires_accept

" Data is stored by type, with data types ordered with those needing
" doubleword alignment appearing first: 
"   LABELS
"   POINTERS
"     to DATA for calling log_write_
"     to IOCBS
"     to SSU SUBSYSTEM CONTROL INFO
"     to TABLES
"   SWITCHES
"   CHARACTER STRINGS
"     ACCESS NAMES
"     PATHNAMES
"     OTHER TYPES

		even		"LABELS
admin_listener_exit_label:
          	its	-1,1	" go here to leave admin listener
		its	-1,1
master_abort_label: its	-1,1   	" go here to return to system_control_
		its	-1,1	" request loop
system_shutdown_label:
		its	-1,1	" go here to make system shutdown.
		its	-1,1

				"POINTERS - DATA for calling log_write_
admin_log_write_ptr:its	-1,1	" static for the admin log
as_log_write_ptr:   its	-1,1	" ext static for the AS log

				"POINTERS - IOCBS
admin_log_iocb:	its	-1,1	" IOCB for admin log
master_iocb:	its	-1,1	" IOCB for "master_i/o"
mc_iocb:		its	-1,1	" IOCB for "mc_i/o"
sv1_iocb:		its	-1,1	" IOCB for "severity1"
sv2_iocb:		its	-1,1	" IOCB for "severity2"
sv3_iocb:		its	-1,1	" IOCB for "severity3"

				"POINTERS - SSU SUBSYSTEM CONTROL INFO
admin_sci_ptr:	its	-1,1	" subsystem for current admin request
master_sci_ptr:	its	-1,1	" permanent subsystem for otw_

				"POINTERS - TABLES
initzer_ttyp:	its	-1,1	"ptr to mc_ate for initializer terminal
mc_ansp:		its	-1,1	"ptr to mc_anstbl, incl mc_ate array

				"SWITCHES
				" dcl XXX bit (1) aligned
		bool	false,0
		bool	true,400000000000
Go:		vfd	36o/false	" TRUE if AS listening  ('go'   done)
Go_typed:		vfd	36o/false	" TRUE immediately after 'go'   typed
Multics:		vfd	36o/false	" TRUE if AS started    ('mult' done)
Multics_typed:	vfd	36o/false	" TRUE immediately after 'mult' typed
Star_typed:	vfd	36o/false	" TRUE if Go & Multics done as a result
				"  of 'star' being typed
admin_listener_switch:
		vfd	36o/false	" TRUE if listening for admin commands
did_part1:	vfd	36o/false	" TRUE if part 1 system_startup.ec done
did_part2:	vfd	36o/false	" TRUE if part 2 system_startup.ec done
did_part3:	vfd	36o/false	" TRUE if part 3 system_startup.ec done
mc_is_on:		vfd	36o/false	" TRUE if message coordinator running
no_operator_login:  vfd	36o/true	" TRUE if not requiring login
shutdown_typed:	vfd	36o/false	" TRUE if shutdown command is executing
test_mode:	vfd	36o/false	" TRUE if in test environment
vchn_requires_accept:
		vfd	36o/true	" TRUE if operator must accept all
				"  'login -op -vchn x' attempts 

				"CHAR STRINGS - ACCESS NAMES
				" dcl XXX char(32) aligned
exec_access_name:			" Name used for executing x requests
		aci	"_Exec_Command.Operator.o",32
unidentified_access_name:		" Name used for executing requests from
				"  unidentified operators.
		aci	"_Unidentified.Operator.o",32

				"CHAR STRINGS - PATHNAMES
				" dcl XXX char (168) aligned
info_dir:		aci	">documentation>subsystem>operator",168
log_dir:		aci	">system_control_1>as_logs",168
mc_acs_dir:	aci	">system_control_1>mc_acs",168
sysdir:		aci	">system_control_1",168

				"CHAR STRINGS - OTHER
master_channel:	aci	"otw_  ",6
				" dcl XXX char (6) aligned
				" Master TTY channel.

		end




		    sys_log_.pl1                    11/11/89  1102.8rew 11/11/89  0809.2      187452



/****^  ***********************************************************
        *                                                         *
        * 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,idind30,indcomtxt */

/* *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
/*							       */
/* Name: sys_log_						       */
/*    This procedure is used by the Answering Service to report errors.      */
/* 							       */
/* There are two modes of operation:				       */
/*    command-mode, in which errors are reported on behalf of an operator    */
/*       command, on the terminal which issued the command		       */
/*       (sc_stat_$real_iocb), and/or logged in the admin log;	       */
/*    as-mode, in which errors are reported on one of the answering service  */
/*       severity I/O switches (severity1, severity2 or severity3), and/or   */
/*       logged in the as log.				       */
/*							       */
/* The severity parameter determines which I/O switch is used (in as-mode)   */
/* and how the error is presented, as follows:			       */
/*							       */
/* 		 as-mode					       */
/*    severity	I/O switch	logging/printing operation	       */
/*       0			log message, only		       */
/*       1	severity1		log & print message		       */
/*       2	severity2		log & print message with banner      */
/*       3	severity3		log & print message with banner,     */
/*				kill the system by returning to bce  */
/*							       */
/* Releases prior to MR11.0 allowed a negative severity value.  Now, the     */
/* absolute value of the severity parameter determines the action, as shown  */
/* above.							       */
/*							       */
/* *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */

/* *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
/*							       */
/* as-mode Entrypoints:					       */
/*							       */
/*    call sys_log_ (severity, ioa_ctl, args);			       */
/*    call sys_log_$binary (severity, data_ptr, data_lth, data_class,	       */
/*		        ioa_ctl, args);			       */
/*    call sys_log_$error_log (severity, code, caller, ioa_ctl, args);       */
/*       Log caller's name, expanded error table code, ioa-formatted message */
/*       and binary data, according to parameters supplied with the	       */
/*       entrypoint.					       */
/*							       */
/* command-mode Entrypoints:					       */
/*							       */
/*    call sys_log_$command (severity, ioa_ctl, args);		       */
/*    call sys_log_$command_error (severity, code, caller, ioa_ctl, args);   */
/*       Log caller's name, expanded error table code, and ioa-formatted     */
/*       message, according to parameters supplied with the entrypoint.      */
/*							       */
/* general Entrypoint:					       */
/*							       */
/*    call sys_log_$general (info_ptr);				       */
/*       Log caller's name, expanded error table code, message and optional  */
/*       binary data in either as-mode or command-mode.  Options controlled  */
/*       by info structure pointed to by info_ptr.  Message data can	       */
/*       optionally come from a caller-supplied argument list.  See comments */
/*       for sl_info structure in sys_log_constants.incl.pl1.	       */
/*							       */
/* Entry: sys_log_$type_sv_zero				       */
/*							       */
/*    call sys_log_$type_sv_zero ();				       */
/*       Causes severity 0 messages to be logged and also printed on the     */
/*       console, even though messages of this severity calls only for       */
/*       logging of messages.					       */
/*							       */
/* *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */

sys_log_:
     proc (Severity);

/****   THVV 11/70
      Modified October 1977 by T. Casey to add type_sv_zero entry point for debugging.
      Modified May 1978 by T. Casey to lengthen message buffer to 256 chars to avoid truncating long messages.
      Modified August 1982 by E. N. Kittlitz, at the insistence of S. Harris and A. Haggett of Calgary,
      to not use MC streams before the MC is enabled.
      Modified August 1983 by K. Loepere for call_bce.
      Rewritten 1984-10-31 BIM
      Modified 1985-01-15 by E. Swenson for sys_log_$binary */


/****^  HISTORY COMMENTS:
  1) change(86-08-01,Swenson), approve(87-05-25,MCR7680),
     audit(87-02-08,GDixon), install(87-08-04,MR12.1-1055):
     Modified to print messages on the terminal when running in system control
     test mode and no as log exists.
  2) change(87-02-08,GDixon), approve(87-05-25,MCR7680),
     audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055):
      A) Fixed coding standard violations.
      B) Added back the facility to crash the system, if need be.
  3) change(87-05-04,GDixon), approve(87-05-25,MCR7680),
     audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055):
      A) Fix sys_log_$error_code formatting problem.
  4) change(87-05-06,GDixon), approve(87-06-10,MCR7708),
     audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055):
      A) Added sys_log_$general entrypoint.
                                                   END HISTORY COMMENTS */


/* Parameters */

	dcl     Severity		        fixed bin (17) parameter;
						/* First arg.  How bad things are. */
	dcl     Data_class		        char (10) varying parameter;
						/* Class of supplied data */
	dcl     Data_lth		        fixed bin (17) parameter;
						/* length of supplied data */
	dcl     Data_ptr		        ptr parameter;
						/* pointer to supplied data */
	dcl     Code		        fixed bin (35) parameter;
						/* Error code */
	dcl     Caller		        char (*) parameter;
						/* Caller name */
	dcl     Sl_info_ptr		        ptr parameter;
						/* pointer to sl_info structure for $general */

/* Automatic */

	dcl     arg_string		        char (500);
	dcl     arg_string_lth	        fixed bin(21);
	dcl     based_arg_ptr	        ptr;
	dcl     based_arg_len	        fixed bin(21);
	dcl     binary		        bit (1) aligned;
	dcl     code		        fixed bin (35);
	dcl     command		        bit (1) aligned;
	dcl     count		        fixed bin;
	dcl     data_ptr		        ptr;	/* pointer to binary data supplied */
	dcl     data_lth		        fixed bin (17);
						/* length of binary data supplied */
	dcl     data_class		        char (10) varying;
						/* class of binary data */
	dcl     (fmtx, argx)	        fixed bin;	/* general_rs args telling where format etc */
	dcl     ioa_ctl_string	        char (100) aligned;
	dcl     long		        char (100) aligned;
						/* error message */
	dcl     (masked_ev_calls_code, unmasked_ev_calls_code)
				        fixed bin (35);
	dcl     severity		        fixed bin;
	dcl     temp_line		        char (500) varying;

/* Based */

	dcl     based_caller	        char (based_arg_len) based (based_arg_ptr);
	dcl     based_class		        char (based_arg_len) based (based_arg_ptr);
	dcl     based_code		        fixed bin(35) based (based_arg_ptr);
	dcl     based_data_lth	        fixed bin(21) based (based_arg_ptr);
	dcl     based_data_ptr	        ptr based (based_arg_ptr);
	dcl     based_fixed_bin	        fixed bin based (based_arg_ptr);

/* Entries */

	dcl     convert_status_code_	        entry (fixed binary (35), character (8) aligned, character (100) aligned);
	dcl     cu_$arg_list_ptr	        entry returns (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     date_time_$format	        entry (character (*), fixed binary (71), character (*), character (*))
				        returns (character (250) var);
	dcl     hcs_$block		        entry ();
	dcl     hphcs_$call_bce	        entry ();
	dcl     ioa_		        entry () options (variable);
	dcl     ioa_$general_rs	        entry (ptr, fixed bin, 
				        fixed bin, char (*),
				        fixed bin(21), bit (1) aligned,
				        bit (1) aligned);
	dcl     ioa_$general_rs_control_string
				        entry (ptr, char(*), fixed bin,
				        char(*), fixed bin(21),
				        bit(1) aligned, 
				        bit(1) aligned);
	dcl     ioa_$ioa_switch	        entry () options (variable);
	dcl     ioa_$rsnnl		        entry options (variable);
	dcl     iox_$control	        entry (ptr, char (*), ptr, fixed bin (35));
	dcl     ipc_$mask_ev_calls	        entry (fixed bin (35));
	dcl     ipc_$unmask_ev_calls	        entry (fixed bin (35));
	dcl     log_write_$data	        entry (ptr, fixed bin, char (*), ptr, fixed bin, char (10) var, ptr,
				        fixed bin (35));
	dcl     log_write_$message	        entry (pointer, fixed binary, character (*), pointer, fixed binary (35));
	dcl     phcs_$ring_0_message	        entry (char(*));
	dcl     signal_		        entry (char(*), ptr, ptr, ptr);
	dcl     ssu_$get_info_ptr	        entry (ptr) returns (ptr);

/* Conditions */ 

	dcl     cleanup		        condition;

/* Builtin */

	dcl     (abs, addr, clock, length, max, null, rtrim, size, substr)
				        builtin;

/* External */

          dcl     (error_table_$bad_arg,
	         error_table_$null_info_ptr,
	         error_table_$unimplemented_version,
	         error_table_$wrong_no_of_args)	fixed bin(35) ext static;

/* Static */

	dcl     type_sv0		        bit (1) aligned int static init (""b);
						/* print Severity zero messages for debugging */

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */


/* sys_log_: entry (Severity); */

	command = "0"b;
	binary = "0"b;
	go to no_error_common;

command:  entry (Severity);

	command = "1"b;
	binary = "0"b;

no_error_common:
	argx = 3;					/* set indices for loc of args */
	fmtx = 2;					/* and format */

	call ioa_$general_rs (cu_$arg_list_ptr (), fmtx, argx, arg_string,
	   arg_string_lth, "0"b, "0"b);
	temp_line = substr (arg_string, 1, arg_string_lth);
	go to join;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */


binary:	entry (Severity, Data_ptr, Data_lth, Data_class);

	data_ptr = Data_ptr;			/* copy args */
	data_lth = Data_lth;			/* copy args */
	data_class = Data_class;			/* copy args */

	argx = 6;					/* location of the ioa args */
	fmtx = 5;					/* location of the ioa format string */

	command = "0"b;				/* regular non-command entrypoint */
	binary = "1"b;				/* we have binary data supplied */

	call ioa_$general_rs (cu_$arg_list_ptr (), fmtx, argx, arg_string,
	   arg_string_lth, "0"b, "0"b);
	temp_line =  substr(arg_string, 1, arg_string_lth);
	goto join;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */


error_log:
	entry (Severity, Code, Caller);		/* like com_err_ for initializer */

	command = "0"b;
	binary = "0"b;
	go to error_common;

command_error:
	entry (Severity, Code, Caller);

	command = "1"b;
	binary = "0"b;
	go to error_common;

error_common:
	argx = 5;
	fmtx = 4;

	long = "";				/* blank reason */
	if Code ^= 0
	then /* convert user error code to string */
	     call convert_status_code_ (Code, "", long);	/* find explanation of errcode */
	call ioa_$general_rs (cu_$arg_list_ptr (), fmtx, argx, arg_string,
	     arg_string_lth, "0"b, "0"b);
	call ioa_$rsnnl ("^a: ^a ^a", temp_line, (0), Caller, long,
	     substr(arg_string,1,arg_string_lth));
	go to join;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */

general:	entry (Sl_info_ptr);

	sli_ptr = Sl_info_ptr;
	if sli_ptr = null then do;
	   sys_log_error_info.info_string =
	      "Null pointer passed to sys_log_$general.";
	   sys_log_error_info.status_code = error_table_$null_info_ptr;
GEN_BAD_IN:  sys_log_error_info.length = size(sys_log_error_info);
	   sys_log_error_info.version = SYS_LOG_ERROR_INFO_version_1;
	   sys_log_error_info.action_flags = "0"b;
	   sys_log_error_info.action_flags.cant_restart = "1"b;
	   sys_log_error_info.sl_info_ptr = sli_ptr;
	   call signal_ (SYS_LOG_ERROR_name, null,
	      addr(sys_log_error_info), null);
	   return;
	   end;
	if sli.version ^= SL_INFO_version_1 then do;
	   sys_log_error_info.info_string =
	      "Structure passed to sys_log_$general has version " ||
	      sli.version || ", expected version " || SL_INFO_version_1 || ".";
	   sys_log_error_info.status_code = error_table_$unimplemented_version;
	   go to GEN_BAD_IN;
	   end;

	if sli.arg_list_ptr ^= null then do;
	   call cu_$arg_count_rel (count, sli.arg_list_ptr, 0);
	   if max (sli.loc.mode, sli.loc.severity, sli.loc.code, 
		 sli.loc.caller, sli.loc.data+1, sli.loc.class,
		 sli.loc.ioa_msg) > count then do;
	      sys_log_error_info.info_string =
	         "Structure input to sys_log_$general references args not in arg list.";
	      sys_log_error_info.status_code = error_table_$wrong_no_of_args;
	      go to GEN_BAD_IN;
	      end;
	   end;
	else if max (sli.loc.mode, sli.loc.severity, sli.loc.code,
		   sli.loc.caller, sli.loc.data, sli.loc.class,
		   sli.loc.ioa_msg) > 0 then do;
	   sys_log_error_info.info_string = 
	      "Structure input to sys_log_$general references args, but arg_list_ptr is null.";
	   sys_log_error_info.status_code = error_table_$bad_arg;
	   go to GEN_BAD_IN;
	   end;

	if sli.loc.code > 0 then do;		
	   call cu_$arg_ptr_rel (sli.loc.code,		
	      based_arg_ptr, 0, code, sli.arg_list_ptr);
	   if code = 0 then 
	      sli.code = based_code;
	   else
	      sli.code = -1;
	   end;
	else if sli.loc.code = SL_INFO_arg_not_given then
	   sli.code = 0;
	if sli.loc.code ^= SL_INFO_arg_not_given then 
	   if sli.code = 0 then return;		/*  0 -> no err  */
	if sli.code = 0 | sli.code = -1 then		/* -1 -> err, no */
	   long = "";				/*       code    */
	else 
	   call convert_status_code_ (sli.code, "", long);

	if sli.loc.mode > 0 then do;
	   call cu_$arg_ptr_rel (sli.loc.mode, based_arg_ptr,
	      0, 0, sli.arg_list_ptr);
	   sli.mode = based_fixed_bin;
	   end;
	else if sli.loc.mode = SL_INFO_arg_not_given then
	   sli.mode = SL_INFO_as_mode;
	command = sli.mode=SL_INFO_command_mode;

	if sli.loc.severity > 0 then do;
	   call cu_$arg_ptr_rel (sli.loc.severity, based_arg_ptr,
	      0, 0, sli.arg_list_ptr);
	   sli.severity = based_fixed_bin;
	   end;
	else if sli.loc.severity = SL_INFO_arg_not_given then
	   sli.severity = SL_LOG;
	severity = abs(sli.severity);

	if sli.loc.caller > 0 then do;
	   call cu_$arg_ptr_rel (sli.loc.caller, based_arg_ptr,
	      based_arg_len, 0, sli.arg_list_ptr);
	   sli.caller = based_caller;
	   end;
	else if sli.loc.caller = SL_INFO_arg_not_given then
	   sli.caller = "";

	if sli.loc.data > 0 then do;
	   call cu_$arg_ptr_rel (sli.loc.data, based_arg_ptr,
	      0, 0, sli.arg_list_ptr);
	   sli.data_ptr = based_data_ptr;
	   call cu_$arg_ptr_rel (sli.loc.data+1, based_arg_ptr,
	      0, 0, sli.arg_list_ptr);
	   sli.data_lth = based_data_lth;
	   end;
	if sli.loc.data = SL_INFO_arg_not_given then
	   binary = "0"b;
	else do;
	   data_ptr = sli.data_ptr;
	   data_lth = sli.data_lth;
	   binary = "1"b;
	   end;

	if sli.loc.class > 0 then do;
	   call cu_$arg_ptr_rel (sli.loc.class, based_arg_ptr,
	      based_arg_len, 0, sli.arg_list_ptr);
	   sli.class = based_class;
	   end;
	else if sli.loc.class = SL_INFO_arg_not_given then
	   sli.class = "";
	if binary then data_class = sli.class;

	if sli.loc.ioa_msg > 0 then do;
	   if sli.flags.ioa_msg_is_error_code then do;
	      call cu_$arg_ptr_rel (sli.loc.ioa_msg, based_arg_ptr, 0, 0,
	         sli.arg_list_ptr);
	      call convert_status_code_ (based_code, "", ioa_ctl_string);
	      if length(rtrim(ioa_ctl_string)) > 0 then 
	         call ioa_$general_rs_control_string (sli.arg_list_ptr,
		  rtrim(ioa_ctl_string), sli.loc.ioa_msg+1,
		  arg_string, arg_string_lth, "0"b, "0"b);
	      else arg_string_lth = 0;
	      end;
	   else
	      call ioa_$general_rs (sli.arg_list_ptr, sli.loc.ioa_msg,
	      sli.loc.ioa_msg+1, arg_string, arg_string_lth, "0"b, "0"b);
	   sli.ioa_msg = substr(arg_string, 1, arg_string_lth);
	   end;
	else if sli.loc.ioa_msg = SL_INFO_arg_not_given then
	   sli.ioa_msg = "";

	temp_line = "";
	if sli.loc.caller ^= SL_INFO_arg_not_given then do;
	   temp_line = temp_line || rtrim(sli.caller);
	   temp_line = temp_line || ": ";
	   end;
	if long ^= "" then do;
	   temp_line = temp_line || rtrim(long);
	   temp_line = temp_line || " ";
	   end;
	if sli.loc.ioa_msg ^= SL_INFO_arg_not_given then
	   temp_line = temp_line || sli.ioa_msg;
	go to join_general;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */


join:
	severity = Severity;			/* copy Severity */
	severity = abs (severity);

join_general:
	masked_ev_calls_code, unmasked_ev_calls_code = -1;
	on cleanup
	     begin;
		if masked_ev_calls_code = 0 & unmasked_ev_calls_code ^= 0
		then call ipc_$unmask_ev_calls ((0));
	     end;
	call ipc_$mask_ev_calls (masked_ev_calls_code);

	if sc_stat_$test_mode & (sc_stat_$as_log_write_ptr = null ())
	then do;
		call ioa_ ("LOG: ^a", temp_line);
		goto RETURN;
	     end;

/**** First deposit in appropriate logs */

	if ^command
	then do;

		if ^binary
		then call log_write_$message (sc_stat_$as_log_write_ptr, severity, (temp_line), (null ()), code);
		else call log_write_$data (sc_stat_$as_log_write_ptr, severity, (temp_line), data_ptr, data_lth,
			data_class, (null ()), code);

		if severity > 3
		then severity = 3;
		if severity = 1 | type_sv0
		then call ioa_$ioa_switch (sc_stat_$sv1_iocb, "^[ ^4a   as   ^;^s^]^a", ^sc_stat_$mc_is_on,
			as_time (), temp_line);
		else if severity = 2
		then call ioa_$ioa_switch (sc_stat_$sv2_iocb, "^[^/********************^/ ^4a   as   ^;^s^]^a",
			^sc_stat_$mc_is_on, as_time (), temp_line);
		else if severity = 3
		then call ioa_$ioa_switch (sc_stat_$sv3_iocb, "^[^/********************^/ ^4a   as   ^]^a",
			^sc_stat_$mc_is_on, as_time (), temp_line);
	     end;
	else do;					/* treat as command output */
		call iox_$control (sc_stat_$admin_log_iocb, "flush_pending_output", null (), (0));
		call log_write_$message (sc_stat_$admin_log_write_ptr, severity, (temp_line), (null ()), code);

		sc_subsystem_info_ptr = ssu_$get_info_ptr (sc_stat_$admin_sci_ptr);
		if (severity > 0 | type_sv0) & sc_subsystem_info.real_iocb ^= null ()
						/* if null, logging will suffice */
		then call ioa_$ioa_switch (sc_subsystem_info.real_iocb, "^a", temp_line);
	     end;

	if severity > 2 then do;			/* should we kill system? */
	     if sc_stat_$mc_is_on then
	        call ioa_$ioa_switch (sc_stat_$sv3_iocb,
	        "^/sys_log_: KILLING ANSWERING SERVICE. DUMP INITIALIZER & REBOOT.");
	     if sc_stat_$test_mode then go to RETURN;
	     call phcs_$ring_0_message ((temp_line));
	     call phcs_$ring_0_message ("sys_log_: Returning to BCE. Dump Initializer and reboot.");
	     call hphcs_$call_bce;

/* *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */
/*							       */
/* If we return here, it is because the operator has warned users to cleanup */
/* & logout.  The initializer is non-operational, so no logins, logouts, or  */
/* accounting updates will work. The initializer should block and stay       */
/* blocked, so users can run.					       */
/*							       */
/* *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */

	     do while ("1"b);
		call hcs_$block;			/* just as if we had logged out */
	     end;
	end;

RETURN:
	call ipc_$unmask_ev_calls (unmasked_ev_calls_code);
	return;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */


type_sv_zero:
     entry;					/* to set switch to type sv zero messages for debugging */

	type_sv0 = ^type_sv0;			/* flip the switch, turning it off or on */
	call ioa_ ("sys_log_: sv zero typing turned ^[on^;off^].", type_sv0);
	return;

/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */


as_time:
     procedure returns (char (4));

	return (date_time_$format ("^Hd^MH", clock (), "", ""));
     end as_time;


%include condition_info_header;
%include sc_subsystem_info_;
%include sc_stat_;
%include sys_log_error_info;
%include sys_log_constants;

	dcl	1 sli		aligned like sl_info based (sli_ptr);
	dcl	sli_ptr		ptr;

     end sys_log_;




		    system_control_.pl1             11/11/89  1102.8rew 11/11/89  0809.2       57951



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

system_control_:
     procedure;

/* System Control is the procedure called by the initializer process
   after system initialization has been completed in ring 1.
   It runs in ring 4, and is outwardly called by system_startup_ */

/*
   Initially coded by M. J. Spier on April 25, 1969
   Revised for mini_shell by R. C. Daley on June 29, 1969
   Recoded for efficiency by J.M. Grochow on December 22, 1969
   Recoded for the new User/System Control  by Michael J. Spier, March 27, 1970
   Completely recoded by Michael J. Spier on Saturday June 27, 1970
   Revised for operator communications by Dennis Capps Sept. 1972
   Intercom, input logging, elimination of bugs 5/74 THVV
   Split into seventeen little programs THVV 4/75
   Modified 750318 by PG to get test mode to work
   Modified for IOX April 1981 by Benson I. Margulies.
   Modified for call_bce August 1983 by Keith Loepere.
   Modified 1984-10-08 BIM for demise of communications 
   Modified 1984-10-26 BIM for ssu_ */

/****^  HISTORY COMMENTS:
  1) change(86-05-13,GJohnson), approve(86-05-13,MCR7387),
     audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056):
     Correct error message documentation.
  2) change(86-08-01,Cox), approve(87-05-25,MCR7690), audit(87-03-13,GDixon),
     install(87-08-04,MR12.1-1055):
     Modified for change to mc_anstbl.incl.pl1.
  3) change(87-02-03,GDixon), approve(87-05-25,MCR7680),
     audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055):
     Modified to meet coding standards by deleting unreferenced variables,
     declaring used builtins, etc.
                                                   END HISTORY COMMENTS */

/* DECLARATION OF BUILTIN FUNCTIONS */

	dcl     (addr, length, null, rtrim)   builtin;

/* CONDITIONS */

	dcl     any_other		        condition;
	dcl     signal_io_		        condition;

/* DECLARATION OF EXTERNAL ENTRIES */

	dcl     hphcs_$syserr	        entry options (variable);
	dcl     hphcs_$call_bce	        entry ();
	dcl     ioa_$ioa_switch	        entry () options (variable);
	dcl     sc_init_		        entry ();
	dcl     sc_process_command_line_      entry (pointer, pointer, fixed binary (21));
	dcl     sc_shutdown_	        entry;
	dcl     sc_signal_handler_	        entry ();
	dcl     sc_signal_io_handler_	        entry;


/* DECLARATION OF AUTOMATIC STORAGE VARIABLES */

	dcl     buffer		        char (500);
	dcl     command_line_length	        fixed bin (21);
	dcl     initial_command	        char (30);
	dcl     ip		        ptr automatic;


/* This section of the code initializes the system control environment. */

	initial_command = "";
	go to common;				/* if entered as result of "standard" */

startup_entry:
     entry;					/* entry to execute startup command upon entry */

	initial_command = "startup";

	go to common;

multics_entry:
     entry;					/* entry to execute multics cmd immediately upon entry */

	initial_command = "multics";
	go to common;

common:
	if ^sc_stat_$test_mode
	then on any_other
		begin;
		     call hphcs_$syserr (1, "system_control_: fault during init.");
		     call hphcs_$call_bce ();
		end;

	call sc_init_ ();

	on any_other call sc_signal_handler_;
	on signal_io_ call sc_signal_io_handler_;

	sc_stat_$system_shutdown_label = SHUTDOWN_COMES_HERE;

	if initial_command ^= ""
	then call sc_process_command_line_ (sc_stat_$master_sci_ptr, addr (initial_command),
		length (rtrim (initial_command)));



/* Here is the main loop of system control.
   All this program does is act like a regular listener:
   It reads a line from the master console, parses it to
   find out what the command is, and executes the command.

   The trick is that in the initializer process, there are
   a large number of static event call channels, in the process's
   event channel table, which can have events arrive on them.
   When such an event is signalled, the ipc_$block module
   appears (on a stack trace) to have called out instead of
   returning to the DIM for the console.

   The rule in the initializer is that any module which
   might encounter a block condition (such as an output dim)
   must mask event calls so that the only place where
   event calls can be activated is while the read call
   just below is blocked. */

	sc_stat_$master_abort_label = SYSTEM_CONTROL_LISTENER;

SYSTEM_CONTROL_LISTENER:
	do while ("1"b);
	     mc_atep = sc_stat_$initzer_ttyp;		/* it may get set at any time */
	     if ^sc_stat_$Multics | (mc_atep = null ())
	     then call ioa_$ioa_switch (sc_stat_$master_iocb, "Ready");
	     else call ioa_$ioa_switch (sc_stat_$master_iocb, "Ready^[ (^a)^;^s^]^[ (Not signed on.)^]",
		     mc_ate.signed_on, mc_ate.personid,
		     as_data_$rs_ptrs (0) -> installation_parms.require_operator_login & ^mc_ate.signed_on);
	     command_line_length = 0;
	     call iox_$get_line (sc_stat_$master_iocb, addr (buffer), length (buffer), command_line_length, (0));
	     if command_line_length > 0
	     then call sc_process_command_line_ (sc_stat_$master_sci_ptr, addr (buffer), command_line_length);
	end;

SHUTDOWN_COMES_HERE:
	call sc_shutdown_;

%include as_data_;

%include installation_parms;

%include iox_entries;

%include mc_anstbl;

%include sc_stat_;

/* BEGIN MESSAGE DOCUMENTATION

Message:
Ready

S:	$info

T:	In response to an operator command.

M:	The Initializer types Ready whenever it is ready to accept
an Initializer command in ring 4.

A:	Type the desired command.


Message:
system_control_: fault during init

S:	ring 4 system control.

T:	$init

M:	Some error condition has occurred unexpectedly while
starting up the ring 4 initializer environment.
The system will return to bce.

A:	$contact
$recover

   END MESSAGE DOCUMENTATION */

     end system_control_;




		    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
