COMPILATION LISTING OF SEGMENT cmcs_queue_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 1022.2 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_queue_ctl_.pl1 Shorten wait time for cmcs_station_ctl_. 16* END HISTORY COMMENTS */ 17 18 19 /* Modified on 10/10/84 by FCH, [5.3-1], BUG565(phx18385), wait time for set_lock_$lock */ 20 /* Modified on 05/06/81 by FCH, [4.4-6], activate and deactivate commands, BUG468 */ 21 /* Modified on 05/05/81 by FCH, [4.4-5], emi and egi are equiv, BUG468 */ 22 /* Modified on 04/29/81 by FCH, [4.4-3], test station_ctl_entry.output_disabled_sw in send, BUG468 */ 23 /* Modified on 04/25/81 by FCH, [4.4-2], once per process initialization, BUG468 */ 24 /* Modified on 04/27/81, [4.4-1], check for now_much^=0 caused abort, BUG468 */ 25 /* Modified since Version 4.3 */ 26 27 28 29 30 31 32 33 /* format: style3 */ 34 cmcs_queue_ctl_: 35 proc; 36 37 return; /* bad entrypoint */ 38 39 /* This COBOL MCS subroutine manages the queue related CMCS functions of 40* ACCEPT, SEND, RECEIVE, PURGE, and ENABLE/DISABLE INPUT (QUEUE). 41* Common code is shared by receive/print, and purge/stop_run. 42* 43* Bob May, 6/30/77 */ 44 45 /* Note: The disable/enable entrypoints all accept a char (10) password string. This string is ignored 46* because it was already checked by cobol_mcs_. Current ANSI rules on the use of multiple passwords for CMCS 47* terminals and queues is unclear and requests for clarification have been submitted. Until the clarification 48* is issued, this implementation will use a single password. Thus, cobol_mcs_ can do the checking for everybody. */ 49 50 dcl a_input_cdp ptr, 51 a_output_cdp ptr, 52 a_cdp ptr, /* when we don't know yet whether input or output (purge) */ 53 a_code fixed bin (35), 54 a_iocb_ptr ptr, /* print entrypoint only */ 55 a_buffer_ptr ptr, 56 a_buffer_len fixed bin, 57 a_station_count fixed bin, /* send entrypoint only */ 58 a_slew_ctl fixed bin (35), /* send entrypoint only */ 59 a_password char (10), 60 a_io_subtype fixed bin; 61 62 dcl cdp ptr; /* intermediate value for purge and stop_run */ 63 64 dcl buffer_len fixed bin (21), 65 buffer_left_index fixed bin (35), 66 buffer_left_len fixed bin (35), 67 buffer_ptr ptr, 68 buffer char (buffer_len) based (buffer_ptr); 69 /* for copying data */ 70 71 dcl (msg_no, seg_no) fixed bin (35); 72 73 dcl sysprint file env (interactive); /* for DEBUG */ 74 75 dcl program_interrupt condition; 76 77 dcl test_sw bit (1) int static init ("0"b); 78 79 dcl iocb_ptr ptr; /* for all the queue I/O, one at atime */ 80 81 dcl 1 min_blksz_info int static, /* to ensure space for vfile lockword in each record */ 82 2 min_residue fixed bin (21), 83 2 min_capacity fixed bin (21); 84 85 dcl my_name char (15) init ("cmcs_queue_ctl_"); 86 /* for DEBUG */ 87 88 dcl (addr, char, fixed, index, min, null, rtrim, size, string, substr) 89 builtin; 90 91 dcl ( 92 ioa_, 93 ioa_$rsnnl, 94 sub_err_ 95 ) entry options (variable); 96 97 dcl sub_err_retval fixed bin (35); /* dummy for sub_err_ */ 98 99 dcl get_process_id_ entry () returns (bit (36)), 100 get_group_id_ entry () returns (char (32)), 101 hcs_$truncate_seg entry (ptr, fixed bin (18), fixed bin (35)), 102 clock_ entry () returns (fixed bin (71)); 103 104 dcl get_temp_segments_ entry (char (*), (*) ptr aligned, fixed bin (35)), 105 release_temp_segments_ 106 entry (char (*), (*) ptr aligned, fixed bin (35)); 107 108 dcl set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35)), 109 set_lock_$unlock entry (bit (36) aligned, fixed bin (35)); 110 111 dcl (i, code) fixed bin (35); 112 113 dcl ( 114 error_table_$action_not_performed, 115 error_table_$bad_new_key, 116 error_table_$no_record, 117 error_table_$not_open 118 ) fixed bin (35) external; 119 120 dcl (old_status, new_status) 121 fixed bin, /* for status_list_ctl_ */ 122 (io_subtype, io_type) 123 fixed bin, 124 station_name char (12), 125 station_count fixed bin; 126 127 dcl overlay_len fixed bin, /* to erase structure data */ 128 overlay (overlay_len) fixed bin (35) based; 129 130 dcl dest_table_index fixed bin, 131 flag bit (1); 132 133 dcl 1 msg_descr like vfile_descr; 134 135 dcl zero fixed bin (35) int static options (constant) init (0); 136 137 dcl zero_descr_ptr ptr int static; 138 139 dcl 1 zero_descr like vfile_descr based (zero_descr_ptr); 140 141 /* */ 142 143 /* declarations for SEND */ 144 145 dcl send_init_sw bit (1) int static init ("0"b); 146 147 dcl ptr_array (1) ptr static internal; /* to pick up temp segs, one at a time */ 148 dcl tseg_ptr ptr, /* temporary buffer for partial messages, per queue */ 149 tseg_len fixed bin (21), 150 tseg char (tseg_len) based (tseg_ptr); 151 dcl tseg_max_len fixed bin (21) init (64 * 1024 * 4); 152 /* arbitrary */ 153 dcl switch_no fixed bin int static init (0);/* to generate switch names for same queue */ 154 dcl attach_descr char (256); /* for iox_$attach */ 155 dcl attach_descr_len fixed bin; /* returned by ioa_$rsnnl */ 156 dcl switch_pic pic "99"; /* to generate switch name from queue_name, number */ 157 158 dcl 1 send_vfile_rs like vfile_rs int static; /* to allocate records for send */ 159 160 dcl send_vfile_rs_ptr ptr int static; 161 162 dcl 1 send_descr like vfile_descr int static; 163 dcl seek_len fixed bin (21); /* for record_status allocate */ 164 dcl fb21 fixed bin (21); /* dummy output variable for seek_key */ 165 166 /* */ 167 168 /* Declarations for RECEIVE */ 169 170 dcl init_queue_table_sw bit (1) int static init ("0"b); 171 172 dcl queue_table_ptr ptr int static; 173 174 dcl 1 queue_table_struc based (queue_table_ptr), 175 2 queue_table_len fixed bin, 176 2 queue_table (tree_ctl.current_size refer (queue_table_struc.queue_table_len)) fixed bin; 177 /* table of queue indices for subtree */ 178 dcl copy_len fixed bin (35); 179 180 dcl 1 rcv_vfile_rs like vfile_rs int static; 181 182 dcl 1 rcv_descr like vfile_descr int static; 183 184 dcl rcv_vfile_rs_ptr ptr int static; 185 186 dcl rcv_descr_ptr ptr int static; 187 188 dcl subtree_count fixed bin; 189 190 dcl rcv_init_sw bit (1) int static init ("0"b); 191 192 /* Declarations for ACCEPT_MESSAGE_COUNT */ 193 194 dcl msg_count fixed bin (35); /* careful, inside input_cd, it's a char item */ 195 196 /* */ 1 1 /* BEGIN INCLUDE FILE... cmcs_cd_dcls.incl.pl1 */ 1 2 1 3 /* This COBOL MCS include file defines the input and output CD structures 1 4* that are used by the COBOL object program to pass function-specific data 1 5* to the CMCS runtime support package. */ 1 6 1 7 /* Bob May, 6/30/77 */ 1 8 1 9 dcl input_cdp ptr; 1 10 1 11 /* Input CD Structure */ 1 12 1 13 dcl 1 input_cd aligned based (input_cdp), 1 14 1 15 /* Input Header */ 1 16 1 17 2 queue_ptr ptr, 1 18 2 flags, 1 19 (3 io_sw bit (1), /* always "1"b for input cd */ 1 20 3 cobol_sw bit (1), /* always "1"b for COBOL MCS */ 1 21 3 filler bit (34)) unaligned, 1 22 2 last_tree_path, /* for faster lookup only */ 1 23 3 level_names (4) char (12), 1 24 1 25 /* COBOL Input CD */ 1 26 1 27 2 tree_path, 1 28 3 level_names (4) char (12), /* DN 1-4 */ 1 29 (2 msg_date char (6), /* DN 5, YYMMDD */ 1 30 2 msg_time char (8), /* DN 6, HHMMSSTT */ 1 31 2 station_name char (12), /* DN 7 */ 1 32 2 text_len pic "9999", /* DN 8, S.B. pic "9999" */ 1 33 2 text_delim pic "9", /* DN 9, S.B. pic "9" */ 1 34 2 status_key char (2), /* DN 10 */ 1 35 2 msg_count pic "999999") unaligned; /* DN 11, S.B. pic "999999" */ 1 36 1 37 /* */ 1 38 1 39 dcl output_cdp ptr; 1 40 1 41 /* Output CD Structure */ 1 42 1 43 dcl 1 output_cd aligned based (output_cdp), 1 44 1 45 /* Output CD Header */ 1 46 1 47 2 last_station_info_ptr ptr, 1 48 2 flags, 1 49 (3 io_sw bit (1), /* always "0"b for output cd */ 1 50 3 cobol_sw bit (1), /* alays "1"b for COBOL MCS */ 1 51 3 filler bit (34)) unaligned, 1 52 2 bin_max_station_count fixed bin, /* who sets? ---- */ 1 53 2 char_max_station_count pic "9999", /* S.B. pic "9999" */ 1 54 1 55 /* COBOL Output CD */ 1 56 1 57 2 station_count pic "9999", /* DN 1, S.B. pic "9999" */ 1 58 2 text_len pic "9999", /* DN 2, S.B. pic "9999" */ 1 59 2 status_key char (2) unaligned, /* DN 3 */ 1 60 2 dest_table (0 refer (output_cd.bin_max_station_count)) unaligned, 1 61 3 error_key char (1), /* DN 4 */ 1 62 3 station_name char (12); /* DN 5 */ 1 63 1 64 /* Last Station Info */ 1 65 1 66 dcl 1 last_station_info based (output_cd.last_station_info_ptr) aligned, 1 67 2 last_dest (output_cd.bin_max_station_count), 1 68 3 queue_iocbp ptr, 1 69 3 station_name char (12); 1 70 1 71 /* END INCLUDE FILE... cmcs_cd_dcls.incl.pl1 */ 197 2 1 /* BEGIN INCLUDE FILE... cmcs_control_hdr.incl.pl1 */ 2 2 2 3 /* This include file is the 1st part of all cobol_mcs tables */ 2 4 2 5 /* Bob May, 4/30/77 */ 2 6 2 7 dcl control_hdr_len fixed bin int static options (constant) init (32); 2 8 2 9 dcl control_hdr_ptr ptr; 2 10 2 11 dcl 1 control_hdr aligned based (control_hdr_ptr), 2 12 2 lockword bit (36) aligned, /* for process_id */ 2 13 2 version fixed bin, 2 14 2 clock_created fixed bin (71), 2 15 2 author aligned, 2 16 3 group_id char (32), /* person.proj.tag */ 2 17 3 process_id bit (36), 2 18 2 max_size fixed bin (18), /* maximum number of entries seg can hold */ 2 19 2 current_size fixed bin (18), /* index of last active entry */ 2 20 2 entry_count fixed bin (18), /* number of active entries */ 2 21 2 cmcs_control_hdr_filler (16) fixed bin; /* words (17-32) for later expansion */ 2 22 2 23 /* END INCLUDE FILE... cmcs_control_hdr.incl.pl1 */ 198 3 1 /* BEGIN INCLUDE FILE... cmcs_entry_dcls.incl.pl1 */ 3 2 3 3 3 4 3 5 /****^ HISTORY COMMENTS: 3 6* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8087), 3 7* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 3 8* MCR8087 cmcs_entry_dcls.incl.pl1 Shorten wait time for cmcs_station_ctl_. 3 9* END HISTORY COMMENTS */ 3 10 3 11 3 12 /* Entry declarations for the COBOL MCS runtime support package */ 3 13 3 14 /* Modified on 10/20/84 by FCH, [5.3-1] */ 3 15 /* Modified on 04/29/81 by FCH, [4.4-1] */ 3 16 /* Bob May, 6/01/77 */ 3 17 3 18 dcl cmcs_create_queues_ entry (fixed bin (35)); 3 19 3 20 dcl cmcs_date_time_ entry (fixed bin (71), char (6) unaligned, char (8) unaligned); 3 21 3 22 dcl cmcs_decode_status_ entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35)); 3 23 3 24 dcl cmcs_expand_tree_path_ entry (char (*), char (48), fixed bin (35)); 3 25 3 26 dcl cmcs_fillin_hdr_ entry (ptr, fixed bin, fixed bin, fixed bin, fixed bin (35)); 3 27 3 28 dcl cmcs_initiate_ctl_ entry (char (*), ptr, fixed bin (35)); 3 29 3 30 dcl cmcs_print_ entry (ptr, ptr, fixed bin (35), ptr, fixed bin (35)); 3 31 3 32 dcl cmcs_purge_queues_ entry (fixed bin, bit (1), fixed bin (35)); 3 33 3 34 dcl cmcs_queue_ctl_$accept_message_count entry (ptr, fixed bin, fixed bin (35)); 3 35 dcl cmcs_queue_ctl_$disable entry (ptr, fixed bin, char (10), fixed bin (35)); 3 36 dcl cmcs_queue_ctl_$enable entry (ptr, fixed bin, char (10), fixed bin (35)); 3 37 dcl cmcs_queue_ctl_$print entry (ptr, fixed bin, ptr, fixed bin (35)); 3 38 dcl cmcs_queue_ctl_$purge entry (ptr, fixed bin, fixed bin (35)); 3 39 dcl cmcs_queue_ctl_$receive entry (ptr, fixed bin, ptr, fixed bin, fixed bin (35)); 3 40 dcl cmcs_queue_ctl_$send entry (ptr, fixed bin, ptr, fixed bin, fixed bin, bit (36), fixed bin (35)); 3 41 dcl cmcs_queue_ctl_$stop_run entry (fixed bin, fixed bin (35)); 3 42 3 43 dcl cmcs_scramble_ entry (char (10)) returns (char (10)); 3 44 3 45 dcl cmcs_set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35)); /*[5.3-1]*/ 3 46 dcl cmcs_set_lock_$unlock entry (bit (36) aligned, fixed bin (35)); 3 47 3 48 dcl cmcs_station_ctl_$attach entry (char (12), fixed bin, fixed bin (35)); 3 49 dcl cmcs_station_ctl_$detach entry (fixed bin, fixed bin (35)); 3 50 dcl cmcs_station_ctl_$detach_name entry (char (12), fixed bin (35)); 3 51 dcl cmcs_station_ctl_$disable_input_terminal entry (ptr, char (10), fixed bin (35)); 3 52 dcl cmcs_station_ctl_$disable_output_terminal entry (ptr, char (10), fixed bin (35)); 3 53 dcl cmcs_station_ctl_$enable_input_terminal entry (ptr, char (10), fixed bin (35)); 3 54 dcl cmcs_station_ctl_$enable_output_terminal entry (ptr, char (10), fixed bin (35)); 3 55 dcl cmcs_station_ctl_$find_destination entry (char (12), fixed bin, ptr, fixed bin (35)); /*[4.4-1]*/ 3 56 dcl cmcs_station_ctl_$input_disabled entry (fixed bin, bit (1), fixed bin (35)); 3 57 dcl cmcs_station_ctl_$output_disabled entry (fixed bin, bit (1), fixed bin (35)); 3 58 dcl cmcs_station_ctl_$validate entry (char (12), fixed bin, fixed bin (35)); 3 59 3 60 dcl cmcs_status_list_ctl_$add entry (ptr, ptr, ptr, fixed bin, fixed bin (35)); 3 61 dcl cmcs_status_list_ctl_$delete entry (ptr, ptr, ptr, fixed bin, fixed bin (35)); 3 62 dcl cmcs_status_list_ctl_$move entry (ptr, ptr, ptr, fixed bin, fixed bin, fixed bin (35)); 3 63 3 64 dcl cmcs_terminal_ctl_$find entry (char (8), char (12), fixed bin (35)); 3 65 3 66 dcl cmcs_tree_ctl_$find_destination entry (char (12), fixed bin, ptr, fixed bin (35)); 3 67 dcl cmcs_tree_ctl_$find_index entry (fixed bin, ptr, fixed bin (35)); 3 68 dcl cmcs_tree_ctl_$find_tree_path entry (ptr, fixed bin, fixed bin, ptr, fixed bin (35)); 3 69 dcl cmcs_tree_ctl_$find_qual_name entry (char (12), fixed bin, ptr, char (52), fixed bin (35)); /*[4.4-1]*/ 3 70 3 71 dcl cmcs_wait_ctl_$add entry (char (48), fixed bin, fixed bin (35)); 3 72 dcl cmcs_wait_ctl_$delete entry (fixed bin, fixed bin (35)); 3 73 dcl cmcs_wait_ctl_$find entry (char (48), ptr, fixed bin (35)); 3 74 dcl cmcs_wait_ctl_$mp_available entry (fixed bin, fixed bin, fixed bin (35)); 3 75 dcl cmcs_wait_ctl_$mp_login entry (fixed bin, fixed bin (35)); 3 76 dcl cmcs_wait_ctl_$mp_logout entry (fixed bin, fixed bin (35)); 3 77 dcl cmcs_wait_ctl_$clear_mp entry (fixed bin (35)); 3 78 dcl cmcs_wait_ctl_$start_mp entry (fixed bin (35)); 3 79 dcl cmcs_wait_ctl_$stop_mp entry (fixed bin (35)); 3 80 3 81 /* END INCLUDE FILE... cmcs_entry_dcls.incl.pl1 */ 199 4 1 /* BEGIN INCLUDE FILE... cmcs_error_table_dcls.incl.pl1 */ 4 2 4 3 /* Bob May, 6/30/77 */ 4 4 4 5 dcl (cmcs_error_table_$ambiguous_tree_path, cmcs_error_table_$bad_call_parm, cmcs_error_table_$bad_dest, 4 6 cmcs_error_table_$bad_dest_count, cmcs_error_table_$bad_message_length, 4 7 cmcs_error_table_$bad_password, cmcs_error_table_$bad_queue_path, cmcs_error_table_$bad_slew, 4 8 4 9 cmcs_error_table_$bad_source, cmcs_error_table_$bad_station, 4 10 cmcs_error_table_$bad_term_devchn, cmcs_error_table_$bad_tree_path, 4 11 cmcs_error_table_$dest_already_disabled, cmcs_error_table_$dest_already_enabled, 4 12 4 13 cmcs_error_table_$dest_disabled, cmcs_error_table_$no_message, 4 14 cmcs_error_table_$no_partial_messages, cmcs_error_table_$null_partial_message, 4 15 cmcs_error_table_$queue_already_disabled, cmcs_error_table_$queue_already_enabled, 4 16 4 17 cmcs_error_table_$queue_disabled, cmcs_error_table_$source_already_disabled, 4 18 cmcs_error_table_$source_already_enabled, cmcs_error_table_$source_disabled) fixed bin (35) external; 4 19 4 20 /* END INCLUDE FILE... cmcs_error_table_dcls.incl.pl1 */ 200 5 1 /* BEGIN INCLUDE FILE... cmcs_iox_processing.incl.pl1, 07/01/74 */ 5 2 5 3 dcl iox_$attach_iocb entry (ptr, char (*), fixed bin (35)), 5 4 iox_$attach_name entry (char (*), ptr, char (*), ptr, fixed bin (35)), 5 5 iox_$close entry (ptr, fixed bin (35)), 5 6 iox_$control entry (ptr, char (*), ptr, fixed bin (35)), 5 7 iox_$delete_record entry (ptr, fixed bin (35)), 5 8 iox_$detach_iocb entry (ptr, fixed bin (35)), 5 9 iox_$find_iocb entry (char (*), ptr, fixed bin (35)), 5 10 iox_$get_chars entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)), 5 11 iox_$get_line entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)), 5 12 iox_$modes entry (ptr, char (*), char (*), fixed bin (35)), 5 13 iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35)), 5 14 iox_$position entry (ptr, fixed bin, fixed bin (21), fixed bin (35)), 5 15 iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)), 5 16 iox_$read_key entry (ptr, char (256) varying, fixed bin (21), fixed bin (35)), 5 17 iox_$read_length entry (ptr, fixed bin (21), fixed bin (35)), 5 18 iox_$read_record entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)), 5 19 iox_$rewrite_record entry (ptr, ptr, fixed bin (21), fixed bin (35)), 5 20 iox_$seek_key entry (ptr, char (256) varying, fixed bin (21), fixed bin (35)), 5 21 iox_$write_record entry (ptr, ptr, fixed bin (21), fixed bin (35)); 5 22 5 23 /* * * EXTERNAL * * */ 5 24 5 25 dcl (iox_$user_io, 5 26 iox_$user_input, 5 27 iox_$user_output, 5 28 iox_$error_output) ptr external; 5 29 5 30 /* * * MODES * * */ 5 31 5 32 /* 5 33* 1 stream_input 5 34* 2 stream_output 5 35* 3 stream_input_output 5 36* 4 sequential_input 5 37* 5 sequential_output 5 38* 6 sequential_input_output 5 39* 7 sequential_update 5 40* 8 keyed_sequential_input 5 41* 9 keyed_sequential_output 5 42* 10 keyed_sequential_update 5 43* 11 direct_input 5 44* 12 direct_output 5 45* 13 direct_update 5 46**/ 5 47 5 48 /* END INCLUDE FILE... cmcs_iox_processing.incl.pl1 */ 201 6 1 /* BEGIN INCLUDE FILE... cmcs_key_dcls.incl.pl1 */ 6 2 6 3 /* 6 4* This COBOL MCS include file gives the structure of the key fields used to access 6 5* the message records in an indexed vfile. 6 6**/ 6 7 6 8 /* Bob May, 5/31/77 */ 6 9 6 10 dcl key char (256) varying; /* used by iox_ */ 6 11 6 12 dcl 1 key_struc aligned, 6 13 (2 key_len init (8), 6 14 2 msg_no, 6 15 2 seg_no) fixed bin (35); 6 16 6 17 dcl based_key char (8) varying based (addr (key_struc)); 6 18 6 19 /* END INCLUDE FILE... cmcs_key_dcls.incl.pl1 */ 202 7 1 /* BEGIN INCLUDE FILE... cmcs_msg_hdr.incl.pl1 */ 7 2 7 3 /* This include file defines the structure of the msg header for COBOL MCS messages. 7 4* Both msg_hdr/msg_seg and msg_seg only records have their msg_no and seg_no 7 5* in the first two words of the record. The seg_no in msg_hdr/msg_seg records will always 7 6* be 1; the seg_no in msg_seg records will always be greater than 1. */ 7 7 7 8 /* Bob May, 5/31/77 */ 7 9 7 10 dcl (msg_hdr_len init (26), /* 24, plus fudges for alignment */ 7 11 msg_hdr_version init (1)) fixed bin int static options (constant); 7 12 7 13 dcl msg_hdr_ptr ptr; 7 14 7 15 dcl 1 msg_hdr aligned based (msg_hdr_ptr), 7 16 2 msg_no fixed bin (35), /* same as in key */ 7 17 2 seg_no fixed bin (35), /* always 1, to indicate msg_hdr */ 7 18 2 lockword bit (36) aligned, /* current owner */ 7 19 2 version fixed bin, 7 20 2 source_station char (12), /* who created this msg */ 7 21 2 source_group_id char (32), /* User_id of msg source */ 7 22 2 final_delim fixed bin, /* 0 illegal, 1-3 legal */ 7 23 2 clock_available fixed bin (71), /* when msg is available for processing */ 7 24 2 clock_deleted fixed bin (71), /* processing completed */ 7 25 2 seg_count fixed bin, /* total number of (msg) segments for this msg */ 7 26 2 msg_len fixed bin (35), /* sum of all segments, in chars */ 7 27 2 status_info, 7 28 3 msg_status fixed bin, /* 0 undefined, 1-4 legal */ 7 29 /* 1 - send incomplete */ 7 30 /* 2 - send complete (available for processing) */ 7 31 /* 3 - receive incomplete (in process) */ 7 32 /* 4 - receive complete */ 7 33 3 descrs, 7 34 4 f_descr like vfile_descr, 7 35 4 b_descr like vfile_descr, 7 36 2 msg_seg like msg_seg; /* for seg 1, where msg hdr and seg are together */ 7 37 7 38 /* END INCLUDE FILE... cmcs_msg_hdr.incl.pl1 */ 203 8 1 /* BEGIN INCLUDE FILE... cmcs_msg_seg.incl.pl1 */ 8 2 8 3 /* This include file defines the structure of a COBOL MCS message segment */ 8 4 8 5 /* Bob May, 5/31/77 */ 8 6 8 7 dcl (msg_seg_hdr_len init (4), 8 8 msg_seg_version init (1)) fixed bin int static options (constant); 8 9 8 10 dcl msg_seg_ptr ptr; 8 11 8 12 dcl 1 msg_seg aligned based (msg_seg_ptr), 8 13 2 hdr, 8 14 3 msg_no fixed bin (35), /* same as in key */ 8 15 3 seg_no fixed bin (35), /* same as in key */ 8 16 3 slew_ctl fixed bin (35), 8 17 3 seg_len fixed bin (35), /* of this segment, in chars */ 8 18 2 data, 8 19 3 seg_data char (msg_seg.hdr.seg_len); 8 20 8 21 /* END INCLUDE FILE... cmcs_msg_seg.incl.pl1 */ 204 9 1 /* BEGIN INCLUDE FILE ... cmcs_queue_ctl.incl.pl1 */ 9 2 9 3 /* This COBOL MCSD include file defines the structure of the cmcs_queue_ctl.control segment. */ 9 4 9 5 /* Bob May, 5/31/77 */ 9 6 9 7 dcl (queue_ctl_hdr_len init (0), 9 8 queue_ctl_entry_len init (48), 9 9 queue_ctl_version init (1)) fixed bin internal static options (constant); 9 10 9 11 dcl queue_ctl_ptr ptr int static; 9 12 9 13 dcl 1 queue_ctl aligned based (queue_ctl_ptr), 9 14 2 hdr like control_hdr, 9 15 2 entries (queue_ctl.current_size) like queue_ctl_entry; 9 16 9 17 dcl queue_ctl_eindex fixed bin; 9 18 9 19 dcl queue_ctl_eptr ptr; 9 20 9 21 dcl 1 queue_ctl_entry aligned based (queue_ctl_eptr), 9 22 2 lockword bit (36) aligned, 9 23 2 tree_ctl_eindex fixed bin, /* index of corresponding entry in tree_ctl */ 9 24 2 tree_path, 9 25 3 level_names (4) char (12), 9 26 2 queue_name char (32), /* includes suffix */ 9 27 2 msg_no fixed bin (35), /* always increasing, until reset manually */ 9 28 2 flags, 9 29 (3 input_disabled_sw bit (1), 9 30 3 mp_entered_sw bit (1), 9 31 3 mp_active_sw bit (1), 9 32 3 mp_sw bit (1), 9 33 3 cmd_sw bit (1), 9 34 3 filler bit (31)) unaligned, 9 35 2 filler (10) fixed bin (35), 9 36 2 mp_lockword bit (36) aligned, /* process_id of message processor */ 9 37 2 status_lists_lockword bit (36) aligned, /* only to manipulate the status lists */ 9 38 2 status_list_ctl_entries (4) like status_list_ctl_entry; /* everything belonging to this queue */ 9 39 9 40 dcl status_list_ctl_eindex fixed bin; 9 41 9 42 dcl status_list_ctl_eptr ptr; 9 43 9 44 dcl 1 status_list_ctl_entry aligned based (status_list_ctl_eptr), 9 45 2 count fixed bin, 9 46 2 descrs, 9 47 3 f_descr like vfile_descr, 9 48 3 b_descr like vfile_descr; 9 49 9 50 /* END INCLUDE FILE ... cmcs_queue_ctl.incl.pl1 */ 205 10 1 /* BEGIN INCLUDE FILE... cmcs_slew_ctl.incl.pl1 */ 10 2 10 3 /* This include file defines the structure of the slew control 10 4* word that is part of a COBOL MCS message segment */ 10 5 10 6 /* Bob May, 5/31/77 */ 10 7 10 8 dcl slew_ctl_ptr ptr; 10 9 10 10 dcl 1 slew_ctl aligned based (slew_ctl_ptr), 10 11 (2 when fixed bin (8), /* 0 = no slew, 1 = before, 2 = after */ 10 12 2 what fixed bin (8), /* 0 - slew 0 lines */ 10 13 /* 1 - slew n lines */ 10 14 /* 2 - slew to top of page */ 10 15 /* 3 - slew to channel (1-16) */ 10 16 10 17 2 how_much fixed bin (17)) unaligned; /* what = 1: n */ 10 18 /* what = 3: carriage control channel 1-16 */ 10 19 10 20 /* END INCLUDE FILE... cmcs_slew_ctl.incl.pl1 */ 206 11 1 /* BEGIN INCLUDE FILE... cmcs_station_ctl.incl.pl1 */ 11 2 11 3 /* This include file defines the station control structure for COBOL MCS */ 11 4 11 5 /* Bob May, 5/31/77 */ 11 6 11 7 dcl (station_ctl_hdr_len init (0), /* no special fields in hdr */ 11 8 station_ctl_entry_len init (6), 11 9 station_ctl_version init (1)) fixed bin int static options (constant); 11 10 11 11 dcl station_ctl_ptr ptr int static; 11 12 11 13 dcl 1 station_ctl aligned based (station_ctl_ptr), 11 14 2 hdr like control_hdr, 11 15 2 entries (station_ctl.current_size) like station_ctl_entry; 11 16 11 17 dcl station_ctl_eindex fixed bin; 11 18 11 19 dcl station_ctl_eptr ptr; 11 20 11 21 dcl 1 station_ctl_entry aligned based (station_ctl_eptr), 11 22 2 station_name char (12), 11 23 2 lockword bit (36) aligned, /* owner process_id */ 11 24 2 flags, 11 25 (3 inactive_sw bit (1), /* station is currently not legal to use */ 11 26 3 destination_sw bit (1), /* station attached as a destination */ 11 27 3 input_disabled_sw bit (1), /* if terminal, can't input */ 11 28 3 output_disabled_sw bit (1), /* if terminal, can't get output */ 11 29 3 filler bit (32)) unaligned, 11 30 2 filler fixed bin; 11 31 11 32 /* END INCLUDE FILE... cmcs_station_ctl.incl.pl1 */ 207 12 1 /* BEGIN INCLUDE FILE ... cmcs_system_ctl.incl.pl1 */ 12 2 12 3 /* 12 4* This COBOL MCS include file holds all the COBOL MCS system-wide parameters. 12 5**/ 12 6 12 7 /* Bob May, 5/31/77 */ 12 8 12 9 dcl (system_ctl_hdr_len init (32), 12 10 system_ctl_entry_len init (0), 12 11 system_ctl_version init (1)) fixed bin internal static options (constant); 12 12 12 13 dcl system_ctl_ptr ptr int static; 12 14 12 15 dcl 1 system_ctl aligned based (system_ctl_ptr), 12 16 2 hdr like control_hdr, 12 17 2 flags, 12 18 (3 mp_started_sw bit (1), 12 19 3 filler bit (35)) unaligned, 12 20 2 mp_started_count fixed bin, /* zero for this version */ 12 21 2 mp_active_count fixed bin, /* number that have logged in so far, less the logouts */ 12 22 2 password char (10), /* scrambled password for all cmcs functions */ 12 23 2 lock_wait_time fixed bin, /* number of seconds to wait before giving up */ 12 24 2 filler (25) fixed bin (35); 12 25 12 26 /* END INCLUDE FILE ... cmcs_system_ctl.incl.pl1 */ 208 13 1 /* BEGIN INCLUDE FILE ... cmcs_tree_ctl.incl.pl1 */ 13 2 13 3 /* 13 4* This COBOL MCS include file defines the sstructure used for accessing 13 5* the MCS queue hierarchy and controlling message I/O for each entry. 13 6**/ 13 7 13 8 /* Bob May, 5/31/77 */ 13 9 13 10 dcl (tree_ctl_hdr_len init (32), 13 11 tree_ctl_entry_len init (144), /* 136, plus fudge for ptr alignments */ 13 12 tree_ctl_version init (1)) fixed bin internal static options (constant); 13 13 13 14 dcl tree_ctl_ptr ptr int static; 13 15 13 16 dcl 1 tree_ctl aligned based (tree_ctl_ptr), 13 17 2 hdr like control_hdr, 13 18 2 queue_count fixed bin, /* total of queue entries for hierarchy */ 13 19 2 filler (31) fixed bin (35), 13 20 2 entries (tree_ctl.current_size) like tree_ctl_entry; 13 21 13 22 dcl tree_ctl_eindex fixed bin; 13 23 13 24 dcl tree_ctl_eptr ptr; 13 25 13 26 dcl 1 tree_ctl_entry aligned based (tree_ctl_eptr), 13 27 2 level_info, /* len = 15 */ 13 28 3 tree_path, 13 29 4 level_names (4) char (12), 13 30 3 entry_flags, 13 31 (4 inactive_sw bit (1), 13 32 4 cmd_sw bit (1), 13 33 4 mp_sw bit (1), 13 34 /* switch separator */ 13 35 4 cobol_program_id_sw bit (1), 13 36 4 queue_sw bit (1), 13 37 4 filler bit (31)) unaligned, 13 38 3 level_no fixed bin, /* level within the hierarchy */ 13 39 3 subtree_count fixed bin, 13 40 2 static_queue_info, /* len = 9 */ 13 41 3 queue_name char (32), /* without the .cmcs_queue suffix */ 13 42 3 queue_ctl_eindex fixed bin, /* to compute addr of table entry */ 13 43 2 command_info, /* len = 75 */ 13 44 3 cmd_line_len fixed bin, 13 45 3 cmd_line char (128), 13 46 3 mp_line_len fixed bin, 13 47 3 mp_line char (128), 13 48 3 cobol_program_id_len fixed bin, 13 49 3 cobol_program_id char (32), 13 50 2 io_info, /* len = 37, sum of all level 3s */ 13 51 3 io_flags, /* len = 1 */ 13 52 (4 io_in_process_sw bit (1), 13 53 4 partial_in_process_sw bit (1), 13 54 4 rcv_wait_sw bit (1), 13 55 /* switch separator */ 13 56 4 rcv_msg_sw bit (1), /* on if user did a receive msg */ 13 57 4 rcv_seg_sw bit (1), /* on if user did a receive seg */ 13 58 4 filler bit (31)) unaligned, 13 59 3 dynamic_queue_info, /* len = 13 */ 13 60 4 switch_name char (32) unaligned, 13 61 4 queue_ctl_eptr ptr, 13 62 4 iocb_ptr ptr, 13 63 4 vfile_status fixed bin, /* 0 - not active/detached */ 13 64 /* 1 - attached, but not open */ 13 65 /* 2 - open */ 13 66 3 msg_hdr_info, /* len = 9 */ 13 67 4 msg_hdr_ptr ptr, /* ptr to base of current msg */ 13 68 4 io_type fixed bin, 13 69 4 io_subtype fixed bin, 13 70 4 seg_count fixed bin (35), /* total no of msg segments */ 13 71 4 msg_len fixed bin (35), /* total msg length (sum of all segments) */ 13 72 4 msg_descr like vfile_descr, 13 73 4 msg_key, 13 74 5 msg_no fixed bin (35), 13 75 5 seg_no fixed bin (35), 13 76 3 tseg_info, /* len = 3 */ 13 77 4 tseg_ptr ptr, /* temp seg to build segment */ 13 78 4 tseg_len fixed bin (35), 13 79 3 msg_seg_info, /* len = 6 */ 13 80 4 msg_seg_ptr ptr, /* ptr to base of current msg_seg */ 13 81 4 msg_seg_descr like vfile_descr, 13 82 4 msg_seg_len fixed bin (35), 13 83 4 msg_seg_left_index fixed bin (35), 13 84 4 msg_seg_left_len fixed bin (35), 13 85 3 buffer_info, /* len = 5 */ 13 86 4 buffer_ptr ptr, 13 87 4 buffer_len fixed bin (35), 13 88 4 buffer_left_index fixed bin (35), 13 89 4 buffer_left_len fixed bin (35); 13 90 13 91 /* END INCLUDE FILE ... cmcs_tree_ctl.incl.pl1 */ 209 14 1 /* BEGIN INCLUDE FILE ... cmcs_user_ctl.incl.pl1 */ 14 2 14 3 /* 14 4* This COBOL MCS include file defines the global, process-dependent variables that are 14 5* not part of the PD copy of cmcs_tree_ctl.control. 14 6**/ 14 7 14 8 /* Modified on 05/06/81 by FCH, [4.4-1], attach command */ 14 9 /* Bob May, 5/31/77 */ 14 10 14 11 dcl user_ctl_exists_sw bit (1) aligned int static init ("0"b); /* indicates legitimacy of external_user_ctl_ptr */ 14 12 14 13 dcl external_user_ctl_ptr ptr external; /* global ptr for user_ctl */ 14 14 14 15 dcl user_ctl_ptr ptr int static; 14 16 14 17 dcl 1 user_ctl aligned based (user_ctl_ptr), 14 18 14 19 /* Flags */ 14 20 14 21 2 init_sw, 14 22 3 terminal_ctl bit(1), 14 23 3 tree_ctl bit(1), 14 24 3 status_list_ctl bit(1), 14 25 3 station_ctl bit(1), 14 26 3 queue_ctl bit(1), 14 27 3 set_lock bit(1), 14 28 3 wait_ctl bit(1), 14 29 3 purge_queues bit(1), 14 30 3 create_queues bit(1), 14 31 3 initiate_ctl bit(1), 14 32 3 mcs bit(1), 14 33 2 flags, 14 34 (3 initialized_sw bit (1), 14 35 3 interactive_sw bit (1), 14 36 3 mp_sw bit (1), /* message processor process */ 14 37 3 terminal_sw bit (1), /* user terminal process */ 14 38 3 admin_sw bit (1), /* cobol_mcs_admin */ 14 39 3 attach_bit bit(1), /*[4.4-1]*/ 14 40 3 rec bit(1), /*[4.4-1]*/ 14 41 3 filler bit (29)) unaligned, 14 42 2 cmcs_dir char (168), 14 43 2 output_file char(168), /*[4.4-1]*/ 14 44 2 station_name char (12), /* current station */ 14 45 2 station_ctl_eindex fixed bin, /* current station */ 14 46 2 process_id bit (36), 14 47 2 process_type fixed bin, /* 0 - not defined, 1 - MP, 2 - terminal, 3 - admin */ 14 48 2 filler fixed bin (35), /* to explicitly align ptrs */ 14 49 2 control_ptrs, 14 50 3 queue_ctl_ptr ptr, 14 51 3 iocb_ptr ptr, /*[4.4-1]*/ 14 52 3 station_ctl_ptr ptr, 14 53 3 system_ctl_ptr ptr, 14 54 3 terminal_ctl_ptr ptr, 14 55 3 tree_ctl_ptr ptr, 14 56 3 wait_ctl_ptr ptr, 14 57 3 filler_ptrs (4) ptr, 14 58 2 terminal_info, 14 59 3 term_id char (4), 14 60 3 term_type fixed bin, 14 61 3 term_channel char (8), 14 62 2 last_receive_info, 14 63 3 tree_path char (48), 14 64 3 tree_ctl_eindex fixed bin, 14 65 3 tree_ctl_eptr ptr, 14 66 2 last_send_info, 14 67 3 dest_name char (12), 14 68 3 tree_ctl_eindex fixed bin, 14 69 3 tree_ctl_eptr ptr, 14 70 2 station_info, 14 71 3 station_count fixed bin, /* must be 1 for phase 1 */ 14 72 3 station_entries (2), 14 73 4 station_name char (12), 14 74 4 station_ctl_eptr ptr, 14 75 4 station_ctl_eindex fixed bin, 14 76 2 wait_info, 14 77 3 wait_ctl_eptr ptr, 14 78 3 wait_ctl_eindex fixed bin, 14 79 3 wait_ctl_mp_eindex fixed bin, /* only for message processors */ 14 80 3 wait_ctl_mp_eptr ptr, 14 81 3 ev_wait_chn fixed bin (71), /* for message processors */ 14 82 3 ev_call_chn fixed bin (71), /* for terminals, to get message responses */ 14 83 3 ev_wait_list_ptr ptr, /* for ipc_$block */ 14 84 3 ev_info_ptr ptr; /* for wakeup */ 14 85 14 86 /* END INCLUDE FILE ... cmcs_user_ctl.incl.pl1 */ 210 15 1 /* BEGIN INCLUDE FILE... cmcs_vfile_rs.incl.pl1 */ 15 2 15 3 /* This COBOL MCS include file is used to reference records by their 15 4* vfile_ descriptors. It is used mainly in the maintenance of 15 5* message status lists. */ 15 6 15 7 /* Bob May, 6/30/77 */ 15 8 15 9 dcl vfile_rs_version fixed bin int static options (constant) init (1); 15 10 15 11 dcl vfile_rs_ptr ptr; 15 12 15 13 dcl 1 vfile_rs aligned based (vfile_rs_ptr), 15 14 2 version fixed bin, /* currently must be set to 1 */ 15 15 2 flags, 15 16 (3 lock_sw bit (1), /* "1"b */ 15 17 3 unlock_sw bit (1), /* "1"b */ 15 18 3 create_sw bit (1), /* "0"b */ 15 19 /* switch separator */ 15 20 3 locate_sw bit (1), /* "0"b for current_rec, "1"b to use descriptor */ 15 21 3 filler bit (32)) unaligned, /* (32) "0"b */ 15 22 2 rec_len fixed bin (21), 15 23 2 max_rec_len fixed bin (21), 15 24 2 rec_ptr ptr, 15 25 2 descr like vfile_descr, /* process INdependent addressing */ 15 26 2 filler fixed bin; /* 0 */ 15 27 15 28 dcl 1 vfile_descr, /* process INdependent addressing */ 15 29 (2 comp_no fixed bin (17), /* component of MSF */ 15 30 2 comp_offset bit (18)) unaligned; /* offset of record in component */ 15 31 15 32 /* END INCLUDE FILE... cmcs_vfile_rs.incl.pl1 */ 211 16 1 /* BEGIN INCLUDE FILE... cmcs_wait_ctl.incl.pl1 */ 16 2 16 3 /* This include file defines the wait control structure for COBOL MCS */ 16 4 16 5 /* Bob May, 5/31/77 */ 16 6 16 7 dcl (wait_ctl_hdr_len init (32), 16 8 wait_ctl_entry_len init (32), 16 9 wait_ctl_version init (1)) fixed bin int static options (constant); 16 10 16 11 dcl wait_ctl_ptr ptr int static; 16 12 16 13 dcl 1 wait_ctl aligned based (wait_ctl_ptr), 16 14 2 hdr like control_hdr, 16 15 2 linked_lists, /* to maintain FIFO processing */ 16 16 3 used, 16 17 4 count fixed bin, 16 18 (4 findex, 16 19 4 bindex) fixed bin (18), 16 20 3 free, 16 21 4 count fixed bin, 16 22 (4 findex, 16 23 4 bindex) fixed bin (18), 16 24 2 mp_info, /* for the message processors */ 16 25 3 mp_lockword bit (36) aligned, 16 26 3 mp_current_size fixed bin, /* max of 10 */ 16 27 3 mp_active_count fixed bin, /* <= current_size */ 16 28 3 mp_entries (10) like wait_ctl_mp_entry, 16 29 2 entries (wait_ctl.current_size) like wait_ctl_entry; 16 30 16 31 dcl wait_ctl_eindex fixed bin; 16 32 16 33 dcl wait_ctl_eptr ptr; 16 34 16 35 dcl 1 wait_ctl_entry aligned based (wait_ctl_eptr), 16 36 2 linked_list_indexes, 16 37 (3 findex, 16 38 3 bindex) fixed bin (18), /* should be FB (18) unsigned */ 16 39 2 lockword bit (36) aligned, /* process that has a msg */ 16 40 2 entry_status fixed bin, /* 0 = free, 1 = used */ 16 41 2 rcv_process_id bit (36), /* process that wants a msg */ 16 42 2 rcv_tree_path, 16 43 3 level_names (4) char (12), /* from receive request */ 16 44 2 abs_tree_path, 16 45 3 level_names (4) char (12), /* full hierarchy path of queue */ 16 46 2 queue_ctl_eindex fixed bin, /* corresponds to abs_tree_path */ 16 47 2 ev_wait_chn fixed bin (71), /* set by requestor */ 16 48 2 ev_message fixed bin (71), 16 49 2 queue_name char (32), /* physical queue where it is */ 16 50 2 tree_ctl_eindex fixed bin; /* back to tree_ctl to set up I/O control */ 16 51 16 52 dcl wait_ctl_mp_eindex fixed bin; 16 53 16 54 dcl wait_ctl_mp_eptr ptr; 16 55 16 56 dcl 1 wait_ctl_mp_entry aligned based (wait_ctl_mp_eptr), 16 57 2 process_id bit (36), 16 58 2 flags, 16 59 (3 available_sw bit (1), /* ready to process another message */ 16 60 3 filler bit (35)) unaligned, 16 61 2 ev_wait_chn fixed bin (71), 16 62 2 ev_message fixed bin (71), /* (currently unused) anything in addition to ipc_ message */ 16 63 2 tree_ctl_eindex fixed bin; 16 64 16 65 /* END INCLUDE FILE... cmcs_wait_ctl.incl.pl1 */ 212 213 /* */ 214 set: 215 proc; 216 217 /*[4.4-2]*/ 218 if ^external_user_ctl_ptr -> user_ctl.init_sw.queue_ctl 219 then call setup; 220 221 end; 222 223 accept_message_count: 224 entry (a_input_cdp, a_io_subtype, a_code); 225 226 /*[4.4-2]*/ 227 call set; 228 229 input_cdp = a_input_cdp; 230 io_type = 5; 231 io_subtype = a_io_subtype; 232 233 call build_queue_table (); 234 235 if a_code ^= 0 236 then return; /* build_queue_table sets status_key */ 237 238 msg_count = 0; /* accumulative */ 239 240 do i = 1 to queue_table_len; /* sum individual counts for this specific request */ 241 242 queue_ctl_eindex = queue_table (i); 243 queue_ctl_eptr = addr (queue_ctl.entries (queue_ctl_eindex)); 244 245 /* accumulated count is not a "locked" count, since it can change before the user does a receive anyway */ 246 247 msg_count = msg_count + queue_ctl_entry.status_list_ctl_entries (2).count; 248 /* count only available msgs */ 249 250 end; 251 252 input_cd.msg_count = msg_count; /* fixed bin -> char, required by COBOL */ 253 input_cd.status_key = "00"; 254 255 return; 256 257 /* end of accept_message_count entrypoint */ 258 259 /* */ 260 261 disable: 262 entry (a_input_cdp, a_io_subtype, a_password, a_code); /* strictly for queues, not stations */ 263 264 /*[4.4-2]*/ 265 call set; 266 267 input_cdp = a_input_cdp; 268 io_type = 4; 269 io_subtype = a_io_subtype; 270 271 call build_queue_table; 272 273 if a_code ^= 0 274 then return; 275 276 code = 0; 277 278 do i = 1 to queue_table_len; 279 280 queue_ctl_eindex = queue_table (i); 281 queue_ctl_eptr = addr (queue_ctl.entries (queue_ctl_eindex)); 282 283 if ^queue_ctl_entry.input_disabled_sw 284 then queue_ctl_entry.input_disabled_sw = "1"b; 285 else code = cmcs_error_table_$queue_already_disabled; 286 287 end; 288 289 a_code = code; /* whatever the results, status_key here is "00" */ 290 input_cd.status_key = "00"; 291 292 return; 293 294 /* end of disable entrypoint */ 295 296 /* */ 297 298 enable: 299 entry (a_input_cdp, a_io_subtype, a_password, a_code); /* strictly for queues, not stations */ 300 301 /*[4.4-2]*/ 302 call set; 303 304 input_cdp = a_input_cdp; 305 io_type = 3; 306 io_subtype = a_io_subtype; 307 308 call build_queue_table; 309 310 if a_code ^= 0 311 then return; 312 313 code = 0; 314 315 do i = 1 to queue_table_len; 316 317 queue_ctl_eindex = queue_table (i); 318 queue_ctl_eptr = addr (queue_ctl.entries (queue_ctl_eindex)); 319 320 if queue_ctl_entry.input_disabled_sw 321 then queue_ctl_entry.input_disabled_sw = "0"b; 322 323 else code = cmcs_error_table_$queue_already_enabled; 324 325 end; 326 327 a_code = code; /* whatever the results, status_key here is "00" */ 328 input_cd.status_key = "00"; 329 330 return; 331 332 /* end of enable entrypoint */ 333 334 /* */ 335 336 stop_run: 337 entry (a_io_subtype, a_code); /* for now, a_io_subtype must always be 1 */ 338 339 io_type = 8; /* for use in purge_common */ 340 cdp = null (); 341 342 go to purge_common; 343 344 /* */ 345 346 purge: 347 entry (a_cdp, a_io_subtype, a_code); 348 349 io_type = 6; /* to identify purge request */ 350 cdp = a_cdp; 351 352 /* From now on, purge and stop_run share common code. */ 353 354 purge_common: 355 dest_table_index = 0; 356 a_code = 0; 357 358 /*[4.4-2]*/ 359 call set; 360 361 io_subtype = a_io_subtype; 362 363 /* if the cdp is null, we delete all sends and/or receives */ 364 365 if cdp = null () 366 then do; 367 368 do tree_ctl_eindex = 1 to tree_ctl.hdr.current_size; 369 370 tree_ctl_eptr = addr (tree_ctl.entries (tree_ctl_eindex)); 371 if tree_ctl_entry.subtree_count = 0 372 then if tree_ctl_entry.io_in_process_sw 373 then do; /* active entry */ 374 375 call get_tce_parms; 376 377 if tree_ctl_entry.io_type = 1 378 then if ^(io_type = 6 & io_subtype = 2) 379 /* specifically shouldn't do sends */ 380 then do; 381 382 call purge_send_entry; 383 end; 384 else ; 385 else if tree_ctl_entry.io_type = 2 | tree_ctl_entry.io_type = 7 386 then if ^(io_type = 6 & io_subtype = 1) 387 /* specifically shouldn't do receives */ 388 then do; 389 390 call purge_rcv_entry; 391 392 end; 393 394 end; 395 396 if tree_ctl_entry.iocb_ptr ^= null () 397 then call close; 398 399 end; 400 401 a_code = 0; 402 403 return; 404 end; /* of code for null cdp */ 405 406 /* Drop-thru means the cdp wasn't null. Thus, we must be in purge, not stop_run. */ 407 408 409 a_code = 0; /* set zero now, to let first error set non-zero */ 410 411 if io_subtype = 1 412 then do; /* purge sends only */ 413 414 output_cdp = cdp; 415 output_cd.status_key = "00"; /* initialize good, set only on first error */ 416 417 station_count = output_cd.station_count;/* thank heavens for pictures */ 418 419 do dest_table_index = 1 to station_count; 420 421 station_name = output_cd.dest_table (dest_table_index).station_name; 422 423 call cmcs_tree_ctl_$find_destination (station_name, tree_ctl_eindex, tree_ctl_eptr, code); 424 425 if code ^= 0 426 then do; 427 if a_code = 0 428 then do; 429 430 a_code = code; 431 output_cd.status_key = "20"; 432 433 end; 434 435 output_cd.dest_table (dest_table_index).error_key = "1"; 436 437 go to send_loop_end; 438 end; 439 440 call get_tce_parms; 441 call purge_send_entry; 442 443 if code ^= 0 444 then do; 445 446 if a_code = 0 447 then do; 448 a_code = code; 449 output_cd.status_key = "20"; 450 end; 451 452 output_cd.dest_table (dest_table_index).error_key = "1"; 453 454 go to send_loop_end; 455 456 end; 457 end; 458 end; /* of purges of sends, using supplied cdp */ 459 460 else if a_io_subtype = 2 /* just purge the receives */ 461 then do; 462 463 input_cdp = cdp; 464 input_cd.status_key = "00"; /* set good now, change if needed */ 465 466 call cmcs_tree_ctl_$find_tree_path (input_cdp, tree_ctl_eindex, subtree_count, tree_ctl_eptr, code); 467 468 if code ^= 0 469 then do; 470 471 purge_set_input_err: 472 input_cd.status_key = "20"; 473 a_code = code; 474 return; 475 end; 476 477 if subtree_count = 0 478 then do; 479 480 call get_tce_parms; 481 call purge_rcv_entry; 482 483 if code ^= 0 484 then go to purge_set_input_err; 485 486 end; 487 else do i = tree_ctl_eindex to tree_ctl_eindex + subtree_count - 1; 488 489 tree_ctl_eptr = addr (tree_ctl.entries (i)); 490 491 if tree_ctl_entry.subtree_count = 0 492 then do; 493 494 call get_tce_parms; 495 call purge_rcv_entry; 496 497 if code ^= 0 498 then if a_code = 0 499 then do; 500 501 a_code = code; 502 input_cd.status_key = "20"; 503 504 end; 505 end; 506 end; /* purge rcv subtree loop */ 507 508 end; 509 510 return; 511 512 /* */ 513 514 get_tce_parms: 515 proc (); 516 517 queue_ctl_eindex = tree_ctl_entry.queue_ctl_eindex; 518 queue_ctl_eptr = addr (queue_ctl.entries (queue_ctl_eindex)); 519 iocb_ptr = tree_ctl_entry.iocb_ptr; 520 msg_descr = tree_ctl_entry.msg_descr; 521 msg_no = tree_ctl_entry.msg_no; 522 523 return; 524 525 end /* get_tce_parms */; 526 527 /* */ 528 529 purge_rcv_entry: 530 proc (); 531 532 if ^tree_ctl_entry.io_in_process_sw 533 then do; 534 535 code = cmcs_error_table_$no_partial_messages; 536 537 return; 538 539 end; 540 541 /* Move the message from in-process back to available */ 542 543 call cmcs_status_list_ctl_$move (queue_ctl_eptr, iocb_ptr, addr (msg_descr), 3, 2, code); 544 545 if code ^= 0 546 then call sub_err_ (code, my_name, "c", null (), sub_err_retval, 547 "Attempting to move message (^d in ^a) from status-3 back to status-2. Continuing.", msg_no, 548 tree_ctl_entry.queue_name); 549 550 call reset_tce_io; 551 552 return; 553 554 end /* purge_rcv_entry */; 555 556 /* */ 557 558 purge_send_entry: 559 proc (); 560 561 /* This procedure assumes that tree_ctl_eptr and dest_table_index are correctly set by the caller */ 562 563 if ^tree_ctl_entry.io_in_process_sw 564 then do; 565 566 code = cmcs_error_table_$no_partial_messages; 567 568 return; 569 570 end; 571 572 if tree_ctl_entry.partial_in_process_sw 573 then do; 574 575 tree_ctl_entry.tseg_len = 0; 576 577 call hcs_$truncate_seg (tree_ctl_entry.tseg_ptr, 0, code); 578 579 if code ^= 0 580 then call sub_err_ (code, my_name, "c", null (), sub_err_retval, 581 "Attempting to truncate the temporary data segment for ^a. Continuing.", 582 tree_ctl_entry.queue_name); 583 tree_ctl_entry.partial_in_process_sw = "0"b; 584 585 end; /* of partial seg processing */ 586 587 if tree_ctl_entry.seg_count > 0 588 then do; /* physical records exist and must be deleted */ 589 590 call cmcs_status_list_ctl_$delete (queue_ctl_eptr, iocb_ptr, addr (msg_descr), 1, code); 591 592 if code ^= 0 593 then call sub_err_ (code, my_name, "c", null (), sub_err_retval, 594 "Attempting to delete message (^d in ^a) from status-1. Continuing.", msg_no, 595 tree_ctl_entry.queue_name); 596 597 key_struc.msg_no = msg_no; 598 do seg_no = 1 to tree_ctl_entry.seg_count; 599 600 key_struc.seg_no = seg_no; 601 key = based_key; /* to keep vfile_ happy */ 602 603 call iox_$seek_key (iocb_ptr, key, fb21, code); 604 605 if code ^= 0 606 then do; 607 608 call sub_err_ (code, my_name, "c", null (), sub_err_retval, 609 "Attempting to seek message segment (^d/^d in ^a) for deletion. Continuing.", 610 msg_no, seg_no, tree_ctl_entry.queue_name); 611 612 go to end_delete_msg_seg_loop; 613 614 end; 615 616 call iox_$delete_record (iocb_ptr, code); 617 618 if code ^= 0 619 then call sub_err_ (code, my_name, "c", null (), sub_err_retval, 620 "Attempting to delete message segment (^d/^d in ^a). Continuing.", msg_no, seg_no, 621 tree_ctl_entry.queue_name); 622 623 end_delete_msg_seg_loop: 624 end; 625 end; /* seg_count > 0 */ 626 627 if io_type = 6 & dest_table_index ^= 0 628 then do; 629 630 call cmcs_station_ctl_$validate (station_name, station_ctl_eindex, code); 631 /* just to get the entry index */ 632 call cmcs_station_ctl_$output_disabled (station_ctl_eindex, flag, code); 633 634 if flag 635 then do; 636 code = cmcs_error_table_$dest_disabled; 637 638 if a_code = 0 639 then do; 640 641 a_code = code; 642 output_cd.status_key = "10"; 643 end; 644 645 output_cd.dest_table (dest_table_index).error_key = "1"; 646 647 end; 648 end; 649 650 call reset_tce_io; 651 652 return; 653 654 end /* purge_send_entry */; 655 656 /* */ 657 658 print: 659 entry (a_input_cdp, a_io_subtype, a_iocb_ptr, a_code); 660 661 io_type = 7; /* to distinguish from receive in common code */ 662 663 go to rcv_common; 664 665 /* */ 666 667 receive: 668 entry (a_input_cdp, a_io_subtype, a_buffer_ptr, a_buffer_len, a_code); 669 670 io_type = 2; /* to indicate receive in common code */ 671 672 rcv_common: /* from here on, receive and print are nearly the same */ 673 /*[4.4-2]*/ 674 call set; 675 676 if ^rcv_init_sw 677 then do; /* do only 1st time entered */ 678 679 rcv_descr_ptr = addr (rcv_descr); 680 rcv_vfile_rs_ptr = addr (rcv_vfile_rs); 681 overlay_len = size (rcv_vfile_rs); 682 rcv_vfile_rs_ptr -> overlay (*) = 0; 683 rcv_vfile_rs.version = vfile_rs_version; 684 rcv_vfile_rs.lock_sw, /* locate switch set dynamically */ 685 rcv_vfile_rs.unlock_sw = "0"b; 686 687 /* We don't need to lock individual records because no two processes will ever be operating 688* on the same message number at the same time. They are locked out at queue_ctl level. */ 689 690 rcv_init_sw = "1"b; 691 692 end; 693 694 /* set basic controls */ 695 696 input_cdp = a_input_cdp; 697 io_subtype = a_io_subtype; 698 699 /* First check for ambiguous tree_path. ANSI says that results from the specification of an ambiguous tree path 700* are vendor defined. This implementation defines this situation to be an error. */ 701 702 call build_queue_table; /* sets tree_ctl_e(index ptr) */ 703 704 if a_code ^= 0 705 then return; /* status key already set */ 706 707 if subtree_count ^= 0 708 then do; 709 710 call rcv_check_io_in_process; 711 712 if a_code ^= 0 713 then return; /* nonzero is ambiguous_tree_path */ 714 715 end; 716 else if tree_ctl_entry.io_in_process_sw 717 then do; 718 719 if io_type ^= tree_ctl_entry.io_type /* don't let them do a receive, for example */ 720 then do; 721 722 a_code = error_table_$action_not_performed; 723 724 /*[4.4-6]*/ 725 if ^user_ctl.rec 726 then call sub_err_ (a_code, my_name, "c", null (), sub_err_retval, 727 "Attempting to do a receive on tree path ""^a"" 728 when another I/O operation (^d) is already in process. 729 Returning a status key of ""20"".", string (tree_ctl_entry.tree_path), tree_ctl_entry.io_type); 730 731 input_cd.status_key = "20"; 732 733 return; 734 735 end; 736 737 iocb_ptr = tree_ctl_entry.iocb_ptr; 738 queue_ctl_eindex = tree_ctl_entry.queue_ctl_eindex; 739 queue_ctl_eptr = addr (queue_ctl.entries (queue_ctl_eindex)); 740 741 call rcv_set_type; /* reset the old and set the new */ 742 743 if io_type = 7 744 then go to rcv_get_next_seg; /* only for print */ 745 746 call rcv_set_buffer; 747 748 go to rcv_copy_seg_data; /* only for receive */ 749 750 end; 751 752 /* drop-through means no io_in_process, check first if terminal output disabled */ 753 754 rcv_find_msg: 755 if user_ctl.terminal_sw 756 then do; 757 758 call cmcs_station_ctl_$output_disabled (user_ctl.station_ctl_eindex, flag, a_code); 759 760 if a_code ^= 0 761 then return; 762 763 if flag 764 then do; 765 a_code = cmcs_error_table_$dest_disabled; 766 return; 767 end; 768 769 end; 770 771 call qc_lock; /* so we can safely acquire a message */ 772 773 if code ^= 0 774 then do; /* should never happen */ 775 776 rcv_lock_err: /*[4.4-6]*/ 777 if ^user_ctl.rec 778 then call sub_err_ (code, my_name, "c", null (), sub_err_retval, 779 "Problem locking queue_ctl to receive message. Return to COBOL program with status key of ""20""." 780 ); 781 a_code = code; 782 783 input_cd.status_key = "20"; 784 return; 785 786 end; 787 788 if subtree_count = 0 789 then do; /* user gave abs_tree_path */ 790 791 queue_ctl_eindex = tree_ctl_entry.queue_ctl_eindex; 792 queue_ctl_eptr = addr (queue_ctl.entries (queue_ctl_eindex)); 793 794 if queue_ctl_entry.status_list_ctl_entries (2).count = 0 795 then do; 796 797 rcv_no_msg: 798 if io_type = 2 & (io_subtype = 3 | io_subtype = 4) 799 then go to rcv_wait_msg; 800 801 a_code = cmcs_error_table_$no_message; 802 input_cd.status_key = "00"; /* no-message is not an error */ 803 804 call qc_unlock; 805 806 return; 807 808 end; 809 810 go to rcv_found_msg; 811 812 end; 813 814 /* no abs path, must look in entire subtree */ 815 816 else do; /* queue ctl still locked from above */ 817 818 do i = 1 to queue_table_len; 819 820 queue_ctl_eindex = queue_table (i); 821 queue_ctl_eptr = addr (queue_ctl.entries (queue_ctl_eindex)); 822 823 if queue_ctl_entry.status_list_ctl_entries (2).count ^= 0 824 then go to rcv_found_msg; 825 826 end; 827 828 /* fell through, no messages in the subtree */ 829 830 go to rcv_no_msg; 831 832 end; 833 834 rcv_wait_msg: /* come here to sit and wait */ 835 call qc_unlock; /* don't keep locked or we'll have problems */ 836 837 on program_interrupt 838 begin; /* interactive user got tired of waiting */ 839 840 call cmcs_wait_ctl_$delete (user_ctl.wait_ctl_eindex, a_code); 841 842 a_code = cmcs_error_table_$no_message; 843 input_cd.status_key = "20"; /* we can't say anything more meaningful */ 844 845 /*[4.4-6]*/ 846 if ^user_ctl.rec 847 then call sub_err_ (a_code, my_name, "h", null (), sub_err_retval, 848 "Program Interrupt occurred while waiting for message. 849 Type ""start"" to return to COBOL program with status key of ""20""."); 850 851 go to rcv_error_return; 852 853 end; 854 855 call cmcs_wait_ctl_$add (string (input_cd.tree_path), user_ctl.wait_ctl_eindex, a_code); 856 857 /* When we reach here, we either went to sleep and have been awakened with a message, or 858* wait ctl rejected our request to add our entry to its list. */ 859 860 revert program_interrupt; 861 862 if a_code ^= 0 863 then do; /* should never happen */ 864 865 rcv_error_return: 866 input_cd.status_key = "20"; 867 return; 868 869 end; 870 871 872 /* We had a good sleep and were awakened with a message. Get the info about the message from the wait ctl entry 873* and attempt to get it before someone else does. If we fail, just loop back on the wait again. */ 874 875 876 wait_ctl_eindex = user_ctl.wait_ctl_eindex; 877 wait_ctl_eptr = addr (wait_ctl.entries (wait_ctl_eindex)); 878 879 queue_ctl_eindex = wait_ctl_entry.queue_ctl_eindex; 880 queue_ctl_eptr = addr (queue_ctl.entries (queue_ctl_eindex)); 881 882 tree_ctl_eindex = wait_ctl_entry.tree_ctl_eindex; 883 tree_ctl_eptr = addr (tree_ctl.entries (tree_ctl_eindex)); 884 885 call qc_lock; 886 887 if code ^= 0 888 then go to rcv_lock_err; /* should never happen */ 889 890 if queue_ctl_entry.status_list_ctl_entries (2).count = 0 891 then do; /* we missed it */ 892 893 /*[4.4-6]*/ 894 if ^user_ctl.rec 895 then call sub_err_ (0, my_name, "c", null (), sub_err_retval, 896 "Missed locking record from receive wait. Will wait for another."); 897 898 go to rcv_wait_msg; /* unlock queue ctl there */ 899 900 end; 901 902 /* Getting here means that we actually detected an available msg in queue ctl. 903* Now we must access it to be sure we really did get it. */ 904 905 call cmcs_wait_ctl_$delete (wait_ctl_eindex, code); 906 907 if code ^= 0 908 then do; 909 910 /*[4.4-6]*/ 911 if ^user_ctl.rec 912 then call sub_err_ (code, my_name, "c", null (), sub_err_retval, 913 "Unexpected error code from deleting entry in wait_ctl. Continuing."); 914 915 end; 916 917 go to rcv_set_msg_busy; /* all indices and ptrs already set */ 918 919 rcv_found_msg: /* Getting here means that we found a message without having to wait for it. queue_ctl_eindex and queue_ctl_eptr 920* must have been set already. */ 921 tree_ctl_eindex = queue_ctl_entry.tree_ctl_eindex; 922 tree_ctl_eptr = addr (tree_ctl.entries (tree_ctl_eindex)); 923 924 rcv_set_msg_busy: /* the lock, all ptrs, etc, must already be set */ 925 call reset_tce_io; /* start clean */ 926 call open; /* make sure the file is usable */ 927 928 if code ^= 0 929 then do; 930 931 rcv_queue_err: /* should never happen */ 932 /*[4.4-6]*/ 933 if ^user_ctl.rec 934 then call sub_err_ (code, my_name, "c", null (), sub_err_retval, 935 "Attempting to process queue ""^a"" for receive. Returning to COBOL program with status key of ""20"".", 936 tree_ctl_entry.queue_name); 937 938 a_code = code; 939 input_cd.status_key = "20"; 940 941 call qc_unlock; /* ignore error code */ 942 943 return; 944 945 end; 946 947 rcv_descr, tree_ctl_entry.msg_descr = queue_ctl_entry.status_list_ctl_entries (2).f_descr; 948 949 call cmcs_status_list_ctl_$move (queue_ctl_eptr, iocb_ptr, rcv_descr_ptr, 2, 3, code); 950 951 /* move msg from available to busy */ 952 953 if code ^= 0 954 then go to rcv_queue_err; /* should never happen */ 955 956 /* The msg is now truly ours. Indicate that I/O is truly in_process and set appropriate control info */ 957 958 call qc_unlock; /* ignore status */ 959 960 /* Initialize Message Control Info */ 961 962 call rcv_set_type; 963 964 call rcv_seek_descr; /* make msg known to process */ 965 966 if code ^= 0 967 then go to rcv_queue_err; /* should never happen */ 968 969 msg_hdr_ptr, tree_ctl_entry.msg_hdr_ptr = rcv_vfile_rs.rec_ptr; 970 971 tree_ctl_entry.seg_count = msg_hdr.seg_count; /* don't reference the hdr again until we're thru with it */ 972 tree_ctl_entry.msg_len = msg_hdr.msg_len; 973 974 975 /* Set Input CD Info */ 976 977 input_cd.station_name = msg_hdr.source_station; 978 979 call cmcs_date_time_ (msg_hdr.clock_available, input_cd.msg_date, input_cd.msg_time); 980 981 string (input_cd.tree_path) = string (tree_ctl_entry.tree_path); 982 983 msg_no, tree_ctl_entry.msg_no, key_struc.msg_no = msg_hdr.msg_no; 984 seg_no, tree_ctl_entry.seg_no, key_struc.seg_no = msg_hdr.seg_no; 985 msg_seg_ptr, tree_ctl_entry.msg_seg_ptr = addr (msg_hdr.msg_seg); 986 987 /* Check for and Initialize Buffer Control */ 988 989 if io_type = 2 990 then do; /* it's a rcv request */ 991 call rcv_set_buffer; 992 end; 993 994 /* Initialize Segment Control */ 995 996 rcv_set_seg_ctl: 997 tree_ctl_entry.msg_seg_len, tree_ctl_entry.msg_seg_left_len = msg_seg.hdr.seg_len; 998 tree_ctl_entry.msg_seg_left_index = 1; 999 1000 if io_type = 7 1001 then do; /* must be a print request (7) */ 1002 1003 call cmcs_print_ (a_iocb_ptr, addr (msg_seg.data.seg_data), msg_seg.hdr.seg_len, 1004 addr (msg_seg.hdr.slew_ctl), code); 1005 1006 go to rcv_check_for_more_segs; /* ignore return status */ 1007 1008 end; 1009 1010 /* Processing a receive request instead */ 1011 1012 rcv_copy_seg_data: 1013 if tree_ctl_entry.msg_seg_left_len = 0 1014 then go to rcv_check_for_more_segs; 1015 1016 if tree_ctl_entry.buffer_left_len = 0 1017 then do; /* couldn't use up segment/message */ 1018 1019 input_cd.text_len = tree_ctl_entry.buffer_len; 1020 input_cd.text_delim = 0; /* more to come */ 1021 input_cd.status_key = "00"; 1022 a_code = 0; 1023 1024 return; 1025 end; 1026 1027 copy_len = min (tree_ctl_entry.msg_seg_left_len, tree_ctl_entry.buffer_left_len); 1028 1029 substr (buffer, tree_ctl_entry.buffer_left_index, copy_len) = 1030 substr (msg_seg.data.seg_data, tree_ctl_entry.msg_seg_left_index, copy_len); 1031 1032 tree_ctl_entry.msg_seg_left_index = tree_ctl_entry.msg_seg_left_index + copy_len; 1033 tree_ctl_entry.msg_seg_left_len = tree_ctl_entry.msg_seg_left_len - copy_len; 1034 tree_ctl_entry.buffer_left_index = tree_ctl_entry.buffer_left_index + copy_len; 1035 tree_ctl_entry.buffer_left_len = tree_ctl_entry.buffer_left_len - copy_len; 1036 1037 go to rcv_copy_seg_data; /* one of the two tests must fail */ 1038 1039 rcv_check_for_more_segs: 1040 if tree_ctl_entry.seg_count = tree_ctl_entry.seg_no 1041 then do; /* no more segs, message is exhausted */ 1042 1043 msg_hdr_ptr = tree_ctl_entry.msg_hdr_ptr; 1044 msg_hdr.clock_deleted = clock_ (); /* for future statistics */ 1045 input_cd.text_delim = msg_hdr.final_delim; 1046 input_cd.text_len = tree_ctl_entry.buffer_left_index - 1; 1047 tree_ctl_entry.io_in_process_sw = "0"b; 1048 rcv_descr = tree_ctl_entry.msg_descr; 1049 1050 1051 call qc_lock; 1052 1053 if code ^= 0 1054 then go to rcv_queue_err; 1055 1056 call cmcs_status_list_ctl_$move (queue_ctl_eptr, tree_ctl_entry.iocb_ptr, rcv_descr_ptr, 3, 4, code); 1057 /* move from busy to used */ 1058 1059 if code ^= 0 1060 then do; /* should never happen */ 1061 1062 /*[4.4-6]*/ 1063 if ^user_ctl.rec 1064 then call sub_err_ (code, my_name, "c", null (), sub_err_retval, 1065 "Attempting to put msg in ""used"" status list. Continuing."); 1066 end; 1067 1068 call qc_unlock; /* ignore status */ 1069 1070 input_cd.status_key = "00"; 1071 a_code = 0; 1072 1073 return; 1074 1075 end; 1076 1077 /* more segs available if we want them */ 1078 1079 if tree_ctl_entry.rcv_seg_sw 1080 then do; /* just wants one seg at a time */ 1081 1082 input_cd.text_delim = 1; /* mark as seg delim */ 1083 input_cd.text_len = tree_ctl_entry.buffer_left_index - 1; 1084 input_cd.status_key = "00"; 1085 a_code = 0; 1086 1087 return; 1088 1089 end; 1090 1091 /* User does want full message instead of just a segment */ 1092 1093 rcv_get_next_seg: /* we already know there is one */ 1094 seg_no, key_struc.seg_no, tree_ctl_entry.seg_no = tree_ctl_entry.seg_no + 1; 1095 1096 msg_no, key_struc.msg_no = tree_ctl_entry.msg_no; 1097 1098 call rcv_seek_key; 1099 1100 if code ^= 0 1101 then do; 1102 1103 /*[4.4-6]*/ 1104 if ^user_ctl.rec 1105 then call sub_err_ (code, my_name, "c", null (), sub_err_retval, 1106 "Attempting to seek another segment of current message. 1107 Returning to COBOL program with status key of ""20""."); 1108 1109 a_code = code; 1110 input_cd.status_key = "20"; 1111 1112 return; 1113 1114 end; 1115 1116 msg_seg_ptr, tree_ctl_entry.msg_seg_ptr = rcv_vfile_rs.rec_ptr; 1117 1118 go to rcv_set_seg_ctl; 1119 1120 1121 /* */ 1122 1123 rcv_seek_key: 1124 proc (); 1125 1126 key = based_key; 1127 1128 call iox_$seek_key (tree_ctl_entry.iocb_ptr, key, fb21, code); 1129 1130 if code ^= 0 1131 then return; 1132 1133 rcv_vfile_rs.locate_sw = "0"b; /* use the record found by the seek */ 1134 1135 call iox_$control (tree_ctl_entry.iocb_ptr, "record_status", rcv_vfile_rs_ptr, code); 1136 1137 if code = 0 1138 then rcv_descr = rcv_vfile_rs.descr; 1139 else rcv_descr = zero_descr; 1140 1141 return; /* with last code */ 1142 1143 end /* rcv_seek_key */; 1144 1145 /* */ 1146 1147 rcv_seek_descr: 1148 proc (); 1149 1150 rcv_vfile_rs.descr = rcv_descr; 1151 rcv_vfile_rs.locate_sw = "1"b; 1152 1153 call iox_$control (tree_ctl_entry.iocb_ptr, "record_status", rcv_vfile_rs_ptr, code); 1154 1155 return; 1156 1157 end /* rcv_seek_descr */; 1158 1159 /* */ 1160 1161 rcv_check_io_in_process: 1162 proc (); 1163 1164 /* Assumes that tree_ctl_entry is set to starting node of subtree to be checked, and that subtree_count, 1165* always non_zero, includes the starting node. Both get set in call to build_queue_table. 1166* 1167* This procedure leaves the tree_ctl_eindex and tree_ctl_eptr intact with their original values upon exit. */ 1168 1169 1170 1171 do i = tree_ctl_eindex + 1 to tree_ctl_eindex + subtree_count; 1172 /* we know the top node is not a queue */ 1173 1174 tree_ctl_eptr = addr (tree_ctl.entries (i)); 1175 1176 if tree_ctl_entry.subtree_count = 0 /* first find an entry for a queue */ 1177 then if tree_ctl_entry.io_in_process_sw 1178 then if tree_ctl_entry.io_type = 2 | tree_ctl_entry.io_type = 7 1179 then do; 1180 1181 a_code = cmcs_error_table_$ambiguous_tree_path; 1182 input_cd.status_key = "20"; 1183 return; 1184 1185 end; 1186 end; 1187 1188 tree_ctl_eptr = addr (tree_ctl.entries (tree_ctl_eindex)); 1189 /* restore to original value just in case */ 1190 a_code = 0; 1191 1192 return; 1193 1194 end /* rcv_check_io_in_process */; 1195 1196 /* */ 1197 1198 build_queue_table: 1199 proc (); 1200 1201 /* If subtree_count = 0, then tree_ctl_eindex and tree_ctl_eptr are set. Otherwise not. */ 1202 1203 if ^init_queue_table_sw 1204 then do; 1205 1206 allocate queue_table_struc; 1207 init_queue_table_sw = "1"b; 1208 end; 1209 1210 call cmcs_tree_ctl_$find_tree_path (input_cdp, tree_ctl_eindex, subtree_count, tree_ctl_eptr, a_code); 1211 1212 if a_code ^= 0 1213 then do; 1214 1215 input_cd.status_key = "20"; 1216 1217 return; 1218 end; 1219 1220 if subtree_count = 0 1221 then do; /* we hit a queue entry all by itself */ 1222 1223 queue_table_len = 1; 1224 queue_table (1) = tree_ctl.entries (tree_ctl_eindex).queue_ctl_eindex; 1225 1226 return; 1227 1228 end; 1229 else do; 1230 1231 queue_table_len = 0; 1232 1233 do i = tree_ctl_eindex + 1 to tree_ctl_eindex + subtree_count; 1234 1235 tree_ctl_eptr = addr (tree_ctl.entries (i)); 1236 1237 if tree_ctl_entry.subtree_count = 0 1238 then do; /* found a queue entry */ 1239 1240 queue_table_len = queue_table_len + 1; 1241 queue_table (queue_table_len) = tree_ctl_entry.queue_ctl_eindex; 1242 1243 end; 1244 end; 1245 end; 1246 1247 return; 1248 1249 end /* build_queue_table */; 1250 1251 /* */ 1252 1253 rcv_set_type: 1254 proc (); 1255 1256 string (tree_ctl_entry.io_flags) = (36)"0"b; 1257 tree_ctl_entry.io_in_process_sw = "1"b; 1258 tree_ctl_entry.io_type = io_type; 1259 tree_ctl_entry.io_subtype = io_subtype; 1260 1261 if io_type = 2 1262 then if io_subtype = 3 | io_subtype = 4 1263 then tree_ctl_entry.rcv_wait_sw = "1"b; 1264 1265 tree_ctl_entry.rcv_seg_sw, tree_ctl_entry.rcv_msg_sw = "0"b; 1266 /* init both to false and then set one true */ 1267 1268 if io_subtype = 1 | io_subtype = 3 1269 then tree_ctl_entry.rcv_seg_sw = "1"b; /* print subtype 1 and rcv subtype 1 are the same */ 1270 else tree_ctl_entry.rcv_msg_sw = "1"b; 1271 1272 return; 1273 1274 end /* rcv_set_type */; 1275 1276 1277 /* */ 1278 1279 rcv_set_buffer: 1280 proc (); 1281 1282 buffer_ptr = a_buffer_ptr; 1283 buffer_len, tree_ctl_entry.buffer_len, tree_ctl_entry.buffer_left_len = a_buffer_len; 1284 1285 buffer_left_index, tree_ctl_entry.buffer_left_index = 1; 1286 1287 end /* rcv_set_buffer */; 1288 1289 /* */ 1290 1291 send: 1292 entry (a_output_cdp, a_io_subtype, a_buffer_ptr, a_buffer_len, a_station_count, a_slew_ctl, a_code); 1293 1294 /*[4.4-2]*/ 1295 call set; 1296 1297 if ^send_init_sw 1298 then call send_init; 1299 1300 /* from now on, a_code gets set only with the first non-zero status code returned */ 1301 1302 output_cdp = a_output_cdp; 1303 io_type = 1; 1304 new_status, io_subtype = a_io_subtype; /* get old status later from tree_ctl_entry */ 1305 1306 if new_status = 3 1307 then new_status = 2; /* EMI and EGI are the same for us */ 1308 1309 buffer_ptr = a_buffer_ptr; 1310 buffer_len = a_buffer_len; 1311 station_count = a_station_count; 1312 1313 call send_check_slew; 1314 1315 if a_code ^= 0 1316 then do; 1317 1318 output_cd.status_key = "60"; /* indicates no action taken */ 1319 1320 return; 1321 1322 end; 1323 1324 /* No other checks needed here because cobol_mcs_ has already verified text-len, max-text-len, 1325* station-count, and max-station-count. */ 1326 1327 1328 1329 output_cd.status_key = "00"; /* start clean, change only on first error */ 1330 1331 1332 1333 /* The BIG Loop! The loop processes the message data for each destination (station) 1334* in the output_cd. It is possible, and legal, for the various destinations to have 1335* different statuses. That is, the message could be the first piece of a message for 1336* one destination and the middle piece for another destination. Thus, each station must 1337* be handled independently from the others. */ 1338 1339 /* Note: To keep the do/end code from nesting too deeply, gotos are used in the outer controls */ 1340 1341 1342 1343 1344 1345 do dest_table_index = 1 to station_count; /* cobol_mcs_ ensures count of at least 1 */ 1346 1347 station_name = output_cd.dest_table (dest_table_index).station_name; 1348 1349 /*[4.4-3]*/ 1350 call cmcs_station_ctl_$find_destination (station_name, station_ctl_eindex, station_ctl_eptr, code); 1351 1352 call cmcs_tree_ctl_$find_destination (station_name, tree_ctl_eindex, tree_ctl_eptr, code); 1353 1354 if code ^= 0 1355 then do; 1356 1357 if a_code = 0 1358 then do; /* always report the first error encountered */ 1359 1360 a_code = code; 1361 output_cd.status_key = "20"; 1362 end; 1363 1364 output_cd.dest_table (dest_table_index).error_key = "1"; 1365 1366 /*[4.4-3]*/ 1367 return; 1368 1369 end; 1370 1371 output_cd.dest_table (dest_table_index).error_key = "0"; 1372 /* initialize to good now, reset only on error */ 1373 1374 queue_ctl_eindex = tree_ctl_entry.queue_ctl_eindex; 1375 1376 tree_ctl_entry.queue_ctl_eptr, queue_ctl_eptr = addr (queue_ctl.entries (queue_ctl_eindex)); 1377 1378 if tree_ctl_entry.io_in_process_sw 1379 then do; 1380 if tree_ctl_entry.io_type > 1 1381 then call E9; 1382 1383 msg_hdr_ptr = tree_ctl_entry.msg_hdr_ptr; 1384 old_status = tree_ctl_entry.io_subtype; 1385 /* always 0 or 1 */ 1386 1387 1388 1389 1390 1391 1392 1393 1394 end; 1395 else do; 1396 call reset_tce_io; /* reset message dep params */ 1397 1398 tree_ctl_entry.io_type = 1; /* send */ 1399 1400 old_status = 0; /* for use in key computation */ 1401 1402 1403 end; 1404 1405 call test_subtype; 1406 1407 /*[4.4-4]*/ 1408 call set_new_status; /* 0(partial), 1(esi), 2(emi,egi) */ 1409 1410 send_loop_end: /* set/reset io_in_process_sw. Only if there are no errors and the message is still not completed (just 0/EsI delim), 1411* will we set the busy switch. All other cases force it to be reset. This can cause garbage pieces (segments), to be left 1412* in the file. These can be cleaned up later with the cobol_mcs_admin request of purge_queues. At a later time, 1413* we may do dynamic purging. */ 1414 if (new_status ^= 2 & output_cd.dest_table (dest_table_index).error_key ^= "1") 1415 then tree_ctl_entry.io_in_process_sw = "1"b; 1416 1417 /* set busy only if no errors and not (EMI or EGI) */ 1418 1419 else tree_ctl_entry.io_in_process_sw = "0"b; 1420 1421 /* force reset, for subsequent I/O */ 1422 1423 end; 1424 1425 return; 1426 1427 1428 test_subtype: 1429 proc; 1430 1431 if io_subtype = 0 1432 then call send_partial; 1433 else call send_non_partial; /* esi,emi,egi */ 1434 1435 1436 end; 1437 1438 E1: 1439 proc; /* queue was disabled */ 1440 1441 a_code = code; 1442 output_cd.status_key = "10"; 1443 output_cd.dest_table (dest_table_index).error_key = "1"; 1444 1445 go to send_loop_end; 1446 1447 end; 1448 1449 E2: 1450 proc; /* output terminal was disabled */ 1451 1452 a_code = code; 1453 output_cd.status_key = "10"; 1454 output_cd.dest_table (dest_table_index).error_key = "1"; 1455 1456 /*[4.4-3]*/ 1457 /*go to send_loop_end;*/ 1458 1459 end; 1460 1461 E3: 1462 proc; /* input terminal was disabled */ 1463 1464 if a_code = 0 1465 then do; 1466 1467 a_code = code; 1468 output_cd.status_key = "20"; /* for lack of a better status key */ 1469 end; 1470 1471 output_cd.dest_table (dest_table_index).error_key = "1"; 1472 1473 go to send_loop_end; 1474 1475 end; 1476 1477 E4: 1478 proc; /* check status after send_get_key */ 1479 1480 call sub_err_ (code, my_name, "c", sub_err_retval, 1481 "Attempting to lock queue_ctl to get message number for ""^a"".", station_name); 1482 1483 if a_code = 0 1484 then do; 1485 1486 a_code = code; 1487 output_cd.status_key = "50"; 1488 end; 1489 1490 output_cd.dest_table (dest_table_index).error_key = "1"; 1491 1492 go to send_loop_end; 1493 1494 end; 1495 1496 1497 E5: 1498 proc; /* check status after open */ 1499 1500 call sub_err_ (code, my_name, "c", null (), sub_err_retval, "Attempting to open queue for message to ""^a"".", 1501 station_name); 1502 1503 if a_code = 0 1504 then do; 1505 1506 a_code = code; 1507 output_cd.status_key = "20"; 1508 end; 1509 1510 output_cd.dest_table (dest_table_index).error_key = "1"; 1511 1512 go to send_loop_end; 1513 1514 end; 1515 1516 1517 E6: 1518 proc; /* check status after send_seek_key */ 1519 1520 call sub_err_ (code, my_name, "c", sub_err_retval, "Attempting to seek space for message to ""^a"".", 1521 station_name); 1522 1523 if a_code = 0 1524 then do; 1525 1526 a_code = code; 1527 output_cd.status_key = "20"; 1528 end; 1529 1530 output_cd.dest_table (dest_table_index).error_key = "1"; 1531 1532 go to send_loop_end; 1533 1534 end; 1535 1536 E8: 1537 proc; /* check status after qc_lock, cmcs_status_list_ctl$(move,add) */ 1538 1539 call sub_err_ (code, my_name, "c", null (), sub_err_retval, 1540 "Attempting to add message for ""^a"" to status list. Contact CMCS Administrator. Continuing.", 1541 tree_ctl_entry.queue_name); 1542 1543 if a_code = 0 1544 then do; 1545 1546 a_code = cmcs_error_table_$bad_dest; 1547 output_cd.status_key = "20"; 1548 end; 1549 1550 output_cd.dest_table (dest_table_index).error_key = "1"; 1551 1552 end; 1553 1554 E9: 1555 proc; 1556 1557 call sub_err_ (error_table_$action_not_performed, my_name, "c", null (), sub_err_retval, 1558 "Attempting to perform send to ""^a"" while other I/O in process.", station_name); 1559 1560 if a_code = 0 1561 then do; 1562 1563 a_code = cmcs_error_table_$bad_dest; 1564 output_cd.status_key = "20"; 1565 end; 1566 1567 output_cd.dest_table (dest_table_index).error_key = "1"; 1568 1569 go to send_loop_end; 1570 1571 end; 1572 1573 1574 E10: 1575 proc; /* check status in send_append_tag */ 1576 1577 code = cmcs_error_table_$bad_message_length; 1578 1579 call sub_err_ (code, my_name, "c", null (), sub_err_retval, 1580 "Maximum size exceeded for partial message to ""^a"".", station_name); 1581 1582 if a_code = 0 1583 then do; 1584 1585 a_code = code; 1586 output_cd.status_key = "20"; 1587 1588 end; 1589 1590 output_cd.dest_table (dest_table_index).error_key = "1"; 1591 1592 go to send_loop_end; 1593 1594 end; 1595 1596 E11: 1597 proc; /* check status after get_temp_segments */ 1598 1599 call sub_err_ (code, my_name, "s", null (), sub_err_retval, 1600 "Attempting to get temp seg for send to ""^a"". Contact CMCS Administrator.", station_name); 1601 1602 if a_code = 0 1603 then do; 1604 1605 a_code = code; 1606 output_cd.status_key = "20"; 1607 1608 end; 1609 1610 output_cd.dest_table (dest_table_index).error_key = "1"; 1611 1612 go to send_loop_end; 1613 1614 end; 1615 1616 1617 send_partial: 1618 proc; 1619 1620 if tree_ctl_entry.tseg_ptr = null () 1621 then do; /* allocate one temp seg */ 1622 1623 call get_temp_segments_ (my_name, ptr_array, code); 1624 1625 if code ^= 0 1626 then call E11; 1627 1628 tseg_ptr, tree_ctl_entry.tseg_ptr = ptr_array (1); 1629 1630 tseg_len, tree_ctl_entry.tseg_len = 0; 1631 end; 1632 1633 else do; 1634 tseg_ptr = tree_ctl_entry.tseg_ptr; 1635 tseg_len = tree_ctl_entry.tseg_len; 1636 end; 1637 1638 if tree_ctl_entry.tseg_len + buffer_len > tseg_max_len 1639 then call E10; 1640 1641 /* exceeded implementation limit for msg seg size */ 1642 1643 substr (tseg, tseg_len + 1, buffer_len) = substr (buffer, 1, buffer_len); 1644 1645 /* copy data to temp seg */ 1646 1647 tree_ctl_entry.tseg_len = tree_ctl_entry.tseg_len + buffer_len; 1648 tree_ctl_entry.partial_in_process_sw = "1"b; 1649 1650 1651 end; 1652 1653 1654 send_non_partial: 1655 proc; /* send delim ^= 0 */ 1656 1657 1658 1659 if user_ctl.terminal_sw 1660 then do; /* terminals are restricted, mp's aren't */ 1661 1662 if ^tree_ctl_entry.io_in_process_sw /* check only for brand-new messages */ 1663 then do; /* once they are started, it's ok */ 1664 1665 if queue_ctl_entry.input_disabled_sw 1666 then do; /* can't let them through */ 1667 1668 code = cmcs_error_table_$queue_disabled; 1669 1670 if a_code = 0 1671 then call E1; 1672 1673 end; 1674 1675 1676 if station_ctl_entry.output_disabled_sw 1677 then do; 1678 code = cmcs_error_table_$dest_disabled; 1679 1680 if a_code = 0 1681 then call E2; 1682 end; 1683 1684 1685 call cmcs_station_ctl_$input_disabled (user_ctl.station_ctl_eindex, flag, code); 1686 1687 if code ^= 0 1688 then call E3; 1689 1690 if flag 1691 then do; 1692 1693 code = cmcs_error_table_$source_disabled; 1694 call E3; 1695 end; 1696 1697 end; 1698 1699 end; 1700 1701 call send_get_key; 1702 1703 if code ^= 0 1704 then call E4; 1705 1706 call open; /* be sure we have a good IO switch */ 1707 1708 if code ^= 0 1709 then call E5; 1710 1711 if tree_ctl_entry.seg_no = 1 1712 then seek_len = msg_hdr_len + msg_seg_hdr_len; 1713 else seek_len = msg_seg_hdr_len; 1714 1715 seek_len = 4 * seek_len + buffer_len; 1716 1717 1718 if tree_ctl_entry.partial_in_process_sw 1719 then seek_len = seek_len + tree_ctl_entry.tseg_len; 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 call send_seek_key; 1738 1739 if code ^= 0 1740 then call E6; 1741 1742 tree_ctl_entry.seg_count = seg_no; /* so we know how many we have altogether */ 1743 1744 if tree_ctl_entry.seg_no = 1 1745 then do; /* first segment of message */ 1746 1747 msg_hdr_ptr, tree_ctl_entry.msg_hdr_ptr = send_vfile_rs.rec_ptr; 1748 1749 call send_fillin_msg_hdr; 1750 1751 tree_ctl_entry.msg_descr = send_vfile_rs.descr; 1752 /* will be needed later for changing status */ 1753 msg_seg_ptr, tree_ctl_entry.msg_seg_ptr = addr (msg_hdr.msg_seg); 1754 1755 end; 1756 else do; /* not the first segment of the message */ 1757 1758 msg_seg_ptr, tree_ctl_entry.msg_seg_ptr = send_vfile_rs.rec_ptr; 1759 tree_ctl_entry.msg_seg_descr = send_vfile_rs.descr; 1760 1761 /* may be useful sometime, but not now */ 1762 1763 end; 1764 1765 call send_fillin_seg_hdr; /* then copy the real data */ 1766 1767 if ^tree_ctl_entry.partial_in_process_sw 1768 then substr (msg_seg.data.seg_data, 1, buffer_len) = substr (buffer, 1, buffer_len); 1769 1770 else do; /* do a gather-copy of the tseg and a_buffer */ 1771 1772 tseg_ptr = tree_ctl_entry.tseg_ptr; 1773 tseg_len = tree_ctl_entry.tseg_len; 1774 msg_seg.hdr.seg_len = msg_seg.hdr.seg_len + 1; 1775 1776 substr (msg_seg.data.seg_data, 1, tseg_len) = substr (tseg, 1, tseg_len); 1777 /* part 1 */ 1778 substr (msg_seg.data.seg_data, tseg_len + 1, 1) = " 1779 "; 1780 substr (msg_seg.data.seg_data, tseg_len + 2, buffer_len) = substr (buffer, 1, buffer_len); 1781 /* part 2 */ 1782 1783 tree_ctl_entry.partial_in_process_sw = "0"b; 1784 tree_ctl_entry.tseg_len = 0; 1785 1786 end; 1787 1788 if new_status = 2 1789 then do; /* this is the latest possible moment to set this info */ 1790 1791 msg_hdr.clock_available = clock_ (); 1792 msg_hdr.source_station = user_ctl.station_name; 1793 msg_hdr.source_group_id = get_group_id_ (); 1794 msg_hdr.msg_len = tree_ctl_entry.msg_len; 1795 msg_hdr.final_delim = io_subtype; /* EMI or EGI */ 1796 msg_hdr.seg_count = tree_ctl_entry.seg_count; 1797 1798 end; 1799 1800 1801 call qc_lock; /* ipc_$wakeup called herein */ 1802 1803 if code ^= 0 1804 then call E8; 1805 else do; 1806 1807 if new_status = 2 & old_status = 1 1808 then call cmcs_status_list_ctl_$move (queue_ctl_eptr, iocb_ptr, addr (tree_ctl_entry.msg_descr), 1809 old_status, new_status, code); 1810 else call cmcs_status_list_ctl_$add (queue_ctl_eptr, iocb_ptr, addr (tree_ctl_entry.msg_descr), 1811 new_status, code); 1812 1813 if code ^= 0 1814 then call E8; 1815 1816 end; 1817 1818 call qc_unlock; /* ignore return status */ 1819 1820 end; 1821 1822 /* */ 1823 1824 send_check_slew: 1825 proc (); 1826 1827 slew_ctl_ptr = addr (a_slew_ctl); /* for overlay processing */ 1828 1829 if a_slew_ctl = 0 1830 then do; /* when = 0, what = 0, how_much = 0 */ 1831 1832 ret_good_slew: 1833 a_code = 0; 1834 return; 1835 end; 1836 else if slew_ctl.when = 0 1837 then do; 1838 ret_bad_slew: 1839 a_code = cmcs_error_table_$bad_slew; 1840 1841 call sub_err_ (a_code, my_name, "c", null (), sub_err_retval, 1842 "From check of the slew control. The slew control supplied is: 1843 when (^d), what (^d), how much (^d). 1844 Error keys set for all destinations.", slew_ctl.when, slew_ctl.what, slew_ctl.how_much); 1845 1846 output_cd.status_key = "20"; 1847 1848 do i = 1 to station_count; 1849 output_cd.dest_table (i).error_key = "1"; 1850 end; 1851 1852 return; 1853 1854 end; 1855 else if slew_ctl.when < 0 | slew_ctl.when > 2 1856 then go to ret_bad_slew; 1857 1858 if slew_ctl.what < 0 | slew_ctl.what > 3 1859 then go to ret_bad_slew; 1860 1861 if slew_ctl.what = 1 1862 then if slew_ctl.how_much < 0 | slew_ctl.how_much > 128 1863 then go to ret_bad_slew; 1864 else ; 1865 else if slew_ctl.what = 2 1866 then slew_ctl.how_much = 0; /*[4.4-1]*/ 1867 1868 else if slew_ctl.what = 3 1869 then if slew_ctl.how_much < 1 | slew_ctl.how_much > 16 1870 then go to ret_bad_slew; 1871 1872 go to ret_good_slew; 1873 1874 end /* send_check_slew */; 1875 1876 /* */ 1877 1878 send_init: 1879 proc (); 1880 1881 send_vfile_rs_ptr = addr (send_vfile_rs); 1882 overlay_len = size (send_vfile_rs); 1883 send_vfile_rs_ptr -> overlay (*) = 0; 1884 1885 send_vfile_rs.version = vfile_rs_version; 1886 send_vfile_rs.create_sw = "1"b; /* send will always create new records */ 1887 1888 send_init_sw = "1"b; 1889 1890 return; 1891 1892 end /* send_init */; 1893 1894 /* */ 1895 1896 send_seek_key: 1897 proc (); 1898 1899 send_vfile_rs.rec_len, send_vfile_rs.max_rec_len = seek_len + 8; 1900 /* to give space for vfile lockword, if needed */ 1901 1902 key = based_key; /* for vfile_ char (256) var key */ 1903 1904 call iox_$seek_key (iocb_ptr, key, fb21, code); 1905 1906 if code = 0 1907 then do; /* must never happen, should always be not_found */ 1908 1909 code = error_table_$bad_new_key; 1910 1911 return; 1912 end; 1913 else if code ^= error_table_$no_record 1914 then return; 1915 1916 /* Seek OK, now create new space */ 1917 1918 call iox_$control (iocb_ptr, "record_status", addr (send_vfile_rs), code); 1919 return; 1920 1921 end /* send_seek_key */; 1922 1923 /* */ 1924 1925 send_fillin_msg_hdr: 1926 proc (); 1927 1928 overlay_len = msg_hdr_len; 1929 msg_hdr_ptr -> overlay (*) = 0; /* erase any existing garbage */ 1930 msg_hdr.lockword = get_process_id_ (); /* temporary id of author */ 1931 msg_hdr.version = msg_hdr_version; 1932 msg_hdr.source_station = user_ctl.station_name; 1933 msg_hdr.msg_no = tree_ctl_entry.msg_no; 1934 msg_hdr.seg_no = 1; /* always 1 in the msg_hdr */ 1935 msg_hdr.seg_count = -1; /* don't have a good number yet */ 1936 msg_hdr.msg_status = new_status; 1937 msg_hdr.final_delim = io_subtype; /* can only be 1-3 */ 1938 1939 return; 1940 1941 end /* send_fillin_msg_hdr */; 1942 1943 /* */ 1944 1945 send_fillin_seg_hdr: 1946 proc (); 1947 1948 msg_seg.hdr.msg_no = tree_ctl_entry.msg_no; 1949 msg_seg.hdr.seg_no = tree_ctl_entry.seg_no; 1950 msg_seg.hdr.slew_ctl = a_slew_ctl; 1951 1952 if ^tree_ctl_entry.partial_in_process_sw 1953 then msg_seg.hdr.seg_len = buffer_len; 1954 else msg_seg.hdr.seg_len = buffer_len + tree_ctl_entry.tseg_len; 1955 1956 tree_ctl_entry.msg_len = tree_ctl_entry.msg_len + msg_seg.hdr.seg_len; 1957 tree_ctl_entry.seg_count = tree_ctl_entry.seg_no; /* may need in case of purge */ 1958 1959 return; 1960 1961 end /* send_fillin_seg_hdr */; 1962 1963 /* */ 1964 1965 reset_tce_io: 1966 proc; 1967 1968 /* Procedure to reset all message dependent parameters */ 1969 1970 /* tree_ctl_eptr must be set to the tree_ctl_entry to be reset */ 1971 1972 string (tree_ctl_entry.io_flags) = (36)"0"b; 1973 1974 tree_ctl_entry.msg_hdr_ptr = null (); 1975 tree_ctl_entry.io_type = 0; 1976 tree_ctl_entry.io_subtype = 0; 1977 string (tree_ctl_entry.io_flags) = (36)"0"b; 1978 tree_ctl_entry.seg_count = 0; 1979 tree_ctl_entry.msg_len = 0; 1980 tree_ctl_entry.msg_descr = zero_descr; 1981 tree_ctl_entry.msg_no = 0; 1982 tree_ctl_entry.seg_no = 0; 1983 tree_ctl_entry.tseg_len = 0; 1984 tree_ctl_entry.msg_seg_ptr = null (); 1985 tree_ctl_entry.msg_seg_descr = zero_descr; 1986 tree_ctl_entry.msg_seg_len = 0; 1987 tree_ctl_entry.msg_seg_left_index = 0; 1988 tree_ctl_entry.msg_seg_left_len = 0; 1989 tree_ctl_entry.buffer_len = 0; 1990 tree_ctl_entry.buffer_left_index = 0; 1991 tree_ctl_entry.buffer_left_len = 0; 1992 1993 return; 1994 1995 end /* reset_tce_io */; 1996 1997 /* */ 1998 1999 open: 2000 proc (); 2001 2002 queue_ctl_eindex = tree_ctl_entry.queue_ctl_eindex; 2003 queue_ctl_eptr = addr (queue_ctl.entries (queue_ctl_eindex)); 2004 2005 if tree_ctl_entry.vfile_status = 2 2006 then do; /* already open */ 2007 2008 iocb_ptr = tree_ctl_entry.iocb_ptr; 2009 code = 0; 2010 2011 return; 2012 end; 2013 else if tree_ctl_entry.vfile_status = 0 2014 then do; /* brand new use */ 2015 iox_attach: 2016 switch_no = switch_no + 1; /* build "unique" switch name */ 2017 switch_pic = switch_no; 2018 tree_ctl_entry.switch_name = rtrim (tree_ctl_entry.queue_name) || "." || switch_pic; 2019 /* aaa.nn */ 2020 2021 call ioa_$rsnnl ("vfile_ ^a>^a -share ^d -old", attach_descr, attach_descr_len, user_ctl.cmcs_dir, 2022 queue_ctl_entry.queue_name, system_ctl.lock_wait_time); 2023 2024 /* q name already has suffix */ 2025 2026 call iox_$attach_name (tree_ctl_entry.switch_name, iocb_ptr, 2027 substr (attach_descr, 1, attach_descr_len), null (), code); 2028 2029 if code ^= 0 2030 then return; 2031 2032 tree_ctl_entry.vfile_status = 1; /* log in case of trouble */ 2033 2034 iox_open: 2035 call iox_$open (iocb_ptr, 13, "0"b, code); 2036 /* 13 = direct_update */ 2037 2038 if code ^= 0 2039 then return; 2040 2041 call iox_$control (iocb_ptr, "min_block_size", addr (min_blksz_info), code); 2042 2043 if code ^= 0 2044 then do; 2045 2046 call sub_err_ (code, my_name, "c", null (), sub_err_retval, 2047 "Attempting to perform min_block_size control order for queue ^a (switch ^a). Continuing.", 2048 tree_ctl_entry.queue_name, tree_ctl_entry.switch_name); 2049 2050 end; 2051 2052 tree_ctl_entry.vfile_status = 2; 2053 tree_ctl_entry.iocb_ptr = iocb_ptr; 2054 2055 end; 2056 else if tree_ctl_entry.vfile_status = 1 2057 then go to iox_open; 2058 else do; /* unrecognized vfile status */ 2059 2060 code = error_table_$not_open; 2061 end; 2062 2063 return; 2064 2065 end /* open */; 2066 2067 /* */ 2068 2069 close: 2070 proc (); 2071 2072 /* This procedure assumes that tree_ctl_eptr is set to the entry to be closed. */ 2073 2074 if tree_ctl_entry.vfile_status > 0 2075 then do; 2076 2077 if tree_ctl_entry.vfile_status = 2 2078 then do; 2079 2080 call iox_$close (tree_ctl_entry.iocb_ptr, code); 2081 2082 if code ^= 0 2083 then do; 2084 close_err: 2085 call sub_err_ (code, my_name, "c", null (), sub_err_retval, 2086 "Attempting to close the ^a queue.", tree_ctl_entry.queue_name); 2087 2088 return; 2089 end; 2090 2091 tree_ctl_entry.vfile_status = 1; 2092 2093 end; 2094 2095 call iox_$detach_iocb (tree_ctl_entry.iocb_ptr, code); 2096 2097 if code ^= 0 2098 then go to close_err; 2099 2100 tree_ctl_entry.iocb_ptr = null (); 2101 tree_ctl_entry.vfile_status = 0; 2102 end; 2103 2104 else if tree_ctl_entry.iocb_ptr ^= null () 2105 then do; 2106 2107 code = cmcs_error_table_$bad_call_parm; 2108 2109 call sub_err_ (code, my_name, "c", null (), sub_err_retval, 2110 "Inconsistent vfile_ status for queue ^a (switch ^a). File closed.", tree_ctl_entry.queue_name, 2111 tree_ctl_entry.switch_name); 2112 2113 call iox_$close (tree_ctl_entry.iocb_ptr, code); 2114 /* ignore return */ 2115 call iox_$detach_iocb (tree_ctl_entry.iocb_ptr, code); 2116 /* ignore return */ 2117 2118 tree_ctl_entry.iocb_ptr = null (); 2119 tree_ctl_entry.vfile_status = 0; 2120 end; 2121 2122 else code = 0; 2123 2124 if tree_ctl_entry.tseg_ptr ^= null () 2125 then do; 2126 2127 ptr_array (1) = tree_ctl_entry.tseg_ptr; 2128 2129 call release_temp_segments_ (my_name, ptr_array, code); 2130 2131 if code ^= 0 2132 then do; 2133 2134 call sub_err_ (code, my_name, "c", null (), sub_err_retval, 2135 "Attempting to release temporary buffer segment for ^a. Continuing.", 2136 tree_ctl_entry.queue_name); 2137 2138 code = 0; 2139 end; 2140 end; 2141 2142 return; 2143 2144 end /* close */; 2145 2146 /* */ 2147 2148 send_get_key: 2149 proc (); 2150 2151 if tree_ctl_entry.msg_no = 0 2152 then do; /* 1st segment of new msg */ 2153 2154 /*[5.3-1]*/ 2155 call cmcs_set_lock_$lock (queue_ctl.hdr.lockword, system_ctl.lock_wait_time, code); 2156 2157 if code ^= 0 2158 then return; 2159 2160 queue_ctl_eindex = tree_ctl_entry.queue_ctl_eindex; 2161 queue_ctl_eptr = addr (queue_ctl.entries (queue_ctl_eindex)); 2162 2163 msg_no, tree_ctl_entry.msg_no, key_struc.msg_no, queue_ctl_entry.msg_no = queue_ctl_entry.msg_no + 1; 2164 /* update all related fields at once */ 2165 2166 call cmcs_set_lock_$unlock (queue_ctl.hdr.lockword, code); 2167 2168 if code ^= 0 2169 then do; /* also should never happen */ 2170 call sub_err_ (code, my_name, "c", sub_err_retval, 2171 "From attempt to unlock queue_ctl for ""^a"".", station_name); 2172 code = 0; 2173 end; 2174 2175 seg_no, key_struc.seg_no, tree_ctl_entry.seg_no = 1; 2176 /* starting fresh msg always uses segno of 1 */ 2177 end; 2178 2179 else do; /* msgno already exists, just bump the segno */ 2180 2181 msg_no, key_struc.msg_no = tree_ctl_entry.msg_no; 2182 2183 seg_no, key_struc.seg_no, tree_ctl_entry.seg_no = tree_ctl_entry.seg_no + 1; 2184 end; 2185 2186 return; 2187 2188 end /* send_get_key */; 2189 2190 /* */ 2191 2192 setup: 2193 proc; 2194 2195 if ^(external_user_ctl_ptr -> user_ctl.init_sw.queue_ctl) 2196 then do; 2197 2198 user_ctl_ptr = external_user_ctl_ptr; /* set local variable from global */ 2199 2200 queue_ctl_ptr = user_ctl.queue_ctl_ptr; 2201 system_ctl_ptr = user_ctl.system_ctl_ptr; 2202 tree_ctl_ptr = user_ctl.tree_ctl_ptr; 2203 wait_ctl_ptr = user_ctl.wait_ctl_ptr; 2204 2205 end; 2206 2207 /* The following code initializes the data for the vfile_ control "min_block_size". 2208* This control ensures at least 8 extra characters will be left for the vfile record lockword. */ 2209 2210 min_blksz_info.min_residue = 8; 2211 min_blksz_info.min_capacity = 8; 2212 2213 zero_descr_ptr = addr (zero); /* for assignments of "null" descriptors */ 2214 2215 user_ctl.init_sw.queue_ctl = "1"b; 2216 a_code = 0; 2217 return; 2218 2219 end /* setup */; 2220 2221 test: 2222 entry (); 2223 2224 test_sw = "1"b; 2225 return; 2226 2227 /* */ 2228 2229 qc_lock: 2230 proc (); 2231 2232 /*[5.3-1]*/ 2233 call cmcs_set_lock_$lock (queue_ctl.hdr.lockword, system_ctl.lock_wait_time, code); 2234 2235 if code ^= 0 2236 then do; 2237 call sub_err_ (code, my_name, "c", null (), sub_err_retval, "Attempting to lock queue_ctl."); 2238 end; 2239 2240 return; 2241 2242 end /* qc_lock */; 2243 2244 /* */ 2245 2246 qc_unlock: 2247 proc (); 2248 2249 call cmcs_set_lock_$unlock (queue_ctl.hdr.lockword, code); 2250 2251 return; 2252 2253 end /* qc_unlock */; 2254 2255 set_new_status: 2256 proc; 2257 2258 /*[4.4-4]*/ 2259 new_status, io_subtype, tree_ctl_entry.io_subtype = a_io_subtype; 2260 2261 /*[4.4-4]*/ 2262 if new_status = 3 2263 then new_status = 2; /* egi = emi */ 2264 2265 end; 2266 2267 end /* cmcs_queue_ctl_ */; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0834.0 cmcs_queue_ctl_.pl1 >spec>install>MR12.3-1048>cmcs_queue_ctl_.pl1 197 1 03/27/82 0439.5 cmcs_cd_dcls.incl.pl1 >ldd>include>cmcs_cd_dcls.incl.pl1 198 2 03/27/82 0439.5 cmcs_control_hdr.incl.pl1 >ldd>include>cmcs_control_hdr.incl.pl1 199 3 05/24/89 0811.5 cmcs_entry_dcls.incl.pl1 >spec>install>MR12.3-1048>cmcs_entry_dcls.incl.pl1 200 4 03/27/82 0439.5 cmcs_error_table_dcls.incl.pl1 >ldd>include>cmcs_error_table_dcls.incl.pl1 201 5 03/27/82 0439.5 cmcs_iox_processing.incl.pl1 >ldd>include>cmcs_iox_processing.incl.pl1 202 6 03/27/82 0439.5 cmcs_key_dcls.incl.pl1 >ldd>include>cmcs_key_dcls.incl.pl1 203 7 03/27/82 0439.5 cmcs_msg_hdr.incl.pl1 >ldd>include>cmcs_msg_hdr.incl.pl1 204 8 03/27/82 0439.5 cmcs_msg_seg.incl.pl1 >ldd>include>cmcs_msg_seg.incl.pl1 205 9 03/27/82 0439.5 cmcs_queue_ctl.incl.pl1 >ldd>include>cmcs_queue_ctl.incl.pl1 206 10 03/27/82 0439.5 cmcs_slew_ctl.incl.pl1 >ldd>include>cmcs_slew_ctl.incl.pl1 207 11 03/27/82 0439.6 cmcs_station_ctl.incl.pl1 >ldd>include>cmcs_station_ctl.incl.pl1 208 12 03/27/82 0439.6 cmcs_system_ctl.incl.pl1 >ldd>include>cmcs_system_ctl.incl.pl1 209 13 03/27/82 0439.6 cmcs_tree_ctl.incl.pl1 >ldd>include>cmcs_tree_ctl.incl.pl1 210 14 03/27/82 0431.5 cmcs_user_ctl.incl.pl1 >ldd>include>cmcs_user_ctl.incl.pl1 211 15 03/27/82 0439.6 cmcs_vfile_rs.incl.pl1 >ldd>include>cmcs_vfile_rs.incl.pl1 212 16 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_buffer_len parameter fixed bin(17,0) dcl 50 ref 667 1283 1291 1310 a_buffer_ptr parameter pointer dcl 50 ref 667 1282 1291 1309 a_cdp parameter pointer dcl 50 ref 346 350 a_code parameter fixed bin(35,0) dcl 50 set ref 223 235 261 273 289* 298 310 327* 336 346 356* 401* 409* 427 430* 446 448* 473* 497 501* 638 641* 658 667 704 712 722* 725* 758* 760 765* 781* 801* 840* 842* 846* 855* 862 938* 1022* 1071* 1085* 1109* 1181* 1190* 1210* 1212 1291 1315 1357 1360* 1441* 1452* 1464 1467* 1483 1486* 1503 1506* 1523 1526* 1543 1546* 1560 1563* 1582 1585* 1602 1605* 1670 1680 1832* 1838* 1841* 2216* a_input_cdp parameter pointer dcl 50 ref 223 229 261 267 298 304 658 667 696 a_io_subtype parameter fixed bin(17,0) dcl 50 ref 223 231 261 269 298 306 336 346 361 460 658 667 697 1291 1304 2259 a_iocb_ptr parameter pointer dcl 50 set ref 658 1003* a_output_cdp parameter pointer dcl 50 ref 1291 1302 a_password parameter char(10) packed unaligned dcl 50 ref 261 298 a_slew_ctl parameter fixed bin(35,0) dcl 50 set ref 1291 1827 1829 1950 a_station_count parameter fixed bin(17,0) dcl 50 ref 1291 1311 addr builtin function dcl 88 ref 243 281 318 370 489 518 543 543 590 590 601 679 680 739 792 821 877 880 883 922 985 1003 1003 1003 1003 1126 1174 1188 1235 1376 1753 1807 1807 1810 1810 1827 1881 1902 1918 1918 2003 2041 2041 2161 2213 attach_descr 000150 automatic char(256) packed unaligned dcl 154 set ref 2021* 2026 2026 attach_descr_len 000250 automatic fixed bin(17,0) dcl 155 set ref 2021* 2026 2026 based_key based varying char(8) dcl 6-17 ref 601 1126 1902 buffer based char packed unaligned dcl 64 set ref 1029* 1643 1767 1780 buffer_info 210 based structure level 3 dcl 13-26 buffer_left_index 213 based fixed bin(35,0) level 4 in structure "tree_ctl_entry" dcl 13-26 in procedure "cmcs_queue_ctl_" set ref 1029 1034* 1034 1046 1083 1285* 1990* buffer_left_index 000103 automatic fixed bin(35,0) dcl 64 in procedure "cmcs_queue_ctl_" set ref 1285* buffer_left_len 214 based fixed bin(35,0) level 4 dcl 13-26 set ref 1016 1027 1035* 1035 1283* 1991* buffer_len 000102 automatic fixed bin(21,0) dcl 64 in procedure "cmcs_queue_ctl_" set ref 1029 1283* 1310* 1638 1643 1643 1643 1647 1715 1767 1767 1767 1780 1780 1780 1952 1954 buffer_len 212 based fixed bin(35,0) level 4 in structure "tree_ctl_entry" dcl 13-26 in procedure "cmcs_queue_ctl_" set ref 1019 1283* 1989* buffer_ptr 000104 automatic pointer dcl 64 set ref 1029 1282* 1309* 1643 1767 1780 cdp 000100 automatic pointer dcl 62 set ref 340* 350* 365 414 463 clock_ 000112 constant entry external dcl 99 ref 1044 1791 clock_available 20 based fixed bin(71,0) level 2 dcl 7-15 set ref 979* 1791* clock_deleted 22 based fixed bin(71,0) level 2 dcl 7-15 set ref 1044* cmcs_date_time_ 000130 constant entry external dcl 3-20 ref 979 cmcs_dir 14 based char(168) level 2 dcl 14-17 set ref 2021* cmcs_error_table_$ambiguous_tree_path 000166 external static fixed bin(35,0) dcl 4-5 ref 1181 cmcs_error_table_$bad_call_parm 000170 external static fixed bin(35,0) dcl 4-5 ref 2107 cmcs_error_table_$bad_dest 000172 external static fixed bin(35,0) dcl 4-5 ref 1546 1563 cmcs_error_table_$bad_message_length 000174 external static fixed bin(35,0) dcl 4-5 ref 1577 cmcs_error_table_$bad_slew 000176 external static fixed bin(35,0) dcl 4-5 ref 1838 cmcs_error_table_$dest_disabled 000200 external static fixed bin(35,0) dcl 4-5 ref 636 765 1678 cmcs_error_table_$no_message 000202 external static fixed bin(35,0) dcl 4-5 ref 801 842 cmcs_error_table_$no_partial_messages 000204 external static fixed bin(35,0) dcl 4-5 ref 535 566 cmcs_error_table_$queue_already_disabled 000206 external static fixed bin(35,0) dcl 4-5 ref 285 cmcs_error_table_$queue_already_enabled 000210 external static fixed bin(35,0) dcl 4-5 ref 323 cmcs_error_table_$queue_disabled 000212 external static fixed bin(35,0) dcl 4-5 ref 1668 cmcs_error_table_$source_disabled 000214 external static fixed bin(35,0) dcl 4-5 ref 1693 cmcs_print_ 000132 constant entry external dcl 3-30 ref 1003 cmcs_set_lock_$lock 000134 constant entry external dcl 3-45 ref 2155 2233 cmcs_set_lock_$unlock 000136 constant entry external dcl 3-46 ref 2166 2249 cmcs_station_ctl_$find_destination 000140 constant entry external dcl 3-55 ref 1350 cmcs_station_ctl_$input_disabled 000142 constant entry external dcl 3-56 ref 1685 cmcs_station_ctl_$output_disabled 000144 constant entry external dcl 3-57 ref 632 758 cmcs_station_ctl_$validate 000146 constant entry external dcl 3-58 ref 630 cmcs_status_list_ctl_$add 000150 constant entry external dcl 3-60 ref 1810 cmcs_status_list_ctl_$delete 000152 constant entry external dcl 3-61 ref 590 cmcs_status_list_ctl_$move 000154 constant entry external dcl 3-62 ref 543 949 1056 1807 cmcs_tree_ctl_$find_destination 000156 constant entry external dcl 3-66 ref 423 1352 cmcs_tree_ctl_$find_tree_path 000160 constant entry external dcl 3-68 ref 466 1210 cmcs_wait_ctl_$add 000162 constant entry external dcl 3-71 ref 855 cmcs_wait_ctl_$delete 000164 constant entry external dcl 3-72 ref 840 905 code 000126 automatic fixed bin(35,0) dcl 111 set ref 276* 285* 289 313* 323* 327 423* 425 430 443 448 466* 468 473 483 497 501 535* 543* 545 545* 566* 577* 579 579* 590* 592 592* 603* 605 608* 616* 618 618* 630* 632* 636* 641 773 776* 781 887 905* 907 911* 928 931* 938 949* 953 966 1003* 1053 1056* 1059 1063* 1100 1104* 1109 1128* 1130 1135* 1137 1153* 1350* 1352* 1354 1360 1441 1452 1467 1480* 1486 1500* 1506 1520* 1526 1539* 1577* 1579* 1585 1599* 1605 1623* 1625 1668* 1678* 1685* 1687 1693* 1703 1708 1739 1803 1807* 1810* 1813 1904* 1906 1909* 1913 1918* 2009* 2026* 2029 2034* 2038 2041* 2043 2046* 2060* 2080* 2082 2084* 2095* 2097 2107* 2109* 2113* 2115* 2122* 2129* 2131 2134* 2138* 2155* 2157 2166* 2168 2170* 2172* 2233* 2235 2237* 2249* control_hdr based structure level 1 dcl 2-11 control_ptrs 150 based structure level 2 dcl 14-17 copy_len 000254 automatic fixed bin(35,0) dcl 178 set ref 1027* 1029 1029 1032 1033 1034 1035 count 44 based fixed bin(17,0) array level 3 dcl 9-21 ref 247 794 823 890 create_sw 1(02) 000024 internal static bit(1) level 3 packed packed unaligned dcl 158 set ref 1886* current_size 16 based fixed bin(18,0) level 3 dcl 13-16 ref 368 1206 1206 data 4 based structure level 2 dcl 8-12 descr 6 000042 internal static structure level 2 in structure "rcv_vfile_rs" packed packed unaligned dcl 180 in procedure "cmcs_queue_ctl_" set ref 1137 1150* descr 6 000024 internal static structure level 2 in structure "send_vfile_rs" packed packed unaligned dcl 158 in procedure "cmcs_queue_ctl_" set ref 1751 1759 descrs 45 based structure array level 3 dcl 9-21 dest_table 7(18) based structure array level 2 packed packed unaligned dcl 1-43 dest_table_index 000140 automatic fixed bin(17,0) dcl 130 set ref 354* 419* 421 435 452* 627 645 1345* 1347 1364 1371 1410* 1443 1454 1471 1490 1510 1530 1550 1567 1590 1610 dynamic_queue_info 146 based structure level 3 dcl 13-26 entries 100 based structure array level 2 in structure "tree_ctl" dcl 13-16 in procedure "cmcs_queue_ctl_" set ref 370 489 883 922 1174 1188 1235 entries 40 based structure array level 2 in structure "queue_ctl" dcl 9-13 in procedure "cmcs_queue_ctl_" set ref 243 281 318 518 739 792 821 880 1376 2003 2161 entries 172 based structure array level 2 in structure "wait_ctl" dcl 16-13 in procedure "cmcs_queue_ctl_" set ref 877 error_key 7(18) based char(1) array level 3 packed packed unaligned dcl 1-43 set ref 435* 452* 645* 1364* 1371* 1410 1443* 1454* 1471* 1490* 1510* 1530* 1550* 1567* 1590* 1610* 1849* error_table_$action_not_performed 000120 external static fixed bin(35,0) dcl 113 set ref 722 1557* error_table_$bad_new_key 000122 external static fixed bin(35,0) dcl 113 ref 1909 error_table_$no_record 000124 external static fixed bin(35,0) dcl 113 ref 1913 error_table_$not_open 000126 external static fixed bin(35,0) dcl 113 ref 2060 external_user_ctl_ptr 000234 external static pointer dcl 14-13 ref 218 2195 2198 f_descr 45 based structure array level 4 dcl 9-21 ref 947 fb21 000253 automatic fixed bin(21,0) dcl 164 set ref 603* 1128* 1904* final_delim 17 based fixed bin(17,0) level 2 dcl 7-15 set ref 1045 1795* 1937* flag 000141 automatic bit(1) packed unaligned dcl 130 set ref 632* 634 758* 763 1685* 1690 flags 1 000024 internal static structure level 2 in structure "send_vfile_rs" packed packed unaligned dcl 158 in procedure "cmcs_queue_ctl_" flags 1 000042 internal static structure level 2 in structure "rcv_vfile_rs" packed packed unaligned dcl 180 in procedure "cmcs_queue_ctl_" flags 27 based structure level 2 in structure "queue_ctl_entry" dcl 9-21 in procedure "cmcs_queue_ctl_" flags 13 based structure level 2 in structure "user_ctl" dcl 14-17 in procedure "cmcs_queue_ctl_" flags 4 based structure level 2 in structure "station_ctl_entry" dcl 11-21 in procedure "cmcs_queue_ctl_" get_group_id_ 000106 constant entry external dcl 99 ref 1793 get_process_id_ 000104 constant entry external dcl 99 ref 1930 get_temp_segments_ 000114 constant entry external dcl 104 ref 1623 hcs_$truncate_seg 000110 constant entry external dcl 99 ref 577 hdr based structure level 2 in structure "tree_ctl" dcl 13-16 in procedure "cmcs_queue_ctl_" hdr based structure level 2 in structure "queue_ctl" dcl 9-13 in procedure "cmcs_queue_ctl_" hdr based structure level 2 in structure "msg_seg" dcl 8-12 in procedure "cmcs_queue_ctl_" how_much 0(18) based fixed bin(17,0) level 2 packed packed unaligned dcl 10-10 set ref 1841* 1861 1861 1865* 1868 1868 i 000125 automatic fixed bin(35,0) dcl 111 set ref 240* 242* 278* 280* 315* 317* 487* 489* 818* 820* 1171* 1174* 1233* 1235* 1848* 1849* init_queue_table_sw 000036 internal static bit(1) initial packed unaligned dcl 170 set ref 1203 1207* init_sw based structure level 2 dcl 14-17 input_cd based structure level 1 dcl 1-13 input_cdp 000260 automatic pointer dcl 1-9 set ref 229* 252 253 267* 290 304* 328 463* 464 466* 471 502 696* 731 783 802 843 855 855 865 939 977 979 979 981 1019 1020 1021 1045 1046 1070 1082 1083 1084 1110 1182 1210* 1215 input_disabled_sw 27 based bit(1) level 3 packed packed unaligned dcl 9-21 set ref 283 283* 320 320* 1665 io_flags 144 based structure level 3 dcl 13-26 set ref 1256* 1972* 1977* io_in_process_sw 144 based bit(1) level 4 packed packed unaligned dcl 13-26 set ref 371 532 563 716 1047* 1176 1257* 1378 1410* 1419* 1662 io_info 144 based structure level 2 dcl 13-26 io_subtype 167 based fixed bin(17,0) level 4 in structure "tree_ctl_entry" dcl 13-26 in procedure "cmcs_queue_ctl_" set ref 1259* 1384 1976* 2259* io_subtype 000131 automatic fixed bin(17,0) dcl 120 in procedure "cmcs_queue_ctl_" set ref 231* 269* 306* 361* 377 385 411 697* 797 797 1259 1261 1261 1268 1268 1304* 1431 1795 1937 2259* io_type 166 based fixed bin(17,0) level 4 in structure "tree_ctl_entry" dcl 13-26 in procedure "cmcs_queue_ctl_" set ref 377 385 385 719 725* 1176 1176 1258* 1380 1398* 1975* io_type 000132 automatic fixed bin(17,0) dcl 120 in procedure "cmcs_queue_ctl_" set ref 230* 268* 305* 339* 349* 377 385 627 661* 670* 719 743 797 989 1000 1258 1261 1303* ioa_$rsnnl 000100 constant entry external dcl 91 ref 2021 iocb_ptr 160 based pointer level 4 in structure "tree_ctl_entry" dcl 13-26 in procedure "cmcs_queue_ctl_" set ref 396 519 737 1056* 1128* 1135* 1153* 2008 2053* 2080* 2095* 2100* 2104 2113* 2115* 2118* iocb_ptr 000116 automatic pointer dcl 79 in procedure "cmcs_queue_ctl_" set ref 519* 543* 590* 603* 616* 737* 949* 1807* 1810* 1904* 1918* 2008* 2026* 2034* 2041* 2053 iox_$attach_name 000216 constant entry external dcl 5-3 ref 2026 iox_$close 000220 constant entry external dcl 5-3 ref 2080 2113 iox_$control 000222 constant entry external dcl 5-3 ref 1135 1153 1918 2041 iox_$delete_record 000224 constant entry external dcl 5-3 ref 616 iox_$detach_iocb 000226 constant entry external dcl 5-3 ref 2095 2115 iox_$open 000230 constant entry external dcl 5-3 ref 2034 iox_$seek_key 000232 constant entry external dcl 5-3 ref 603 1128 1904 key 000264 automatic varying char(256) dcl 6-10 set ref 601* 603* 1126* 1128* 1902* 1904* key_len 000365 automatic fixed bin(35,0) initial level 2 dcl 6-12 set ref 6-12* key_struc 000365 automatic structure level 1 dcl 6-12 set ref 601 1126 1902 level_info based structure level 2 dcl 13-26 locate_sw 1(03) 000042 internal static bit(1) level 3 packed packed unaligned dcl 180 set ref 1133* 1151* lock_sw 1 000042 internal static bit(1) level 3 packed packed unaligned dcl 180 set ref 684* lock_wait_time 46 based fixed bin(17,0) level 2 dcl 12-15 set ref 2021* 2155* 2233* lockword 2 based bit(36) level 2 in structure "msg_hdr" dcl 7-15 in procedure "cmcs_queue_ctl_" set ref 1930* lockword based bit(36) level 3 in structure "queue_ctl" dcl 9-13 in procedure "cmcs_queue_ctl_" set ref 2155* 2166* 2233* 2249* max_rec_len 3 000024 internal static fixed bin(21,0) level 2 dcl 158 set ref 1899* min builtin function dcl 88 ref 1027 min_blksz_info 000012 internal static structure level 1 unaligned dcl 81 set ref 2041 2041 min_capacity 1 000012 internal static fixed bin(21,0) level 2 dcl 81 set ref 2211* min_residue 000012 internal static fixed bin(21,0) level 2 dcl 81 set ref 2210* msg_count 000256 automatic fixed bin(35,0) dcl 194 in procedure "cmcs_queue_ctl_" set ref 238* 247* 247 252 msg_count 43(09) based picture(6) level 2 in structure "input_cd" packed packed unaligned dcl 1-13 in procedure "cmcs_queue_ctl_" set ref 252* msg_date 33 based char(6) level 2 packed packed unaligned dcl 1-13 set ref 979* msg_descr 000142 automatic structure level 1 packed packed unaligned dcl 133 in procedure "cmcs_queue_ctl_" set ref 520* 543 543 590 590 msg_descr 172 based structure level 4 in structure "tree_ctl_entry" dcl 13-26 in procedure "cmcs_queue_ctl_" set ref 520 947* 1048 1751* 1807 1807 1810 1810 1980* msg_hdr based structure level 1 dcl 7-15 msg_hdr_info 164 based structure level 3 dcl 13-26 msg_hdr_len constant fixed bin(17,0) initial dcl 7-10 ref 1711 1928 msg_hdr_ptr 164 based pointer level 4 in structure "tree_ctl_entry" dcl 13-26 in procedure "cmcs_queue_ctl_" set ref 969* 1043 1383 1747* 1974* msg_hdr_ptr 000370 automatic pointer dcl 7-13 in procedure "cmcs_queue_ctl_" set ref 969* 971 972 977 979 983 984 985 1043* 1044 1045 1383* 1747* 1753 1791 1792 1793 1794 1795 1796 1929 1930 1931 1932 1933 1934 1935 1936 1937 msg_hdr_version constant fixed bin(17,0) initial dcl 7-10 ref 1931 msg_key 173 based structure level 4 dcl 13-26 msg_len 25 based fixed bin(35,0) level 2 in structure "msg_hdr" dcl 7-15 in procedure "cmcs_queue_ctl_" set ref 972 1794* msg_len 171 based fixed bin(35,0) level 4 in structure "tree_ctl_entry" dcl 13-26 in procedure "cmcs_queue_ctl_" set ref 972* 1794 1956* 1956 1979* msg_no 173 based fixed bin(35,0) level 5 in structure "tree_ctl_entry" dcl 13-26 in procedure "cmcs_queue_ctl_" set ref 521 983* 1096 1933 1948 1981* 2151 2163* 2181 msg_no based fixed bin(35,0) level 2 in structure "msg_hdr" dcl 7-15 in procedure "cmcs_queue_ctl_" set ref 983 1933* msg_no 000106 automatic fixed bin(35,0) dcl 71 in procedure "cmcs_queue_ctl_" set ref 521* 545* 592* 597 608* 618* 983* 1096* 2163* 2181* msg_no based fixed bin(35,0) level 3 in structure "msg_seg" dcl 8-12 in procedure "cmcs_queue_ctl_" set ref 1948* msg_no 1 000365 automatic fixed bin(35,0) level 2 in structure "key_struc" dcl 6-12 in procedure "cmcs_queue_ctl_" set ref 597* 983* 1096* 2163* 2181* msg_no 26 based fixed bin(35,0) level 2 in structure "queue_ctl_entry" dcl 9-21 in procedure "cmcs_queue_ctl_" set ref 2163 2163* msg_seg based structure level 1 dcl 8-12 in procedure "cmcs_queue_ctl_" msg_seg 31 based structure level 2 in structure "msg_hdr" dcl 7-15 in procedure "cmcs_queue_ctl_" set ref 985 1753 msg_seg_descr 204 based structure level 4 dcl 13-26 set ref 1759* 1985* msg_seg_hdr_len constant fixed bin(17,0) initial dcl 8-7 ref 1711 1713 msg_seg_info 202 based structure level 3 dcl 13-26 msg_seg_left_index 206 based fixed bin(35,0) level 4 dcl 13-26 set ref 998* 1029 1032* 1032 1987* msg_seg_left_len 207 based fixed bin(35,0) level 4 dcl 13-26 set ref 996* 1012 1027 1033* 1033 1988* msg_seg_len 205 based fixed bin(35,0) level 4 dcl 13-26 set ref 996* 1986* msg_seg_ptr 000372 automatic pointer dcl 8-10 in procedure "cmcs_queue_ctl_" set ref 985* 996 1003 1003 1003 1003 1003 1003 1003 1029 1029 1116* 1753* 1758* 1767 1767 1774 1774 1776 1776 1778 1778 1780 1780 1948 1949 1950 1952 1954 1956 msg_seg_ptr 202 based pointer level 4 in structure "tree_ctl_entry" dcl 13-26 in procedure "cmcs_queue_ctl_" set ref 985* 1116* 1753* 1758* 1984* msg_status 26 based fixed bin(17,0) level 3 dcl 7-15 set ref 1936* msg_time 34(18) based char(8) level 2 packed packed unaligned dcl 1-13 set ref 979* my_name 000120 automatic char(15) initial packed unaligned dcl 85 set ref 85* 545* 579* 592* 608* 618* 725* 776* 846* 894* 911* 931* 1063* 1104* 1480* 1500* 1520* 1539* 1557* 1579* 1599* 1623* 1841* 2046* 2084* 2109* 2129* 2134* 2170* 2237* new_status 000130 automatic fixed bin(17,0) dcl 120 set ref 1304* 1306 1306* 1410 1788 1807 1807* 1810* 1936 2259* 2262 2262* null builtin function dcl 88 ref 340 365 396 545 545 579 579 592 592 608 608 618 618 725 725 776 776 846 846 894 894 911 911 931 931 1063 1063 1104 1104 1500 1500 1539 1539 1557 1557 1579 1579 1599 1599 1620 1841 1841 1974 1984 2026 2026 2046 2046 2084 2084 2100 2104 2109 2109 2118 2124 2134 2134 2237 2237 old_status 000127 automatic fixed bin(17,0) dcl 120 set ref 1384* 1400* 1807 1807* output_cd based structure level 1 dcl 1-43 output_cdp 000262 automatic pointer dcl 1-39 set ref 414* 415 417 421 431 435 449 452 642 645 1302* 1318 1329 1347 1361 1364 1371 1410 1442 1443 1453 1454 1468 1471 1487 1490 1507 1510 1527 1530 1547 1550 1564 1567 1586 1590 1606 1610 1846 1849 output_disabled_sw 4(03) based bit(1) level 3 packed packed unaligned dcl 11-21 ref 1676 overlay based fixed bin(35,0) array dcl 127 set ref 682* 1883* 1929* overlay_len 000137 automatic fixed bin(17,0) dcl 127 set ref 681* 682 1882* 1883 1928* 1929 partial_in_process_sw 144(01) based bit(1) level 4 packed packed unaligned dcl 13-26 set ref 572 583* 1648* 1718 1767 1783* 1952 program_interrupt 000110 stack reference condition dcl 75 ref 837 860 ptr_array 000020 internal static pointer array dcl 147 set ref 1623* 1628 2127* 2129* queue_ctl based structure level 1 dcl 9-13 in procedure "cmcs_queue_ctl_" queue_ctl 4 based bit(1) level 3 in structure "user_ctl" dcl 14-17 in procedure "cmcs_queue_ctl_" set ref 218 2195 2215* queue_ctl_eindex 35 based fixed bin(17,0) level 2 in structure "wait_ctl_entry" dcl 16-35 in procedure "cmcs_queue_ctl_" ref 879 queue_ctl_eindex 127 based fixed bin(17,0) array level 4 in structure "tree_ctl" dcl 13-16 in procedure "cmcs_queue_ctl_" set ref 1224 queue_ctl_eindex 27 based fixed bin(17,0) level 3 in structure "tree_ctl_entry" dcl 13-26 in procedure "cmcs_queue_ctl_" ref 517 738 791 1241 1374 2002 2160 queue_ctl_eindex 000374 automatic fixed bin(17,0) dcl 9-17 in procedure "cmcs_queue_ctl_" set ref 242* 243 280* 281 317* 318 517* 518 738* 739 791* 792 820* 821 879* 880 1374* 1376 2002* 2003 2160* 2161 queue_ctl_entry based structure level 1 dcl 9-21 queue_ctl_eptr 000376 automatic pointer dcl 9-19 in procedure "cmcs_queue_ctl_" set ref 243* 247 281* 283 283 318* 320 320 518* 543* 590* 739* 792* 794 821* 823 880* 890 919 947 949* 1056* 1376* 1665 1807* 1810* 2003* 2021 2161* 2163 2163 queue_ctl_eptr 156 based pointer level 4 in structure "tree_ctl_entry" dcl 13-26 in procedure "cmcs_queue_ctl_" set ref 1376* queue_ctl_ptr 000062 internal static pointer dcl 9-11 in procedure "cmcs_queue_ctl_" set ref 243 281 318 518 739 792 821 880 1376 2003 2155 2161 2166 2200* 2233 2249 queue_ctl_ptr 150 based pointer level 3 in structure "user_ctl" dcl 14-17 in procedure "cmcs_queue_ctl_" ref 2200 queue_name 16 based char(32) level 2 in structure "queue_ctl_entry" dcl 9-21 in procedure "cmcs_queue_ctl_" set ref 2021* queue_name 17 based char(32) level 3 in structure "tree_ctl_entry" dcl 13-26 in procedure "cmcs_queue_ctl_" set ref 545* 579* 592* 608* 618* 931* 1539* 2018 2046* 2084* 2109* 2134* queue_table 1 based fixed bin(17,0) array level 2 dcl 174 set ref 242 280 317 820 1224* 1241* queue_table_len based fixed bin(17,0) level 2 dcl 174 set ref 240 278 315 818 1206* 1223* 1231* 1240* 1240 1241 queue_table_ptr 000040 internal static pointer dcl 172 set ref 240 242 278 280 315 317 818 820 1206* 1223 1224 1231 1240 1240 1241 1241 queue_table_struc based structure level 1 unaligned dcl 174 set ref 1206 rcv_descr 000052 internal static structure level 1 packed packed unaligned dcl 182 set ref 679 947* 1048* 1137* 1139* 1150 rcv_descr_ptr 000056 internal static pointer dcl 186 set ref 679* 949* 1056* rcv_init_sw 000060 internal static bit(1) initial packed unaligned dcl 190 set ref 676 690* rcv_msg_sw 144(03) based bit(1) level 4 packed packed unaligned dcl 13-26 set ref 1265* 1270* rcv_seg_sw 144(04) based bit(1) level 4 packed packed unaligned dcl 13-26 set ref 1079 1265* 1268* rcv_vfile_rs 000042 internal static structure level 1 unaligned dcl 180 set ref 680 681 rcv_vfile_rs_ptr 000054 internal static pointer dcl 184 set ref 680* 682 1135* 1153* rcv_wait_sw 144(02) based bit(1) level 4 packed packed unaligned dcl 13-26 set ref 1261* rec 13(06) based bit(1) level 3 packed packed unaligned dcl 14-17 ref 725 776 846 894 911 931 1063 1104 rec_len 2 000024 internal static fixed bin(21,0) level 2 dcl 158 set ref 1899* rec_ptr 4 000024 internal static pointer level 2 in structure "send_vfile_rs" dcl 158 in procedure "cmcs_queue_ctl_" set ref 1747 1758 rec_ptr 4 000042 internal static pointer level 2 in structure "rcv_vfile_rs" dcl 180 in procedure "cmcs_queue_ctl_" set ref 969 1116 release_temp_segments_ 000116 constant entry external dcl 104 ref 2129 rtrim builtin function dcl 88 ref 2018 seek_len 000252 automatic fixed bin(21,0) dcl 163 set ref 1711* 1713* 1715* 1715 1718* 1718 1899 seg_count 170 based fixed bin(35,0) level 4 in structure "tree_ctl_entry" dcl 13-26 in procedure "cmcs_queue_ctl_" set ref 587 598 971* 1039 1742* 1796 1957* 1978* seg_count 24 based fixed bin(17,0) level 2 in structure "msg_hdr" dcl 7-15 in procedure "cmcs_queue_ctl_" set ref 971 1796* 1935* seg_data 4 based char level 3 dcl 8-12 set ref 1003 1003 1029 1767* 1776* 1778* 1780* seg_len 3 based fixed bin(35,0) level 3 dcl 8-12 set ref 996 1003 1003 1003* 1029 1767 1774* 1774 1776 1778 1780 1952* 1954* 1956 seg_no 000107 automatic fixed bin(35,0) dcl 71 in procedure "cmcs_queue_ctl_" set ref 598* 600 608* 618* 984* 1093* 1742 2175* 2183* seg_no 2 000365 automatic fixed bin(35,0) level 2 in structure "key_struc" dcl 6-12 in procedure "cmcs_queue_ctl_" set ref 600* 984* 1093* 2175* 2183* seg_no 174 based fixed bin(35,0) level 5 in structure "tree_ctl_entry" dcl 13-26 in procedure "cmcs_queue_ctl_" set ref 984* 1039 1093 1093* 1711 1744 1949 1957 1982* 2175* 2183 2183* seg_no 1 based fixed bin(35,0) level 2 in structure "msg_hdr" dcl 7-15 in procedure "cmcs_queue_ctl_" set ref 984 1934* seg_no 1 based fixed bin(35,0) level 3 in structure "msg_seg" dcl 8-12 in procedure "cmcs_queue_ctl_" set ref 1949* send_init_sw 000016 internal static bit(1) initial packed unaligned dcl 145 set ref 1297 1888* send_vfile_rs 000024 internal static structure level 1 unaligned dcl 158 set ref 1881 1882 1918 1918 send_vfile_rs_ptr 000034 internal static pointer dcl 160 set ref 1881* 1883 size builtin function dcl 88 ref 681 1882 slew_ctl 2 based fixed bin(35,0) level 3 in structure "msg_seg" dcl 8-12 in procedure "cmcs_queue_ctl_" set ref 1003 1003 1950* slew_ctl based structure level 1 dcl 10-10 in procedure "cmcs_queue_ctl_" slew_ctl_ptr 000400 automatic pointer dcl 10-8 set ref 1827* 1836 1841 1841 1841 1855 1855 1858 1858 1861 1861 1861 1865 1865 1868 1868 1868 source_group_id 7 based char(32) level 2 dcl 7-15 set ref 1793* source_station 4 based char(12) level 2 dcl 7-15 set ref 977 1792* 1932* static_queue_info 17 based structure level 2 in structure "tree_ctl_entry" dcl 13-26 in procedure "cmcs_queue_ctl_" static_queue_info 117 based structure array level 3 in structure "tree_ctl" dcl 13-16 in procedure "cmcs_queue_ctl_" station_count 000136 automatic fixed bin(17,0) dcl 120 in procedure "cmcs_queue_ctl_" set ref 417* 419 1311* 1345 1848 station_count 5 based picture(4) level 2 in structure "output_cd" dcl 1-43 in procedure "cmcs_queue_ctl_" ref 417 station_ctl_eindex 143 based fixed bin(17,0) level 2 in structure "user_ctl" dcl 14-17 in procedure "cmcs_queue_ctl_" set ref 758* 1685* station_ctl_eindex 000402 automatic fixed bin(17,0) dcl 11-17 in procedure "cmcs_queue_ctl_" set ref 630* 632* 1350* station_ctl_entry based structure level 1 dcl 11-21 station_ctl_eptr 000404 automatic pointer dcl 11-19 set ref 1350* 1676 station_name 000133 automatic char(12) packed unaligned dcl 120 in procedure "cmcs_queue_ctl_" set ref 421* 423* 630* 1347* 1350* 1352* 1480* 1500* 1520* 1557* 1579* 1599* 2170* station_name 140 based char(12) level 2 in structure "user_ctl" dcl 14-17 in procedure "cmcs_queue_ctl_" ref 1792 1932 station_name 36(18) based char(12) level 2 in structure "input_cd" packed packed unaligned dcl 1-13 in procedure "cmcs_queue_ctl_" set ref 977* station_name 7(27) based char(12) array level 3 in structure "output_cd" packed packed unaligned dcl 1-43 in procedure "cmcs_queue_ctl_" ref 421 1347 status_info 26 based structure level 2 dcl 7-15 status_key 7 based char(2) level 2 in structure "output_cd" packed packed unaligned dcl 1-43 in procedure "cmcs_queue_ctl_" set ref 415* 431* 449* 642* 1318* 1329* 1361* 1442* 1453* 1468* 1487* 1507* 1527* 1547* 1564* 1586* 1606* 1846* status_key 42(27) based char(2) level 2 in structure "input_cd" packed packed unaligned dcl 1-13 in procedure "cmcs_queue_ctl_" set ref 253* 290* 328* 464* 471* 502* 731* 783* 802* 843* 865* 939* 1021* 1070* 1084* 1110* 1182* 1215* status_list_ctl_entries 44 based structure array level 2 dcl 9-21 status_list_ctl_entry based structure level 1 dcl 9-44 string builtin function dcl 88 set ref 725 725 855 855 981* 981 1256* 1972* 1977* sub_err_ 000102 constant entry external dcl 91 ref 545 579 592 608 618 725 776 846 894 911 931 1063 1104 1480 1500 1520 1539 1557 1579 1599 1841 2046 2084 2109 2134 2170 2237 sub_err_retval 000124 automatic fixed bin(35,0) dcl 97 set ref 545* 579* 592* 608* 618* 725* 776* 846* 894* 911* 931* 1063* 1104* 1480* 1500* 1520* 1539* 1557* 1579* 1599* 1841* 2046* 2084* 2109* 2134* 2170* 2237* substr builtin function dcl 88 set ref 1029* 1029 1643* 1643 1767* 1767 1776* 1776 1778* 1780* 1780 2026 2026 subtree_count 16 based fixed bin(17,0) level 3 in structure "tree_ctl_entry" dcl 13-26 in procedure "cmcs_queue_ctl_" ref 371 491 1176 1237 subtree_count 000255 automatic fixed bin(17,0) dcl 188 in procedure "cmcs_queue_ctl_" set ref 466* 477 487 707 788 1171 1210* 1220 1233 switch_name 146 based char(32) level 4 packed packed unaligned dcl 13-26 set ref 2018* 2026* 2046* 2109* switch_no 000022 internal static fixed bin(17,0) initial dcl 153 set ref 2015* 2015 2017 switch_pic 000251 automatic picture(2) packed unaligned dcl 156 set ref 2017* 2018 sysprint 000076 constant file interactive environment dcl 73 system_ctl based structure level 1 dcl 12-15 system_ctl_ptr 000064 internal static pointer dcl 12-13 in procedure "cmcs_queue_ctl_" set ref 2021 2155 2201* 2233 system_ctl_ptr 156 based pointer level 3 in structure "user_ctl" dcl 14-17 in procedure "cmcs_queue_ctl_" ref 2201 terminal_sw 13(03) based bit(1) level 3 packed packed unaligned dcl 14-17 ref 754 1659 test_sw 000010 internal static bit(1) initial packed unaligned dcl 77 set ref 2224* text_delim 42(18) based picture(1) level 2 packed packed unaligned dcl 1-13 set ref 1020* 1045* 1082* text_len 41(18) based picture(4) level 2 packed packed unaligned dcl 1-13 set ref 1019* 1046* 1083* tree_ctl based structure level 1 dcl 13-16 tree_ctl_eindex 000406 automatic fixed bin(17,0) dcl 13-22 in procedure "cmcs_queue_ctl_" set ref 368* 370* 423* 466* 487 487 882* 883 919* 922 1171 1171 1188 1210* 1224 1233 1233 1352* tree_ctl_eindex 1 based fixed bin(17,0) level 2 in structure "queue_ctl_entry" dcl 9-21 in procedure "cmcs_queue_ctl_" ref 919 tree_ctl_eindex 52 based fixed bin(17,0) level 2 in structure "wait_ctl_entry" dcl 16-35 in procedure "cmcs_queue_ctl_" ref 882 tree_ctl_entry based structure level 1 dcl 13-26 tree_ctl_eptr 000410 automatic pointer dcl 13-24 set ref 370* 371 371 377 385 385 396 423* 466* 489* 491 517 519 520 521 532 545 563 572 575 577 579 583 587 592 598 608 618 716 719 725 725 725 737 738 791 883* 922* 931 947 969 971 972 981 983 984 985 996 996 998 1012 1016 1019 1027 1027 1029 1029 1032 1032 1033 1033 1034 1034 1035 1035 1039 1039 1043 1046 1047 1048 1056 1079 1083 1093 1093 1096 1116 1128 1135 1153 1174* 1176 1176 1176 1176 1188* 1210* 1235* 1237 1241 1256 1257 1258 1259 1261 1265 1265 1268 1270 1283 1283 1285 1352* 1374 1376 1378 1380 1383 1384 1398 1410 1419 1539 1620 1628 1630 1634 1635 1638 1647 1647 1648 1662 1711 1718 1718 1742 1744 1747 1751 1753 1758 1759 1767 1772 1773 1783 1784 1794 1796 1807 1807 1810 1810 1933 1948 1949 1952 1954 1956 1956 1957 1957 1972 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 2002 2005 2008 2013 2018 2018 2026 2032 2046 2046 2052 2053 2056 2074 2077 2080 2084 2091 2095 2100 2101 2104 2109 2109 2113 2115 2118 2119 2124 2127 2134 2151 2160 2163 2175 2181 2183 2183 2259 tree_ctl_ptr 000066 internal static pointer dcl 13-14 in procedure "cmcs_queue_ctl_" set ref 368 370 489 883 922 1174 1188 1206 1206 1224 1235 2202* tree_ctl_ptr 162 based pointer level 3 in structure "user_ctl" dcl 14-17 in procedure "cmcs_queue_ctl_" ref 2202 tree_path based structure level 3 in structure "tree_ctl_entry" dcl 13-26 in procedure "cmcs_queue_ctl_" ref 725 725 981 tree_path 17 based structure level 2 in structure "input_cd" dcl 1-13 in procedure "cmcs_queue_ctl_" set ref 855 855 981* tseg based char packed unaligned dcl 148 set ref 1643* 1776 tseg_info 176 based structure level 3 dcl 13-26 tseg_len 200 based fixed bin(35,0) level 4 in structure "tree_ctl_entry" dcl 13-26 in procedure "cmcs_queue_ctl_" set ref 575* 1630* 1635 1638 1647* 1647 1718 1773 1784* 1954 1983* tseg_len 000146 automatic fixed bin(21,0) dcl 148 in procedure "cmcs_queue_ctl_" set ref 1630* 1635* 1643 1643 1773* 1776 1776 1776 1778 1780 tseg_max_len 000147 automatic fixed bin(21,0) initial dcl 151 set ref 151* 1638 tseg_ptr 000144 automatic pointer dcl 148 in procedure "cmcs_queue_ctl_" set ref 1628* 1634* 1643 1772* 1776 tseg_ptr 176 based pointer level 4 in structure "tree_ctl_entry" dcl 13-26 in procedure "cmcs_queue_ctl_" set ref 577* 1620 1628* 1634 1772 2124 2127 unlock_sw 1(01) 000042 internal static bit(1) level 3 packed packed unaligned dcl 180 set ref 684* user_ctl based structure level 1 dcl 14-17 user_ctl_ptr 000070 internal static pointer dcl 14-15 set ref 725 754 758 776 840 846 855 876 894 911 931 1063 1104 1659 1685 1792 1932 2021 2198* 2200 2201 2202 2203 2215 version 000042 internal static fixed bin(17,0) level 2 in structure "rcv_vfile_rs" dcl 180 in procedure "cmcs_queue_ctl_" set ref 683* version 3 based fixed bin(17,0) level 2 in structure "msg_hdr" dcl 7-15 in procedure "cmcs_queue_ctl_" set ref 1931* version 000024 internal static fixed bin(17,0) level 2 in structure "send_vfile_rs" dcl 158 in procedure "cmcs_queue_ctl_" set ref 1885* vfile_descr 000412 automatic structure level 1 packed packed unaligned dcl 15-28 vfile_rs based structure level 1 dcl 15-13 vfile_rs_version constant fixed bin(17,0) initial dcl 15-9 ref 683 1885 vfile_status 162 based fixed bin(17,0) level 4 dcl 13-26 set ref 2005 2013 2032* 2052* 2056 2074 2077 2091* 2101* 2119* wait_ctl based structure level 1 dcl 16-13 wait_ctl_eindex 000413 automatic fixed bin(17,0) dcl 16-31 in procedure "cmcs_queue_ctl_" set ref 876* 877 905* wait_ctl_eindex 254 based fixed bin(17,0) level 3 in structure "user_ctl" dcl 14-17 in procedure "cmcs_queue_ctl_" set ref 840* 855* 876 wait_ctl_entry based structure level 1 dcl 16-35 wait_ctl_eptr 000414 automatic pointer dcl 16-33 set ref 877* 879 882 wait_ctl_mp_entry based structure level 1 dcl 16-56 wait_ctl_ptr 164 based pointer level 3 in structure "user_ctl" dcl 14-17 in procedure "cmcs_queue_ctl_" ref 2203 wait_ctl_ptr 000072 internal static pointer dcl 16-11 in procedure "cmcs_queue_ctl_" set ref 877 2203* wait_info 252 based structure level 2 dcl 14-17 what 0(09) based fixed bin(8,0) level 2 packed packed unaligned dcl 10-10 set ref 1841* 1858 1858 1861 1865 1868 when based fixed bin(8,0) level 2 packed packed unaligned dcl 10-10 set ref 1836 1841* 1855 1855 zero 000045 constant fixed bin(35,0) initial dcl 135 set ref 2213 zero_descr based structure level 1 packed packed unaligned dcl 139 ref 1139 1980 1985 zero_descr_ptr 000014 internal static pointer dcl 137 set ref 1139 1980 1985 2213* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. buffer_left_len automatic fixed bin(35,0) dcl 64 char builtin function dcl 88 cmcs_create_queues_ 000000 constant entry external dcl 3-18 cmcs_decode_status_ 000000 constant entry external dcl 3-22 cmcs_error_table_$bad_dest_count external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$bad_password external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$bad_queue_path external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$bad_source external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$bad_station external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$bad_term_devchn external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$bad_tree_path external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$dest_already_disabled external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$dest_already_enabled external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$null_partial_message external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$source_already_disabled external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$source_already_enabled external static fixed bin(35,0) dcl 4-5 cmcs_expand_tree_path_ 000000 constant entry external dcl 3-24 cmcs_fillin_hdr_ 000000 constant entry external dcl 3-26 cmcs_initiate_ctl_ 000000 constant entry external dcl 3-28 cmcs_purge_queues_ 000000 constant entry external dcl 3-32 cmcs_queue_ctl_$accept_message_count 000000 constant entry external dcl 3-34 cmcs_queue_ctl_$disable 000000 constant entry external dcl 3-35 cmcs_queue_ctl_$enable 000000 constant entry external dcl 3-36 cmcs_queue_ctl_$print 000000 constant entry external dcl 3-37 cmcs_queue_ctl_$purge 000000 constant entry external dcl 3-38 cmcs_queue_ctl_$receive 000000 constant entry external dcl 3-39 cmcs_queue_ctl_$send 000000 constant entry external dcl 3-40 cmcs_queue_ctl_$stop_run 000000 constant entry external dcl 3-41 cmcs_scramble_ 000000 constant entry external dcl 3-43 cmcs_station_ctl_$attach 000000 constant entry external dcl 3-48 cmcs_station_ctl_$detach 000000 constant entry external dcl 3-49 cmcs_station_ctl_$detach_name 000000 constant entry external dcl 3-50 cmcs_station_ctl_$disable_input_terminal 000000 constant entry external dcl 3-51 cmcs_station_ctl_$disable_output_terminal 000000 constant entry external dcl 3-52 cmcs_station_ctl_$enable_input_terminal 000000 constant entry external dcl 3-53 cmcs_station_ctl_$enable_output_terminal 000000 constant entry external dcl 3-54 cmcs_terminal_ctl_$find 000000 constant entry external dcl 3-64 cmcs_tree_ctl_$find_index 000000 constant entry external dcl 3-67 cmcs_tree_ctl_$find_qual_name 000000 constant entry external dcl 3-69 cmcs_wait_ctl_$clear_mp 000000 constant entry external dcl 3-77 cmcs_wait_ctl_$find 000000 constant entry external dcl 3-73 cmcs_wait_ctl_$mp_available 000000 constant entry external dcl 3-74 cmcs_wait_ctl_$mp_login 000000 constant entry external dcl 3-75 cmcs_wait_ctl_$mp_logout 000000 constant entry external dcl 3-76 cmcs_wait_ctl_$start_mp 000000 constant entry external dcl 3-78 cmcs_wait_ctl_$stop_mp 000000 constant entry external dcl 3-79 control_hdr_len internal static fixed bin(17,0) initial dcl 2-7 control_hdr_ptr automatic pointer dcl 2-9 fixed builtin function dcl 88 index builtin function dcl 88 ioa_ 000000 constant entry external dcl 91 iox_$attach_iocb 000000 constant entry external dcl 5-3 iox_$error_output external static pointer dcl 5-25 iox_$find_iocb 000000 constant entry external dcl 5-3 iox_$get_chars 000000 constant entry external dcl 5-3 iox_$get_line 000000 constant entry external dcl 5-3 iox_$modes 000000 constant entry external dcl 5-3 iox_$position 000000 constant entry external dcl 5-3 iox_$put_chars 000000 constant entry external dcl 5-3 iox_$read_key 000000 constant entry external dcl 5-3 iox_$read_length 000000 constant entry external dcl 5-3 iox_$read_record 000000 constant entry external dcl 5-3 iox_$rewrite_record 000000 constant entry external dcl 5-3 iox_$user_input external static pointer dcl 5-25 iox_$user_io external static pointer dcl 5-25 iox_$user_output external static pointer dcl 5-25 iox_$write_record 000000 constant entry external dcl 5-3 last_station_info based structure level 1 dcl 1-66 msg_seg_version internal static fixed bin(17,0) initial dcl 8-7 queue_ctl_entry_len internal static fixed bin(17,0) initial dcl 9-7 queue_ctl_hdr_len internal static fixed bin(17,0) initial dcl 9-7 queue_ctl_version internal static fixed bin(17,0) initial dcl 9-7 send_descr internal static structure level 1 packed packed unaligned dcl 162 set_lock_$lock 000000 constant entry external dcl 108 set_lock_$unlock 000000 constant entry external dcl 108 station_ctl based structure level 1 dcl 11-13 station_ctl_entry_len internal static fixed bin(17,0) initial dcl 11-7 station_ctl_hdr_len internal static fixed bin(17,0) initial dcl 11-7 station_ctl_ptr internal static pointer dcl 11-11 station_ctl_version internal static fixed bin(17,0) initial dcl 11-7 status_list_ctl_eindex automatic fixed bin(17,0) dcl 9-40 status_list_ctl_eptr automatic pointer dcl 9-42 system_ctl_entry_len internal static fixed bin(17,0) initial dcl 12-9 system_ctl_hdr_len internal static fixed bin(17,0) initial dcl 12-9 system_ctl_version internal static fixed bin(17,0) initial dcl 12-9 tree_ctl_entry_len internal static fixed bin(17,0) initial dcl 13-10 tree_ctl_hdr_len internal static fixed bin(17,0) initial dcl 13-10 tree_ctl_version internal static fixed bin(17,0) initial dcl 13-10 user_ctl_exists_sw internal static bit(1) initial dcl 14-11 vfile_rs_ptr automatic pointer dcl 15-11 wait_ctl_entry_len internal static fixed bin(17,0) initial dcl 16-7 wait_ctl_hdr_len internal static fixed bin(17,0) initial dcl 16-7 wait_ctl_mp_eindex automatic fixed bin(17,0) dcl 16-52 wait_ctl_mp_eptr automatic pointer dcl 16-54 wait_ctl_version internal static fixed bin(17,0) initial dcl 16-7 NAMES DECLARED BY EXPLICIT CONTEXT. E1 005517 constant entry internal dcl 1438 ref 1670 E10 006173 constant entry internal dcl 1574 ref 1638 E11 006263 constant entry internal dcl 1596 ref 1625 E2 005533 constant entry internal dcl 1449 ref 1680 E3 005547 constant entry internal dcl 1461 ref 1687 1694 E4 005566 constant entry internal dcl 1477 ref 1703 E5 005646 constant entry internal dcl 1497 ref 1708 E6 005734 constant entry internal dcl 1517 ref 1739 E8 006014 constant entry internal dcl 1536 ref 1803 1813 E9 006104 constant entry internal dcl 1554 ref 1380 accept_message_count 001165 constant entry external dcl 223 build_queue_table 005312 constant entry internal dcl 1198 ref 233 271 308 702 close 010075 constant entry internal dcl 2069 ref 396 close_err 010116 constant label dcl 2084 ref 2097 cmcs_queue_ctl_ 001152 constant entry external dcl 34 disable 001266 constant entry external dcl 261 enable 001364 constant entry external dcl 298 end_delete_msg_seg_loop 005012 constant label dcl 623 ref 612 get_tce_parms 004230 constant entry internal dcl 514 ref 375 440 480 494 iox_attach 007544 constant label dcl 2015 iox_open 007726 constant label dcl 2034 ref 2056 open 007521 constant entry internal dcl 1999 ref 926 1706 print 002063 constant entry external dcl 658 purge 001506 constant entry external dcl 346 purge_common 001527 constant label dcl 354 ref 342 purge_rcv_entry 004254 constant entry internal dcl 529 ref 390 481 495 purge_send_entry 004373 constant entry internal dcl 558 ref 382 441 purge_set_input_err 001776 constant label dcl 471 ref 483 qc_lock 010625 constant entry internal dcl 2229 ref 771 885 1051 1801 qc_unlock 010710 constant entry internal dcl 2246 ref 804 834 941 958 1068 1818 rcv_check_for_more_segs 003422 constant label dcl 1039 ref 1006 1012 rcv_check_io_in_process 005235 constant entry internal dcl 1161 ref 710 rcv_common 002123 constant label dcl 672 ref 663 rcv_copy_seg_data 003330 constant label dcl 1012 ref 748 1037 rcv_error_return 002647 constant label dcl 865 ref 851 rcv_find_msg 002316 constant label dcl 754 rcv_found_msg 003043 constant label dcl 919 ref 810 823 rcv_get_next_seg 003640 constant label dcl 1093 ref 743 rcv_lock_err 002351 constant label dcl 776 ref 887 rcv_no_msg 002443 constant label dcl 797 ref 830 rcv_queue_err 003057 constant label dcl 931 ref 953 966 1053 rcv_seek_descr 005176 constant entry internal dcl 1147 ref 964 rcv_seek_key 005077 constant entry internal dcl 1123 ref 1098 rcv_set_buffer 005472 constant entry internal dcl 1279 ref 746 991 rcv_set_msg_busy 003053 constant label dcl 924 ref 917 rcv_set_seg_ctl 003271 constant label dcl 996 ref 1118 rcv_set_type 005430 constant entry internal dcl 1253 ref 741 962 rcv_wait_msg 002514 constant label dcl 834 ref 797 898 receive 002106 constant entry external dcl 667 reset_tce_io 007454 constant entry internal dcl 1965 ref 550 650 924 1396 ret_bad_slew 007047 constant label dcl 1838 set ref 1855 1858 1861 1868 ret_good_slew 007041 constant label dcl 1832 ref 1872 send 003747 constant entry external dcl 1291 send_check_slew 007033 constant entry internal dcl 1824 ref 1313 send_fillin_msg_hdr 007344 constant entry internal dcl 1925 ref 1749 send_fillin_seg_hdr 007421 constant entry internal dcl 1945 ref 1765 send_get_key 010432 constant entry internal dcl 2148 ref 1701 send_init 007222 constant entry internal dcl 1878 ref 1297 send_loop_end 004161 constant label dcl 1410 ref 437 454 1445 1473 1492 1512 1532 1569 1592 1612 send_non_partial 006451 constant entry internal dcl 1654 ref 1433 send_partial 006351 constant entry internal dcl 1617 ref 1431 send_seek_key 007251 constant entry internal dcl 1896 ref 1737 set 004220 constant entry internal dcl 214 ref 227 265 302 359 672 1295 set_new_status 010723 constant entry internal dcl 2255 ref 1408 setup 010570 constant entry internal dcl 2192 ref 218 stop_run 001464 constant entry external dcl 336 test 004206 constant entry external dcl 2221 test_subtype 005510 constant entry internal dcl 1428 ref 1405 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 11650 12110 10764 11660 Length 13070 10764 240 743 663 66 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cmcs_queue_ctl_ 1627 external procedure is an external procedure. set internal procedure shares stack frame of external procedure cmcs_queue_ctl_. get_tce_parms internal procedure shares stack frame of external procedure cmcs_queue_ctl_. purge_rcv_entry internal procedure shares stack frame of external procedure cmcs_queue_ctl_. purge_send_entry internal procedure shares stack frame of external procedure cmcs_queue_ctl_. on unit on line 837 130 on unit rcv_seek_key internal procedure shares stack frame of external procedure cmcs_queue_ctl_. rcv_seek_descr internal procedure shares stack frame of external procedure cmcs_queue_ctl_. rcv_check_io_in_process internal procedure shares stack frame of external procedure cmcs_queue_ctl_. build_queue_table internal procedure shares stack frame of external procedure cmcs_queue_ctl_. rcv_set_type internal procedure shares stack frame of external procedure cmcs_queue_ctl_. rcv_set_buffer internal procedure shares stack frame of external procedure cmcs_queue_ctl_. test_subtype internal procedure shares stack frame of external procedure cmcs_queue_ctl_. E1 internal procedure shares stack frame of external procedure cmcs_queue_ctl_. E2 internal procedure shares stack frame of external procedure cmcs_queue_ctl_. E3 internal procedure shares stack frame of external procedure cmcs_queue_ctl_. E4 internal procedure shares stack frame of external procedure cmcs_queue_ctl_. E5 internal procedure shares stack frame of external procedure cmcs_queue_ctl_. E6 internal procedure shares stack frame of external procedure cmcs_queue_ctl_. E8 internal procedure shares stack frame of external procedure cmcs_queue_ctl_. E9 internal procedure shares stack frame of external procedure cmcs_queue_ctl_. E10 internal procedure shares stack frame of external procedure cmcs_queue_ctl_. E11 internal procedure shares stack frame of external procedure cmcs_queue_ctl_. send_partial internal procedure shares stack frame of external procedure cmcs_queue_ctl_. send_non_partial internal procedure shares stack frame of external procedure cmcs_queue_ctl_. send_check_slew internal procedure shares stack frame of external procedure cmcs_queue_ctl_. send_init internal procedure shares stack frame of external procedure cmcs_queue_ctl_. send_seek_key internal procedure shares stack frame of external procedure cmcs_queue_ctl_. send_fillin_msg_hdr internal procedure shares stack frame of external procedure cmcs_queue_ctl_. send_fillin_seg_hdr internal procedure shares stack frame of external procedure cmcs_queue_ctl_. reset_tce_io internal procedure shares stack frame of external procedure cmcs_queue_ctl_. open internal procedure shares stack frame of external procedure cmcs_queue_ctl_. close internal procedure shares stack frame of external procedure cmcs_queue_ctl_. send_get_key internal procedure shares stack frame of external procedure cmcs_queue_ctl_. setup internal procedure shares stack frame of external procedure cmcs_queue_ctl_. qc_lock internal procedure shares stack frame of external procedure cmcs_queue_ctl_. qc_unlock internal procedure shares stack frame of external procedure cmcs_queue_ctl_. set_new_status internal procedure shares stack frame of external procedure cmcs_queue_ctl_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 test_sw cmcs_queue_ctl_ 000012 min_blksz_info cmcs_queue_ctl_ 000014 zero_descr_ptr cmcs_queue_ctl_ 000016 send_init_sw cmcs_queue_ctl_ 000020 ptr_array cmcs_queue_ctl_ 000022 switch_no cmcs_queue_ctl_ 000024 send_vfile_rs cmcs_queue_ctl_ 000034 send_vfile_rs_ptr cmcs_queue_ctl_ 000036 init_queue_table_sw cmcs_queue_ctl_ 000040 queue_table_ptr cmcs_queue_ctl_ 000042 rcv_vfile_rs cmcs_queue_ctl_ 000052 rcv_descr cmcs_queue_ctl_ 000054 rcv_vfile_rs_ptr cmcs_queue_ctl_ 000056 rcv_descr_ptr cmcs_queue_ctl_ 000060 rcv_init_sw cmcs_queue_ctl_ 000062 queue_ctl_ptr cmcs_queue_ctl_ 000064 system_ctl_ptr cmcs_queue_ctl_ 000066 tree_ctl_ptr cmcs_queue_ctl_ 000070 user_ctl_ptr cmcs_queue_ctl_ 000072 wait_ctl_ptr cmcs_queue_ctl_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cmcs_queue_ctl_ 000100 cdp cmcs_queue_ctl_ 000102 buffer_len cmcs_queue_ctl_ 000103 buffer_left_index cmcs_queue_ctl_ 000104 buffer_ptr cmcs_queue_ctl_ 000106 msg_no cmcs_queue_ctl_ 000107 seg_no cmcs_queue_ctl_ 000116 iocb_ptr cmcs_queue_ctl_ 000120 my_name cmcs_queue_ctl_ 000124 sub_err_retval cmcs_queue_ctl_ 000125 i cmcs_queue_ctl_ 000126 code cmcs_queue_ctl_ 000127 old_status cmcs_queue_ctl_ 000130 new_status cmcs_queue_ctl_ 000131 io_subtype cmcs_queue_ctl_ 000132 io_type cmcs_queue_ctl_ 000133 station_name cmcs_queue_ctl_ 000136 station_count cmcs_queue_ctl_ 000137 overlay_len cmcs_queue_ctl_ 000140 dest_table_index cmcs_queue_ctl_ 000141 flag cmcs_queue_ctl_ 000142 msg_descr cmcs_queue_ctl_ 000144 tseg_ptr cmcs_queue_ctl_ 000146 tseg_len cmcs_queue_ctl_ 000147 tseg_max_len cmcs_queue_ctl_ 000150 attach_descr cmcs_queue_ctl_ 000250 attach_descr_len cmcs_queue_ctl_ 000251 switch_pic cmcs_queue_ctl_ 000252 seek_len cmcs_queue_ctl_ 000253 fb21 cmcs_queue_ctl_ 000254 copy_len cmcs_queue_ctl_ 000255 subtree_count cmcs_queue_ctl_ 000256 msg_count cmcs_queue_ctl_ 000260 input_cdp cmcs_queue_ctl_ 000262 output_cdp cmcs_queue_ctl_ 000264 key cmcs_queue_ctl_ 000365 key_struc cmcs_queue_ctl_ 000370 msg_hdr_ptr cmcs_queue_ctl_ 000372 msg_seg_ptr cmcs_queue_ctl_ 000374 queue_ctl_eindex cmcs_queue_ctl_ 000376 queue_ctl_eptr cmcs_queue_ctl_ 000400 slew_ctl_ptr cmcs_queue_ctl_ 000402 station_ctl_eindex cmcs_queue_ctl_ 000404 station_ctl_eptr cmcs_queue_ctl_ 000406 tree_ctl_eindex cmcs_queue_ctl_ 000410 tree_ctl_eptr cmcs_queue_ctl_ 000412 vfile_descr cmcs_queue_ctl_ 000413 wait_ctl_eindex cmcs_queue_ctl_ 000414 wait_ctl_eptr cmcs_queue_ctl_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out return_mac tra_ext_1 enable_op shorten_stack ext_entry int_entry unpack_picture alloc_storage THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. clock_ cmcs_date_time_ cmcs_print_ cmcs_set_lock_$lock cmcs_set_lock_$unlock cmcs_station_ctl_$find_destination cmcs_station_ctl_$input_disabled cmcs_station_ctl_$output_disabled cmcs_station_ctl_$validate cmcs_status_list_ctl_$add cmcs_status_list_ctl_$delete cmcs_status_list_ctl_$move cmcs_tree_ctl_$find_destination cmcs_tree_ctl_$find_tree_path cmcs_wait_ctl_$add cmcs_wait_ctl_$delete get_group_id_ get_process_id_ get_temp_segments_ hcs_$truncate_seg ioa_$rsnnl iox_$attach_name iox_$close iox_$control iox_$delete_record iox_$detach_iocb iox_$open iox_$seek_key release_temp_segments_ sub_err_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cmcs_error_table_$ambiguous_tree_path cmcs_error_table_$bad_call_parm cmcs_error_table_$bad_dest cmcs_error_table_$bad_message_length cmcs_error_table_$bad_slew cmcs_error_table_$dest_disabled cmcs_error_table_$no_message cmcs_error_table_$no_partial_messages cmcs_error_table_$queue_already_disabled cmcs_error_table_$queue_already_enabled cmcs_error_table_$queue_disabled cmcs_error_table_$source_disabled error_table_$action_not_performed error_table_$bad_new_key error_table_$no_record error_table_$not_open external_user_ctl_ptr sysprint sysprint.fsb LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 73 001122 85 001137 151 001143 6 12 001145 34 001151 37 001160 223 001161 227 001200 229 001201 230 001205 231 001207 233 001211 235 001212 238 001214 240 001215 242 001225 243 001230 247 001234 250 001240 252 001245 253 001255 255 001260 261 001261 265 001301 267 001302 268 001306 269 001310 271 001312 273 001313 276 001315 278 001316 280 001327 281 001332 283 001336 285 001344 287 001346 289 001353 290 001355 292 001361 298 001362 302 001377 304 001400 305 001404 306 001406 308 001410 310 001411 313 001413 315 001414 317 001425 318 001430 320 001434 323 001442 325 001444 327 001451 328 001453 330 001457 336 001460 339 001477 340 001501 342 001503 346 001504 349 001521 350 001523 354 001527 356 001530 359 001531 361 001532 365 001534 368 001540 370 001551 371 001556 375 001563 377 001564 382 001576 384 001577 385 001600 390 001612 396 001613 399 001621 401 001623 403 001624 409 001625 411 001626 414 001631 415 001633 417 001636 419 001645 421 001655 423 001662 425 001677 427 001701 430 001703 431 001705 435 001710 437 001716 440 001717 441 001720 443 001721 446 001723 448 001725 449 001727 452 001732 454 001740 457 001741 458 001743 460 001744 463 001747 464 001751 466 001755 468 001774 471 001776 473 002002 474 002004 477 002005 480 002007 481 002010 483 002011 486 002013 487 002014 489 002025 491 002032 494 002034 495 002035 497 002036 501 002042 502 002044 506 002050 510 002055 658 002056 661 002076 663 002100 667 002101 670 002121 672 002123 676 002124 679 002127 680 002131 681 002133 682 002135 683 002150 684 002152 690 002156 696 002160 697 002164 702 002166 704 002167 707 002171 710 002173 712 002174 715 002176 716 002177 719 002203 722 002206 725 002211 731 002272 733 002276 737 002277 738 002301 739 002303 741 002310 743 002311 746 002314 748 002315 754 002316 758 002323 760 002335 763 002337 765 002342 766 002345 771 002346 773 002347 776 002351 781 002420 783 002422 784 002426 788 002427 791 002431 792 002434 794 002441 797 002443 801 002453 802 002456 804 002462 806 002463 810 002464 818 002465 820 002475 821 002500 823 002504 826 002506 830 002513 834 002514 837 002515 840 002531 842 002543 843 002547 846 002553 851 002621 855 002624 860 002644 862 002645 865 002647 867 002653 876 002654 877 002660 879 002664 880 002666 882 002672 883 002674 885 002700 887 002701 890 002703 894 002706 898 002757 905 002760 907 002771 911 002773 917 003042 919 003043 922 003046 924 003053 926 003054 928 003055 931 003057 938 003133 939 003135 941 003141 943 003142 947 003143 949 003156 953 003202 958 003204 962 003205 964 003206 966 003207 969 003211 971 003216 972 003221 977 003223 979 003227 981 003243 983 003250 984 003254 985 003261 989 003265 991 003270 996 003271 998 003276 1000 003300 1003 003303 1006 003327 1012 003330 1016 003333 1019 003335 1020 003345 1021 003351 1022 003354 1024 003355 1027 003356 1029 003362 1032 003375 1033 003401 1034 003407 1035 003413 1037 003421 1039 003422 1043 003426 1044 003430 1045 003437 1046 003450 1047 003466 1048 003470 1051 003475 1053 003476 1056 003500 1059 003526 1063 003530 1068 003577 1070 003600 1071 003604 1073 003605 1079 003606 1082 003611 1083 003616 1084 003633 1085 003636 1087 003637 1093 003640 1096 003647 1098 003652 1100 003653 1104 003655 1109 003724 1110 003726 1112 003732 1116 003733 1118 003740 1291 003741 1295 003762 1297 003763 1302 003767 1303 003773 1304 003775 1306 004000 1309 004004 1310 004007 1311 004011 1313 004013 1315 004014 1318 004016 1320 004021 1329 004022 1345 004025 1347 004035 1350 004042 1352 004057 1354 004074 1357 004076 1360 004100 1361 004102 1364 004105 1367 004113 1371 004114 1374 004122 1376 004125 1378 004134 1380 004137 1383 004143 1384 004146 1394 004151 1396 004152 1398 004153 1400 004156 1405 004157 1408 004160 1410 004161 1419 004177 1423 004202 1425 004204 2221 004205 2224 004214 2225 004217 214 004220 218 004221 221 004227 514 004230 517 004231 518 004234 519 004241 520 004244 521 004251 523 004253 529 004254 532 004255 535 004261 537 004264 543 004265 545 004314 550 004371 552 004372 558 004373 563 004374 566 004400 568 004403 572 004404 575 004407 577 004410 579 004424 583 004476 587 004501 590 004503 592 004526 597 004603 598 004605 600 004615 601 004616 603 004623 605 004640 608 004642 612 004720 616 004721 618 004732 623 005012 627 005017 630 005024 632 005037 634 005052 636 005055 638 005060 641 005062 642 005064 645 005067 650 005075 652 005076 1123 005077 1126 005100 1128 005105 1130 005123 1133 005126 1135 005131 1137 005161 1139 005167 1141 005175 1147 005176 1150 005177 1151 005202 1153 005204 1155 005234 1161 005235 1171 005236 1174 005247 1176 005254 1181 005266 1182 005270 1183 005274 1186 005275 1188 005302 1190 005310 1192 005311 1198 005312 1203 005313 1206 005316 1207 005331 1210 005333 1212 005351 1215 005353 1217 005357 1220 005360 1223 005362 1224 005365 1226 005373 1231 005374 1233 005376 1235 005407 1237 005414 1240 005416 1241 005417 1244 005422 1247 005427 1253 005430 1256 005431 1257 005433 1258 005435 1259 005437 1261 005441 1265 005453 1268 005457 1270 005467 1272 005471 1279 005472 1282 005473 1283 005477 1285 005504 1287 005507 1428 005510 1431 005511 1433 005515 1436 005516 1438 005517 1441 005520 1442 005522 1443 005525 1445 005532 1449 005533 1452 005534 1453 005536 1454 005541 1459 005546 1461 005547 1464 005550 1467 005552 1468 005554 1471 005557 1473 005565 1477 005566 1480 005567 1483 005630 1486 005632 1487 005634 1490 005637 1492 005645 1497 005646 1500 005647 1503 005716 1506 005720 1507 005722 1510 005725 1512 005733 1517 005734 1520 005735 1523 005776 1526 006000 1527 006002 1530 006005 1532 006013 1536 006014 1539 006015 1543 006065 1546 006067 1547 006072 1550 006075 1552 006103 1554 006104 1557 006105 1560 006154 1563 006156 1564 006161 1567 006164 1569 006172 1574 006173 1577 006174 1579 006177 1582 006245 1585 006247 1586 006251 1590 006254 1592 006262 1596 006263 1599 006264 1602 006333 1605 006335 1606 006337 1610 006342 1612 006350 1617 006351 1620 006352 1623 006357 1625 006400 1628 006403 1630 006410 1631 006413 1634 006414 1635 006416 1638 006420 1643 006432 1647 006441 1648 006446 1651 006450 1654 006451 1659 006452 1662 006457 1665 006463 1668 006467 1670 006471 1676 006474 1678 006500 1680 006503 1685 006506 1687 006522 1690 006525 1693 006530 1694 006533 1701 006534 1703 006535 1706 006540 1708 006541 1711 006544 1713 006553 1715 006555 1718 006560 1737 006567 1739 006570 1742 006573 1744 006576 1747 006601 1749 006605 1751 006606 1753 006614 1755 006621 1758 006622 1759 006626 1765 006633 1767 006634 1772 006647 1773 006651 1774 006653 1776 006660 1778 006664 1780 006667 1783 006674 1784 006676 1788 006677 1791 006702 1792 006712 1793 006723 1794 006735 1795 006740 1796 006742 1801 006744 1803 006745 1807 006751 1810 007004 1813 007026 1818 007031 1820 007032 1824 007033 1827 007034 1829 007037 1832 007041 1834 007042 1836 007043 1838 007047 1841 007052 1846 007133 1848 007136 1849 007145 1850 007152 1852 007157 1855 007160 1858 007163 1861 007171 1864 007202 1865 007203 1868 007210 1872 007221 1878 007222 1881 007223 1882 007226 1883 007230 1885 007242 1886 007244 1888 007246 1890 007250 1896 007251 1899 007252 1902 007257 1904 007264 1906 007300 1909 007302 1911 007305 1913 007306 1918 007312 1919 007343 1925 007344 1928 007345 1929 007347 1930 007361 1931 007373 1932 007375 1933 007405 1934 007410 1935 007412 1936 007414 1937 007416 1939 007420 1945 007421 1948 007422 1949 007425 1950 007430 1952 007433 1954 007441 1956 007445 1957 007451 1959 007453 1965 007454 1972 007455 1974 007457 1975 007461 1976 007463 1977 007464 1978 007465 1979 007466 1980 007467 1981 007477 1982 007500 1983 007501 1984 007502 1985 007503 1986 007512 1987 007513 1988 007514 1989 007515 1990 007516 1991 007517 1993 007520 1999 007521 2002 007522 2003 007525 2005 007532 2008 007536 2009 007540 2011 007541 2013 007542 2015 007544 2017 007545 2018 007555 2021 007614 2026 007655 2029 007717 2032 007723 2034 007726 2038 007747 2041 007752 2043 010004 2046 010006 2052 010062 2053 010065 2055 010067 2056 010070 2060 010072 2063 010074 2069 010075 2074 010076 2077 010101 2080 010103 2082 010114 2084 010116 2088 010166 2091 010167 2095 010172 2097 010203 2100 010205 2101 010210 2102 010212 2104 010213 2107 010217 2109 010222 2113 010274 2115 010306 2118 010320 2119 010323 2120 010325 2122 010326 2124 010327 2127 010333 2129 010336 2131 010356 2134 010360 2138 010430 2142 010431 2148 010432 2151 010433 2155 010436 2157 010452 2160 010455 2161 010460 2163 010465 2166 010475 2168 010505 2170 010507 2172 010550 2175 010551 2177 010556 2181 010557 2183 010561 2186 010567 2192 010570 2195 010571 2198 010576 2200 010577 2201 010602 2202 010605 2203 010610 2210 010613 2211 010615 2213 010616 2215 010620 2216 010623 2217 010624 2229 010625 2233 010626 2235 010642 2237 010644 2240 010707 2246 010710 2249 010711 2251 010722 2255 010723 2259 010724 2262 010731 2265 010736 ----------------------------------------------------------- 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