



		    debug_check.pl1                 11/11/89  1130.2rew 11/11/89  0851.6       38862



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


debug_check: proc (a_name, a_sw);

/*	Last Modified and Reason

   2/14/76 by S. Webber to convert to using PARM cards
   01/22/76 by TVV for NSS
   10/08/74 by Bernard Greenberg for AST name table
   3/15/74 by A. Kobziar to remove references to tty_buf$ in salvager case
   10/01/73 by RE Mullen to convert to v2pl1
   12/27/73 by R.B.Snyder to make copy_card entry set values in sst etc. from debg card
   84-01-08 BIM to use sst and tc_data definitions, and to handle multiple
	      cards, and not to store numerics in whd.
   10/19/84 by Keith Loepere so that dirw works (one more time). */

dcl  a_name char (4) aligned;
dcl  a_sw bit (1);

declare sst$ast_track bit (1) aligned external static;
declare sst$double_write fixed bin (35) external static;
declare sst$dirlock_writebehind fixed bin (35) external static;

declare tc_data$time_out_severity fixed bin (35) external static;
declare tc_data$notify_check fixed bin (35) external static;

dcl  addwordno builtin;
dcl  bin builtin;
dcl  null builtin;

dcl  i fixed bin;
dcl  searching bit (1) aligned;
dcl  next_opt fixed bin;

dcl  config_$find entry (character (4) aligned, pointer);
dcl  config_$find_parm entry (character (4) aligned, pointer);
dcl  syserr entry options (variable);

dcl 1 wired_hardcore_data$debug_check_options external,
    2 count fixed bin,
    2 opt (14) char (4) aligned;

%include config_parm_card;



	a_sw = "0"b;
	do i = 1 to wired_hardcore_data$debug_check_options.count;
	     if wired_hardcore_data$debug_check_options.opt (i) = a_name then do;
		a_sw = "1"b;
		return;
	     end;
	end;
	return;

copy_card: entry;

	tc_data$time_out_severity = 3;			/* default timeout severity is 3 */
	tc_data$notify_check = 0;			/* don't perform notify checking as default */

	next_opt = 0;
	searching = "1"b;
	parm_cardp = null ();
	do while (searching);			/* search until no more parm cards */
	     call config_$find (PARM_CARD_WORD, parm_cardp);
	     if parm_cardp = null then searching = "0"b;	/* no more */
	     else do;
		do i = 1 to parm_card.n_fields;
		     if parm_card.type_word.field_type (i)
			= CONFIG_STRING_TYPE
			& (i = parm_card.n_fields | (i < parm_card.n_fields & parm_card.field_type (i + 1) = CONFIG_STRING_TYPE))
			then do; /* no value following */
			next_opt = next_opt + 1;
			if next_opt > 14 then call syserr (ANNOUNCE, "debug_check: too many parameters on parm cards");
			wired_hardcore_data$debug_check_options.opt (next_opt) = parm_card.options (i);
		     end;
		end;
	     end;
	end;

	wired_hardcore_data$debug_check_options.count = next_opt;

	parm_ptr = null ();
	call config_$find_parm ("dblw", parm_ptr);
	if parm_ptr ^= null ()
	then sst$double_write = numeric_parm.value;

	parm_ptr = null ();
	call config_$find_parm ("ntfy", parm_ptr);
	if parm_ptr ^= null ()
	then do;
	     tc_data$time_out_severity = numeric_parm.value;
	     parm_ptr = addwordno (parm_ptr, 1);
	     tc_data$notify_check = numeric_parm.value;
	end;

	parm_ptr = null ();
	call config_$find_parm ("astk", parm_ptr);
	sst$ast_track = (parm_ptr ^= null ());

	parm_ptr = null ();
	call config_$find_parm ("dirw", parm_ptr);
	sst$dirlock_writebehind = bin ((parm_ptr ^= null ()), 1);

	return;

 

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   debug_check: too many parameters on parm cards

   S:	$info

   T:	$init

   M:	A total of 14 options may be specified on PARM cards.
   This limit has been exceeded.
   Options after the 14th will be ignored.

   A:	Correct the configuration deck
   before the next bootload.


   END MESSAGE DOCUMENTATION */

%include config_deck;
%include syserr_constants;

     end debug_check;




		    disk_emergency.pl1              11/11/89  1130.2r w 11/11/89  0851.6       35469



/****^  ***********************************************************
        *                                                         *
        * 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(88-02-23,Farley), approve(88-02-23,MCR7759),
     audit(88-02-24,Fawcett), install(88-03-01,MR12.2-1029):
     Corrected main entry to copy a_errflags to erflagbuf.
                                                   END HISTORY COMMENTS */


disk_emergency: proc (a_pvtx, a_errflags);

/* Procedure in wired world to mark disks as inoperative
   at appropriate times.

   Bernard Greenberg  02/27/77  

   Modified March 1982 by J. Bongiovanni for new PVTE format
*/

dcl  a_pvtx fixed bin;
dcl  a_errflags bit (36) aligned;

dcl  addr builtin;
dcl  erflagbuf bit (36) aligned;
dcl  pvtx fixed bin;
dcl  tc_data$system_shutdown fixed bin (35) ext;
dcl  pvt$n_entries fixed bin ext;
dcl  syserr entry options (variable);
dcl (pmut$wire_and_mask, pmut$unwire_unmask) entry (fixed bin (71), ptr);
dcl  page$time_out entry;
dcl  disk_control$test_drive entry (fixed bin);

dcl  ptwp ptr;
dcl  oldmask fixed bin (71);
dcl  p99 pic "99";
dcl  masked bit (1) init ("0"b);

%include pvte;
%include device_error;



          pvt_arrayp = addr (pvt$array);
	pvtx = a_pvtx;
	pvtep = addr (pvt_array (pvtx));
	erflagbuf = a_errflags;
	erfp = addr (erflagbuf);

	if tc_data$system_shutdown = 0 then return;

	if ^pvte.device_inoperative then call mark;
	return;


test_all_drives_masked: entry;

	masked = "1"b;


test_all_drives: entry;				/* does like it says */
	pvt_arrayp = addr (pvt$array);
	erfp = addr (erflagbuf);
	errflags.device_inoperative = "1"b;


	if ^masked then call pmut$wire_and_mask (oldmask, ptwp);


	do pvtx = 1 to pvt$n_entries;
	     pvtep = addr (pvt_array (pvtx));
	     if (pvte.used | pvte.permanent) & pvte.storage_system
		then do;
		pvte.device_inoperative = "0"b;
		pvte.testing = "1"b;
		call disk_control$test_drive (pvtx);
		do while (pvte.testing);
		     call page$time_out;
		end;
		if pvte.device_inoperative then call mark;
	     end;
	end;

	if ^masked then call pmut$unwire_unmask (oldmask, ptwp);
	return;


mark:	proc;					/* Perform the actual marking */

	     if errflags.device_inoperative then do;
		pvte.device_inoperative = "1"b;
		p99 = pvte.logical_area_number;
		call syserr (3, "disk_emergency: ^a_^a inoperative: shutdown of ^a_^a suspended.",
		     pvte.devname, p99, pvte.devname, p99);
	     end;
	     return;
	end mark;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   disk_emergency: DSKX_NN inoperative; shutdown of DSKX_NN suspended

   S: $beep

   T: Emergency shutdown.

   M: During emergency shutdown, DSKX_NN was found inoperative.
   Data in main memory or on the paging device
   which need to be flushed
   to the pack on DSKX_NN cannot be written out.
   The data remain where they were and ESD may be tried again.

   A: If the drive
   can be made ready, make it ready and try ESD again.
   Do NOT move packs before trying ESD,
   unless address plugs are changed so that the same pack
   appears to have the same address.
   (If this action is performed, the MPC must be halted
   and restarted with a reset and branch.)
   If the pack is not successfully shut down,
   the system will volume salvage it
   when it is next brought up,
   and data from main memory which belongs on the pack will be lost.

   END MESSAGE DOCUMENTATION */

     end;




		    ocdcm_.pl1                      11/11/89  1130.2rew 11/11/89  0851.8     1284534



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


/****^  HISTORY COMMENTS:
  1) change(85-09-30,Farley), approve(85-11-14,MCR6979),
     audit(85-11-14,Fawcett), install(86-03-21,MR12.0-1033):
     To support IMU.
  2) change(85-12-03,Farley), approve(85-12-03,MCR7306),
     audit(86-03-03,Fawcett), install(86-03-21,MR12.0-1033):
     Fix bugs found while doing Dipper changes.
  3) change(85-12-03,Farley), approve(85-12-03,MCR7312),
     audit(86-03-03,Fawcett), install(86-03-21,MR12.0-1033):
     Add BCE MCA lock and unlock.
  4) change(86-03-12,Fawcett), approve(86-03-12,MCR7359),
     audit(86-09-05,Lippard), install(86-09-16,MR12.0-1159):
     Enable the locking and unlocking of MCA after system is booted. If system
     is not at BCE then enter audit trail.
  5) 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.
  6) change(86-07-01,Farley), approve(86-09-02,MCR7523),
     audit(86-10-03,Fawcett), install(86-10-09,MR12.0-1181):
     Add the BAIL_OUT label, as a place for process_io to goto when it finds
     that there is no functional console. Also some other fixes suggested by
     John Ata in TR phx19534.
  7) change(86-08-07,Farley), approve(86-09-02,MCR7523),
     audit(86-10-03,Fawcett), install(86-10-09,MR12.0-1181):
     Increased all timeouts for IMU consoles to 2 min 30 sec. This is needed
     because the console adapter firmware waits 2 min before returning "Device
     Busy" (01/00) when someone is inputing something on the multi-drop.
     Also removed the timeout_factor code, as it is nolonger needed.
  8) change(86-12-18,Farley), approve(87-01-05,MECR0007),
     audit(86-12-18,Fawcett), install(87-01-05,MR12.0-1253):
     Reset oc_data.write_q_full after get_mc_output entry picks up a message
     and after freeing all the write queues in the esd_reset entry and
     reset_console/retry_io procedures.
     
     Changed to call process_io as part of the duties of the poll_for_timeout
     entry.  This will allow queued IO to be started.
  9) change(87-01-14,Farley), approve(87-01-14,MCR7603),
     audit(87-01-14,Fawcett), install(87-01-14,MR12.0-1279):
     Offical installation of above corrections (closes MECR0007).
 10) change(87-07-15,Farley), approve(87-07-17,MCR7735),
     audit(87-07-20,Fawcett), install(87-07-22,MR12.1-1044):
     Changed queue_io entry to set oc_entry_ptr before checking if MC I/O
     is enabled, as this code will eventually want to use it..
     
     Changed queue_console_io to check for a write_queue_full condition
     after adding an entry.  This corrects the age old problem of
     out-of-sequence I/O..
     
     Added a wire_and_mask flag and moved the wiring/masking and
     unwiring/unmasking to internal procs to allow it to only occur when
     required.
     
     Changed several sections of the code to check for a null oc_entry_ptr
     before attempting to reference data in the oc_entry structure.  Also
     turn off the in_service flag in most cases.
     
     Removed extra new_line (NL) from error_msg.
     
     Changed all CRASH severities to PANIC, so that report_error will
     properly crash the system.
     
     Changed init_all_consoles to first find all available consoles then
     try to assign the bootload.  If attempt fails then it will now
     attempt error recovery.
     
     Changed reconfigure (MAKE_BOOTLOAD_CONSOLE) to reassign previous
     (old) console if new console assignment fails.
 11) change(89-08-28,Farley), approve(89-09-18,MCR8132),
     audit(89-10-10,WAAnderson), install(89-10-11,MR12.3-1091):
     Added checks in the reconfigure MAKE_IO_DEVICE and MAKE_INOP_DEVICE code
     after unassigning the bootload console for a NULL oc_entry_ptr.  If it is
     null then attempt to find the console again and if unsuccessful return an
     error code to the caller.
     
     Changed console_recovery to call change_console_state to insure that the
     config_deck gets properly modified.
     
     Changed fill_oc_entry to insure that only ONE console has a state of "ON",
     changing all others to "ALT".
     
     Increased the size of the error_msg and error_buffer to be consistent with
     oc_trans_output_.
     
     Added a temporary holding area for oc_entry.line_leng in report_error.
     This is required when reporting a multi-line error message and the console
     goes inoperative prior to completing the sequence.
     
     Changed "I/O error" log message to optionally include a timeout indication
     ("I/O timeout error") and also include the OPC name in the ascii text.
                                                   END HISTORY COMMENTS */
/* format: off */

ocdcm_:
     proc ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Purpose:									*/
	/*										*/
	/*	This is the operator console DIM. It has the following responsibilities:		*/
	/*										*/
	/* 		1.) Initialize and maintain the ring 0 oc_data database.			*/
	/*										*/
	/* 		2.) Establish and maintain communications with the bootload console.		*/
	/*										*/
	/* 		3.) Detect console faults and handle these faults through one of the following	*/
	/* 		recovery strategies:						*/
	/*										*/
	/* 			a.) Utilize an alternate console as the bootload console device.	*/
	/* 			b.) Forward all console traffic to the message coordinator.		*/
	/*										*/
	/* 		4.) Provide an orderly means explicitly reconfiguring all configured console	*/
	/*		    devices.							*/
	/*										*/
	/* Note:	This code was redesigned and rewritten from the original ocdcm_ to add support of 	*/
	/* 	multiple consoles and to provide a better automated recovery strategy.		*/
	/*										*/
	/*										*/
	/* Written:		07/20/73							*/
	/*										*/
	/* Author:		Bill Silver	(Silver.Multics)				*/
	/*										*/
	/* Rewritten:		05/01/83							*/
	/*										*/
	/* Author:		E. A. Ranzenbach	(Ranzenbach.Multics@M)			*/
	/* Location:		System-M.							*/
	/* Release:		MR10.2							*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Modifications:									*/
	/*										*/
	/*  Date	  Author			Reason						*/
     	/*										*/
	/*  831207  Edward A. Ranzenbach	Set the wired_hardcore_data$abort_request bit for bce.	*/
	/*				Also, list consoles only at appropriate times.		*/
	/*										*/
	/*  840320  Edward A. Ranzenbach	Critical Fix for MR10.2. Corrected reconfiguration crashes	*/
	/*				caused by inadvertantly leaving oc_data locked.		*/
	/*										*/
	/*  840410  Edward A. Ranzenbach	Fixed yet another reconfiguration problem which produces	*/
	/*				a "Lock not Mine" condition. Added set_prompt entrypoint	*/
	/* 				for B2. Cut size of I/Os to 132 bytes. Changed bootload	*/
	/*				consoles reconfigured implicitly by a new bootload console	*/
	/*				to have a state of ALT, thus making them immediately	*/
	/*				available to console recovery. Changed console recovery	*/
	/*				strategy during crash to search for a good console until it	*/
	/*				can find one.					*/
	/*										*/
	/*  840417  E. A. Ranzenbach		Better error reporting stragegy which prevents syserr race	*/
	/*				conditions.					*/
	/*  840502  E. A. Ranzenbach		Changed certain reconfiguration options to not wire and 	*/
	/*				mask.						*/
	/*										*/
	/*  840517  E. A. Ranzenbach		Update the wired config deck dynamically.		*/
	/*										*/
	/*  840605  E. A. Ranzenbach		Fix garbled I/O problems and attempts to unlock oc_data 	*/
	/*				multiple times.					*/
	/*  840712  E. A. Ranzenbach		Fixed problem that stored uninitialized pointer in the 	*/
	/*				event queue.					*/
	/*										*/
 	/*  840724  E. A. Ranzenbach		To change timeouts to look for good status before retrying  */
	/*				the I/O. Necessary for bce breakpoints.			*/
	/*										*/
	/*  841105  E. A. Ranzenbach		Implemented printer_(on off) control order and fixed one	*/
	/*				more reconfiguration locking strategy problem.		*/
	/*										*/
	/*  841115  E. A. Ranzenbach		Change for Olin to send wakeup when taking back 		*/
	/*				responsibility for I/O from theMC.			*/
	/*										*/
	/*  841115  E. A. Ranzenbach		Simulate a pending READ during initialization.		*/
	/*										*/
	/*  850111  E. A. Ranzenbach		Added lost special interrupt protection so that EMC's	*/
	/* 				won't lose during heavey traffic.			*/
	/*  850329  E. A. Ranzenbach		Cut the size of I/O's to 132 chars, improved error	*/
	/*				reporting. TR19223.					*/
	/*  850405  E. A. Ranzenbach		Fixed console_io.io_in_progress not being reset during	*/
	/* 				console recovery. TR19225.				*/
	/*										*/
	/*  850620  Paul K  Farley		To wait five milliseconds after status arrives, if doing	*/
	/*                                      priority_io. This will allow the IMU console time to send   */
	/*                                      the interrupt and get ready for the next IO.                */
	/*										*/
	/*                                      Add code to check if PCW gets executed by console. Only     */
	/*                                      IOM consoles use it, and if on an IMU we need to know.      */
	/*										*/
	/*				Add a flag to know that the program was called at           */
	/*                                      $interrupt_handler.  Change the status pause check to       */
	/*                                      check this flag, instead of checking for priority io in     */
	/*                                      progress.  This is because there could be an IO             */
	/*                                      outstanding that will not terminate properly if not given   */
	/*                                      the extra time.                                             */
	/*										*/
	/*                                      Added code to LOCK(disable) or UNLOCK(enable) the console   */
	/*				input to the MCA (in the IMU).			*/
	/*										*/
	/*  850827  Paul K  Farley		To change report_error to locate the bootload console	*/
	/*                                      before outputting error message. Also added more info	*/
	/*                                      to the oc_data event trace.				*/
	/*										*/
	/*  850911  Paul K  Farley		To reset alerted switch in priority_io entry.		*/
	/*										*/
	/*  850913  Paul K  Farley		To add a timeout_factor to oc_entry for increasing the	*/
	/*                                      IO timeout under special conditions.			*/
	/*										*/
	/*  850925  Paul K  Farley		To allow for times when NO cpu cards are present and	*/
	/*				to properly find the entrypoint_name in report_error.	*/
	/*										*/
	/*  850930  Paul K  Farley		To add the process_group_id to the new MCA messages.	*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

console_free:
     entry (console_to_check_parm, console_is_free_parm);

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Entry to check if the specified console is available to RCP. If the console is not assigned as	*/
	/* a bootload or alternate then console_is_free is returned true. If no such console is configured	*/
	/* or the console is assigned as a bootload or alternate console then console_is_free is returned	*/
	/* false.										*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

/* parameters... (I) = Input, (O) = Output */

     dcl	console_to_check_parm	char	(4)	parameter;	/* name of the console to check...  (I) */
     dcl	console_is_free_parm	bit	(1)	parameter;	/* ON => console is free...	      (O) */

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


     console_to_check = console_to_check_parm;				/* copy args before we wire and mask...	*/

     call lock_oc_data ();						/* get the lock, wire and mask...	*/

     oc_entry_ptr = find_oc_entry (console_to_check);			/* locate the console...		*/
     if oc_entry_ptr = null then do;					/* no such animal...		*/
	call unlock_oc_data ();					/* release lock, unwire, unmask...	*/
	console_is_free_parm = false;					/* set parameter value...		*/
	return;
     end;

     console_is_free = (^oc_entry.bootload_console & ^oc_entry.alternate);	/* setup internal parm value...	*/

     call unlock_oc_data ();						/* release lock, unwire, unmask...	*/

     console_is_free_parm = console_is_free;				/* copy to caller's stack...		*/

     return;							/* done...			*/

console_info:
     entry (oc_name, oc_flags, oc_channel, oc_device_idx, oc_line_leng, code);

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Entry to return information about the requested console. If oc_name  = "" then information about	*/
	/* the bootload console is returned.							*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

/* parameters... (I) = Input, (O) = Output */

     dcl	oc_name			char	(4)	aligned		/* console info is requested for..(I/O) */
						parameter;
     dcl	oc_flags			bit	(36)	parameter;	/* oc_entry.flags...	      (O) */
     dcl	oc_channel		char	(8)	parameter;	/* console's IOM channel...	      (O) */
     dcl	oc_device_idx		fixed bin	(17)	parameter;	/* console's assigned device index..(O) */
     dcl	oc_line_leng		fixed bin	(17)	parameter;	/* console's line length...	      (O) */
/*   dcl	code			fixed bin	(35)	parameter;	   standard Multics error code...   (O) */

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

     oc_entry_ptr = find_oc_entry (oc_name);				/* locate the requested console...	*/

     if oc_entry_ptr = null then do;					/* no such console...		*/
	code = error_table_$device_not_active;
	return;
     end;

     oc_flags = unspec (oc_entry.flags);				/* copy the info...			*/
     oc_channel = oc_entry.channel;
     oc_device_idx = oc_entry.device_idx;
     oc_line_leng = oc_entry.line_leng;

     code = 0;							/* indicate successful completion...	*/

     return;

drain_io:
     entry ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Entry to quies the console. This is done by locking oc_data, thus preventing I/O queueing, then	*/
	/* completing any I/O in progress and then attempting to complete any I/O in the queue.		*/
	/*										*/
	/* Note: This entry leaves oc_entry.io_in_progress set to prevent further attempts at I/O...	*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     oc_data_ptr = addr (oc_data$);					/* locate oc_data...		*/

     if ^oc_data.in_service | oc_data.mc_io_enabled then return;		/* console is not configured...	*/

     oc_entry_ptr = find_oc_entry ("");					/* find the bootload console...	*/
     if oc_entry_ptr = null then return;				/* no console, no need to drain...	*/

     do while (^done);						/* quies the console...		*/
	call lock_oc_data ();					/* get the lock, wire and mask...	*/
	do while (oc_entry.io_in_progress);				/* finish I/O that is in progress...	*/
	     call process_io_status ();				/* process received statuses...	*/
	end;
	if next_console_io () = null then done = true;
	else call process_io ();					/* and outstanding I/O...		*/
	call unlock_oc_data ();					/* release lock, unwire and unmask...	*/
     end;

     oc_entry.io_in_progress = true;					/* only my hairdresser knows for sure...*/
          
     return;							/* pending I/O completed...		*/

err_event_chan:
     entry (event_chan);

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Entry which when called will install the event channel specified by the caller into		*/
	/* oc_data.err_event_cid. This event channel will be utilizied to wakeup the caller any time a	*/
	/* condition exists where I/O cannot be handled by any of the configured consoles.		*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

/* parameters... (I) = Input, (O) = Output */

     dcl	event_chan		fixed bin	(71)	parameter;	/* event channel to send wakeup on..(I) */

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

     oc_data_ptr = addr (oc_data$);					/* locate oc_data...		*/

     oc_data.err_event_cid = event_chan;				/* install the channel...		*/
     oc_data.err_event_pid = pds$process_id;				/* and the process ID of the caller...	*/

     return;							/* done...			*/

