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 \ / / [a_code = error_table_$noarg] / RETURN \ / / [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 \ / / [a_code = error_table_$noarg] / RETURN \ / / [a_code = error_table_$bad_arg] / AUDIT_RET \ ft_ipc / / LEX (1) / next_ipc \ / / [a_code = error_table_$io_not_assigned] / AUDIT_RET \ / / [a_code = error_table_$bad_arg] / AUDIT_RET \ / / [a_code = error_table_$noarg] / RETURN \ next_ipc / / / exit \ / / LEX (1) / next_ipc \ / / [a_code = error_table_$io_not_assigned] / AUDIT_RET \ / / [a_code = error_table_$bad_arg] / AUDIT_RET \ all_ipcs / / 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 \ / / [a_code = error_table_$bad_arg] / AUDIT_RET \ / / [a_code = error_table_$noarg] / RETURN \ target_verb / ipc / LEX (1) / ck_ipc_att \ / / [a_code = error_table_$bad_arg] / AUDIT_RET \ / / [a_code = error_table_$noarg] / RETURN \ ck_ipc_att / / LEX (1) / ck_via \ / / [a_code = error_table_$io_not_assigned] / AUDIT_RET \ / / [a_code = error_table_$bad_arg] / AUDIT_RET \ / / [a_code = error_table_$noarg] / RETURN \ ck_via / via / LEX (1) / ck_imu \ / / [a_code = error_table_$bad_arg] / AUDIT_RET \ / / [a_code = error_table_$noarg] / RETURN \ ck_imu / imu / LEX (1) / ck_imu_num \ / / [a_code = error_table_$bad_arg] / AUDIT_RET \ / / [a_code = error_table_$noarg] / RETURN \ ck_imu_num / / LEX(1) / ck_using \ / / [a_code = code] / AUDIT_RET \ / / [a_code = error_table_$noarg] / RETURN \ ck_using / using / LEX (1) / ck_technique \ / / [a_code = error_table_$bad_arg] / AUDIT_RET \ / / [a_code = error_table_$noarg] / RETURN \ \" Parse the 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 \ / / [a_code = error_table_$bad_arg] / AUDIT_RET \ / / [a_code = error_table_$noarg] / RETURN \ ck_options / / [a_code = 0] / RETURN \ / options / LEX (1) / exit \ / / [a_code = error_table_$bad_arg] / AUDIT_RET \ exit / / [a_code = 0] / RETURN \ / / [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