



		    mca_attach_.pl1                 04/26/87  1542.4rew 04/26/87  1530.0      210420



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


/****^  HISTORY COMMENTS:
  1) change(86-03-18,Fawcett), approve(86-03-18,MCR7374),
     audit(86-09-05,Lippard), install(86-09-16,MR12.0-1159):
     Created to control the MCA for online use. This is mainly used by online
     T&D.
  2) change(86-10-21,Fawcett), approve(86-10-21,PBF7374),
     audit(86-10-23,Farley), install(86-10-30,MR12.0-1203):
     Change entry mca_attach_$finish_detach to only set the mcad.state to
     MCA_FREE if the state is greater than MCA_FREE.
  3) change(87-03-31,Fawcett), approve(87-04-23,MCR7667),
     audit(87-04-23,Farley), install(87-04-26,MR12.1-1025):
     Changed to set the error code returned to 0 if the IPC attached is not
     in the Multics config deck.
                                                   END HISTORY COMMENTS */

/* format: style4 */
/* Created Nov 1984 by R. A. Fawcett */
/* Modified Oct 1985 by Paul Farley for multiple attachments per IPC and
   to check for the correct version in the mca_data_seg. */

mca_attach_:
     proc;
dcl  a_force bit (1);
dcl  a_name char (*);				/* name of the MCA to be attached */
dcl  a_ev_chn fixed bin (71);				/* event channel for the attachement */
dcl  a_ioi_idx fixed bin;				/* the ioi_index for this MCA */
dcl  a_code fixed bin (35);				/* is returned to indicate success */
dcl  a_ipc_id char (*);
dcl  a_ipc_operational bit (1);			/* used during ipc detachment */
dcl  a_ipc_num fixed bin;
dcl  a_mca_status bit (72) parm;
dcl  bc fixed bin (24);
dcl  channel_number fixed bin (17);
dcl  code fixed bin (35);
dcl  dev_name char (3);
dcl  dev_type char (32);
dcl  ev_chan fixed bin (71);

dcl  (dev_00_sw, fips_sw) bit (1);
dcl  (force_detach_entry, force_reset_entry) bit (1);
dcl  group_index fixed bin (17);
dcl  ioi_max_ws fixed bin (19);
dcl  ipc_id char (5) var;
dcl  ipc_index fixed bin;
dcl  ipc_num fixed bin (17);
dcl  ipc_operational bit (1);
dcl  loc_async bit (1);
dcl  loc_ev_chn fixed bin (71);
dcl  loc_ioi_idx fixed bin;
dcl  loc_rcp_id bit (36) aligned;
dcl  max_time fixed bin (71);
dcl  mca_index fixed bin (3);
dcl  multiple_prph_on_ipc bit (1);
dcl  name char (4);
dcl  need_to_del_evchn bit (1);
dcl  prph_index fixed bin;
dcl  rcp_msg char (132);
dcl  rcp_state fixed bin;
dcl  save_code fixed bin (35);
dcl  1 sk_dev_info like device_info;
dcl  1 sk_printer_info like printer_info;
dcl  status_from_reset bit (72);
dcl  user_level fixed bin;

dcl  p99 pic "99" based;

/* Entries */
dcl  admin_gate_$syserr entry options (variable);
dcl  config_$find entry (char (4) aligned, ptr);
dcl  convert_ipc_code_ entry (fixed bin (35));
dcl  cu_$level_get entry (fixed bin);
dcl  cu_$level_set entry (fixed bin);
dcl  cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35));
dcl  get_group_id_ entry () returns (char (32));
dcl  get_ring_ entry () returns (fixed bin (3));
dcl  get_process_id_ entry () returns (bit (36));
dcl  initiate_file_ entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35));
dcl  ioi_$set_channel_required
	entry (fixed bin, fixed bin (3), fixed bin (7), fixed bin (35));
dcl  ioi_$set_status entry (fixed bin, fixed bin, fixed bin, fixed bin (35));
dcl  ioi_$timeout entry (fixed bin, fixed bin (71), fixed bin (35));
dcl  ioi_$release_devices entry (fixed bin, fixed bin (35));
dcl  ioi_$suspend_devices entry (fixed bin, fixed bin (35));
dcl  ioi_$workspace entry (fixed bin, ptr, fixed bin (18), fixed bin (35));
dcl  ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35));
dcl  ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35));
dcl  mca_util_$reset entry (fixed bin, bit (72), fixed bin (35));
dcl  mca_util_$force_reset entry (fixed bin, bit (72), fixed bin (35));
dcl  mca_util_$mca_ptr entry (fixed bin, fixed bin (35)) returns (ptr);
dcl  mca_util_$force_mca_ptr entry (fixed bin, fixed bin (35)) returns (ptr);
dcl  rcp_$check_attach entry (bit (36) aligned, ptr, char (*), fixed bin, fixed bin (19), fixed bin (71),
	fixed bin, fixed bin (35));
dcl  rcp_$detach entry (bit (36) aligned, bit (*), fixed bin, char (*), fixed bin (35));
dcl  rcp_priv_$attach entry (char (*), ptr, fixed bin (71), char (*), bit (36) aligned, fixed bin (35));

/* Error codes */

dcl  error_table_$bad_channel fixed bin (35) ext static;
dcl  error_table_$io_not_configured fixed bin (35) ext static;
dcl  error_table_$name_not_found fixed bin (35) ext static;
dcl  error_table_$not_attached fixed bin (35) ext static;
dcl  error_table_$resource_not_free fixed bin (35) ext static;
dcl  error_table_$unimplemented_version fixed bin (35) ext static;

/* Constant */

dcl  FIFTEEN_SEC fixed bin (71) init (15000000) static options (constant);
dcl  MCA_CHAN fixed bin (7) init (3) static options (constant);
dcl  MCA_NAME (1:4) char (4) static options (constant)
	init ("mcaa", "mcab", "mcac", "mcad");
dcl  lower char (7) static options (constant)
	init ("abcdimp");
dcl  UPPER char (7) static options (constant)
	init ("ABCDIMP");

dcl  sys_info$page_size fixed bin (17) ext static;

dcl  (addr, clock, convert, fixed, hbound, lbound, null, rel, substr, translate, unspec) builtin;

dcl  cleanup condition;



%page;
mca_attach_$mca_attach:
     entry (a_name, a_ev_chn, a_ioi_idx, a_code);

/* This entry will attach a MCA. It is called via the mca_$attach_mca gate */

/* The MCA is attached via rcp_, it may be attached for sync_io or async_io
   depending on the value of a_ev_chn. After rcp_ has attached the MCA the
   configuration data stored in the MCA must be read into the mca_data_seg
   for this MCA. The sequence of events for sync_io and async_io must be done
   in the same order and attempt has been made to use the same procedures for
   both sync_io and async_io.

   1) check to see if MCA is CONFIGURED and FREE.

   2) attach via rcp

   3) setup mcad entry

   4) call mca_util_$reset,
   This step causes a reset status command,
   and then read config command to be issued.
   If the IO is async then the user must call via gates to invoke
   the process io routines.
   If sync IO then wait routine invokes the process io routines upon io
   completion.
   Most of the above actions are in mca_util.
*/

	force_reset_entry = "0"b;

	goto ATTACH_COMMON;

mca_attach_$force_reset_mca:
     entry (a_name, a_mca_status, a_code);

/* This entry will reset and mask a MCA. It is called via the
   mca_priv_$force_reset gate. */


	force_reset_entry = "1"b;

ATTACH_COMMON:

	code = 0;
	name = translate (a_name, lower, UPPER);
	if ^force_reset_entry then loc_ev_chn = a_ev_chn;
	else loc_ev_chn = 0;
	call cu_$level_get (user_level);
	need_to_del_evchn, force_detach_entry = "0"b;
	mcad_ptr = null ();

	on cleanup begin;
	     call clean_up_attach;
	     call set_back_level;
	end;

	call cu_$level_set (get_ring_ ());
	if mca_data_seg_ptr = null () then do;
	     call initiate_file_ (SYSTEM_DIR, DATA_SEG, "0"b,
		mca_data_seg_ptr, bc, code);
	     if mca_data_seg_ptr = null () then

/*           Trouble in River City            */

		goto ATTACH_ENDS;
	end;

	if mca_data_seg.version ^= MCA_data_version_1 then do; /* Bad News */
	     code = error_table_$unimplemented_version;
	     goto ATTACH_ENDS;
	end;

	do mca_index = lbound (MCA_NAME, 1) to hbound (MCA_NAME, 1) while (name ^= MCA_NAME (mca_index));
	end;
	if mca_index > hbound (MCA_NAME, 1) then do;
	     code = error_table_$name_not_found;
	     goto ATTACH_ENDS;
	end;

	mcad_ptr = addr (mca_data_seg.array (mca_index));

	if mcad.state ^= MCA_FREE then do;
	     if mcad.state = MCA_NOT_CONFIGURED then
		code = error_table_$io_not_configured;
	     else code = error_table_$resource_not_free;
	     goto ATTACH_ENDS;
	end;


	device_info_ptr = addr (sk_dev_info);
	device_info.version_num = DEVICE_INFO_VERSION_1;
	device_info.wait_time = 0;
	device_info.system_flag = "1"b;
	device_info.device_name = MCA_NAME (mca_index);
	device_info.model = 0;
	device_info.qualifiers (*) = 0;
	dev_type = DEVICE_TYPE (MCA_DTYPEX);

/* check to see if the user wants async_io, or no event channel passed. */
	if loc_ev_chn = 0 | loc_ev_chn = 1 then do;
	     loc_async = "0"b;

/* if not async_io then set up a ring1_ event channel */
	     call ipc_$create_ev_chn (ev_chan, code);
	     if code ^= 0 then do;
		call convert_ipc_code_ (code);
		goto ATTACH_ENDS;
	     end;
	     need_to_del_evchn = "1"b;
	end;
	else do;
	     loc_async = "1"b;
	     ev_chan = loc_ev_chn;
	end;

/* try to attach the MCA */

	loc_rcp_id = "0"b;
	call rcp_priv_$attach (dev_type, device_info_ptr, ev_chan, "",
	     loc_rcp_id, code);

	if code ^= 0 then goto ATTACH_ENDS;

	mcad.event_chn = ev_chan;
	mcad.async_io = loc_async;
	mcad.rcp_id = loc_rcp_id;

	call rcp_$check_attach (mcad.rcp_id, device_info_ptr, rcp_msg,
	     loc_ioi_idx, ioi_max_ws, max_time, rcp_state, code);
	if rcp_state ^= 0 then do;
	     if code = 0 then code = rcp_state;
	     goto ATTACH_ENDS;
	end;

/* Not really attached until reset & read config I/O is completed */

	mcad.state = MCA_ATTACHING;
	mcad.config_data_requested = "0"b;
	mcad.attach_time = clock ();
	mcad.attach_pid = get_process_id_ ();
	mcad.last_status = ""b;
	mcad.current_ws_size = 0;
	mcad.ioi_idx = loc_ioi_idx;
	mcad.max_time_out = max_time;
	mcad.max_ws_size = ioi_max_ws;

	call ioi_$set_channel_required
	     (mcad.ioi_idx, mca_index, MCA_CHAN, code);
	if code ^= 0 then goto ATTACH_ENDS;

	mcad.current_ws_size = sys_info$page_size;
	call ioi_$workspace (mcad.ioi_idx, mcad.ioi_wks_ptr,
	     (mcad.current_ws_size), code);
	if code ^= 0 then goto ATTACH_ENDS;

	mca_work_space_ptr = mcad.ioi_wks_ptr;

	mcad.status_offset = fixed (rel (addr (mca_work_space.status_area)), 17);
	call ioi_$set_status (mcad.ioi_idx, mcad.status_offset, 1, code);
	if code ^= 0 then goto ATTACH_ENDS;

	call ioi_$timeout (mcad.ioi_idx, FIFTEEN_SEC, code);
	if code ^= 0 then goto ATTACH_ENDS;
	if force_reset_entry then do;
	     call mca_util_$force_reset (mcad.ioi_idx, status_from_reset, code);
	     a_mca_status = status_from_reset;
	end;
	else do;
	     call mca_util_$reset (mcad.ioi_idx, status_from_reset, code);
	     if code ^= 0 then goto ATTACH_ENDS;
	     else a_ioi_idx = mcad.ioi_idx;
	end;

	goto MAIN_EXIT;