esd_reset:
     entry ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Entry called by ESD to ensure that it has a usable console.				*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     entrypoint = "esd_reset";					/* set entrypoint name...		*/
     
     oc_data_ptr = addr (oc_data$);					/* locate oc_data...		*/
     oc_data.lock = ""b;						/* reset lock...			*/

     if ^oc_data.in_service then do;					/* no good consoles to run on...	*/
	return;							/* all that is necessary...		*/
     end;

     oc_data.mc_io_enabled = false;					/* MC will not be operative...	*/

     oc_data.crash_on_crf = false;					/* give ESD a fair shake at recovery... */
     
     unspec (oc_data.priority_io) = ""b;				/* erase any residue...		*/
     oc_data.priority_io.completed = true;				/* mark the slot free...		*/
     
     do idx = 1 to WRITE_QUEUE_SIZE;					/* free all WRITES...		*/
	unspec (oc_data.write_queue (idx)) = ""b;			/* erase any residue...		*/
	oc_data.write_queue (idx).completed = true;			/* mark the slot free...		*/
     end;
     oc_data.write_q_full  = false;					/* reset the full flag...		*/

     oc_data.stacked_read_cnt = 1;					/* free all READs, leave one pending... */
     unspec (oc_data.read_io) = ""b;					/* erase any residue...		*/
     oc_data.read_io.completed = true;					/* mark the slot free...		*/
               
     call unassign_bootload_console ();					/* unassign the bootload console...	*/
     
     if oc_entry_ptr = null then do;					/* no bootload console found...	*/
	oc_data.in_service = false;					/* best we can do...		*/
	return;
     end;
       
     oc_entry.io_in_progress = false;					/* reset certain flags...		*/
     oc_entry.discard = false;
     oc_entry.discarded = false;
     oc_entry.got_special_int = false;
     oc_entry.oper_request = false;
     oc_entry.retry_cnt = 0;
     oc_entry.io_time = 0;

     call assign_bootload_console (oc_entry.name, err_code);		/* and now re-assign it...		*/

     call reset_channel ();						/* reset the console channel...	*/

     return;

get_input:
     entry (input_text, input_length, code);

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Entry to pickup operator input. Although there is only one physical READ I/O additional READs	*/
	/* may be queued before this one completes. This is accomplished by stacking the READ requests. As	*/
	/* a READ is picked up a check is made and the READ is reset if any READs have been stacked.	*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

/* parameters... (I) = Input, (O) = Output */

     dcl	input_text		char	(256)	parameter;	/* text of the input line...	      (O) */
     dcl	input_length		fixed bin	(17)	parameter;	/* length of the input line...      (O) */
/*   dcl	code			fixed bin	(35)	parameter;	   standard Multics error code...   (O) */

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

     input_text = "";						/* initialize...			*/
     input_length = 0;
     code = 0;

     oc_entry_ptr = find_oc_entry ("");					/* find the bootload console...	*/
     if oc_entry_ptr = null then return;				/* no console, no data...		*/

     call lock_oc_data ();						/* get the lock, wire and mask...	*/

     local_io = oc_data.read_io;					/* copy to local storage...		*/
     call reset_read ();						/* reset the READ I/O...		*/
     oc_data.stacked_read_cnt = oc_data.stacked_read_cnt - 1;		/* decrement the read stack...	*/
     if oc_data.stacked_read_cnt > 0 then do;				/* if we have stacked reads...	*/
	call log_console_event (POPPED_READ, addr (oc_data.read_io));	/* log the POP...			*/
     end;
     call unlock_oc_data ();						/* release lock, unwire and unmask...	*/
     input_text = local_io.text;					/* copy the input text...		*/
     input_length = local_io.leng;					/* and the input text length...	*/
     call log_console_event (READ_PICKUP, addr (oc_data.read_io));		/* log the event...			*/
     
     return;

get_mc_output:
     entry (mc_io_uid , output_length, output_text);


	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Entry called be the Message Coordinator to pickup the text of a non-syserr message. The	*/
	/* mc_io_uid contains the negated time that the message was queued. This was passed to the Message	*/
	/* Coordinator when we told it there was someting to do. This message UID is used to search the	*/
	/* message queue and retrieve the right message.						*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

/* parameters... (I) = Input, (O) = Output */

     dcl	mc_io_uid			fixed bin	(71)	parameter;	/* negated time queued of output... (I) */
     dcl	output_length		fixed bin	(17)	parameter;	/* 			      (O) */
     dcl	output_text		char	(256)	parameter;	/* 			      (O) */

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

     oc_data_ptr = addr (oc_data$);					/* locate oc_data...		*/
     oc_entry_ptr = null;

     do idx = 1 to WRITE_QUEUE_SIZE;					/* search the WRITE queue...		*/
	if -oc_data.write_queue (idx).time_queued = mc_io_uid then do;	/* found it...			*/
	     console_io_ptr = addr (oc_data.write_queue (idx));		/* overlay the WRITE...		*/
	     output_length = multiply (console_io.leng, 4, 17);		/* setup return parameters...		*/
	     output_text = console_io.text;
	     console_io.completed = true;				/* free the I/O slot...		*/
	     oc_data.write_q_full  = false;				/* reset the full flag...		*/
	     call log_console_event (MC_IO_PICKUP, console_io_ptr);
	     return;
	end;
     end;

     output_length = 0;						/* requested output not found...	*/
     output_text = "";

     call log_console_event (MC_IO_FAILURE, null);
     
     return;							/* done... 			*/

init_all_consoles:
     entry ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* This entry is called by real_initializer during initialization to configure all consoles	*/
	/* described in the config file.							*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     entrypoint = "init_all_consoles";					/* set entrypoint name...		*/
     
     oc_data_ptr = addr (oc_data$);					/* find oc_data...			*/
     oc_entry_ptr = null;
     
     unspec (oc_data) = ""b;						/* zero the database...		*/

     sd_ptr = addr (syserr_data$syserr_area);				/* find syserr data...		*/
     sd.char_type_flag = true;					/* ASCII console...			*/
     sd.ocdcm_init_flag = false;					/* specify no active console yet...	*/
     
     oc_data.version = oc_data_version;					/* set the version...		*/
     oc_data.flags.printer_on = true;					/* start with echoing input...	*/

     oc_data.last_read_queued = -1;					/* initialize some times...		*/
     oc_data.last_write_queued = -1;
     oc_data.last_poll_time = -1;
     oc_data.max_computed_io_time = MAX_MAX_IO_TIME * 1e06;			/* for now...			*/
     
     oc_data.next_free_write = 1;					/* initialize indices...		*/
     oc_data.next_event = 1;
     
     oc_data.read_io.completed = true;					/* free the read slot...		*/
     oc_data.priority_io.completed = true;				/* and mark priority as empty...	*/

     do idx = 1 to WRITE_QUEUE_SIZE;					/* mark all WRITE slots as free...	*/
	oc_data.write_queue (idx).completed = true;
     end;
     
     oc_data.abs_addr = absadr (oc_data_ptr, err_code);			/* find absolute address of oc_data...	*/
     if err_code ^= 0 then call report_error (PANIC, entrypoint,
	"Unable to determine absolute memory address of oc_data.");

     oc_data.prompt = "M-> " || copy (byte (binary ("177"b3)), 4);		/* setup prompt string & pad...	*/
     oc_data.write_return = "177177012015"b3;				/* string to write = PAD PAD CR LF...	*/
     oc_data.discard_notice = byte (10) || byte (13) || "(output discarded)" || /* initialize the discard notice...	*/
	byte (10) || byte (13) || copy (byte (binary ("177"b3)), 2);

     prph_opc_cardp = null;						/* initialize for card search...	*/

     call config_$find_parm ("ccrf", parm_ptr);				/* find the CCRF parm...		*/
     if parm_ptr ^= null then oc_data.crash_on_crf = true;			/* found it...			*/

     call config_$find_parm ("clst", parm_ptr);				/* find the CLST parm...		*/
     if parm_ptr ^= null then oc_data.list_consoles = true;			/* found it...			*/

     do while (^done);						/* process all "opc" "prph" cards...	*/
	call config_$find ("prph", prph_opc_cardp);			/* find a "prph" card...		*/
	if prph_opc_cardp = null then done = true;			/* no more prph cards...		*/
	else do;
	     if substr (prph_opc_card.name, 1, 3) = "opc" then do;		/* found an "opc" card...		*/
		if oc_data.console_cnt = MAX_OPC_CNT then do;		/* don't reference beyond oc_data...	*/
		     done = true;					/* signal end of initialization loop... */
		     call report_error (BEEP, entrypoint, "Maximum console count exceeded.");
		     call report_error (ANNOUNCE, entrypoint, "Additional consoles will not be configured.");
		end;
		else do;
		     call fill_oc_entry (oc_data_ptr,			/* build DCW list, etc...		*/
			oc_data.console_cnt + 1, prph_opc_cardp, oc_entry_ptr);
		     if oc_entry.active then				/* if we succeeded...		*/
			oc_data.console_cnt = oc_data.console_cnt + 1;
		end;
	     end;
	end;
     end;
     	
     if oc_data.console_cnt < 1 then do;				/* must be at least one opc card...	*/
	call report_error (PANIC, entrypoint, "Missing prph opc card.");
     end;
     
     do idx = 1 to oc_data.console_cnt;					/* locate the console...		*/
	oc_entry_ptr = addr (oc_data.opc (idx));
	if oc_entry.bootload_console then do;				/* found bootload console, turn it on...*/
	     call assign_bootload_console (oc_entry.name, err_code);
	     if err_code ^= 0 then call console_recovery ();
	     if oc_data.bootload_console_idx < 1 then
		call report_error (PANIC, entrypoint, "Console channel assignment failed.");
	     sd.ocdcm_init_flag = true;				/* enable syserr traffic...		*/
	end;
     end;

     if oc_data.bootload_console_idx < 1 then do;				/* must have an active console...	*/
	call console_recovery ();
	if oc_data.bootload_console_idx < 1 then
	     call report_error (PANIC, entrypoint, "No active console configured.");
     end;

     prph_opc_cardp = null;						/* might as well use this ptr...	*/
     cpu_cnt = 0;							/* initialize the counter...		*/
     done = false;							/* initialize loop terminator...	*/

     do while (^done);						/* count the number of CPUs...	*/
	call config_$find ("cpu", prph_opc_cardp);
	if prph_opc_cardp ^= null then cpu_cnt = cpu_cnt + 1;
	else done = true;
     end;
								/* maximum time we will wait for lock...*/
     oc_data.max_computed_io_time = oc_data.max_computed_io_time * max (1, cpu_cnt);
     
     if oc_data.list_consoles & 
	(sys_info$collection_1_phase = BOOT_INITIALIZATION  
	| sys_info$collection_1_phase = SERVICE_INITIALIZATION) then
	do idx = 1 to oc_data.console_cnt;				/* list the assignments...		*/
	     oc_entry_ptr = addr (oc_data.opc (idx));
	     device_type = "uninitialized";
	     if oc_entry.bootload_console then device_type = "bootload";
	     else if oc_entry.alternate then device_type = "alternate";
	     else if oc_entry.io_device then device_type = "I/O";
	     else if oc_entry.inop_device then device_type = "inoperative";
	     else if oc_entry.no_device then device_type = "off";
	     call report_error (ANNOUNCE, entrypoint, "Assigned console ^a as ^a device.",
		oc_entry.name, device_type);
     end;
     
     if sys_info$collection_1_phase < SERVICE_INITIALIZATION then do;		/* simulate a waiting READ...		*/
	oc_data.opc (oc_data.bootload_console_idx).oper_request = true;	/* prime the RE(TURN QUEST) key...	*/
     end;
     
     call log_console_event (INIT_OC_DATA, oc_data.io_ptr);

     return;							/* done...			*/

interrupt_handler:
     entry (assigned_idx, interrupt_level, fault_status);

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Entry called to field an interrupt for the console channel. It should be noted that any Multics	*/
	/* process on the CPU when the interrupt arrives will execute this code. If we are unable to get	*/
	/* the lock and we have a special interrupt (level 7) then we will post it in a special area of	*/
	/* oc_data that can be modified without protection of the lock. It is the responsibility of anyone	*/
	/* unlocking oc_data to process any pending specials.					*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

/* parameters... (I) = Input, (O) = Output */

     dcl	assigned_idx		fixed bin	(35)	parameter;	/* index of console causing interrupt. (I) */
     dcl	interrupt_level		fixed bin	(3)	parameter;	/* should be 1, 3, or 7...	      (I) */
     dcl	fault_status		bit	(36)	parameter;	/* system fault status, IGNORED...  (I) */

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

     entrypoint = "interrupt_handler";					/* set entrypoint name...		*/
     
     
     entered_via_interrupt = true;					/* show which way we came in..	*/

     if interrupt_level = 1 then do;					/* IOM overhead fault...		*/
	call report_error (JUST_LOG, entrypoint, "System Fault.");		/* log it...			*/
	return;							/* and ignore it...			*/
     end;

     oc_data_ptr = addr (oc_data$);					/* locate oc_data...		*/
     
     oc_entry_ptr = find_oc_entry ("");					/* locate the bootload console...	*/
     if oc_entry_ptr = null then return;				/* no bootload console... */
     if assigned_idx > 0 & assigned_idx ^= oc_entry.device_idx then do;	/* interrupt not from bootload console. */
	if interrupt_level = 7 then return;				/* no specials, please...		*/
          do idx = 1 to oc_data.console_cnt;				/* locate the console...		*/
	     if oc_data.opc (idx).device_idx = assigned_idx then		/* found it...			*/
	          oc_entry_ptr = (addr (oc_data.opc (idx)));
	end;
	if assigned_idx ^= oc_entry.device_idx then return;		/* could not locate console...	*/
	if ^oc_entry.assigned then return;				/* console no longer assigned...	*/
     end;

     if stac (addr (oc_data.lock), pds$process_id) then do;			/* only field terminates if we get lock.*/
	call wire_and_mask;						/* so unlock can unwire...		*/
	if interrupt_level = 7 then oc_entry.got_special_int = true;	/* operator pushed RE(TURN QUEST) ...	*/
     
	call process_io_status ();					/* process any associated I/O status... */

	call process_io ();						/* process any waiting output...	*/

	call unlock_oc_data ();					/* release lock, unwire and unmask...	*/
     end;
     else if interrupt_level = 7 then do;
	oc_data.no_lock_flags.got_special_int = true;
	oc_data.meters.queued_special_int_count = oc_data.meters.queued_special_int_count +1;
     end;
     
     return;

poll_for_timeout:
     entry ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Entry called by traffic control to check for I/O timeouts on the console.			*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     oc_data_ptr = addr (oc_data$);					/* locate oc_data...		*/

     if ^oc_data.in_service | oc_data.mc_io_enabled then return;		/* no console service, no timeouts...	*/
          
     if oc_data.lock = pds$process_id then do;				/* MYLOCK error...			*/
	call report_error (PANIC, "lock_oc_data", "Mylock error.");		/* crash system, store flagbox message..*/
     end;

     if ^stac (addr (oc_data.lock), pds$process_id) then return;		/* if I can't get the lock return...	*/
          
     oc_data.last_poll_time = clock ();					/* note last time polling occured...	*/

     oc_entry_ptr = find_oc_entry ("");					/* find the bootload console entry...	*/

     if oc_entry_ptr ^= null then do;					/* only do if console available...	*/
	call process_io_status ();					/* timeout check done there..		*/

	call process_io ();						/* process any waiting output...	*/
     end;
     else if ^oc_data.mc_io_enabled then
	oc_data.in_service = false;

     if ^stacq (oc_data.lock, ""b, pds$process_id) then do;			/* clear lock...			*/
	if oc_data.lock ^= ""b then					/* if not free crash...		*/
	     call report_error (PANIC, "unlock_oc_data", "Lock not mine.");
     end;
          
     return;							/* done...			*/

printer_off:
     entry ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Entry which implements "printer_off" control order. Once this entry has been called all input	*/
	/* from the console will be in the blind until the "printer_on" entry is called.		*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     oc_data_ptr = addr (oc_data$);					/* no need to lock and wire for this...	*/
     oc_data.flags.printer_on = false;					/* turn off read echoing...		*/
     return;							/* all there is to it...		*/
     
printer_on:
     entry ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Re-enables echoing of input from the console...					*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     oc_data_ptr = addr (oc_data$);					/* no need to lock and wire for this... */
     oc_data.flags.printer_on = true;					/* turn it back on...		*/
     return;							/* all there is to it...		*/

priority_io:
     entry (priority_io_ptr);

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* This entry provides a means of performing priority I/O to the operator's console. The I/O is	*/
	/* placed into a special buffer in oc_data. The caller then calls the appropriate internal	*/
	/* procedures to cause the I/O to be immediately executed.					*/
	/*										*/
	/* 			     * * *  W A R N I N G * * *				*/
	/*										*/
	/* The use of this entrypoint causes the caller to loop in ocdcm_ awaiting the successful		*/
	/* completion of the I/O. This looping is done on a wired stack in a masked interrupt environment	*/
	/* and can cause the processor of execution to loop for as long as it takes to complete the I/O. 	*/
	/* For READs this can take longer than thirty (30) seconds.					*/
	/*										*/
	/* Noting the effects that this can have on performance it is imperative that this entrypoint be	*/
	/* utilized judiciously.								*/
	/*										*/
	/* Note:	An additional side effect of this entrypoint is that I/O performed by it will not be in	*/
	/* chronological order with I/O performed through the queue_io entrypoint.			*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

/* parameters... (I) = Input, (O) = Output */

     dcl	priority_io_ptr		ptr		parameter;	/* -> console_io structure...	      (I) */

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

     oc_data_ptr = addr (oc_data$);					/* locate oc_data...		*/

     if ^oc_data.in_service then return;				/* no tickee, no washee...		*/

     local_io = priority_io_ptr -> console_io;				/* copy the I/O to our stack...	*/

     call lock_oc_data ();						/* get the lock, wire and mask...	*/

     oc_data.priority_io = local_io;					/* copy the priority I/O...		*/

     oc_data.priority_io.time_queued = clock ();				/* next_console_io needs this...	*/
     oc_data.priority_io.process_id = pds$process_id;			/* store our process_id...		*/
     oc_data.priority_io.event_chan = 0;				/* caller will loop on completion...	*/
     oc_data.priority_io.completed = false;				/* start off on the right foot..	*/
     oc_data.priority_io.in_progress = false;
     oc_data.priority_io.alerted = false;
     
     if oc_data.priority_io.read then do;				/* reset READ stuff...		*/
	oc_data.priority_io.sequence_no = 0;				/* READs don't have syserr numbers...	*/
	oc_data.priority_io.prompted = false;
	oc_data.priority_io.leng = 0;
	oc_data.priority_io.text = "";
     end;

     oc_entry_ptr = find_oc_entry ("");					/* locate the bootload console...	*/
          
     if oc_entry_ptr ^= null then
	do while (oc_entry.io_in_progress);				/* quies the console...		*/
	call process_io_status ();
     end;

     if oc_data.mc_io_enabled then do;					/* Message Coordinator is handling I/O..*/
	if ^oc_data.priority_io.read then do;				/* only pass on WRITEs...		*/
	     call bump_io_to_mc ((oc_data.priority_io.sequence_no));
	     oc_data.priority_io.completed = true;			/* free the space...		*/
	end;
	call unlock_oc_data ();					/* release lock, unwire, unmask...	*/
	return;							/* all we can do...			*/
     end;


     do while (^oc_data.priority_io.completed);				/* LOOP IN RING ZERO TILL I/O COMPLETE..*/
	call process_io ();						/* process the I/O...		*/
	if oc_data.priority_io.read & ^oc_data.priority_io.in_progress then do;
	     call unlock_oc_data ();					/* let Special interrupts through...	*/
	     call lock_oc_data ();					/* and wire and mask again...		*/
	end;
	call process_io_status ();					/* process the status...		*/
     end;

     local_io = oc_data.priority_io;					/* copy results to local storage...	*/
     oc_data.priority_io.read = false;					/* prevent priority READ resets...	*/

     call unlock_oc_data ();						/* release lock, unwire and unmask...	*/

     if local_io.read then do;					/* copy results for the caller...	*/
	priority_io_ptr -> console_io = local_io;
     end;

     return;							/* I/O complete...			*/

queue_io:
     entry (user_io_ptr, io_queue_time);

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Entry to queue an I/O. This entry first copies the I/O onto our stack before we wire it with a	*/
	/* call to lock_oc_data. This is necessary because we would are not allowed to page fault on the	*/
	/* callers data after we wire ourselves. The entry the makes some preliminary decisions about the	*/
	/* I/O and the console state and calls the queue_console_io routine to do the actual queueing. For	*/
	/* WRITEs the caller is returned the time that the I/O is queued. If that time is 0 then the queue	*/
	/* is full and the caller will have to try again later. A time of 0 is always returned for	*/
	/* READs since the caller always goes blocked awaiting READ completion.			*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
     
/* parameters... (I) = Input, (O) = Output */

     dcl	user_io_ptr		ptr		parameter;	/* -> console_io structure...	      (I) */
     dcl	io_queue_time		fixed bin	(71)	parameter;	/* UID of this I/O request...	      (O) */

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

     oc_data_ptr = addr (oc_data$);					/* find oc_data...			*/
     
     if ^oc_data.in_service then do;					/* pass it to the log...		*/
	call syserr (JUST_LOG, substr (user_io_ptr -> console_io.text, 1,
	     multiply (user_io_ptr -> console_io.leng, 4, 17)));
	io_queue_time = clock ();					/* make it look as if successful...	*/
	return;
     end;

     local_io = user_io_ptr -> console_io;				/* copy the I/O to our stack...	*/

     if oc_data.write_q_full & ^local_io.read then do;			/* no room at the Inn...		*/
	oc_data.meters.write_q_full_cnt = oc_data.meters.write_q_full_cnt + 1;
	io_queue_time = 0;						/* make them try again...		*/
	return;
     end;
     
     call lock_oc_data ();						/* get the lock, wire and mask...	*/

     oc_entry_ptr = find_oc_entry ("");					/* locate the bootload console...	*/
     
     if oc_data.mc_io_enabled then do;					/* Message Coordinator is handling I/O..*/
	local_time = 0;
	if ^local_io.read then do;					/* only pass on WRITEs...		*/
	     local_time = queue_console_io ();				/* attempt to queue the I/O...	*/
	     if local_time ^= 0 then do;				/* if we were successful then do...	*/
		call bump_io_to_mc ((-local_time));			/* send I/O to the MC...		*/
	     end;
	end;
	else local_time = clock ();					/* simulate successful queuing of READ..*/
	call unlock_oc_data ();					/* release lock, unwire, unmask...	*/
	io_queue_time = local_time;					/* copy argument...			*/
	return;							/* all we can do...			*/
     end;

     if oc_entry_ptr = null then do;					/* no bootload console...		*/
	call syserr (JUST_LOG, substr (user_io_ptr -> console_io.text, 1,
	     multiply (user_io_ptr -> console_io.leng, 4, 17)));
	io_queue_time = clock ();					/* make it look as if successful...	*/
	oc_data.in_service = false;
	return;
     end;

     if oc_entry.discard & ^local_io.read then do;			/* if DISCARD condition and not a READ..*/
	if ^oc_entry.discarded then do;				/* haven't informed them yet...	*/
	     oc_entry.discarded = true;				/* note that we're informing them...	*/
	     call log_console_event (DISCARDED_OUTPUT, oc_data.io_ptr);	/* log it...			*/
	end;
	call unlock_oc_data ();					/* release lock, unwire and unmask...	*/
	io_queue_time = -1;						/* let caller know...		*/
	return;							/* flush the output...		*/
     end;

     call process_io_status ();					/* process any pending I/O status...	*/
     call process_io ();						/* process any pending I/O...		*/
     local_time = queue_console_io ();					/* attempt to queue the I/O...	*/

     call process_io ();						/* attempt to start the I/O...	*/
     
     call unlock_oc_data ();						/* release lock, unwire and unmask...	*/

     io_queue_time = local_time;					/* copy argument...			*/
               
     return;

