COMPILATION LISTING OF SEGMENT cobol_mcs Compiled by: Multics PL/I Compiler, Release 31b, of April 24, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 05/24/89 1020.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., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 15 /****^ HISTORY COMMENTS: 16* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060), 17* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 18* MCR8060 cobol_mcs.pl1 Reformatted code to new Cobol standard. 19* END HISTORY COMMENTS */ 20 21 22 /* Modified on 03/17/82 by FCH, [5.2-1], eliminate need for copy switch by using temp seg, BUG530 */ 23 /* Modified on 07/21/81 by FCH, [4.4-9], ..command added, BUG468 */ 24 /* Modified on 06/02/81 by FCH, [4.4-8], initialization, BUG468 */ 25 /* Modified on 06/01/81 by FCH, [4.4-7], on command_abort_ added, BUG468 */ 26 /* Modified on 05/05/81 by FCH, [4.4-5], attach and detach commands added, BUG468 */ 27 /* Modified on 05/01/81 by FCH, [4.4-3], all option on receive added, BUG468 */ 28 /* Modified on 04/23/81 by FCH, [4.4-1], delete final new-line from send buffer, BUG468 */ 29 /* Modified since Version 4.3 */ 30 31 32 33 34 35 36 /* format: style3 */ 37 cmcs: 38 cobol_mcs: 39 procedure options (separate_static); 40 41 /* This COBOL MCS command is used to intialize the process environment 42* for subsequent CMCS processing. For "CMCS terminals", it will enter 43* request mode, and allow the user to essentially duplicate the COBOL program 44* MCS functions through the request interface. 45**/ 46 47 /* Bob May, 5/31/77 */ 48 49 dcl (i, j) fixed bin, 50 dname char (168), 51 ename char (32), 52 char_delim char (1), 53 io_subtype fixed bin, 54 rcv_tree_path char (48) init (""), 55 code fixed bin (35), 56 my_name char (16), /* either cobol_mcs or cobol_mcs_admin */ 57 my_brief_name char (8), /* for whoami */ 58 (password1, password2) 59 char (10); 60 61 dcl station_name char (12), 62 dest_table_index fixed bin, 63 err_sw bit (1) init ("0"b); 64 65 dcl output_cd_size fixed bin; /* temp output CD stuff, to get started */ 66 67 dcl output_cd_area (output_cd_size) fixed bin based (output_cdp); 68 69 dcl ptr_array (1) ptr; /* for get, release temp segments */ 70 71 dcl overlay_len fixed bin, /* for structure initialization */ 72 overlay (overlay_len) fixed bin based; 73 74 dcl buffer_len fixed bin (21), 75 buffer_max_len fixed bin (21), 76 buffer_ptr ptr, 77 buffer char (256); 78 79 80 dcl send_buffer_ptr ptr, 81 send_buffer_max_len fixed bin (21), 82 send_buffer_len fixed bin (35), /* actual number of chars in temp buffer */ 83 char_send_buffer_len 84 pic "9999", 85 send_buffer char (send_buffer_max_len) based (send_buffer_ptr); 86 87 /* Switches */ 88 89 dcl (scpsw_sw, interactive_sw) 90 bit (1); 91 92 dcl test_sw bit (1) int static init ("0"b); 93 94 dcl (cleanup, program_interrupt, command_abort_) 95 condition; 96 97 dcl term_id char (4), 98 term_type fixed bin, 99 term_channel char (8); 100 101 dcl command_count fixed bin int static init (15); 102 103 dcl 1 command_list int static, 104 2 brief (15) char (8) init ("q", /* 1 */ 105 "e", /* 2 */ 106 "amc", /* 3 */ 107 "r", /* 4 */ 108 "s", /* 5 */ 109 "ei", /* 6 */ 110 "eit", /* 7 */ 111 "eo", /* 8 */ 112 "di", /* 9 */ 113 "dit", /* 10 */ 114 "do", /* 11 */ 115 "p", /* 12 */ 116 ".", /* 13 */ 117 "a", /* 14 */ 118 "d"), /* 15 */ 119 2 long (15) char (32) init ("quit", /* 1 */ 120 "execute", /* 2 */ 121 "accept_message_count", /* 3 */ 122 "receive", /* 4 */ 123 "send", /* 5 */ 124 "enable_input", /* 6 */ 125 "enable_input_terminal", /* 7 */ 126 "enable_output", /* 8 */ 127 "disable_input", /* 9 */ 128 "disable_input_terminal", /* 10 */ 129 "disable_output", /* 11 */ 130 "purge", /* 12 */ 131 ".", /* 13 */ 132 "activate", /* 14 */ 133 "deactivate"); /* 15 */ 134 135 136 dcl admin_command_count fixed bin int static init (11); 137 138 dcl 1 admin_command_list 139 int static, 140 2 brief (11) char (8) init (".", /* 1 */ 141 "q", /* 2 */ 142 "e", /* 3 */ 143 "test", /* 4 */ 144 "ccpsw", /* 5 */ 145 "scpsw", /* 6 */ 146 "ccq", /* 7 */ 147 "start_mp", /* 8 (not currently used) */ 148 "stop_mp", /* 9 */ 149 "clear_mp", /* 10 */ 150 "purge_qs"), /* 11 */ 151 2 long (11) char (32) init (".", /* 1 */ 152 "quit", /* 2 */ 153 "execute", /* 3 */ 154 "test", /* 4 */ 155 "change_cmcs_password", /* 5 */ 156 "set_cmcs_password", /* 6 */ 157 "create_cmcs_queues", /* 7 */ 158 "start_mp", /* 8 (not currently used) */ 159 "stop_mp", /* 9 */ 160 "clear_mp", /* 10 */ 161 "purge_queues"); /* 11 */ 162 163 dcl req char (256), /* request line input buffer */ 164 (req_arg_count, req_left_begin, req_left_len) 165 fixed bin, 166 req_len fixed bin (21), /* for use with iox_$get_line */ 167 req_cmd_ptr ptr, 168 req_cmd_len fixed bin; 169 170 dcl (cmd_parsed_sw, args_parsed_sw) 171 bit (1); 172 173 dcl max_arg_count fixed bin int static options (constant) init (25); 174 175 dcl 1 arg_array (25), 176 2 argp ptr, 177 2 argl fixed bin; 178 179 180 dcl max_req_args fixed bin int static options (constant) init (16); 181 /* loop control */ 182 183 dcl whitespace char (5) int static options (constant) init (" 184 185 "); /* b, HT, NL, VT, FF */ 186 187 188 dcl user_info_$absentee_queue 189 entry (fixed bin), 190 user_info_$tty_data entry (char (*), fixed bin, char (*)), 191 absolute_pathname_ entry (char (*), char (*), fixed bin (35)), 192 expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)), 193 cu_$cp entry (ptr, fixed bin, fixed bin (35)), 194 read_password_ entry (char (*), char (*)), 195 get_process_id_ entry () returns (bit (36)), 196 get_wdir_ entry () returns (char (168)), 197 get_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)), 198 release_temp_segments_ 199 entry (char (*), (*) ptr, fixed bin (35)), 200 hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)), 201 ( 202 ioa_, 203 ioa_$rsnnl 204 ) entry options (variable); /*[5.2-1]*/ 205 dcl cmcs_initiate_ctl_$release 206 entry (fixed bin (35)); 207 dcl ( 208 error_table_$action_not_performed, 209 error_table_$long_record, 210 error_table_$too_many_args, 211 error_table_$wrong_no_of_args 212 ) fixed bin (35) external; 213 214 dcl (addr, char, fixed, null, search, size, string, substr, verify) 215 builtin; /* */ 1 1 /* BEGIN INCLUDE FILE...cmcs_arg_processing.incl.pl1 */ 1 2 1 3 dcl arg_count fixed bin, /* total number of args in cmd line */ 1 4 arg_no fixed bin, /* used in arg processing loops */ 1 5 arg_ptr ptr, /* ptr to last arg retrieved */ 1 6 arg_len fixed bin, /* size in chars of last arg retrieved with cu_$arg_ptr */ 1 7 arg char (arg_len) based (arg_ptr); 1 8 1 9 dcl af_return_arg_ptr ptr, 1 10 af_return_arg_len fixed bin, 1 11 af_return_arg char (af_return_arg_len) varying based (af_return_arg_ptr); 1 12 1 13 dcl cu_$arg_count entry (fixed bin), 1 14 cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)), 1 15 com_err_ entry options (variable); 1 16 1 17 dcl cu_$af_return_arg entry (fixed bin, ptr, fixed bin, fixed bin (35)), 1 18 cu_$af_arg_count entry (fixed bin, fixed bin (35)), 1 19 cu_$af_arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)), 1 20 active_fnc_err_ entry options (variable); 1 21 1 22 dcl error_table_$not_act_fnc fixed bin (35) external; 1 23 1 24 /* END INCLUDE FILE...cmcs_arg_processing.incl.pl1 */ 216 2 1 /* BEGIN INCLUDE FILE... cmcs_cd_dcls.incl.pl1 */ 2 2 2 3 /* This COBOL MCS include file defines the input and output CD structures 2 4* that are used by the COBOL object program to pass function-specific data 2 5* to the CMCS runtime support package. */ 2 6 2 7 /* Bob May, 6/30/77 */ 2 8 2 9 dcl input_cdp ptr; 2 10 2 11 /* Input CD Structure */ 2 12 2 13 dcl 1 input_cd aligned based (input_cdp), 2 14 2 15 /* Input Header */ 2 16 2 17 2 queue_ptr ptr, 2 18 2 flags, 2 19 (3 io_sw bit (1), /* always "1"b for input cd */ 2 20 3 cobol_sw bit (1), /* always "1"b for COBOL MCS */ 2 21 3 filler bit (34)) unaligned, 2 22 2 last_tree_path, /* for faster lookup only */ 2 23 3 level_names (4) char (12), 2 24 2 25 /* COBOL Input CD */ 2 26 2 27 2 tree_path, 2 28 3 level_names (4) char (12), /* DN 1-4 */ 2 29 (2 msg_date char (6), /* DN 5, YYMMDD */ 2 30 2 msg_time char (8), /* DN 6, HHMMSSTT */ 2 31 2 station_name char (12), /* DN 7 */ 2 32 2 text_len pic "9999", /* DN 8, S.B. pic "9999" */ 2 33 2 text_delim pic "9", /* DN 9, S.B. pic "9" */ 2 34 2 status_key char (2), /* DN 10 */ 2 35 2 msg_count pic "999999") unaligned; /* DN 11, S.B. pic "999999" */ 2 36 2 37 /* */ 2 38 2 39 dcl output_cdp ptr; 2 40 2 41 /* Output CD Structure */ 2 42 2 43 dcl 1 output_cd aligned based (output_cdp), 2 44 2 45 /* Output CD Header */ 2 46 2 47 2 last_station_info_ptr ptr, 2 48 2 flags, 2 49 (3 io_sw bit (1), /* always "0"b for output cd */ 2 50 3 cobol_sw bit (1), /* alays "1"b for COBOL MCS */ 2 51 3 filler bit (34)) unaligned, 2 52 2 bin_max_station_count fixed bin, /* who sets? ---- */ 2 53 2 char_max_station_count pic "9999", /* S.B. pic "9999" */ 2 54 2 55 /* COBOL Output CD */ 2 56 2 57 2 station_count pic "9999", /* DN 1, S.B. pic "9999" */ 2 58 2 text_len pic "9999", /* DN 2, S.B. pic "9999" */ 2 59 2 status_key char (2) unaligned, /* DN 3 */ 2 60 2 dest_table (0 refer (output_cd.bin_max_station_count)) unaligned, 2 61 3 error_key char (1), /* DN 4 */ 2 62 3 station_name char (12); /* DN 5 */ 2 63 2 64 /* Last Station Info */ 2 65 2 66 dcl 1 last_station_info based (output_cd.last_station_info_ptr) aligned, 2 67 2 last_dest (output_cd.bin_max_station_count), 2 68 3 queue_iocbp ptr, 2 69 3 station_name char (12); 2 70 2 71 /* END INCLUDE FILE... cmcs_cd_dcls.incl.pl1 */ 217 3 1 /* BEGIN INCLUDE FILE... cmcs_cobol_mcs_dcls */ 3 2 3 3 dcl cobol_mcs_$accept entry (ptr, fixed bin (35)); 3 4 dcl cobol_mcs_$disable_input_queue entry (ptr, char (*), fixed bin (35)); 3 5 dcl cobol_mcs_$disable_input_terminal entry (ptr, char (*), fixed bin (35)); 3 6 dcl cobol_mcs_$disable_output entry (ptr, char (*), fixed bin (35)); 3 7 dcl cobol_mcs_$enable_input_queue entry (ptr, char (*), fixed bin (35)); 3 8 dcl cobol_mcs_$enable_input_terminal entry (ptr, char (*), fixed bin (35)); 3 9 dcl cobol_mcs_$enable_output entry (ptr, char (*), fixed bin (35)); 3 10 dcl cobol_mcs_$get_user_ctl_exists_sw entry (bit (1) aligned); 3 11 dcl cobol_mcs_$purge entry (ptr, fixed bin (35)); 3 12 dcl cobol_mcs_$receive entry (ptr, fixed bin, ptr, fixed bin, fixed bin (35)); 3 13 dcl cobol_mcs_$receive_wait entry (ptr, fixed bin, ptr, fixed bin, fixed bin (35)); 3 14 dcl cobol_mcs_$send entry (ptr, ptr, char (4), char (1), bit (36), fixed bin (35)); 3 15 dcl cobol_mcs_$set_user_ctl_exists_sw entry (bit (1) aligned); 3 16 dcl cobol_mcs_$stop_run entry (); 3 17 3 18 /* 3 19* call cobol_mcs_$accept (mcs_icdp, code); 3 20* call cobol_mcs_$disable_input_queue (mcs_icdp, password, code); 3 21* call cobol_mcs_$disable_input_terminal (mcs_icdp, password, code); 3 22* call cobol_mcs_$disable_output (mcs_ocdp, password, code); 3 23* call cobol_mcs_$enable_input_queue (mcs_icdp, password, code); 3 24* call cobol_mcs_$enable_input_terminal (mcs_icdp, password, code); 3 25* call cobol_mcs_$enable_output (mcs_ocdp, password, code); 3 26* call cobol_mcs_$get_user_ctl_exists_sw (flag); 3 27* call cobol_mcs_$purge (mcs_ocdp, code); 3 28* call cobol_mcs_$receive (mcs_icdp, type, mesp, max_meslen, code); 3 29* call cobol_mcs_$receive_wait(mcs_icdp, type, mesp, max_meslen, code); 3 30* call cobol_mcs_$send (mcs_ocdp, mesp, max_meslen, end_indicator, slew_control, code); 3 31* call cobol_mcs_$set_user_ctl_exists_sw (ON); 3 32* call cobol_mcs_$stop_run (); 3 33**/ 3 34 3 35 /* END INCLUDE FILE... cmcs_cobol_mcs_dcls */ 218 4 1 /* BEGIN INCLUDE FILE... cmcs_control_hdr.incl.pl1 */ 4 2 4 3 /* This include file is the 1st part of all cobol_mcs tables */ 4 4 4 5 /* Bob May, 4/30/77 */ 4 6 4 7 dcl control_hdr_len fixed bin int static options (constant) init (32); 4 8 4 9 dcl control_hdr_ptr ptr; 4 10 4 11 dcl 1 control_hdr aligned based (control_hdr_ptr), 4 12 2 lockword bit (36) aligned, /* for process_id */ 4 13 2 version fixed bin, 4 14 2 clock_created fixed bin (71), 4 15 2 author aligned, 4 16 3 group_id char (32), /* person.proj.tag */ 4 17 3 process_id bit (36), 4 18 2 max_size fixed bin (18), /* maximum number of entries seg can hold */ 4 19 2 current_size fixed bin (18), /* index of last active entry */ 4 20 2 entry_count fixed bin (18), /* number of active entries */ 4 21 2 cmcs_control_hdr_filler (16) fixed bin; /* words (17-32) for later expansion */ 4 22 4 23 /* END INCLUDE FILE... cmcs_control_hdr.incl.pl1 */ 219 5 1 /* BEGIN INCLUDE FILE... cmcs_entry_dcls.incl.pl1 */ 5 2 5 3 5 4 5 5 /****^ HISTORY COMMENTS: 5 6* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8087), 5 7* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 5 8* MCR8087 cmcs_entry_dcls.incl.pl1 Shorten wait time for cmcs_station_ctl_. 5 9* END HISTORY COMMENTS */ 5 10 5 11 5 12 /* Entry declarations for the COBOL MCS runtime support package */ 5 13 5 14 /* Modified on 10/20/84 by FCH, [5.3-1] */ 5 15 /* Modified on 04/29/81 by FCH, [4.4-1] */ 5 16 /* Bob May, 6/01/77 */ 5 17 5 18 dcl cmcs_create_queues_ entry (fixed bin (35)); 5 19 5 20 dcl cmcs_date_time_ entry (fixed bin (71), char (6) unaligned, char (8) unaligned); 5 21 5 22 dcl cmcs_decode_status_ entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35)); 5 23 5 24 dcl cmcs_expand_tree_path_ entry (char (*), char (48), fixed bin (35)); 5 25 5 26 dcl cmcs_fillin_hdr_ entry (ptr, fixed bin, fixed bin, fixed bin, fixed bin (35)); 5 27 5 28 dcl cmcs_initiate_ctl_ entry (char (*), ptr, fixed bin (35)); 5 29 5 30 dcl cmcs_print_ entry (ptr, ptr, fixed bin (35), ptr, fixed bin (35)); 5 31 5 32 dcl cmcs_purge_queues_ entry (fixed bin, bit (1), fixed bin (35)); 5 33 5 34 dcl cmcs_queue_ctl_$accept_message_count entry (ptr, fixed bin, fixed bin (35)); 5 35 dcl cmcs_queue_ctl_$disable entry (ptr, fixed bin, char (10), fixed bin (35)); 5 36 dcl cmcs_queue_ctl_$enable entry (ptr, fixed bin, char (10), fixed bin (35)); 5 37 dcl cmcs_queue_ctl_$print entry (ptr, fixed bin, ptr, fixed bin (35)); 5 38 dcl cmcs_queue_ctl_$purge entry (ptr, fixed bin, fixed bin (35)); 5 39 dcl cmcs_queue_ctl_$receive entry (ptr, fixed bin, ptr, fixed bin, fixed bin (35)); 5 40 dcl cmcs_queue_ctl_$send entry (ptr, fixed bin, ptr, fixed bin, fixed bin, bit (36), fixed bin (35)); 5 41 dcl cmcs_queue_ctl_$stop_run entry (fixed bin, fixed bin (35)); 5 42 5 43 dcl cmcs_scramble_ entry (char (10)) returns (char (10)); 5 44 5 45 dcl cmcs_set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35)); /*[5.3-1]*/ 5 46 dcl cmcs_set_lock_$unlock entry (bit (36) aligned, fixed bin (35)); 5 47 5 48 dcl cmcs_station_ctl_$attach entry (char (12), fixed bin, fixed bin (35)); 5 49 dcl cmcs_station_ctl_$detach entry (fixed bin, fixed bin (35)); 5 50 dcl cmcs_station_ctl_$detach_name entry (char (12), fixed bin (35)); 5 51 dcl cmcs_station_ctl_$disable_input_terminal entry (ptr, char (10), fixed bin (35)); 5 52 dcl cmcs_station_ctl_$disable_output_terminal entry (ptr, char (10), fixed bin (35)); 5 53 dcl cmcs_station_ctl_$enable_input_terminal entry (ptr, char (10), fixed bin (35)); 5 54 dcl cmcs_station_ctl_$enable_output_terminal entry (ptr, char (10), fixed bin (35)); 5 55 dcl cmcs_station_ctl_$find_destination entry (char (12), fixed bin, ptr, fixed bin (35)); /*[4.4-1]*/ 5 56 dcl cmcs_station_ctl_$input_disabled entry (fixed bin, bit (1), fixed bin (35)); 5 57 dcl cmcs_station_ctl_$output_disabled entry (fixed bin, bit (1), fixed bin (35)); 5 58 dcl cmcs_station_ctl_$validate entry (char (12), fixed bin, fixed bin (35)); 5 59 5 60 dcl cmcs_status_list_ctl_$add entry (ptr, ptr, ptr, fixed bin, fixed bin (35)); 5 61 dcl cmcs_status_list_ctl_$delete entry (ptr, ptr, ptr, fixed bin, fixed bin (35)); 5 62 dcl cmcs_status_list_ctl_$move entry (ptr, ptr, ptr, fixed bin, fixed bin, fixed bin (35)); 5 63 5 64 dcl cmcs_terminal_ctl_$find entry (char (8), char (12), fixed bin (35)); 5 65 5 66 dcl cmcs_tree_ctl_$find_destination entry (char (12), fixed bin, ptr, fixed bin (35)); 5 67 dcl cmcs_tree_ctl_$find_index entry (fixed bin, ptr, fixed bin (35)); 5 68 dcl cmcs_tree_ctl_$find_tree_path entry (ptr, fixed bin, fixed bin, ptr, fixed bin (35)); 5 69 dcl cmcs_tree_ctl_$find_qual_name entry (char (12), fixed bin, ptr, char (52), fixed bin (35)); /*[4.4-1]*/ 5 70 5 71 dcl cmcs_wait_ctl_$add entry (char (48), fixed bin, fixed bin (35)); 5 72 dcl cmcs_wait_ctl_$delete entry (fixed bin, fixed bin (35)); 5 73 dcl cmcs_wait_ctl_$find entry (char (48), ptr, fixed bin (35)); 5 74 dcl cmcs_wait_ctl_$mp_available entry (fixed bin, fixed bin, fixed bin (35)); 5 75 dcl cmcs_wait_ctl_$mp_login entry (fixed bin, fixed bin (35)); 5 76 dcl cmcs_wait_ctl_$mp_logout entry (fixed bin, fixed bin (35)); 5 77 dcl cmcs_wait_ctl_$clear_mp entry (fixed bin (35)); 5 78 dcl cmcs_wait_ctl_$start_mp entry (fixed bin (35)); 5 79 dcl cmcs_wait_ctl_$stop_mp entry (fixed bin (35)); 5 80 5 81 /* END INCLUDE FILE... cmcs_entry_dcls.incl.pl1 */ 220 6 1 /* BEGIN INCLUDE FILE... cmcs_error_table_dcls.incl.pl1 */ 6 2 6 3 /* Bob May, 6/30/77 */ 6 4 6 5 dcl (cmcs_error_table_$ambiguous_tree_path, cmcs_error_table_$bad_call_parm, cmcs_error_table_$bad_dest, 6 6 cmcs_error_table_$bad_dest_count, cmcs_error_table_$bad_message_length, 6 7 cmcs_error_table_$bad_password, cmcs_error_table_$bad_queue_path, cmcs_error_table_$bad_slew, 6 8 6 9 cmcs_error_table_$bad_source, cmcs_error_table_$bad_station, 6 10 cmcs_error_table_$bad_term_devchn, cmcs_error_table_$bad_tree_path, 6 11 cmcs_error_table_$dest_already_disabled, cmcs_error_table_$dest_already_enabled, 6 12 6 13 cmcs_error_table_$dest_disabled, cmcs_error_table_$no_message, 6 14 cmcs_error_table_$no_partial_messages, cmcs_error_table_$null_partial_message, 6 15 cmcs_error_table_$queue_already_disabled, cmcs_error_table_$queue_already_enabled, 6 16 6 17 cmcs_error_table_$queue_disabled, cmcs_error_table_$source_already_disabled, 6 18 cmcs_error_table_$source_already_enabled, cmcs_error_table_$source_disabled) fixed bin (35) external; 6 19 6 20 /* END INCLUDE FILE... cmcs_error_table_dcls.incl.pl1 */ 221 7 1 /* BEGIN INCLUDE FILE... cmcs_iox_processing.incl.pl1, 07/01/74 */ 7 2 7 3 dcl iox_$attach_iocb entry (ptr, char (*), fixed bin (35)), 7 4 iox_$attach_name entry (char (*), ptr, char (*), ptr, fixed bin (35)), 7 5 iox_$close entry (ptr, fixed bin (35)), 7 6 iox_$control entry (ptr, char (*), ptr, fixed bin (35)), 7 7 iox_$delete_record entry (ptr, fixed bin (35)), 7 8 iox_$detach_iocb entry (ptr, fixed bin (35)), 7 9 iox_$find_iocb entry (char (*), ptr, fixed bin (35)), 7 10 iox_$get_chars entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)), 7 11 iox_$get_line entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)), 7 12 iox_$modes entry (ptr, char (*), char (*), fixed bin (35)), 7 13 iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35)), 7 14 iox_$position entry (ptr, fixed bin, fixed bin (21), fixed bin (35)), 7 15 iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)), 7 16 iox_$read_key entry (ptr, char (256) varying, fixed bin (21), fixed bin (35)), 7 17 iox_$read_length entry (ptr, fixed bin (21), fixed bin (35)), 7 18 iox_$read_record entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)), 7 19 iox_$rewrite_record entry (ptr, ptr, fixed bin (21), fixed bin (35)), 7 20 iox_$seek_key entry (ptr, char (256) varying, fixed bin (21), fixed bin (35)), 7 21 iox_$write_record entry (ptr, ptr, fixed bin (21), fixed bin (35)); 7 22 7 23 /* * * EXTERNAL * * */ 7 24 7 25 dcl (iox_$user_io, 7 26 iox_$user_input, 7 27 iox_$user_output, 7 28 iox_$error_output) ptr external; 7 29 7 30 /* * * MODES * * */ 7 31 7 32 /* 7 33* 1 stream_input 7 34* 2 stream_output 7 35* 3 stream_input_output 7 36* 4 sequential_input 7 37* 5 sequential_output 7 38* 6 sequential_input_output 7 39* 7 sequential_update 7 40* 8 keyed_sequential_input 7 41* 9 keyed_sequential_output 7 42* 10 keyed_sequential_update 7 43* 11 direct_input 7 44* 12 direct_output 7 45* 13 direct_update 7 46**/ 7 47 7 48 /* END INCLUDE FILE... cmcs_iox_processing.incl.pl1 */ 222 8 1 /* BEGIN INCLUDE FILE... cmcs_ipc_processing.incl.pl1 */ 8 2 8 3 dcl ev_chn fixed bin (71); 8 4 8 5 dcl ev_wait_list_ptr ptr; 8 6 8 7 dcl 1 ev_wait_list aligned, 8 8 2 n_chn fixed bin, 8 9 2 ev_chn (2) fixed bin (71); 8 10 8 11 dcl ev_info_ptr ptr; 8 12 8 13 dcl 1 ev_info aligned, 8 14 2 ev_chn fixed bin (71), 8 15 2 ev_message fixed bin (71), 8 16 2 sender bit (36), 8 17 2 origin, 8 18 (3 dev_signal bit (18), 8 19 3 ring bit (18)) unaligned, 8 20 2 ev_chn_index fixed bin; 8 21 8 22 dcl ev_message_ptr ptr; 8 23 8 24 dcl 1 ev_message_struc based (ev_message_ptr), 8 25 2 function fixed bin (35), 8 26 2 value fixed bin (35); 8 27 8 28 dcl hcs_$wakeup entry (bit (36), fixed bin (71), fixed bin (71), fixed bin (35)); 8 29 8 30 dcl ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35)), 8 31 ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35)), 8 32 ipc_$decl_ev_call_chn entry (fixed bin (71), entry, ptr, fixed bin, fixed bin (35)), 8 33 ipc_$decl_ev_wait_chn entry (fixed bin (71), fixed bin (35)), 8 34 ipc_$drain_chn entry (fixed bin (71), fixed bin (35)), 8 35 ipc_$cutoff entry (fixed bin (71), fixed bin (35)), 8 36 ipc_$reconnect entry (fixed bin (71), fixed bin (35)), 8 37 ipc_$mak_ev_calls entry (fixed bin (35)), 8 38 ipc_$unmask_ev_calls entry (fixed bin (35)), 8 39 ipc_$block entry (ptr, ptr, fixed bin (35)); 8 40 8 41 /* END INCLUDE FILE... cmcs_ipc_processing.incl.pl1 */ 223 9 1 /* BEGIN INCLUDE FILE... cmcs_station_ctl.incl.pl1 */ 9 2 9 3 /* This include file defines the station control structure for COBOL MCS */ 9 4 9 5 /* Bob May, 5/31/77 */ 9 6 9 7 dcl (station_ctl_hdr_len init (0), /* no special fields in hdr */ 9 8 station_ctl_entry_len init (6), 9 9 station_ctl_version init (1)) fixed bin int static options (constant); 9 10 9 11 dcl station_ctl_ptr ptr int static; 9 12 9 13 dcl 1 station_ctl aligned based (station_ctl_ptr), 9 14 2 hdr like control_hdr, 9 15 2 entries (station_ctl.current_size) like station_ctl_entry; 9 16 9 17 dcl station_ctl_eindex fixed bin; 9 18 9 19 dcl station_ctl_eptr ptr; 9 20 9 21 dcl 1 station_ctl_entry aligned based (station_ctl_eptr), 9 22 2 station_name char (12), 9 23 2 lockword bit (36) aligned, /* owner process_id */ 9 24 2 flags, 9 25 (3 inactive_sw bit (1), /* station is currently not legal to use */ 9 26 3 destination_sw bit (1), /* station attached as a destination */ 9 27 3 input_disabled_sw bit (1), /* if terminal, can't input */ 9 28 3 output_disabled_sw bit (1), /* if terminal, can't get output */ 9 29 3 filler bit (32)) unaligned, 9 30 2 filler fixed bin; 9 31 9 32 /* END INCLUDE FILE... cmcs_station_ctl.incl.pl1 */ 224 10 1 /* BEGIN INCLUDE FILE ... cmcs_system_ctl.incl.pl1 */ 10 2 10 3 /* 10 4* This COBOL MCS include file holds all the COBOL MCS system-wide parameters. 10 5**/ 10 6 10 7 /* Bob May, 5/31/77 */ 10 8 10 9 dcl (system_ctl_hdr_len init (32), 10 10 system_ctl_entry_len init (0), 10 11 system_ctl_version init (1)) fixed bin internal static options (constant); 10 12 10 13 dcl system_ctl_ptr ptr int static; 10 14 10 15 dcl 1 system_ctl aligned based (system_ctl_ptr), 10 16 2 hdr like control_hdr, 10 17 2 flags, 10 18 (3 mp_started_sw bit (1), 10 19 3 filler bit (35)) unaligned, 10 20 2 mp_started_count fixed bin, /* zero for this version */ 10 21 2 mp_active_count fixed bin, /* number that have logged in so far, less the logouts */ 10 22 2 password char (10), /* scrambled password for all cmcs functions */ 10 23 2 lock_wait_time fixed bin, /* number of seconds to wait before giving up */ 10 24 2 filler (25) fixed bin (35); 10 25 10 26 /* END INCLUDE FILE ... cmcs_system_ctl.incl.pl1 */ 225 11 1 /* BEGIN INCLUDE FILE... cmcs_terminal_ctl.incl.pl1 */ 11 2 11 3 /* This table does nothing more than supply the default station_name 11 4* for a given terminal subchannel (user$device_channel */ 11 5 11 6 /* Bob May, 4/30/77 */ 11 7 11 8 dcl (terminal_ctl_hdr_len init (0), 11 9 terminal_ctl_entry_len init (6), 11 10 terminal_ctl_version init (1)) fixed bin int static options (constant); 11 11 11 12 dcl terminal_ctl_ptr ptr int static; 11 13 11 14 dcl 1 terminal_ctl aligned based (terminal_ctl_ptr), 11 15 2 hdr like control_hdr, 11 16 2 entries (terminal_ctl.current_size) like terminal_ctl_entry; 11 17 11 18 dcl terminal_ctl_eindex fixed bin; 11 19 11 20 dcl terminal_ctl_eptr ptr; 11 21 11 22 dcl 1 terminal_ctl_entry aligned based (terminal_ctl_eptr), 11 23 2 flags, 11 24 (3 inactive_sw bit (1), 11 25 3 filler bit (35)) unaligned, 11 26 2 device_channel char (8), /* from user$device_channel */ 11 27 2 station_name char (12); /* default station for the given terminal */ 11 28 11 29 /* END INCLUDE FILE... cmcs_terminal_ctl.incl.pl1 */ 226 12 1 /* BEGIN INCLUDE FILE ... cmcs_tree_ctl.incl.pl1 */ 12 2 12 3 /* 12 4* This COBOL MCS include file defines the sstructure used for accessing 12 5* the MCS queue hierarchy and controlling message I/O for each entry. 12 6**/ 12 7 12 8 /* Bob May, 5/31/77 */ 12 9 12 10 dcl (tree_ctl_hdr_len init (32), 12 11 tree_ctl_entry_len init (144), /* 136, plus fudge for ptr alignments */ 12 12 tree_ctl_version init (1)) fixed bin internal static options (constant); 12 13 12 14 dcl tree_ctl_ptr ptr int static; 12 15 12 16 dcl 1 tree_ctl aligned based (tree_ctl_ptr), 12 17 2 hdr like control_hdr, 12 18 2 queue_count fixed bin, /* total of queue entries for hierarchy */ 12 19 2 filler (31) fixed bin (35), 12 20 2 entries (tree_ctl.current_size) like tree_ctl_entry; 12 21 12 22 dcl tree_ctl_eindex fixed bin; 12 23 12 24 dcl tree_ctl_eptr ptr; 12 25 12 26 dcl 1 tree_ctl_entry aligned based (tree_ctl_eptr), 12 27 2 level_info, /* len = 15 */ 12 28 3 tree_path, 12 29 4 level_names (4) char (12), 12 30 3 entry_flags, 12 31 (4 inactive_sw bit (1), 12 32 4 cmd_sw bit (1), 12 33 4 mp_sw bit (1), 12 34 /* switch separator */ 12 35 4 cobol_program_id_sw bit (1), 12 36 4 queue_sw bit (1), 12 37 4 filler bit (31)) unaligned, 12 38 3 level_no fixed bin, /* level within the hierarchy */ 12 39 3 subtree_count fixed bin, 12 40 2 static_queue_info, /* len = 9 */ 12 41 3 queue_name char (32), /* without the .cmcs_queue suffix */ 12 42 3 queue_ctl_eindex fixed bin, /* to compute addr of table entry */ 12 43 2 command_info, /* len = 75 */ 12 44 3 cmd_line_len fixed bin, 12 45 3 cmd_line char (128), 12 46 3 mp_line_len fixed bin, 12 47 3 mp_line char (128), 12 48 3 cobol_program_id_len fixed bin, 12 49 3 cobol_program_id char (32), 12 50 2 io_info, /* len = 37, sum of all level 3s */ 12 51 3 io_flags, /* len = 1 */ 12 52 (4 io_in_process_sw bit (1), 12 53 4 partial_in_process_sw bit (1), 12 54 4 rcv_wait_sw bit (1), 12 55 /* switch separator */ 12 56 4 rcv_msg_sw bit (1), /* on if user did a receive msg */ 12 57 4 rcv_seg_sw bit (1), /* on if user did a receive seg */ 12 58 4 filler bit (31)) unaligned, 12 59 3 dynamic_queue_info, /* len = 13 */ 12 60 4 switch_name char (32) unaligned, 12 61 4 queue_ctl_eptr ptr, 12 62 4 iocb_ptr ptr, 12 63 4 vfile_status fixed bin, /* 0 - not active/detached */ 12 64 /* 1 - attached, but not open */ 12 65 /* 2 - open */ 12 66 3 msg_hdr_info, /* len = 9 */ 12 67 4 msg_hdr_ptr ptr, /* ptr to base of current msg */ 12 68 4 io_type fixed bin, 12 69 4 io_subtype fixed bin, 12 70 4 seg_count fixed bin (35), /* total no of msg segments */ 12 71 4 msg_len fixed bin (35), /* total msg length (sum of all segments) */ 12 72 4 msg_descr like vfile_descr, 12 73 4 msg_key, 12 74 5 msg_no fixed bin (35), 12 75 5 seg_no fixed bin (35), 12 76 3 tseg_info, /* len = 3 */ 12 77 4 tseg_ptr ptr, /* temp seg to build segment */ 12 78 4 tseg_len fixed bin (35), 12 79 3 msg_seg_info, /* len = 6 */ 12 80 4 msg_seg_ptr ptr, /* ptr to base of current msg_seg */ 12 81 4 msg_seg_descr like vfile_descr, 12 82 4 msg_seg_len fixed bin (35), 12 83 4 msg_seg_left_index fixed bin (35), 12 84 4 msg_seg_left_len fixed bin (35), 12 85 3 buffer_info, /* len = 5 */ 12 86 4 buffer_ptr ptr, 12 87 4 buffer_len fixed bin (35), 12 88 4 buffer_left_index fixed bin (35), 12 89 4 buffer_left_len fixed bin (35); 12 90 12 91 /* END INCLUDE FILE ... cmcs_tree_ctl.incl.pl1 */ 227 13 1 /* BEGIN INCLUDE FILE ... cmcs_user_ctl.incl.pl1 */ 13 2 13 3 /* 13 4* This COBOL MCS include file defines the global, process-dependent variables that are 13 5* not part of the PD copy of cmcs_tree_ctl.control. 13 6**/ 13 7 13 8 /* Modified on 05/06/81 by FCH, [4.4-1], attach command */ 13 9 /* Bob May, 5/31/77 */ 13 10 13 11 dcl user_ctl_exists_sw bit (1) aligned int static init ("0"b); /* indicates legitimacy of external_user_ctl_ptr */ 13 12 13 13 dcl external_user_ctl_ptr ptr external; /* global ptr for user_ctl */ 13 14 13 15 dcl user_ctl_ptr ptr int static; 13 16 13 17 dcl 1 user_ctl aligned based (user_ctl_ptr), 13 18 13 19 /* Flags */ 13 20 13 21 2 init_sw, 13 22 3 terminal_ctl bit(1), 13 23 3 tree_ctl bit(1), 13 24 3 status_list_ctl bit(1), 13 25 3 station_ctl bit(1), 13 26 3 queue_ctl bit(1), 13 27 3 set_lock bit(1), 13 28 3 wait_ctl bit(1), 13 29 3 purge_queues bit(1), 13 30 3 create_queues bit(1), 13 31 3 initiate_ctl bit(1), 13 32 3 mcs bit(1), 13 33 2 flags, 13 34 (3 initialized_sw bit (1), 13 35 3 interactive_sw bit (1), 13 36 3 mp_sw bit (1), /* message processor process */ 13 37 3 terminal_sw bit (1), /* user terminal process */ 13 38 3 admin_sw bit (1), /* cobol_mcs_admin */ 13 39 3 attach_bit bit(1), /*[4.4-1]*/ 13 40 3 rec bit(1), /*[4.4-1]*/ 13 41 3 filler bit (29)) unaligned, 13 42 2 cmcs_dir char (168), 13 43 2 output_file char(168), /*[4.4-1]*/ 13 44 2 station_name char (12), /* current station */ 13 45 2 station_ctl_eindex fixed bin, /* current station */ 13 46 2 process_id bit (36), 13 47 2 process_type fixed bin, /* 0 - not defined, 1 - MP, 2 - terminal, 3 - admin */ 13 48 2 filler fixed bin (35), /* to explicitly align ptrs */ 13 49 2 control_ptrs, 13 50 3 queue_ctl_ptr ptr, 13 51 3 iocb_ptr ptr, /*[4.4-1]*/ 13 52 3 station_ctl_ptr ptr, 13 53 3 system_ctl_ptr ptr, 13 54 3 terminal_ctl_ptr ptr, 13 55 3 tree_ctl_ptr ptr, 13 56 3 wait_ctl_ptr ptr, 13 57 3 filler_ptrs (4) ptr, 13 58 2 terminal_info, 13 59 3 term_id char (4), 13 60 3 term_type fixed bin, 13 61 3 term_channel char (8), 13 62 2 last_receive_info, 13 63 3 tree_path char (48), 13 64 3 tree_ctl_eindex fixed bin, 13 65 3 tree_ctl_eptr ptr, 13 66 2 last_send_info, 13 67 3 dest_name char (12), 13 68 3 tree_ctl_eindex fixed bin, 13 69 3 tree_ctl_eptr ptr, 13 70 2 station_info, 13 71 3 station_count fixed bin, /* must be 1 for phase 1 */ 13 72 3 station_entries (2), 13 73 4 station_name char (12), 13 74 4 station_ctl_eptr ptr, 13 75 4 station_ctl_eindex fixed bin, 13 76 2 wait_info, 13 77 3 wait_ctl_eptr ptr, 13 78 3 wait_ctl_eindex fixed bin, 13 79 3 wait_ctl_mp_eindex fixed bin, /* only for message processors */ 13 80 3 wait_ctl_mp_eptr ptr, 13 81 3 ev_wait_chn fixed bin (71), /* for message processors */ 13 82 3 ev_call_chn fixed bin (71), /* for terminals, to get message responses */ 13 83 3 ev_wait_list_ptr ptr, /* for ipc_$block */ 13 84 3 ev_info_ptr ptr; /* for wakeup */ 13 85 13 86 /* END INCLUDE FILE ... cmcs_user_ctl.incl.pl1 */ 228 14 1 /* BEGIN INCLUDE FILE... cmcs_vfile_rs.incl.pl1 */ 14 2 14 3 /* This COBOL MCS include file is used to reference records by their 14 4* vfile_ descriptors. It is used mainly in the maintenance of 14 5* message status lists. */ 14 6 14 7 /* Bob May, 6/30/77 */ 14 8 14 9 dcl vfile_rs_version fixed bin int static options (constant) init (1); 14 10 14 11 dcl vfile_rs_ptr ptr; 14 12 14 13 dcl 1 vfile_rs aligned based (vfile_rs_ptr), 14 14 2 version fixed bin, /* currently must be set to 1 */ 14 15 2 flags, 14 16 (3 lock_sw bit (1), /* "1"b */ 14 17 3 unlock_sw bit (1), /* "1"b */ 14 18 3 create_sw bit (1), /* "0"b */ 14 19 /* switch separator */ 14 20 3 locate_sw bit (1), /* "0"b for current_rec, "1"b to use descriptor */ 14 21 3 filler bit (32)) unaligned, /* (32) "0"b */ 14 22 2 rec_len fixed bin (21), 14 23 2 max_rec_len fixed bin (21), 14 24 2 rec_ptr ptr, 14 25 2 descr like vfile_descr, /* process INdependent addressing */ 14 26 2 filler fixed bin; /* 0 */ 14 27 14 28 dcl 1 vfile_descr, /* process INdependent addressing */ 14 29 (2 comp_no fixed bin (17), /* component of MSF */ 14 30 2 comp_offset bit (18)) unaligned; /* offset of record in component */ 14 31 14 32 /* END INCLUDE FILE... cmcs_vfile_rs.incl.pl1 */ 229 15 1 /* BEGIN INCLUDE FILE... cmcs_wait_ctl.incl.pl1 */ 15 2 15 3 /* This include file defines the wait control structure for COBOL MCS */ 15 4 15 5 /* Bob May, 5/31/77 */ 15 6 15 7 dcl (wait_ctl_hdr_len init (32), 15 8 wait_ctl_entry_len init (32), 15 9 wait_ctl_version init (1)) fixed bin int static options (constant); 15 10 15 11 dcl wait_ctl_ptr ptr int static; 15 12 15 13 dcl 1 wait_ctl aligned based (wait_ctl_ptr), 15 14 2 hdr like control_hdr, 15 15 2 linked_lists, /* to maintain FIFO processing */ 15 16 3 used, 15 17 4 count fixed bin, 15 18 (4 findex, 15 19 4 bindex) fixed bin (18), 15 20 3 free, 15 21 4 count fixed bin, 15 22 (4 findex, 15 23 4 bindex) fixed bin (18), 15 24 2 mp_info, /* for the message processors */ 15 25 3 mp_lockword bit (36) aligned, 15 26 3 mp_current_size fixed bin, /* max of 10 */ 15 27 3 mp_active_count fixed bin, /* <= current_size */ 15 28 3 mp_entries (10) like wait_ctl_mp_entry, 15 29 2 entries (wait_ctl.current_size) like wait_ctl_entry; 15 30 15 31 dcl wait_ctl_eindex fixed bin; 15 32 15 33 dcl wait_ctl_eptr ptr; 15 34 15 35 dcl 1 wait_ctl_entry aligned based (wait_ctl_eptr), 15 36 2 linked_list_indexes, 15 37 (3 findex, 15 38 3 bindex) fixed bin (18), /* should be FB (18) unsigned */ 15 39 2 lockword bit (36) aligned, /* process that has a msg */ 15 40 2 entry_status fixed bin, /* 0 = free, 1 = used */ 15 41 2 rcv_process_id bit (36), /* process that wants a msg */ 15 42 2 rcv_tree_path, 15 43 3 level_names (4) char (12), /* from receive request */ 15 44 2 abs_tree_path, 15 45 3 level_names (4) char (12), /* full hierarchy path of queue */ 15 46 2 queue_ctl_eindex fixed bin, /* corresponds to abs_tree_path */ 15 47 2 ev_wait_chn fixed bin (71), /* set by requestor */ 15 48 2 ev_message fixed bin (71), 15 49 2 queue_name char (32), /* physical queue where it is */ 15 50 2 tree_ctl_eindex fixed bin; /* back to tree_ctl to set up I/O control */ 15 51 15 52 dcl wait_ctl_mp_eindex fixed bin; 15 53 15 54 dcl wait_ctl_mp_eptr ptr; 15 55 15 56 dcl 1 wait_ctl_mp_entry aligned based (wait_ctl_mp_eptr), 15 57 2 process_id bit (36), 15 58 2 flags, 15 59 (3 available_sw bit (1), /* ready to process another message */ 15 60 3 filler bit (35)) unaligned, 15 61 2 ev_wait_chn fixed bin (71), 15 62 2 ev_message fixed bin (71), /* (currently unused) anything in addition to ipc_ message */ 15 63 2 tree_ctl_eindex fixed bin; 15 64 15 65 /* END INCLUDE FILE... cmcs_wait_ctl.incl.pl1 */ 230 231 232 /* */ 233 /* cobol_mcs, cmcs only */ 234 235 my_name = "cobol_mcs"; 236 my_brief_name = "cmcs"; 237 238 call cu_$arg_count (arg_count); 239 240 if arg_count < 2 | arg_count > 3 241 then do; 242 243 print_usage: 244 code = 0; 245 246 print_error_usage: 247 call com_err_ (code, my_name, "^/Usage: cobol_mcs cmcs_dir -message_processor (-mp) 248 249 or: cobol_mcs cmcs_dir -terminal (-term) {}"); 250 251 return; 252 253 end; 254 255 common_entry: 256 call get_temp_segments_ ("cobol_mcs", ptr_array, code); 257 258 if code ^= 0 259 then do; 260 261 call com_err_ (code, my_name, "Attempting to create cmcs_user_ctl_.control in your process_dir."); 262 return; 263 end; 264 265 user_ctl_ptr = ptr_array (1); /* now we can do something with it */ 266 267 call cu_$arg_ptr (1, arg_ptr, arg_len, code); 268 269 if code ^= 0 270 then go to print_error_usage; 271 272 if arg = "-wd" | arg = "-working_dir" 273 then dname = get_wdir_ (); 274 else do; 275 276 call absolute_pathname_ (arg, dname, code); 277 if code ^= 0 278 then go to print_error_usage; 279 end; 280 281 /* general initialization */ 282 283 buffer_ptr = addr (buffer); 284 buffer_max_len = 4 * 16 * 1024; /* terminal input arbitrarily limited to 16k chunks */ 285 286 /*[4.4-5]*/ 287 user_ctl.attach_bit, user_ctl.rec = "0"b; 288 d_stat_path = ""; /*[4.4-5]*/ 289 user_ctl.output_file = ""; /*[4.4-5]*/ 290 user_ctl.iocb_ptr = null (); /*[4.4-5]*/ 291 IOCB_ptr = iox_$user_output; 292 293 294 /* clear all user_ctl data */ 295 296 overlay_len = size (user_ctl); 297 user_ctl_ptr -> overlay (*) = 0; /* clean slate */ 298 /*[4.4-8]*/ 299 string (user_ctl.init_sw) = "0"b; 300 user_ctl.cmcs_dir, user_ctl.station_name, user_ctl.term_id, user_ctl.term_channel, 301 user_ctl.last_receive_info.tree_path, user_ctl.last_send_info.dest_name = ""; 302 /* so it isn't garbage if printed */ 303 304 user_ctl.last_receive_info.tree_ctl_eptr = null (); 305 user_ctl.last_send_info.tree_ctl_eptr = null (); 306 user_ctl.station_info.station_entries (*).station_ctl_eptr = null (); 307 user_ctl.wait_info.wait_ctl_eptr = null (); /* so we don't reference the dseg */ 308 309 user_ctl.cmcs_dir = dname; /* start filling things in */ 310 311 external_user_ctl_ptr = user_ctl_ptr; /* first reference */ 312 313 call cobol_mcs_$set_user_ctl_exists_sw ("1"b); /* let the world know we're ready */ 314 call cmcs_initiate_ctl_ ("", null (), code); /* just set all the ptrs in user_ctl, ma'am */ 315 316 if code ^= 0 317 then do; 318 319 external_user_ctl_ptr = null (); 320 return; /* cminit_ will print the error message */ 321 end; 322 323 /* Drop-thru means that user_ctl has had all its control seg ptrs set by cminit_. 324* Now we all can get ptrs from user_ctl without using a call */ 325 326 queue_ctl_ptr = user_ctl.queue_ctl_ptr; /* for admin and MPs */ 327 station_ctl_ptr = user_ctl.station_ctl_ptr; /* for admin and MPs */ 328 system_ctl_ptr = user_ctl.system_ctl_ptr; /* for admin and MPs */ 329 terminal_ctl_ptr = user_ctl.terminal_ctl_ptr; /* for admin and MPs */ 330 tree_ctl_ptr = user_ctl.tree_ctl_ptr; /* for admin and MPs */ 331 wait_ctl_ptr = user_ctl.wait_ctl_ptr; 332 333 user_ctl.process_id = get_process_id_ (); 334 335 call set_interactive_info; 336 337 if my_brief_name = "cmcsa" 338 then do; 339 340 user_ctl.admin_sw = "1"b; 341 user_ctl.process_type = 3; /* admin process */ 342 end; 343 344 if my_name = "cobol_mcs" 345 then do; /* cobol_mcs only */ 346 347 call cu_$arg_ptr (2, arg_ptr, arg_len, code); 348 if code ^= 0 349 then go to print_error_usage; 350 351 if arg = "-mp" | arg = "-message_processor" 352 then do; 353 354 call cu_$arg_ptr (3, arg_ptr, arg_len, code); 355 356 if code ^= 0 357 then go to print_error_usage; 358 station_name = arg; 359 user_ctl.mp_sw = "1"b; /* we made it, user is a station */ 360 user_ctl.process_type = 1; /* process is a CMCS message processor */ 361 end; 362 363 else if arg = "-term" | arg = "-terminal" 364 then do; 365 366 367 if ^interactive_sw 368 then do; 369 370 call com_err_ (0, my_name, "The terminal option must be used interactively."); 371 go to print_usage; 372 end; 373 374 if arg_count = 3 375 then do; 376 377 call cu_$arg_ptr (3, arg_ptr, arg_len, code); 378 379 if code ^= 0 380 then go to print_error_usage; 381 382 station_name = arg; 383 end; 384 else do; 385 386 call cmcs_terminal_ctl_$find (term_channel, station_name, code); 387 if code ^= 0 388 then do; 389 call com_err_ (code, my_name, 390 "Attempting to find your terminal subchannel in the cmcs_terminal_ctl.control segment." 391 ); 392 return; 393 end; 394 end; 395 396 user_ctl.station_name = station_name; 397 user_ctl.terminal_sw = "1"b; 398 user_ctl.process_type = 2; /* user is a CMCS terminal */ 399 end; 400 401 call cmcs_station_ctl_$attach (station_name, station_ctl_eindex, code); 402 403 if code ^= 0 404 then do; /* station already taken */ 405 406 call com_err_ (code, my_name, 407 "Attempting to attach station ""^a"". Returning to command level.", station_name); 408 return; 409 end; 410 411 user_ctl.station_name = station_name; 412 user_ctl.station_ctl_eindex = station_ctl_eindex; 413 /* save for disable checks */ 414 415 end; 416 417 /* Initialization for use as terminal */ 418 419 if user_ctl.terminal_sw 420 then do; 421 422 allocate input_cd; /* fixed size, no problem */ 423 output_cd_size = 100; /* can be increased later, if desired */ 424 allocate output_cd_area; 425 output_cd.bin_max_station_count = 10; /* artificial command-interface limitation */ 426 output_cd.char_max_station_count = 10; /* artificial command-interface limitation */ 427 428 call get_temp_segments_ (my_name, ptr_array, code); 429 430 if code ^= 0 431 then do; 432 call com_err_ (code, my_name, "Attempting to get temp seg for send buffer."); 433 return; 434 end; 435 436 send_buffer_ptr = ptr_array (1); /* only using one */ 437 send_buffer_max_len = 9999; /* max no of chars a COBOL program can send at one time */ 438 end; 439 440 if ^user_ctl.mp_sw 441 then do; /* they just abort */ 442 443 /* check for interrupted operations */ 444 445 on program_interrupt /* for all modes of use */ 446 begin; 447 call ioa_ ("Returning to request level."); 448 go to nonlocal_request; /* nonlocal goto */ 449 end; 450 451 /* catch any release stack */ 452 /*[4.4-7]*/ 453 on command_abort_ go to nonlocal_return; 454 on cleanup go to nonlocal_return; /* for all modes of use */ 455 end; 456 457 user_ctl.initialized_sw = "1"b; 458 459 /* Station Processing */ 460 461 if ^user_ctl.admin_sw /* everyone else may need this */ 462 then do; 463 464 /* Any checks to force use only as daemon should go here */ 465 466 call ipc_$create_ev_chn (user_ctl.ev_wait_chn, code); 467 468 if code ^= 0 469 then do; 470 call com_err_ (code, my_name, 471 "Attempting to create an event wait channel. Returning to command level."); 472 go to nonlocal_return; 473 end; 474 475 ev_wait_list.n_chn = 1; 476 ev_wait_list.ev_chn (1) = user_ctl.ev_wait_chn; 477 ev_wait_list_ptr, user_ctl.ev_wait_list_ptr = addr (ev_wait_list); 478 ev_info_ptr, user_ctl.ev_info_ptr = addr (ev_info); 479 end; 480 481 if user_ctl.mp_sw 482 then do; 483 484 call cmcs_wait_ctl_$mp_login (user_ctl.wait_ctl_mp_eindex, code); 485 486 if code ^= 0 487 then do; 488 call com_err_ (code, my_name, 489 "Attempting to add process to list of logged-in message processors. Returning to command level." 490 ); 491 go to nonlocal_return; 492 end; 493 494 /* We are logged in, but not yet available. Set ptr to mp wait entry for subsequent wakeup prcessing. */ 495 496 wait_ctl_mp_eindex = user_ctl.wait_ctl_mp_eindex; 497 /* set working value from saved value */ 498 wait_ctl_mp_eptr = addr (wait_ctl.mp_info.mp_entries (wait_ctl_mp_eindex)); 499 500 mp_loop: 501 call cmcs_wait_ctl_$mp_available (user_ctl.wait_ctl_mp_eindex, tree_ctl_eindex, code); 502 503 /* wakeup with an available message, hopefully */ 504 505 if code ^= 0 506 then do; 507 508 call com_err_ (code, my_name, 509 "Attempting to add process to list of available message processors. Returning to command level." 510 ); 511 go to nonlocal_return; 512 end; 513 514 /* So far, so good. Now check the ev_message to see what we are supposed to do. If 0, we process a message. 515* If 1, we log out. If anything else, we complain, and wait for the next wakeup. Ho hum, what a life! */ 516 517 if ev_info.ev_message = 1 518 then do; 519 520 mp_logout: 521 call ioa_ ("Message Processor (Station ^a) returning to command level.", 522 user_ctl.station_name); 523 call cmcs_wait_ctl_$mp_logout (wait_ctl_mp_eindex, code); 524 /* we don't want any more wakeups */ 525 526 if code ^= 0 527 then call com_err_ (code, my_name, 528 "Attempting to request an mp_logout for this process. Continuing to log out."); 529 530 go to nonlocal_return; 531 end; 532 533 else if ev_info.ev_message ^= 0 534 then do; 535 536 code = error_table_$action_not_performed; 537 call com_err_ (code, my_name, 538 "Invalid event message received in wakeup. Returning to mp_loop."); 539 540 go to mp_loop; 541 542 end; 543 544 /* Drop-thru means we must process a message in some queue specified in the mp wait entry */ 545 546 /* process the returned tree_ctl_eindex */ 547 548 tree_ctl_eindex = wait_ctl_mp_entry.tree_ctl_eindex; 549 /* the tree_ctl_entry has all the necessary info */ 550 tree_ctl_eptr = addr (tree_ctl.entries (tree_ctl_eindex)); 551 552 if ^(tree_ctl_entry.mp_sw | tree_ctl_entry.cobol_program_id_sw) 553 then do; 554 555 code = error_table_$action_not_performed; 556 557 mp_cmd_err: 558 call com_err_ (code, my_name, 559 "Error found in command line syntax or execution for ""^a"". Returning to mp_loop."); 560 561 go to mp_loop; 562 563 end; 564 565 call ioa_$rsnnl ("^a ^a ^a", buffer, buffer_len, 566 substr (tree_ctl_entry.mp_line, 1, tree_ctl_entry.mp_line_len), 567 substr (tree_ctl_entry.cobol_program_id, 1, tree_ctl_entry.cobol_program_id_len), 568 string (tree_ctl_entry.tree_path)); 569 570 call cu_$cp (addr (buffer), fixed (buffer_len, 17), code); 571 572 if code ^= 0 573 then do; 574 575 call com_err_ (code, my_name, "Executing command line (^a). Returning to mp_loop.", 576 substr (buffer, 1, buffer_len)); 577 end; 578 579 go to mp_loop; 580 end; /* of station processing */ 581 582 /*[4.4-5]*/ 583 declare 1 info_structure aligned, /*[4.4-5]*/ 584 2 ev_chain fixed bin (71), /*[4.4-5]*/ 585 2 input_available bit (1); 586 587 /*[4.4-5]*/ 588 declare timer_manager_$sleep 589 entry (fixed bin (71), bit (2)); 590 /*[4.4-5]*/ 591 declare info_ptr ptr; /*[4.4-5]*/ 592 declare IOCB_ptr ptr; 593 594 delay: 595 proc; 596 597 /*[4.4-5]*/ 598 info_ptr = addr (info_structure); 599 600 601 602 /*[4.4-5]*/ 603 do while ("1"b); 604 605 /*[4.4-5]*/ 606 call timer_manager_$sleep (1, "11"b); /* 1 sec delay */ 607 /*[4.4-5]*/ 608 call iox_$control (iox_$user_input, "read_status", info_ptr, code); 609 610 /*[4.4-5]*/ 611 if info_structure.input_available 612 then go to GL; 613 614 /*[4.4-5]*/ 615 call rec_messages; 616 617 /*[4.4-5]*/ 618 end; 619 620 end; 621 622 rec_messages: 623 proc; 624 625 /*[4.4-5]*/ 626 char_delim = "2"; /*[4.4-5]*/ 627 io_subtype = 2; /*[4.4-5]*/ 628 all_bit = "1"b; /*[4.4-5]*/ 629 string (input_cd.tree_path) = d_stat_path; 630 631 /*[4.4-5]*/ 632 user_ctl.rec = "1"b; /*[4.4-5]*/ 633 call rec; /*[4.4-5]*/ 634 user_ctl.rec = "0"b; 635 636 637 end; 638 639 /* NONLOCAL REQUEST */ 640 641 nonlocal_request: 642 read_request: /*[4.4-5]*/ 643 if my_brief_name = "cmcs" 644 then if user_ctl.attach_bit 645 then call delay; 646 647 648 649 GL: 650 call iox_$get_line (iox_$user_input, addr (req), 256, req_len, code); 651 652 if code ^= 0 653 then do; 654 if code = error_table_$long_record 655 then do; 656 657 call com_err_ (code, my_name, "Request lines must be <= 256 characters. Please reenter."); 658 go to read_request; 659 end; 660 else do; /* unexpected problem */ 661 662 call com_err_ (code, my_name, "Attempting to read a request line from user_input."); 663 return; 664 end; 665 end; 666 667 if req_len = 1 668 then go to read_request; /* just spacing down the terminal */ 669 670 /*[4.4-9]*/ 671 if substr (arg, 1, 2) = ".." /*[4.4-9]*/ 672 then do; 673 req_left_begin = 3; /*[4.4-9]*/ 674 req_left_len = req_len - 2; 675 676 /*[4.4-9]*/ 677 go to command (2); /*[4.4-9]*/ 678 end; 679 680 cmd_parsed_sw, args_parsed_sw = "0"b; /* flags to control parsing */ 681 req_left_begin = 1; 682 req_left_len = req_len - 1; /* forget the trailing NL */ 683 684 call get_req_cmd; /* strip off the command */ 685 686 if user_ctl.process_type = 2 687 then do; 688 689 do i = 1 to command_count; /* try the brief forms first */ 690 if arg = command_list.brief (i) 691 then go to command (i); 692 end; 693 694 do i = 1 to command_count; /* likes to type */ 695 if arg = command_list.long (i) 696 then go to command (i); 697 end; 698 699 end; 700 701 else if user_ctl.process_type = 3 702 then do; 703 704 do i = 1 to admin_command_count; /* try the brief forms first */ 705 if arg = admin_command_list.brief (i) 706 then go to admin_command (i); 707 end; 708 709 do i = 1 to admin_command_count; /* likes to type */ 710 if arg = admin_command_list.long (i) 711 then go to admin_command (i); 712 end; 713 714 end; 715 716 call com_err_ (0, my_name, "Unrecognized command ""^a"". Please reenter request.", arg); 717 718 go to read_request; 719 720 721 cmcsa: 722 cobol_mcs_admin: 723 entry; 724 725 my_name = "cobol_mcs_admin"; 726 my_brief_name = "cmcsa"; 727 728 call cu_$arg_count (arg_count); 729 730 if arg_count ^= 1 731 then do; /* needs help */ 732 733 call com_err_ (0, my_name, "Usage: cobol_mcs_admin cmcs_dir"); 734 return; 735 end; 736 737 go to common_entry; 738 739 /* NONLOCAL RETURN */ 740 /* quit */ 741 742 command (1): 743 admin_command (2): /*[4.4-5]*/ 744 if my_brief_name = "cmcs" 745 then if user_ctl.attach_bit 746 then call rec_messages; 747 748 nonlocal_return: 749 if ^user_ctl.admin_sw /* do for everyone except admin */ 750 then do; 751 752 if test_sw 753 then call ioa_ ("Starting purge all before return."); 754 /* DEBUG */ 755 756 call cobol_mcs_$stop_run (); 757 758 if user_ctl.terminal_sw /* no one else uses these */ 759 then do; 760 761 if input_cdp ^= null () 762 then free input_cd; 763 764 if output_cdp ^= null () 765 then free output_cd; 766 767 if send_buffer_ptr ^= null () 768 then do; 769 770 ptr_array (1) = send_buffer_ptr; 771 772 call release_temp_segments_ (my_name, ptr_array, code); 773 774 if code ^= 0 775 then call com_err_ (code, my_name, 776 "From releasing the send buffer segment. Continuing."); 777 end; 778 end; 779 780 call ipc_$delete_ev_chn (user_ctl.ev_wait_chn, code); 781 782 if code ^= 0 783 then call com_err_ (code, my_name, 784 "Attempting to delete the wait event channel. Please contact the CMCS Administrator. Continuing." 785 ); 786 787 call cmcs_station_ctl_$detach (user_ctl.station_ctl_eindex, code); 788 789 if code ^= 0 790 then call com_err_ (code, my_name, "Attempting to detach the process station_name. Continuing."); 791 end; 792 793 794 call cobol_mcs_$set_user_ctl_exists_sw ("0"b); /* now illegal to use CMCS */ 795 796 external_user_ctl_ptr = null (); 797 ptr_array (1) = user_ctl_ptr; /*[5.2-1]*/ 798 if my_brief_name = "cmcs" /*[5.2-1]*/ 799 then do; 800 call release_temp_segments_ ("cobol_mcs", ptr_array, code); 801 802 if code ^= 0 803 then call com_err_ (code, my_name, 804 "Attempting to release temporary segment for user_ctl. Continuing return to command level.") 805 ; /*[5.2-1]*/ 806 call cmcs_initiate_ctl_$release (code); /*[5.2-1]*/ 807 end; 808 return; /* execute */ 809 810 command (2): 811 admin_command (3): 812 call cu_$cp (addr (substr (req, req_left_begin, 1)), req_left_len, code); 813 814 if code ^= 0 815 then do; 816 call com_err_ (code, my_name, "From execute request."); 817 end; 818 819 /*[4.4-5]*/ 820 if my_brief_name = "cmcs" 821 then if user_ctl.attach_bit 822 then call rec_messages; 823 824 go to read_request; 825 826 827 /* accept_message_count */ 828 829 command (3): 830 if test_sw 831 then call ioa_ ("amc"); 832 833 io_subtype = 1; 834 835 call get_req_arg_count; 836 837 if arg_count ^= 1 838 then do; 839 840 call com_err_ (0, my_name, "Usage: accept_message_count tree_path"); 841 842 go to read_request; 843 844 end; 845 846 847 call req_arg_ptr (1); 848 849 call cmcs_expand_tree_path_ (arg, rcv_tree_path, code); 850 851 if code ^= 0 852 then do; 853 854 amc_error: 855 call com_err_ (code, my_name, "From accept_message_count, using ""^a"".", arg); 856 857 call cmcs_decode_status_ (iox_$user_output, input_cdp, 5, io_subtype, code); 858 859 go to read_request; 860 861 end; 862 863 864 865 string (input_cd.tree_path) = rcv_tree_path; 866 867 868 869 call cobol_mcs_$accept (input_cdp, code); 870 871 if code ^= 0 872 then go to amc_error; 873 874 call ioa_ ("Message count for ""^a"" is ^a.", arg, input_cd.msg_count); 875 876 rcv_tree_path = ""; /* so we don't confuse receives */ 877 878 go to read_request; 879 880 /*[4.4-3]*/ 881 declare all_bit bit (1); 882 883 /* receive */ 884 885 command (4): 886 if test_sw 887 then call ioa_ ("receive"); 888 889 /*[4.4-3]*/ 890 all_bit = "0"b; 891 892 call get_req_arg_count; 893 894 if arg_count = 0 | arg_count > 2 895 then do; 896 897 call com_err_ (0, my_name, "Usage: receive delim {tree_path}"); 898 go to read_request; 899 end; 900 901 call req_arg_ptr (1); /* get delimiter */ 902 903 if arg = "1" | arg = "esi" 904 then do; /* wants message segment */ 905 906 char_delim = "1"; 907 io_subtype = 1; 908 end; 909 else if arg = "2" | arg = "emi" 910 then do; /* wants entire message */ 911 912 char_delim = "2"; 913 io_subtype = 2; 914 end; 915 916 /*[4.4-3]*/ 917 else if arg = "3" | arg = "all" /*[4.4-3]*/ 918 then do; 919 char_delim = "2"; /*[4.4-3]*/ 920 io_subtype = 2; /* entire message */ 921 /*[4.4-3]*/ 922 all_bit = "1"b; /*[4.4-3]*/ 923 end; 924 925 else do; 926 927 /*[4.4-3]*/ 928 call com_err_ (0, my_name, "Receive delimiter must be esi (1) or emi (2) or all (3)."); 929 go to read_request; 930 end; 931 932 if arg_count = 2 933 then do; /* supplied the tree_path */ 934 935 call req_arg_ptr (2); 936 call cmcs_expand_tree_path_ (arg, rcv_tree_path, code); 937 938 if code ^= 0 939 then do; 940 941 call com_err_ (code, my_name, "Expanding ""^a"" to full tree path.", arg); 942 go to read_request; 943 end; 944 end; 945 else if rcv_tree_path = "" /* didn't give new one, is old one ok? */ 946 then do; 947 948 call com_err_ (0, my_name, "Previous tree path is blank. Please reenter request with new tree path."); 949 950 go to read_request; 951 end; 952 953 string (input_cd.tree_path) = rcv_tree_path; 954 955 /*[4.4-3]*/ 956 call rec; 957 958 if code ^= 0 959 then do; 960 961 call com_err_ (code, my_name, "From receive."); 962 call cmcs_decode_status_ (iox_$user_output, input_cdp, 2, io_subtype, code); 963 964 if code ^= 0 965 then call com_err_ (code, my_name, "From the status decode."); 966 967 end; 968 969 if input_cd.text_delim = 0 | input_cd.text_delim = 1 970 then rcv_tree_path = string (input_cd.tree_path); /* partial message, keep abs tree path */ 971 else rcv_tree_path = ""; /* nullify for complete messages and rcv errors */ 972 973 go to read_request; 974 975 rec: 976 proc; 977 978 /*[4.4-3]*/ 979 declare mess_bit bit (1); 980 981 /*[4.4-3]*/ 982 mess_bit = "0"b; 983 984 /*[4.4-3]*/ 985 do while ("1"b); 986 987 /*[4.4-3]*/ 988 call cmcs_queue_ctl_$print (input_cdp, io_subtype, IOCB_ptr, code); 989 990 /*[4.4-3]*/ 991 if ^all_bit 992 then return; 993 994 /*[4.4-3]*/ 995 if code ^= 0 /*[4.4-3]*/ 996 then do; 997 if code = cmcs_error_table_$no_message & (mess_bit | user_ctl.attach_bit) 998 then code = 0; 999 1000 /*[4.4-3]*/ 1001 return; /*[4.4-3]*/ 1002 end; 1003 1004 /*[4.4-3]*/ 1005 mess_bit = "1"b; /*[4.4-3]*/ 1006 end; 1007 1008 end; 1009 1010 /* send */ 1011 1012 command (5): 1013 if test_sw 1014 then call ioa_ ("send"); 1015 1016 send_buffer_len = 0; /* start fresh each time */ 1017 1018 call get_req_arg_count; /* for initial checks */ 1019 1020 if arg_count < 2 1021 then do; /* doesn't know how to use */ 1022 1023 call com_err_ (0, my_name, "Usage: send delim dest1 {dest2 ... destn}"); 1024 go to read_request; 1025 end; 1026 else if arg_count > 11 1027 then do; 1028 1029 call com_err_ (0, my_name, 1030 "Only 10 destinations can be specified in the send request. Please reenter request."); 1031 go to read_request; 1032 end; 1033 1034 call req_arg_ptr (1); /* get message delim */ 1035 1036 if arg = "1" | arg = "esi" 1037 then do; /* send data as message segment */ 1038 1039 char_delim = "1"; /* for cobol_mcs_ interface */ 1040 io_subtype = 1; /* for internal interfaces */ 1041 end; 1042 else if arg = "2" | arg = "emi" 1043 then do; /* send data as complete message */ 1044 1045 char_delim = "2"; 1046 io_subtype = 2; 1047 end; 1048 else if arg = "3" | arg = "egi" 1049 then do; /* egi same as emi */ 1050 1051 char_delim = "3"; 1052 io_subtype = 3; 1053 1054 end; 1055 else do; 1056 1057 call com_err_ (0, my_name, "The send delimiter must be esi (1), emi (2), or egi (3)."); 1058 go to read_request; 1059 end; 1060 1061 call fill_dest_table (2); /* arg 2 = 1st dest name */ 1062 1063 send_loop: 1064 call iox_$get_line (iox_$user_input, buffer_ptr, buffer_max_len, buffer_len, code); 1065 1066 if code ^= 0 1067 then do; 1068 1069 call com_err_ (code, my_name, "While doing a get_line for the send data."); 1070 1071 go to read_request; 1072 end; 1073 1074 if buffer_len = 2 1075 then if substr (buffer, 1, 1) = "." 1076 then do; 1077 1078 if send_buffer_len = 0 1079 then do; /* tried to send a null message */ 1080 1081 call com_err_ (0, my_name, "Send data must be non-null. Returning to request level."); 1082 1083 go to read_request; 1084 end; 1085 1086 /*[4.4-1]*/ 1087 if substr (send_buffer, send_buffer_len, 1) = " 1088 " /*[4.4-1]*/ 1089 then send_buffer_len = send_buffer_len - 1; 1090 1091 output_cd.text_len = send_buffer_len; 1092 1093 call cobol_mcs_$send (output_cdp, send_buffer_ptr, "9999", char_delim, (36)"0"b, code); 1094 1095 if code ^= 0 1096 then do; 1097 1098 call com_err_ (code, my_name, "From send."); 1099 call cmcs_decode_status_ (iox_$user_output, output_cdp, 1, io_subtype, code); 1100 1101 if code ^= 0 1102 then call com_err_ (code, my_name, "From decode of status information."); 1103 end; 1104 1105 go to read_request; 1106 end; 1107 1108 if send_buffer_len + buffer_len > send_buffer_max_len 1109 then do; /* should never happen, but just in case... */ 1110 1111 call com_err_ (0, my_name, 1112 "You have exceeded the maximum amount of input to the send request (^d characters). 1113 Returning to request level.", send_buffer_max_len); 1114 1115 go to read_request; 1116 end; 1117 1118 substr (send_buffer, send_buffer_len + 1, buffer_len) = substr (buffer, 1, buffer_len); 1119 send_buffer_len = send_buffer_len + buffer_len; 1120 1121 go to send_loop; 1122 1123 /* enable_input */ 1124 1125 command (6): 1126 if test_sw 1127 then call ioa_ ("ei"); 1128 1129 io_subtype = 1; 1130 1131 call get_req_arg_count; 1132 1133 if arg_count ^= 1 1134 then do; 1135 1136 call com_err_ (0, my_name, "Usage: enable_input tree_path"); 1137 go to read_request; 1138 end; 1139 1140 call req_arg_ptr (1); 1141 call cmcs_expand_tree_path_ (arg, rcv_tree_path, code); 1142 1143 if code ^= 0 1144 then do; 1145 1146 ei_error: 1147 call com_err_ (code, my_name, "From enable_input."); 1148 call cmcs_decode_status_ (iox_$user_output, input_cdp, 3, io_subtype, code); 1149 1150 go to read_request; 1151 end; 1152 1153 string (input_cd.tree_path) = rcv_tree_path; 1154 1155 call get_password; 1156 1157 call cobol_mcs_$enable_input_queue (input_cdp, password1, code); 1158 1159 if code ^= 0 1160 then go to ei_error; 1161 1162 go to read_request; 1163 1164 1165 /* enable_input_terminal */ 1166 1167 command (7): 1168 if test_sw 1169 then call ioa_ ("eit"); 1170 1171 io_subtype = 2; 1172 1173 call get_req_arg_count; 1174 1175 if arg_count ^= 1 1176 then do; 1177 call com_err_ (0, my_name, "Usage: enable_input_terminal station_name"); 1178 go to read_request; 1179 end; 1180 1181 call get_password; 1182 1183 call req_arg_ptr (1); 1184 1185 input_cd.station_name = arg; 1186 1187 call cobol_mcs_$enable_input_terminal (input_cdp, password1, code); 1188 1189 if code ^= 0 1190 then do; 1191 1192 call com_err_ (code, my_name, "From enable_input_terminal."); 1193 call cmcs_decode_status_ (iox_$user_output, input_cdp, 3, io_subtype, code); 1194 1195 go to read_request; 1196 end; 1197 1198 go to read_request; 1199 1200 1201 /* enable_output */ 1202 1203 command (8): 1204 if test_sw 1205 then call ioa_ ("eo"); 1206 1207 io_subtype = 3; 1208 1209 call get_req_arg_count; 1210 1211 if arg_count = 0 1212 then do; 1213 1214 call com_err_ (0, my_name, "Usage: enable_output dest1 {dest2 ... dest10}"); 1215 go to read_request; 1216 end; 1217 1218 call get_password; 1219 call fill_dest_table (1); 1220 1221 call cobol_mcs_$enable_output (output_cdp, password1, code); 1222 1223 if code ^= 0 1224 then do; 1225 1226 call com_err_ (code, my_name, "From enable_output"); 1227 call cmcs_decode_status_ (iox_$user_output, output_cdp, 3, io_subtype, code); 1228 1229 go to read_request; 1230 end; 1231 1232 go to read_request; 1233 1234 1235 /* disable_input */ 1236 1237 command (9): 1238 if test_sw 1239 then call ioa_ ("di"); 1240 1241 io_subtype = 1; 1242 1243 call get_req_arg_count; 1244 1245 if arg_count ^= 1 1246 then do; 1247 1248 call com_err_ (0, my_name, "Usage: disable_input tree_path"); 1249 go to read_request; 1250 end; 1251 1252 call req_arg_ptr (1); 1253 call cmcs_expand_tree_path_ (arg, rcv_tree_path, code); 1254 1255 if code ^= 0 1256 then do; 1257 1258 di_error: 1259 call com_err_ (code, my_name, "From disable_input."); 1260 call cmcs_decode_status_ (iox_$user_output, input_cdp, 4, io_subtype, code); 1261 1262 go to read_request; 1263 end; 1264 1265 string (input_cd.tree_path) = rcv_tree_path; 1266 1267 call get_password; 1268 1269 call cobol_mcs_$disable_input_queue (input_cdp, password1, code); 1270 1271 if code ^= 0 1272 then go to di_error; 1273 1274 go to read_request; 1275 1276 1277 /* disable_input_terminal */ 1278 1279 command (10): 1280 if test_sw 1281 then call ioa_ ("dit"); 1282 1283 io_subtype = 2; 1284 1285 call get_req_arg_count; 1286 1287 if arg_count ^= 1 1288 then do; 1289 1290 call com_err_ (0, my_name, "Usage: disable_input_terminal station_name"); 1291 go to read_request; 1292 end; 1293 1294 call get_password; 1295 call req_arg_ptr (1); 1296 1297 input_cd.station_name = arg; 1298 1299 call cobol_mcs_$disable_input_terminal (input_cdp, password1, code); 1300 1301 if code ^= 0 1302 then do; 1303 1304 call com_err_ (code, my_name, "From disable_input_terminal."); 1305 call cmcs_decode_status_ (iox_$user_output, input_cdp, 4, io_subtype, code); 1306 1307 go to read_request; 1308 end; 1309 1310 go to read_request; 1311 1312 1313 /* disable_output */ 1314 1315 command (11): 1316 if test_sw 1317 then call ioa_ ("do"); 1318 1319 io_subtype = 3; 1320 1321 call get_req_arg_count; 1322 1323 if arg_count = 0 1324 then do; 1325 1326 call com_err_ (0, my_name, "Usage: disable_output dest1 {dest2 ... dest10}"); 1327 1328 go to read_request; 1329 end; 1330 1331 call fill_dest_table (1); 1332 call get_password; 1333 1334 call cobol_mcs_$disable_output (output_cdp, password1, code); 1335 1336 if code ^= 0 1337 then do; 1338 1339 call com_err_ (code, my_name, "From disable_output"); 1340 call cmcs_decode_status_ (iox_$user_output, output_cdp, 4, io_subtype, code); 1341 1342 go to read_request; 1343 end; 1344 1345 go to read_request; 1346 1347 1348 /* purge */ 1349 1350 command (12): 1351 if test_sw 1352 then call ioa_ ("purge"); 1353 1354 io_subtype = 1; 1355 1356 call get_req_arg_count; 1357 1358 if arg_count = 0 1359 then do; 1360 1361 print_purge_usage: 1362 call com_err_ (0, my_name, "Usage: purge s {dest1 dest2 ... {dest10}"); 1363 1364 go to read_request; 1365 1366 end; 1367 1368 call req_arg_ptr (1); 1369 1370 if arg ^= "s" 1371 then go to print_purge_usage; 1372 1373 if arg_count > 1 1374 then do; 1375 1376 call fill_dest_table (2); 1377 1378 call cobol_mcs_$purge (output_cdp, code); 1379 /* sends only, for cmd interface */ 1380 1381 if code ^= 0 1382 then do; 1383 1384 call com_err_ (code, my_name, "From purge"); 1385 call cmcs_decode_status_ (iox_$user_output, output_cdp, 6, io_subtype, code); 1386 1387 end; 1388 end; 1389 else do; 1390 1391 call cobol_mcs_$purge (null (), code); 1392 if code ^= 0 1393 then call com_err_ (code, my_name, "From purge."); 1394 1395 end; 1396 1397 go to read_request; 1398 1399 /*activate */ 1400 1401 command (14): /* activate [ station_name [ path_name ]] */ 1402 /*[4.4-5]*/ 1403 if user_ctl.attach_bit /*[4.4-5]*/ 1404 then do; 1405 call com_err_ (0, my_name, "Station already activated"); 1406 /*[4.4-5]*/ 1407 go to read_request; /*[4.4-5]*/ 1408 end; 1409 1410 /*[4.4-5]*/ 1411 call get_req_arg_count; 1412 1413 /*[4.4-5]*/ 1414 if arg_count > 2 /*[4.4-5]*/ 1415 then do; 1416 call bad_attach; /*[4.4-5]*/ 1417 go to read_request; /*[4.4-5]*/ 1418 end; 1419 1420 /*[4.4-5]*/ 1421 go to A (arg_count); /* activate */ 1422 A (0): /*[4.4-5]*/ 1423 ARG = user_ctl.station_name; 1424 user_ctl.iocb_ptr = null (); /*[4.4-5]*/ 1425 go to A0; /* activate station-name */ 1426 A (1): /*[4.4-5]*/ 1427 call save_station; 1428 user_ctl.iocb_ptr = null (); /*[4.4-5]*/ 1429 go to A0; /* activate station-name file_name */ 1430 A (2): /*[4.4-5]*/ 1431 call save_station; /*[4.4-5]*/ 1432 call save_path (2); /*[4.4-5]*/ 1433 go to A0; 1434 1435 A0: /*[4.4-5]*/ 1436 call cmcs_tree_ctl_$find_qual_name (ARG, a_index, a_eptr, d_stat_path, code); 1437 1438 /*[4.4-5]*/ 1439 if code ^= 0 /*[4.4-5]*/ 1440 then do; 1441 d_stat_path = ""; /*[4.4-5]*/ 1442 call com_err_ (code, my_name, "illegal destination"); 1443 /*[4.4-5]*/ 1444 end; 1445 1446 /*[4.4-5]*/ 1447 user_ctl.attach_bit = "1"b; 1448 1449 /*[4.4-5]*/ 1450 go to read_request; 1451 1452 /*[4.4-5]*/ 1453 declare a_index fixed bin, 1454 a_eptr ptr; /*[4.4-5]*/ 1455 declare ARG char (12); /*[4.4-5]*/ 1456 declare d_stat_path char (52); 1457 1458 1459 /* deactivate */ 1460 1461 command (15): /* deactivate */ 1462 /*[4.4-5]*/ 1463 if ^user_ctl.attach_bit /*[4.4-5]*/ 1464 then do; 1465 call com_err_ (0, my_name, "Station already deactivated"); 1466 /*[4.4-5]*/ 1467 go to read_request; /*[4.4-5]*/ 1468 end; 1469 1470 /*[4.4-5]*/ 1471 if user_ctl.iocb_ptr ^= null () /*[4.4-5]*/ 1472 then do; 1473 call iox_$close (user_ctl.iocb_ptr, code); 1474 /*[4.4-5]*/ 1475 call code_test; /*[4.4-5]*/ 1476 call iox_$detach_iocb (user_ctl.iocb_ptr, code); 1477 /*[4.4-5]*/ 1478 call code_test; /*[4.4-5]*/ 1479 end; 1480 1481 /*[4.4-5]*/ 1482 user_ctl.attach_bit = "0"b; /*[4.4-5]*/ 1483 user_ctl.output_file = ""; /*[4.4-5]*/ 1484 user_ctl.iocb_ptr = null (); /*[4.4-5]*/ 1485 IOCB_ptr = iox_$user_output; 1486 1487 /*[4.4-5]*/ 1488 go to read_request; 1489 1490 save_station: 1491 proc; 1492 1493 /*[4.4-5]*/ 1494 call req_arg_ptr (1); 1495 1496 /*[4.4-5]*/ 1497 ARG = arg; 1498 end; 1499 1500 save_path: 1501 proc (arg_num); 1502 1503 /*[4.4-5]*/ 1504 declare arg_num fixed bin; 1505 1506 /*[4.4-5]*/ 1507 call req_arg_ptr (arg_num); 1508 1509 /*[4.4-5]*/ 1510 call exp; 1511 1512 /*[4.4-5]*/ 1513 call iox_$attach_name /*[4.4-5]*/ ("A", /*[4.4-5]*/ 1514 user_ctl.iocb_ptr, /*[4.4-5]*/ 1515 "vfile_ " || substr (dname, 1, dsz) || ">" || substr (ename, 1, esz) || " -extend", 1516 /*[4.4-5]*/ 1517 null (), /*[4.4-5]*/ 1518 code /*[4.4-5]*/); 1519 1520 /*[4.4-5]*/ 1521 call code_test; 1522 1523 /*[4.4-5]*/ 1524 call iox_$open (user_ctl.iocb_ptr, 2, "0"b, code); 1525 1526 /*[4.4-5]*/ 1527 call code_test; 1528 1529 /*[4.4-5]*/ 1530 IOCB_ptr = user_ctl.iocb_ptr; 1531 end; 1532 1533 code_test: 1534 proc; 1535 1536 /*[4.4-5]*/ 1537 if code ^= 0 /*[4.4-5]*/ 1538 then do; 1539 call com_err_ (code); 1540 1541 /*[4.4-5]*/ 1542 go to read_request; /*[4.4-5]*/ 1543 end; 1544 end; 1545 1546 bad_attach: 1547 proc; 1548 1549 /*[4.4-5]*/ 1550 call com_err_ (0, my_name, "Usage: attach [atation-name] "); 1551 1552 end; 1553 1554 1555 1556 /* change_cmcs_password */ 1557 1558 admin_command (5): 1559 if test_sw 1560 then call ioa_ ("Command ""change_cmcs_password"":"); 1561 1562 scpsw_sw = "0"b; /* check old psw before resetting it */ 1563 1564 call ioa_ ("Old password will be requested and then new password will be requested."); 1565 call get_password; 1566 1567 scpsw_sw = "1"b; 1568 1569 common_password: 1570 call get_password; /* if we return here, we checked out ok */ 1571 1572 system_ctl.password = password2; /* changed from now on */ 1573 1574 go to read_request; 1575 1576 /* set_cmcs_password */ 1577 1578 admin_command (6): 1579 if test_sw 1580 then call ioa_ ("Command ""set_cmcs_password"":"); 1581 scpsw_sw = "1"b; /* don't check old psw before resetting it */ 1582 1583 go to common_password; 1584 1585 1586 1587 /* create_cmcs_queues */ 1588 1589 admin_command (7): 1590 if test_sw 1591 then call ioa_ ("Command ""create_cmcs_queues"":"); 1592 1593 call cmcs_create_queues_ (code); 1594 1595 if code ^= 0 1596 then do; 1597 call com_err_ (code, my_name); 1598 end; 1599 1600 go to read_request; 1601 1602 /* who am I? */ 1603 1604 command (13): 1605 admin_command (1): 1606 if user_ctl.process_type = 2 1607 then call ioa_ ("^a, ^a", my_brief_name, user_ctl.station_name); 1608 else call ioa_ ("^a", my_brief_name); 1609 1610 go to read_request; 1611 1612 1613 /* test */ 1614 1615 admin_command (4): 1616 call get_req_arg_count; 1617 1618 call ioa_ ("Arg count is ^d.", arg_count); 1619 1620 go to read_request; 1621 1622 /* stop_mp */ 1623 1624 admin_command (9): 1625 call cmcs_wait_ctl_$stop_mp (code); 1626 1627 if code ^= 0 1628 then call com_err_ (code, my_name, "Attempting to issue ""stop_mp"" command. Returning to request level."); 1629 1630 go to read_request; 1631 1632 /* */ 1633 1634 /* clear_mp */ 1635 1636 admin_command (10): 1637 call cmcs_wait_ctl_$clear_mp (code); 1638 1639 if code ^= 0 1640 then call com_err_ (code, my_name, "Attempting to perform clear_mp request. Returning to request level."); 1641 1642 go to read_request; 1643 1644 1645 /* */ 1646 1647 /* start_mp */ 1648 admin_command (8): 1649 call cmcs_wait_ctl_$start_mp (code); 1650 1651 if code ^= 0 1652 then call com_err_ (code, my_name, "Attempting to perform start_mp request. Returning to request level."); 1653 1654 go to read_request; 1655 1656 /* */ 1657 1658 /* purge_queues */ 1659 admin_command (11): /* This request currently purges all queues and all records with status 1 and status 4 are deleted. 1660* Records with status 3 are moved back to status 2. Records with status 2 are left as-is. 1661* This request must be executed only when no other users of the given CMCS environment are on the system 1662* because no attempt is made to determine that a message is being processed by another process. */ 1663 if test_sw 1664 then call ioa_ ("Command ""purge_queues"":"); 1665 1666 call cmcs_purge_queues_ (0, "1"b, code); 1667 1668 if code ^= 0 1669 then call com_err_ (code, my_name, "From the purge_queues request. Returning to request level."); 1670 1671 go to read_request; 1672 1673 /* */ 1674 1675 /* Parsing Procedures */ 1676 1677 get_req_cmd: 1678 proc; 1679 1680 if ^cmd_parsed_sw 1681 then do; 1682 1683 call parse_args; 1684 req_cmd_ptr = arg_ptr; /* save for later reference */ 1685 req_cmd_len = arg_len; 1686 end; 1687 else do; 1688 1689 arg_ptr = req_cmd_ptr; /* retrieve previously set values */ 1690 arg_len = req_cmd_len; 1691 end; 1692 1693 return; 1694 1695 end /* get_req_cmd */; 1696 1697 /* */ 1698 1699 get_req_arg_count: 1700 proc; 1701 1702 if ^cmd_parsed_sw 1703 then call parse_args; 1704 1705 if ^args_parsed_sw 1706 then do; 1707 1708 call parse_args; 1709 req_arg_count = arg_count; /* save for later reference */ 1710 args_parsed_sw = "1"b; 1711 end; 1712 else arg_count = req_arg_count; 1713 1714 return; 1715 1716 end /* get_req_arg_count */; 1717 1718 /* */ 1719 1720 req_arg_ptr: 1721 proc (arg_no); 1722 1723 dcl arg_no fixed bin; 1724 1725 call get_req_arg_count; /* make sure everything is set up */ 1726 1727 arg_ptr = arg_array (arg_no).argp; 1728 arg_len = arg_array (arg_no).argl; 1729 1730 return; 1731 1732 end /* req_arg_ptr */; 1733 1734 /* */ 1735 1736 parse_args: 1737 proc; 1738 1739 arg_count = 0; 1740 1741 do j = 1 to max_req_args while (req_left_len > 0); 1742 1743 i = verify (substr (req, req_left_begin, req_left_len), whitespace); 1744 /* find first nonblank */ 1745 1746 if i ^= 0 1747 then do; /* found another arg */ 1748 1749 arg_count = arg_count + 1; 1750 req_left_begin = req_left_begin + i - 1; 1751 req_left_len = req_left_len - i + 1; 1752 end; 1753 else req_left_len = 0; /* no more args, stop looking */ 1754 1755 arg_ptr = addr (substr (req, req_left_begin, 1)); 1756 1757 i = search (substr (req, req_left_begin, req_left_len), whitespace); 1758 /* find end of arg */ 1759 1760 if i ^= 0 1761 then arg_len = i - 1; 1762 else arg_len = req_left_len; 1763 1764 req_left_begin = req_left_begin + arg_len; /* set for next iteration now or later */ 1765 req_left_len = req_left_len - arg_len; 1766 1767 if ^cmd_parsed_sw 1768 then do; 1769 1770 cmd_parsed_sw = "1"b; /* avoid infinite loop */ 1771 code = 0; 1772 1773 return; /* that's all we need this time */ 1774 end; 1775 1776 arg_array (arg_count).argp = arg_ptr; 1777 arg_array (arg_count).argl = arg_len; 1778 1779 end; /* of parse loop */ 1780 1781 if req_left_len ^= 0 1782 then code = error_table_$too_many_args; 1783 else code = 0; 1784 1785 return; 1786 1787 end /* parse_args */; 1788 1789 /* */ 1790 1791 set_interactive_info: 1792 proc; 1793 1794 call user_info_$absentee_queue (i); /* to see if we're interactive */ 1795 1796 if i ^= -1 1797 then interactive_sw = "0"b; /* No, Virginia */ 1798 else do; 1799 1800 interactive_sw = "1"b; /* yes, Virginia */ 1801 1802 call user_info_$tty_data (term_id, term_type, term_channel); 1803 1804 user_ctl.interactive_sw = "1"b; 1805 user_ctl.term_id = term_id; 1806 user_ctl.term_type = term_type; 1807 user_ctl.term_channel = term_channel; 1808 end; 1809 return; 1810 1811 end /* set_interactive_info */; 1812 1813 /* */ 1814 1815 get_password: 1816 proc (); 1817 1818 if interactive_sw /* should be done interactively but... */ 1819 then do; 1820 1821 request_password: 1822 call read_password_ ("Input COBOL MCS password:", password1); 1823 call read_password_ ("Please repeat for verification...", password2); 1824 1825 if password1 ^= password2 1826 then do; 1827 1828 call com_err_ (0, my_name, "Passwords do not match. Please repeat."); 1829 1830 go to request_password; 1831 1832 end; 1833 1834 encode_password: 1835 password2 = cmcs_scramble_ (password1); /* maintain secure passwords */ 1836 1837 if ^scpsw_sw 1838 then if password2 ^= system_ctl.password/* change, not set */ 1839 then do; /* not what it's thought to be */ 1840 1841 call com_err_ (cmcs_error_table_$bad_password, my_name, "Returning to request level."); 1842 1843 go to read_request; 1844 1845 end; 1846 scpsw_sw = "0"b; /* reset so we check the next time */ 1847 end; 1848 else do; 1849 1850 call com_err_ (error_table_$action_not_performed, my_name, 1851 "Passwords for COBOL MCS must be changed either by COBOL program or interactively."); 1852 1853 go to read_request; 1854 1855 end; 1856 return; 1857 1858 end /* get_password */; 1859 1860 /* */ 1861 1862 fill_dest_table: 1863 proc (x_arg_no); 1864 1865 dcl x_arg_no fixed bin; /* starting arg number */ 1866 1867 err_sw = "0"b; 1868 dest_table_index = 0; /* initialize */ 1869 1870 do i = x_arg_no to arg_count; 1871 1872 call req_arg_ptr (i); 1873 station_name = arg; /* for fixed 12 char size */ 1874 1875 call cmcs_station_ctl_$validate (station_name, station_ctl_eindex, code); 1876 1877 if code ^= 0 1878 then do; 1879 1880 err_sw = "1"b; 1881 call com_err_ (code, my_name, """^a"".", station_name); 1882 end; 1883 else do; 1884 1885 dest_table_index = dest_table_index + 1; 1886 output_cd.dest_table (dest_table_index).station_name = station_name; 1887 end; 1888 end; 1889 1890 if err_sw 1891 then do; 1892 1893 call com_err_ (error_table_$action_not_performed, my_name, "Please reenter request."); 1894 1895 go to read_request; /* non-local */ 1896 end; 1897 1898 output_cd.station_count = dest_table_index; 1899 code = 0; 1900 1901 return; 1902 1903 end /* fill_dest_table */; 1904 1905 1906 exp: 1907 proc; 1908 1909 /*[4.4-5]*/ 1910 call expand_pathname_ (arg, dname, ename, code); 1911 1912 /*[4.4-5]*/ 1913 call code_test; 1914 1915 /*[4.4-5]*/ 1916 dsz = index (dname, " "); /*[4.4-5]*/ 1917 if dsz <= 0 1918 then dsz = 168; 1919 else dsz = dsz - 1; 1920 1921 /*[4.4-5]*/ 1922 esz = index (ename, " "); /*[4.4-5]*/ 1923 if esz <= 0 1924 then esz = 32; 1925 else esz = esz - 1; 1926 1927 end; 1928 1929 /*[4.4-5]*/ 1930 declare (dsz, esz) fixed bin; 1931 1932 test: 1933 entry (); 1934 1935 test_sw = "1"b; 1936 return; 1937 1938 end /* cobol_mcs */; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0834.1 cobol_mcs.pl1 >spec>install>MR12.3-1048>cobol_mcs.pl1 216 1 03/27/82 0439.5 cmcs_arg_processing.incl.pl1 >ldd>include>cmcs_arg_processing.incl.pl1 217 2 03/27/82 0439.5 cmcs_cd_dcls.incl.pl1 >ldd>include>cmcs_cd_dcls.incl.pl1 218 3 03/27/82 0439.5 cmcs_cobol_mcs_dcls.incl.pl1 >ldd>include>cmcs_cobol_mcs_dcls.incl.pl1 219 4 03/27/82 0439.5 cmcs_control_hdr.incl.pl1 >ldd>include>cmcs_control_hdr.incl.pl1 220 5 05/24/89 0811.5 cmcs_entry_dcls.incl.pl1 >spec>install>MR12.3-1048>cmcs_entry_dcls.incl.pl1 221 6 03/27/82 0439.5 cmcs_error_table_dcls.incl.pl1 >ldd>include>cmcs_error_table_dcls.incl.pl1 222 7 03/27/82 0439.5 cmcs_iox_processing.incl.pl1 >ldd>include>cmcs_iox_processing.incl.pl1 223 8 03/27/82 0439.5 cmcs_ipc_processing.incl.pl1 >ldd>include>cmcs_ipc_processing.incl.pl1 224 9 03/27/82 0439.6 cmcs_station_ctl.incl.pl1 >ldd>include>cmcs_station_ctl.incl.pl1 225 10 03/27/82 0439.6 cmcs_system_ctl.incl.pl1 >ldd>include>cmcs_system_ctl.incl.pl1 226 11 03/27/82 0439.6 cmcs_terminal_ctl.incl.pl1 >ldd>include>cmcs_terminal_ctl.incl.pl1 227 12 03/27/82 0439.6 cmcs_tree_ctl.incl.pl1 >ldd>include>cmcs_tree_ctl.incl.pl1 228 13 03/27/82 0431.5 cmcs_user_ctl.incl.pl1 >ldd>include>cmcs_user_ctl.incl.pl1 229 14 03/27/82 0439.6 cmcs_vfile_rs.incl.pl1 >ldd>include>cmcs_vfile_rs.incl.pl1 230 15 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. ARG 000730 automatic char(12) packed unaligned dcl 1455 set ref 1422* 1435* 1497* IOCB_ptr 000722 automatic pointer dcl 592 set ref 291* 988* 1485* 1530* a_eptr 000726 automatic pointer dcl 1453 set ref 1435* a_index 000725 automatic fixed bin(17,0) dcl 1453 set ref 1435* absolute_pathname_ 000014 constant entry external dcl 188 ref 276 addr builtin function dcl 214 ref 283 477 478 498 550 570 570 598 649 649 810 810 1755 admin_command_count constant fixed bin(17,0) initial dcl 136 ref 704 709 admin_command_list 000226 constant structure level 1 packed packed unaligned dcl 138 admin_sw 13(04) based bit(1) level 3 packed packed unaligned dcl 13-17 set ref 340* 461 748 all_bit 000724 automatic bit(1) packed unaligned dcl 881 set ref 628* 890* 922* 991 arg based char packed unaligned dcl 1-3 set ref 272 272 276* 351 351 358 363 363 382 671 690 695 705 710 716* 849* 854* 874* 903 903 909 909 917 917 936* 941* 1036 1036 1042 1042 1048 1048 1141* 1185 1253* 1297 1370 1497 1873 1910* arg_array 000504 automatic structure array level 1 unaligned dcl 175 arg_count 000650 automatic fixed bin(17,0) dcl 1-3 set ref 238* 240 240 374 728* 730 837 894 894 932 1020 1026 1133 1175 1211 1245 1287 1323 1358 1373 1414 1421 1618* 1709 1712* 1739* 1749* 1749 1776 1777 1870 arg_len 000654 automatic fixed bin(17,0) dcl 1-3 set ref 267* 272 272 276 276 347* 351 351 354* 358 363 363 377* 382 671 690 695 705 710 716 716 849 849 854 854 874 874 903 903 909 909 917 917 936 936 941 941 1036 1036 1042 1042 1048 1048 1141 1141 1185 1253 1253 1297 1370 1497 1685 1690* 1728* 1760* 1762* 1764 1765 1777 1873 1910 1910 arg_no parameter fixed bin(17,0) dcl 1723 ref 1720 1727 1728 arg_num parameter fixed bin(17,0) dcl 1504 set ref 1500 1507* arg_ptr 000652 automatic pointer dcl 1-3 set ref 267* 272 272 276 347* 351 351 354* 358 363 363 377* 382 671 690 695 705 710 716 849 854 874 903 903 909 909 917 917 936 941 1036 1036 1042 1042 1048 1048 1141 1185 1253 1297 1370 1497 1684 1689* 1727* 1755* 1776 1873 1910 argl 2 000504 automatic fixed bin(17,0) array level 2 dcl 175 set ref 1728 1777* argp 000504 automatic pointer array level 2 dcl 175 set ref 1727 1776* args_parsed_sw 000502 automatic bit(1) packed unaligned dcl 170 set ref 680* 1705 1710* attach_bit 13(05) based bit(1) level 3 packed packed unaligned dcl 13-17 set ref 287* 641 742 820 997 1401 1447* 1461 1482* bin_max_station_count 3 based fixed bin(17,0) level 2 dcl 2-43 set ref 425* 764 brief 000000 constant char(8) initial array level 2 in structure "command_list" packed packed unaligned dcl 103 in procedure "cobol_mcs" ref 690 brief 000226 constant char(8) initial array level 2 in structure "admin_command_list" packed packed unaligned dcl 138 in procedure "cobol_mcs" ref 705 buffer 000236 automatic char(256) packed unaligned dcl 74 set ref 283 565* 570 570 575 575 1074 1118 buffer_len 000231 automatic fixed bin(21,0) dcl 74 set ref 565* 570 570 575 575 1063* 1074 1108 1118 1118 1119 buffer_max_len 000232 automatic fixed bin(21,0) dcl 74 set ref 284* 1063* buffer_ptr 000234 automatic pointer dcl 74 set ref 283* 1063* char_delim 000164 automatic char(1) packed unaligned dcl 49 set ref 626* 906* 912* 919* 1039* 1045* 1051* 1093* char_max_station_count 4 based picture(4) level 2 dcl 2-43 set ref 426* cleanup 000344 stack reference condition dcl 94 ref 454 cmcs_create_queues_ 000104 constant entry external dcl 5-18 ref 1593 cmcs_decode_status_ 000106 constant entry external dcl 5-22 ref 857 962 1099 1148 1193 1227 1260 1305 1340 1385 cmcs_dir 14 based char(168) level 2 dcl 13-17 set ref 300* 309* cmcs_error_table_$bad_password 000150 external static fixed bin(35,0) dcl 6-5 set ref 1841* cmcs_error_table_$no_message 000152 external static fixed bin(35,0) dcl 6-5 ref 997 cmcs_expand_tree_path_ 000110 constant entry external dcl 5-24 ref 849 936 1141 1253 cmcs_initiate_ctl_ 000112 constant entry external dcl 5-28 ref 314 cmcs_initiate_ctl_$release 000040 constant entry external dcl 205 ref 806 cmcs_purge_queues_ 000114 constant entry external dcl 5-32 ref 1666 cmcs_queue_ctl_$print 000116 constant entry external dcl 5-37 ref 988 cmcs_scramble_ 000120 constant entry external dcl 5-43 ref 1834 cmcs_station_ctl_$attach 000122 constant entry external dcl 5-48 ref 401 cmcs_station_ctl_$detach 000124 constant entry external dcl 5-49 ref 787 cmcs_station_ctl_$validate 000126 constant entry external dcl 5-58 ref 1875 cmcs_terminal_ctl_$find 000130 constant entry external dcl 5-64 ref 386 cmcs_tree_ctl_$find_qual_name 000132 constant entry external dcl 5-69 ref 1435 cmcs_wait_ctl_$clear_mp 000142 constant entry external dcl 5-77 ref 1636 cmcs_wait_ctl_$mp_available 000134 constant entry external dcl 5-74 ref 500 cmcs_wait_ctl_$mp_login 000136 constant entry external dcl 5-75 ref 484 cmcs_wait_ctl_$mp_logout 000140 constant entry external dcl 5-76 ref 523 cmcs_wait_ctl_$start_mp 000144 constant entry external dcl 5-78 ref 1648 cmcs_wait_ctl_$stop_mp 000146 constant entry external dcl 5-79 ref 1624 cmd_parsed_sw 000501 automatic bit(1) packed unaligned dcl 170 set ref 680* 1680 1702 1767 1770* cobol_mcs_$accept 000056 constant entry external dcl 3-3 ref 869 cobol_mcs_$disable_input_queue 000060 constant entry external dcl 3-4 ref 1269 cobol_mcs_$disable_input_terminal 000062 constant entry external dcl 3-5 ref 1299 cobol_mcs_$disable_output 000064 constant entry external dcl 3-6 ref 1334 cobol_mcs_$enable_input_queue 000066 constant entry external dcl 3-7 ref 1157 cobol_mcs_$enable_input_terminal 000070 constant entry external dcl 3-8 ref 1187 cobol_mcs_$enable_output 000072 constant entry external dcl 3-9 ref 1221 cobol_mcs_$purge 000074 constant entry external dcl 3-11 ref 1378 1391 cobol_mcs_$send 000076 constant entry external dcl 3-14 ref 1093 cobol_mcs_$set_user_ctl_exists_sw 000100 constant entry external dcl 3-15 ref 313 794 cobol_mcs_$stop_run 000102 constant entry external dcl 3-16 ref 756 cobol_program_id 133 based char(32) level 3 dcl 12-26 ref 565 565 cobol_program_id_len 132 based fixed bin(17,0) level 3 dcl 12-26 ref 565 565 cobol_program_id_sw 14(03) based bit(1) level 4 packed packed unaligned dcl 12-26 ref 552 code 000202 automatic fixed bin(35,0) dcl 49 set ref 243* 246* 255* 258 261* 267* 269 276* 277 314* 316 347* 348 354* 356 377* 379 386* 387 389* 401* 403 406* 428* 430 432* 466* 468 470* 484* 486 488* 500* 505 508* 523* 526 526* 536* 537* 555* 557* 570* 572 575* 608* 649* 652 654 657* 662* 772* 774 774* 780* 782 782* 787* 789 789* 800* 802 802* 806* 810* 814 816* 849* 851 854* 857* 869* 871 936* 938 941* 958 961* 962* 964 964* 988* 995 997 997* 1063* 1066 1069* 1093* 1095 1098* 1099* 1101 1101* 1141* 1143 1146* 1148* 1157* 1159 1187* 1189 1192* 1193* 1221* 1223 1226* 1227* 1253* 1255 1258* 1260* 1269* 1271 1299* 1301 1304* 1305* 1334* 1336 1339* 1340* 1378* 1381 1384* 1385* 1391* 1392 1392* 1435* 1439 1442* 1473* 1476* 1513* 1524* 1537 1539* 1593* 1595 1597* 1624* 1627 1627* 1636* 1639 1639* 1648* 1651 1651* 1666* 1668 1668* 1771* 1781* 1783* 1875* 1877 1881* 1899* 1910* com_err_ 000054 constant entry external dcl 1-13 ref 246 261 370 389 406 432 470 488 508 526 537 557 575 657 662 716 733 774 782 789 802 816 840 854 897 928 941 948 961 964 1023 1029 1057 1069 1081 1098 1101 1111 1136 1146 1177 1192 1214 1226 1248 1258 1290 1304 1326 1339 1361 1384 1392 1405 1442 1465 1539 1550 1597 1627 1639 1651 1668 1828 1841 1850 1881 1893 command_abort_ 000360 stack reference condition dcl 94 ref 453 command_count constant fixed bin(17,0) initial dcl 101 ref 689 694 command_info 30 based structure level 2 dcl 12-26 command_list 000000 constant structure level 1 packed packed unaligned dcl 103 control_hdr based structure level 1 dcl 4-11 control_ptrs 150 based structure level 2 dcl 13-17 cu_$arg_count 000050 constant entry external dcl 1-13 ref 238 728 cu_$arg_ptr 000052 constant entry external dcl 1-13 ref 267 347 354 377 cu_$cp 000020 constant entry external dcl 188 ref 570 810 d_stat_path 000733 automatic char(52) packed unaligned dcl 1456 set ref 288* 629 1435* 1441* dest_name 222 based char(12) level 3 dcl 13-17 set ref 300* dest_table 7(18) based structure array level 2 packed packed unaligned dcl 2-43 dest_table_index 000223 automatic fixed bin(17,0) dcl 61 set ref 1868* 1885* 1885 1886 1898 dname 000102 automatic char(168) packed unaligned dcl 49 set ref 272* 276* 309 1513 1910* 1916 dsz 000750 automatic fixed bin(17,0) dcl 1930 set ref 1513 1916* 1917 1917* 1919* 1919 ename 000154 automatic char(32) packed unaligned dcl 49 set ref 1513 1910* 1922 entries 100 based structure array level 2 dcl 12-16 set ref 550 entry_flags 14 based structure level 3 dcl 12-26 err_sw 000224 automatic bit(1) initial packed unaligned dcl 61 set ref 61* 1867* 1880* 1890 error_table_$action_not_performed 000042 external static fixed bin(35,0) dcl 207 set ref 536 555 1850* 1893* error_table_$long_record 000044 external static fixed bin(35,0) dcl 207 ref 654 error_table_$too_many_args 000046 external static fixed bin(35,0) dcl 207 ref 1781 esz 000751 automatic fixed bin(17,0) dcl 1930 set ref 1513 1922* 1923 1923* 1925* 1925 ev_chn 2 000664 automatic fixed bin(71,0) array level 2 dcl 8-7 set ref 476* ev_info 000674 automatic structure level 1 dcl 8-13 set ref 478 ev_info_ptr 266 based pointer level 3 in structure "user_ctl" dcl 13-17 in procedure "cobol_mcs" set ref 478* ev_info_ptr 000672 automatic pointer dcl 8-11 in procedure "cobol_mcs" set ref 478* ev_message 2 000674 automatic fixed bin(71,0) level 2 dcl 8-13 set ref 517 533 ev_wait_chn 260 based fixed bin(71,0) level 3 dcl 13-17 set ref 466* 476 780* ev_wait_list 000664 automatic structure level 1 dcl 8-7 set ref 477 ev_wait_list_ptr 264 based pointer level 3 in structure "user_ctl" dcl 13-17 in procedure "cobol_mcs" set ref 477* ev_wait_list_ptr 000662 automatic pointer dcl 8-5 in procedure "cobol_mcs" set ref 477* expand_pathname_ 000016 constant entry external dcl 188 ref 1910 external_user_ctl_ptr 000200 external static pointer dcl 13-13 set ref 311* 319* 796* fixed builtin function dcl 214 ref 570 570 flags 13 based structure level 2 dcl 13-17 get_process_id_ 000024 constant entry external dcl 188 ref 333 get_temp_segments_ 000030 constant entry external dcl 188 ref 255 428 get_wdir_ 000026 constant entry external dcl 188 ref 272 i 000100 automatic fixed bin(17,0) dcl 49 set ref 689* 690 690* 694* 695 695* 704* 705 705* 709* 710 710* 1743* 1746 1750 1751 1757* 1760 1760 1794* 1796 1870* 1872* info_ptr 000720 automatic pointer dcl 591 set ref 598* 608* info_structure 000714 automatic structure level 1 dcl 583 set ref 598 init_sw based structure level 2 dcl 13-17 set ref 299* initialized_sw 13 based bit(1) level 3 packed packed unaligned dcl 13-17 set ref 457* input_available 2 000714 automatic bit(1) level 2 dcl 583 set ref 611 input_cd based structure level 1 dcl 2-13 set ref 422 761 input_cdp 000656 automatic pointer dcl 2-9 set ref 422* 629 761 761 857* 865 869* 874 953 962* 969 969 969 988* 1148* 1153 1157* 1185 1187* 1193* 1260* 1265 1269* 1297 1299* 1305* interactive_sw 13(01) based bit(1) level 3 in structure "user_ctl" packed packed unaligned dcl 13-17 in procedure "cobol_mcs" set ref 1804* interactive_sw 000343 automatic bit(1) packed unaligned dcl 89 in procedure "cobol_mcs" set ref 367 1796* 1800* 1818 io_subtype 000165 automatic fixed bin(17,0) dcl 49 set ref 627* 833* 857* 907* 913* 920* 962* 988* 1040* 1046* 1052* 1099* 1129* 1148* 1171* 1193* 1207* 1227* 1241* 1260* 1283* 1305* 1319* 1340* 1354* 1385* ioa_ 000034 constant entry external dcl 188 ref 447 520 752 829 874 885 1012 1125 1167 1203 1237 1279 1315 1350 1558 1564 1578 1589 1604 1608 1618 1659 ioa_$rsnnl 000036 constant entry external dcl 188 ref 565 iocb_ptr 152 based pointer level 3 dcl 13-17 set ref 290* 1424* 1428* 1471 1473* 1476* 1484* 1513* 1524* 1530 iox_$attach_name 000154 constant entry external dcl 7-3 ref 1513 iox_$close 000156 constant entry external dcl 7-3 ref 1473 iox_$control 000160 constant entry external dcl 7-3 ref 608 iox_$detach_iocb 000162 constant entry external dcl 7-3 ref 1476 iox_$get_line 000164 constant entry external dcl 7-3 ref 649 1063 iox_$open 000166 constant entry external dcl 7-3 ref 1524 iox_$user_input 000170 external static pointer dcl 7-25 set ref 608* 649* 1063* iox_$user_output 000172 external static pointer dcl 7-25 set ref 291 857* 962* 1099* 1148* 1193* 1227* 1260* 1305* 1340* 1385* 1485 ipc_$create_ev_chn 000174 constant entry external dcl 8-30 ref 466 ipc_$delete_ev_chn 000176 constant entry external dcl 8-30 ref 780 j 000101 automatic fixed bin(17,0) dcl 49 set ref 1741* last_receive_info 202 based structure level 2 dcl 13-17 last_send_info 222 based structure level 2 dcl 13-17 level_info based structure level 2 dcl 12-26 long 26 000226 constant char(32) initial array level 2 in structure "admin_command_list" packed packed unaligned dcl 138 in procedure "cobol_mcs" ref 710 long 36 000000 constant char(32) initial array level 2 in structure "command_list" packed packed unaligned dcl 103 in procedure "cobol_mcs" ref 695 max_req_args constant fixed bin(17,0) initial dcl 180 ref 1741 mess_bit 001002 automatic bit(1) packed unaligned dcl 979 set ref 982* 997 1005* mp_entries 52 based structure array level 3 dcl 15-13 set ref 498 mp_info 46 based structure level 2 dcl 15-13 mp_line 72 based char(128) level 3 dcl 12-26 ref 565 565 mp_line_len 71 based fixed bin(17,0) level 3 dcl 12-26 ref 565 565 mp_sw 14(02) based bit(1) level 4 in structure "tree_ctl_entry" packed packed unaligned dcl 12-26 in procedure "cobol_mcs" ref 552 mp_sw 13(02) based bit(1) level 3 in structure "user_ctl" packed packed unaligned dcl 13-17 in procedure "cobol_mcs" set ref 359* 440 481 msg_count 43(09) based picture(6) level 2 packed packed unaligned dcl 2-13 set ref 874* my_brief_name 000210 automatic char(8) packed unaligned dcl 49 set ref 236* 337 641 726* 742 798 820 1604* 1608* my_name 000203 automatic char(16) packed unaligned dcl 49 set ref 235* 246* 261* 344 370* 389* 406* 428* 432* 470* 488* 508* 526* 537* 557* 575* 657* 662* 716* 725* 733* 772* 774* 782* 789* 802* 816* 840* 854* 897* 928* 941* 948* 961* 964* 1023* 1029* 1057* 1069* 1081* 1098* 1101* 1111* 1136* 1146* 1177* 1192* 1214* 1226* 1248* 1258* 1290* 1304* 1326* 1339* 1361* 1384* 1392* 1405* 1442* 1465* 1550* 1597* 1627* 1639* 1651* 1668* 1828* 1841* 1850* 1881* 1893* n_chn 000664 automatic fixed bin(17,0) level 2 dcl 8-7 set ref 475* null builtin function dcl 214 ref 290 304 305 306 307 314 314 319 761 764 767 796 1391 1391 1424 1428 1471 1484 1513 1513 output_cd based structure level 1 dcl 2-43 set ref 764 output_cd_area based fixed bin(17,0) array dcl 67 ref 424 output_cd_size 000225 automatic fixed bin(17,0) dcl 65 set ref 423* 424 output_cdp 000660 automatic pointer dcl 2-39 set ref 424* 425 426 764 764 1091 1093* 1099* 1221* 1227* 1334* 1340* 1378* 1385* 1886 1898 output_file 66 based char(168) level 2 dcl 13-17 set ref 289* 1483* overlay based fixed bin(17,0) array dcl 71 set ref 297* overlay_len 000230 automatic fixed bin(17,0) dcl 71 set ref 296* 297 password 43 based char(10) level 2 dcl 10-15 set ref 1572* 1837 password1 000212 automatic char(10) packed unaligned dcl 49 set ref 1157* 1187* 1221* 1269* 1299* 1334* 1821* 1825 1834* password2 000215 automatic char(10) packed unaligned dcl 49 set ref 1572 1823* 1825 1834* 1837 process_id 144 based bit(36) level 2 dcl 13-17 set ref 333* process_type 145 based fixed bin(17,0) level 2 dcl 13-17 set ref 341* 360* 398* 686 701 1604 program_interrupt 000352 stack reference condition dcl 94 ref 445 ptr_array 000226 automatic pointer array dcl 69 set ref 255* 265 428* 436 770* 772* 797* 800* queue_ctl_ptr 150 based pointer level 3 dcl 13-17 set ref 326* 326 rcv_tree_path 000166 automatic char(48) initial packed unaligned dcl 49 set ref 49* 849* 865 876* 936* 945 953 969* 971* 1141* 1153 1253* 1265 read_password_ 000022 constant entry external dcl 188 ref 1821 1823 rec 13(06) based bit(1) level 3 packed packed unaligned dcl 13-17 set ref 287* 632* 634* release_temp_segments_ 000032 constant entry external dcl 188 ref 772 800 req 000372 automatic char(256) packed unaligned dcl 163 set ref 649 649 810 810 1743 1755 1757 req_arg_count 000472 automatic fixed bin(17,0) dcl 163 set ref 1709* 1712 req_cmd_len 000500 automatic fixed bin(17,0) dcl 163 set ref 1685* 1690 req_cmd_ptr 000476 automatic pointer dcl 163 set ref 1684* 1689 req_left_begin 000473 automatic fixed bin(17,0) dcl 163 set ref 673* 681* 810 810 1743 1750* 1750 1755 1757 1764* 1764 req_left_len 000474 automatic fixed bin(17,0) dcl 163 set ref 674* 682* 810* 1741 1743 1751* 1751 1753* 1757 1762 1765* 1765 1781 req_len 000475 automatic fixed bin(21,0) dcl 163 set ref 649* 667 674 682 scpsw_sw 000342 automatic bit(1) packed unaligned dcl 89 set ref 1562* 1567* 1581* 1837 1846* search builtin function dcl 214 ref 1757 send_buffer based char packed unaligned dcl 80 set ref 1087 1118* send_buffer_len 000341 automatic fixed bin(35,0) dcl 80 set ref 1016* 1078 1087 1087* 1087 1091 1108 1118 1119* 1119 send_buffer_max_len 000340 automatic fixed bin(21,0) dcl 80 set ref 437* 1087 1108 1111* 1118 send_buffer_ptr 000336 automatic pointer dcl 80 set ref 436* 767 770 1087 1093* 1118 size builtin function dcl 214 ref 296 station_count 5 based picture(4) level 2 dcl 2-43 set ref 1898* station_ctl_eindex 000703 automatic fixed bin(17,0) dcl 9-17 in procedure "cobol_mcs" set ref 401* 412 1875* station_ctl_eindex 143 based fixed bin(17,0) level 2 in structure "user_ctl" dcl 13-17 in procedure "cobol_mcs" set ref 412* 787* station_ctl_entry based structure level 1 dcl 9-21 station_ctl_eptr 236 based pointer array level 4 dcl 13-17 set ref 306* station_ctl_ptr 154 based pointer level 3 in structure "user_ctl" dcl 13-17 in procedure "cobol_mcs" ref 327 station_ctl_ptr 000002 internal static pointer dcl 9-11 in procedure "cobol_mcs" set ref 327* station_entries 232 based structure array level 3 dcl 13-17 station_info 230 based structure level 2 dcl 13-17 station_name 140 based char(12) level 2 in structure "user_ctl" dcl 13-17 in procedure "cobol_mcs" set ref 300* 396* 411* 520* 1422 1604* station_name 000220 automatic char(12) packed unaligned dcl 61 in procedure "cobol_mcs" set ref 358* 382* 386* 396 401* 406* 411 1873* 1875* 1881* 1886 station_name 36(18) based char(12) level 2 in structure "input_cd" packed packed unaligned dcl 2-13 in procedure "cobol_mcs" set ref 1185* 1297* station_name 7(27) based char(12) array level 3 in structure "output_cd" packed packed unaligned dcl 2-43 in procedure "cobol_mcs" set ref 1886* string builtin function dcl 214 set ref 299* 565 565 629* 865* 953* 969 1153* 1265* substr builtin function dcl 214 set ref 565 565 565 565 575 575 671 810 810 1074 1087 1118* 1118 1513 1513 1743 1755 1757 system_ctl based structure level 1 dcl 10-15 system_ctl_ptr 000004 internal static pointer dcl 10-13 in procedure "cobol_mcs" set ref 328* 1572 1837 system_ctl_ptr 156 based pointer level 3 in structure "user_ctl" dcl 13-17 in procedure "cobol_mcs" ref 328 term_channel 000370 automatic char(8) packed unaligned dcl 97 in procedure "cobol_mcs" set ref 386* 1802* 1807 term_channel 200 based char(8) level 3 in structure "user_ctl" dcl 13-17 in procedure "cobol_mcs" set ref 300* 1807* term_id 176 based char(4) level 3 in structure "user_ctl" dcl 13-17 in procedure "cobol_mcs" set ref 300* 1805* term_id 000366 automatic char(4) packed unaligned dcl 97 in procedure "cobol_mcs" set ref 1802* 1805 term_type 177 based fixed bin(17,0) level 3 in structure "user_ctl" dcl 13-17 in procedure "cobol_mcs" set ref 1806* term_type 000367 automatic fixed bin(17,0) dcl 97 in procedure "cobol_mcs" set ref 1802* 1806 terminal_ctl_entry based structure level 1 dcl 11-22 terminal_ctl_ptr 000006 internal static pointer dcl 11-12 in procedure "cobol_mcs" set ref 329* terminal_ctl_ptr 160 based pointer level 3 in structure "user_ctl" dcl 13-17 in procedure "cobol_mcs" ref 329 terminal_info 176 based structure level 2 dcl 13-17 terminal_sw 13(03) based bit(1) level 3 packed packed unaligned dcl 13-17 set ref 397* 419 758 test_sw 000000 internal static bit(1) initial packed unaligned dcl 92 set ref 752 829 885 1012 1125 1167 1203 1237 1279 1315 1350 1558 1578 1589 1659 1935* text_delim 42(18) based picture(1) level 2 packed packed unaligned dcl 2-13 ref 969 969 text_len 6 based picture(4) level 2 dcl 2-43 set ref 1091* timer_manager_$sleep 000202 constant entry external dcl 588 ref 606 tree_ctl based structure level 1 dcl 12-16 tree_ctl_eindex 000704 automatic fixed bin(17,0) dcl 12-22 in procedure "cobol_mcs" set ref 500* 548* 550 tree_ctl_eindex 6 based fixed bin(17,0) level 2 in structure "wait_ctl_mp_entry" dcl 15-56 in procedure "cobol_mcs" ref 548 tree_ctl_entry based structure level 1 dcl 12-26 tree_ctl_eptr 226 based pointer level 3 in structure "user_ctl" dcl 13-17 in procedure "cobol_mcs" set ref 305* tree_ctl_eptr 000706 automatic pointer dcl 12-24 in procedure "cobol_mcs" set ref 550* 552 552 565 565 565 565 565 565 565 565 565 565 tree_ctl_eptr 220 based pointer level 3 in structure "user_ctl" dcl 13-17 in procedure "cobol_mcs" set ref 304* tree_ctl_ptr 000010 internal static pointer dcl 12-14 in procedure "cobol_mcs" set ref 330* 550 tree_ctl_ptr 162 based pointer level 3 in structure "user_ctl" dcl 13-17 in procedure "cobol_mcs" ref 330 tree_path 202 based char(48) level 3 in structure "user_ctl" dcl 13-17 in procedure "cobol_mcs" set ref 300* tree_path based structure level 3 in structure "tree_ctl_entry" dcl 12-26 in procedure "cobol_mcs" ref 565 565 tree_path 17 based structure level 2 in structure "input_cd" dcl 2-13 in procedure "cobol_mcs" set ref 629* 865* 953* 969 1153* 1265* user_ctl based structure level 1 dcl 13-17 set ref 296 user_ctl_ptr 000012 internal static pointer dcl 13-15 set ref 265* 287 287 289 290 296 297 299 300 300 300 300 300 300 304 305 306 307 309 311 326 326 327 328 329 330 331 333 340 341 359 360 396 397 398 411 412 419 440 457 461 466 476 477 478 481 484 496 500 520 632 634 641 686 701 742 748 758 780 787 797 820 997 1401 1422 1424 1428 1447 1461 1471 1473 1476 1482 1483 1484 1513 1524 1530 1604 1604 1804 1805 1806 1807 user_info_$absentee_queue 000010 constant entry external dcl 188 ref 1794 user_info_$tty_data 000012 constant entry external dcl 188 ref 1802 verify builtin function dcl 214 ref 1743 vfile_descr 000710 automatic structure level 1 packed packed unaligned dcl 14-28 wait_ctl based structure level 1 dcl 15-13 wait_ctl_entry based structure level 1 dcl 15-35 wait_ctl_eptr 252 based pointer level 3 dcl 13-17 set ref 307* wait_ctl_mp_eindex 000711 automatic fixed bin(17,0) dcl 15-52 in procedure "cobol_mcs" set ref 496* 498 523* wait_ctl_mp_eindex 255 based fixed bin(17,0) level 3 in structure "user_ctl" dcl 13-17 in procedure "cobol_mcs" set ref 484* 496 500* wait_ctl_mp_entry based structure level 1 dcl 15-56 wait_ctl_mp_eptr 000712 automatic pointer dcl 15-54 set ref 498* 548 wait_ctl_ptr 164 based pointer level 3 in structure "user_ctl" dcl 13-17 in procedure "cobol_mcs" ref 331 wait_ctl_ptr 000014 internal static pointer dcl 15-11 in procedure "cobol_mcs" set ref 331* 498 wait_info 252 based structure level 2 dcl 13-17 whitespace 000442 constant char(5) initial packed unaligned dcl 183 ref 1743 1757 x_arg_no parameter fixed bin(17,0) dcl 1865 ref 1862 1870 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. active_fnc_err_ 000000 constant entry external dcl 1-17 af_return_arg based varying char dcl 1-9 af_return_arg_len automatic fixed bin(17,0) dcl 1-9 af_return_arg_ptr automatic pointer dcl 1-9 arg_no automatic fixed bin(17,0) dcl 1-3 char builtin function dcl 214 char_send_buffer_len automatic picture(4) packed unaligned dcl 80 cmcs_date_time_ 000000 constant entry external dcl 5-20 cmcs_error_table_$ambiguous_tree_path external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$bad_call_parm external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$bad_dest external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$bad_dest_count external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$bad_message_length external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$bad_queue_path external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$bad_slew external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$bad_source external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$bad_station external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$bad_term_devchn external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$bad_tree_path external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$dest_already_disabled external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$dest_already_enabled external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$dest_disabled external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$no_partial_messages external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$null_partial_message external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$queue_already_disabled external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$queue_already_enabled external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$queue_disabled external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$source_already_disabled external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$source_already_enabled external static fixed bin(35,0) dcl 6-5 cmcs_error_table_$source_disabled external static fixed bin(35,0) dcl 6-5 cmcs_fillin_hdr_ 000000 constant entry external dcl 5-26 cmcs_print_ 000000 constant entry external dcl 5-30 cmcs_queue_ctl_$accept_message_count 000000 constant entry external dcl 5-34 cmcs_queue_ctl_$disable 000000 constant entry external dcl 5-35 cmcs_queue_ctl_$enable 000000 constant entry external dcl 5-36 cmcs_queue_ctl_$purge 000000 constant entry external dcl 5-38 cmcs_queue_ctl_$receive 000000 constant entry external dcl 5-39 cmcs_queue_ctl_$send 000000 constant entry external dcl 5-40 cmcs_queue_ctl_$stop_run 000000 constant entry external dcl 5-41 cmcs_set_lock_$lock 000000 constant entry external dcl 5-45 cmcs_set_lock_$unlock 000000 constant entry external dcl 5-46 cmcs_station_ctl_$detach_name 000000 constant entry external dcl 5-50 cmcs_station_ctl_$disable_input_terminal 000000 constant entry external dcl 5-51 cmcs_station_ctl_$disable_output_terminal 000000 constant entry external dcl 5-52 cmcs_station_ctl_$enable_input_terminal 000000 constant entry external dcl 5-53 cmcs_station_ctl_$enable_output_terminal 000000 constant entry external dcl 5-54 cmcs_station_ctl_$find_destination 000000 constant entry external dcl 5-55 cmcs_station_ctl_$input_disabled 000000 constant entry external dcl 5-56 cmcs_station_ctl_$output_disabled 000000 constant entry external dcl 5-57 cmcs_status_list_ctl_$add 000000 constant entry external dcl 5-60 cmcs_status_list_ctl_$delete 000000 constant entry external dcl 5-61 cmcs_status_list_ctl_$move 000000 constant entry external dcl 5-62 cmcs_tree_ctl_$find_destination 000000 constant entry external dcl 5-66 cmcs_tree_ctl_$find_index 000000 constant entry external dcl 5-67 cmcs_tree_ctl_$find_tree_path 000000 constant entry external dcl 5-68 cmcs_wait_ctl_$add 000000 constant entry external dcl 5-71 cmcs_wait_ctl_$delete 000000 constant entry external dcl 5-72 cmcs_wait_ctl_$find 000000 constant entry external dcl 5-73 cobol_mcs_$get_user_ctl_exists_sw 000000 constant entry external dcl 3-10 cobol_mcs_$receive 000000 constant entry external dcl 3-12 cobol_mcs_$receive_wait 000000 constant entry external dcl 3-13 control_hdr_len internal static fixed bin(17,0) initial dcl 4-7 control_hdr_ptr automatic pointer dcl 4-9 cu_$af_arg_count 000000 constant entry external dcl 1-17 cu_$af_arg_ptr 000000 constant entry external dcl 1-17 cu_$af_return_arg 000000 constant entry external dcl 1-17 error_table_$not_act_fnc external static fixed bin(35,0) dcl 1-22 error_table_$wrong_no_of_args external static fixed bin(35,0) dcl 207 ev_chn automatic fixed bin(71,0) dcl 8-3 ev_message_ptr automatic pointer dcl 8-22 ev_message_struc based structure level 1 unaligned dcl 8-24 hcs_$make_seg 000000 constant entry external dcl 188 hcs_$wakeup 000000 constant entry external dcl 8-28 iox_$attach_iocb 000000 constant entry external dcl 7-3 iox_$delete_record 000000 constant entry external dcl 7-3 iox_$error_output external static pointer dcl 7-25 iox_$find_iocb 000000 constant entry external dcl 7-3 iox_$get_chars 000000 constant entry external dcl 7-3 iox_$modes 000000 constant entry external dcl 7-3 iox_$position 000000 constant entry external dcl 7-3 iox_$put_chars 000000 constant entry external dcl 7-3 iox_$read_key 000000 constant entry external dcl 7-3 iox_$read_length 000000 constant entry external dcl 7-3 iox_$read_record 000000 constant entry external dcl 7-3 iox_$rewrite_record 000000 constant entry external dcl 7-3 iox_$seek_key 000000 constant entry external dcl 7-3 iox_$user_io external static pointer dcl 7-25 iox_$write_record 000000 constant entry external dcl 7-3 ipc_$block 000000 constant entry external dcl 8-30 ipc_$cutoff 000000 constant entry external dcl 8-30 ipc_$decl_ev_call_chn 000000 constant entry external dcl 8-30 ipc_$decl_ev_wait_chn 000000 constant entry external dcl 8-30 ipc_$drain_chn 000000 constant entry external dcl 8-30 ipc_$mak_ev_calls 000000 constant entry external dcl 8-30 ipc_$reconnect 000000 constant entry external dcl 8-30 ipc_$unmask_ev_calls 000000 constant entry external dcl 8-30 last_station_info based structure level 1 dcl 2-66 max_arg_count internal static fixed bin(17,0) initial dcl 173 station_ctl based structure level 1 dcl 9-13 station_ctl_entry_len internal static fixed bin(17,0) initial dcl 9-7 station_ctl_eptr automatic pointer dcl 9-19 station_ctl_hdr_len internal static fixed bin(17,0) initial dcl 9-7 station_ctl_version internal static fixed bin(17,0) initial dcl 9-7 system_ctl_entry_len internal static fixed bin(17,0) initial dcl 10-9 system_ctl_hdr_len internal static fixed bin(17,0) initial dcl 10-9 system_ctl_version internal static fixed bin(17,0) initial dcl 10-9 terminal_ctl based structure level 1 dcl 11-14 terminal_ctl_eindex automatic fixed bin(17,0) dcl 11-18 terminal_ctl_entry_len internal static fixed bin(17,0) initial dcl 11-8 terminal_ctl_eptr automatic pointer dcl 11-20 terminal_ctl_hdr_len internal static fixed bin(17,0) initial dcl 11-8 terminal_ctl_version internal static fixed bin(17,0) initial dcl 11-8 tree_ctl_entry_len internal static fixed bin(17,0) initial dcl 12-10 tree_ctl_hdr_len internal static fixed bin(17,0) initial dcl 12-10 tree_ctl_version internal static fixed bin(17,0) initial dcl 12-10 user_ctl_exists_sw internal static bit(1) initial dcl 13-11 vfile_rs based structure level 1 dcl 14-13 vfile_rs_ptr automatic pointer dcl 14-11 vfile_rs_version internal static fixed bin(17,0) initial dcl 14-9 wait_ctl_eindex automatic fixed bin(17,0) dcl 15-31 wait_ctl_entry_len internal static fixed bin(17,0) initial dcl 15-7 wait_ctl_eptr automatic pointer dcl 15-33 wait_ctl_hdr_len internal static fixed bin(17,0) initial dcl 15-7 wait_ctl_version internal static fixed bin(17,0) initial dcl 15-7 NAMES DECLARED BY EXPLICIT CONTEXT. A 000436 constant label array(0:2) dcl 1422 ref 1421 A0 010776 constant label dcl 1435 ref 1425 1429 1433 GL 004471 constant label dcl 649 ref 611 admin_command 000404 constant label array(11) dcl 742 ref 705 710 amc_error 005637 constant label dcl 854 ref 871 bad_attach 012221 constant entry internal dcl 1546 ref 1416 cmcs 002535 constant entry external dcl 37 cmcsa 005013 constant entry external dcl 721 cobol_mcs 002525 constant entry external dcl 37 cobol_mcs_admin 005003 constant entry external dcl 721 code_test 012203 constant entry internal dcl 1533 ref 1475 1478 1521 1527 1913 command 000417 constant label array(15) dcl 742 ref 677 690 695 common_entry 002612 constant label dcl 255 ref 737 common_password 011215 constant label dcl 1569 set ref 1583 delay 011651 constant entry internal dcl 594 ref 641 di_error 010035 constant label dcl 1258 ref 1271 ei_error 007300 constant label dcl 1146 ref 1159 encode_password 012613 constant label dcl 1834 exp 013060 constant entry internal dcl 1906 ref 1510 fill_dest_table 012711 constant entry internal dcl 1862 ref 1061 1219 1331 1376 get_password 012516 constant entry internal dcl 1815 ref 1155 1181 1218 1267 1294 1332 1565 1569 get_req_arg_count 012266 constant entry internal dcl 1699 ref 835 892 1018 1131 1173 1209 1243 1285 1321 1356 1411 1615 1725 get_req_cmd 012250 constant entry internal dcl 1677 ref 684 mp_cmd_err 004267 constant label dcl 557 mp_logout 004136 constant label dcl 520 mp_loop 004066 constant label dcl 500 ref 540 561 579 nonlocal_request 004456 constant label dcl 641 ref 448 nonlocal_return 005102 constant label dcl 748 ref 453 454 472 491 511 530 parse_args 012320 constant entry internal dcl 1736 ref 1683 1702 1708 print_error_usage 002565 constant label dcl 246 ref 269 277 348 356 379 print_purge_usage 010511 constant label dcl 1361 ref 1370 print_usage 002564 constant label dcl 243 set ref 371 read_request 004456 constant label dcl 641 ref 658 667 718 824 842 859 878 898 929 942 950 973 1024 1031 1058 1071 1083 1105 1115 1137 1150 1162 1178 1195 1198 1215 1229 1232 1249 1262 1274 1291 1307 1310 1328 1342 1345 1364 1397 1407 1417 1450 1467 1488 1542 1574 1600 1610 1620 1630 1642 1654 1671 1843 1853 1895 rec 011753 constant entry internal dcl 975 ref 633 956 rec_messages 011726 constant entry internal dcl 622 ref 615 742 820 req_arg_ptr 012305 constant entry internal dcl 1720 ref 847 901 935 1034 1140 1183 1252 1295 1368 1494 1507 1872 request_password 012521 constant label dcl 1821 ref 1830 save_path 012033 constant entry internal dcl 1500 ref 1432 save_station 012020 constant entry internal dcl 1490 ref 1426 1430 send_loop 006644 constant label dcl 1063 ref 1121 set_interactive_info 012442 constant entry internal dcl 1791 ref 335 test 011637 constant entry external dcl 1932 NAME DECLARED BY CONTEXT OR IMPLICATION. index builtin function ref 1916 1922 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 14620 15042 13612 15024 Length 16054 13612 204 775 1005 16 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_mcs 910 external procedure is an external procedure. on unit on line 445 78 on unit on unit on line 453 64 on unit on unit on line 454 64 on unit delay internal procedure shares stack frame of external procedure cobol_mcs. rec_messages internal procedure shares stack frame of external procedure cobol_mcs. rec internal procedure shares stack frame of external procedure cobol_mcs. save_station internal procedure shares stack frame of external procedure cobol_mcs. save_path internal procedure shares stack frame of external procedure cobol_mcs. code_test internal procedure shares stack frame of external procedure cobol_mcs. bad_attach internal procedure shares stack frame of external procedure cobol_mcs. get_req_cmd internal procedure shares stack frame of external procedure cobol_mcs. get_req_arg_count internal procedure shares stack frame of external procedure cobol_mcs. req_arg_ptr internal procedure shares stack frame of external procedure cobol_mcs. parse_args internal procedure shares stack frame of external procedure cobol_mcs. set_interactive_info internal procedure shares stack frame of external procedure cobol_mcs. get_password internal procedure shares stack frame of external procedure cobol_mcs. fill_dest_table internal procedure shares stack frame of external procedure cobol_mcs. exp internal procedure shares stack frame of external procedure cobol_mcs. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000000 test_sw cobol_mcs 000002 station_ctl_ptr cobol_mcs 000004 system_ctl_ptr cobol_mcs 000006 terminal_ctl_ptr cobol_mcs 000010 tree_ctl_ptr cobol_mcs 000012 user_ctl_ptr cobol_mcs 000014 wait_ctl_ptr cobol_mcs STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_mcs 000100 i cobol_mcs 000101 j cobol_mcs 000102 dname cobol_mcs 000154 ename cobol_mcs 000164 char_delim cobol_mcs 000165 io_subtype cobol_mcs 000166 rcv_tree_path cobol_mcs 000202 code cobol_mcs 000203 my_name cobol_mcs 000210 my_brief_name cobol_mcs 000212 password1 cobol_mcs 000215 password2 cobol_mcs 000220 station_name cobol_mcs 000223 dest_table_index cobol_mcs 000224 err_sw cobol_mcs 000225 output_cd_size cobol_mcs 000226 ptr_array cobol_mcs 000230 overlay_len cobol_mcs 000231 buffer_len cobol_mcs 000232 buffer_max_len cobol_mcs 000234 buffer_ptr cobol_mcs 000236 buffer cobol_mcs 000336 send_buffer_ptr cobol_mcs 000340 send_buffer_max_len cobol_mcs 000341 send_buffer_len cobol_mcs 000342 scpsw_sw cobol_mcs 000343 interactive_sw cobol_mcs 000366 term_id cobol_mcs 000367 term_type cobol_mcs 000370 term_channel cobol_mcs 000372 req cobol_mcs 000472 req_arg_count cobol_mcs 000473 req_left_begin cobol_mcs 000474 req_left_len cobol_mcs 000475 req_len cobol_mcs 000476 req_cmd_ptr cobol_mcs 000500 req_cmd_len cobol_mcs 000501 cmd_parsed_sw cobol_mcs 000502 args_parsed_sw cobol_mcs 000504 arg_array cobol_mcs 000650 arg_count cobol_mcs 000652 arg_ptr cobol_mcs 000654 arg_len cobol_mcs 000656 input_cdp cobol_mcs 000660 output_cdp cobol_mcs 000662 ev_wait_list_ptr cobol_mcs 000664 ev_wait_list cobol_mcs 000672 ev_info_ptr cobol_mcs 000674 ev_info cobol_mcs 000703 station_ctl_eindex cobol_mcs 000704 tree_ctl_eindex cobol_mcs 000706 tree_ctl_eptr cobol_mcs 000710 vfile_descr cobol_mcs 000711 wait_ctl_mp_eindex cobol_mcs 000712 wait_ctl_mp_eptr cobol_mcs 000714 info_structure cobol_mcs 000720 info_ptr cobol_mcs 000722 IOCB_ptr cobol_mcs 000724 all_bit cobol_mcs 000725 a_index cobol_mcs 000726 a_eptr cobol_mcs 000730 ARG cobol_mcs 000733 d_stat_path cobol_mcs 000750 dsz cobol_mcs 000751 esz cobol_mcs 001002 mess_bit rec 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 unpack_picture ss_ext_entry ss_int_entry alloc_storage op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. absolute_pathname_ cmcs_create_queues_ cmcs_decode_status_ cmcs_expand_tree_path_ cmcs_initiate_ctl_ cmcs_initiate_ctl_$release cmcs_purge_queues_ cmcs_queue_ctl_$print cmcs_scramble_ cmcs_station_ctl_$attach cmcs_station_ctl_$detach cmcs_station_ctl_$validate cmcs_terminal_ctl_$find cmcs_tree_ctl_$find_qual_name cmcs_wait_ctl_$clear_mp cmcs_wait_ctl_$mp_available cmcs_wait_ctl_$mp_login cmcs_wait_ctl_$mp_logout cmcs_wait_ctl_$start_mp cmcs_wait_ctl_$stop_mp cobol_mcs_$accept cobol_mcs_$disable_input_queue cobol_mcs_$disable_input_terminal cobol_mcs_$disable_output cobol_mcs_$enable_input_queue cobol_mcs_$enable_input_terminal cobol_mcs_$enable_output cobol_mcs_$purge cobol_mcs_$send cobol_mcs_$set_user_ctl_exists_sw cobol_mcs_$stop_run com_err_ cu_$arg_count cu_$arg_ptr cu_$cp expand_pathname_ get_process_id_ get_temp_segments_ get_wdir_ ioa_ ioa_$rsnnl iox_$attach_name iox_$close iox_$control iox_$detach_iocb iox_$get_line iox_$open ipc_$create_ev_chn ipc_$delete_ev_chn read_password_ release_temp_segments_ timer_manager_$sleep user_info_$absentee_queue user_info_$tty_data THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cmcs_error_table_$bad_password cmcs_error_table_$no_message error_table_$action_not_performed error_table_$long_record error_table_$too_many_args external_user_ctl_ptr iox_$user_input iox_$user_output LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 49 002516 61 002521 37 002524 235 002543 236 002546 238 002550 240 002557 243 002564 246 002565 251 002611 255 002612 258 002637 261 002641 262 002665 265 002666 267 002671 269 002710 272 002712 276 002734 277 002760 283 002762 284 002764 287 002766 288 002774 289 002777 290 003002 291 003004 296 003010 297 003012 299 003024 300 003027 304 003050 305 003052 306 003053 307 003071 309 003073 311 003076 313 003100 314 003110 316 003133 319 003135 320 003140 326 003141 327 003146 328 003150 329 003152 330 003154 331 003156 333 003160 335 003173 337 003174 340 003200 341 003204 344 003206 347 003212 348 003231 351 003233 354 003245 356 003264 358 003266 359 003273 360 003277 361 003301 363 003302 367 003312 370 003314 371 003341 374 003342 377 003345 379 003364 382 003366 383 003373 386 003374 387 003407 389 003411 392 003435 396 003436 397 003445 398 003447 401 003451 403 003464 406 003466 408 003516 411 003517 412 003526 419 003530 422 003535 423 003541 424 003543 425 003547 426 003551 428 003555 430 003576 432 003600 433 003624 436 003625 437 003627 440 003631 445 003636 447 003652 448 003665 453 003670 454 003707 457 003726 461 003732 466 003735 468 003746 470 003750 472 003774 475 003775 476 003777 477 004003 478 004007 481 004013 484 004016 486 004027 488 004031 491 004055 496 004056 498 004062 500 004066 505 004103 508 004105 511 004131 517 004132 520 004136 523 004160 526 004171 530 004217 533 004220 536 004222 537 004225 540 004250 548 004251 550 004254 552 004261 555 004264 557 004267 561 004312 565 004313 570 004373 572 004413 575 004415 577 004454 579 004455 641 004456 649 004471 652 004514 654 004516 657 004521 658 004544 662 004545 663 004570 667 004571 671 004574 673 004601 674 004603 677 004606 680 004607 681 004611 682 004613 684 004616 686 004617 689 004624 690 004633 692 004645 694 004647 695 004657 697 004671 699 004673 701 004674 704 004676 705 004705 707 004717 709 004721 710 004731 712 004743 716 004745 718 005001 721 005002 725 005021 726 005024 728 005026 730 005035 733 005040 734 005065 737 005066 742 005067 748 005102 752 005107 756 005125 758 005132 761 005137 764 005145 767 005161 770 005165 772 005167 774 005210 780 005236 782 005251 787 005277 789 005312 794 005340 796 005351 797 005354 798 005357 800 005364 802 005410 806 005436 808 005445 810 005446 814 005466 816 005470 820 005517 824 005532 829 005533 833 005551 835 005553 837 005554 840 005557 842 005604 847 005605 849 005611 851 005635 854 005637 857 005672 859 005713 865 005714 869 005720 871 005731 874 005733 876 005765 878 005770 885 005771 890 006007 892 006010 894 006011 897 006015 898 006042 901 006043 903 006047 906 006061 907 006063 908 006065 909 006066 912 006076 913 006100 914 006102 917 006103 919 006113 920 006115 922 006117 923 006121 928 006122 929 006147 932 006150 935 006153 936 006157 938 006203 941 006205 942 006240 944 006241 945 006242 948 006246 950 006273 953 006274 956 006300 958 006301 961 006303 962 006332 964 006353 969 006404 971 006430 973 006433 1012 006434 1016 006452 1018 006453 1020 006454 1023 006457 1024 006504 1026 006505 1029 006507 1031 006534 1034 006535 1036 006541 1039 006553 1040 006555 1041 006557 1042 006560 1045 006570 1046 006572 1047 006574 1048 006575 1051 006605 1052 006607 1054 006611 1057 006612 1058 006637 1061 006640 1063 006644 1066 006663 1069 006665 1071 006711 1074 006712 1078 006721 1081 006723 1083 006750 1087 006751 1091 006764 1093 006774 1095 007021 1098 007023 1099 007051 1101 007072 1105 007120 1108 007121 1111 007131 1115 007162 1118 007163 1119 007171 1121 007173 1125 007174 1129 007212 1131 007214 1133 007215 1136 007220 1137 007245 1140 007246 1141 007252 1143 007276 1146 007300 1148 007324 1150 007345 1153 007346 1155 007352 1157 007353 1159 007374 1162 007376 1167 007377 1171 007415 1173 007417 1175 007420 1177 007423 1178 007450 1181 007451 1183 007452 1185 007456 1187 007464 1189 007505 1192 007507 1193 007533 1195 007554 1198 007555 1203 007556 1207 007574 1209 007576 1211 007577 1214 007601 1215 007626 1218 007627 1219 007630 1221 007634 1223 007655 1226 007657 1227 007706 1229 007727 1232 007730 1237 007731 1241 007747 1243 007751 1245 007752 1248 007755 1249 010002 1252 010003 1253 010007 1255 010033 1258 010035 1260 010061 1262 010102 1265 010103 1267 010107 1269 010110 1271 010131 1274 010133 1279 010134 1283 010152 1285 010154 1287 010155 1290 010160 1291 010205 1294 010206 1295 010207 1297 010213 1299 010221 1301 010242 1304 010244 1305 010270 1307 010311 1310 010312 1315 010313 1319 010331 1321 010333 1323 010334 1326 010336 1328 010363 1331 010364 1332 010370 1334 010371 1336 010412 1339 010414 1340 010443 1342 010464 1345 010465 1350 010466 1354 010504 1356 010506 1358 010507 1361 010511 1364 010536 1368 010537 1370 010543 1373 010551 1376 010554 1378 010560 1381 010571 1384 010573 1385 010620 1388 010641 1391 010642 1392 010655 1397 010705 1401 010706 1405 010713 1407 010740 1411 010741 1414 010742 1416 010745 1417 010746 1421 010747 1422 010750 1424 010757 1425 010761 1426 010762 1428 010763 1429 010767 1430 010770 1432 010771 1433 010775 1435 010776 1439 011015 1441 011017 1442 011022 1447 011046 1450 011052 1461 011053 1465 011060 1467 011105 1471 011106 1473 011112 1475 011123 1476 011124 1478 011137 1482 011140 1483 011144 1484 011147 1485 011151 1488 011155 1558 011156 1562 011175 1564 011176 1565 011212 1567 011213 1569 011215 1572 011216 1574 011226 1578 011227 1581 011246 1583 011250 1589 011251 1593 011270 1595 011277 1597 011301 1600 011316 1604 011317 1608 011350 1610 011367 1615 011370 1618 011371 1620 011414 1624 011415 1627 011424 1630 011452 1636 011453 1639 011462 1642 011510 1648 011511 1651 011520 1654 011546 1659 011547 1666 011571 1668 011607 1671 011635 1932 011636 1935 011645 1936 011650 594 011651 598 011652 606 011654 608 011671 611 011721 615 011723 618 011724 620 011725 622 011726 626 011727 627 011731 628 011733 629 011735 632 011741 633 011745 634 011746 637 011752 975 011753 982 011754 985 011755 988 011756 991 011773 995 011776 997 012000 1001 012013 1005 012014 1006 012016 1008 012017 1490 012020 1494 012021 1497 012025 1498 012032 1500 012033 1507 012035 1510 012043 1513 012044 1521 012150 1524 012152 1527 012175 1530 012176 1531 012202 1533 012203 1537 012204 1539 012206 1542 012217 1544 012220 1546 012221 1550 012222 1552 012247 1677 012250 1680 012251 1683 012253 1684 012254 1685 012256 1686 012260 1689 012261 1690 012263 1693 012265 1699 012266 1702 012267 1705 012272 1708 012274 1709 012275 1710 012277 1711 012301 1712 012302 1714 012304 1720 012305 1725 012307 1727 012310 1728 012315 1730 012317 1736 012320 1739 012321 1741 012322 1743 012333 1746 012346 1749 012347 1750 012350 1751 012354 1752 012360 1753 012361 1755 012362 1757 012367 1760 012403 1762 012407 1764 012411 1765 012412 1767 012414 1770 012416 1771 012420 1773 012421 1776 012422 1777 012425 1779 012430 1781 012432 1783 012440 1785 012441 1791 012442 1794 012443 1796 012452 1800 012457 1802 012461 1804 012502 1805 012506 1806 012510 1807 012512 1809 012515 1815 012516 1818 012517 1821 012521 1823 012541 1825 012561 1828 012565 1830 012612 1834 012613 1837 012624 1841 012634 1843 012660 1846 012661 1847 012662 1850 012663 1853 012707 1856 012710 1862 012711 1867 012713 1868 012714 1870 012715 1872 012725 1873 012727 1875 012734 1877 012747 1880 012751 1881 012753 1882 013002 1885 013003 1886 013004 1888 013012 1890 013014 1893 013016 1895 013045 1898 013046 1899 013056 1901 013057 1906 013060 1910 013061 1913 013111 1916 013112 1917 013123 1919 013127 1922 013131 1923 013142 1925 013146 1927 013150 ----------------------------------------------------------- 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