ATTACH_ENDS:
	call clean_up_attach;
	goto MAIN_EXIT;

/* end mca_attach */

mca_attach_$mca_detach:
     entry (a_ioi_idx, a_code);

/* This entry will detach the MCA. It will first check to see if any of
   the IPCs are attached if so it will detach them. This is called via
   the mca_$detach_mca gate. */

	loc_ioi_idx = a_ioi_idx;
	code = 0;
	force_detach_entry = "0"b;
	call cu_$level_get (user_level);

	on cleanup begin;
	     call set_back_level;
	end;

	call cu_$level_set (get_ring_ ());
	mcad_ptr = mca_util_$mca_ptr (loc_ioi_idx, code);
	if code ^= 0 then do;
	     if code ^= error_table_$not_attached then goto MAIN_EXIT;
	     if mcad_ptr = null () then goto MAIN_EXIT;
	     if mcad.state <= MCA_FREE then goto MAIN_EXIT;
	end;

	if mcad.state = MCA_FREE then do;
	     code = error_table_$not_attached;
	     goto MAIN_EXIT;
	end;

	call rcp_$detach (mcad.rcp_id, "0"b, 0, "", code);/* RCP will call mca_attach_$finish_detach */
	if code ^= 0 then goto MAIN_EXIT;
	goto MAIN_EXIT;

/* end mca_detach */

mca_attach_$ipc_attach:
     entry (a_ipc_id, a_ioi_idx, a_ipc_num, a_code);


/* This entry will attach an IPC. The MCA must be attached to the process.
   This is called via mca_$attach_mca gate. */

	loc_ioi_idx = a_ioi_idx;
	ipc_id = translate (a_ipc_id, lower, UPPER);
	call cu_$level_get (user_level);
	on cleanup begin;
	     call set_back_level;
	end;
	call cu_$level_set (get_ring_ ());
	call set_up_ipc;
	if code ^= 0 then goto MAIN_EXIT;
	force_detach_entry = "0"b;
	ipc_operational = "1"b;			/* in case we have to detach */
	ipcd.ipc_name = "ipc" || convert (p99, ipc_num);
	ipcd.prph_attachments = 0;
	unspec (ipcd.attach_data) = ""b;
	multiple_prph_on_ipc = "1"b;
	do prph_index = 1 to ipcd.nchan while (multiple_prph_on_ipc);
	     channel_number = ipcd.channel + prph_index - 1;
	     ipcd.attach_data (prph_index).attached_thru_rcp = "0"b;
	     ipcd.attach_data (prph_index).io_suspended = "0"b;
	     ipcd.attach_data (prph_index).prph_name = "";
	     call dev_info;
	     if code ^= 0 then do;

/* if the ipc channel is not known to Multics then it is OK to let the user
   think it is attached  */

		if code = error_table_$io_not_configured then do;
		     code = 0;
		     goto not_known_ok;
		end;
		goto ERROR_DT_IPC;
	     end;
	     call rcp_priv_$attach (dev_type, device_info_ptr, mcad.event_chn,
		"", ipcd.attach_data (prph_index).ipc_rcp_id, code);
	     if code ^= 0 then goto ERROR_DT_IPC;
	     ipcd.attach_data (prph_index).attached_thru_rcp = "1"b;
	     call rcp_$check_attach (ipcd.attach_data (prph_index).ipc_rcp_id, device_info_ptr, rcp_msg,
		ipcd.attach_data (prph_index).ipc_ioi_idx, ioi_max_ws, max_time, rcp_state, code);
	     if rcp_state ^= 0 then do;
		if code = 0 then code = rcp_state;
		goto ERROR_DT_IPC;
	     end;
	     call ioi_$set_channel_required
		(ipcd.attach_data (prph_index).ipc_ioi_idx, (mcad.imu_number), (channel_number), code);
	     if code ^= 0 then goto ERROR_DT_IPC;

	     if dev_type = "special" & dev_name ^= "fnp" then do;
		call ioi_$suspend_devices (ipcd.attach_data (prph_index).ipc_ioi_idx, code);
		if code ^= 0 then do;

ERROR_DT_IPC:
		     save_code = code;
		     call detach_this_ipc;
		     code = save_code;
		     goto MAIN_EXIT;
		end;
		ipcd.attach_data (prph_index).io_suspended = "1"b;
		call admin_gate_$syserr (LOG, "MCA: IO suspended on ^a (^a in IMU-^a) for ^a.",
		     ipcd.attach_data (prph_index).prph_name, ipcd.ipc_name,
		     translate (mcad.name, UPPER, lower), get_group_id_ ());
	     end;

not_known_ok:

	     ipcd.attach_data (prph_index).attach_time = clock ();
	     ipcd.prph_attachments = prph_index;
	end;
	ipcd.state = IPC_ATTACHED;
	a_ipc_num = ipc_num;
	goto MAIN_EXIT;

/* end ipc_attach */
%skip (4);
mca_attach_$ipc_detach:
     entry (a_ipc_id, a_ioi_idx, a_ipc_operational, a_code);

/* called via the mca_$detach_ipc gate to detach an ipc */
	force_detach_entry = "0"b;
	loc_ioi_idx = a_ioi_idx;
	ipc_id = translate (a_ipc_id, lower, UPPER);
	call cu_$level_get (user_level);
	on cleanup begin;
	     call set_back_level;
	end;
	call cu_$level_set (get_ring_ ());
	call set_up_ipc;
	if code ^= 0 then goto MAIN_EXIT;
	ipc_operational = a_ipc_operational;
	call detach_this_ipc;
	goto MAIN_EXIT;

/* end ipc_detach */



MAIN_EXIT:

/* Things seem ok */

	a_code = code;
	call cu_$level_set (user_level);
	return;
%skip (6);
mca_attach_$finish_detach:
     entry (a_ioi_idx, a_force, a_code);

/* This entry is called by rcp_detach_ to clear out the mca_data_seg, and
   is not a ring_1 gate target it is only callable in ring_1 */

	loc_ioi_idx = a_ioi_idx;
	force_detach_entry = a_force;
	ipc_operational = "1"b;			/* force the flag */
	mcad_ptr = mca_util_$force_mca_ptr (loc_ioi_idx, code);
	if mcad_ptr = null () then do;
	     a_code = code;
	     return;
	end;

/* Are there any IPC'S attached ?? */

check_ipc_attached:
	do ipc_index = lbound (mcad.ipcd_array, 1) to hbound (mcad.ipcd_array, 1);
	     ipcd_ptr = addr (mcad.ipcd_array (ipc_index));
	     if ipcd.state >= IPC_ATTACHED then do;

/* OK detach this IPC */
		call detach_this_ipc;
		if code ^= 0 & ^force_detach_entry then goto MAIN_EXIT;
	     end;
	end;
	if ^mcad.async_io then
						/* delete the ring_1 event channel */
	     call ipc_$delete_ev_chn (mcad.event_chn, code);
	unspec (mcad.flags) = "0"b;
	mcad.rcp_id = "0"b;
	if mcad.state > MCA_FREE then mcad.state = MCA_FREE;
	mcad.attach_pid = "0"b;
	if force_detach_entry then mcad.lock = "0"b;
	code = 0;
	return;
%page;
clean_up_attach:
     proc;
	save_code = code;
	if mca_data_seg_ptr = null () then return;	/* Never got started */
	if mcad_ptr = null () then return;		/* Never got MCA attached */
	if need_to_del_evchn then call ipc_$delete_ev_chn (ev_chan, code);
	if loc_rcp_id ^= "0"b then do;
	     mcad.state = MCA_FREE;
	     call rcp_$detach (loc_rcp_id, "0"b, 0, "", code);
						/* RCP will call mca_attach_$finish_detach */
	end;
	code = save_code;
     end clean_up_attach;
%page;
set_back_level:
     proc;
	call cu_$level_set (user_level);
     end set_back_level;

detach_this_ipc:
     proc;

/* This proc will detach the IPC as per the ipcd_ptr */

	do prph_index = hbound (ipcd.attach_data, 1) to lbound (ipcd.attach_data, 1) by -1;
	     if ipcd.attach_data (prph_index).attached_thru_rcp then do;
		if ipcd.attach_data (prph_index).io_suspended then do;
		     if ipc_operational then do;
			call ioi_$release_devices (ipcd.attach_data (prph_index).ipc_ioi_idx, code);
			if code ^= 0 then
			     call admin_gate_$syserr (ANNOUNCE, "MCA: IO not released on ^a (^a in IMU-^a), ^a.",
				ipcd.attach_data (prph_index).prph_name, ipcd.ipc_name,
				translate (mcad.name, UPPER, lower), get_group_id_ ());
			else do;
			     ipcd.attach_data (prph_index).io_suspended = "0"b;
			     call admin_gate_$syserr (LOG, "MCA: IO released on ^a (^a in IMU-^a), ^a.",
				ipcd.attach_data (prph_index).prph_name, ipcd.ipc_name,
				translate (mcad.name, UPPER, lower), get_group_id_ ());
			end;
		     end;
		     else call admin_gate_$syserr (LOG, "MCA: IO not released on ^a (^a in IMU-^a), ^a.",
			     ipcd.attach_data (prph_index).prph_name, ipcd.ipc_name,
			     translate (mcad.name, UPPER, lower), get_group_id_ ());
		end;
		call rcp_$detach (ipcd.attach_data (prph_index).ipc_rcp_id, "0"b, 0, "", code);
		ipcd.attach_data (prph_index).attached_thru_rcp = "0"b;
		ipcd.attach_data (prph_index).ipc_ioi_idx = 0;
	     end;
	end;
	ipcd.prph_attachments = 0;
	ipcd.state = IPC_FREE;
     end detach_this_ipc;
%page;
dev_info:
     proc;

/* This entry will build the dev info structure for the PRPH */

	dev_00_sw, fips_sw = "0"b;
	if ipcd.type_index = PSIA_2_TRIP |
	     ipcd.type_index = PSIA_4_TRIP then do;
	     dev_00_sw = "1"b;
	end;
	else if ipcd.type_index = IPC_TAPE_FIPS |
	     ipcd.type_index = IPC_DISK_FIPS then do;
	     fips_sw = "1"b;
	end;
	chnl_cardp, prph_cardp = null ();
	call config_$find (PRPH_CARD_WORD, prph_cardp);
	do while (prph_cardp ^= null ());
	     if prph_card.iom = mcad.imu_number then do;
		if prph_card.chan = channel_number then do;
		     dev_name = substr (prph_card.name, 1, 3);
		     ipcd.attach_data (prph_index).prph_name = prph_card.name;
		     goto found_dev;
		end;
	     end;
	     call config_$find (PRPH_CARD_WORD, prph_cardp);
	end;
	call config_$find (CHNL_CARD_WORD, chnl_cardp);
	do while (chnl_cardp ^= null ());
	     do group_index = lbound (chnl_card.group, 1) to hbound (chnl_card.group, 1) while
		(chnl_card.group (group_index).iom ^= -1);
		if chnl_card.group (group_index).iom = mcad.imu_number then do;
		     if chnl_card.group (group_index).chan = channel_number then do;
			dev_name = substr (chnl_card.name, 1, 3);
			ipcd.attach_data (prph_index).prph_name = chnl_card.name;
			prph_cardp = chnl_cardp;
			goto found_dev;
		     end;
		end;
	     end;
	     call config_$find (CHNL_CARD_WORD, chnl_cardp);
	end;
	dev_name = "";
	code = error_table_$io_not_configured;
	return;