reconfigure:
     entry (console_name_parm, reconfig_option_parm, code);

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* This entry is called to explicitly reconfigure any configured console. The respective actions	*/
	/* taken are controlled via the reconfig_option parameter and are described in			*/
	/* opc_reconfig_options.incl.pl1							*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

/* parameters... (I) = Input, (O) = Output */

     dcl	console_name_parm		char	(4)	parameter;	/* console being reconfigured or MCA	*/
								/* number to unlock "M_xx"...       (I) */
     dcl	reconfig_option_parm	fixed bin	(17)	parameter;	/* see opc_reconfig_options...      (I) */
/*   dcl	code			fixed bin	(35)	parameter;	   standard Multics error code...   (O)	*/

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

     entrypoint = "reconfigure";					/* set entrypoint name...		*/
     audit_flag = "0"b;
     code = 0;							/* initialize it...			*/
     console_name = console_name_parm;					/* copy arguments into our stack...	*/
     reconfig_option = reconfig_option_parm;

     oc_data_ptr = addr (oc_data$);					/* for unwired operations...		*/
     
     if reconfig_option = NOP then do;					/* just return an error code...	*/
	code = error_table_$no_operation;
     end;
     
     if reconfig_option = SUSPEND_CONSOLE_SERVICE then do;			/* indicate no console service...	*/
	oc_data.in_service = false;					/* and normal I/O...		*/
	return;
     end;
     
     if reconfig_option = ENABLE_CONSOLE_SERVICE then do;			/* indicate no console service...	*/
	oc_data.in_service = true;					/* and normal I/O...		*/
	return;
     end;
     
     if reconfig_option = SEND_MC_IO then do;				/* send I/O to MC...		*/
	oc_data.mc_io_enabled = true;
	return;
     end;
     
     if reconfig_option = CRASH_ON_CRF then do;				/* set the right flags...		*/
	oc_data.crash_on_crf = true;
	return;
     end;

     if reconfig_option = RUN_ON_CRF then do;				/* set the right flags...		*/
	oc_data.crash_on_crf = false;
	return;
     end;

     if reconfig_option = UNLOCK_MCA_INPUT then do;			/* save mca# & reset console_name...	*/
	mca_to_unlock = cv_dec_check_ (substr (console_name, 3, 2), err_code);
	if substr (console_name, 1, 2) ^= "M_" | err_code ^= 0 | mca_to_unlock < MIN_MCA | mca_to_unlock > MAX_MCA then do;
	     code = error_table_$bad_arg;
	     return;
	end;
	console_name = "";
     end;

     call lock_oc_data ();						/* get lock, wire and mask...		*/

     oc_entry_ptr = find_oc_entry (console_name);
     if oc_entry_ptr = null then do;					/* it is not...			*/
null_ocep:
	call unlock_oc_data ();					/* release lock, unwire, unmask...	*/
	code = error_table_$dev_nt_assnd;
	return;
     end;

     if reconfig_option = RESET_CONSOLE then do;
	call reset_console ();					/* simple enough...			*/
	call unlock_oc_data ();					/* release lock, unwire, unmask...	*/
	return;
     end;

     if reconfig_option = MAKE_BOOTLOAD_CONSOLE then do;			/* make specified console the bootload..*/
	call unassign_bootload_console ();				/* unassign the current bootload console*/
	if oc_entry_ptr ^= null then do;
	     oc_entry.alternate = true;				/* make available to console recovery...*/
	     oc_entry.io_device = false;
	     call change_console_state ();
	end;
	call assign_bootload_console (console_name, err_code);		/* attach the console...		*/
	if err_code ^= 0 then do;
	     if old_console_name ^= "" then
		call assign_bootload_console (old_console_name, (0));	/* reattach the old console...	*/
	     call unlock_oc_data ();					/* release lock, unwire, unmask...	*/
	     code = err_code;					/* OK for page / seg faults...	*/
	     return;						/* all we can do...			*/
	end;
	call report_error (BEEP, entrypoint, "Assigned ^a as the bootload console for ^a.", oc_entry.name, pds$process_group_id);
	call unlock_oc_data ();
	return;
     end;

     if reconfig_option = MAKE_ALTERNATE_CONSOLE then do;			/* make specified console an alternate..*/
	if oc_entry.bootload_console then do;				/* not a good move...		*/
	     call unlock_oc_data ();					/* release lock, unwire, unmask...	*/
	     code = error_table_$device_busy;				/* device is not available...		*/
	     return;
	end;
	oc_entry.alternate = true;					/* set the proper flags...		*/
	oc_entry.io_device = false;
	oc_entry.inop_device = false;
	oc_entry.no_device = false;
	oc_entry.config_change = true;				/* note config change has occurred...	*/
	call change_console_state ();
	call report_error (BEEP, entrypoint, "Assigned ^a as an alternate console for ^a.",
	     oc_entry.name, pds$process_group_id);
	call unlock_oc_data ();
	return;
     end;
     
     if reconfig_option = MAKE_IO_DEVICE then do;				/* make specified console an I/O device.*/
	if oc_entry.bootload_console then do;				/* not a good move...		*/
	     if oc_data.err_event_cid ^= 0 then oc_data.mc_io_enabled = true; /* use Message Coordinator if we can... */
	     else do;
		if oc_data.crash_on_crf then call report_error (PANIC,	/* that was a dumb move...		*/
		     entrypoint, "Bootload console deconfigured with CCRF set.");
		else oc_data.in_service = false;			/* just send it to the log...		*/
	     end;
	     call unassign_bootload_console ();
	     if oc_entry_ptr = null then do;				/* lost console, try to relocate...	*/
		oc_entry_ptr = find_oc_entry (console_name);
		if oc_entry_ptr = null then goto null_ocep; 		 /* can't locate.  Report error to caller */
	     end;
	end;
	oc_entry.io_device = true;					/* set the proper flags...		*/
	oc_entry.alternate = false;
	oc_entry.inop_device = false;
	oc_entry.no_device = false;
	oc_entry.config_change = true;				/* note config change has occurred...	*/
	call change_console_state ();
	call report_error (BEEP, entrypoint, "Consigned ^a as an I/O device for ^a.",
	     oc_entry.name, pds$process_group_id);
	call unlock_oc_data ();
	return;
     end;
     
     if reconfig_option = MAKE_INOP_DEVICE then do;			/* make specified console an I/O device.*/
	if oc_entry.bootload_console then do;				/* not a good move...		*/
	     if oc_data.err_event_cid ^= 0 then oc_data.mc_io_enabled = true; /* use Message Coordinator if we can... */
	     else do;
		if oc_data.crash_on_crf then call report_error (PANIC,	/* that was a dumb move...		*/
		     entrypoint, "Bootload console deconfigured with CCRF set.");
		else oc_data.in_service = false;			/* just send it to the log...		*/
	     end;
	     call unassign_bootload_console ();
	     if oc_entry_ptr = null then do;				/* lost console, try to relocate...	*/
		oc_entry_ptr = find_oc_entry (console_name);
		if oc_entry_ptr = null then goto null_ocep; 		 /* can't locate.  Report error to caller */
	     end;
	end;
	oc_entry.inop_device = true;					/* set the proper flags...		*/
	oc_entry.io_device = false;
	oc_entry.alternate = false;
	oc_entry.no_device = false;
	oc_entry.config_change = true;				/* note config change has occurred...	*/
	call change_console_state ();
	call report_error (BEEP, entrypoint, "Marked ^a as an inoperative device for ^a.",
	     oc_entry.name, pds$process_group_id);
	call unlock_oc_data ();
	return;
     end;

     if reconfig_option = MAKE_UNAVAILABLE then do;			/* delete console from configuration... */
	if oc_entry.bootload_console then do;				/* can't go directly from "on" to "off".*/ 
	     call unlock_oc_data ();					/* relinquish lock, unwire, unmask...	*/
	     code = error_table_$resource_not_free;
	     return;
	end;
	else do;
	     oc_entry.inop_device = false;				/* set the proper flags...		*/
	     oc_entry.io_device = false;
	     oc_entry.alternate = false;
	     oc_entry.no_device = true;
	     oc_entry.config_change = true;				/* note config change has occurred...	*/
	     call change_console_state ();
	     call unlock_oc_data ();
	     return;
	end;
     end;

     if reconfig_option = LOCK_MCA_INPUT |
	reconfig_option = UNLOCK_MCA_INPUT then do;
          audit_flag = (sys_info$collection_1_phase = SERVICE_INITIALIZATION);
	call lock_unlock_mca ();					/* do the lock or unlock...		*/
	if ^mca_lock_unlock_success then code = error_table_$action_not_performed;
	call unlock_oc_data ();					/* release lock, unwire, unmask...	*/
	return;
     end;

     call unlock_oc_data ();						/* should never really get here...	*/
          
     return;
     

set_prompt:
     entry (new_prompt_parm);

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Entry to set the prompt. The prompt can be set to any 6 character string. If the prompt	*/
	/* specified is "" then the default of "M->" will be set.					*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

/* parameters... (all input) */

     dcl	new_prompt_parm		char	(8)	parameter;	/* new prompt string...	      (I) */

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

     new_prompt = new_prompt_parm;					/* copy arguments...		*/
     
     call lock_oc_data ();						/* get lock, wire and mask...		*/

     if rtrim (new_prompt) = "" then new_prompt = "M->";			/* default case...			*/
     else new_prompt = rtrim (substr (new_prompt, 1, 6)) || "->";		/* format the prompt...		*/

     oc_data.prompt = new_prompt;					/* install it...			*/

     call unlock_oc_data ();						/* relinquish lock, unwire, unmask...	*/

     return;

BAIL_OUT:
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/*  BAIL_OUT is used as a non-local goto from process_io when it is found that there is		*/
	/* no current console.								*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     if ^stacq (oc_data.lock, ""b, pds$process_id) then do;			/* clear lock if it is ours...	*/
	if oc_data.lock ^= ""b then					/* not ours, if not free crash...	*/
	     call report_error (PANIC, "unlock_oc_data", "Lock not mine.");
     end;

     call unwire_and_unmask;						/* unwire stack, accept interrupts...	*/

     return;


assign_bootload_console:
     proc (name, error_code);


	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure to assign the specified console as the bootload console. When this procedure	*/
	/* returns all oc_entry flags for the assigned console are correctly set, the bootload console	*/
	/* entry index oc_data.bootload_console_idx is correctly set and the oc_data.in_service flag is	*/
	/* set.										*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     
/* parameters... (I) = Input, (O) = Output */

     dcl	name			char	(4)	aligned		/* of the console to activate...    (I) */
						parameter;
     dcl	error_code		fixed bin	(35)	parameter;	/* standard Multics error code...   (O) */

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

     oc_entry_ptr = find_oc_entry (name);				/* check to see if console active...	*/
     if oc_entry_ptr = null then do;					/* specified console not active...	*/
	error_code = error_table_$device_not_active;
	return;
     end;

     call io_manager$assign (oc_entry.device_idx, oc_entry.channel,		/* attach this console...		*/
	ocdcm_$interrupt_handler, (0), oc_data.status_ptr, error_code);
     if error_code ^= 0 then return;

     oc_entry.assigned = true;
     oc_data.bootload_console_idx = oc_entry.opc_idx;			/* note this is the bootload console... */
     oc_entry.bootload_console = true;					/* and flag it...			*/
     oc_entry.alternate = false;					/* make sure things are consistent...	*/
     oc_entry.io_device = false;
     oc_entry.inop_device = false;
     oc_entry.no_device = false;
     oc_entry.retry_cnt = 0;						/* reset the I/O retry count...	*/
     oc_entry.config_change = true;					/* note config change has occurred...	*/
     call change_console_state ();
     
     oc_data.in_service = true;					/* we can start processing I/O...	*/
     if oc_data.mc_io_enabled then do;					/* tell MC that we are taking over...	*/
	call pxss$ring_0_wakeup (oc_data.err_event_pid, oc_data.err_event_cid, 0, (0));
	oc_data.mc_io_enabled = false;				/* suspend MC I/O...		*/
     end;
               
     return;

end assign_bootload_console;

bump_io_to_mc:
     proc (io_uid);


	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure to inform the Message Coordinator that there is a message that it should	*/
	/* handle. The Message Coordinator will be sent a message containing the UID of the message to be	*/
	/* processed by it. This io_uid is a syserr sequence number for syserr messages or the negated	*/
	/* time that the I/O was queued for non-syserr traffic.					*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

/* parameters... (I) = Input, (O) = Output */

     dcl	io_uid			fixed bin (71)	parameter;	/* used by the MC to get this I/O...(I) */

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

     if oc_data.err_event_cid ^= 0 then do;				/* if MC has placed process ID here...	*/
	call pxss$ring_0_wakeup (oc_data.err_event_pid, oc_data.err_event_cid,/* tell MC about the I/O...		*/
	     io_uid, (0));
	if io_uid > 0 then call log_console_event (SENT_MC_PRIORITY_IO, addr (oc_data.priority_io));
	else call log_console_event (SENT_MC_IO, console_io_ptr);
	return;
     end;
     else do;							/* Message Coordinator disappeared...	*/
	if oc_data.crash_on_crf | sys_info$collection_1_phase < SERVICE_INITIALIZATION then
								/* sorry, MUST crash...		*/
	     call unlock_oc_data ();					/* relinquish lock, unwire, unmask...	*/
	     call syserr_real$panic ("ocdcm_ (bump_io_to_mc): Console recovery failure.");
	oc_data.mc_io_enabled = false;
	oc_data.in_service = false;
	call report_error (JUST_LOG, "bump_io_to_mc", "Message Coordinator failure.");
	return;
     end;
          
end bump_io_to_mc;

change_console_state:
     proc ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal entry to change the state of a console as listed in the config file.  The config file	*/
	/* is wired so but the conf partition must be paged. In order to write the partition we will have	*/
	/* to call config_$update when were unwired and unmasked. This is not yet implemented.		*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     do idx = 1 to MAX_OPC_CNT;					/* check all consoles for changes...	*/
	if oc_data.opc (idx).active then do;				/* only check active entries...	*/
	     if oc_data.opc (idx).config_change then do;			/* found a config change...		*/
		oc_data.opc (idx).config_change = false;		/* reset change indicator...		*/
		if oc_data.opc (idx).bootload_console then new_state = "on";
		else if oc_data.opc (idx).alternate then new_state = "alt";
		else if oc_data.opc (idx).io_device then new_state = "io";
		else if oc_data.opc (idx).inop_device then new_state = "inop";
		else if oc_data.opc (idx).no_device then new_state = "off";
		prph_opc_cardp = null;				/* start ath the beginning of the file..*/
		console_found = false;				/* reset loop terminator...		*/
		do while (^console_found);				/* process all "opc" "prph" cards...	*/
		     call config_$find ("prph", prph_opc_cardp);		/* find a "prph" card...		*/
		     if prph_opc_cardp = null then console_found = true;	/* no more prph cards...		*/
		     else do;
			if prph_opc_card.name = oc_data (idx).name then do;    /* found it...			*/
			     prph_opc_card.state = new_state;		/* update the new state...		*/
			     console_found = true;			/* signal end of loop...		*/
			end;
		     end;
		end;
	     end;
	end;
     end;

     return;							/* done...			*/
     
end change_console_state;

console_recovery:
     proc ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure to attempt console failure recovery. This procedure takes the following	*/
	/* actions:									*/
	/*										*/
	/* 	1.) Attempt to find an alternate console making it the bootload if one is found.	*/
	/*										*/
	/* 	2.) If no alternates exist attempt to set up switches so that all I/O is bumped to the	*/
	/* 	Message Coordinator if one exists.						*/
	/*										*/
	/* 	3.) If no Message Coordinator exists then take the following actions with regards to the	*/
	/* 	CCRF parm specified in the config file:						*/
	/*										*/
	/* 		a.) If CCRF was specified then crash.					*/
	/* 		b.) If CCRF was not specified setup switches so that all I/O is bumped to the	*/
	/* 		syserr_log.							*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     entrypoint = "console_recovery";					/* set entrypoint name...		*/

     if oc_data.must_have_console then do;				/* ensure we have a real console...	*/
	call poll_for_console ();					/* it will find one...		*/
	oc_data.must_have_console = false;				/* reset flag...			*/
	return;							/* done all that was required...	*/
     end;

     error_msg = "";						/* clear error message...		*/
     
     call unassign_bootload_console ();					/* unassign the bootload console...	*/

     if oc_entry_ptr ^= null then do;					/* if unassign_bootload_console found it*/
	oc_entry.io_device = false;					/* this was set by unassign_bootload... */
	oc_entry.inop_device = true;					/* mark it inoperative...		*/
	oc_entry.config_change = true;				/* note config change occurred...	*/
     end;
     
     found = false;							/* initialize loop terminator...	*/

     do idx = 1 to oc_data.console_cnt while (^found);			/* locate an alternate console...	*/
	oc_entry_ptr = addr (oc_data.opc (idx));			/* find the console entry...		*/
	if oc_entry.alternate then do;				/* found one...			*/
	     found = true;						/* signal loop termination...		*/
	     call assign_bootload_console (oc_entry.name, err_code);	/* assign it...			*/
	     if err_code = 0 then do;					/* assignment successful...		*/
		call ioa_$rsnnl ("Console inoperative, alternate ^a assigned.",
		     error_msg, 0, oc_entry.name);
	     end;
	     else do;						/* assignment failed...		*/
		call ioa_$rsnnl ("Console failed, assignment of alternate ^a failed.",
		     error_msg, 0, oc_entry.name);
		oc_entry.inop_device = true;				/* change its state...		*/
		oc_entry.alternate = false;
		oc_entry.config_change = true;			/* note config change occurred...	*/
		found = false;					/* continue search...		*/
	     end;
	end;
     end;

     if ^found then do;						/* no alternates, MC or CRASH?...	*/
	if oc_data.err_event_cid = 0 then do;				/* no Message Coordinator...		*/
	     if oc_data.crash_on_crf | sys_info$collection_1_phase < SERVICE_INITIALIZATION then do;
								/* no choice but to crash...		*/
		call report_error (PANIC, entrypoint, "Console recovery failure.");
	     end;
	     oc_data.in_service = false;				/* next time we'll know...		*/
	     oc_data.mc_io_enabled = false;				/* ditto...			*/
	end;
	else oc_data.mc_io_enabled = true;				/* flag MC is in control...		*/

	if oc_data.mc_io_enabled then do;
	     error_msg = "Console inoperative, no alternates available.";	/* let 'em know...			*/
	end;
	else do;
	     error_msg = "Console inoperative, no alternates, no MC.";
	     console_io_ptr = oc_data.io_ptr;
	     console_io.in_progress = false;				/* reset failed I/O to prevent MYLOCK...*/
	     oc_data.priority_io.completed = true;                            /* mark this so priority_io will not loop on it forever. */
	end;
     end;

     call change_console_state ();					/* show any changes that may have occured */

     if error_msg ^= "" then call report_error (JUST_LOG, entrypoint, error_msg);

     return;							/* done...			*/
          
end console_recovery;

console_responds_to_bell:
     proc (console_idx) returns (bit (1));

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure that sends a bell to the the specified console and returns true if the I/O	*/
	/* succeeds.									*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

/* parameters... (all input) */

     dcl console_idx		fixed bin	(17)	parameter;	/* index of the console to test...	*/

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


     oc_entry_ptr = addr (oc_data.opc (console_idx));			/* overlay it...			*/
     oc_entry.dcw_list_idx = ALERT_DCW;					/* we'll test by sending a bell...	*/
     call initiate_io ();						/* send it...			*/
     do while (^io_status.t);						/* wait for termination...		*/
     end;
     
     if io_status_overlay.major = "00"b3 then return (true);
     else return (false);
     
end console_responds_to_bell;

console_in_imu:
     proc () returns (bit (1));


	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal function that returns true if the specified console is located in an IMU style IOM.	*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     iom_cardp = null;
     call config_$find ("iom", iom_cardp);
     do while (iom_cardp ^= null);
	if iom_card.model = "imu" | iom_card.model = "iioc" then do;	/* found an IMU...		*/
	     if iom_card.tag = prph_opc_card.iom then return (true);	/* console in this IMU...	*/
	end;
	call config_$find ("iom", iom_cardp);				/* find next iom card...	*/
     end;
     return (false);						/* console not in an IMU...	*/
end console_in_imu;

