COMPILATION LISTING OF SEGMENT cmcs_wait_ctl_ Compiled by: Multics PL/I Compiler, Release 31b, of April 24, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 05/24/89 1020.8 mst Wed Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 6* * * 7* *********************************************************** */ 8 9 10 11 12 /****^ HISTORY COMMENTS: 13* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8087), 14* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 15* MCR8087 cmcs_wait_ctl_.pl1 Shorten wait time for cmcs_station_ctl_. 16* END HISTORY COMMENTS */ 17 18 19 /* Modified on 10/20/84 by FCH, [5.3-1], BUG565(phx18385), wait time for set_lock_$lock */ 20 /* Modified since Version 4.3 */ 21 22 23 24 25 /* format: style3 */ 26 cmcs_wait_ctl_: 27 proc; 28 29 return; /* bad entrypoint */ 30 31 /* This COBOL MCS subroutine is used to manage the wait control lists. The lists 32* are linked forward and backward by entry index. All additions are done at the end of the list. 33* Deletions can occur anywhere. Lists are always searched from the beginning, 34* in order to serve requests on a first-come, first-served (when appropriate) basis. 35* 36* Note: the wait_ctl.current_size is not decremented even when the last physical entry of the segment 37* is deleted. The entry is just added to the free list. The segment will never have more entries 38* than the maximum number of concurrent users, so it will never grow to unreasonable size. */ 39 40 /* Bob May, 6/30/77 */ 41 42 /* DEBUG dcls */ 43 44 dcl (sub_err_, ioa_) entry options (variable); 45 46 dcl sub_err_retval fixed bin (35); /* dummy for sub_err_ */ 47 48 /* input/output parameters */ 49 50 dcl a_tree_path char (48), 51 a_index fixed bin, 52 a_queue_ctl_eptr ptr, 53 a_wait_ctl_mp_eindex 54 fixed bin, 55 a_tree_ctl_eindex fixed bin, 56 a_code fixed bin (35); 57 58 /* variables to manipulate entries */ 59 60 dcl (c_ptr, b_ptr, f_ptr) 61 ptr, 62 (c_index, b_index, f_index) 63 fixed bin, 64 1 c like wait_ctl_entry based (c_ptr), 65 /* "current" entry */ 66 1 b like wait_ctl_entry based (b_ptr), 67 /* entry before current entry */ 68 1 f like wait_ctl_entry based (f_ptr); 69 /* entry following current entry */ 70 71 dcl i fixed bin, 72 new_index fixed bin; /* additional FB to process entry indices */ 73 74 dcl code fixed bin (35); 75 76 dcl my_name char (14) int static init ("cmcs_wait_ctl_"); 77 78 dcl test_sw bit (1) int static init ("0"b); 79 80 dcl ( 81 free_flag init ("1"b), 82 used_flag init ("0"b) 83 ) bit (1) aligned int static options (constant); 84 85 dcl get_process_id_ entry () returns (bit (36) aligned); 86 87 dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)), 88 ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35)), 89 ipc_$block entry (ptr, ptr, fixed bin (35)); 90 91 dcl error_table_$action_not_performed 92 fixed bin (35) external; 93 94 dcl (addr, null, string) 95 builtin; 96 97 /* */ 1 1 /* BEGIN INCLUDE FILE... cmcs_control_hdr.incl.pl1 */ 1 2 1 3 /* This include file is the 1st part of all cobol_mcs tables */ 1 4 1 5 /* Bob May, 4/30/77 */ 1 6 1 7 dcl control_hdr_len fixed bin int static options (constant) init (32); 1 8 1 9 dcl control_hdr_ptr ptr; 1 10 1 11 dcl 1 control_hdr aligned based (control_hdr_ptr), 1 12 2 lockword bit (36) aligned, /* for process_id */ 1 13 2 version fixed bin, 1 14 2 clock_created fixed bin (71), 1 15 2 author aligned, 1 16 3 group_id char (32), /* person.proj.tag */ 1 17 3 process_id bit (36), 1 18 2 max_size fixed bin (18), /* maximum number of entries seg can hold */ 1 19 2 current_size fixed bin (18), /* index of last active entry */ 1 20 2 entry_count fixed bin (18), /* number of active entries */ 1 21 2 cmcs_control_hdr_filler (16) fixed bin; /* words (17-32) for later expansion */ 1 22 1 23 /* END INCLUDE FILE... cmcs_control_hdr.incl.pl1 */ 98 2 1 /* BEGIN INCLUDE FILE... cmcs_entry_dcls.incl.pl1 */ 2 2 2 3 2 4 2 5 /****^ HISTORY COMMENTS: 2 6* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8087), 2 7* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 2 8* MCR8087 cmcs_entry_dcls.incl.pl1 Shorten wait time for cmcs_station_ctl_. 2 9* END HISTORY COMMENTS */ 2 10 2 11 2 12 /* Entry declarations for the COBOL MCS runtime support package */ 2 13 2 14 /* Modified on 10/20/84 by FCH, [5.3-1] */ 2 15 /* Modified on 04/29/81 by FCH, [4.4-1] */ 2 16 /* Bob May, 6/01/77 */ 2 17 2 18 dcl cmcs_create_queues_ entry (fixed bin (35)); 2 19 2 20 dcl cmcs_date_time_ entry (fixed bin (71), char (6) unaligned, char (8) unaligned); 2 21 2 22 dcl cmcs_decode_status_ entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35)); 2 23 2 24 dcl cmcs_expand_tree_path_ entry (char (*), char (48), fixed bin (35)); 2 25 2 26 dcl cmcs_fillin_hdr_ entry (ptr, fixed bin, fixed bin, fixed bin, fixed bin (35)); 2 27 2 28 dcl cmcs_initiate_ctl_ entry (char (*), ptr, fixed bin (35)); 2 29 2 30 dcl cmcs_print_ entry (ptr, ptr, fixed bin (35), ptr, fixed bin (35)); 2 31 2 32 dcl cmcs_purge_queues_ entry (fixed bin, bit (1), fixed bin (35)); 2 33 2 34 dcl cmcs_queue_ctl_$accept_message_count entry (ptr, fixed bin, fixed bin (35)); 2 35 dcl cmcs_queue_ctl_$disable entry (ptr, fixed bin, char (10), fixed bin (35)); 2 36 dcl cmcs_queue_ctl_$enable entry (ptr, fixed bin, char (10), fixed bin (35)); 2 37 dcl cmcs_queue_ctl_$print entry (ptr, fixed bin, ptr, fixed bin (35)); 2 38 dcl cmcs_queue_ctl_$purge entry (ptr, fixed bin, fixed bin (35)); 2 39 dcl cmcs_queue_ctl_$receive entry (ptr, fixed bin, ptr, fixed bin, fixed bin (35)); 2 40 dcl cmcs_queue_ctl_$send entry (ptr, fixed bin, ptr, fixed bin, fixed bin, bit (36), fixed bin (35)); 2 41 dcl cmcs_queue_ctl_$stop_run entry (fixed bin, fixed bin (35)); 2 42 2 43 dcl cmcs_scramble_ entry (char (10)) returns (char (10)); 2 44 2 45 dcl cmcs_set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35)); /*[5.3-1]*/ 2 46 dcl cmcs_set_lock_$unlock entry (bit (36) aligned, fixed bin (35)); 2 47 2 48 dcl cmcs_station_ctl_$attach entry (char (12), fixed bin, fixed bin (35)); 2 49 dcl cmcs_station_ctl_$detach entry (fixed bin, fixed bin (35)); 2 50 dcl cmcs_station_ctl_$detach_name entry (char (12), fixed bin (35)); 2 51 dcl cmcs_station_ctl_$disable_input_terminal entry (ptr, char (10), fixed bin (35)); 2 52 dcl cmcs_station_ctl_$disable_output_terminal entry (ptr, char (10), fixed bin (35)); 2 53 dcl cmcs_station_ctl_$enable_input_terminal entry (ptr, char (10), fixed bin (35)); 2 54 dcl cmcs_station_ctl_$enable_output_terminal entry (ptr, char (10), fixed bin (35)); 2 55 dcl cmcs_station_ctl_$find_destination entry (char (12), fixed bin, ptr, fixed bin (35)); /*[4.4-1]*/ 2 56 dcl cmcs_station_ctl_$input_disabled entry (fixed bin, bit (1), fixed bin (35)); 2 57 dcl cmcs_station_ctl_$output_disabled entry (fixed bin, bit (1), fixed bin (35)); 2 58 dcl cmcs_station_ctl_$validate entry (char (12), fixed bin, fixed bin (35)); 2 59 2 60 dcl cmcs_status_list_ctl_$add entry (ptr, ptr, ptr, fixed bin, fixed bin (35)); 2 61 dcl cmcs_status_list_ctl_$delete entry (ptr, ptr, ptr, fixed bin, fixed bin (35)); 2 62 dcl cmcs_status_list_ctl_$move entry (ptr, ptr, ptr, fixed bin, fixed bin, fixed bin (35)); 2 63 2 64 dcl cmcs_terminal_ctl_$find entry (char (8), char (12), fixed bin (35)); 2 65 2 66 dcl cmcs_tree_ctl_$find_destination entry (char (12), fixed bin, ptr, fixed bin (35)); 2 67 dcl cmcs_tree_ctl_$find_index entry (fixed bin, ptr, fixed bin (35)); 2 68 dcl cmcs_tree_ctl_$find_tree_path entry (ptr, fixed bin, fixed bin, ptr, fixed bin (35)); 2 69 dcl cmcs_tree_ctl_$find_qual_name entry (char (12), fixed bin, ptr, char (52), fixed bin (35)); /*[4.4-1]*/ 2 70 2 71 dcl cmcs_wait_ctl_$add entry (char (48), fixed bin, fixed bin (35)); 2 72 dcl cmcs_wait_ctl_$delete entry (fixed bin, fixed bin (35)); 2 73 dcl cmcs_wait_ctl_$find entry (char (48), ptr, fixed bin (35)); 2 74 dcl cmcs_wait_ctl_$mp_available entry (fixed bin, fixed bin, fixed bin (35)); 2 75 dcl cmcs_wait_ctl_$mp_login entry (fixed bin, fixed bin (35)); 2 76 dcl cmcs_wait_ctl_$mp_logout entry (fixed bin, fixed bin (35)); 2 77 dcl cmcs_wait_ctl_$clear_mp entry (fixed bin (35)); 2 78 dcl cmcs_wait_ctl_$start_mp entry (fixed bin (35)); 2 79 dcl cmcs_wait_ctl_$stop_mp entry (fixed bin (35)); 2 80 2 81 /* END INCLUDE FILE... cmcs_entry_dcls.incl.pl1 */ 99 3 1 /* BEGIN INCLUDE FILE... cmcs_error_table_dcls.incl.pl1 */ 3 2 3 3 /* Bob May, 6/30/77 */ 3 4 3 5 dcl (cmcs_error_table_$ambiguous_tree_path, cmcs_error_table_$bad_call_parm, cmcs_error_table_$bad_dest, 3 6 cmcs_error_table_$bad_dest_count, cmcs_error_table_$bad_message_length, 3 7 cmcs_error_table_$bad_password, cmcs_error_table_$bad_queue_path, cmcs_error_table_$bad_slew, 3 8 3 9 cmcs_error_table_$bad_source, cmcs_error_table_$bad_station, 3 10 cmcs_error_table_$bad_term_devchn, cmcs_error_table_$bad_tree_path, 3 11 cmcs_error_table_$dest_already_disabled, cmcs_error_table_$dest_already_enabled, 3 12 3 13 cmcs_error_table_$dest_disabled, cmcs_error_table_$no_message, 3 14 cmcs_error_table_$no_partial_messages, cmcs_error_table_$null_partial_message, 3 15 cmcs_error_table_$queue_already_disabled, cmcs_error_table_$queue_already_enabled, 3 16 3 17 cmcs_error_table_$queue_disabled, cmcs_error_table_$source_already_disabled, 3 18 cmcs_error_table_$source_already_enabled, cmcs_error_table_$source_disabled) fixed bin (35) external; 3 19 3 20 /* END INCLUDE FILE... cmcs_error_table_dcls.incl.pl1 */ 100 4 1 /* BEGIN INCLUDE FILE ... cmcs_queue_ctl.incl.pl1 */ 4 2 4 3 /* This COBOL MCSD include file defines the structure of the cmcs_queue_ctl.control segment. */ 4 4 4 5 /* Bob May, 5/31/77 */ 4 6 4 7 dcl (queue_ctl_hdr_len init (0), 4 8 queue_ctl_entry_len init (48), 4 9 queue_ctl_version init (1)) fixed bin internal static options (constant); 4 10 4 11 dcl queue_ctl_ptr ptr int static; 4 12 4 13 dcl 1 queue_ctl aligned based (queue_ctl_ptr), 4 14 2 hdr like control_hdr, 4 15 2 entries (queue_ctl.current_size) like queue_ctl_entry; 4 16 4 17 dcl queue_ctl_eindex fixed bin; 4 18 4 19 dcl queue_ctl_eptr ptr; 4 20 4 21 dcl 1 queue_ctl_entry aligned based (queue_ctl_eptr), 4 22 2 lockword bit (36) aligned, 4 23 2 tree_ctl_eindex fixed bin, /* index of corresponding entry in tree_ctl */ 4 24 2 tree_path, 4 25 3 level_names (4) char (12), 4 26 2 queue_name char (32), /* includes suffix */ 4 27 2 msg_no fixed bin (35), /* always increasing, until reset manually */ 4 28 2 flags, 4 29 (3 input_disabled_sw bit (1), 4 30 3 mp_entered_sw bit (1), 4 31 3 mp_active_sw bit (1), 4 32 3 mp_sw bit (1), 4 33 3 cmd_sw bit (1), 4 34 3 filler bit (31)) unaligned, 4 35 2 filler (10) fixed bin (35), 4 36 2 mp_lockword bit (36) aligned, /* process_id of message processor */ 4 37 2 status_lists_lockword bit (36) aligned, /* only to manipulate the status lists */ 4 38 2 status_list_ctl_entries (4) like status_list_ctl_entry; /* everything belonging to this queue */ 4 39 4 40 dcl status_list_ctl_eindex fixed bin; 4 41 4 42 dcl status_list_ctl_eptr ptr; 4 43 4 44 dcl 1 status_list_ctl_entry aligned based (status_list_ctl_eptr), 4 45 2 count fixed bin, 4 46 2 descrs, 4 47 3 f_descr like vfile_descr, 4 48 3 b_descr like vfile_descr; 4 49 4 50 /* END INCLUDE FILE ... cmcs_queue_ctl.incl.pl1 */ 101 5 1 /* BEGIN INCLUDE FILE ... cmcs_tree_ctl.incl.pl1 */ 5 2 5 3 /* 5 4* This COBOL MCS include file defines the sstructure used for accessing 5 5* the MCS queue hierarchy and controlling message I/O for each entry. 5 6**/ 5 7 5 8 /* Bob May, 5/31/77 */ 5 9 5 10 dcl (tree_ctl_hdr_len init (32), 5 11 tree_ctl_entry_len init (144), /* 136, plus fudge for ptr alignments */ 5 12 tree_ctl_version init (1)) fixed bin internal static options (constant); 5 13 5 14 dcl tree_ctl_ptr ptr int static; 5 15 5 16 dcl 1 tree_ctl aligned based (tree_ctl_ptr), 5 17 2 hdr like control_hdr, 5 18 2 queue_count fixed bin, /* total of queue entries for hierarchy */ 5 19 2 filler (31) fixed bin (35), 5 20 2 entries (tree_ctl.current_size) like tree_ctl_entry; 5 21 5 22 dcl tree_ctl_eindex fixed bin; 5 23 5 24 dcl tree_ctl_eptr ptr; 5 25 5 26 dcl 1 tree_ctl_entry aligned based (tree_ctl_eptr), 5 27 2 level_info, /* len = 15 */ 5 28 3 tree_path, 5 29 4 level_names (4) char (12), 5 30 3 entry_flags, 5 31 (4 inactive_sw bit (1), 5 32 4 cmd_sw bit (1), 5 33 4 mp_sw bit (1), 5 34 /* switch separator */ 5 35 4 cobol_program_id_sw bit (1), 5 36 4 queue_sw bit (1), 5 37 4 filler bit (31)) unaligned, 5 38 3 level_no fixed bin, /* level within the hierarchy */ 5 39 3 subtree_count fixed bin, 5 40 2 static_queue_info, /* len = 9 */ 5 41 3 queue_name char (32), /* without the .cmcs_queue suffix */ 5 42 3 queue_ctl_eindex fixed bin, /* to compute addr of table entry */ 5 43 2 command_info, /* len = 75 */ 5 44 3 cmd_line_len fixed bin, 5 45 3 cmd_line char (128), 5 46 3 mp_line_len fixed bin, 5 47 3 mp_line char (128), 5 48 3 cobol_program_id_len fixed bin, 5 49 3 cobol_program_id char (32), 5 50 2 io_info, /* len = 37, sum of all level 3s */ 5 51 3 io_flags, /* len = 1 */ 5 52 (4 io_in_process_sw bit (1), 5 53 4 partial_in_process_sw bit (1), 5 54 4 rcv_wait_sw bit (1), 5 55 /* switch separator */ 5 56 4 rcv_msg_sw bit (1), /* on if user did a receive msg */ 5 57 4 rcv_seg_sw bit (1), /* on if user did a receive seg */ 5 58 4 filler bit (31)) unaligned, 5 59 3 dynamic_queue_info, /* len = 13 */ 5 60 4 switch_name char (32) unaligned, 5 61 4 queue_ctl_eptr ptr, 5 62 4 iocb_ptr ptr, 5 63 4 vfile_status fixed bin, /* 0 - not active/detached */ 5 64 /* 1 - attached, but not open */ 5 65 /* 2 - open */ 5 66 3 msg_hdr_info, /* len = 9 */ 5 67 4 msg_hdr_ptr ptr, /* ptr to base of current msg */ 5 68 4 io_type fixed bin, 5 69 4 io_subtype fixed bin, 5 70 4 seg_count fixed bin (35), /* total no of msg segments */ 5 71 4 msg_len fixed bin (35), /* total msg length (sum of all segments) */ 5 72 4 msg_descr like vfile_descr, 5 73 4 msg_key, 5 74 5 msg_no fixed bin (35), 5 75 5 seg_no fixed bin (35), 5 76 3 tseg_info, /* len = 3 */ 5 77 4 tseg_ptr ptr, /* temp seg to build segment */ 5 78 4 tseg_len fixed bin (35), 5 79 3 msg_seg_info, /* len = 6 */ 5 80 4 msg_seg_ptr ptr, /* ptr to base of current msg_seg */ 5 81 4 msg_seg_descr like vfile_descr, 5 82 4 msg_seg_len fixed bin (35), 5 83 4 msg_seg_left_index fixed bin (35), 5 84 4 msg_seg_left_len fixed bin (35), 5 85 3 buffer_info, /* len = 5 */ 5 86 4 buffer_ptr ptr, 5 87 4 buffer_len fixed bin (35), 5 88 4 buffer_left_index fixed bin (35), 5 89 4 buffer_left_len fixed bin (35); 5 90 5 91 /* END INCLUDE FILE ... cmcs_tree_ctl.incl.pl1 */ 102 6 1 /* BEGIN INCLUDE FILE ... cmcs_user_ctl.incl.pl1 */ 6 2 6 3 /* 6 4* This COBOL MCS include file defines the global, process-dependent variables that are 6 5* not part of the PD copy of cmcs_tree_ctl.control. 6 6**/ 6 7 6 8 /* Modified on 05/06/81 by FCH, [4.4-1], attach command */ 6 9 /* Bob May, 5/31/77 */ 6 10 6 11 dcl user_ctl_exists_sw bit (1) aligned int static init ("0"b); /* indicates legitimacy of external_user_ctl_ptr */ 6 12 6 13 dcl external_user_ctl_ptr ptr external; /* global ptr for user_ctl */ 6 14 6 15 dcl user_ctl_ptr ptr int static; 6 16 6 17 dcl 1 user_ctl aligned based (user_ctl_ptr), 6 18 6 19 /* Flags */ 6 20 6 21 2 init_sw, 6 22 3 terminal_ctl bit(1), 6 23 3 tree_ctl bit(1), 6 24 3 status_list_ctl bit(1), 6 25 3 station_ctl bit(1), 6 26 3 queue_ctl bit(1), 6 27 3 set_lock bit(1), 6 28 3 wait_ctl bit(1), 6 29 3 purge_queues bit(1), 6 30 3 create_queues bit(1), 6 31 3 initiate_ctl bit(1), 6 32 3 mcs bit(1), 6 33 2 flags, 6 34 (3 initialized_sw bit (1), 6 35 3 interactive_sw bit (1), 6 36 3 mp_sw bit (1), /* message processor process */ 6 37 3 terminal_sw bit (1), /* user terminal process */ 6 38 3 admin_sw bit (1), /* cobol_mcs_admin */ 6 39 3 attach_bit bit(1), /*[4.4-1]*/ 6 40 3 rec bit(1), /*[4.4-1]*/ 6 41 3 filler bit (29)) unaligned, 6 42 2 cmcs_dir char (168), 6 43 2 output_file char(168), /*[4.4-1]*/ 6 44 2 station_name char (12), /* current station */ 6 45 2 station_ctl_eindex fixed bin, /* current station */ 6 46 2 process_id bit (36), 6 47 2 process_type fixed bin, /* 0 - not defined, 1 - MP, 2 - terminal, 3 - admin */ 6 48 2 filler fixed bin (35), /* to explicitly align ptrs */ 6 49 2 control_ptrs, 6 50 3 queue_ctl_ptr ptr, 6 51 3 iocb_ptr ptr, /*[4.4-1]*/ 6 52 3 station_ctl_ptr ptr, 6 53 3 system_ctl_ptr ptr, 6 54 3 terminal_ctl_ptr ptr, 6 55 3 tree_ctl_ptr ptr, 6 56 3 wait_ctl_ptr ptr, 6 57 3 filler_ptrs (4) ptr, 6 58 2 terminal_info, 6 59 3 term_id char (4), 6 60 3 term_type fixed bin, 6 61 3 term_channel char (8), 6 62 2 last_receive_info, 6 63 3 tree_path char (48), 6 64 3 tree_ctl_eindex fixed bin, 6 65 3 tree_ctl_eptr ptr, 6 66 2 last_send_info, 6 67 3 dest_name char (12), 6 68 3 tree_ctl_eindex fixed bin, 6 69 3 tree_ctl_eptr ptr, 6 70 2 station_info, 6 71 3 station_count fixed bin, /* must be 1 for phase 1 */ 6 72 3 station_entries (2), 6 73 4 station_name char (12), 6 74 4 station_ctl_eptr ptr, 6 75 4 station_ctl_eindex fixed bin, 6 76 2 wait_info, 6 77 3 wait_ctl_eptr ptr, 6 78 3 wait_ctl_eindex fixed bin, 6 79 3 wait_ctl_mp_eindex fixed bin, /* only for message processors */ 6 80 3 wait_ctl_mp_eptr ptr, 6 81 3 ev_wait_chn fixed bin (71), /* for message processors */ 6 82 3 ev_call_chn fixed bin (71), /* for terminals, to get message responses */ 6 83 3 ev_wait_list_ptr ptr, /* for ipc_$block */ 6 84 3 ev_info_ptr ptr; /* for wakeup */ 6 85 6 86 /* END INCLUDE FILE ... cmcs_user_ctl.incl.pl1 */ 103 7 1 /* BEGIN INCLUDE FILE... cmcs_vfile_rs.incl.pl1 */ 7 2 7 3 /* This COBOL MCS include file is used to reference records by their 7 4* vfile_ descriptors. It is used mainly in the maintenance of 7 5* message status lists. */ 7 6 7 7 /* Bob May, 6/30/77 */ 7 8 7 9 dcl vfile_rs_version fixed bin int static options (constant) init (1); 7 10 7 11 dcl vfile_rs_ptr ptr; 7 12 7 13 dcl 1 vfile_rs aligned based (vfile_rs_ptr), 7 14 2 version fixed bin, /* currently must be set to 1 */ 7 15 2 flags, 7 16 (3 lock_sw bit (1), /* "1"b */ 7 17 3 unlock_sw bit (1), /* "1"b */ 7 18 3 create_sw bit (1), /* "0"b */ 7 19 /* switch separator */ 7 20 3 locate_sw bit (1), /* "0"b for current_rec, "1"b to use descriptor */ 7 21 3 filler bit (32)) unaligned, /* (32) "0"b */ 7 22 2 rec_len fixed bin (21), 7 23 2 max_rec_len fixed bin (21), 7 24 2 rec_ptr ptr, 7 25 2 descr like vfile_descr, /* process INdependent addressing */ 7 26 2 filler fixed bin; /* 0 */ 7 27 7 28 dcl 1 vfile_descr, /* process INdependent addressing */ 7 29 (2 comp_no fixed bin (17), /* component of MSF */ 7 30 2 comp_offset bit (18)) unaligned; /* offset of record in component */ 7 31 7 32 /* END INCLUDE FILE... cmcs_vfile_rs.incl.pl1 */ 104 8 1 /* BEGIN INCLUDE FILE... cmcs_wait_ctl.incl.pl1 */ 8 2 8 3 /* This include file defines the wait control structure for COBOL MCS */ 8 4 8 5 /* Bob May, 5/31/77 */ 8 6 8 7 dcl (wait_ctl_hdr_len init (32), 8 8 wait_ctl_entry_len init (32), 8 9 wait_ctl_version init (1)) fixed bin int static options (constant); 8 10 8 11 dcl wait_ctl_ptr ptr int static; 8 12 8 13 dcl 1 wait_ctl aligned based (wait_ctl_ptr), 8 14 2 hdr like control_hdr, 8 15 2 linked_lists, /* to maintain FIFO processing */ 8 16 3 used, 8 17 4 count fixed bin, 8 18 (4 findex, 8 19 4 bindex) fixed bin (18), 8 20 3 free, 8 21 4 count fixed bin, 8 22 (4 findex, 8 23 4 bindex) fixed bin (18), 8 24 2 mp_info, /* for the message processors */ 8 25 3 mp_lockword bit (36) aligned, 8 26 3 mp_current_size fixed bin, /* max of 10 */ 8 27 3 mp_active_count fixed bin, /* <= current_size */ 8 28 3 mp_entries (10) like wait_ctl_mp_entry, 8 29 2 entries (wait_ctl.current_size) like wait_ctl_entry; 8 30 8 31 dcl wait_ctl_eindex fixed bin; 8 32 8 33 dcl wait_ctl_eptr ptr; 8 34 8 35 dcl 1 wait_ctl_entry aligned based (wait_ctl_eptr), 8 36 2 linked_list_indexes, 8 37 (3 findex, 8 38 3 bindex) fixed bin (18), /* should be FB (18) unsigned */ 8 39 2 lockword bit (36) aligned, /* process that has a msg */ 8 40 2 entry_status fixed bin, /* 0 = free, 1 = used */ 8 41 2 rcv_process_id bit (36), /* process that wants a msg */ 8 42 2 rcv_tree_path, 8 43 3 level_names (4) char (12), /* from receive request */ 8 44 2 abs_tree_path, 8 45 3 level_names (4) char (12), /* full hierarchy path of queue */ 8 46 2 queue_ctl_eindex fixed bin, /* corresponds to abs_tree_path */ 8 47 2 ev_wait_chn fixed bin (71), /* set by requestor */ 8 48 2 ev_message fixed bin (71), 8 49 2 queue_name char (32), /* physical queue where it is */ 8 50 2 tree_ctl_eindex fixed bin; /* back to tree_ctl to set up I/O control */ 8 51 8 52 dcl wait_ctl_mp_eindex fixed bin; 8 53 8 54 dcl wait_ctl_mp_eptr ptr; 8 55 8 56 dcl 1 wait_ctl_mp_entry aligned based (wait_ctl_mp_eptr), 8 57 2 process_id bit (36), 8 58 2 flags, 8 59 (3 available_sw bit (1), /* ready to process another message */ 8 60 3 filler bit (35)) unaligned, 8 61 2 ev_wait_chn fixed bin (71), 8 62 2 ev_message fixed bin (71), /* (currently unused) anything in addition to ipc_ message */ 8 63 2 tree_ctl_eindex fixed bin; 8 64 8 65 /* END INCLUDE FILE... cmcs_wait_ctl.incl.pl1 */ 105 106 /* */ 107 add: 108 entry (a_tree_path, a_index, a_code); 109 110 if ^(external_user_ctl_ptr -> user_ctl.init_sw.wait_ctl) 111 then call setup; 112 113 call lock; 114 if a_code ^= 0 115 then return; 116 117 call get_free_index (a_index); 118 119 wait_ctl_eptr = addr (wait_ctl.entries (a_index)); 120 wait_ctl_entry.rcv_process_id = get_process_id_ (); 121 /* set owner info */ 122 string (wait_ctl_entry.rcv_tree_path) = a_tree_path; 123 wait_ctl_entry.ev_wait_chn = user_ctl.ev_wait_chn; 124 125 call link_index (a_index, used_flag); 126 call unlock; 127 128 if test_sw 129 then call ioa_ ("Now going to sleep."); 130 131 /* Code to go to sleep until wakeup goes here */ 132 133 call ipc_$block (user_ctl.ev_wait_list_ptr, user_ctl.ev_info_ptr, a_code); 134 135 return; 136 137 /* end of add entrypoint */ 138 139 find: 140 entry (a_tree_path, a_queue_ctl_eptr, a_code); 141 142 if ^(external_user_ctl_ptr -> user_ctl.init_sw.wait_ctl) 143 then call setup; 144 145 queue_ctl_eptr = a_queue_ctl_eptr; 146 147 call lock; 148 if a_code ^= 0 149 then return; 150 151 call find_index (new_index); 152 if a_code ^= 0 /* First check to see if COBOL program waiting */ 153 then do; 154 if a_code ^= cmcs_error_table_$no_message 155 then do; /* should never happen */ 156 call unlock; 157 return; 158 end; 159 160 /* Drop-through means that no COBOL program was waiting */ 161 162 tree_ctl_eindex = queue_ctl_entry.tree_ctl_eindex; 163 /* should we notify an mp? */ 164 tree_ctl_eptr = addr (tree_ctl.entries (tree_ctl_eindex)); 165 166 if (tree_ctl_entry.mp_sw | tree_ctl_entry.cobol_program_id_sw) 167 /* don't bother unless there is some thing to do */ 168 then if wait_ctl.mp_info.mp_active_count > 0 169 then do wait_ctl_mp_eindex = 1 to wait_ctl.mp_current_size; 170 wait_ctl_mp_eptr = addr (wait_ctl.mp_info.mp_entries (wait_ctl_mp_eindex)); 171 if wait_ctl_mp_entry.process_id ^= (36)"0"b 172 then if wait_ctl_mp_entry.available_sw 173 /* found waiting mp */ 174 then do; 175 wait_ctl_mp_entry.available_sw = "0"b; 176 wait_ctl_mp_entry.ev_message = 0; 177 /* unused for the present */ 178 wait_ctl_mp_entry.tree_ctl_eindex = queue_ctl_entry.tree_ctl_eindex; 179 call hcs_$wakeup (wait_ctl_mp_entry.process_id, 180 wait_ctl_mp_entry.ev_wait_chn, 0, code); 181 if code ^= 0 182 then call sub_err_ (code, my_name, "c", null (), sub_err_retval, 183 "Attempting to send wakeup to message processor (^w). Continuing.", 184 wait_ctl_mp_entry.process_id); 185 go to find_mp_ret; 186 end; 187 end; 188 189 /* Drop-through means no message processors available either */ 190 191 find_mp_ret: 192 call unlock; 193 a_code = 0; 194 return; 195 end; 196 197 /* Got to here, so we found a COBOL program that was waiting on a receive */ 198 199 tree_ctl_eindex, c.tree_ctl_eindex = queue_ctl_entry.tree_ctl_eindex; 200 201 tree_ctl_eptr = addr (tree_ctl.entries (tree_ctl_eindex)); 202 string (c.abs_tree_path) = string (tree_ctl_entry.tree_path); 203 c.queue_ctl_eindex = tree_ctl_entry.queue_ctl_eindex; 204 c.queue_name = tree_ctl_entry.queue_name; 205 c.ev_message = 0; 206 207 wait_ctl_eptr = addr (wait_ctl.entries (new_index)); 208 209 if test_sw 210 then do; 211 call ioa_ ("wait_ctl_$wakeup:^-^a, ^p", a_tree_path, a_queue_ctl_eptr); 212 /* DEBUG */ 213 call ioa_ ("^2-^a.", string (wait_ctl_entry.rcv_tree_path)); 214 /* DEBUG */ 215 end; 216 217 call hcs_$wakeup (wait_ctl_entry.rcv_process_id, wait_ctl_entry.ev_wait_chn, 0, a_code); 218 /* 0 says process message */ 219 if a_code ^= 0 220 then call sub_err_ (a_code, my_name, "c", null (), sub_err_retval, 221 "Attempting to send wakeup to waiting process. Continuing."); 222 call unlock; 223 224 return; 225 226 /* end of find entrypoint */ 227 228 /* */ 229 230 delete: 231 entry (a_index, a_code); 232 233 if ^(external_user_ctl_ptr -> user_ctl.init_sw.wait_ctl) 234 then call setup; 235 236 wait_ctl_eptr = addr (wait_ctl.entries (a_index)); 237 if get_process_id_ () = wait_ctl_entry.rcv_process_id 238 then do; 239 call lock; 240 if a_code ^= 0 241 then return; 242 call unlink_index (a_index, used_flag); 243 call link_index (a_index, free_flag); /* keep it for reuse */ 244 call unlock; 245 a_code = 0; 246 end; 247 else do; /* wrong index */ 248 a_code = error_table_$action_not_performed; 249 end; 250 251 return; 252 253 /* end of delete entrypoint */ 254 255 /* */ 256 link_index: 257 proc (x_index, x_free_flag); 258 259 dcl x_index fixed bin, 260 x_free_flag bit (1) aligned; 261 262 c_index = x_index; 263 c_ptr = addr (wait_ctl.entries (c_index)); 264 c.findex = 0; /* new entry always added at (logical) end */ 265 266 if x_free_flag 267 then do; /* added to free list */ 268 b_index = wait_ctl.free.bindex; 269 if b_index = 0 270 then do; /* new entry is only entry */ 271 wait_ctl.free.bindex, wait_ctl.free.findex = c_index; 272 c.bindex = 0; /* new, only entry can only point back to hdr */ 273 end; 274 else do; 275 b_ptr = addr (wait_ctl.entries (b_index)); 276 b.findex = c_index; /* make old last entry point forward to new, only one */ 277 c.bindex = b_index; /* point back to old last entry */ 278 wait_ctl.free.bindex = c_index; 279 /* now points to new, only entry */ 280 end; 281 c.entry_status = 0; /* free */ 282 wait_ctl.free.count = wait_ctl.free.count + 1; 283 end; 284 else do; /* added to used list */ 285 b_index = wait_ctl.used.bindex; 286 if b_index = 0 287 then do; /* new, only entry is only entry */ 288 wait_ctl.used.bindex, wait_ctl.used.findex = c_index; 289 c.bindex = 0; /* new, only entry can only point back to hdr */ 290 end; 291 else do; 292 b_ptr = addr (wait_ctl.entries (b_index)); 293 b.findex = c_index; /* make old last entry point forward to new one */ 294 c.bindex = b_index; /* point back to old last entry */ 295 wait_ctl.used.bindex = c_index; 296 /* now points to new last entry */ 297 end; 298 c.entry_status = 1; /* used */ 299 wait_ctl.used.count = wait_ctl.used.count + 1; 300 end; 301 302 return; 303 304 end /* link_index */; 305 306 /* */ 307 unlink_index: 308 proc (x_index, x_free_flag); 309 310 dcl x_index fixed bin, 311 x_free_flag bit (1) aligned; 312 313 c_index = x_index; 314 c_ptr = addr (wait_ctl.entries (c_index)); 315 b_index = c.bindex; 316 f_index = c.findex; 317 if b_index = 0 318 then if x_free_flag /* current is first record (logically) following hdr */ 319 then wait_ctl.free.findex = f_index; /* free list */ 320 else wait_ctl.used.findex = f_index; /* used list */ 321 else do; /* current was not the 1st record following hdr */ 322 b_ptr = addr (wait_ctl.entries (b_index)); 323 b.findex = f_index; 324 end; 325 if f_index = 0 326 then if x_free_flag /* current is last record in one list or the other */ 327 then wait_ctl.free.bindex = b_index; /* free list */ 328 else wait_ctl.used.bindex = b_index; /* used list */ 329 else do; /* current was not last entry in list */ 330 f_ptr = addr (wait_ctl.entries (f_index)); 331 f.bindex = b_index; 332 end; 333 334 if x_free_flag 335 then wait_ctl.free.count = wait_ctl.free.count - 1; 336 else wait_ctl.used.count = wait_ctl.used.count - 1; 337 338 c.findex, c.bindex = 262143; /* 777777, easy to spot unlinked entries */ 339 340 return; 341 342 end /* unlink_index */; 343 344 /* */ 345 346 find_index: 347 proc (x_index); 348 349 dcl x_index fixed bin; /* output, 0 if none found */ 350 351 dcl x_level_names (4) char (12) based (addr (a_tree_path)); 352 353 if wait_ctl.used.count = 0 354 then go to not_found; /* don't look any further */ 355 356 c_index = wait_ctl.used.findex; 357 358 359 find_index_loop: 360 if c_index = 0 /* will never happen 1st time through */ 361 then go to not_found; /* we exhausted the list without an appropriate match */ 362 363 c_ptr = addr (wait_ctl.entries (c_index)); 364 if x_level_names (1) = c.rcv_tree_path.level_names (1) 365 then do i = 2 to 4; /* there's hope, check the rest */ 366 if c.rcv_tree_path.level_names (i) = "" 367 then go to found; /* req was for higher level, which is fine */ 368 if x_level_names (i) ^= c.rcv_tree_path.level_names (i) 369 then go to find_index_continue; /* doesn't agree at higher levels, forget it */ 370 end; 371 372 find_index_continue: 373 c_index = c.findex; 374 go to find_index_loop; 375 376 found: 377 x_index = c_index; 378 a_code = 0; 379 return; 380 381 not_found: 382 x_index = 0; 383 a_code = cmcs_error_table_$no_message; 384 return; 385 386 end /* find_index */; 387 388 /* */ 389 setup: 390 proc; 391 392 if ^(external_user_ctl_ptr -> user_ctl.init_sw.wait_ctl) 393 then do; 394 395 user_ctl_ptr = external_user_ctl_ptr; /* set local variable from global */ 396 397 queue_ctl_ptr = user_ctl.queue_ctl_ptr; 398 tree_ctl_ptr = user_ctl.tree_ctl_ptr; 399 wait_ctl_ptr = user_ctl.wait_ctl_ptr; 400 401 user_ctl.init_sw.wait_ctl = "1"b; 402 end; 403 404 a_code = 0; 405 406 return; 407 408 end /* setup */; 409 410 /* */ 411 412 get_free_index: 413 proc (x_index); /* caller must link back in */ 414 415 dcl x_index fixed bin; 416 417 if wait_ctl.free.count = 0 418 then do; /* this is the easy way */ 419 x_index, wait_ctl.current_size, wait_ctl.entry_count = wait_ctl.current_size + 1; 420 end; 421 else do; 422 x_index = wait_ctl.free.findex; /* take the first one */ 423 call unlink_index (x_index, free_flag); /* let caller link it to used list */ 424 end; 425 426 return; 427 428 end /* get_free_index */; 429 430 431 /* */ 432 433 mp_login: 434 entry (a_wait_ctl_mp_eindex, a_code); 435 436 if ^(external_user_ctl_ptr -> user_ctl.init_sw.wait_ctl) 437 then call setup; 438 439 if user_ctl.ev_wait_chn = 0 | user_ctl.process_id = (36)"0"b 440 then do; 441 a_code = cmcs_error_table_$bad_call_parm; 442 mp_err: 443 a_wait_ctl_mp_eindex = -1; /* if they try to use it, we'll blow */ 444 call sub_err_ (a_code, my_name, "c", null (), sub_err_retval, 445 "Error found in message processor login control info. Returning to caller."); 446 return; 447 end; 448 449 call mp_lock; 450 if a_code ^= 0 451 then return; 452 453 /* First check to see if mp is already logged in */ 454 455 if wait_ctl.mp_current_size > 0 456 then do; 457 do i = 1 to wait_ctl.mp_current_size; 458 wait_ctl_mp_eptr = addr (wait_ctl.mp_info.mp_entries (i)); 459 if wait_ctl_mp_entry.process_id = user_ctl.process_id 460 then do; 461 call mp_unlock; 462 a_code = cmcs_error_table_$bad_call_parm; 463 go to mp_err; 464 end; 465 end; 466 467 /* So far, so good. Now, do we have any open slots already? */ 468 469 do wait_ctl_mp_eindex = 1 to wait_ctl.mp_info.mp_current_size; 470 wait_ctl_mp_eptr = addr (wait_ctl.mp_info.mp_entries (wait_ctl_mp_eindex)); 471 if wait_ctl_mp_entry.process_id = (36)"0"b 472 then do; 473 set_mp_info: 474 string (wait_ctl_mp_entry.flags) = (36)"0"b; 475 wait_ctl_mp_entry.ev_wait_chn = user_ctl.ev_wait_chn; 476 wait_ctl_mp_entry.process_id = user_ctl.process_id; 477 wait_ctl.mp_info.mp_active_count = wait_ctl.mp_info.mp_active_count + 1; 478 a_wait_ctl_mp_eindex = wait_ctl_mp_eindex; 479 /* all future calls will use this index */ 480 call mp_unlock; 481 a_code = 0; 482 return; 483 end; 484 end; 485 end; 486 487 /* Got to here, so we must increase the current size of the table for the new entry */ 488 489 if wait_ctl.mp_info.mp_current_size < 10 490 then do; 491 wait_ctl_mp_eindex, wait_ctl.mp_info.mp_current_size = wait_ctl.mp_info.mp_current_size + 1; 492 wait_ctl_mp_eptr = addr (wait_ctl.mp_info.mp_entries (wait_ctl_mp_eindex)); 493 go to set_mp_info; 494 end; 495 496 else do; /* already have 10 message processors */ 497 a_code = error_table_$action_not_performed; 498 go to mp_err; 499 end; 500 501 /* end of mp_login entrypoint */ 502 503 /* */ 504 505 mp_available: 506 entry (a_wait_ctl_mp_eindex, a_tree_ctl_eindex, a_code); 507 508 if ^(external_user_ctl_ptr -> user_ctl.init_sw.wait_ctl) 509 then call setup; 510 511 /* No need to use mp_lock because entry is ignored until we set the available_sw true */ 512 513 wait_ctl_mp_eptr = addr (wait_ctl.mp_info.mp_entries (a_wait_ctl_mp_eindex)); 514 wait_ctl_mp_entry.available_sw = "1"b; 515 516 call ipc_$block (user_ctl.ev_wait_list_ptr, user_ctl.ev_info_ptr, a_code); 517 return; 518 519 /* end of mp_available entrypoint */ 520 521 /* */ 522 523 mp_logout: 524 entry (a_wait_ctl_mp_eindex, a_code); 525 526 if ^(external_user_ctl_ptr -> user_ctl.init_sw.wait_ctl) 527 then call setup; 528 529 wait_ctl_mp_eindex = a_wait_ctl_mp_eindex; 530 wait_ctl_mp_eptr = addr (wait_ctl.mp_info.mp_entries (wait_ctl_mp_eindex)); 531 532 call mp_lock; 533 if a_code ^= 0 534 then return; 535 536 wait_ctl_mp_entry.process_id = (36)"0"b; 537 wait_ctl_mp_entry.ev_wait_chn = 0; 538 string (wait_ctl_mp_entry.flags) = (36)"0"b; 539 if wait_ctl.mp_info.mp_active_count ^= 0 540 then wait_ctl.mp_info.mp_active_count = wait_ctl.mp_info.mp_active_count - 1; 541 542 if wait_ctl_mp_eindex = wait_ctl.mp_info.mp_current_size 543 then wait_ctl.mp_info.mp_current_size = wait_ctl.mp_info.mp_current_size - 1; 544 545 call mp_unlock; 546 a_code = 0; 547 return; 548 549 /* end of mp_logout entrypoint */ 550 551 /* */ 552 553 clear_mp: 554 entry (a_code); 555 556 /* Used to force a reset to zero of the message processor control information. 557* This is necessary in case of a crash with active message processors. */ 558 559 /*[5.3-1]*/ 560 call cmcs_set_lock_$lock (wait_ctl.hdr.lockword, 0, a_code); 561 if a_code ^= 0 562 then do; 563 call sub_err_ (a_code, my_name, "c", null (), sub_err_retval, 564 "Attempting to set lock in preparation for clear_mp request. Returning to request level."); 565 return; 566 end; 567 568 if wait_ctl.mp_info.mp_active_count > 0 569 then call sub_err_ (0, my_name, "c", null (), sub_err_retval, 570 "Active message processor count reset from ^d to 0.", wait_ctl.mp_info.mp_active_count); 571 572 do i = 1 to 10; 573 wait_ctl_mp_eptr = addr (wait_ctl.mp_info.mp_entries (i)); 574 wait_ctl_mp_entry.process_id = (36)"0"b; 575 string (wait_ctl_mp_entry.flags) = (36)"0"b; 576 end; 577 wait_ctl.mp_info.mp_active_count, wait_ctl.mp_info.mp_current_size = 0; 578 call cmcs_set_lock_$unlock (wait_ctl.mp_info.mp_lockword, a_code); 579 /* ignore status */ 580 581 a_code = 0; 582 return; 583 584 /* end of clear_mp entrypoint */ 585 586 /* */ 587 588 start_mp: 589 entry (a_code); 590 591 /* Used to wakeup message processors explicitly because the queues are already non-empty. 592* The message processors must already be logged in and available. */ 593 594 do queue_ctl_eindex = 1 to queue_ctl.current_size; 595 queue_ctl_eptr = addr (queue_ctl.entries (queue_ctl_eindex)); 596 if queue_ctl_entry.status_list_ctl_entries (2).count > 0 597 then do; /* messages waiting to be processed */ 598 tree_ctl_eindex = queue_ctl_entry.tree_ctl_eindex; 599 tree_ctl_eptr = addr (tree_ctl.entries (tree_ctl_eindex)); 600 /* needed for getting short queue name in case of trouble */ 601 call start_next_mp; 602 if a_code ^= 0 603 then return; 604 end; 605 end; 606 607 return; 608 609 /* end of start_mp entrypoint */ 610 611 /* */ 612 613 stop_mp: 614 entry (a_code); 615 616 if ^(external_user_ctl_ptr -> user_ctl.init_sw.wait_ctl) 617 then call setup; 618 619 call mp_lock; 620 if a_code ^= 0 621 then return; 622 623 /* Send a wakeup with a message of 1 to all mps. All will get this either immediately or the next time they go blocked */ 624 625 if wait_ctl.mp_info.mp_active_count > 0 626 then do wait_ctl_mp_eindex = 1 to wait_ctl.mp_info.mp_current_size; 627 wait_ctl_mp_eptr = addr (wait_ctl.mp_info.mp_entries (wait_ctl_mp_eindex)); 628 if wait_ctl_mp_entry.process_id ^= (36)"0"b 629 then do; 630 call hcs_$wakeup (wait_ctl_mp_entry.process_id, wait_ctl_mp_entry.ev_wait_chn, 1, a_code); 631 /* 1 says to logout */ 632 if a_code ^= 0 633 then call sub_err_ (code, my_name, "c", null (), sub_err_retval, 634 "Attempting to send wakeup to tell process (^b) to log out. Continuing.", 635 wait_ctl_mp_entry.process_id); 636 end; 637 end; 638 call mp_unlock; 639 a_code = 0; 640 return; 641 642 /* end of stop_mp entrypoint */ 643 644 /* */ 645 646 start_next_mp: 647 proc (); 648 649 /* Finds the next available message processor and sends it a wakeup. It will complain if none are available, 650* rather than sending multiple wakeups to a single process. */ 651 652 dcl old_wait_ctl_mp_eindex 653 fixed bin int static init (0);/* To make sure we don't just continue looping */ 654 655 if old_wait_ctl_mp_eindex = 0 656 then wait_ctl_mp_eindex, old_wait_ctl_mp_eindex = 1; 657 /* first time through, initialize */ 658 659 do i = 1 to wait_ctl.mp_info.mp_current_size; 660 wait_ctl_mp_eindex = wait_ctl_mp_eindex + 1; 661 if wait_ctl_mp_eindex > wait_ctl.mp_info.mp_current_size 662 then wait_ctl_mp_eindex = 1; /* don't overflow the table entries */ 663 if wait_ctl_mp_eindex = old_wait_ctl_mp_eindex 664 then do; /* didn't finnd an available mp */ 665 a_code = error_table_$action_not_performed; 666 call sub_err_ (a_code, my_name, "c", null (), sub_err_retval, 667 "Couldn't find an available message processor to start for ^a.", tree_ctl_entry.queue_name); 668 /* without the suffix */ 669 return; 670 end; 671 672 wait_ctl_mp_eptr = addr (wait_ctl.mp_info.mp_entries (wait_ctl_mp_eindex)); 673 if wait_ctl_mp_entry.process_id ^= (36)"0"b 674 then if wait_ctl_mp_entry.available_sw 675 then do; 676 call hcs_$wakeup (wait_ctl_mp_entry.process_id, wait_ctl_mp_entry.ev_wait_chn, 0, a_code); 677 if a_code ^= 0 678 then do; 679 call sub_err_ (a_code, my_name, "c", null (), sub_err_retval, 680 "Attempting to send wakeup to message processor for queue ^a.", 681 tree_ctl_entry.queue_name); 682 return; 683 end; 684 else do; 685 wait_ctl_mp_entry.available_sw = "0"b; 686 /* now this one is busy */ 687 call sub_err_ (0, my_name, "c", null (), sub_err_retval, 688 "Started message processor for queue ^a.", tree_ctl_entry.queue_name); 689 end; 690 end; 691 end; 692 693 a_code = 0; 694 return; 695 696 end /* start_next_mp */; 697 698 /* */ 699 700 test: 701 entry; 702 703 test_sw = "0"b; 704 return; 705 706 /* end of test entrypoint */ 707 708 /* */ 709 710 lock: 711 proc; 712 713 /*[5.3-1]*/ 714 call cmcs_set_lock_$lock (wait_ctl.hdr.lockword, 0, a_code); 715 if a_code ^= 0 716 then call sub_err_ (a_code, my_name, "c", null (), sub_err_retval, "Attempting to lock wait control."); 717 return; 718 719 end /* lock */; 720 721 /* */ 722 723 mp_lock: 724 proc; 725 726 /*[5.3-1]*/ 727 call cmcs_set_lock_$lock (wait_ctl.mp_lockword, 0, a_code); 728 if a_code ^= 0 729 then call sub_err_ (a_code, my_name, "c", null (), sub_err_retval, 730 "Attempting to lock message processor wait control."); 731 return; 732 733 end /* mp_lock */; 734 735 /* */ 736 737 unlock: 738 proc; 739 740 call cmcs_set_lock_$unlock (wait_ctl.hdr.lockword, a_code); 741 if a_code ^= 0 742 then call sub_err_ (a_code, my_name, "c", null (), sub_err_retval, "Attempting to unlock wait control."); 743 return; 744 745 end /* unlock */; 746 747 /* */ 748 749 mp_unlock: 750 proc; 751 752 call cmcs_set_lock_$unlock (wait_ctl.mp_lockword, a_code); 753 if a_code ^= 0 754 then call sub_err_ (a_code, my_name, "c", null (), sub_err_retval, 755 "Attempting to unlock message processor wait control."); 756 return; 757 758 end /* mp_unlock */; 759 760 end /* cmcs_wait_ctl_ */; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0834.1 cmcs_wait_ctl_.pl1 >spec>install>MR12.3-1048>cmcs_wait_ctl_.pl1 98 1 03/27/82 0439.5 cmcs_control_hdr.incl.pl1 >ldd>include>cmcs_control_hdr.incl.pl1 99 2 05/24/89 0811.5 cmcs_entry_dcls.incl.pl1 >spec>install>MR12.3-1048>cmcs_entry_dcls.incl.pl1 100 3 03/27/82 0439.5 cmcs_error_table_dcls.incl.pl1 >ldd>include>cmcs_error_table_dcls.incl.pl1 101 4 03/27/82 0439.5 cmcs_queue_ctl.incl.pl1 >ldd>include>cmcs_queue_ctl.incl.pl1 102 5 03/27/82 0439.6 cmcs_tree_ctl.incl.pl1 >ldd>include>cmcs_tree_ctl.incl.pl1 103 6 03/27/82 0431.5 cmcs_user_ctl.incl.pl1 >ldd>include>cmcs_user_ctl.incl.pl1 104 7 03/27/82 0439.6 cmcs_vfile_rs.incl.pl1 >ldd>include>cmcs_vfile_rs.incl.pl1 105 8 03/27/82 0439.6 cmcs_wait_ctl.incl.pl1 >ldd>include>cmcs_wait_ctl.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. a_code parameter fixed bin(35,0) dcl 50 set ref 107 114 133* 139 148 152 154 193* 217* 219 219* 230 240 245* 248* 378* 383* 404* 433 441* 444* 450 462* 481* 497* 505 516* 523 533 546* 553 560* 561 563* 578* 581* 588 602 613 620 630* 632 639* 665* 666* 676* 677 679* 693* 714* 715 715* 727* 728 728* 740* 741 741* 752* 753 753* a_index parameter fixed bin(17,0) dcl 50 set ref 107 117* 119 125* 230 236 242* 243* a_queue_ctl_eptr parameter pointer dcl 50 set ref 139 145 211* a_tree_ctl_eindex parameter fixed bin(17,0) dcl 50 ref 505 a_tree_path parameter char(48) packed unaligned dcl 50 set ref 107 122 139 211* 364 368 a_wait_ctl_mp_eindex parameter fixed bin(17,0) dcl 50 set ref 433 442* 478* 505 513 523 529 abs_tree_path 21 based structure level 2 packed packed unaligned dcl 60 set ref 202* addr builtin function dcl 94 ref 119 164 170 201 207 236 263 275 292 314 322 330 363 364 368 458 470 492 513 530 573 595 599 627 672 available_sw 1 based bit(1) level 3 packed packed unaligned dcl 8-56 set ref 171 175* 514* 673 685* b based structure level 1 unaligned dcl 60 b_index 000111 automatic fixed bin(17,0) dcl 60 set ref 268* 269 275 277 285* 286 292 294 315* 317 322 325 328 331 b_ptr 000104 automatic pointer dcl 60 set ref 275* 276 292* 293 322* 323 bindex 42 based fixed bin(18,0) level 4 in structure "wait_ctl" dcl 8-13 in procedure "cmcs_wait_ctl_" set ref 285 288* 295* 328* bindex 1 based fixed bin(18,0) level 3 in structure "c" dcl 60 in procedure "cmcs_wait_ctl_" set ref 272* 277* 289* 294* 315 338* bindex 1 based fixed bin(18,0) level 3 in structure "f" dcl 60 in procedure "cmcs_wait_ctl_" set ref 331* bindex 45 based fixed bin(18,0) level 4 in structure "wait_ctl" dcl 8-13 in procedure "cmcs_wait_ctl_" set ref 268 271* 278* 325* c based structure level 1 unaligned dcl 60 c_index 000110 automatic fixed bin(17,0) dcl 60 set ref 262* 263 271 276 278 288 293 295 313* 314 356* 359 363 372* 376 c_ptr 000102 automatic pointer dcl 60 set ref 199 202 203 204 205 263* 264 272 277 281 289 294 298 314* 315 316 338 338 363* 364 366 368 372 cmcs_error_table_$bad_call_parm 000050 external static fixed bin(35,0) dcl 3-5 ref 441 462 cmcs_error_table_$no_message 000052 external static fixed bin(35,0) dcl 3-5 ref 154 383 cmcs_set_lock_$lock 000044 constant entry external dcl 2-45 ref 560 714 727 cmcs_set_lock_$unlock 000046 constant entry external dcl 2-46 ref 578 740 752 cobol_program_id_sw 14(03) based bit(1) level 4 packed packed unaligned dcl 5-26 ref 166 code 000115 automatic fixed bin(35,0) dcl 74 set ref 179* 181 181* 632* control_hdr based structure level 1 dcl 1-11 control_ptrs 150 based structure level 2 dcl 6-17 count 40 based fixed bin(17,0) level 4 in structure "wait_ctl" dcl 8-13 in procedure "cmcs_wait_ctl_" set ref 299* 299 336* 336 353 count 43 based fixed bin(17,0) level 4 in structure "wait_ctl" dcl 8-13 in procedure "cmcs_wait_ctl_" set ref 282* 282 334* 334 417 count 44 based fixed bin(17,0) array level 3 in structure "queue_ctl_entry" dcl 4-21 in procedure "cmcs_wait_ctl_" ref 596 current_size 16 based fixed bin(18,0) level 3 in structure "queue_ctl" dcl 4-13 in procedure "cmcs_wait_ctl_" ref 594 current_size 16 based fixed bin(18,0) level 3 in structure "wait_ctl" dcl 8-13 in procedure "cmcs_wait_ctl_" set ref 419 419* entries 172 based structure array level 2 in structure "wait_ctl" dcl 8-13 in procedure "cmcs_wait_ctl_" set ref 119 207 236 263 275 292 314 322 330 363 entries 40 based structure array level 2 in structure "queue_ctl" dcl 4-13 in procedure "cmcs_wait_ctl_" set ref 595 entries 100 based structure array level 2 in structure "tree_ctl" dcl 5-16 in procedure "cmcs_wait_ctl_" set ref 164 201 599 entry_count 17 based fixed bin(18,0) level 3 dcl 8-13 set ref 419* entry_flags 14 based structure level 3 dcl 5-26 entry_status 3 based fixed bin(17,0) level 2 dcl 60 set ref 281* 298* error_table_$action_not_performed 000042 external static fixed bin(35,0) dcl 91 ref 248 497 665 ev_info_ptr 266 based pointer level 3 dcl 6-17 set ref 133* 516* ev_message 40 based fixed bin(71,0) level 2 in structure "c" dcl 60 in procedure "cmcs_wait_ctl_" set ref 205* ev_message 4 based fixed bin(71,0) level 2 in structure "wait_ctl_mp_entry" dcl 8-56 in procedure "cmcs_wait_ctl_" set ref 176* ev_wait_chn 36 based fixed bin(71,0) level 2 in structure "wait_ctl_entry" dcl 8-35 in procedure "cmcs_wait_ctl_" set ref 123* 217* ev_wait_chn 260 based fixed bin(71,0) level 3 in structure "user_ctl" dcl 6-17 in procedure "cmcs_wait_ctl_" ref 123 439 475 ev_wait_chn 2 based fixed bin(71,0) level 2 in structure "wait_ctl_mp_entry" dcl 8-56 in procedure "cmcs_wait_ctl_" set ref 179* 475* 537* 630* 676* ev_wait_list_ptr 264 based pointer level 3 dcl 6-17 set ref 133* 516* external_user_ctl_ptr 000054 external static pointer dcl 6-13 ref 110 142 233 392 395 436 508 526 616 f based structure level 1 unaligned dcl 60 f_index 000112 automatic fixed bin(17,0) dcl 60 set ref 316* 317 320 323 325 330 f_ptr 000106 automatic pointer dcl 60 set ref 330* 331 findex 41 based fixed bin(18,0) level 4 in structure "wait_ctl" dcl 8-13 in procedure "cmcs_wait_ctl_" set ref 288* 320* 356 findex 44 based fixed bin(18,0) level 4 in structure "wait_ctl" dcl 8-13 in procedure "cmcs_wait_ctl_" set ref 271* 317* 422 findex based fixed bin(18,0) level 3 in structure "b" dcl 60 in procedure "cmcs_wait_ctl_" set ref 276* 293* 323* findex based fixed bin(18,0) level 3 in structure "c" dcl 60 in procedure "cmcs_wait_ctl_" set ref 264* 316 338* 372 flags 1 based structure level 2 dcl 8-56 set ref 473* 538* 575* free 43 based structure level 3 dcl 8-13 free_flag 000013 constant bit(1) initial dcl 80 set ref 243* 423* get_process_id_ 000034 constant entry external dcl 85 ref 120 237 hcs_$wakeup 000036 constant entry external dcl 87 ref 179 217 630 676 hdr based structure level 2 in structure "wait_ctl" dcl 8-13 in procedure "cmcs_wait_ctl_" hdr based structure level 2 in structure "queue_ctl" dcl 4-13 in procedure "cmcs_wait_ctl_" i 000113 automatic fixed bin(17,0) dcl 71 set ref 364* 366 368 368* 457* 458* 572* 573* 659* init_sw based structure level 2 dcl 6-17 ioa_ 000032 constant entry external dcl 44 ref 128 211 213 ipc_$block 000040 constant entry external dcl 87 ref 133 516 level_info based structure level 2 dcl 5-26 level_names 5 based char(12) array level 3 packed packed unaligned dcl 60 ref 364 366 368 linked_list_indexes based structure level 2 in structure "c" unaligned dcl 60 in procedure "cmcs_wait_ctl_" linked_list_indexes based structure level 2 in structure "f" unaligned dcl 60 in procedure "cmcs_wait_ctl_" linked_list_indexes based structure level 2 in structure "b" unaligned dcl 60 in procedure "cmcs_wait_ctl_" linked_lists 40 based structure level 2 dcl 8-13 lockword based bit(36) level 3 dcl 8-13 set ref 560* 714* 740* mp_active_count 50 based fixed bin(17,0) level 3 dcl 8-13 set ref 166 477* 477 539 539* 539 568 568* 577* 625 mp_current_size 47 based fixed bin(17,0) level 3 dcl 8-13 set ref 166 455 457 469 489 491 491* 542 542* 542 577* 625 659 661 mp_entries 52 based structure array level 3 dcl 8-13 set ref 170 458 470 492 513 530 573 627 672 mp_info 46 based structure level 2 dcl 8-13 mp_lockword 46 based bit(36) level 3 dcl 8-13 set ref 578* 727* 752* mp_sw 14(02) based bit(1) level 4 packed packed unaligned dcl 5-26 ref 166 my_name 000010 internal static char(14) initial packed unaligned dcl 76 set ref 181* 219* 444* 563* 568* 632* 666* 679* 687* 715* 728* 741* 753* new_index 000114 automatic fixed bin(17,0) dcl 71 set ref 151* 207 null builtin function dcl 94 ref 181 181 219 219 444 444 563 563 568 568 632 632 666 666 679 679 687 687 715 715 728 728 741 741 753 753 old_wait_ctl_mp_eindex 000026 internal static fixed bin(17,0) initial dcl 652 set ref 655 655* 663 process_id based bit(36) level 2 in structure "wait_ctl_mp_entry" dcl 8-56 in procedure "cmcs_wait_ctl_" set ref 171 179* 181* 459 471 476* 536* 574* 628 630* 632* 673 676* process_id 144 based bit(36) level 2 in structure "user_ctl" dcl 6-17 in procedure "cmcs_wait_ctl_" ref 439 459 476 queue_ctl based structure level 1 dcl 4-13 queue_ctl_eindex 35 based fixed bin(17,0) level 2 in structure "c" dcl 60 in procedure "cmcs_wait_ctl_" set ref 203* queue_ctl_eindex 000116 automatic fixed bin(17,0) dcl 4-17 in procedure "cmcs_wait_ctl_" set ref 594* 595* queue_ctl_eindex 27 based fixed bin(17,0) level 3 in structure "tree_ctl_entry" dcl 5-26 in procedure "cmcs_wait_ctl_" ref 203 queue_ctl_entry based structure level 1 dcl 4-21 queue_ctl_eptr 000120 automatic pointer dcl 4-19 set ref 145* 162 178 199 595* 596 598 queue_ctl_ptr 000016 internal static pointer dcl 4-11 in procedure "cmcs_wait_ctl_" set ref 397* 594 595 queue_ctl_ptr 150 based pointer level 3 in structure "user_ctl" dcl 6-17 in procedure "cmcs_wait_ctl_" ref 397 queue_name 42 based char(32) level 2 in structure "c" packed packed unaligned dcl 60 in procedure "cmcs_wait_ctl_" set ref 204* queue_name 17 based char(32) level 3 in structure "tree_ctl_entry" dcl 5-26 in procedure "cmcs_wait_ctl_" set ref 204 666* 679* 687* rcv_process_id 4 based bit(36) level 2 dcl 8-35 set ref 120* 217* 237 rcv_tree_path 5 based structure level 2 in structure "c" packed packed unaligned dcl 60 in procedure "cmcs_wait_ctl_" rcv_tree_path 5 based structure level 2 in structure "wait_ctl_entry" dcl 8-35 in procedure "cmcs_wait_ctl_" set ref 122* 213 213 static_queue_info 17 based structure level 2 dcl 5-26 status_list_ctl_entries 44 based structure array level 2 dcl 4-21 status_list_ctl_entry based structure level 1 dcl 4-44 string builtin function dcl 94 set ref 122* 202* 202 213 213 473* 538* 575* sub_err_ 000030 constant entry external dcl 44 ref 181 219 444 563 568 632 666 679 687 715 728 741 753 sub_err_retval 000100 automatic fixed bin(35,0) dcl 46 set ref 181* 219* 444* 563* 568* 632* 666* 679* 687* 715* 728* 741* 753* test_sw 000014 internal static bit(1) initial packed unaligned dcl 78 set ref 128 209 703* tree_ctl based structure level 1 dcl 5-16 tree_ctl_eindex 52 based fixed bin(17,0) level 2 in structure "c" dcl 60 in procedure "cmcs_wait_ctl_" set ref 199* tree_ctl_eindex 000122 automatic fixed bin(17,0) dcl 5-22 in procedure "cmcs_wait_ctl_" set ref 162* 164 199* 201 598* 599 tree_ctl_eindex 6 based fixed bin(17,0) level 2 in structure "wait_ctl_mp_entry" dcl 8-56 in procedure "cmcs_wait_ctl_" set ref 178* tree_ctl_eindex 1 based fixed bin(17,0) level 2 in structure "queue_ctl_entry" dcl 4-21 in procedure "cmcs_wait_ctl_" ref 162 178 199 598 tree_ctl_entry based structure level 1 dcl 5-26 tree_ctl_eptr 000124 automatic pointer dcl 5-24 set ref 164* 166 166 201* 202 203 204 599* 666 679 687 tree_ctl_ptr 000020 internal static pointer dcl 5-14 in procedure "cmcs_wait_ctl_" set ref 164 201 398* 599 tree_ctl_ptr 162 based pointer level 3 in structure "user_ctl" dcl 6-17 in procedure "cmcs_wait_ctl_" ref 398 tree_path based structure level 3 dcl 5-26 ref 202 used 40 based structure level 3 dcl 8-13 used_flag 000025 constant bit(1) initial dcl 80 set ref 125* 242* user_ctl based structure level 1 dcl 6-17 user_ctl_ptr 000022 internal static pointer dcl 6-15 set ref 123 133 133 395* 397 398 399 401 439 439 459 475 476 516 516 vfile_descr 000126 automatic structure level 1 packed packed unaligned dcl 7-28 wait_ctl 6 based bit(1) level 3 in structure "user_ctl" dcl 6-17 in procedure "cmcs_wait_ctl_" set ref 110 142 233 392 401* 436 508 526 616 wait_ctl based structure level 1 dcl 8-13 in procedure "cmcs_wait_ctl_" wait_ctl_entry based structure level 1 dcl 8-35 wait_ctl_eptr 000130 automatic pointer dcl 8-33 set ref 119* 120 122 123 207* 213 213 217 217 236* 237 wait_ctl_mp_eindex 000132 automatic fixed bin(17,0) dcl 8-52 set ref 166* 170* 469* 470 478* 491* 492 529* 530 542 625* 627* 655* 660* 660 661 661* 663 672 wait_ctl_mp_entry based structure level 1 dcl 8-56 wait_ctl_mp_eptr 000134 automatic pointer dcl 8-54 set ref 170* 171 171 175 176 178 179 179 181 458* 459 470* 471 473 475 476 492* 513* 514 530* 536 537 538 573* 574 575 627* 628 630 630 632 672* 673 673 676 676 685 wait_ctl_ptr 164 based pointer level 3 in structure "user_ctl" dcl 6-17 in procedure "cmcs_wait_ctl_" ref 399 wait_ctl_ptr 000024 internal static pointer dcl 8-11 in procedure "cmcs_wait_ctl_" set ref 119 166 166 170 207 236 263 268 271 271 275 278 282 282 285 288 288 292 295 299 299 314 317 320 322 325 328 330 334 334 336 336 353 356 363 399* 417 419 419 419 422 455 457 458 469 470 477 477 489 491 491 492 513 530 539 539 539 542 542 542 560 568 568 573 577 577 578 625 625 627 659 661 672 714 727 740 752 wait_info 252 based structure level 2 dcl 6-17 x_free_flag parameter bit(1) dcl 310 in procedure "unlink_index" ref 307 317 325 334 x_free_flag parameter bit(1) dcl 259 in procedure "link_index" ref 256 266 x_index parameter fixed bin(17,0) dcl 259 in procedure "link_index" ref 256 262 x_index parameter fixed bin(17,0) dcl 349 in procedure "find_index" set ref 346 376* 381* x_index parameter fixed bin(17,0) dcl 415 in procedure "get_free_index" set ref 412 419* 422* 423* x_index parameter fixed bin(17,0) dcl 310 in procedure "unlink_index" ref 307 313 x_level_names based char(12) array packed unaligned dcl 351 ref 364 368 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. cmcs_create_queues_ 000000 constant entry external dcl 2-18 cmcs_date_time_ 000000 constant entry external dcl 2-20 cmcs_decode_status_ 000000 constant entry external dcl 2-22 cmcs_error_table_$ambiguous_tree_path external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$bad_dest external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$bad_dest_count external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$bad_message_length external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$bad_password external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$bad_queue_path external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$bad_slew external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$bad_source external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$bad_station external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$bad_term_devchn external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$bad_tree_path external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$dest_already_disabled external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$dest_already_enabled external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$dest_disabled external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$no_partial_messages external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$null_partial_message external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$queue_already_disabled external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$queue_already_enabled external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$queue_disabled external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$source_already_disabled external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$source_already_enabled external static fixed bin(35,0) dcl 3-5 cmcs_error_table_$source_disabled external static fixed bin(35,0) dcl 3-5 cmcs_expand_tree_path_ 000000 constant entry external dcl 2-24 cmcs_fillin_hdr_ 000000 constant entry external dcl 2-26 cmcs_initiate_ctl_ 000000 constant entry external dcl 2-28 cmcs_print_ 000000 constant entry external dcl 2-30 cmcs_purge_queues_ 000000 constant entry external dcl 2-32 cmcs_queue_ctl_$accept_message_count 000000 constant entry external dcl 2-34 cmcs_queue_ctl_$disable 000000 constant entry external dcl 2-35 cmcs_queue_ctl_$enable 000000 constant entry external dcl 2-36 cmcs_queue_ctl_$print 000000 constant entry external dcl 2-37 cmcs_queue_ctl_$purge 000000 constant entry external dcl 2-38 cmcs_queue_ctl_$receive 000000 constant entry external dcl 2-39 cmcs_queue_ctl_$send 000000 constant entry external dcl 2-40 cmcs_queue_ctl_$stop_run 000000 constant entry external dcl 2-41 cmcs_scramble_ 000000 constant entry external dcl 2-43 cmcs_station_ctl_$attach 000000 constant entry external dcl 2-48 cmcs_station_ctl_$detach 000000 constant entry external dcl 2-49 cmcs_station_ctl_$detach_name 000000 constant entry external dcl 2-50 cmcs_station_ctl_$disable_input_terminal 000000 constant entry external dcl 2-51 cmcs_station_ctl_$disable_output_terminal 000000 constant entry external dcl 2-52 cmcs_station_ctl_$enable_input_terminal 000000 constant entry external dcl 2-53 cmcs_station_ctl_$enable_output_terminal 000000 constant entry external dcl 2-54 cmcs_station_ctl_$find_destination 000000 constant entry external dcl 2-55 cmcs_station_ctl_$input_disabled 000000 constant entry external dcl 2-56 cmcs_station_ctl_$output_disabled 000000 constant entry external dcl 2-57 cmcs_station_ctl_$validate 000000 constant entry external dcl 2-58 cmcs_status_list_ctl_$add 000000 constant entry external dcl 2-60 cmcs_status_list_ctl_$delete 000000 constant entry external dcl 2-61 cmcs_status_list_ctl_$move 000000 constant entry external dcl 2-62 cmcs_terminal_ctl_$find 000000 constant entry external dcl 2-64 cmcs_tree_ctl_$find_destination 000000 constant entry external dcl 2-66 cmcs_tree_ctl_$find_index 000000 constant entry external dcl 2-67 cmcs_tree_ctl_$find_qual_name 000000 constant entry external dcl 2-69 cmcs_tree_ctl_$find_tree_path 000000 constant entry external dcl 2-68 cmcs_wait_ctl_$add 000000 constant entry external dcl 2-71 cmcs_wait_ctl_$clear_mp 000000 constant entry external dcl 2-77 cmcs_wait_ctl_$delete 000000 constant entry external dcl 2-72 cmcs_wait_ctl_$find 000000 constant entry external dcl 2-73 cmcs_wait_ctl_$mp_available 000000 constant entry external dcl 2-74 cmcs_wait_ctl_$mp_login 000000 constant entry external dcl 2-75 cmcs_wait_ctl_$mp_logout 000000 constant entry external dcl 2-76 cmcs_wait_ctl_$start_mp 000000 constant entry external dcl 2-78 cmcs_wait_ctl_$stop_mp 000000 constant entry external dcl 2-79 control_hdr_len internal static fixed bin(17,0) initial dcl 1-7 control_hdr_ptr automatic pointer dcl 1-9 ipc_$create_ev_chn 000000 constant entry external dcl 87 queue_ctl_entry_len internal static fixed bin(17,0) initial dcl 4-7 queue_ctl_hdr_len internal static fixed bin(17,0) initial dcl 4-7 queue_ctl_version internal static fixed bin(17,0) initial dcl 4-7 status_list_ctl_eindex automatic fixed bin(17,0) dcl 4-40 status_list_ctl_eptr automatic pointer dcl 4-42 tree_ctl_entry_len internal static fixed bin(17,0) initial dcl 5-10 tree_ctl_hdr_len internal static fixed bin(17,0) initial dcl 5-10 tree_ctl_version internal static fixed bin(17,0) initial dcl 5-10 user_ctl_exists_sw internal static bit(1) initial dcl 6-11 vfile_rs based structure level 1 dcl 7-13 vfile_rs_ptr automatic pointer dcl 7-11 vfile_rs_version internal static fixed bin(17,0) initial dcl 7-9 wait_ctl_eindex automatic fixed bin(17,0) dcl 8-31 wait_ctl_entry_len internal static fixed bin(17,0) initial dcl 8-7 wait_ctl_hdr_len internal static fixed bin(17,0) initial dcl 8-7 wait_ctl_version internal static fixed bin(17,0) initial dcl 8-7 NAMES DECLARED BY EXPLICIT CONTEXT. add 000366 constant entry external dcl 107 clear_mp 001557 constant entry external dcl 553 cmcs_wait_ctl_ 000354 constant entry external dcl 26 delete 001116 constant entry external dcl 230 find 000520 constant entry external dcl 139 find_index 002373 constant entry internal dcl 346 ref 151 find_index_continue 002446 constant label dcl 372 ref 368 find_index_loop 002403 constant label dcl 359 ref 374 find_mp_ret 000716 constant label dcl 191 ref 185 found 002451 constant label dcl 376 ref 366 get_free_index 002511 constant entry internal dcl 412 ref 117 link_index 002203 constant entry internal dcl 256 ref 125 243 lock 003025 constant entry internal dcl 710 ref 113 147 239 mp_available 001433 constant entry external dcl 505 mp_err 001240 constant label dcl 442 set ref 463 498 mp_lock 003110 constant entry internal dcl 723 ref 449 532 619 mp_login 001212 constant entry external dcl 433 mp_logout 001500 constant entry external dcl 523 mp_unlock 003254 constant entry internal dcl 749 ref 461 480 545 638 not_found 002456 constant label dcl 381 ref 353 359 set_mp_info 001366 constant label dcl 473 ref 493 setup 002464 constant entry internal dcl 389 ref 110 142 233 436 508 526 616 start_mp 001764 constant entry external dcl 588 start_next_mp 002540 constant entry internal dcl 646 ref 601 stop_mp 002032 constant entry external dcl 613 test 002173 constant entry external dcl 700 unlink_index 002273 constant entry internal dcl 307 ref 242 423 unlock 003174 constant entry internal dcl 737 ref 126 156 191 222 244 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3606 3664 3342 3616 Length 4336 3342 56 435 244 20 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cmcs_wait_ctl_ 512 external procedure is an external procedure. link_index internal procedure shares stack frame of external procedure cmcs_wait_ctl_. unlink_index internal procedure shares stack frame of external procedure cmcs_wait_ctl_. find_index internal procedure shares stack frame of external procedure cmcs_wait_ctl_. setup internal procedure shares stack frame of external procedure cmcs_wait_ctl_. get_free_index internal procedure shares stack frame of external procedure cmcs_wait_ctl_. start_next_mp internal procedure shares stack frame of external procedure cmcs_wait_ctl_. lock internal procedure shares stack frame of external procedure cmcs_wait_ctl_. mp_lock internal procedure shares stack frame of external procedure cmcs_wait_ctl_. unlock internal procedure shares stack frame of external procedure cmcs_wait_ctl_. mp_unlock internal procedure shares stack frame of external procedure cmcs_wait_ctl_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 my_name cmcs_wait_ctl_ 000014 test_sw cmcs_wait_ctl_ 000016 queue_ctl_ptr cmcs_wait_ctl_ 000020 tree_ctl_ptr cmcs_wait_ctl_ 000022 user_ctl_ptr cmcs_wait_ctl_ 000024 wait_ctl_ptr cmcs_wait_ctl_ 000026 old_wait_ctl_mp_eindex start_next_mp STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cmcs_wait_ctl_ 000100 sub_err_retval cmcs_wait_ctl_ 000102 c_ptr cmcs_wait_ctl_ 000104 b_ptr cmcs_wait_ctl_ 000106 f_ptr cmcs_wait_ctl_ 000110 c_index cmcs_wait_ctl_ 000111 b_index cmcs_wait_ctl_ 000112 f_index cmcs_wait_ctl_ 000113 i cmcs_wait_ctl_ 000114 new_index cmcs_wait_ctl_ 000115 code cmcs_wait_ctl_ 000116 queue_ctl_eindex cmcs_wait_ctl_ 000120 queue_ctl_eptr cmcs_wait_ctl_ 000122 tree_ctl_eindex cmcs_wait_ctl_ 000124 tree_ctl_eptr cmcs_wait_ctl_ 000126 vfile_descr cmcs_wait_ctl_ 000130 wait_ctl_eptr cmcs_wait_ctl_ 000132 wait_ctl_mp_eindex cmcs_wait_ctl_ 000134 wait_ctl_mp_eptr cmcs_wait_ctl_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return_mac ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cmcs_set_lock_$lock cmcs_set_lock_$unlock get_process_id_ hcs_$wakeup ioa_ ipc_$block sub_err_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cmcs_error_table_$bad_call_parm cmcs_error_table_$no_message error_table_$action_not_performed external_user_ctl_ptr LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 26 000353 29 000361 107 000362 110 000400 113 000406 114 000407 117 000411 119 000417 120 000425 122 000433 123 000441 125 000445 126 000455 128 000456 133 000477 135 000513 139 000514 142 000530 145 000536 147 000542 148 000543 151 000545 152 000547 154 000551 156 000554 157 000555 162 000556 164 000561 166 000565 170 000603 171 000610 175 000615 176 000617 178 000621 179 000624 181 000642 185 000713 187 000714 191 000716 193 000717 194 000720 199 000721 201 000726 202 000733 203 000736 204 000740 205 000743 207 000745 209 000752 211 000754 213 001000 217 001023 219 001043 222 001110 224 001111 230 001112 233 001130 236 001136 237 001144 239 001156 240 001157 242 001161 243 001171 244 001201 245 001202 246 001203 248 001204 251 001207 433 001210 436 001222 439 001230 441 001236 442 001240 444 001243 446 001306 449 001307 450 001310 455 001312 457 001316 458 001325 459 001332 461 001336 462 001337 463 001342 465 001343 469 001345 470 001357 471 001364 473 001366 475 001370 476 001374 477 001376 478 001400 480 001403 481 001404 482 001405 484 001406 489 001410 491 001415 492 001420 493 001423 497 001424 498 001426 505 001427 508 001443 513 001451 514 001460 516 001462 517 001475 523 001476 526 001510 529 001516 530 001521 532 001526 533 001527 536 001531 537 001532 538 001535 539 001536 542 001544 545 001551 546 001552 547 001553 553 001554 560 001567 561 001603 563 001605 565 001650 568 001651 572 001725 573 001733 574 001740 575 001741 576 001742 577 001744 578 001750 581 001760 582 001761 588 001762 594 001774 595 002005 596 002012 598 002014 599 002016 601 002022 602 002023 605 002025 607 002027 613 002030 616 002042 619 002050 620 002051 625 002053 627 002067 628 002074 630 002076 632 002114 637 002165 638 002167 639 002170 640 002171 700 002172 703 002200 704 002202 256 002203 262 002205 263 002207 264 002214 266 002215 268 002220 269 002223 271 002224 272 002227 273 002230 275 002231 276 002234 277 002236 278 002240 281 002242 282 002243 283 002244 285 002245 286 002250 288 002251 289 002254 290 002255 292 002256 293 002261 294 002263 295 002265 298 002267 299 002271 302 002272 307 002273 313 002275 314 002277 315 002304 316 002306 317 002310 320 002321 322 002325 323 002331 325 002333 328 002343 330 002347 331 002353 334 002355 336 002364 338 002367 340 002372 346 002373 353 002375 356 002401 359 002403 363 002405 364 002412 366 002425 368 002435 370 002444 372 002446 374 002450 376 002451 378 002454 379 002455 381 002456 383 002460 384 002463 389 002464 392 002465 395 002472 397 002473 398 002476 399 002501 401 002504 404 002507 406 002510 412 002511 417 002513 419 002517 420 002524 422 002525 423 002527 426 002537 646 002540 655 002541 659 002547 660 002557 661 002560 663 002567 665 002571 666 002573 669 002642 672 002643 673 002646 676 002653 677 002671 679 002673 682 002743 685 002744 687 002747 691 003021 693 003023 694 003024 710 003025 714 003026 715 003042 717 003107 723 003110 727 003111 728 003126 731 003173 737 003174 740 003175 741 003206 743 003253 749 003254 752 003255 753 003267 756 003334 ----------------------------------------------------------- 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