found_dev:
	if dev_name = "prt" then do;
	     dev_type = "printer";
	     printer_info_ptr = addr (sk_printer_info);
	     printer_info.version_num = PRINTER_INFO_VERSION_1;
	     printer_info.wait_time = 0;
	     printer_info.system_flag = "1"b;
	     printer_info.device_name = prph_card.name;
	     printer_info.print_train = 0;
	     printer_info.line_length = -1;
	     printer_info.model = 0;
	     device_info_ptr = printer_info_ptr;
	     multiple_prph_on_ipc = "1"b;
	     return;
	end;
	multiple_prph_on_ipc = "0"b;			/* normally only one device per IPC */
	device_info_ptr = addr (sk_dev_info);
	device_info.version_num = DEVICE_INFO_VERSION_1;
	device_info.wait_time = 0;
	device_info.system_flag = "1"b;
	device_info.model = 0;
	device_info.qualifiers (*) = 0;
	if dev_name = "rdr" then do;
	     dev_type = "reader";
	     device_info.device_name = prph_card.name;
	     multiple_prph_on_ipc = "1"b;
	end;
	else if dev_name = "pun" then do;
	     dev_type = "punch";
	     device_info.device_name = prph_card.name;
	     multiple_prph_on_ipc = "1"b;
	end;
	else if dev_name = "opc" then do;
	     dev_type = "console";
	     device_info.device_name = prph_card.name;
	end;
	else do;
	     dev_type = "special";
	     if dev_00_sw then
		device_info.device_name = prph_card.name || "_00";
	     else device_info.device_name = prph_card.name;
	end;
     end dev_info;
%page;
set_up_ipc:
     proc;
dcl  chan_number fixed bin;

	code = 0;
	mcad_ptr = mca_util_$mca_ptr (loc_ioi_idx, code);
	if code ^= 0 then goto MAIN_EXIT;
	if mcad.state < MCA_ATTACHED then do;
	     code = error_table_$not_attached;
	     return;
	end;

	if substr (ipc_id, 1, 3) = "ipc" then do;
	     ipc_num = cv_dec_check_ (substr (ipc_id, 4), code);
	     if code ^= 0 then do;
		code = error_table_$bad_channel;
		return;
	     end;
	     if ipc_num < lbound (mcad.ipcd_array, 1) | ipc_num > hbound (mcad.ipcd_array, 1) then do;
		code = error_table_$bad_channel;
		return;
	     end;
	     ipcd_ptr = addr (mcad.ipcd_array (ipc_num));
	     goto ipc_found;
	end;
	else do;
	     if substr (ipc_id, 1, 1) ^= mcad.name then do;
		code = error_table_$bad_channel;
		return;
	     end;
	     chan_number = cv_dec_check_ (substr (ipc_id, 2, 2), code);
	     if code ^= 0 then do;
		code = error_table_$bad_channel;
		return;
	     end;
	     do ipc_index = lbound (mcad.ipcd_array, 1) to hbound (mcad.ipcd_array, 1);
		ipcd_ptr = addr (mcad.ipcd_array (ipc_index));
		if ipcd.state > IPC_NOT_CONFIGURED then do;
		     if (ipcd.channel <= chan_number) &
			(chan_number < (ipcd.channel + ipcd.nchan)) then do;
			ipc_num = ipc_index;
			goto ipc_found;
		     end;
		end;
	     end;
	     code = error_table_$io_not_configured;
	     return;
	end;
ipc_found:
	return;
     end set_up_ipc;

%page;
%include config_chnl_card;
%page;
%include config_prph_card;
%page;
%include mca_constants;
%page;
%include mca_data;
%page;
%include mca_data_area;
%page;
%include rcp_device_info;
%page;
%include rcp_printer_info;
%page;
%include rcp_resource_types;
%page;
%include syserr_constants;
%page;
/* BEGIN MESSAGE DOCUMENTATION

   Message:
   MCA: IO suspended on DEVICE (ipcNN in IMU-X) for PERSON.PROJ.T.

   S:	$log

   T:	$run

   M:	This message is stating that the normal flow of I/O for
   this device is being suspended. This allows the user to stop
   or alter/reload an IPC without affecting the system.

   A:	$ignore

   Message:
   MCA: IO released on DEVICE (ipcNN in IMU-X), PERSON.PROJ.T.

   S:	$log

   T:	$run

   M:	This message is stating that the normal flow of I/O for
   this device is being resumed.

   A:	$ignore

   Message:
   MCA: IO not released on DEVICE (ipcNN in IMU-X), PERSON.PROJ.T.

   S:	$warn

   T:	$run

   M:	The user is detaching the IPC, but does not want the IO to be
   resumed.

   A:	This is normally because the IPC is defective or no longer capable
   of handling normal I/O.

   END MESSAGE DOCUMENTATION */

     end mca_attach_;




		    mca_parse_.rd                   10/30/86  1146.1rew 10/30/86  1142.0       84096



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

/* HISTORY COMMENTS:
  1) change(86-01-14,Fawcett), approve(86-03-19,MCR7374),
     audit(86-05-05,Lippard), install(86-09-16,MR12.0-1159):
     Created to check the MCA command set to the MCA via the tandd gates.
  2) change(86-10-21,Fawcett), approve(86-10-21,PBF7374),
     audit(86-10-23,Farley), install(86-10-30,MR12.0-1203):
     Change the decimal-number reduction to decimal-integer.
                                                   END HISTORY COMMENTS */

/* format: style4 */
/* Created Nov 1984 by R. A. Fawcett */
mca_parse_:
	proc (a_data_ptr,a_data_len,a_mcad_ptr,a_user_level,a_code);
/*++
BEGIN 
main           

\"   Fist word MUST be load, reset, rload, trace, or test;
		/ load		/  LEX (1)				/ load_rest_tar \
		/ reset		/  LEX (1)				/ load_rest_tar \
		/ rload		/  LEX (1)				/ load_rest_tar \
		/ test		/  LEX (1)				/ target_verb   \
		/ read		/  LEX (1)				/ read_verb     \
		/ <no-token>	/ [a_code = error_table_$noarg]		/ RETURN \
		/ <any-token>	/ [a_code = error_table_$bad_arg]		/ AUDIT_RET \

\" Reset targets;

load_rest_tar	/ ipc		/ LEX (1)					/ ft_ipc      \
		/ ipcs		/				/ all_ipcs    \
		/ mca		/ LEX (1)					/ do_mca	    \
		/ <no-token>        / [a_code = error_table_$noarg]		/ RETURN \
		/ <any-token>	/ [a_code = error_table_$bad_arg]		/ AUDIT_RET \

ft_ipc		/ <ipc_num_att>	/ LEX (1)					/ next_ipc \
		/ <decimal-integer>	  / [a_code = error_table_$io_not_assigned]	/ AUDIT_RET \
		/ <any-token>	  / [a_code = error_table_$bad_arg]		/ AUDIT_RET \
		/ <no-token>	  / [a_code = error_table_$noarg]		/ RETURN \
next_ipc		/ <no-token>	  /					/ exit        \
		/ <ipc_num_att>	  / LEX (1)				/ next_ipc    \
		/ <decimal-integer>	    / [a_code = error_table_$io_not_assigned]	/ AUDIT_RET \
		/ <any-token>	    / [a_code = error_table_$bad_arg]		/ AUDIT_RET \
all_ipcs		/ <all_ipc_att>	    / LEX (1)				/ exit  \
		/		 / [a_code = error_table_$bad_arg]		/ AUDIT_RET \
do_mca		/		 / [a_code = error_table_$bad_arg]		/ AUDIT_RET \

read_verb		/ config		 / LEX (1)				/ exit \
		/ <any-token>	   / [a_code = error_table_$bad_arg]		/ AUDIT_RET \
		/ <no-token>	   / [a_code = error_table_$noarg]		/ RETURN \

target_verb	/ ipc		   / LEX (1)				/ ck_ipc_att \
		/ <any-token>	   / [a_code = error_table_$bad_arg]		/ AUDIT_RET \
		/ <no-token>	   / [a_code = error_table_$noarg]		/ RETURN \

ck_ipc_att	/ <ipc_num_att>	   / LEX (1)				/ ck_via \
		/ <decimal-integer>	   / [a_code = error_table_$io_not_assigned]	/ AUDIT_RET \
		/ <any-token>	   / [a_code = error_table_$bad_arg]		/ AUDIT_RET \
		/ <no-token>	   / [a_code = error_table_$noarg]		/ RETURN \

ck_via		/ via		   / LEX (1)				/ ck_imu \
		/ <any-token>	   / [a_code = error_table_$bad_arg]		/ AUDIT_RET \
		/ <no-token>	   / [a_code = error_table_$noarg]		/ RETURN \

ck_imu		/ imu		   / LEX (1)				/ ck_imu_num \
		/ <any-token>	   / [a_code = error_table_$bad_arg]		/ AUDIT_RET \
		/ <no-token>	   / [a_code = error_table_$noarg]		/ RETURN \

ck_imu_num	/ <valid_imu>	   / LEX(1)				/ ck_using \
		/ <any-token>	   / [a_code = code]			/ AUDIT_RET \
		/ <no-token>	   / [a_code = error_table_$noarg]		/ RETURN \

ck_using		/ using		   / LEX (1)				/ ck_technique \
		/ <any-token>	   / [a_code = error_table_$bad_arg]		/ AUDIT_RET \
		/ <no-token>	   / [a_code = error_table_$noarg]		/ RETURN \

\" Parse the <technique>
ck_technique 	/ diag		   / LEX (1)				/ ck_options  \
		/ disp		   / LEX (1)				/ ck_options  \
		/ qry		   / LEX (1)				/ ck_options  \
		/ dpm		   / LEX (1)				/ ck_options  \
		/ mdr		   / LEX (1)				/ ck_options  \
		/ nft		   / LEX (1)				/ ck_options  \
		/ self		   / LEX (1)				/ ck_options  \
		/ <any-token>	   / [a_code = error_table_$bad_arg]		/ AUDIT_RET \
		/ <no-token>	   / [a_code = error_table_$noarg]		/ RETURN \

ck_options	/ <no-token>	   / [a_code = 0]				/ RETURN \
		/ options		   / LEX (1)				/ exit \
		/ <any-token>	   / [a_code = error_table_$bad_arg]		/ AUDIT_RET \

exit		/ <no-token>	   / [a_code = 0]				/ RETURN \
		/ <any-token>	   / [a_code = error_table_$too_many_args]	/ AUDIT_RET \
AUDIT_RET		/		 / audit_err				/ RETURN \
++*/

/* Externial Entries */

dcl  access_audit_r1_$log_general	entry options (variable);
dcl  cv_dec_check_ 	entry (char(*), fixed bin(35)) returns(fixed bin(35));
dcl  get_process_id_ entry() returns(bit(36));
dcl  lex_string_$init_lex_delims entry (char (*), char (*), char (*), char (*), char (*), bit (*),
		     char (*) var, char (*) var, char (*) var, char (*) var);
dcl  lex_string_$lex entry (ptr, fixed bin, fixed bin, ptr, bit(*), char(*),
                        char(*), char(*), char(*), char(*), char(*) var, char(*) var,
		    char(*) var, char(*) var, ptr, ptr, fixed bin(35));
dcl translator_temp_$get_segment entry (char(*) aligned, ptr, fixed bin(35));
dcl translator_temp_$release_all_segments entry (ptr, fixed bin (35));

dcl cleanup condition;

/* Error_table */

dcl error_table_$bad_arg fixed bin(35) ext static;
dcl error_table_$too_many_args fixed bin(35) ext static;
dcl error_table_$noarg fixed bin(35) ext static;
dcl error_table_$not_attached fixed bin(35) ext static;
dcl error_table_$io_not_assigned fixed bin(35) ext static;
dcl error_table_$io_no_path fixed bin(35) ext static;