fill_oc_entry:
     proc (oc_data_struct_ptr, console_entry_idx, opc_card_ptr, oc_entry_ptr_arg);


	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure that fills in an opc entry describing a configured operator's console. This	*/
	/* procedure builds the DCW list for the device. This list is composed IDCWs describing a device	*/
	/* instruction and optionally a DCW describing a data transfer.				*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

/* parameters... (I) = Input, (O) = Output */

     dcl	oc_data_struct_ptr		ptr		parameter;	/* -> oc_data...		      (I) */
     dcl	console_entry_idx		fixed bin	(17)	unaligned
     						parameter,	/* index into the opc console array.(I) */
	opc_card_ptr		ptr		parameter,	/* -> "opcx" "prph" card...	      (I) */
	oc_entry_ptr_arg		ptr		parameter;	/* -> oc_entry...		      (O) */

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

     oc_data_ptr = oc_data_struct_ptr;					/* copy arguments...		*/
     prph_opc_cardp = opc_card_ptr;

     oc_entry_ptr = addr (oc_data.opc (console_entry_idx));			/* entry to fill...			*/
     oc_entry_ptr_arg = oc_entry_ptr;					/* returned to caller...		*/

     unspec (oc_entry) = ""b;						/* just to be safe...		*/

     if prph_opc_card.name < "opca" | prph_opc_card.name > "opcz" then do;
	call report_error (BEEP, "Illegal console name (^a) specified. It will be ignored.", prph_opc_card.name);
	return;
     end;

     oc_entry.active = true;						/* mark the console as active...	*/
               
     if substr (prph_opc_card.mask, 1, 4) = "mask" then oc_entry.flags.read_unechoed_option = false;
     else oc_entry.flags.read_unechoed_option = true;
     
     oc_entry.name = prph_opc_card.name;				/* so we can find it later...		*/
     oc_entry.opc_idx = console_entry_idx;				/* note our opc array index...	*/
     oc_entry.imu = console_in_imu ();					/* is console located in an IMU??	*/
     
     if substr (prph_opc_card.state, 1, 2) = "on" then do;
	do idx = 1 to oc_data.console_cnt while (oc_data.opc (idx).bootload_console = false);
	end;
	if idx > oc_data.console_cnt then do;				/* if no previous bootload console...	*/
	     oc_entry.bootload_console = true;				/* mark console as bootload...	*/
	end;
	else do;							/* no multiple bootload consoles...	*/
	     call report_error (BEEP, entrypoint, "Changing state of ^a to alt.", oc_entry.name);
	     prph_opc_card.state = "alt";				/* change the consoles status...	*/
	     oc_entry.alternate = true;
	end;
     end;

     else if substr (prph_opc_card.state, 1, 3) = "alt" then do;		/* flag this as an alternate console... */
	oc_entry.alternate = true;
     end;
     
     else if prph_opc_card.state = "inop" then do;			/* this console is inoperative...	*/
	oc_entry.inop_device = true;
     end;

     else if substr (prph_opc_card.state, 1, 2) = "io" then do;		/* this console is not to be used...	*/
	oc_entry.io_device = true;
     end;

     else if substr (prph_opc_card.state, 1, 3) = "off" then do;		/* this console deconfigured...	*/
	oc_entry.no_device = true;
     end;

     else do;							/* unknown state...			*/
	call report_error (BEEP, entrypoint, "Invalid state of ^a for console ^a.",
	     prph_opc_card.state, prph_opc_card.name);
	call report_error (ANNOUNCE, entrypoint, "This console will not be configured.");
	unspec (oc_entry) = ""b;					/* undo what we have done...		*/
	return;
     end;
     
     oc_entry.line_leng = prph_opc_card.line_leng;			/* set console line length...		*/

     console_data_ptr = addr (config_data_$console_model_names);		/* get console data for verification... */

     found = false;							/* initialize it...			*/
     
     do idx = 1 to console_data.count while (^found);			/* find our console...		*/
	if console_data.model (idx) = prph_opc_card.model then do;
	     found = true;
	     oc_entry.model = prph_opc_card.model;
	     if substr (console_data.io_type (idx), 1, 3) = "pcw" then do;
		oc_entry.pcw_io = true;
		oc_entry.flags.read_unechoed_option = false;		/* CSU6001 does not have this option... */
	     end;
	end;
     end;

     if ^found then do;
	call report_error (BEEP, entrypoint, "Unknown model, ^i, specified for ^a. It will not be configured.",
	     prph_opc_card.model, oc_entry.name);
	unspec (oc_entry) = ""b;					/* undo what we've done...		*/
	return;							/* best we can do...		*/
     end;
     
     call io_chnl_util$iom_to_name ((prph_opc_card.iom), (prph_opc_card.chan),	/* get this console's channel ID...	*/
	oc_entry.channel, err_code);
     
     if err_code ^= 0 then do;
	call report_error (PANIC, entrypoint, "Invalid channel specified for ^a.", oc_entry.name);
     end;
     idcwp = addr (oc_entry.dcw_list (WRITE_DCW));			/* WRITE IDCW...			*/
     idcw.command = "33"b3;						/* write ASCII command...		*/
     idcw.code = "111"b;						/* indicates a PCW...		*/

     idcwp = addr (oc_entry.dcw_list (READ_DCW));				/* READ IDCW...			*/
     idcw.command = "23"b3;						/* read ASCII command...		*/
     idcw.code = "111"b;						/* indicates a PCW...		*/
     dcwp = addr (oc_entry.dcw_list (READ_DCW + 1));			/* get data word...			*/
     dcw.tally = bit (binary (divide (MAX_IO_LENGTH, 4, 17), 12));		/* maximum for READ ops...		*/
          
     idcwp = addr (oc_entry.dcw_list (READ_UNECHOED_DCW));			/* READ_UNECHOED IDCW...		*/
     idcw.command = "43"b3;						/* read unechoed ASCII command...	*/
     idcw.code = "111"b;						/* indicates a PCW...		*/
     dcwp = addr (oc_entry.dcw_list (READ_UNECHOED_DCW + 1));		/* get data word...			*/
     dcw.tally = bit (binary (divide (MAX_IO_LENGTH, 4, 17), 12));		/* maximum for READ ops...		*/
          
     idcwp = addr (oc_entry.dcw_list (RESET_DCW));			/* READ_ID IDCW...			*/
     idcw.command = "57"b3;						/* so I lied...			*/
     idcw.code = "111"b;						/* indicates PCW...			*/
     idcw.chan_cmd = "02"b3;						/* indicate "non-data" type transfer... */
     idcw.count = "01"b3;						/* issue only once...		*/

     idcwp = addr (oc_entry.dcw_list (ALERT_DCW));			/* WRITE_ALERT IDCW...		*/
     idcw.command = "51"b3;						/* write_alert command...		*/
     idcw.code = "111"b;						/* indicates PCW...			*/
     idcw.chan_cmd = "02"b3;						/* indicate "non-data" type transfer... */
     idcw.count = "01"b3;						/* issue only once...		*/

     oc_entry.dcw_list (NEWLINE_DCW) = oc_entry.dcw_list (WRITE_DCW);		/* put IOM in WRITE mode...		*/
     dcwp = addr (oc_entry.dcw_list (NEWLINE_DCW + 1));			/* next in list describes what to write.*/
     dcw.address = bit (binary (wordno (addr (oc_data.write_return))		/* -> string to write...		*/
	+ oc_data.abs_addr, 18));
     dcw.tally = "0001"b3;						/* tally = number of words to transfer..*/

     oc_entry.dcw_list (PROMPT_DCW) = oc_entry.dcw_list (WRITE_DCW);		/* put IOM in write mode...		*/
     dcwp = addr (oc_entry.dcw_list (PROMPT_DCW + 1));			/* next in list describes what to write.*/
     dcw.address = bit (binary (wordno (addr (oc_data.prompt))		/* -> string to write...		*/
	+ oc_data.abs_addr, 18));
     dcw.tally = "0002"b3;						/* tally = number of words to transfer..*/

     oc_entry.dcw_list (DISCARD_DCW) = oc_entry.dcw_list (WRITE_DCW);		/* put IOM in WRITE mode...		*/
     dcwp = addr (oc_entry.dcw_list (DISCARD_DCW + 1));			/* next in list describes what to write.*/
     dcw.address = bit (binary (wordno (addr (oc_data.discard_notice))	/* -> string to write...		*/
	+ oc_data.abs_addr, 18));
     dcw.tally = "0006"b3;						/* tally = number of words to transfer..*/

     idcwp = addr (oc_entry.dcw_list (LOCK_MCA_DCW));			/* LOCK MCA IDCW...			*/
     idcw.command = "60"b3;						/* lock command...			*/
     idcw.code = "111"b;						/* indicates IDCW...		*/
     idcw.chan_cmd = "02"b3;						/* indicate "non-data" type transfer... */
     idcw.count = "00"b3;						/* Not examined by console...		*/

     idcwp = addr (oc_entry.dcw_list (UNLOCK_MCA_DCW));			/* UNLOCK MCA IDCW...		*/
     idcw.command = "63"b3;						/* unlock command...		*/
     idcw.code = "111"b;						/* indicates IDCW...		*/
     idcw.chan_cmd = "02"b3;						/* indicate "non-data" type transfer... */
     idcw.count = "00"b3;						/* Set MCA# to 00...		*/

     oc_entry.prompt = true;						/* turn on prompting for all consoles...*/
     
     return;							/* all done...			*/
     
end fill_oc_entry;

find_oc_entry:
     proc (opc_name) returns (ptr);


	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal function that returns a pointer to the specified console. If the opc_name is "" then a	*/
	/* pointer to the bootload console is returned. If the specified console is not configured a null	*/
	/* pointer is returned.								*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

/* parameters... (I) = Input, (O) = Output */

     dcl	opc_name			char	(4)	aligned		/* name of the console...	      (I) */
						parameter;

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

     oc_data_ptr = addr (oc_data$);					/* just in case we don't know...	*/
     
     if opc_name = "" then do;					/* find the bootload console...	*/
	if oc_data.bootload_console_idx = 0 then return (null);		/* no bootload console assigned...	*/
	return (addr (oc_data.opc (oc_data.bootload_console_idx)));		/* return the requested pointer...	*/
     end;
     
     do idx = 1 to oc_data.console_cnt;					/* locate the console...		*/
	if oc_data.opc (idx).name = opc_name then do;			/* found it...			*/
	     return (addr (oc_data.opc (idx)));
	end;
     end;

     return (null);							/* console not configured...		*/
          
end find_oc_entry;

initiate_io:
     proc ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure to initiate the I/O indicated by the DCW list index in the oc_entry.	*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     oc_entry.io_time = clock ();					/* save the time we started the I/O...	*/
     oc_entry.io_in_progress = true;					/* indicate console is busy...	*/
     
     if oc_entry.dcw_list_idx = READ_DCW |				/* if we're doing a READ or...	*/
	oc_entry.dcw_list_idx = READ_UNECHOED_DCW |			/* or a READ_UNECHOED...		*/
	oc_entry.dcw_list_idx = WRITE_DCW |				/* a WRITE 			*/
	oc_entry.dcw_list_idx = PROMPT_DCW |				/* or a PROMPT			*/
	oc_entry.dcw_list_idx = ALERT_DCW then do;			/* or an ALERT then do...		*/
	oc_data.io_ptr = console_io_ptr;				/* save a pointer to the I/O...	*/
	console_io.console = oc_data.opc (oc_data.bootload_console_idx).name;	/* note what console the I/O went to... */
     end;

     iom_args.chx = oc_entry.device_idx;				/* setup I/O manager args...		*/

     if oc_entry.pcw_io then do;					/* for EMC style consoles...		*/
	iom_args.pcw = oc_entry.dcw_list (oc_entry.dcw_list_idx);
	iom_args.listp = addr (oc_entry.dcw_list (oc_entry.dcw_list_idx + 1));
     end;

     else do;							/* for new style consoles...		*/
	iom_args.pcw = false;
	iom_args.listp = addr (oc_entry.dcw_list (oc_entry.dcw_list_idx));
     end;

     iom_args.ptp = null;						/* unused...			*/

     call io_manager$connect_abs (iom_args);				/* initiate the I/O...		*/

     return;

end initiate_io;

lock_oc_data:
     proc ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure to wire our stack, mask interrupts and then lock oc_data. There are two	*/
	/* possible errors during this process. The first is that the value of the lock is already set to	*/
	/* our process_id. This is the MYLOCK error and will result in a system crash. The second possible 	*/
	/* error is that the lock cannot be had within a reasonable	amount of time. In this case we will 	*/
	/* also crash the system.								*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     oc_data_ptr = addr (oc_data$);					/* locate oc_data...		*/

     if oc_data.lock = pds$process_id then do;				/* MYLOCK error...			*/
	call report_error (PANIC, "lock_oc_data", "Mylock error.");		/* crash system, store flagbox message..*/
     end;

     call wire_and_mask;						/* wire our stack and mask interrupts...*/

     time_lock_expires = clock () + oc_data.max_computed_io_time;		/* setup spin lock timeout...		*/
          
     do while (clock () < time_lock_expires);				/* loop on the lock...		*/
	if stac (addr (oc_data.lock), pds$process_id) then return;		/* if got lock then return...		*/
     end;

     call report_error (PANIC, "lock_oc_data", "Lock wait timer expired.");	/* timer expired, crash the system...	*/
          
end lock_oc_data;

lock_unlock_mca:
     proc ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure to either lock (disable) or unlock (enable) communication through the console	*/
	/* to the MCA (Maintenace Channel Adapter), located in an IMU.  In order to lock or unlock the	*/
	/* input an I/O must be sent to the "Master" MCA console, but since we have no sure way of knowing	*/
	/* which console in the "Master" we issue an I/O to every configured console. This way we make sure	*/
	/* that the interface to the MCA will be locked or unlocked. However if a site does not configure	*/
	/* the console that is running as the master, then there is nothing we can do.			*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     bootload_console_name = oc_entry.name;				/* need for setting later...		*/
     save_status_ptr = oc_data.status_ptr;				/* ditto...			*/
     ad_code = 0;
     mca_lock_unlock_success = false;

     do while (oc_entry.io_in_progress);				/* quies the console...		*/
	call process_io_status ();
     end;

     do idx = 1 to oc_data.console_cnt;					/* scan through all consoles...	*/
	if oc_data.opc (idx).imu &					/* is console on an IMU		*/
	     ^oc_data.opc (idx).inop_device &				/* and not broken			*/
	     ^oc_data.opc (idx).no_device &				/* and not off			*/
	     ^oc_data.opc (idx).io_device then do;			/* and not being used as an IO device.	*/
	     oc_entry_ptr = addr (oc_data.opc (idx));
	     must_unassign = false;
	     if ^oc_entry.assigned then do;				/* non-bootload console		*/
		call io_manager$assign (oc_entry.device_idx, oc_entry.channel,
		     ocdcm_$interrupt_handler, (0), oc_data.status_ptr, err_code);
		if err_code ^= 0 then do;
		     ad_code, code = err_code;
		     goto locate_bootload;
		end;
		oc_entry.assigned = true;
		oc_entry.io_in_progress = false;
		must_unassign = true;
	     end;
	     else oc_data.status_ptr = save_status_ptr;			/* bootload console needs its ptr...	*/

	     if reconfig_option = LOCK_MCA_INPUT then do;
		oc_entry.dcw_list_idx = LOCK_MCA_DCW;
		call log_console_event (LOCK_MCA_IO, null);
	     end;
	     else do;
		idcwp = addr (oc_entry.dcw_list (UNLOCK_MCA_DCW));
		idcw.count =  bit (binary (mca_to_unlock, 6));
		oc_entry.dcw_list_idx = UNLOCK_MCA_DCW;
		call log_console_event (UNLOCK_MCA_IO, null);
	     end;
	     call initiate_io ();

	     do while (oc_entry.io_in_progress);			/* wait for I/O to finish...		*/
		call process_io_status ();
		if console_io_timeout then do;
		     ad_code = error_table_$timeout;
		     call report_error (JUST_LOG, entrypoint, "Timeout executing MCA^[(^2.3b)^;^s^] ^[LOCK^;UNLOCK^] on ^a for ^a.",
			(reconfig_option = UNLOCK_MCA_INPUT), bit (binary (mca_to_unlock, 6)),
			(reconfig_option = LOCK_MCA_INPUT), oc_entry.name, pds$process_group_id);
		end;
		oc_entry_ptr = addr (oc_data.opc (idx));		/* make sure we stay with right one...	*/
	     end;

	     if oc_entry.status_word = "400002000000"b3 then do;
		call report_error (JUST_LOG, entrypoint, "MCA^[(^2.3b)^;^s^] input through ^a, ^[dis^;en^]abled by ^a.",
		     (reconfig_option = UNLOCK_MCA_INPUT), bit (binary (mca_to_unlock, 6)),
		     oc_entry.name, (reconfig_option = LOCK_MCA_INPUT), pds$process_group_id);
		oc_entry_ptr = addr (oc_data.opc (idx));		/* switch back to proper console...	*/
		mca_lock_unlock_success = true;
	     end;

	     if must_unassign then do;
		call io_manager$unassign (oc_entry.device_idx, (0));
		oc_entry.assigned = false;
		oc_entry.io_in_progress = false;
		oc_entry_ptr = null;
	     end;
	end;
     end;

locate_bootload:
     if audit_flag then do;						/* Not at BCE so audit event */
	if mca_lock_unlock_success then ad_code = 0;
	audit_eventflags = "0"b;
	addr (audit_eventflags) -> audit_event_flags.priv_op = "1"b;
	addr (audit_eventflags) -> audit_event_flags.grant = "1"b;
	if reconfig_option = LOCK_MCA_INPUT then
	     call access_audit_$log_general ("ocdcm_$reconfigure", level$get (), audit_eventflags,
	     access_operations_$lock_mca, "", ad_code, null (), 0, "");
	else call access_audit_$log_general ("ocdcm_$reconfigure", level$get (), audit_eventflags,
	     access_operations_$unlock_mca, "", ad_code, null (), 0, "MCA ^d", mca_to_unlock);
     end;
     oc_entry_ptr = find_oc_entry (bootload_console_name);			/* locate the bootload console...	*/
     oc_data.status_ptr = save_status_ptr;				/* reset the status pointer back...	*/
     return;
end lock_unlock_mca;

log_console_error:
     proc ();
     

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure to enter a note that a console error has occurred into the system log.	*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     call io_manager$get_status (oc_entry.device_idx, addr (oc_status));	/* get IOM status...		*/

     unspec (log_message) = ""b;					/* clear any previous message residue.. */

     log_message.level = "3"b3;					/* terminate...			*/
     log_message.channel = oc_entry.channel;
     log_message.device = "00"b;
     log_message.time_out = console_io_timeout;				/* if that is why were here...	*/
     log_message.type = oc_status.action_code;
     log_message.command = addr (oc_entry.dcw_list (oc_entry.dcw_list_idx)) -> idcw.command;
     log_message.status = oc_entry.status_word;
     log_message.devname = oc_entry.name;

     call ioa_$rsnnl ("^[in_service^1x^]^[crash_on_crf^1x^]^[mc_io_enabled^1x^]^[list_consoles^1x^]^[printer_on^1x^]^[write_q_full^]",
	oc_data_flags, 0,
	oc_data.in_service, oc_data.crash_on_crf, oc_data.mc_io_enabled,
	oc_data.list_consoles, oc_data.printer_on, oc_data.write_q_full);

     call ioa_$rsnnl ("^[io_in_progress^1x^]^[prompt^1x^]^[got_special_int^1x^]^[oper_request^1x^]^[discard^1x^]^[discarded^]",
	oc_entry_flags, 0,
	oc_entry.io_in_progress, oc_entry.prompt, oc_entry.got_special_int,
	oc_entry.oper_request, oc_entry.discard, oc_entry.discarded);

     call ioa_$rsnnl ("^[alert^1x^]^[alerted^1x^]^[read^1x^]^[prompted^1x^]^[in_progress^1x^]^[completed^1x^]^[retry_reset^1x^]",
	console_io_flags, 0,
	console_io.alert, console_io.alerted, console_io.read,
	console_io.prompted, console_io.in_progress,
	console_io.completed, console_io.retry_reset);

     call syserr$binary (JUST_LOG, addr (log_message), SB_ocdcm_err, SBL_ocdcm_err,
	"ocdcm_ (log_console_error): I/O ^[timeout ^]error on ^a; status = ^.3b^/oc_data flags: ^a^/oc_entry flags: ^a^/console_io flags: ^a",
	console_io_timeout, oc_entry.name,
	substr (string (log_message.status), 1, 36), oc_data_flags,
	oc_entry_flags, console_io_flags);

     call log_console_event (LOGGED_ERROR, oc_data.io_ptr);

     return;
     
end log_console_error;

log_console_event:
     proc (event_no, event_io_ptr_parm);

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure to log console events...						*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

/* parameters... (I) = Input, (O) = Output */

     dcl	event_no			fixed bin	(35)	parameter;	/* event to log...		      (I) */
     dcl	event_io_ptr_parm		ptr		parameter;	/* -> I/O being affected by the event...*/
     
/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  * */


     oc_data.event (oc_data.next_event).time = clock ();			/* note the time...			*/
     oc_data.event (oc_data.next_event).process_id = pds$process_id;		/* and logger's process ID...		*/
     oc_data.event (oc_data.next_event).event_number = event_no;		/* log the event...			*/
     oc_data.event (oc_data.next_event).event_io_ptr = event_io_ptr_parm;	/* note current I/O...		*/
     if oc_entry_ptr ^= null then do;
	oc_data.event (oc_data.next_event).opc_name = oc_entry.name;	/* note console name...		*/
	oc_data.event (oc_data.next_event).opc_flags = oc_entry.flags;	/* and console flags...		*/
     end;
     else do;							/* currently no bootload console...	*/
	oc_data.event (oc_data.next_event).opc_name = "";
	oc_data.event (oc_data.next_event).opc_flags = ""b;
     end;

     oc_data.next_event = oc_data.next_event + 1;				/* bump the index...		*/
     if oc_data.next_event > EVENT_QUEUE_SIZE then oc_data.next_event = 1;	/* and ensure it stays in bounds...	*/

     return;							/* done...			*/
     
end log_console_event;

next_console_io:
     proc () returns (ptr);

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure to return a pointer to the next console I/O to be performed. If there are no	*/
	/* outstanding I/Os then a null pointer is returned.					*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     
     if oc_data.read_io.in_progress then return (addr (oc_data.read_io));	/* complete READs without interruption..*/
     
     if ^oc_data.priority_io.completed then do;				/* found a priority I/O...		*/
	if oc_data.priority_io.read then do;				/* is it a READ?...			*/
	     if ^oc_entry.oper_request then return (null);		/* yes, but no RE(QUEST TURN) key...	*/
	end;
	return (addr (oc_data.priority_io));
     end;

     if oc_data.write_q_full then do;					/* if the write queue is full...	*/
	return (addr (oc_data.write_queue (oc_data.next_free_write)));	/* next free write is the oldest I/O... */
     end;
     			        
     first_search_pass = true;
     first_io_slot = oc_data.next_free_write + 1;				/* else next free + 1 is the oldest...	*/
     if first_io_slot > WRITE_QUEUE_SIZE then first_io_slot = 1;
     last_io_slot = WRITE_QUEUE_SIZE;					/* search to end of queue...		*/

SEARCH_WRITE_QUEUE:

     do idx = first_io_slot to last_io_slot;				/* search for the next pending write...	*/
	console_io_ptr = addr (oc_data.write_queue (idx));		/* overlay the write...		*/
	if ^console_io.completed then return (console_io_ptr);		/* return pending WRITE to caller...	*/
     end;
     if first_search_pass then do;					/* first try failed...		*/
	first_search_pass = false;
	first_io_slot = 1;						/* start at top of the queue...	*/
	last_io_slot = oc_data.next_free_write;
	go to SEARCH_WRITE_QUEUE;					/* and start again...		*/
     end;
     
     if oc_entry.discarded then do;					/* discarded output but noone knows...	*/
	oc_entry.dcw_list_idx = DISCARD_DCW;				/* get the DISCARD DCW list...	*/
	call initiate_io ();					/* and let them know...		*/
	return (null);						/* fake it this time around...	*/
     end;
     
     if oc_entry.oper_request then do;					/* only done if RE(TURN QUEST) pushed...*/
	if oc_data.stacked_read_cnt > 0 then do;			/* if any READs are queued then do...	*/
	     if ^oc_data.read_io.in_progress & oc_data.read_io.completed	/* if not in progress & last completed..*/
		then return (addr (oc_data.read_io));			/* return pending READ to caller...	*/
	end;
     end;
     
     return (null);							/* nothing to do...			*/
     
end next_console_io;

poll_for_console:
     proc ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure that will poll for a working console and will not return until one is found.	*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     if oc_data.bootload_console_idx ^= 0 then do;			/* appears to be a working console...	*/
	if console_responds_to_bell ((oc_data.bootload_console_idx)) then return;
     end;

     call unassign_bootload_console ();					/* quash pretender to the throne...	*/
     
     do while (true);
	poll_idx = poll_idx + 1;					/* get next console...		*/
	if poll_idx > oc_data.console_cnt then poll_idx = 1;		/* make sure we stay in bounds...	*/
	if ^oc_data.opc (poll_idx).no_device then do;			/* don't poll deconfigured consoles...	*/
	     if console_responds_to_bell (poll_idx) then do;		/* found one that works...		*/
		call assign_bootload_console (oc_data.opc (poll_idx).name, code);
		if code = 0 then return;
	     end;
	end;
     end;
     
end poll_for_console;