/* Ext static var */

dcl  access_operations_$invalid_mca bit (36) aligned ext static;

/* Automatic */

dcl (APstmt, APtoken) ptr;
dcl (LEXDLM,LEXCTL) char (32) var aligned;
dcl a_code fixed bin (35);
dcl a_data_ptr ptr;
dcl a_data_len fixed bin;
dcl a_mcad_ptr ptr;
dcl a_user_level fixed bin;
dcl audit_eventflags bit (36);
dcl areap ptr;
dcl code fixed bin (35);
dcl  data char (data_len) based (data_ptr);
dcl  command char (data_len) based (command_ptr);
dcl command_ptr ptr;
dcl data_ptr ptr;
dcl data_len fixed bin;
dcl imu_path_num fixed bin;
dcl ipc_att_num fixed bin init (0);
dcl my_pid bit (36);
dcl user_level fixed bin;

/* Builtins */

dcl (addr, hbound, lbound, null, translate) builtin;

/* Constants */
dcl  lower char (26) static options (constant)
	init ("abcdefghijklmnopqrstuvwxyz");
dcl  UPPER char (26) static options (constant)
	init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ");
dcl TRUE bit (1) init ("1"b) static options (constant);
dcl FALSE bit (1) init ("0"b) static options (constant);
dcl myname char (10) aligned init ("mca_parse_") static options (constant);
%page;

	my_pid = get_process_id_ ();
	mcad_ptr = a_mcad_ptr;
	if my_pid ^= mcad.attach_pid then do;
	   a_code = error_table_$not_attached;
	   return;
	   end;
	data_ptr = a_data_ptr;
	data_len = a_data_len;
          user_level = a_user_level;
	areap = null ();
	command_ptr = null ();

	on cleanup begin;
	    if areap ^= null () then call translator_temp_$release_all_segments (areap, (0));
	end;

	call translator_temp_$get_segment (myname, areap, code);
	if areap = null () then do;
	   a_code = code;
	   return;
	   end;



	command_ptr = allocate (areap,data_len);          

          command = translate (data,lower,UPPER);

	call lex_string_$init_lex_delims
	   ("", "", "", "","", "11"b," ", " ", LEXDLM, LEXCTL);

	call lex_string_$lex (command_ptr, data_len, 0, areap, "0110"b,
	   "", "", "", "","", " ", " ",
	   LEXDLM, LEXCTL, APstmt, APtoken, code);

	if code ^= 0 then do;
	   a_code = code;
	   return;
	   end;
	Pstmt = APstmt;
	Pthis_token = APtoken;

	a_code = 0;
	call SEMANTIC_ANALYSIS ();

error_ret:
          if areap ^= null () then call translator_temp_$release_all_segments (areap, (0));

          return;
%page;

all_ipc_att:
	proc () returns (bit (1));
dcl ret_bit bit (1);
	ret_bit = "1"b;
	do ipc_att_num = lbound(mcad.ipcd_array,1) to hbound(mcad.ipcd_array,1) while (ret_bit = "1"b);
	   if mcad.ipcd_array(ipc_att_num).level_1_state >
	      PH_NOT_PRESENT then ret_bit = ipc_is_att ();
	   end;
	return (ret_bit);
	end all_ipc_att;

ipc_num_att:
          proc () returns (bit (1));
          ipc_att_num = cv_dec_check_ (token_value,code);
	if code ^= 0 then return (FALSE);
          token.Nvalue = ipc_att_num;
	return (ipc_is_att());
end ipc_num_att;	      

ipc_is_att:
	proc () returns (bit (1));
          if mcad.ipcd_array (ipc_att_num).state >= IPC_ATTACHED
             then return (TRUE);
	else
	   return (FALSE);
	end ipc_is_att;
 

valid_imu:
       proc () returns (bit (1));
       imu_path_num =  cv_dec_check_ (token_value,code) + 1;
       if code ^= 0 then do;
	 code = error_table_$bad_arg;
	 return (FALSE);
       end;
       else do;
	if imu_path_num ^= mcad.imu_number then do;
	   a_code = error_table_$io_no_path;
	   return (FALSE);
	   end;
	return (TRUE);
	end;
       end valid_imu;



audit_err: proc;

	audit_eventflags = "0"b;
	addr (audit_eventflags) -> audit_event_flags.special_op = "1"b;
	addr (audit_eventflags) -> audit_event_flags.grant = "0"b;
	call access_audit_r1_$log_general (myname,user_level,
	     audit_eventflags,access_operations_$invalid_mca,"",a_code,
               null (),0,"^a", data);
end audit_err;
%page;
%include translator_temp_alloc;
%page;
%include access_audit_eventflags;
%page;
%include mca_data;
%page;
%include mca_constants;




		    mca_tandd_.pl1                  09/16/86  1108.1rew 09/16/86  1107.4      117567



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

/****^  HISTORY COMMENTS:
  1) change(86-03-18,Fawcett), approve(86-03-18,MCR7374),
     audit(86-09-05,Lippard), install(86-09-16,MR12.0-1159):
     Created to control the MCA for online use. This is mainly used by online
     T&D.
                                                   END HISTORY COMMENTS */

/* format: style4 */
/* Created Nov 1984 by R. A. Fawcett */
mca_tandd_:
     proc;
	return;


dcl  a_code fixed bin (35);
dcl  a_ioi_idx fixed bin (17);
dcl  a_mca_status bit (36);
dcl  a_mcad_ptr ptr;
dcl  a_ret_len fixed bin (21);
dcl  a_user_ptr ptr;
dcl  a_user_words fixed bin (17);

dcl  basic_size fixed bin (17);
dcl  code fixed bin (35);
dcl  1 event_info_area like event_wait_info;
dcl  ev_info_ptr ptr;
dcl  idcw1_cmd bit (6);
dcl  ioi_ws_size fixed bin (18);
dcl  offset_of_data_2 fixed bin;
dcl  ret_len fixed bin (21);
dcl  ret_data char (ret_len) based;
dcl  1 sk_mca_area like mca_area;
dcl  sk_ioi_idx fixed bin;
dcl  tally_num fixed bin (17);
dcl  temp_bits bit (16);
dcl  user_iop ptr;
dcl  user_size fixed bin;
dcl  user_level fixed bin;

dcl  CHARS_PER_WORD fixed bin init (4) static options (constant);
dcl  CONT_NO_MARKER bit (2) init ("10"b) static options (constant);
dcl  DATA_TYPE bit (6) init ("15"b3) static options (constant);
dcl  ENABLE_CONT_CMD bit (6) init ("40"b3) static options (constant);
dcl  IDCW_ID bit (3) init ("7"b3) static options (constant);
dcl  IOTD bit (2) init ("00"b) static options (constant);
dcl  MAX_DATA_SIZE fixed bin (17) init (16384) static options (constant);
dcl  MAX_TALLY fixed bin (17) init (4096) static options (constant);
dcl  READ_TYPE bit (6) init ("03"b3) static options (constant);
dcl  TEXT_TYPE bit (6) init ("13"b3) static options (constant);


dcl  cu_$level_get entry (fixed bin);
dcl  cu_$level_set entry (fixed bin);
dcl  get_ring_ entry () returns (fixed bin (3));
dcl  convert_ipc_code_ entry options (variable);
dcl  ioi_$workspace entry (fixed bin, ptr, fixed bin (18), fixed bin (35));
dcl  ipc_$block entry (ptr, ptr, fixed bin (35));
dcl  mca_parse_ entry (ptr, fixed bin (21), ptr, fixed bin, fixed bin (35));
dcl  mca_util_$connect entry (ptr, fixed bin (35));
dcl  mca_util_$io_event_mca entry (ptr, ptr, ptr, fixed bin (35));
dcl  mca_util_$mca_ptr entry (fixed bin, fixed bin (35)) returns (ptr);

dcl  (addr, bin, divide, fixed, length, low, min, mod, rel, size, substr, unspec) builtin;

dcl  cleanup condition;

dcl  error_table_$area_too_small fixed bin (35) ext static;
dcl  sys_info$page_size fixed bin ext static;
%page;
mca_tandd_$read_data:
     entry (a_ioi_idx, a_user_ptr, a_user_words, a_mca_status, a_code);

/* This entry is to read the remaining data from the MCA if any */

	idcw1_cmd = READ_TYPE;
	goto TANDD_COMMON;

%skip (4);
mca_tandd_$write_data:
     entry (a_ioi_idx, a_user_ptr, a_user_words, a_mca_status, a_code);

/* This entry is used for the HOST MCA dialog */

	idcw1_cmd = DATA_TYPE;
	goto TANDD_COMMON;
%skip (4);
mca_tandd_$write_text:
     entry (a_ioi_idx, a_user_ptr, a_user_words, a_mca_status, a_code);

/* This entry is used to cause the MCA to affect some IPC */

	idcw1_cmd = TEXT_TYPE;

TANDD_COMMON:

	sk_ioi_idx = a_ioi_idx;
	call cu_$level_get (user_level);
	on cleanup begin;
	     call cu_$level_set (user_level);
	end;
	call cu_$level_set (get_ring_ ());
	mcad_ptr = mca_util_$mca_ptr (sk_ioi_idx, code);
	if code ^= 0 then goto ERROR_EXIT;

	code = 0;

	if idcw1_cmd = READ_TYPE then call build_read_io_blk;
	else call build_write_io_blk;

	if code ^= 0 then goto ERROR_EXIT;

/* now get set for the IO completion */
/* don't return the mca_dcw_list, start at the status_area */

	mcad.entry_to_return_data = mca_tandd_$return_data;
	mcad.user_ptr = addr (user_iop -> mca_work_space.status_area);
	mcad.return_data_ptr = addr (mca_work_space.status_area);

/* requests the connect */

	call mca_util_$connect (mcad_ptr, code);
	if code ^= 0 then goto ERROR_EXIT;
	if ^mcad.async_io then do;

/* the user has requested in the attachment that we wait
   for the IO to complete */

	     call wait;

/* alway tell status */
	     a_mca_status = substr (mca_area.mca_status, 1, length (a_mca_status));


	     if code ^= 0 then goto ERROR_EXIT;
	end;

	else a_mca_status = "0"b;			/* no status yet */
	a_code = 0;
	call cu_$level_set (user_level);
	return;
%skip (4);
mca_tandd_$return_data:
     entry (a_mcad_ptr, a_ret_len, a_code);

/* called by mca_util_$io_event entries for both sync and async IO modes */

	mcad_ptr = a_mcad_ptr;
	mca_work_space_ptr = mcad.ioi_wks_ptr;
	mca_dcw_list_ptr = addr (mca_work_space.list_of_dcw);
	idcwp = addr (mca_dcw_list.idcw1);
	if idcw.control = "00"b			/* read-data */
	then dcwp = addr (mca_dcw_list.dcw1);		/* use first dcw */
	else dcwp = addr (mca_dcw_list.dcw2);		/* write text/data & read-data, use second */

/* find the offset of data_2 */
	io_param_blk_ptr = mcad.io_param_ptr;
	offset_of_data_2 = fixed (rel (io_param_blk_ptr), 17) + size (io_parameter_block);

/* find the size in chars of data_2 */

	temp_bits = io_parameter_block.source_len_msb || io_parameter_block.source_len_lsb;
	data_size_2 = fixed (temp_bits, 21);
	tally_num = bin (dcw.tally, 17);		/* find amount requested */
	if tally_num = 0 then tally_num = MAX_TALLY;
	tally_num = (tally_num - size (data_header)) * CHARS_PER_WORD;
	data_size_2 = min (data_size_2, tally_num);	/* use smallest */

/* we will return from the status offset to the end of the returned data */
	ret_len = (CHARS_PER_WORD * (offset_of_data_2 - mcad.status_offset)) + data_size_2;
	mcad.user_ptr -> ret_data = mcad.return_data_ptr -> ret_data;
	a_code = 0;
	a_ret_len = ret_len;
	return;
%skip (4);
ERROR_EXIT:
	a_code = code;
	call cu_$level_set (user_level);
	return;
%page;

build_read_io_blk:
     proc;

/* internal proc to build the ioi_work_space for read entries.
   This will build the IDCWs and DCWs based on the entry and the
   way the io_block is built. */

	user_iop = a_user_ptr;
	user_size = a_user_words;
	basic_size = size (mca_dcw_list) + size (istat) + size (data_header);
	data_size_1 = MAX_DATA_SIZE;			/* max the mca can send */
	data_size_2 = 0;
	call get_ws_size;
	if code ^= 0 then return;

/* now set up the idcw and dcw */
	mca_dcw_list_ptr = addr (mca_work_space.list_of_dcw);
	unspec (mca_dcw_list) = ""b;
	isp = addr (mca_work_space.status_area);
	unspec (mca_work_space.status_area) = ""b;

/* idcw command based on entry */
	idcwp = addr (mca_dcw_list.idcw1);
	unspec (idcw) = "0"b;
	dcwp = addr (mca_dcw_list.dcw1);
	unspec (dcw) = "0"b;

/* for read the data will always be returned in the second io_blk */
	data_header_ptr = addr (mca_work_space.data_header_1);
	mca_work_space.data_1 = low (data_size_1);

/* remember where we tell the MCA to return the data */
	mcad.io_param_ptr = addr (data_header.io_param_blk);
	unspec (idcw) = "0"b;
	idcw.command = READ_TYPE;
	idcw.code = IDCW_ID;
	idcw.chan_cmd = ENABLE_CONT_CMD;
	dcw.address = rel (data_header_ptr);
	dcw.type = IOTD;

/* Tally in words */
	tally_num = size (data_header) + (divide (data_size_1, CHARS_PER_WORD, 17));
	if mod (data_size_1, CHARS_PER_WORD) > 0 then tally_num = tally_num + 1;
	if tally_num > MAX_TALLY then tally_num = MAX_TALLY; /* trim to 4k */
	dcw.tally = substr (unspec (tally_num), 25, 12);

     end build_read_io_blk;

%page;
build_write_io_blk:
     proc;

/* internal proc to build the ioi_work_space for write entries.
   This will build the IDCWs and DCWs based on the entry and the
   way the io_block is built. This proc will call mca_parse_
   if the write_text entry was called */

	user_iop = a_user_ptr;
	user_size = a_user_words;
	basic_size = size (mca_dcw_list) + size (istat)
	     + (2 * size (data_header));
	io_param_blk_ptr = addr (user_iop -> mca_work_space.data_header_1.io_param_blk);

/* find out how large the mca command is */

	temp_bits = io_parameter_block.dest_len_msb || io_parameter_block.dest_len_lsb;
	data_size_1 = fixed (temp_bits, 21);
	data_size_2 = MAX_DATA_SIZE;
	call get_ws_size;
	if code ^= 0 then return;

	io_param_blk_ptr = addr (mca_work_space.data_header_1.io_param_blk);
	unspec (mca_work_space.data_header_1) = ""b;
	unspec (mca_work_space.list_of_dcw) = ""b;
	unspec (mca_work_space.status_area) = ""b;
	mca_work_space.data_1 = low (data_size_1);
						/*  copy the first part of the user data_header */
	mca_work_space.data_header_1 = user_iop -> mca_work_space.data_header_1;

/* copy the mca command */

	mca_work_space.data_1 = user_iop -> mca_work_space.data_1;

	if idcw1_cmd = TEXT_TYPE then do;

/* if this is a call for the write_text entry check the mca command */

	     call mca_parse_ (addr (mca_work_space.data_1), data_size_1,
		mcad_ptr, user_level, code);

/* if parse found some thing wrong get out of here now. */
	     if code ^= 0 then return;
	end;

	unspec (mca_work_space.data_header_2) = ""b;
						/* OK copy over the rest of the user info */
	mca_work_space.data_header_2 = user_iop -> mca_work_space.data_header_2;

/* now set up the idcws and dcws */
	mca_dcw_list_ptr = addr (mca_work_space.list_of_dcw);
	isp = addr (mca_work_space.status_area);
	idcwp = addr (mca_dcw_list.idcw1);
	unspec (idcw) = "0"b;

/* idcw command based on entry */
	idcw.command = idcw1_cmd;
	idcw.code = IDCW_ID;
	idcw.control = CONT_NO_MARKER;
	idcw.chan_cmd = ENABLE_CONT_CMD;
	dcwp = addr (mca_dcw_list.dcw1);
	unspec (dcw) = "0"b;
	data_header_ptr = addr (mca_work_space.data_header_1);
	dcw.address = rel (data_header_ptr);
	dcw.type = IOTD;

/* Tally in words + 1 */
	tally_num = size (data_header) + divide (data_size_1, CHARS_PER_WORD, 17);
	if mod (data_size_1, CHARS_PER_WORD) ^= 0 then tally_num = tally_num + 1;
	if tally_num > MAX_TALLY then tally_num = MAX_TALLY; /* trim to 4k */
	dcw.tally = substr (unspec (tally_num), 25, 12);

/* now set up the second data block for the returned data */

	data_header_ptr = addr (mca_work_space.data_header_2);

/* remember where we tell the MCA to return the data */
	mcad.io_param_ptr = addr (data_header.io_param_blk);
	idcwp = addr (mca_dcw_list.idcw2);
	unspec (idcw) = "0"b;
	idcw.command = READ_TYPE;
	idcw.code = IDCW_ID;
	idcw.chan_cmd = ENABLE_CONT_CMD;
	dcwp = addr (mca_dcw_list.dcw2);
	unspec (dcw) = "0"b;
	dcw.address = rel (data_header_ptr);
	dcw.type = IOTD;
	mca_work_space.data_2 = low (data_size_2);
						/* Tally in words */
	tally_num = size (data_header) + (divide (data_size_2, CHARS_PER_WORD, 17) + 1);
	if tally_num > MAX_TALLY then tally_num = MAX_TALLY; /* trim to 4k */
	dcw.tally = substr (unspec (tally_num), 25, 12);
     end build_write_io_blk;
%page;
get_ws_size:
     proc;
dcl  pages fixed bin;
	mca_work_space_ptr = mcad.ioi_wks_ptr;
						/* check user space */
	if user_size < basic_size + divide (data_size_1, CHARS_PER_WORD, 17) then do;
	     if idcw1_cmd ^= READ_TYPE then do;
		code = error_table_$area_too_small;
		return;
	     end;
	     else if user_size < basic_size then do;
		code = error_table_$area_too_small;
		return;
	     end;
	end;

/* make sure the current ioi_work_space is large enough to get started */
	ioi_ws_size = basic_size + divide (data_size_1, CHARS_PER_WORD, 17) + divide (data_size_2, CHARS_PER_WORD, 17);
	pages = divide (ioi_ws_size, sys_info$page_size, 17);
	if mod (ioi_ws_size, sys_info$page_size) ^= 0 then pages = pages + 1;
	ioi_ws_size = pages * sys_info$page_size;	/* ioi increments in pages */
	if mcad.current_ws_size < ioi_ws_size then do;
	     call ioi_$workspace (mcad.ioi_idx, mcad.ioi_wks_ptr,
		ioi_ws_size, code);
	     if code ^= 0 then return;
	     mcad.current_ws_size = ioi_ws_size;
	end;
	mca_work_space_ptr = mcad.ioi_wks_ptr;

	if user_size < ioi_ws_size then do;
	     if idcw1_cmd ^= READ_TYPE then
						/* decrease then size of data_2 */
		data_size_2 = data_size_2 - (CHARS_PER_WORD * (ioi_ws_size - user_size));

	     else					/* must be a read type so decrease then size of data_1 */
		data_size_1 = CHARS_PER_WORD * (user_size - basic_size);
	end;
     end get_ws_size;
%page;
wait:
     proc;

/* the connect is on its way and the IO mode is sync so we will wait here */
	ev_info_ptr = addr (event_info_area);
	mca_area_ptr = addr (sk_mca_area);
	event_wait_channel.channel_id (1) = mcad.event_chn;
	call ipc_$block (addr (event_wait_channel), ev_info_ptr, code);
	if code ^= 0 then do;
	     call convert_ipc_code_ (code);
	     return;
	end;

/* Now that something has happened the IO event will be processed, and it
   is known what MCA this should be for */

	call mca_util_$io_event_mca
	     (mcad_ptr, ev_info_ptr, mca_area_ptr, code);
     end wait;
%page;
%include event_wait_info;
%skip (3);
%include event_wait_channel;
%page;
%include mca_area;
%page;
%include mca_data;
%page;
%include mca_data_area;
     end mca_tandd_;




		    mca_util_.pl1                   10/30/86  1146.1rew 10/30/86  1143.3      283041



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

/****^  HISTORY COMMENTS:
  1) change(86-03-18,Fawcett), approve(86-03-18,MCR7374),
     audit(86-09-05,Lippard), install(86-09-16,MR12.0-1159):
     Created to control the MCA for online use. This is mainly used by online
     T&D.
  2) change(86-09-23,Fawcett), approve(86-09-23,PBF7374),
     audit(86-10-23,Farley), install(86-10-30,MR12.0-1203):
     Changed to check the mcad_ptr for null after a call to idx_to_ptr
     instead of the code being non-zero.
                                                   END HISTORY COMMENTS */

/* format: style4 */
/* Created Nov 1984 by R. A. Fawcett */
mca_util_:
     proc;
	return;

dcl  a_code fixed bin (35);
dcl  a_dsk_num fixed bin;
dcl  a_ev_info_ptr ptr;
dcl  a_ioi_idx fixed bin;
dcl  a_ipc_num fixed bin;
dcl  a_mca_area_ptr ptr;
dcl  a_mca_status bit (72);
dcl  a_mcad_ptr ptr;
dcl  a_on bit (1);
dcl  a_options bit (3);
dcl  a_ret_len fixed bin (21);
dcl  a_ret_size fixed bin (21);
dcl  a_trace_state char (40);
dcl  a_read_type char (*);
dcl  a_user_ptr ptr;
dcl  bc fixed bin (24);
dcl  code fixed bin (35);
dcl  dsk_num fixed bin;
dcl  1 event_info based (ev_info_ptr),			/* Structure returned by ipc */
       2 channel_id fixed bin (71),
       2 message fixed bin (71),
       2 sender bit (36),
       2 origin,
         3 dev_signal bit (18) unaligned,
         3 ring bit (18) unaligned,
       2 channel_index fixed bin;

dcl  ev_info_ptr ptr;
dcl  1 event_info_area like event_info;

dcl  1 event_list,					/* A list of ipc events */
       2 ev_count fixed bin,
       2 ev_chan fixed bin (71);


dcl  1 pcw_auto aligned,
       2 pcwa bit (36),
       2 pcwb bit (36);

dcl  expected_chars fixed bin (21);
dcl  file_ptr ptr;
dcl  force_entry bit (1);
dcl  foo_len fixed bin (21);
dcl  index_of_chan fixed bin;
dcl  ioi_ws_size fixed bin (18);
dcl  io_event_entry bit (1);
dcl  ipc_num fixed bin;
dcl  ipc_pic pic "99";
dcl  loc_ioi_idx fixed bin;
dcl  mca_command char (80);
dcl  mca_index fixed bin;
dcl  read_type char (80);
dcl  ret_len_bits bit (16);
dcl  ret_data char (ret_data_len) based;
dcl  ret_data_len fixed bin (21);
dcl  1 sk_mca_area like mca_area;
dcl  tally_num fixed bin;
dcl  trace_on bit (1);
dcl  trace_types bit (3);
dcl  trace_what char (20);
dcl  user_level fixed bin;