process_io:
     proc ();


	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure to perform a pending I/O. If there is no I/O pending the return argument	*/
	/* will be set to true.								*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     if oc_entry_ptr = null () then goto BAIL_OUT;			/* Console went inoperable! Bail out... */
      
     if oc_entry.io_in_progress then return;				/* console is already in use...	*/

     console_io_ptr = next_console_io ();				/* find I/O to process...		*/
     if console_io_ptr = null then return;				/* nothing to do...			*/

     if console_io.read then do;					/* process pending read...		*/
	oc_entry.discard = false;					/* end any DISCARD condition...	*/
	wired_hardcore_data$abort_request = false;			/* and any abort condition...		*/
	console_io.in_progress = true;				/* indicate that the I/O is in progress.*/
	console_io.completed = false;					/* and has not yet completed...	*/
	if oc_entry.prompt & ^console_io.prompted then do;		/* prompt first...			*/
	     oc_entry.dcw_list_idx = PROMPT_DCW;			/* setup the prompt DCW list...	*/
	     console_io.prompted = true;
	     call log_console_event (SENT_PROMPT, console_io_ptr);
	end;
	else do;							/* perform the read...		*/
	     if oc_data.flags.printer_on | ^oc_entry.read_unechoed_option then do;
		oc_entry.dcw_list_idx = READ_DCW;			/* perform the read...		*/
		dcwp = addr (oc_entry.dcw_list (READ_DCW + 1));		/* READ DCW...			*/
		call log_console_event (STARTED_READ, console_io_ptr);
	     end;
	     else do;						/* attempt unechoed READ...		*/
		oc_entry.dcw_list_idx = READ_UNECHOED_DCW;		/* perform the read...		*/
		dcwp = addr (oc_entry.dcw_list (READ_UNECHOED_DCW + 1));	/* READ_UNECHOED DCW...		*/
		call log_console_event (STARTED_UNECHOED_READ, console_io_ptr);
	     end;
	     dcw.address = bit (binary (oc_data.abs_addr +		/* get absolute address of read buffer..*/
		wordno (addr (console_io.text)), 18));
	end;
	call initiate_io ();					/* start the I/O...			*/
	return;
     end;
     
     else do;							/* if not a READ then it is a WRITE..	*/
	if console_io.alert & ^console_io.alerted then do;		/* send WRITE_ALERT if wanted...	*/
	     oc_entry.dcw_list_idx = ALERT_DCW;				/* get WRITE_ALERT DCW...		*/
	     console_io.alerted = true;
	     call log_console_event (SENT_ALERT, console_io_ptr);
	end;
	else do;							/* send the message...		*/
	     console_io.in_progress = true;				/* indicate that the I/O is in progress.*/
	     dcwp = addr (oc_entry.dcw_list (WRITE_DCW + 1));		/* setup DCW list...		*/
	     dcw.tally = bit (binary (console_io.leng, 12), 12);		/* tally = length of message in words...*/
	     dcw.address = bit (binary (oc_data.abs_addr +		/* get absolute address of write buffer.*/
		wordno (addr (console_io.text)), 18));
	     oc_entry.dcw_list_idx = WRITE_DCW;				/* we will write...			*/
	     if console_io_ptr = addr (oc_data.priority_io) then
		call log_console_event (PRIORITY_OUTPUT, console_io_ptr);
	     else call log_console_event (STARTED_WRITE, console_io_ptr);
	end;
	call initiate_io ();					/* start the I/O...			*/
	return;
     end;

end process_io;

process_io_status:
     proc ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure to process statuses returned by io_manager.				*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

    if oc_entry.got_special_int then do;				/* operator wants to input...		*/
         call log_console_event (GOT_SPECIAL_INT, oc_data.io_ptr);		/* log the event...			*/
         oc_entry.got_special_int = false;				/* and reset the switch...		*/
         if oc_entry.oper_request then do;				/* if already in INPUT mode...	*/
	    if ^oc_entry.discard then do;				/* and not in DISCARD state...	*/
	         oc_entry.discard = true;				/* enter same...			*/
	         oc_entry.discarded = false;				/* have not announced it yet...	*/
	         wired_hardcore_data$abort_request = true;		/* he who notices shall abort...	*/
	    end;
	    return;
         end;
         else oc_entry.oper_request = true;				/* else note oper hit RE(TURN QUEST) key*/
         return;
     end;

     if ^oc_entry.io_in_progress then return;				/* no outstanding I/O, no status...	*/

     if timeout () & ^io_status.t then do;				/* the last I/O has exceeded its time...*/
	call io_manager$mask (oc_entry.device_idx);			/* abort the I/O...			*/
	call retry_io ();						/* retry the I/O...			*/
	return;							/* that's all for now...		*/
     end;

     if ^io_status.t then return;					/* no valid status to process...	*/

     oc_entry.status_word = unspec (io_status);				/* save the status for debugging...	*/
     io_status.t = false;						/* indicate that we've processed it...	*/

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* If ocdcm_ was invoked anywhere other than to handle an interrupt, then we need to pause 5	*/
	/* milliseconds after the status for the interrupt to be sent by the console.  This is due to the	*/
	/* fact that we are not waiting for the interrupt, but only seeing if status has been stored.  The	*/
	/* IMU console takes a long time between the status store and terminate interrupt and if time is	*/
	/* not given then a second connect could be sent before the interrupt has been sent, causing a	*/
	/* console fault.									*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     if ^entered_via_interrupt then do;
	if io_status.initiate & ^oc_entry.pcw_io & ^oc_entry.imu then return; /* ignore initiate & no major status, if... */
	wait_timer = clock () + 5000;                                         /* set wait timer			*/
	do while (clock () < wait_timer);				/* loop for a while			*/
	end;
     end;

     if io_status.power | io_status.channel_stat | io_status.central_stat then do;
	call io_manager$mask (oc_entry.device_idx);			/* abort the I/O...			*/
	call retry_io ();						/* retry the I/O operation...		*/
	return;							/* that's all for now...		*/
     end;
     
     if io_status_overlay.major = "00"b3 then do;
	if io_status.initiate & ^oc_entry.pcw_io & ^oc_entry.imu then return; /* ignore initiate & no major status, if... */
	call terminate_io ();					/* normal termination...		*/
	return;
     end;
          
     if io_status_overlay.major = "01"b3 then do;				/* if DEVICE_BUSY..			*/
	call retry_io ();						/* give it another try...		*/
	return;
     end;
          
     if io_status_overlay.major = "02"b3 &				/* if DEVICE_ATTENTION..		*/
	(oc_entry.dcw_list_idx = LOCK_MCA_DCW |
	oc_entry.dcw_list_idx = UNLOCK_MCA_DCW) then do;			/* and doing MCA type I/O, then its ok...*/
	call terminate_io ();					/* normal termination...		*/
	return;
     end;
     
     if io_status_overlay.major ^= "03"b3 |				/* if ^DATA_ALERT...		*/
	(oc_entry.dcw_list_idx ^= READ_DCW &
	oc_entry.dcw_list_idx ^= READ_UNECHOED_DCW) then do;		/* or not a READ I/O then retry...	*/
	call io_manager$mask (oc_entry.device_idx);			/* abort the I/O...			*/
	call retry_io ();
	return;
     end;
     
     console_io_ptr = oc_data.io_ptr;					/* locate I/O in progress...		*/

     if io_status_overlay.sub = "10"b3 then do;				/* OPERATOR DISTRACTED...		*/
	oc_entry.oper_request = false;				/* wait for oper to hit RE(TURN QUEST)..*/
	oc_entry.discard = false;					/* end the DISCARD condition...	*/
	oc_entry.discarded = false;
	call reset_read ();						/* reset the READ I/O...		*/
	call send_newline ();					/* start next I/O on a fresh line...	*/
	return;
     end;
	
     if io_status_overlay.sub = "04"b3 |				/* if OPERATOR INPUT ERROR or...	*/
	io_status_overlay.sub = "40"b3 then do;				/* MESSAGE LENGTH ALERT...		*/
	call reset_read ();						/* reset the READ...		*/
	call send_newline ();					/* start on a fresh line...		*/
	return;
     end;

     call io_manager$mask (oc_entry.device_idx);				/* abort the I/O...			*/
     call retry_io ();						/* retry all others...		*/
     
     return;							/* done...			*/
     
end process_io_status;

queue_console_io:
     proc () returns (fixed bin (71));

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure that copies the user's I/O out of our local copy and into the appropriate	*/
	/* I/O queue. If there is room for the I/O we return the time that the I/O is queued to our caller.	*/
	/* If we find that there is no room to queue the I/O we return a zero to our caller.		*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     local_io.in_progress = false;					/* reset action switches...		*/
     local_io.completed = false;
     local_io.alerted = false;
     local_io.prompted = false;
     local_io.retry_reset = false;
     local_io.console = "";						/* reset console assigned indicator...	*/
     
     if local_io.read then do;
	if oc_data.last_read_queued = -1 then do;			/* if this is the first ever read...	*/
	     oc_data.reader_process_id = pds$process_id;			/* then we get the prize...		*/
	end;
	oc_data.stacked_read_cnt = oc_data.stacked_read_cnt + 1;		/* push the read onto the stack...	*/
	if oc_data.stacked_read_cnt > 1 then do;			/* if we have more then one read...	*/
	     call log_console_event (PUSHED_READ, addr (oc_data.read_io));	/* log the PUSH...			*/
	     oc_data.meters.pushed_read_cnt = oc_data.meters.pushed_read_cnt + 1;
	     return (0);						/* nothing else to do...		*/
	end;
	local_io.completed = true;					/* READs always start off as completed..*/
	local_io.leng = 0;						/* make sure read goes smoothly...	*/
	local_io.text = "";
	local_io.sequence_no = 0;
	local_io.time_queued = clock ();
	local_io.process_id = pds$process_id;				/* for debugging purposes...		*/
	oc_data.read_io = local_io;					/* copy the read...			*/
	oc_data.last_read_queued = local_io.time_queued;			/* update stats...			*/
	call log_console_event (QUEUED_READ, addr (oc_data.read_io));	/* log the event...			*/
	return (local_io.time_queued);				/* and return the time we queued it...	*/
     end;
     else do;							/* I/O is a WRITE...		*/
	if ^oc_data.write_queue (oc_data.next_free_write).completed then do;	/* no room to queue a write...	*/
	     oc_data.meters.write_q_full_cnt = oc_data.meters.write_q_full_cnt + 1;
	     oc_data.write_q_full = true;				/* let next_console_io know...	*/
	     return (0);						/* DIM will try again later...	*/
	end;
	else do;							/* we have room to queue the WRITE...	*/
	     local_io.time_queued = clock ();
	     local_io.process_id = pds$process_id;			/* get the writers process ID...	*/
	     console_io_ptr = addr (oc_data.write_queue (oc_data.next_free_write));
	     console_io = local_io;
	     oc_data.last_write_queued = local_io.time_queued;		/* update stats...			*/
	     call log_console_event (QUEUED_WRITE, console_io_ptr);
	     oc_data.next_free_write = oc_data.next_free_write + 1;		/* update the next free slot number...	*/
	     if oc_data.next_free_write > WRITE_QUEUE_SIZE then		/* if past the end of the queue then... */
		oc_data.next_free_write = 1;				/* wrap around...			*/
	     if ^oc_data.write_queue (oc_data.next_free_write).completed then do;/* no room to queue any more writes...*/
		oc_data.meters.write_q_full_cnt = oc_data.meters.write_q_full_cnt + 1;
		oc_data.write_q_full = true;				/* let next_console_io know...	*/
	     end;
	     return (local_io.time_queued);				/* return the time we queued it...	*/
	end;
     end;
     
end queue_console_io;

report_error:
     proc options (variable);

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure to report errors to the operator. Depending upon the severity of the error	*/
	/* we will either return or crash.							*/
	/*										*/
	/* Calling sequence:								*/
	/*										*/
	/* 	call report_error (SEVERITY, entrypoint_name, control_string, arg_1,... arg_n);		*/
	/*										*/
	/* Note: 	This procedure does not validate its arguments.					*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     dcl	arg_list_ptr		ptr;				/* -> arg_list...			*/
     dcl	based_epname		char	(32)	based;		/* entrypoint name overlay...		*/
     dcl	based_severity		fixed bin	(17)	based;		/* severity overlay...		*/
     dcl	entrypoint_name		char	(32);			/* name of our caller...		*/
     dcl	error_msg			char	(256);			/* filled by formline_...		*/
     dcl	error_buffer		char	(256);			/* filled by oc_trans_output_...	*/
     dcl	severity			fixed bin	(17);			/* severity of the error...		*/

     dcl  1 saved_priority_io		aligned				/*  copy of a priority I/O...		*/
     				like	priority_io;

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


     arg_list_ptr = arg_list_ptr_ ();					/* -> argument list...		*/

     severity = arg_list_ptr -> arg_list.arg_ptrs (1) -> based_severity;	/* first arg is the severity...	*/
     if arg_list_ptr -> arg_list.call_type = Envptr_supplied_call_type then
	entrypoint_name = substr (arg_list_ptr -> arg_list_with_envptr.arg_ptrs (2) -> based_epname, 1,
	arg_list_ptr -> arg_list_with_envptr.desc_ptrs (2) -> arg_descriptor.size);
     else entrypoint_name = substr (arg_list_ptr -> arg_list.arg_ptrs (2) -> based_epname, 1, arg_list_ptr -> arg_list.desc_ptrs (2) -> arg_descriptor.size);
     
     error_msg = "";						/* start with a clean slate...	*/
     
     call formline_ (3, 4, addr (error_msg), length (error_msg), 1, arg_list_ptr);

     error_msg = "ocdcm_ (" || rtrim (entrypoint_name) || "): " || rtrim (error_msg);

     oc_entry_ptr = find_oc_entry ("");					/* locate the bootload console...	*/

     if severity = PANIC then do;					/* must crash Multics...		*/
	call unlock_oc_data ();					/* relinquish lock, unwire, unmask...	*/
	call syserr_real$panic (error_msg);				/* the point of no return...		*/
     end;
     
     call syserr (JUST_LOG, error_msg);					/* log the error...			*/
          
     if severity = JUST_LOG then return;				/* all that is necessary...		*/
     
     if ^oc_data.in_service then do;
	if sys_info$collection_1_phase > SERVICE_INITIALIZATION then do;	/* if crashing then must have console...*/
	     oc_data.must_have_console = true;				/* set the appropriate flag...	*/
	     call console_recovery ();				/* console recovery knows what to do... */
	end;
	else if oc_data.crash_on_crf | sys_info$collection_1_phase < SERVICE_INITIALIZATION then do;
	     call unlock_oc_data ();					/* relinquish lock, unwire, unmask...	*/		
	     call syserr_real$panic (error_msg);			/* oh well...			*/
	end;
	else return;						/* can't go any further...		*/
     end;

     if ^oc_data.priority_io.completed then do;				/* must save that message...		*/
	i_saved_priority_io = true;
	if ^saved_priority_io.completed then do;			/* LOST CONSOLE I/O...		*/
	     call syserr (JUST_LOG, "ocdcm_ (report_error): LOST CONSOLE I/O. I/O follows...");
	     call syserr (JUST_LOG, saved_priority_io.text);		/* pass it to the log...		*/
	end;
	saved_priority_io = oc_data.priority_io;			/* copy it...			*/
     end;
           
     oc_data.priority_io.time_queued = clock ();
     oc_data.priority_io.process_id = pds$process_id;
     oc_data.priority_io.event_chan = 0;
     oc_data.priority_io.in_progress = false;
     oc_data.priority_io.alert = (severity <= BEEP);

     if oc_data.mc_io_enabled then do;					/* Message Coordinator is handling I/O..*/
	call bump_io_to_mc ((oc_data.priority_io.sequence_no));
	oc_data.priority_io.completed = true;				/* free the space...		*/
	return;							/* all we can do...			*/
     end;
     
     if oc_entry_ptr = null then return;				/* no need to continue...		*/
     to_write_ptr = addr (error_msg);
     to_write_length = length (rtrim (error_msg));
     continue_flag = false;
     this_part_length = 0;
     console_line_length = oc_entry.line_leng;				/* in case the console gets lost...	*/

     do while (to_write_length > 0);
	oc_data.priority_io.completed = false;
	oc_data.priority_io.in_progress = false;
	error_buffer = "";
	call oc_trans_output_ (to_write_ptr, to_write_length, this_part_length, addr (error_buffer),
	     word_length, console_line_length, continue_flag);
	oc_data.priority_io.leng = word_length;
	oc_data.priority_io.text = substr (error_buffer, 1, multiply (word_length, 4, 17));

	oc_data.priority_io.completed = false;				/* lest it not be performed...	*/

	do while (^oc_data.priority_io.completed & oc_data.in_service);	/* LOOP IN RING ZERO TILL I/O COMPLETE..*/
	     call process_io ();					/* process the I/O...		*/
	     call process_io_status ();				/* process the status...		*/
	end;
	to_write_ptr = addcharno (to_write_ptr, (this_part_length));
	to_write_length = to_write_length - this_part_length;
     end;
     
     if i_saved_priority_io then priority_io = saved_priority_io;		/* restore priority I/O if necessary... */
     saved_priority_io.completed = true;

end report_error;

reset_channel:
     proc ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure to reset the console channel by sending a READ_ID DCW to the channel.	*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


     if true then return;						/* UNTIL I FIGURE OUT RESETS...	*/
     
     oc_entry.dcw_list_idx = RESET_DCW;
          
     call log_console_event (RESET_CHANNEL, oc_data.io_ptr);		/* log the event...			*/

     call initiate_io ();						/* and do it...			*/

     return;							/* done...			*/

end reset_channel;

reset_console:
     proc ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure to reset the console.						*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     entrypoint = "reset_console";					/* set entrypoint name...		*/
     
     oc_data.in_service = true;					/* attempt to put us back in service... */
     oc_data.mc_io_enabled = false;
     
     do idx = 1 to WRITE_QUEUE_SIZE;					/* mark all WRITE slots as free...	*/
	oc_data.write_queue (idx).completed = true;
     end;
     oc_data.write_q_full  = false;					/* reset the full flag...		*/
     
     oc_data.stacked_read_cnt = 1;					/* free all READs, leave one pending... */
     call reset_read ();						/* and simulate one pending...	*/
               
     call unassign_bootload_console ();					/* first unassign it...		*/
     
     if oc_entry_ptr = null then do;					/* no active console...		*/
	call console_recovery ();					/* try another...			*/
	return;							/* best we can do...		*/
     end;

     oc_entry.io_in_progress = false;					/* reset certain flags...		*/
     oc_entry.discard = false;
     oc_entry.discarded = false;
     oc_entry.got_special_int = false;
     oc_entry.oper_request = false;
     oc_entry.retry_cnt = 0;
     oc_entry.io_time = 0;

     call assign_bootload_console (oc_entry.name, err_code);		/* then re-assign it...		*/
     if err_code ^= 0 then do;
	call console_recovery ();					/* failed, try another console...	*/
	return;							/* done...			*/
     end;
     
     call reset_channel ();						/* reset console channel...		*/
     
     call report_error (BEEP, entrypoint, "Reset bootload console for ^a.", pds$process_group_id);
     
     return;

end  reset_console;

reset_read:
     proc ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure to reset a READ so that it will be done again.				*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     if oc_data.priority_io.read then read_io_ptr = addr (oc_data.priority_io); /* if we were doing a priority READ...	*/
     else read_io_ptr = addr (oc_data.read_io);
          
     unspec (read_io_ptr -> console_io.flags) = ""b;			/* reset all flags...		*/
     read_io_ptr -> console_io.read = true;				/* and not that it is a READ...	*/
     read_io_ptr -> console_io.completed = true;				/* so that it will be executed...	*/
     read_io_ptr -> console_io.console = "";				/* reset assigned console...		*/
     read_io_ptr -> console_io.leng = 0;				/* clear text length...		*/
     read_io_ptr -> console_io.text = "";				/* and text...			*/

     return;							/* done...			*/
          
end reset_read;
	     
retry_io:
     proc ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure that will attempt to retry the last I/O operation initiated. If the console	*/
	/* has already been flagged as inoperative then we will pass control to console_recovery who will	*/
	/* handle the problem.								*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     console_io_ptr = oc_data.io_ptr;					/* find I/O we were processing...	*/
     
     if oc_entry.retry_cnt = 0 then call log_console_error ();		/* log the error on the first retry...	*/

     call log_console_event (RETRY_IO, oc_data.io_ptr);			/* log the retry event...		*/

     if oc_entry.retry_cnt = MAX_RETRIES then do;				/* sorry...			*/
	call console_recovery ();					/* get a new console...		*/
	if ^oc_data.in_service then do;				/* console recovery failed...		*/
	     console_io.completed = true;				/* free up the I/O...		*/
	     return;						/* I/O was at least logged...		*/
	end;
	else if oc_data.mc_io_enabled then do;				/* no real consoles left...		*/
	     local_io = console_io;					/* copy the I/O to local_io structure...*/
	     if local_io.sequence_no > 0 then do;			/* if a syserr message then...	*/
		call bump_io_to_mc ((local_io.sequence_no));		/* pass it to the MC...		*/
		console_io.completed = true;				/* signal priority I/O completion...	*/
	     end;
	     else call bump_io_to_mc (-(local_io.time_queued));		/* for normal messages...		*/
	     return;						/* done...			*/
	end;
     end;
     
     else do;							/* give 'em another chance...		*/
	oc_entry.retry_cnt = oc_entry.retry_cnt + 1;			/* bump the retry count...		*/
	if console_io.read then do;					/* READs are special...		*/
	     oc_entry.oper_request = false;				/* make 'em hit RE(TURN QUEST) again... */
	     oc_entry.discard = false;				/* reset any DISCARD condition...	*/
	     oc_entry.discarded = false;
	     oc_entry.io_in_progress = false;				/* no I/O in progress...		*/
	     call reset_read ();					/* reset the READ...		*/
	     call send_newline ();					/* start on a fresh line...		*/
	     return;						/* don't try again...		*/
	end;
	call reset_channel ();					/* reset the console channel...	*/
	call initiate_io ();					/* retry the I/O...			*/
	return;
     end;

     return;
     
end retry_io;

send_newline:
     proc ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure that sends a newline to the console.					*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     oc_entry.dcw_list_idx = NEWLINE_DCW;				/* get newline DCW...		*/

     call log_console_event (SENT_NEWLINE, oc_data.io_ptr);

     call initiate_io ();						/* send it...			*/

     return;

end send_newline;

terminate_io:
     proc ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure to terminate a successful I/O operation.				*/
	/* 										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     oc_entry.io_in_progress = false;					/* signal end of I/O operation...	*/
     oc_entry.retry_cnt = 0;						/* reset for successful termination...	*/
     
     if oc_entry.dcw_list_idx = NEWLINE_DCW then do;
	call log_console_event (TERMINATED_NEWLINE, oc_data.io_ptr);
	return;							/* nothing else to do...		*/
     end;
     
     if oc_entry.dcw_list_idx = LOCK_MCA_DCW then do;
	call log_console_event (TERMINATED_MCA_LOCK, null);
	return;							/* nothing else to do...		*/
     end;
     
     if oc_entry.dcw_list_idx = UNLOCK_MCA_DCW then do;
	call log_console_event (TERMINATED_MCA_UNLOCK, null);
	return;							/* nothing else to do...		*/
     end;
     
     if oc_entry.dcw_list_idx = DISCARD_DCW then do;
	oc_entry.discard = false;					/* reset the DISCARD condition...	*/
	oc_entry.discarded = false;
	return;							/* nothing else to do...		*/
     end;
     
     console_io_ptr = oc_data.io_ptr;					/* find the I/O to terminate...	*/
          
     if oc_entry.dcw_list_idx = RESET_DCW then do;
	call log_console_event (TERMINATED_RESET, oc_data.io_ptr);
	return;							/* nothing more to do...		*/
     end;

     if oc_entry.dcw_list_idx = ALERT_DCW then do;
	call log_console_event (TERMINATED_ALERT, oc_data.io_ptr);
	return;							/* nothing more to do...		*/
     end;

     if oc_entry.dcw_list_idx = PROMPT_DCW then do;			/* note that prompt succeeded...	*/
	call log_console_event (TERMINATED_PROMPT, oc_data.io_ptr);
	return;							/* nothing else to do...		*/
     end;

     if oc_entry.dcw_list_idx = WRITE_DCW then do;
	oc_data.write_q_full  = false;				/* reset the full flag...		*/
	console_io.completed = true;					/* free the I/O slot...		*/
	console_io.in_progress = false;				/* terminate the I/O...		*/
	call log_console_event (TERMINATED_WRITE, oc_data.io_ptr);
	return;
     end;

     if (oc_entry.dcw_list_idx = READ_DCW |				/* READ termination...		*/
	oc_entry.dcw_list_idx = READ_UNECHOED_DCW) then do;		/* READ_UNECHOED termination...	*/
	console_io.in_progress = false;				/* READ operation completed...	*/
	call io_manager$get_status (oc_entry.device_idx, addr (oc_status));	/* get number of characters read...	*/
	console_io.leng =
	     multiply ((divide (MAX_IO_LENGTH, 4, 17) - oc_status.tally_residue), 4, 17); /* calculate number of characters read..*/
	if oc_status.character_position > 0 then
	     console_io.leng = console_io.leng + oc_status.character_position - 4;
	call log_console_event (TERMINATED_READ, oc_data.io_ptr);
	call send_newline ();					/* our way of acknowledging the I/O...	*/
	if console_io.leng = 0 then do;
	     oc_entry.oper_request = false;				/* null input line terminates INPUT mode*/
	     call reset_read ();					/* reset the READ I/O...		*/
	     return;
	end;
	if console_io_ptr = addr (oc_data.priority_io) then do;		/* if the READ was a priority I/O...	*/
	     console_io.completed = true;				/* priority READ is finished...	*/
	     return;						/* no wakeup necessary...		*/
	end;
	call pxss$ring_0_wakeup (oc_data.reader_process_id,		/* tell reader to come get his mail...	*/
	     console_io.event_chan, console_io.time_queued, (0));
	call log_console_event (SENT_WAKEUP, oc_data.io_ptr);		/* log the event...			*/
     end;

     return;