/* Entries */
dcl  cu_$level_get entry (fixed bin);
dcl  cu_$level_set entry (fixed bin);
dcl  convert_ipc_code_ entry options (variable);
dcl  get_process_id_ entry () returns (bit (36));
dcl  get_ring_ entry () returns (fixed bin (3));
dcl  initiate_file_ entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35));
dcl  ioa_$rsnnl entry () options (variable);
dcl  ioi_$connect entry (fixed bin, fixed bin (18), fixed bin (35));
dcl  ioi_$connect_pcw entry (fixed bin, fixed bin, bit (36) aligned, fixed bin (35));
dcl  ioi_$timeout entry (fixed bin, fixed bin (71), fixed bin (35));
dcl  ioi_$workspace entry (fixed bin, ptr, fixed bin (18), fixed bin (35));
dcl  rcp_$detach entry (bit (36) aligned, bit (*), fixed bin, char (*), fixed bin (35));
dcl  ipc_$block entry (ptr, ptr, fixed bin (35));


/* Builtin  */

dcl  (addr, addrel, bin, divide, fixed, hbound, lbound, length, min, mod,
     null, rel, rtrim, search, size, substr, unspec) builtin;

dcl  cleanup condition;


/* ERROR TABLE */

dcl  error_table_$action_not_performed fixed bin (35) ext static;
dcl  error_table_$area_too_small fixed bin (35) ext static;
dcl  error_table_$bad_arg fixed bin (35) ext static;
dcl  error_table_$not_attached fixed bin (35) ext static;
dcl  error_table_$timeout fixed bin (35) ext static;

/* Constants */

dcl  CHARS_PER_WORD fixed bin (17) init (4) static options (constant);
dcl  COMPLETE bit (6) unal init ("02"b3) static options (constant);
dcl  CONT_MARKER bit (2) init ("11"b) static options (constant);
dcl  CONT_NO_MARKER bit (2) init ("10"b) static options (constant);
dcl  IDCW_ID bit (3) init ("7"b3) static options (constant);
dcl  IOTD bit (2) init ("00"b) static options (constant);
dcl  MAX_TALLY fixed bin (17) init (4096) static options (constant);
dcl  NOT_COMPLETE bit (6) unal init ("40"b3) static options (constant);
dcl  ONE_K fixed bin (17) init (1024) static options (constant);
dcl  READ_TYPE bit (6) init ("03"b3) static options (constant);
dcl  READY bit (4) unal init ("0"b) static options (constant);
dcl  RESET_STATUS bit (6) init ("40"b3) static options (constant);
dcl  STATUS_MASK bit (72) init ("370000770000000000000000"b3) static options (constant);
dcl  TEXT_TYPE bit (6) init ("13"b3) static options (constant);
dcl  TRACE_FAULT bit (3) init ("4"b3) static options (constant);
dcl  TRACE_BOOT bit (3) init ("2"b3) static options (constant);
dcl  TRACE_DEBUG bit (3) init ("1"b3) static options (constant);

mca_util_$display:
     entry (a_user_ptr, a_ret_size, a_ret_len, a_code);

/* This entry returns the contents of the mca_data_seg, and is called via
   the mca_$display gate. */

	code = 0;
	file_ptr = a_user_ptr;
	mcad_ptr = null ();
	call cu_$level_get (user_level);
	on cleanup begin;
	     call cu_$level_set (user_level);
	end;
	call cu_$level_set (get_ring_ ());
	if mca_data_seg_ptr = null () then do;
	     call initiate_file_ (SYSTEM_DIR, DATA_SEG, "0"b,
		mca_data_seg_ptr, bc, code);
	     if mca_data_seg_ptr = null () then do;
		a_ret_len = 0;
		goto NORMAL_EXIT;
	     end;
	end;
	ret_data_len = a_ret_size;
	if ret_data_len > size (mca_data_seg) * CHARS_PER_WORD then ret_data_len = size (mca_data_seg) * CHARS_PER_WORD;
	file_ptr -> ret_data = mca_data_seg_ptr -> ret_data;
	a_ret_len = ret_data_len;
	goto NORMAL_EXIT;


mca_util_$io_event:
     entry (a_ioi_idx, a_ev_info_ptr, a_mca_area_ptr, a_code);

/* This entry is called via the mca_$process_io_event gate when the
   user has attached the MCA indicating the async_io mode */

	loc_ioi_idx = a_ioi_idx;
	ev_info_ptr = a_ev_info_ptr;
	mca_area_ptr = a_mca_area_ptr;
	io_event_entry = "1"b;
	force_entry = "0"b;
	code = 0;
	call cu_$level_get (user_level);
	on cleanup begin;
	     call cu_$level_set (user_level);
	end;
	call cu_$level_set (get_ring_ ());

	call idx_to_ptr;
	if (mcad_ptr = null ()) then do;
	     unspec (a_mca_area_ptr -> mca_area) = ""b;
	     goto ERROR_EXIT;
	end;
          code = 0;
	call common_io_event;
	if code ^= 0 then goto ERROR_EXIT;
	goto NORMAL_EXIT;

%skip (4);
mca_util_$load_ipc:
     entry (a_ioi_idx, a_ipc_num, a_mca_status, a_code);

/* Request the MCA to load the FW of the selected ipc  */

	code = 0;
	loc_ioi_idx = a_ioi_idx;
	ipc_num = a_ipc_num;
	call cu_$level_get (user_level);
	on cleanup begin;
	     call cu_$level_set (user_level);
	end;
	call cu_$level_set (get_ring_ ());
	if ipc_num < lbound (mcad.ipcd_array, 1) | ipc_num > hbound (mcad.ipcd_array, 1) then do;
	     code = error_table_$bad_arg;
	     a_mca_status = ""b;
	     goto ERROR_EXIT;
	end;
	ipc_pic = ipc_num;
	mca_command = "LOAD IPC " || ipc_pic;
	goto load_reset_common;
%skip (4);
mca_util_$reset_ipc:
     entry (a_ioi_idx, a_ipc_num, a_mca_status, a_code);

/* This entry will reset the selected ipc (a_ipc_num) it is called via the
   mca_ gate */

	code = 0;
	loc_ioi_idx = a_ioi_idx;
	ipc_num = a_ipc_num;
	call cu_$level_get (user_level);
	on cleanup begin;
	     call cu_$level_set (user_level);
	end;
	call cu_$level_set (get_ring_ ());
	if ipc_num < lbound (mcad.ipcd_array, 1) | ipc_num > hbound (mcad.ipcd_array, 1) then do;
	     code = error_table_$bad_arg;
	     a_mca_status = "0"b;
	     goto ERROR_EXIT;
	end;
	ipc_pic = ipc_num;
	mca_command = "RESET IPC " || ipc_pic;
	goto load_reset_common;
%skip (4);
load_reset_common:

/* The load and reset a requested IPC entries come here after setting
   the acsii MCA command in mca_command */

	io_event_entry = "0"b;
	force_entry = "0"b;
	call idx_to_ptr;
	if mcad_ptr = null () then goto ERROR_EXIT;
	ipcd_ptr = addr (mcad.ipcd_array (ipc_num));
	if ipcd.state < IPC_ATTACHED then do;
	     code = error_table_$not_attached;
	     goto ERROR_EXIT;
	end;
	expected_chars = CHARS_PER_WORD;
	call set_ws_connect;
	if code ^= 0 then goto ERROR_EXIT;
	mcad.entry_to_return_data = mca_util_$ret_load_reset_ipc;
	if ^mcad.async_io then do;
	     call wait;
	     a_mca_status = mca_area.mca_status;
	     if code ^= 0 then goto ERROR_EXIT;
	end;
	else a_mca_status = "0"b;
	goto NORMAL_EXIT;

/* end load_ipc reset_ipc */
%skip (4);
mca_util_$load_all_ipcs:
     entry (a_ioi_idx, a_mca_status, a_code);

/* Entry called via mca_priv_ gate to request the MCA to load FW
   in all the IPCs */

	mca_command = "LOAD IPCS";
	goto common_all_ipcs;
%skip (4);
mca_util_$reset_all_ipcs:
     entry (a_ioi_idx, a_mca_status, a_code);

/* Entry called via mca_priv_ gate to request the MCA to reset all the IPCs */

	mca_command = "RESET IPCS";
	goto common_all_ipcs;

common_all_ipcs:

/* load and reset "all ipcs" entries come here after setting the
   ascii MCA command in mca_command */

	loc_ioi_idx = a_ioi_idx;
	code = 0;
	io_event_entry = "0"b;
	force_entry = "0"b;
	call cu_$level_get (user_level);
	on cleanup begin;
	     call cu_$level_set (user_level);
	end;
	call cu_$level_set (get_ring_ ());
	call idx_to_ptr;
	if mcad_ptr = null () then goto ERROR_EXIT;

/* Make sure the user has requested and mca_attach_ has granted the attach
   of all the IPCs */

	do ipc_num = lbound (mcad.ipcd_array, 1) to hbound (mcad.ipcd_array, 1);
	     if mcad.ipcd_array (ipc_num).state < IPC_ATTACHED then do;
						/* NO CAN DO */
		code = error_table_$not_attached;
		goto ERROR_EXIT;
	     end;
	end;
	call set_ws_connect;
	if code ^= 0 then goto ERROR_EXIT;
	mcad.entry_to_return_data = mca_util_$ret_load_reset_ipc;
	if ^mcad.async_io then do;
	     call wait;
	     a_mca_status = mca_area.mca_status;
	     if code ^= 0 then goto ERROR_EXIT;
	end;
	goto NORMAL_EXIT;
%skip (4);
mca_util_$diskette_read:
     entry (a_ioi_idx, a_read_type, a_dsk_num, a_user_ptr, a_ret_size,
	a_ret_len, a_mca_status, a_code);

/* This entry is to read one of the MCA diskettes it is called via the
   mca_$diskette_read gate  */

	loc_ioi_idx = a_ioi_idx;
	io_event_entry = "0"b;
	force_entry = "0"b;
	call cu_$level_get (user_level);
	on cleanup begin;
	     call cu_$level_set (user_level);
	end;
	call cu_$level_set (get_ring_ ());
	call idx_to_ptr;
	if mcad_ptr = null () then goto ERROR_EXIT;
	dsk_num = a_dsk_num;
	read_type = a_read_type;

	if read_type = "DIRECTORY" then goto format_with_num;
	else if read_type = "HDR" then goto format_with_num;
	else if substr (read_type, 1, 2) = "P=" then goto format_with_num;
	else if search (read_type, "/") ^= 0 then do;
	     call ioa_$rsnnl ("READ^x^a", mca_command, foo_len,
		rtrim (read_type));
	     goto have_format;
	end;
	else do;
	     code = error_table_$bad_arg;
	     goto ERROR_EXIT;
	end;
format_with_num:
	if dsk_num < 0 | dsk_num > 1 then do;
	     code = error_table_$bad_arg;
	     goto ERROR_EXIT;
	end;
	call ioa_$rsnnl ("READ^x^a,^d", mca_command,
	     foo_len, rtrim (read_type), dsk_num);
have_format:
	expected_chars = min (16128, a_ret_size);
	goto common_read;
%skip (4);
mca_util_$read_config:
     entry (a_ioi_idx, a_user_ptr, a_ret_size,
	a_ret_len, a_mca_status, a_code);

/* This entry is called via the mca_$config gate to read the MCA configuration file */
	loc_ioi_idx = a_ioi_idx;
	a_mca_status = "0"b;
	io_event_entry = "0"b;
	force_entry = "0"b;
	call cu_$level_get (user_level);
	on cleanup begin;
	     call cu_$level_set (user_level);
	end;
	call cu_$level_set (get_ring_ ());
	call idx_to_ptr;
	if mcad_ptr = null () then goto ERROR_EXIT;
	expected_chars = (size (mca_config_file) * CHARS_PER_WORD);
	if a_ret_size < expected_chars then do;
	     code = error_table_$area_too_small;
	     goto ERROR_EXIT;
	end;
	mca_command = "READ CONFIG";
	goto common_read;

%skip (4);
mca_util_$read_data:
     entry (a_ioi_idx, a_user_ptr, a_ret_size,
	a_ret_len, a_mca_status, a_code);

/* This entry is to read data from the MCA called via mca_$read_data gate */

	loc_ioi_idx = a_ioi_idx;
	io_event_entry = "0"b;
	force_entry = "0"b;
	call cu_$level_get (user_level);
	on cleanup begin;
	     call cu_$level_set (user_level);
	end;
	call cu_$level_set (get_ring_ ());
	call idx_to_ptr;
	if mcad_ptr = null () then goto ERROR_EXIT;

	expected_chars = min (16128, a_ret_size);
	mca_command = "";				/* This will indicate that there is no ascii */
						/* command to the MCA */
common_read:

/* diskette_read, read_config and read_data come here after setting the ascii
   MCA command in mca_command */

	call set_ws_connect;
	if code ^= 0 then do;
	     a_mca_status = ""b;
	     a_ret_len = 0;
	     goto ERROR_EXIT;
	end;
	mcad.user_ptr = a_user_ptr;
	mcad.return_data_ptr = file_ptr;
	mcad.entry_to_return_data = mca_util_$return_data;
	if ^mcad.async_io then do;
	     call wait;
	     a_mca_status = mca_area.mca_status;
	     a_ret_len = mca_area.ret_len;
	     if code ^= 0 then goto ERROR_EXIT;
	end;
	else do;
	     a_mca_status = "0"b;
	     a_ret_len = 0;
	end;
	goto NORMAL_EXIT;


/* end read_config, read_data, and diskette_read */

mca_util_$trace_sw:
     entry (a_ioi_idx, a_options, a_on, a_trace_state, a_mca_status, a_code);

/* Entry called via mca_priv_ gate to change the tracing */

	loc_ioi_idx = a_ioi_idx;
	trace_types = a_options;
	io_event_entry = "0"b;
	call cu_$level_get (user_level);
	on cleanup begin;
	     call cu_$level_set (user_level);
	end;
	call cu_$level_set (get_ring_ ());
	code = 0;
	trace_what = " ";
	trace_on = a_on;
	if trace_types = "0"b then do;
	     a_mca_status = "0"b;
	     code = error_table_$bad_arg;
	     goto ERROR_EXIT;
	end;
	force_entry = "0"b;
	call idx_to_ptr;
	if mcad_ptr = null () then do;
	     a_mca_status = "0"b;
	     goto ERROR_EXIT;
	end;
	call ioa_$rsnnl
	     ("TRACE^x^[ON^;OFF^]^[^xFAULT^]^[^xBOOT^]^[^xDEBUG^]",
	     mca_command, foo_len, trace_on,
	     (trace_types & TRACE_FAULT),
	     (trace_types & TRACE_BOOT),
	     (trace_types & TRACE_DEBUG));
	expected_chars = 32;
	call set_ws_connect;
	if code ^= 0 then do;
	     a_mca_status = "0"b;
	     goto ERROR_EXIT;
	end;
	mcad.user_ptr = addr (a_trace_state);
	mcad.return_data_ptr = addr (mca_work_space.data_2);
	mcad.entry_to_return_data = mca_util_$ret_trace_state;
	if ^mcad.async_io then do;
	     call wait;
	     a_mca_status = mca_area.mca_status;
	     if code ^= 0 then goto ERROR_EXIT;
	end;
	goto NORMAL_EXIT;
%skip (4);
mca_util_$reset:
     entry (a_ioi_idx, a_mca_status, a_code);

/* This entry is called via mca_$reset gate, and in ring_1 by mca_attach_
   to reset the mca and read the config data from the MCA. */

	loc_ioi_idx = a_ioi_idx;
	code = 0;
	io_event_entry = "1"b;
	force_entry = "0"b;
	call cu_$level_get (user_level);

	on cleanup begin;
	     call cu_$level_set (user_level);
	end;

	call cu_$level_set (get_ring_ ());

	call idx_to_ptr;

	if mcad_ptr = null () then do;
	     a_mca_status = "0"b;
	     goto ERROR_EXIT;
	end;
	call reset_status;
	mcad.entry_to_return_data = mca_util_$no_data;
	if mcad.async_io then do;
	     a_mca_status = "0"b;
	     goto NORMAL_EXIT;
	end;

	call wait;
	a_mca_status = mca_area.mca_status;
	if code ^= 0 & mcad.state ^= MCA_ATTACHING then goto ERROR_EXIT;
	if mcad.state = MCA_ATTACHING & ^mcad.config_data_requested then do;
	     call mca_util_$attach_config (mcad_ptr, code);
	     if code ^= 0 then do;
		goto ERROR_EXIT;
	     end;
	     mcad.config_data_requested = "1"b;
	end;
	goto NORMAL_EXIT;

%skip (4);

NORMAL_EXIT:

/* All seems to be well */

	a_code = code;
	call cu_$level_set (user_level);
	return;
%skip (4);
ERROR_EXIT:

/* Something is wrong */

	a_code = code;
	if mcad_ptr ^= null () then
	     if mcad.state = MCA_ATTACHING then do;
		if mcad.rcp_id ^= "0"b then do;
		     call rcp_$detach (mcad.rcp_id, "0"b, 0, "", code);
		end;
	     end;
	     else ;
	call cu_$level_set (user_level);
	return;
%page;

/* Start non-gate entries */

mca_util_$force_mca_ptr:
     entry (a_ioi_idx, a_code) returns (ptr);
	force_entry = "1"b;
	goto mca_ptr_common;

mca_util_$mca_ptr:
     entry (a_ioi_idx, a_code) returns (ptr);

/* This entry will return a pointer to the mca_data for the MCA
   indicated by a_ioi_idx. If the ioi_idx is not found or the MCA is not
   attached to this process, the pointer will be null and an error code
   of error_table_$not_attached will be returned.  */

	force_entry = "0"b;
mca_ptr_common:

	loc_ioi_idx = a_ioi_idx;
	mcad_ptr = null ();
	code = 0;
	io_event_entry = "0"b;
	call idx_to_ptr;
	a_code = code;
	return (mcad_ptr);

/* end mca_ptr entry */
%skip (4);
mca_util_$attach_config:
     entry (a_mcad_ptr, a_code);

/* called by ring1 mca_attach after the rcp attachment to issue the connect to
   read in the config data from the MCA. Some parts of the config data are
   placed into the mca_data_seg for this MCA entry on completion of the IO.
   This is done by mca_util_$fill_config_data */

	mca_command = "READ CONFIG";
	expected_chars = (size (mca_config_file) * CHARS_PER_WORD);
	mcad_ptr = a_mcad_ptr;
	call set_ws_connect;
	if code ^= 0 then do;
	     a_code = code;
	     return;
	end;
	mcad.return_data_ptr = file_ptr;
	mcad.user_ptr = null ();
	mcad.entry_to_return_data = mca_util_$fill_config_data;
	if ^mcad.async_io then do;
sync_io_loop:
	     call wait;
	     if code ^= 0 then do;
		a_code = code;
		return;
	     end;
	     statp = addr (mca_area.mca_status);
	     if status.sub ^= "02"b3 then do;
		mca_command = "";
		expected_chars = MAX_TALLY;
		call set_ws_connect;
		if code ^= 0 then return;
		mcad.return_data_ptr = file_ptr;
		mcad.entry_to_return_data = mca_util_$no_data;
		goto sync_io_loop;
	     end;
	     else do;
		call ioi_$timeout (mcad.ioi_idx, mcad.max_time_out, code);
		if code ^= 0 then do;
		     a_code = code;
		     return;
		end;
		mcad.state = MCA_ATTACHED;
	     end;
	end;
	a_code = code;
	return;
%skip (4);
mca_util_$connect: entry (a_mcad_ptr, a_code);

/* This entry will always assume that the dcw_list starts at the base
   of the work space. It can only be called by ring1_ procs */

	mcad_ptr = a_mcad_ptr;
	code = 0;
	call do_connect;
	a_code = code;
	return;

/* end connect entry */
%skip (4);
mca_util_$force_reset:
     entry (a_ioi_idx, a_mca_status, a_code);

/* This is only called in ring_1 */

	loc_ioi_idx = a_ioi_idx;
	force_entry = "1"b;
	code = 0;
	call idx_to_ptr;
	if mcad_ptr = null () then do;
	     a_code = code;
	     a_mca_status = "0"b;
	     return;
	end;
	pcw_auto = "0"b;
	pcwp = addr (pcw_auto);
	pcw.code = IDCW_ID;
	pcw.mask = "1"b;
	pcw.control = CONT_MARKER;
	mca_work_space_ptr = mcad.ioi_wks_ptr;
	idcwp = addr (mca_work_space.list_of_dcw);
	unspec (idcw) = "0"b;
	idcw.code = IDCW_ID;
	call ioi_$connect_pcw (mcad.ioi_idx, 0, pcw_auto.pcwa, code);
	if code ^= 0 then do;
	     a_code = code;
	     return;
	end;
	mcad.entry_to_return_data = mca_util_$no_data;
	if mcad.async_io then do;
	     a_mca_status = "0"b;
	     a_code = code;
	     return;
	end;
	call wait;
	a_mca_status = mca_area.mca_status;
	if imess.time_out then code = 0;		/* This is what is expected */
	a_code = code;
	return;
%skip (4);
mca_util_$io_event_mca:
     entry (a_mcad_ptr, a_ev_info_ptr, a_mca_area_ptr, a_code);

/* This entry is called by ring1 mca_ modules when in sync_io mode after the
   IO event has happened */

	mcad_ptr = a_mcad_ptr;
	ev_info_ptr = a_ev_info_ptr;
	mca_area_ptr = a_mca_area_ptr;
	code = 0;
	call common_io_event;
	a_code = code;
	return;
%page;

/* The next entries are used to return the data back to the user at the
   completion of the IO. These are called by the io_event entries.

   The call is:
   call mcad.entry_to_return_data (mcad_ptr,ret_len,code);

   the entry var, mcad.entry_to_return_data is set by the code that requests
   the IO be started. The same code will set the mcad.user_ptr, if the
   user changes his mind it is too bad for him. The mcad.io_param_blk_ptr
   is set before the connect is requested. This is a pointer to the io_param
   filled in by the MCA for the data it returns.

   It is done this way for ASYNC_IO and SYNC_IO to keep
   the code simple (???). The load and reset commands do not return data,
   however due to the constant way the MCA manager should work an entry is
   here. */

mca_util_$ret_load_reset_ipc:
mca_util_$no_data:

     entry (a_mcad_ptr, a_ret_len, a_code);

/* There is no data returned	so don't return any but say so */

	a_code = 0;
	a_ret_len = 0;
	return;

/* end ret_load_ipc */
%skip (4);
mca_util_$ret_trace_state:
     entry (a_mcad_ptr, a_ret_len, a_code);

/* This entry returns the ascii data from the MCA data called form ring_1 */

	mcad_ptr = a_mcad_ptr;
	io_param_blk_ptr = mcad.io_param_ptr;
	ret_len_bits = (io_parameter_block.source_len_msb || io_parameter_block.source_len_lsb);

/* if the data returned by MCA is greater that the area for the user (40)
   then only return the first 40 chars (the length of a_trace_state) */

	ret_data_len = min (fixed (ret_len_bits, 21), length (a_trace_state));
	mcad.user_ptr -> ret_data = mcad.return_data_ptr -> ret_data;
	a_ret_len = ret_data_len;
	a_code = 0;
	return;
%skip (4);
mca_util_$return_data:
     entry (a_mcad_ptr, a_ret_len, a_code);