end terminate_io;

timeout:
     proc () returns (bit (1));

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal function that returns true if the I/O operation being performed has timed out.	*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     console_io_timeout = false;
     if oc_entry.imu then
	if (clock () > (oc_entry.io_time + 1e06 * MAX_IMU_IO_TIME)) then
	     goto console_timed_out;
	else return (false);
     else if (clock () > (oc_entry.io_time + 1e06 * MAX_IO_TIME (oc_entry.dcw_list_idx))) then do;
console_timed_out:
	console_io_timeout = true;
	call log_console_event (IO_TIMEOUT, oc_data.io_ptr);
	return (true);
     end;

     return (false);
          
end timeout;

unassign_bootload_console:
     proc ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure to unassign the bootload console. At the conclusion of this procedure	*/
	/* oc_data.bootload_console_idx = 0.							*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */

     
     oc_entry_ptr = null;						/* initialize it to start...		*/
     
     if oc_data.bootload_console_idx = 0 then do;				/* can't unassign if no bootload console*/
	old_console_name = "";
	return;
     end;

     oc_entry_ptr = addr (oc_data.opc (oc_data.bootload_console_idx));	/* overlay the bootload console entry...*/
     old_console_name = oc_entry.name;					/* in case reassignment is needed...	*/
     oc_entry.io_in_progress = false;					/* prevent MYLOCK race conditions...	*/
     
     call io_manager$unassign (oc_entry.device_idx, (0));			/* unassign it...			*/
     oc_entry.assigned = false;
     oc_data.bootload_console_idx = 0;					/* indicate no bootload console assigned*/
     oc_entry.bootload_console = false;					/* bookeeping...			*/
     oc_entry.io_device = true;					/* let them have it...		*/
     oc_entry.config_change = true;					/* note config change occurred...	*/

     return;

end unassign_bootload_console;

unlock_oc_data:
     proc ();

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* Internal procedure to unlock the oc_data database. This procedure will also unwire our stack	*/
	/* and unmask interrupts. The only possible error here will be that the lock does not belong to	*/
	/* us. This situation should not happen and will result in a system  crash.			*/
	/*										*/
	/* Before unlocking we will check to see if any specials have occurred while we were busy. If so	*/
	/* we will process them.								*/
	/*										*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


     do while (oc_data.no_lock_flags.got_special_int);			/* special occurred while we held lock..*/
          oc_data.no_lock_flags.got_special_int = false;			/* reset the flag...		*/
	oc_entry_ptr = find_oc_entry ("");				/* find the bootload console...	*/
	if oc_entry_ptr ^= null then do;				/* only do if console available...	*/
	     oc_entry.got_special_int = true;				/* say it came from there...		*/
	     call process_io_status ();				/* process any pending status...	*/
	     call process_io ();					/* attempt to start the I/O...	*/
	end;
	else if ^oc_data.mc_io_enabled then
	     oc_data.in_service = false;
     end;

     if ^stacq (oc_data.lock, ""b, pds$process_id) then do;			/* clear lock if it is ours...	*/
	if oc_data.lock ^= ""b then					/* not ours, if not free crash...	*/
	     call report_error (PANIC, "unlock_oc_data", "Lock not mine.");
     end;

     call unwire_and_unmask;						/* unwire stack, accept interrupts...	*/

     return;
     
end unlock_oc_data;

wire_and_mask:
     proc ();

     call privileged_mode_ut$wire_and_mask (wire_mask, wire_ptw_ptr);		/* wire our stack and mask interrupts...*/
     wired_and_masked = true;
     return;

unwire_and_unmask:
     entry;
     if wired_and_masked then do;
	call privileged_mode_ut$unwire_unmask (wire_mask, wire_ptw_ptr);	/* unwire stack, accept interrupts...	*/
	wired_and_masked = false;
     end;
     return;
     
end wire_and_mask;

	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */
	/*										*/
	/* 				Declarations...					*/
	/* format: off									*/
	/*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  */


/* global parameters... (I) = Input, (O) = Output */

     dcl	code			fixed bin	(35)	parameter;
/* standard Multics error code...  (O) */

/* entries... */

     dcl	absadr entry (ptr, fixed bin (35)) returns (fixed bin (26));
     dcl  access_audit_$log_general entry options (variable);
     dcl	arg_list_ptr_ entry () returns (ptr);
     dcl	config_$find entry (char(4) aligned, ptr);
     dcl	config_$find_parm entry (char(4) aligned, ptr);
     dcl	cv_dec_check_ entry (char(*), fixed bin(35)) returns(fixed bin(35));
     dcl	formline_ entry options(variable);
     dcl	ioa_$rsnnl entry() options(variable);
/*  dcl	io_chnl_util$iom_to_name;					declared in io_chnl_util_dcls include..	*/
/*   dcl	io_manager$assign;						declared in io_manager_dcls include...	*/
/*   dcl	io_manager$connect_abs;					declared in io_manager_dcls include...	*/
/*   dcl	io_manager$get_status;					declared in io_manager_dcls include...	*/
/*   dcl	io_manager$mask;						declared in io_manager_dcls include...	*/
/*   dcl	io_manager$unassign;					declared in io_manager_dcls include...	*/
     dcl  level$get entry () returns (fixed bin);
     dcl	ocdcm_$interrupt_handler entry (fixed bin (35), fixed bin (3), bit (36) aligned);
     dcl	oc_trans_output_ entry (ptr, fixed bin(21), fixed bin(21), ptr, fixed bin(19), fixed bin, bit(1) aligned);
     dcl	privileged_mode_ut$wire_and_mask entry (fixed bin (71), ptr);
     dcl	privileged_mode_ut$unwire_unmask entry (fixed bin (71), ptr);
     dcl  pxss$ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
     dcl	syserr entry options (variable);
     dcl	syserr$binary entry options (variable);
     dcl	syserr_real$panic entry options (variable);

/* builtins... */

     dcl	addr			builtin;
     dcl	addcharno			builtin;
     dcl	binary			builtin;
     dcl	bit			builtin;
     dcl	byte			builtin;
     dcl	clock			builtin;
     dcl	copy			builtin;
     dcl	divide			builtin;
     dcl	length			builtin;
     dcl	max			builtin;
     dcl	multiply			builtin;
     dcl	null			builtin;
     dcl	rtrim			builtin;
     dcl	stac			builtin;
     dcl	stacq			builtin;
     dcl	string			builtin;
     dcl	substr			builtin;
     dcl	unspec			builtin;
     dcl	wordno			builtin;

/* pointers... */

     dcl	console_data_ptr		ptr;				/* -> console_data structure...	*/
     dcl	read_io_ptr		ptr;				/* -> the READ I/O to reset...	*/
     dcl	to_write_ptr		ptr;				/* -> string to be written...		*/
     dcl	wire_ptw_ptr		ptr;				/* gotten and returned w/o changes...	*/
     dcl	save_status_ptr		ptr;				/* used to save oc_data.status_ptr...	*/

/* switches... */

     dcl  audit_flag		bit       (1);
     dcl	true			bit	(1)	init	("1"b)
				internal static	options (constant);

     dcl	false			bit	(1)	init	("0"b)
				internal static	options (constant);

     dcl	console_found		bit	(1)	init	("0"b);	/* used for loop termination...	*/
     dcl	console_is_free		bit	(1);			/* ON => OK for RCP attachment...	*/
     dcl	continue_flag		bit	(1)	init	("0"b)	/* line being written gets "\c" chars...*/
						aligned;
     dcl	done			bit	(1)	init	("0"b);	/* used for loop termination...	*/
     dcl	first_search_pass		bit	(1)	init	("0"b);	/* ON => first pass to find an I/O...	*/
     dcl	found			bit	(1)	init	("0"b);	/* used for loop termination...	*/
     dcl	i_saved_priority_io		bit	(1)	init	("0"b);	/* ON => I saved a priority I/O...	*/
     dcl	entered_via_interrupt	bit	(1)	init	("0"b)	/* used to see if need to pause during status processing...*/
						aligned;
     dcl	mca_lock_unlock_success	bit	(1);			/* used during lock/unlock mca operations...*/
     dcl	must_unassign		bit	(1);			/* used during lock/unlock mca operations...*/
     dcl	console_io_timeout		bit	(1);			/* ON => Had io timeout...		*/
     dcl	wired_and_masked		bit	(1)	init	("0"b)	/* used to control when unwiring and unmasking is needed...*/
						aligned;
     dcl  wired_hardcore_data$abort_request
				bit	(1)	aligned
				external static;

/* error_table_... */

     dcl	error_table_$action_not_performed
				fixed bin	(35)	external static;
     dcl	error_table_$bad_arg	fixed bin	(35)	external static;
     dcl	error_table_$device_busy	fixed bin	(35)	external static;
     dcl	error_table_$device_not_active
				fixed bin	(35)	external static;
     dcl	error_table_$dev_nt_assnd	fixed bin	(35)	external static;
     dcl	error_table_$no_operation	fixed bin	(35)	external static;
     dcl	error_table_$resource_not_free
				fixed bin	(35)	external static;
     dcl  error_table_$timeout	fixed bin	(35)	external static;

/* access ops */

     dcl  access_operations_$lock_mca   bit (36) aligned	external static;
     dcl  access_operations_$unlock_mca bit (36) aligned	external static;

/* structures... */

     dcl	1 console_data	aligned	like	config_data_$console_model_names
				based	(console_data_ptr);
     dcl	1 io_status	aligned	like	io_status_word
				based	(oc_data.status_ptr);
     dcl	1 iom_args	aligned	like	io_manager_arg;
     dcl	1 local_io	aligned	like	console_io;
     dcl	1 log_message	aligned	like	io_msg;
     dcl	1 oc_status	aligned	like	io_status_entry;

/* status_word overlay... */

     dcl	1 io_status_overlay		based (oc_data.status_ptr),		/* to pick up statuses easily...	*/
	     2 major		bit	(6),			/* major status...			*/
	     2 sub		bit	(6);			/* sub status...			*/
     
/* miscellaneous... */

     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	PANIC			fixed bin	(17)	init	(6)	/* call syserr_real$panic...		*/
				internal static	options (constant);
     dcl  ad_code			fixed bin (35);
     dcl  audit_eventflags		bit (36) aligned;			/* access audit flags...		*/
     dcl	bootload_console_name	char	(4)	aligned;
     dcl	console_name		char	(4)	aligned;
     dcl	console_to_check		char	(4)	aligned;		/* for RCP availability...		*/
     dcl	console_io_flags		char	(80);			/* string representation of flags...	*/
     dcl  console_line_length		fixed bin (17);			/* temp holding space...		*/
     dcl	cpu_cnt			fixed bin	(17);			/* number of CPUs in the config file... */
     dcl	device_type		char	(16);			/* alternate, inoperative, I/O...	*/
     dcl	entrypoint		char	(32);			/* name of where we are in the code...	*/
     dcl	err_code			fixed bin	(35);			/* internal standard error code...	*/
     dcl	error_msg			char	(80);			/* error message for reporting...	*/
     dcl	first_io_slot		fixed bin	(17);			/* to check for pending I/O...	*/
     dcl	idx			fixed bin	(17);			/* miscellaneous working index...	*/
     dcl	last_io_slot		fixed bin	(17);			/* to check for pending I/O...	*/
     dcl	local_time		fixed bin	(71);			/* miscellaneous time value...	*/
     dcl	mca_to_unlock		fixed bin	(35);			/* MCA number to be unlocked...	*/
     dcl	new_prompt		char	(8);			/* new prompt string...		*/
     dcl	new_state			char	(4);			/* changed state of a console...	*/
     dcl	oc_data_flags		char	(80);			/* string representation of flags...	*/
     dcl	oc_entry_flags		char	(80);			/* string representation of flags...	*/
     dcl	old_console_name		char	(4)	aligned;
     dcl	word_length		fixed bin	(19);			/* length of I/O in words...		*/
     dcl	pds$process_id		bit	(36)	external	static;
     dcl	pds$process_group_id	char	(32)	external	static;
     dcl	poll_idx			fixed bin	(17);			/* index for polling consoles...	*/
     dcl	reconfig_option		fixed bin	(17);			/* reconfiguration action to take...	*/
     dcl	time_lock_expires		fixed bin	(71);			/* holder should relinquish by then...	*/
     dcl	wait_timer		fixed bin (71);			/* priority IO wait timer		*/
     dcl	this_part_length		fixed bin	(21);			/* ASCII char count of part of the write*/
     dcl	to_write_length		fixed bin	(21);			/* length of string to write...	*/
     dcl	wire_mask			fixed bin	(71);			/* gotten and returned w/o changes...	*/

/* includes... */

%include access_audit_eventflags;

%include arg_descriptor;

%include arg_list;

%include collection_1_phases;

%include config_data_dcls;

%include config_parm_card;

%include config_prph_opc_card;

%include config_iom_card;

%include io_chnl_util_dcls;

%include io_manager_dcls;

%include io_status_entry;

%include io_syserr_msg;

%include iom_dcw;

%include iom_pcw;

%include oc_data;

%include opc_reconfig_options;

%include syserr_binary_def;

%include syserr_constants;

%include syserr_data;

/*	BEGIN MESSAGE DOCUMENTATION


Message:
ocdcm_ (init_all_consoles): Assigned console OPCx as TYPE device.

S:	$announce

T:	$init

M:	This message appears as the system configures consoles found 
in the config file. This message will only appear if the CLST
parameter has been specified on the PARM card. Values for TYPE
are "bootload", "alternate", "I/O", "inoperative" and "off".

A:	$ignore

Message:
ocdcm_ (init_all_consoles): Changing state of OPCx to alt.

S:	$beep

T:	$init

M:	During console initialization more than one console was found 
to have a state of "on". Since only one bootload console is 
allowed the software reconfigures additional "on" consoles as 
alternates.

A:	$config

Message:
ocdcm_ (init_all_consoles): Unknown model, NNNN, specified for OPCx.
       It will not be configured.

S:	$beep

T:	$init

M:	The console model number specified in the config file is not
supported by this software and will not be configured.

A:	$config

Message:
ocdcm_ (init_all_consoles): Illegal console name (NAME) specified.
It will be ignored.

S:	$beep

T:	$init

M:	An illegal console name was found. Console names must be values
of "opca" through "opcz".

A:	$config

Message:
ocdcm_ (init_all_consoles): Invalid state of STATE for console OPCx.
ocdcm_ (init_all_consoles): This console will not be configured.

S:	$beep

T:	$init

M:	An unrecognizable state was found for the specified console.
That console will not be configured. Only valid states are
"on", "alt", "io", "inop" and "off".

A:	$config

Message:
ocdcm_ (init_all_consoles): Maximum console count exceeded.
ocdcm_ (init_all_consoles): Additional consoles will not be configured.

S:	$beep

T:	$init

M:	Too many consoles have been specified in the config file. Only
the maximum number allowable will be configured.

A:	$config

Message:
ocdcm_ (reconfigure): Assigned OPCx as an alternate console for PERSON.PROJ.T.

S:	$beep

T:	$run

M:	The specified process has configured the specified console as an
alternate.

A:	$ignore

Message:
ocdcm_ (reconfigure): Assigned OPCx as the bootload console for PERSON.PROJ.T.

S:	$beep

T:	$run

M:	The specified process has configured the specified console as
the bootload console. The bootload console at the time of the
reconfiguration is reconfigured as an alternate device.

A:	$ignore

Message:
ocdcm_ (reconfigure): Consigned OPCx as an I/O device for PERSON.PROJ.T.

S:	$beep

T:	$run

M:	The specified process has configured the specified console as an
I/O device.

A:	$ignore

Message:
ocdcm_ (reconfigure): Marked OPCx as an inoperative device for PERSON.PROJ.T.

S:	$beep

T:	$run

M:	The specified process has configured the specified console as an
inoperative device.

A:	$ignore

Message:
ocdcm_ (reconfigure): Timeout executing MCA LOCK on OPCx for PERSON.PROJ.T.

S:	$log

T:	$run

M:	The I/O to LOCK the MCA interface through OPCx did not complete
within a given time.

A:	This is most likely a hardware failure of the console channel adapter
or the IMU central.

Message:
ocdcm_ (reconfigure): Timeout executing MCA(nn) UNLOCK on OPCx for PERSON.PROJ.T.

S:	$log

T:	$run

M:	The I/O to UNLOCK the MCA(nn) interface through OPCx did not
complete within a given time.

A:	This is most likely a hardware failure of the console channel adapter
or the IMU central.

Message:
ocdcm_ (reconfigure): MCA input through OPCx, disabled by PERSON.PROJ.T.

S:	$log

T:	$run

M:	The input to the MCA (Maint. Channel Adapter) in the IMU
(Interrupt Multiplexer Unit) from special keyboard sequences
has been LOCKed (disabled). Input to the MCA can now only come
from the on-line, Multics controlled, channel 03 interface.

A:	$ignore

Message:
ocdcm_ (reconfigure): MCA(nn) input through OPCx, enabled by PERSON.PROJ.T.

S:	$log

T:	$run

M:	The input to MCA(nn) via special console keyboard sequences
has been enabled (UNLOCKed).

A:	$ignore

Message:
ocdcm_ (reset_console): Reset bootload console for PERSON.PROJ.T.

S:	$beep

T:	$run

M:	The bootload console has been reset by the specified process.

A:	$ignore

Message:
ocdcm_ (init_all_consoles): Invalid channel specified for OPCx.

S:	$crash

T:	$init

M:	The console channel as specified in the config file for the
specified device is illegal.

A:	$config

Message:
ocdcm_ (init_all_consoles): Missing prph opc card.

S:	$crash

T:	$init

M:	At least one PRPH OPCx card must be in the config file.

A:	$config

Message:
ocdcm_ (init_all_consoles): No active console configured.

S:	$crash

T:	$init

M:	None of the consoles specified in the config file has a state
of "on".

A:	$config

Message:
ocdcm_ (bump_io_to_mc): Message Coordinator failure.

S:	$log

T:	$run

M:	The Message Coordinator is no longer able to handle console
traffic.

A:	Attempt to get an active console online as soon as possible
and reset the Message Coordinator.

Message:
ocdcm_ (console_recovery): Console failed, assignment of alternate OPCx failed.

S:	$log

T:	$run

M:	The console software detected a failure of the bootload console
and found an alternate to utilize. However, when it tried to 
attach the alternate it too was found to be inoperative. The
search continues for a usable console.

A:	Attempt to determine why the alternate console failed to
come online. If it can be repaired configure it with the 
set_system_console command from a highly priviliged process.

Message:
ocdcm_ (console_recovery): Console inoperative, alternate OPCx assigned.

S:	$log

T:	$run

M:	The software has detected a bootload console failure and has
assigned the specifed alternate to take over. The inoperative
console is flagged as such.

A:	$notify

Message:
ocdcm_ (console_recovery): Console inoperative, no alternates available.

S:	$log

T:	$run

M:	The software dected failure of the bootload console, but no
alternates are configured. It will direct subsequent console
traffic to the Message Coordinator.

A:	Attempt to get a running console online via the set_system_console
command as soon as possible.

Message:
ocdcm_ (console_recovery): Console inoperative, no alternates, no MC.

S:	$log

T:	$run

M:	The software detected failure of the bootload console, but no
alternates are configured and the Message Coordinator is not
functioning. All subsequent console traffic will be sent to
the syserr log.

A:	Attempt to get a running console online via the set_system_console
command as soon as possible.

Message:
ocdcm_ (esd_reset): No active consoles configured.

S:	$log

T:	$run

M:	During ESD there were no consoles in service. ESD messages
will be sent to the syserr log.

A:	$notify

Message:
ocdcm_ (interrupt_handler): System Fault.

S:	$log

T:	$run

M:	A system fault interrupt was received from the IOM. The fault
is logged and ignored.

A:	$notify

Message:
ocdcm_ (log_console_error): I/O [timeout] error on OPCx; status = SSSSSS
        oc_data flags: FLAGS
        oc_entry flags: FLAGS
        console_io flags: FLAGS

S:	$log

T:	$run

M:	An I/O error occurred. The status is the returned IOM status
for the I/O in question and the flags denote the state of the
oc_data, the console and the I/O, respectively, at the time of
the error. The flag values are interpreted.

A:	Too many of these errors will result in the invocation of
console recovery. Have the console fixed.

Message:
ocdcm_ (bump_io_to_mc): Console recovery failure.

S:	$crash

T:	$run

M:	The software detected Message Coordinator failure while the
Message Coordinator was being used in place of a functioning
console. Since the CCRF parameter was specified the system 
crashed.

A:	$inform
$inform_sa

Message:
ocdcm_ (console_recovery): Console recovery failure.

S:	$crash

T:	$run

M:	The software detected console failure and was unable to continue
because the CCRF parameter was specified. The system crashed.

A:	$inform
$inform_sa

Message:
ocdcm_ (init_all_consoles): Console channel assignment failed.

S:	$crash

T:	$run

M:	Attachment of the specified bootload console failed during
initialization.

A:	This is most likely a hardware failure of the console channel
adapter.

Message:
ocdcm_ (init_all_consoles): Unable to determine absolute memory address of
       oc_data.

S:	$crash

T:	$run

M:	The absloute memory address of oc_data could not be determined
during console initialization.

A:	This is a very serious error. Ensure that your MST is good and
then consider hardware.

Message:
ocdcm_ (lock_oc_data): Mylock error.

S:	$crash

T:	$run

M:	The offending process found its own process_id in the lock.

A:	$inform

Message:
ocdcm_ (lock_oc_data): Lock wait timer expired.

S:	$crash

T:	$run

M:	A process waiting on the lock was not able to get the lock before
the wait timer expired. This timer is calculated as the maximum
time that it should take a READ I/O to complete times the number of 
CPUs specified in the config file. Any process waiting on the lock
should never have to wait more than that amount of time for the 
lock to become available without there being a serious problem
with the hardcore process holding the lock.

A:	$inform

Message:
ocdcm_ (reconfigure): Bootload console deconfigured with CCRF set.

S:	$crash

T:	During console reconfiguration.

M:	The bootload console was deconfigured by use of the
set_system_console command and the site had specified the CCRF
parameter in the config file.

A:	$recover

Message:
ocdcm_ (unlock_oc_data): Lock not mine.

S:	$crash

T:	$run

M:	A process attempting to unlock oc_data found a non-zero lock
that was not its own.

A:        $inform

END MESSAGE DOCUMENTATION */