/* this is called by io_events to return data from read configuration and
   read diskette entries. This is called only from ring_1 */
	code = 0;
	mcad_ptr = a_mcad_ptr;
	mca_work_space_ptr = mcad.ioi_wks_ptr;
	mca_dcw_list_ptr = addr (mca_work_space.list_of_dcw);
	idcwp = addr (mca_dcw_list.idcw1);
	if idcw.control = READ_TYPE			/* read data */
	then dcwp = addr (mca_dcw_list.dcw1);		/* use first dcw */
	else dcwp = addr (mca_dcw_list.dcw2);		/* read conf/diskette, use second */
	io_param_blk_ptr = mcad.io_param_ptr;

/* calculate the data size returned by the MCA */

	ret_len_bits = (io_parameter_block.source_len_msb || io_parameter_block.source_len_lsb);
	ret_data_len = fixed (ret_len_bits, 21);

/* calculate the amount of data requested from the MCA */

	tally_num = bin (dcw.tally, 17);
	if tally_num = 0 then tally_num = MAX_TALLY;
	tally_num = (tally_num - size (data_header)) * CHARS_PER_WORD;
	ret_data_len = min (ret_data_len, tally_num);	/* use smallest value */

	mcad.user_ptr -> ret_data = mcad.return_data_ptr -> ret_data;
	a_ret_len = ret_data_len;
	a_code = code;
	return;
%skip (4);
mca_util_$fill_config_data:
     entry (a_mcad_ptr, a_ret_len, a_code);

/* this will fill in the config data of the mcad from the mca config file .
   It will change the state for this MCA from ATTACHING to ATTACHED. It is only callable in ring_1 */

	mcad_ptr = a_mcad_ptr;
	mca_config_file_ptr = mcad.return_data_ptr;
	do index_of_chan = lbound (mca_config_file.channel_data, 1) to hbound (mca_config_file.channel_data, 1);
	     ipcd_ptr = addr (mcad.ipcd_array (index_of_chan));
	     unspec (ipcd) = "0"b;
	     ipcd.channel =
		mca_config_file.channel_data (index_of_chan).prim_ch_num;
	     ipcd.nchan =
		mca_config_file.channel_data (index_of_chan).num_of_log_ch;
	     ipcd.no_level_2_info =
		mca_config_file.channel_data (index_of_chan).no_lev_2;
	     ipcd.is_micro_cont =
		mca_config_file.channel_data (index_of_chan).micro_ctl;
	     ipcd.fbus_disable_latch =
		mca_config_file.channel_data (index_of_chan).fbus_latch;
	     ipcd.type_index =
		mca_config_file.channel_data (index_of_chan).lvl_1_id_type;
	     ipcd.level_1_state =
		mca_config_file.channel_data (index_of_chan).lvl_1_state;
	     if ipcd.level_1_state <=
		PH_NOT_PRESENT then ipcd.state = IPC_NOT_CONFIGURED;
	     else ipcd.state = IPC_FREE;
	end;
	a_code = 0;
	return;
%page;

/* Start of internal procedures */
common_io_event: proc;

/* Only one version now. In future we may want to check this to see
   if it is correct */

	call process_io_event;
	if code ^= 0 then return;
	if mcad.state = MCA_ATTACHING & ^mcad.config_data_requested then do;
	     call mca_util_$attach_config (mcad_ptr, code);
	     if code ^= 0 then return;
	     mcad.config_data_requested = "1"b;
	     if mcad.async_io then goto NORMAL_EXIT;	/* wait for IO to finish */
	end;
	if mcad.state = MCA_ATTACHING & mcad.async_io then do;
	     statp = addr (mca_area.mca_status);
	     if status.major = READY then do;
		if status.sub = COMPLETE then do;
		     call ioi_$timeout (mcad.ioi_idx, mcad.max_time_out, code);
		     if code ^= 0 then return;
		     mcad.state = MCA_ATTACHED;
		end;
		else if status.sub = NOT_COMPLETE then do;
		     mca_command = "";
		     expected_chars = ONE_K;
		     call set_ws_connect;
		     if code ^= 0 then return;
		end;
	     end;
	end;
	mca_area.mca_attach_state = mcad.state;

     end common_io_event;
%skip (4);
do_connect:
     proc;
	code = 0;
	call ioi_$connect (mcad.ioi_idx, 0, code);

     end do_connect;
%page;
idx_to_ptr:
     proc;

/* this proc sets the mcad_ptr to the mca_data_seg array that contains the
   requested ioi_idx (loc_ioi_idx) */

	mcad_ptr = null ();
	code = 0;

	if mca_data_seg_ptr = null () then do;
	     call initiate_file_ (SYSTEM_DIR, DATA_SEG, "0"b,
		mca_data_seg_ptr, bc, code);
	     if mca_data_seg_ptr = null () then
						/* Trouble in River City */
		return;
	end;

	do mca_index = lbound (mca_data_seg.array, 1) to hbound (mca_data_seg.array, 1)
	     while (mca_data_seg.array (mca_index).ioi_idx ^= loc_ioi_idx);
	end;

	if mca_index > hbound (mca_data_seg.array, 1) then do;

/* none of the array entries has the ioi_idx */

	     code = error_table_$not_attached;
	     return;
	end;

/* This array entry is the one we want */

	mcad_ptr = addr (mca_data_seg.array (mca_index));

	if force_entry then return;			/* no need to check attachments */

/* Now see if the process we are running in has it attached */

	if mcad.attach_pid ^= get_process_id_ () then do;

/* user must have made lucky gess */

	     mcad_ptr = null ();
	     code = error_table_$not_attached;
	     return;
	end;

	if mcad.state <= MCA_ATTACHING then do;
	     code = error_table_$not_attached;

/* could be that we where called after the completion of the IO to read
   the config at attach time and mca_util_$fill_config_data hasn't set the
   state to ATTACHED yet */

	     if io_event_entry & (mcad.state = MCA_ATTACHING) then return;

/* OK this is not an IO entry so make it looked non attached */
	     else mcad_ptr = null ();
	end;

     end idx_to_ptr;
%page;
process_io_event:
     proc;

/* this proc will set up the returned mca_area structure and call the entry in
   mcad.entry_to_return_data to return the data to the user (clever name) */

	unspec (mca_area) = ""b;
	mca_area.version = MCA_area_version_1;
	mca_area.mca_attach_state = mcad.state;
	imp = addr (event_info.message);
	if imess.completion.time_out then do;
	     code = error_table_$timeout;
	     return;
	end;
	if ^imess.completion.st then do;
	     code = error_table_$action_not_performed;
	     return;
	end;
	isp = addrel (mcad.ioi_wks_ptr, mcad.status_offset);
	statp = addr (istat.iom_stat);
	mcad.last_status = substr (istat.iom_stat, 1, length (mcad.last_status));
	mca_area.mca_status = mcad.last_status;

	if unspec (status) & STATUS_MASK then do;
	     unspec (code) = substr (mcad.last_status, 1, 36);
	     mca_area.io_outstanding = "0"b;
	     if substr (status.sub, 1, 1) = "1"b then
		call mcad.entry_to_return_data
		     (mcad_ptr, mca_area.ret_len, code);
	     else mca_area.ret_len = 0;
	     return;
	end;
	else do;
	     if substr (status.sub, 5, 1) = "1"b then	/* The MCA is all done */
		mca_area.io_outstanding = "0"b;
	     else mca_area.io_outstanding = "1"b;
	     if substr (status.sub, 1, 1) = "1"b then	/* The MCA has sent data */
		call mcad.entry_to_return_data
		     (mcad_ptr, mca_area.ret_len, code);
	     else mca_area.ret_len = 0;
	     return;
	end;
     end process_io_event;
%page;
reset_status:
     proc;
	mca_work_space_ptr = mcad.ioi_wks_ptr;
	mca_dcw_list_ptr = addr (mca_work_space.list_of_dcw);
	isp = addr (mca_work_space.status_area);
	unspec (mca_dcw_list) = ""b;
	idcwp = addr (mca_dcw_list.idcw1);
	idcw.command = RESET_STATUS;
	idcw.code = IDCW_ID;
	call do_connect;
     end reset_status;
%skip (4);
set_ws_connect:
     proc;

/* this proc sets up the work space for all the mca_util_$ entries that send
   command to the MCA. It will build the data headers and io_param_blocks
   based on the mca_command and the expected_chars setup by the caller. The
   dcw list is set up based on the two data headers */

	mca_work_space_ptr = mcad.ioi_wks_ptr;
	data_size_1 = length (rtrim (mca_command));
	data_size_2 = expected_chars;
	ioi_ws_size = size (mca_work_space);
	if ioi_ws_size > mcad.current_ws_size then do;
	     call ioi_$workspace (mcad.ioi_idx, mcad.ioi_wks_ptr,
		ioi_ws_size, code);
	     if code ^= 0 then return;
	     mca_work_space_ptr = mcad.ioi_wks_ptr;
	     mcad.current_ws_size = ioi_ws_size;
	end;
	mca_dcw_list_ptr = addr (mca_work_space.list_of_dcw);
	isp = addr (mca_work_space.status_area);
	data_header_ptr = addr (mca_work_space.data_header_1);
	unspec (data_header) = ""b;
	unspec (mca_dcw_list) = ""b;
	idcwp = addr (mca_dcw_list.idcw1);
	dcwp = addr (mca_dcw_list.dcw1);
	if mca_command = "" then ;
	else do;
	     data_header.file_name = "";
	     data_header.definer = CON_DATA_FROM_HOST;
	     data_header.rd_flpy = 1;
	     data_header.dest_len.dest_len_msb
		= substr (unspec (data_size_1), 21, 8);
	     data_header.dest_len.dest_len_lsb =
		substr (unspec (data_size_1), 29, 8);
	     data_1 = substr (mca_command, 1, data_size_1);
	     idcw.command = TEXT_TYPE;
	     idcw.code = IDCW_ID;
	     idcw.control = CONT_NO_MARKER;
	     dcw.address = rel (data_header_ptr);
	     dcw.type = IOTD;

/* Tally in words (next highest) */
	     tally_num = size (data_header) + divide (data_size_1, CHARS_PER_WORD, 17);
	     if mod (data_size_1, CHARS_PER_WORD) ^= 0 then tally_num = tally_num + 1;
	     dcw.tally = substr (unspec (tally_num), 25, 12);
	     idcwp = addr (mca_dcw_list.idcw2);
	     dcwp = addr (mca_dcw_list.dcw2);
	end;

/* now set up the second data block for the returned data */

READ_PART:

	data_header_ptr = addr (mca_work_space.data_header_2);
	unspec (data_header) = ""b;

	mcad.io_param_ptr = addr (data_header_2.io_param_blk);
	file_ptr = addr (mca_work_space.data_2);
	idcw.command = READ_TYPE;
	idcw.code = IDCW_ID;
	dcw.address = rel (data_header_ptr);
	dcw.type = IOTD;

/* Tally in words (next highest) */
	tally_num = size (data_header) + (divide (data_size_2, CHARS_PER_WORD, 17) + 1);

	dcw.tally = substr (unspec (tally_num), 25, 12);


/* Requests the IO */

	call do_connect;
	return;
     end set_ws_connect;
%page;
wait:
     proc;

/* At attach time the user indicated that the IO mode would be sync */

	mca_area_ptr = addr (sk_mca_area);
	event_list.ev_count = 1;			/* only one */
	event_list.ev_chan = mcad.event_chn;		/* This is it */
	ev_info_ptr = addr (event_info_area);
	call ipc_$block (addr (event_list), ev_info_ptr, code);
	if code ^= 0 then do;
	     call convert_ipc_code_ (code);
	     return;
	end;
	call process_io_event;
     end wait;

%page;
%include iom_stat;
%page;
%include mca_area;
%page;
%include mca_constants;
%page;
%include mca_data;
%page;
%include mca_config_file;
%page;
%include mca_data_area;
     end mca_util_;







		    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