end ocdcm_;




		    pc_recover_sst.pl1              11/11/89  1130.2r w 11/11/89  0853.8       35433



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */
/* pc_recover_sst.pl1. The smarts of this program live in
   pc_check_tables_.pl1, which see. */

/* format: style2,indcomtxt */

pc_recover_sst:
     procedure;

/* BIM 84-01-11 */

%include pc_check_tables_info;

	declare arg_list_ptr_	 entry returns (pointer);
	declare syserr		 entry options (variable);
	declare syserr$error_code	 entry options (variable);
	declare ioa_$general_rs	 entry (pointer, fixed binary, fixed binary, character (*), fixed binary (21),
				 bit (1) aligned, bit (1) aligned);
	declare ioa_$rsnnl		 entry () options (variable);
	declare pc_check_tables_	 entry (pointer, fixed bin (35));
	declare debug_check		 entry (char (4) aligned) returns (bit (1) aligned);

	declare 1 CTI		 aligned like check_tables_info;

	declare sst_seg$		 external;
	declare core_map$		 external;
	declare slt$		 external;
	declare pvt$		 external;
	declare sys_info$system_type	 fixed bin (35) external static;

	declare code		 fixed bin (35);

	declare (addr, setwordno, segno)
				 builtin;


	CTI.version = PC_CHECK_TABLES_INFO_VERSION_1;
	CTI.flags = "0"b;
	CTI.flags.recover_errors = "1"b;
	CTI.flags.report_errors, CTI.report_state = debug_check ("esdt");
	CTI.flags.report_error_counts = CTI.flags.report_errors | debug_check ("esds");
	CTI.report = report_;
	CTI.display_ptw = display_ptw_;
	CTI.display_cme = display_cme_;
	CTI.display_aste = display_aste_;
	CTI.display_ptr = display_ptr_;
	CTI.display_pvname = display_pvname_;

	CTI.sst_ptr = addr (sst_seg$);
	CTI.core_map_ptr = addr (core_map$);		/* NOT sst.cmp */
	CTI.pvt_ptr = addr (pvt$);
	CTI.system_type = sys_info$system_type;

	call pc_check_tables_ (addr (CTI), code);
	if code ^= 0
	then call syserr$error_code (CRASH, code, "pc_recover_sst: could not recover sst/core_map. Reboot and salvage.")
		;
	return;

report_:
     procedure options (variable);

	declare long_string		 char (200);
	declare lsl		 fixed bin (21);

	call ioa_$general_rs (arg_list_ptr_ (), 1, 2, long_string, lsl, "0"b, "0"b);
	call syserr (ANNOUNCE, "^a", substr (long_string, 1, lsl));
	return;
     end report_;

display_ptw_:
     procedure (ptwp);

	declare ptwp		 pointer;

	call report_ (" --> PTW at ^6o", wordno (ptwp));
	return;
     end display_ptw_;

display_cme_:
     procedure (cmep);

	declare cmep		 pointer;

	call report_ (" --> CME at ^6o", wordno (cmep));
	return;
     end display_cme_;

display_aste_:
     procedure (astep);

	declare astep		 pointer;

	call report_ (" --> aste at ^6o", wordno (astep));
	return;
     end display_aste_;

display_ptr_:
     procedure (ap) returns (char (*));

	declare ap		 pointer;
	declare offset		 char (12);

	offset = "";
	call ioa_$rsnnl ("^o", offset, (0), wordno (ap));
	sltp = addr (slt$);
	names_ptr = slt.name_seg_ptr;
	sltep = addr (slt.seg (segno (ap)));
	namep = setwordno (names_ptr, bin (slte_uns.names_ptr, 18));
	return (rtrim (segnam.names (1).name) || rtrim (offset));
     end display_ptr_;

display_pvname_:
     procedure (pvtx) returns (char (32));

	declare pvtx		 fixed bin;

	declare 1 dname		 unaligned,
		2 devname		 char (4),
		2 u		 char (1) init ("_"),
		2 nn		 picture "99";

	pvt_arrayp = addr (pvt$array);
	pvtep = addr (pvt_array (pvtx));
	dname.devname = pvte.devname;
	dname.nn = pvte.logical_area_number;
	return (string (dname));
     end display_pvname_;


/* format: off */

%page; %include pvte;
%page; %include syserr_constants;
%page; %include slt;
%page; %include slte;

       end pc_recover_sst;




		    scr_util.pl1                    11/11/89  1130.2rew 11/11/89  0853.8      217584



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */
/* SCR_UTIL - Procedure to Manipulate System Controller Registers and Data.
   coded 2/1/76 by Noel I. Morris
   modified 5/11/78 by J. A. Bush for processor testing
   modified 2/5/79 by B. Greenberg for port expanders.
   modified May 1981 by J. Bongiovanni to set anti-hog switches,
        validate sscr
*/


/* ******************************************************
   *                                                    *
   *                                                    *
   * Copyright (c) 1972 by Massachusetts Institute of   *
   * Technology and Honeywell Information Systems, Inc. *
   *                                                    *
   *                                                    *
   ****************************************************** */


scr_util$read_cfg: proc (port);

dcl  port fixed bin (3);				/* controller port number on active modules */

dcl  mr_data fixed bin (71),				/* data from RSCR-MR */
     i fixed bin,					/* iteration variable */
     ctag fixed bin (3),				/* system controller tag */
     bitno fixed bin,				/* mask bit offset */
     iscu fixed bin (5),				/* ISOLTS SCU tag */
     icpu fixed bin (5),				/* ISOLTS CPU tag */
     mcpu fixed bin (5),				/* ISOLTS mask cpu */
    (maska, maskb) bit (9),				/* temporary mask reg storage */
    (store_a_size, store_b_size) fixed bin (17),		/* size of stores A & B */
    scr_cfg2_temp fixed bin (71) aligned,		/* temp rscr storage			*/
    set_cfg_try_count fixed bin,			/* number times tried sscr			*/
    set_cfg_ok bit (1) aligned,
    mask_a_val char (3),
    mask_b_val char (3),
    cycle_priority_bits (7) bit (1),
    port_enable_bits (8) bit (1),
    nea_bits (7) bit (1);

	         
	         

dcl 1 cdata aligned like scs$controller_data based (cdp),	/* single element of scs$controller data */
     cdp ptr,					/* pointer to the above */
    1 pdata aligned like scs$processor_data based (pdp),	/* single element of scs$processor_data */
     pdp ptr;					/* pointer to the above */

dcl  masks (3) bit (72) aligned based (mkp),		/* array of interrupt masks */
     mkp ptr;					/* pointer to the above */

dcl  scr_cfg2_temp_overlay bit (72) aligned defined (scr_cfg2_temp);
	         

dcl  SCR_CFG2_PROGRAM_MASK bit (72) aligned int static options (constant)
        init ("777774037777777000077417"b3);		/* program settable bits in config register	*/
dcl  SET_CFG_TRY_LIMIT fixed bin int static options (constant)
        init (10);					/* number sscr attempts before punting		*/
dcl  LETTERS char (8) int static options (constant) init ("ABCDEFGH");

dcl  privileged_mode_ut$cioc entry (ptr),
     privileged_mode_ut$rscr entry (fixed bin (3), fixed bin (6), fixed bin (71)),
     privileged_mode_ut$sscr entry (fixed bin (3), fixed bin (6), fixed bin (71)),
     privileged_mode_ut$smcm entry (fixed bin (3), bit (72) aligned),
     syserr entry options (variable);
	         

dcl (addr, bin, bit, convert, index, mod, string, substr, unspec) builtin;



% include scs;


% include scr;



	cdp = addr (scs$controller_data (port));	/* Get pointer to appropriate element of array. */

	call privileged_mode_ut$rscr (port, SC_MR, mr_data); /* Read the controller mode register. */
	scrp = addr (mr_data);			/* Set pointer to data read. */
	cdata.type = scr_mr.identification;		/* Extract the controller ID code. */

	call privileged_mode_ut$rscr (port, SC_CFG, scs$cfg_data (port));
	scrp = addr (scs$cfg_data (port));		/* Read configuration data from controller. */

	if cdata.type >= "0010"b then do;		/* If 4MW SCU ... */
	     cdata.store_a_online = scr_cfg2.a_online;
	     cdata.store_a1_online = scr_cfg2.a1_online;
	     cdata.store_b_online = scr_cfg2.b_online;
	     cdata.store_b1_online = scr_cfg2.b1_online;
	     cdata.store_b_is_lower = scr_cfg2.lwr;
	     cdata.int_interlaced = scr_cfg2.int;
	     cdata.lower_store_size = power_of_two (bin (scr_cfg2.size, 3) + 5);
	     if (cdata.store_b_is_lower & cdata.store_a_online) |
	     (^cdata.store_b_is_lower & cdata.store_b_online) then
		if scr_cfg2.nea_enabled then		/* Compute size of upper store. */
		     cdata.upper_store_size =
		     bin (bit (scr_cfg2.nea, 12)) - mod (cdata.base, 4096) - cdata.lower_store_size;
		else
		cdata.upper_store_size = cdata.lower_store_size;
	     else
	     cdata.upper_store_size = 0;
	     string (cdata.cyclic_priority) = scr_cfg2.cyclic_prior;
	     call interpret_eima (1, scr_cfg2.mask_a_assign);
	     call interpret_eima (2, scr_cfg2.mask_b_assign);
	     cdata.eima_data (1).mask_available,
		cdata.eima_data (2).mask_available = "1"b;
	     cdata.eima_data (3).mask_available,
		cdata.eima_data (4).mask_available = "0"b;

	     cdata.program = scr_cfg2.mode;
	end;



	else do;					/* If 6000 SC ... */
	     cdata.store_a_online = (scr_cfg1.mode_a = "000"b);
	     cdata.store_b_online = (scr_cfg1.mode_b = "000"b);
	     cdata.store_b_is_lower = scr_cfg1.lwr;
	     cdata.int_interlaced = scr_cfg1.int;
	     if cdata.store_a_online then
		store_a_size = (bin (scr_cfg1.bdry_a, 3) + 1) * 32;
	     else
	     store_a_size = 0;
	     if store_a_size = 128 then
		cdata.store_a1_online = "1"b;		/* Two ports for 128K store. */
	     else
	     cdata.store_a1_online = "0"b;
	     if cdata.store_b_online then
		store_b_size = (bin (scr_cfg1.bdry_b, 3) + 1) * 32;
	     else
	     store_b_size = 0;
	     if store_b_size = 128 then
		cdata.store_b1_online = "1"b;		/* Two ports for 128K store. */
	     else
	     cdata.store_b1_online = "0"b;
	     if cdata.store_b_is_lower then do;
		cdata.lower_store_size = store_b_size;
		cdata.upper_store_size = store_a_size;
	     end;
	     else do;
		cdata.lower_store_size = store_a_size;
		cdata.upper_store_size = store_b_size;
	     end;
	     string (cdata.cyclic_priority) = (7)"0"b;
	     do i = 1 to 4;
		call interpret_eima (i, scr_cfg1.pima (i));
		cdata.eima_data (i).mask_available = "1"b;
	     end;

	     cdata.program = "1"b;
	end;

	return;



set_port_enable: entry (port, enable_sw);		/* entry to enable a controller port */

dcl  enable_sw bit (1) unal;				/* 1 => enable corresponding port */


	call set_port_enable_bit (port, enable_sw);	/* Set the bit first. */

	do ctag = 0 to 7;				/* Set ports in all controllers. */
	     cdp = addr (scs$controller_data (ctag));	/* Get pointer to controller data for this port. */

	     if cdata.online then			/* If controller is in use ... */
		call enable_ports (ctag);		/* Go set the port enable bits. */
	end;

	return;



set_port_enable_bit: entry (port, enable_sw);		/* entry to only set port enable bits */


	mkp = addr (scs$sys_level);			/* Get pointer to array of masks. */

	do i = 1 to scs$number_of_masks;		/* Modify all masks. */
	     scrp = addr (masks (i));			/* Get pointer to mask. */
	     if port < 4 then			/* If ports 0 thru 3 ... */
		substr (scr_msk.port_mask_1, port + 1, 1) = enable_sw;
	     else					/* If ports 4 thru 7 ... */
	     substr (scr_msk.port_mask_2, port - 3, 1) = enable_sw;
	end;

	return;



enable_ports: entry (port);				/* entry to set port enable bits in a controller */


	cdp = addr (scs$controller_data (port));	/* Get pointer to data for this controller. */
	scrp = addr (scs$cfg_data (port));		/* Get pointer to CFG data for this controller. */
	mkp = addr (scs$sys_level);			/* Get pointer to a mask. */

	if cdata.type >= "0010"b then do;		/* If 4MW SCU ... */
	     scr_cfg2.port_mask_0_3 = mkp -> scr_msk.port_mask_1;
	     scr_cfg2.port_mask_4_7 = mkp -> scr_msk.port_mask_2;
	     call set_cfg (port);			/* Actually set the controller. */
	end;

	else					/* If 6000 SC ... */
	if port = scs$interrupt_controller then		/* If bootload controller, allow interrupts. */
	     call privileged_mode_ut$smcm (port, scs$open_level);
	else					/* If not bootload controller, prevent interrupts. */
	call privileged_mode_ut$smcm (port, scs$sys_level);

	return;



disable_ports: entry (port);				/* entry to clear all port enable bits in a controller */


	cdp = addr (scs$controller_data (port));	/* Get pointer to data for this controller. */
	scrp = addr (scs$cfg_data (port));		/* Get pointer to CFG data for this controller. */

	if cdata.type >= "0010"b then do;		/* If 4MW SCU ... */
	     scr_cfg2.port_mask_0_3 = "0000"b;
	     scr_cfg2.port_mask_4_7 = "0000"b;
	     call set_cfg (port);			/* Actually set the controller. */
	end;

	else					/* If 6000 SC ... */
	call privileged_mode_ut$smcm (port, unspec (bin (0, 71)));

	return;



assign_mask: entry (port, target);			/* entry to assign a mask to a port */

dcl  target fixed bin (3);				/* port to which mask will be assigned */

dcl  mask_assignment bit (9);				/* mask assignment bits */


	cdp = addr (scs$controller_data (port));	/* Get pointer to correct array element. */
	scrp = addr (scs$cfg_data (port));		/* Get pointer to correct CFG data. */

	if cdata.type >= "0010"b then do i = 1 to 2;	/* Do this only for 4MW SCU. */
	     if ^cdata.eima_data (i).mask_assigned then do; /* Look for unused mask. */
		cdata.eima_data (i).mask_assignment = target;
		cdata.eima_data (i).mask_assigned = "1"b;
		mask_assignment = set_mask_assignment (target + 1);
		if i = 1 then			/* Set appropriate field in CFG data. */
		     scr_cfg2.mask_a_assign = mask_assignment;
		else
		scr_cfg2.mask_b_assign = mask_assignment;
	     end;
	end;

	return;



unassign_mask: entry (port, target);			/* entry to unassign a mask from a port */


	cdp = addr (scs$controller_data (port));	/* Get pointer to correct array element. */
	scrp = addr (scs$cfg_data (port));		/* Get pointer to correct CFG data. */

	if cdata.type >= "0010"b then do i = 1 to 2;	/* Do this only for 4MW SCU. */
	     if cdata.eima_data (i).mask_assigned &	/* Look for mask used for this target. */
	     (cdata.eima_data (i).mask_assignment = target) then do;
		cdata.eima_data (i).mask_assigned = "0"b;
		mask_assignment = set_mask_assignment (9);
		if i = 1 then			/* Set appropriate field in CFG data. */
		     scr_cfg2.mask_a_assign = mask_assignment;
		else
		scr_cfg2.mask_b_assign = mask_assignment;
	     end;
	end;

	return;




reassign_mask: entry (tag1, tag2);			/* entry to reassign mask to another port */

dcl  tag1 fixed bin (3),				/* processor tag of assigned mask */
     tag2 fixed bin (3);				/* processor tag for new assignment */


	ctag = scs$interrupt_controller;		/* Change bootload controller only. */

	if tag1 ^= -1 then do;			/* If assignment to be removed ... */	
	     pdp = addr (scs$processor_data (tag1));	/* Get pointer to data for this processor. */

	     if tag2 ^= -1 then 			/* Check for same-port (poss. expander) case and punt */
		if pdata.controller_port = scs$processor_data (tag2).controller_port then return;
	     call set_mask (ctag, (pdata.controller_port), 0);
						/* Clear the mask. */
	     call unassign_mask (ctag, (pdata.controller_port));
						/* Unassign the mask. */
	end;
	if tag2 ^= -1 then do;			/* If new assignment to be made ... */
	     pdp = addr (scs$processor_data (tag2));	/* Get pointer to data for this processor. */

	     call assign_mask (ctag, (pdata.controller_port));
						/* Make new mask assignment. */
	     call set_cfg (ctag);			/* Set switches in controller. */
	end;

	return;


update_export_xipmsk:
	entry (port);				/* Update port-expander XIP masks */

dcl 1 rcow based (addr (scs$reconfig_general_cow)) aligned like scs$reconfig_general_cow;

	unspec (rcow) = ""b;			/* Zero the cow. */
	do i = 0 to 7;
	     pdp = addr (scs$processor_data (i));	/* Address proc data element */
	     if pdata.expanded_port & pdata.controller_port = port
		then substr (rcow.sub_mask, pdata.expander_port + 1, 1) =  pdata.interrupt_cpu;
	end;
	rcow.expander_command = "2"b3;		/* Set XIP register */
	rcow.controller_port = port;
	call privileged_mode_ut$cioc (addr (rcow.cow));	/* We rely on this living in the bootload controller */
	return;

set_export_enable:
	entry (port, subport, enable_sw);

dcl  subport fixed bin (3);

	unspec (rcow) = ""b;			/* Clear out sutff */
	do i = 0 to 7;				/* Scan CPU's */
	     pdp = addr (scs$processor_data (i));
	     if pdata.expanded_port & pdata.controller_port = port
		then if pdata.expander_port = subport
		     then substr (rcow.sub_mask, pdata.expander_port + 1, 1) = enable_sw;
		     else substr (rcow.sub_mask, pdata.expander_port + 1, 1) = pdata.online;
         end;
	substr (rcow.sub_mask, 5, 1) = "1"b;		/* T. Ohlin wants exerciser bit on. */
         rcow.expander_command = "1"b3;			/* Set subport enables */
         rcow.controller_port = port;
         call privileged_mode_ut$cioc (addr (rcow.cow));	/* Zap the bootload SCU */
/* The enables on all the other SCU's will be left enabled */
         return;
		     
	

set_cfg:	entry (port);				/* entry to set CFG data in controller */


	if scs$controller_data (port).type >= "0010"b then do; /* If 4MW SCU ... */
	     if scs$set_cycle_switches then
		string (addr (scs$cfg_data (port)) -> scr_cfg2.cyclic_prior) = scs$cycle_priority_template;
try_to_set_cfg:
	     scrp = addr (scs$cfg_data (port));
	     unspec (port_enable_bits) = scr_cfg2.port_mask_0_3 || scr_cfg2.port_mask_4_7;
	     set_cfg_ok = "0"b;
	     do set_cfg_try_count = 1 repeat set_cfg_try_count + 1
		while (set_cfg_try_count <= SET_CFG_TRY_LIMIT & ^set_cfg_ok);
		call privileged_mode_ut$sscr (port, SC_CFG, scs$cfg_data (port));
		if unspec (port_enable_bits) = "0"b then set_cfg_ok = "1"b;     /* if we can't check, assume OK	*/
		else do;
		     call privileged_mode_ut$rscr (port, SC_CFG, scr_cfg2_temp); /* read to make sure it took	*/
		     if (unspec (scr_cfg2_temp) & SCR_CFG2_PROGRAM_MASK)
			= (unspec (scs$cfg_data (port)) & SCR_CFG2_PROGRAM_MASK)    /* check all program-settable bits*/
			then set_cfg_ok = "1"b;
		end;
	     end;
	     
/* If the sscr did not take within the requisite number of tries, we
   punt by printing instructions to the operator to clear the SCU
   manually.  This involves setting switches, flipping the mode into
   MANUAL, then back into PROGRAM.  When these two actions have happened,
   we check again, repeating the process if necessary						*/
	     
	     if ^set_cfg_ok then do;			/* drastic manual intervention		*/
		call syserr (3, "scr_util: error setting configuration register. SCU ^a must be set manually",
		     substr (LETTERS, port+1, 1));
		call syserr (0, "Set the following switches on SCU ^a",
		     substr (LETTERS, port+1,1));
		
		unspec (cycle_priority_bits) = scr_cfg2.cyclic_prior;
		unspec (nea_bits) = scr_cfg2.nea;
		mask_a_val = convert_to_mask_val (substr (scr_cfg2.mask_a_assign, 1, 8));
		mask_b_val = convert_to_mask_val (substr (scr_cfg2.mask_b_assign, 1, 8));
		
		call syserr (0, "^/^12x--PORT ENABLE--  --CYCLIC PRIORITY---^/^12x0 1 2 3 4 5 6 7  0/1 1/2 2/3 3/4 4/5 5/6 6/7^/^8xON  ^8(^[X^; ^] ^) ^7( ^[X^; ^]  ^)^/^8xOFF ^8(^[ ^;X^] ^) ^7( ^[ ^;X^]  ^)",
		     port_enable_bits, cycle_priority_bits, 
		     port_enable_bits, cycle_priority_bits);
		call syserr (0, "^/^8xNON-EXISTENT ADDRESS^/^17x2 3 4 5 6 7 8^/^8xON  ^[X^; ^]  1 ^7(^[X^; ^] ^)^/^8xOFF ^[ ^;X^]  0 ^7(^[ ^;X^] ^)",
		     scr_cfg2.nea_enabled, nea_bits,
		     scr_cfg2.nea_enabled, nea_bits);
		call syserr (0, "^/^8xSTORE A  A1 B  B1^/^8xON    ^4(^[X^; ^]  ^)^/^8xOFF   ^4(^[ ^;X^]  ^)",
		     scr_cfg2.a_online, scr_cfg2.a1_online, scr_cfg2.b_online, scr_cfg2.b1_online,
		     scr_cfg2.a_online, scr_cfg2.a1_online, scr_cfg2.b_online, scr_cfg2.b1_online);
		call syserr (0, "^/^8xLWR STORE SIZE - ^d^/^8xINTERLACE - ^[ON^;OFF^]^/^8xLWR STORE - ^[B^;A^]^/^8xMASK A - ^a^/^8xMASK B - ^a",
		     bin (scr_cfg2.size), scr_cfg2.int, scr_cfg2.lwr,
		     mask_a_val, mask_b_val);
		
		call syserr (0, "After setting the switches for SCU ^a place SCU ^a into Manual Mode and then into Program Mode",
		     substr (LETTERS, port+1, 1), substr (LETTERS, port+1, 1));

/* Wait for SCU to go into Manual Mode								*/
		
		do while (addr (scr_cfg2_temp) -> scr_cfg2.mode);
		     call privileged_mode_ut$rscr (port, SC_CFG, scr_cfg2_temp);
		end;
		
/* Wait for SCU to go into Program Mode								*/
		
		do while (^addr (scr_cfg2_temp) -> scr_cfg2.mode);
		     call privileged_mode_ut$rscr (port, SC_CFG, scr_cfg2_temp);
		end;
		

/* Check whether SCU cleared properly								*/
		
		if (unspec (scr_cfg2_temp) & SCR_CFG2_PROGRAM_MASK)
		     ^= (unspec (scs$cfg_data (port)) & SCR_CFG2_PROGRAM_MASK)
		     then goto try_to_set_cfg;
	     end;
	     

		
		

	end;
						/* Set CFG data in controller. */
	return;



set_mask:	entry (port, target, mask);			/* entry to set mask for controller port */

dcl  mask fixed bin (71);				/* mask to be set */


	call privileged_mode_ut$sscr (port, SC_MSK + 8 * target, mask);
						/* Set the mask. */

	return;




convert_to_mask_val:
	proc (scu_mask_bits) returns (char (*));	/* procedure to convert a mask to printable form	*/
	
dcl  scu_mask_bits bit (*) unaligned,
     mask_val pic "9";
	
	
	if index (scu_mask_bits, "1"b) >0 then do;
	     mask_val = index (scu_mask_bits, "1"b) - 1;
	     return (mask_val);
	end;
	else return ("Off");
	
	
end convert_to_mask_val;

	



interpret_eima: proc (n, eima);			/* procedure to determine port assignment from bits */

dcl  n fixed bin,					/* EIMA number */
     eima bit (9);					/* mask assignment bits */

dcl  x fixed bin;					/* port mask assigned to */


	     x = index (eima, "1"b);			/* Look for bit ON. */
	     if (x = 0) | (x = 9) then		/* If no bits ON, or last bit ON ... */
		cdata.eima_data (n).mask_assigned = "0"b; /* Mask is not assigned to any port. */
	     else do;				/* Mask is assigned. */
		cdata.eima_data (n).mask_assigned = "1"b;
		cdata.eima_data (n).mask_assignment = x - 1; /* Remember port to which mask is assigned. */
	     end;

	     return;

	end interpret_eima;



set_mask_assignment: proc (n) returns (bit (9) unal);	/* procedure to set correct mask assignment bit */

dcl  n fixed bin;					/* bit to be set */

dcl  m bit (9) aligned;				/* prototype mask assignment bits */


	     m = "0"b;				/* Clear all bits. */
	     substr (m, n, 1) = "1"b;			/* Set the desired bit. */

	     return (m);				/* Return assignment bits. */


	end set_mask_assignment;




power_of_two: proc (e) returns (fixed bin);		/* procedure to compute power of two */

dcl  e fixed bin;					/* exponent */

dcl  p fixed bin;					/* power of two */


	     p = 0;				/* Clear the result. */
	     substr (unspec (p), 36 - e, 1) = "1"b;	/* Very quick, and extremely dirty. */

	     return (p);


	end power_of_two;

/*  */

/* isolts_scu_p1 - entry to set config data in the SCU being used for ISOLTS, to isolate the processor under test */

isolts_scu_p1: entry;

	iscu = scs$processor_test_data.scu_tag;		/* pick up scu_tag, cpu_tag, and mask cpu tag */
	icpu = scs$processor_test_data.cpu_tag;		/* from processor test data structure */
	mcpu = scs$processor_test_data.mask_cpu;
	cdp = addr (scs$controller_data (iscu));
	scrp = addr (scs$cfg_data (iscu));
	pdp = addr (scs$processor_data (icpu));
	mkp = addr (scs$cpu_test_mask);

/* do the things common to both types of SCU's first */

	maska = set_mask_assignment (scs$processor_data (mcpu).controller_port + 1);
	maskb = set_mask_assignment (pdata.controller_port + 1);

/* set up scs$cpu_test mask */

	scs$cpu_test_mask = "0"b;			/* initialize it first */
	mkp -> scr_msk.port_mask_1 = substr ((maska | maskb), 1, 4); /* set port mask fields */
	mkp -> scr_msk.port_mask_2 = substr ((maska | maskb), 5, 4);

	if cdata.type >= "0010"b then do;		/* if 4MW SCU ... */

	     scr_cfg2.mask_a_assign = maska;		/* set up config data */
	     scr_cfg2.mask_b_assign = maskb;
	     scr_cfg2.port_mask_0_3 = mkp -> scr_msk.port_mask_1;
	     scr_cfg2.port_mask_4_7 = mkp -> scr_msk.port_mask_2;

	     call set_cfg ((iscu));			/* actually set config data in SCU */

	end;

	else call privileged_mode_ut$smcm ((iscu), scs$cpu_test_mask); /* 6000 SCU, just set port mask  */
	call set_mask ((iscu), (scs$processor_data (mcpu).controller_port), /* mask off interrupts */
	     fixed (scs$cpu_test_mask, 71));		/* in mask cpu */
	mkp -> scr_msk.interrupt_mask_1 = "1001000000001000"b; /* set int mask for cells 0 and 12 */
						/* and cell 3 for test progras */
	scs$processor_test_data.scu_state = "10"b;	/* set scu state to indicate where we are at */

	return;					/* thats all folks */

/*  */

/* isolts_scu_p2 - entry to re-enable original SCU ports + port for test cpu */

isolts_scu_p2: entry;

	iscu = scs$processor_test_data.scu_tag;		/* pick up scu_tag, cpu_tag, and mask cpu tag */
	icpu = scs$processor_test_data.cpu_tag;		/* from processor test data structure */
	mcpu = scs$processor_test_data.mask_cpu;
	cdp = addr (scs$controller_data (iscu));
	scrp = addr (scs$cfg_data (iscu));
	pdp = addr (scs$processor_data (icpu));
	mkp = addr (scs$cpu_test_mask);

/* do the things common to both types of SCU's first */

	maska = set_mask_assignment (pdata.controller_port + 1);
	pdp = addr (scs$sys_level);			/* get a pointer to a mask */
	mkp -> scr_msk.port_mask_1 = pdp -> scr_msk.port_mask_1 | substr (maska, 1, 4);
	mkp -> scr_msk.port_mask_2 = pdp -> scr_msk.port_mask_2 | substr (maska, 5, 4);

	if cdata.type >= "0010"b then do;		/* if 4MW SCU ... */

	     scr_cfg2.port_mask_0_3 = mkp -> scr_msk.port_mask_1;
	     scr_cfg2.port_mask_4_7 = mkp -> scr_msk.port_mask_2;

	     call set_cfg ((iscu));			/* actually set config data in SCU */

	end;

	else call privileged_mode_ut$smcm ((iscu),
	     "000000000017000000000017"b3 & scs$cpu_test_mask); /* 6000 SCU, set port mask */
	call set_mask ((iscu), (scs$processor_data (mcpu).controller_port), /* mask off interrupts */
	     fixed ("000000000017000000000017"b3 & scs$cpu_test_mask, 71)); /* in mask cpu */

	return;					/* thats all folks */


/*  */

/* isolts_scu_p3 - entry to restore orignial SCU port masks upon termination of ISOLTS CPU testing */

isolts_scu_p3: entry;

	iscu = scs$processor_test_data.scu_tag;		/* pick up scu_tag */
	cdp = addr (scs$controller_data (iscu));

	scs$cfg_data (iscu) = scs$cfg_data_save;	/* restoe orignial config data */

	if cdata.type >= "0010"b then			/* if 4MW SCU */
	     call set_cfg ((iscu));			/* actually set config data */
	else call privileged_mode_ut$smcm ((iscu), scs$sys_level); /* if 6000 SC */

	return;					/* thats all */

%page;
/* BEGIN MESSAGE DOCUMENTATION

   Message:
   scr_util: error setting configuration register. SCU X must be set manually.
   Set the following switches on SCU X
   < Diagram of SCU Maintenance Panel is Printed Here>
   After setting the switches for SCU X place SCU S into Manual Mode and then into Program Mode
   
   S: $beep

   T: Reconfiguration (e.g., adding or deleting a CPU)

   M: The supervisor was unable to set the configuration register in the SCU
   indicated after 10 attempts.  To avoid a system crash, the SCU must be
   cleared manually.  In this message, the supervisor will print a diagram
   of the SCU Maintenance Panel, indicating how each switch should be set.
   
   A: The operator should copy the diagram of the SCU Maintenance Panel
   printed by the supervisor (or take the copy printed, if possible).  The
   operator should then go to the Maintenance Panel of the SCU indicated
   and set each switch on the diagram to the indicated position, and then
   verify that each switch is in the correct position.  Following this, the
   operator should set the Program/Manual switch into the Manual position
   briefly, and then return it to the Program position.  If this procedure
   does not remedy the problem, the message will be repeated, and the
   System Programming Staff should be contacted.

   END MESSAGE DOCUMENTATION */
   
     end scr_util$read_cfg;




		    vtoc_interrupt.pl1              11/11/89  1130.2r w 11/11/89  0853.8       43857



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


	/*


			vtoc_interrupt (core, code)	




              The  "vtoc_interrupt"  procedure  is called upon completion of any
          64-word I/O operation. Its input arguments are the absolute address of
          the 64-word buffer involved in the operation  and  a  code  indicating
          whether or not the operation was successful.

          If  the  operation was successful, the input argument code is zero. In
          this case the procedure aknowledges the successful I/O termination  by
          turning  the  out  of  service  switch  OFF  in  the  buffer descripor
          associated with the operation. In  addition,  it  notifies  the  event
          associated  with  this  particular buffer.  
          This  notification  takes place only if at least one process is waiting
          for the event.

          All these actions are performed without any  lock  and  are  therefore
          completely asynchronous with the execution of the vtoc_man procedures.

          If  the  operation was not successful, the input argument is non zero.
	The operation is posted with an error flag in the buffer control word.
	This causes read calls to return with an error,  freeing   the buffer,
	and write  calls to keep the  buffer 'hot', awaiting  later successful
	write calls or shutdown to requeue the I/O.


	Modified by :

	06/20/75	Andre Bensoussan.
	06/02/76  Bernard Greenberg for 'hot' buffers (non-fatal write errors)
	07/08/82 by J. Bongiovanni for new vtoc buffer strategy

	*/

vtoc_interrupt : procedure (core, code);


	dcl core		fixed bin(24);
	dcl code		fixed bin(35);

	dcl bufx		fixed bin;
	dcl p99		pic "99";
	dcl wait_event	bit (36) aligned;

	dcl pxss$notify	entry (bit (36) aligned);
	dcl disk_emergency  entry (fixed bin, bit (36) aligned);
	dcl syserr	entry options (variable);

	/*	% include	vtoc_buffer	see at the end	*/



          vtoc_buffer_segp = addr (vtoc_buffer_seg$);
	vtoc_buf_desc_arrayp = ptr (vtoc_buffer_segp, vtoc_buffer.buf_desc_offset);
	vtoc_buf_arrayp = ptr (vtoc_buffer_segp, vtoc_buffer.buf_offset);

	bufx = divide (core - vtoc_buffer.abs_addr - bin (rel (vtoc_buf_arrayp)), size (vtoce_buffer), 17)
	     + 1;
	if bufx < 1 | bufx > vtoc_buffer.n_bufs
	     then call syserr (CRASH, "vtoc_interrupt: Bad core address");

	vtoc_buf_descp = addr (vtoc_buf_desc_array (bufx));
	vtoc_bufp = addr (vtoce_buffer_array (bufx));
	
	if ^vtoc_buf_desc.os
	     then call syserr (CRASH, "vtoc_interrupt: Buffer not os at interrupt");

	if code ^= 0 then do;		/* An error */
	   if vtoc_buf_desc.write_sw then do;
	        pvt_arrayp = addr (pvt$array);
	        pvtep = addr (pvt_array (vtoc_buf_desc.pvtx));
	        call syserr (JUST_LOG, "vtoc_interrupt: Write error on ^a_^a vtocx ^o",
		   pvte.devname, convert (p99, pvte.logical_area_number), vtoc_buf_desc.vtocx);
	   end;
	   vtoc_buf_desc.err = "1"b;
	   call disk_emergency ((vtoc_buf_desc.pvtx), unspec (code));
	end;

	vtoc_buf_desc.os = "0"b;

	if vtoc_buf_desc.notify_sw then do;
	     wait_event = bit (bin (vtoc_buffer.wait_event_constant + vtoc_buf_desc.wait_index, 36), 36);
	     call pxss$notify (wait_event);
	end;

	return;

%page;
%include pvte;
%page;
%include syserr_constants;
%page;
%include vtoc_buffer;
%page;
/* BEGIN MESSAGE DOCUMENTATION

   Message:
   vtoc_interrupt: bad core address

   S: $crash

   T: $run

   M: The disk dim reported a main memory address to the
   VTOC manager which was not in the VTOC buffer segment,
   or was not designating a legal buffer boundary.
   $err

   A: $recover

   Message:
   vtoc_interrupt: Buffer not os at interrupt

   S: $crash

   T: $run

   M: An I/O completion was received for a VTOC buffer which was
   apparently not undergoing I/O.
   $err

   A: $recover

   Message:
   vtoc_interrupt: Write error on dskX_NN vtocx XXXXXX

   S: $log

   T: $run

   M: A bad I/O status was received by the VTOC manager for a write operation.
   The unwritten vtoce-part will remain in main memory until the next attempt is
   made to write it out, or demount or shutdown time.  Too many of these can
   cause the system to crash.

   A: $ignore

   END MESSAGE DOCUMENTATION */

end vtoc_interrupt;




		    wired_plm.pl1                   11/11/89  1130.2rew 11/11/89  0853.8       36864



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


wired_plm: proc ();

/* RE Mullen, v2pl1, oct 1973 */
/* NSS by BSG */
/* BSG for lockless scheduler and global events, 9/20/77 */
/* Modified 03/21/81, W. Olin Sibert, for ADP PTW formats */
/* Metering added 04/17/81, WOS */
/* No PD, 07/25/83, E. N. Kittlitz */

dcl  apt_ptr ptr parameter;

dcl  rastep bit (18) aligned;
dcl  i fixed bin;
dcl (astep, ap) ptr;
dcl  sstp pointer;
dcl  ptp pointer;

dcl 1 p based (ap),
    2 a (0 : 1) bit (18) unaligned;

dcl  page$pread entry (ptr, fixed bin, fixed bin (35));
dcl  page$lock_ptl entry ();
dcl  page$unlock_ptl entry ();

dcl  pds$processid bit (36) aligned external static;
dcl  pds$apt_ptr ptr external static;
dcl  sst$astsize fixed bin external static;
dcl  sst$astap pointer external static;
dcl  sst$cmp pointer external static;
dcl  sst$wired fixed bin external static;
dcl  sys_info$system_type fixed bin external static;
dcl  tcm$loading_page_waits fixed bin (35) external static;

dcl  sst_seg$ external static;

dcl (addr, addrel, ptr, rel) builtin;

/*  */

/* LOAD: Entry to load a process by wiring down all critical pages
   needed by the process. */

wired_plm$load: entry (apt_ptr);

	aptep = apt_ptr;				/* Copy args */
	sstp = addr (sst_seg$);
	ap = addr (apte.asteps);			/* get pointer to asteps array */

	call page$lock_ptl;

	do i = 0 to 1;				/* loop over the asteps */
	     rastep = ap -> p.a (i);			/* get i-th rel pointer */
	     if rastep then do;			/* if rel pointer non zero */
		astep = ptr (sstp, rastep);
		ptp = addrel (astep, sst$astsize);	/* get pointer to page table */

		call load_this_page ();
		end;
	     end; 				/* of loop through asteps */

	call page$unlock_ptl;

	return;					/* All done */

/*  */

load_this_page: proc ();

dcl  wired_bit bit (1) aligned;
dcl  os_bit bit (1) aligned;
dcl  valid_bit bit (1) aligned;
dcl  wait_event fixed bin (35);


	if sys_info$system_type = ADP_SYSTEM then do;	/* Get the interesting bits */
	     valid_bit = adp_ptw.valid;
	     os_bit = adp_ptw.os;
	     wired_bit = adp_ptw.wired;
	     end;

	else do;
	     valid_bit = l68_ptw.valid;
	     os_bit = l68_ptw.os;
	     wired_bit = l68_ptw.wired;
	     end;

	if ^wired_bit then do;			/* If not already wired, wire it */
	     if sys_info$system_type = ADP_SYSTEM then
		adp_ptw.wired = "1"b;
	     else l68_ptw.wired = "1"b;
	     sst$wired = sst$wired + 1;
	     end;

	if ^valid_bit then do;			/* Not now in core */
	     if os_bit then 			/* But should be arriving any minute now */
		wait_event = binary (rel (ptp), 18);
	     else call page$pread (astep, 0, wait_event); /* Otherwise, ask for it */

	     if wait_event > 0 then			/* Have an event, remember to wait for it */
		apte.wait_event = bit (bin (wait_event, 36), 36);

	     if wait_event > 262143 then;		/* Global event -- ignore it */
	     else do;				/* It will end up here, so notify */
		if sys_info$system_type = ADP_SYSTEM then
		     cmep = addr (sst$cmp -> cma (adp_core_ptw.frame));
		else cmep = addr (sst$cmp -> cma (l68_core_ptw.frame));
		cme.notify_requested = "1"b;
		end;

/* THIS IS COMMENTED OUT until there is room in tcm for the new metering cell -- WOS, 04/17/81
	     tcm$loading_page_waits = tcm$loading_page_waits + 1; /* Meter */
	     end;

	return;
	end load_this_page;

%page; %include apte;
%page; %include cmp;
%page; %include "ptw.l68";
%page; %include "ptw.adp";
%page; %include system_types;

     end wired_plm;




		    wired_shutdown.pl1              11/11/89  1130.2r w 11/11/89  0856.8       57195



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


wired_shutdown$wired_emergency: procedure;

/* Created by Bernard Greenberg, 03/29/76, when he removed
   wired_shutdown from wired_shutdown and unwired it. What is left
   is a pl1-coded transitional interface between
   ESD and shutdown */

/*  Modified 06/07/76 by Greenberg for vtoc_man$stabilize */
/*  Modified 03/14/77 by Greenberg for ESD with drive down */
/*  Modified 02/28/82 by J. Bongiovanni to eliminate use of FSDCT, reset PVT entries */
/*  Modified March 1982 by J. Bongiovanni to call shutdown_file_system */
/*  Modified August 1982 by J. Bongiovanni to reset scavenge */
/*  Modified 830620 for new ocdcm_$drain_io call... -E. A. Ranzenbach */
/*  Modified 8/83 for pmut$bce - K. Loepere */
/*  Modified  84-01-17 BIM for get_pvtx$reset. */

dcl  pc$flush entry;
dcl  page$reset_pvte entry (ptr);
dcl  pmut$bce entry;
dcl  ocdcm_$drain_io entry ();
dcl  syserr entry options (variable);
dcl  vtoc_man$stabilize entry;
dcl  get_pvtx$reset entry;
dcl  pmut$set_mask entry (fixed bin (71), fixed bin (71));
dcl  fsout_vol entry (fixed bin, fixed bin);
dcl  shutdown_file_system entry;
dcl  control char (8) static internal init ("tooearly");


dcl  scs$open_level fixed bin (71) ext;

dcl  pvt$shutdown_state fixed bin external,
     pvt$esd_state fixed bin external,
     pvt$n_entries fixed bin external,
     sst$root_pvtx fixed bin external;
			  

dcl  save_mask fixed bin (71);
dcl  condition_ entry (char (*), entry);
dcl  pvtx fixed bin;

/* This portion of emergency shutdown gets entered on the
   shutdown_stack after preliminary resetting has been
   accomplished.					 */

	call condition_ ("any_other", handler);
	call pmut$set_mask (scs$open_level, save_mask);	/* Open mask to allow I/O interrupts. */

	if control = "tooearly" | sst$root_pvtx = 0 then do;
	     call syserr (0, "esd before fs enabled");
shut:	     call syserr (0, "shutdown complete");
	     call ocdcm_$drain_io;					/* quies the console...		*/
	     do while ("1"b);
		call pmut$bce;
	     end;
	end;

	pvt_arrayp = addr (pvt$array);

	if ^pvt_array (sst$root_pvtx).used then do;
	     call syserr (0, "system already shut down");
	     go to shut;
	end;

	vtoc_buffer_segp = addr (vtoc_buffer_seg$);	/* Mark trouble pv, perhaps */
	if vtoc_buffer.unsafe_pvtx > 0 then do;
	     pvt_array (vtoc_buffer.unsafe_pvtx).vol_trouble_count = pvt_array (vtoc_buffer.unsafe_pvtx).vol_trouble_count + 1;
	     vtoc_buffer.unsafe_pvtx = 0;
	end;

	do pvtx = 1 to pvt$n_entries;
	     pvtep = addr (pvt_array (pvtx));
	     if pvte.used
		then do;
		pvte.scav_check_address = "0"b;
		pvte.scavenger_block_rel = ""b;
		call page$reset_pvte (pvtep);
	     end;
	end;

	call get_pvtx$reset; /* mark trouble for all held pvte's 
			    and release all held pvtes. */

	call syserr (0, "begin emergency shutdown part 1.");


	pvt$shutdown_state = 1;			/* Indicate that esd part 1 started */
	pvt$esd_state = 1;				/* System in ESD */
	call fsout_vol (sst$root_pvtx, 0);		/* Get this fact out */

	call pc$flush;				/* Flush out all pages in core. */
	pvt$shutdown_state = 2;			/* Indicate that emergency shutdown part 1 is successful. */
	pvt$esd_state = 2;
	call fsout_vol (sst$root_pvtx, 0);

	call syserr (0, "emergency shutdown part 1 complete.");

	call vtoc_man$stabilize;			/* Get VTOC buffers in shape */
	call shutdown_file_system;			/* Try to complete a normal shutdown now. */
	return;					/* Should never happen */

enable:	entry;
	control = "enabled";
	return;

handler:	proc (mcptr, condname, coptr, infoptr, cont);

dcl (mcptr, coptr, infoptr) ptr;
dcl  condname char (*);
dcl  cont bit (1);

	     call syserr (1, "wired_shutdown: ^a fault during emergency shutdown", condname);

	end handler;

	 %include pvte;
	 %include vtoc_buffer;



/* BEGIN MESSAGE DOCUMENTATION

   Message:
   esd before fs enabled

   S: $info

   T: Emergency shutdown

   M: The system crashed before the storage system was accessed by
   Multics. An ESD was attempted, but no ESD is necessary.
   The "shutdown complete" message will always follow.

   A: Reboot the system.

   Message:
   shutdown complete

   S: $info

   T: Emergency shutdown

   M: Emergency shutdown is complete; this message was
   preceded by either "esd before fs enabled" or
   "system already shut down":
   no ESD was necessary.

   A: Reboot the system.

   Message:
   system already shut down

   S: $info

   T: Emergency shutdown

   M: An attempt to perform emergency shutdown was made after
   a previous attempt, or normal shutdown, succeeded. No ESD
   is necessary in this case. The "shutdown complete" message
   follows.

   A: $ignore

   Message:
   begin emergency shutdown part 1

   S: $info

   T: Emergency shutdown

   M: The system emergency shutdown environment has been
   successfully established. An attempt will be made to write
   out all of memory and flush the paging device.

   A: $ignore

   Message:
   emergency shutdown part 1 complete

   S: $info

   T: Emergency shutdown

   M: All of memory has been written out once, and those
   pages on the paging device which could be written out to
   operative drives flushed. All segments and directories will
   now be deactivated, and all drives shut down.

   A: $ignore

   Message:
   wired_shutdown: FFF fault during emergency shutdown

   S: $crash

   T: Emergency shutdown

   M: An unexpected fault has occured during emergency
   shutdown.  Emergency shutdown
   cannot complete.

   A: Get a dump for system programmers. If an disk dump was taken
   of the preceding crash, get a dump to paper via the bce dump facility.
   Re-attempt ESD as many times as necessary.

   END MESSAGE DOCUMENTATION */


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