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 1019.8 mst Wed Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 6* * * 7* *********************************************************** */ 8 9 10 11 12 /****^ HISTORY COMMENTS: 13* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060), 14* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 15* MCR8060 cobol_mcs_.pl1 Reformatted code to new Cobol standard. 16* END HISTORY COMMENTS */ 17 18 19 /* Modified on 06/08/81 by FCH, [4.4-2], code "60" returned, BUG468 */ 20 /* Modified on 03/03/81 by FCH, [4.4-1], once per process initialization, BUG468 */ 21 /* Modified since Version 4.3 */ 22 23 /* format: style3 */ 24 cobol_mcs_: 25 proc; 26 27 dcl a_input_cdp ptr, 28 a_output_cdp ptr, 29 a_code fixed bin (35), 30 a_rcv_type fixed bin, 31 a_slew_ctl bit (36), 32 a_buffer_ptr ptr, 33 a_char_buffer_len char (4), 34 a_char_max_buffer_len 35 char (4), 36 a_bin_buffer_len fixed bin, 37 a_char_delim char (1), 38 a_sw bit (1) aligned, /* flag for set/get user_ctl_exists_sw */ 39 a_password char (*); 40 41 dcl buffer_len fixed bin, 42 max_buffer_len fixed bin, 43 io_subtype fixed bin, 44 code fixed bin (35), 45 purge_ptr ptr, 46 scrambled_password char (10), 47 password char (10); 48 49 dcl my_name char (10) int static init ("cobol_mcs_"); 50 51 dcl test_sw bit (1) int static init ("0"b); 52 53 dcl (addr, fixed, index, null, substr) 54 builtin; 55 56 dcl (ioa_, com_err_, sub_err_) 57 entry options (variable); /* Both for DEBUG */ 58 59 dcl sub_err_retval fixed bin (35); 60 dcl station_count fixed bin; 61 62 dcl ( 63 error_table_$noentry, 64 error_table_$action_not_performed 65 ) fixed bin (35) external; 66 67 dcl cleanup condition; 68 69 dcl continue_to_signal_ entry (fixed bin (35)); 70 71 /* */ 1 1 /* BEGIN INCLUDE FILE... cmcs_cd_dcls.incl.pl1 */ 1 2 1 3 /* This COBOL MCS include file defines the input and output CD structures 1 4* that are used by the COBOL object program to pass function-specific data 1 5* to the CMCS runtime support package. */ 1 6 1 7 /* Bob May, 6/30/77 */ 1 8 1 9 dcl input_cdp ptr; 1 10 1 11 /* Input CD Structure */ 1 12 1 13 dcl 1 input_cd aligned based (input_cdp), 1 14 1 15 /* Input Header */ 1 16 1 17 2 queue_ptr ptr, 1 18 2 flags, 1 19 (3 io_sw bit (1), /* always "1"b for input cd */ 1 20 3 cobol_sw bit (1), /* always "1"b for COBOL MCS */ 1 21 3 filler bit (34)) unaligned, 1 22 2 last_tree_path, /* for faster lookup only */ 1 23 3 level_names (4) char (12), 1 24 1 25 /* COBOL Input CD */ 1 26 1 27 2 tree_path, 1 28 3 level_names (4) char (12), /* DN 1-4 */ 1 29 (2 msg_date char (6), /* DN 5, YYMMDD */ 1 30 2 msg_time char (8), /* DN 6, HHMMSSTT */ 1 31 2 station_name char (12), /* DN 7 */ 1 32 2 text_len pic "9999", /* DN 8, S.B. pic "9999" */ 1 33 2 text_delim pic "9", /* DN 9, S.B. pic "9" */ 1 34 2 status_key char (2), /* DN 10 */ 1 35 2 msg_count pic "999999") unaligned; /* DN 11, S.B. pic "999999" */ 1 36 1 37 /* */ 1 38 1 39 dcl output_cdp ptr; 1 40 1 41 /* Output CD Structure */ 1 42 1 43 dcl 1 output_cd aligned based (output_cdp), 1 44 1 45 /* Output CD Header */ 1 46 1 47 2 last_station_info_ptr ptr, 1 48 2 flags, 1 49 (3 io_sw bit (1), /* always "0"b for output cd */ 1 50 3 cobol_sw bit (1), /* alays "1"b for COBOL MCS */ 1 51 3 filler bit (34)) unaligned, 1 52 2 bin_max_station_count fixed bin, /* who sets? ---- */ 1 53 2 char_max_station_count pic "9999", /* S.B. pic "9999" */ 1 54 1 55 /* COBOL Output CD */ 1 56 1 57 2 station_count pic "9999", /* DN 1, S.B. pic "9999" */ 1 58 2 text_len pic "9999", /* DN 2, S.B. pic "9999" */ 1 59 2 status_key char (2) unaligned, /* DN 3 */ 1 60 2 dest_table (0 refer (output_cd.bin_max_station_count)) unaligned, 1 61 3 error_key char (1), /* DN 4 */ 1 62 3 station_name char (12); /* DN 5 */ 1 63 1 64 /* Last Station Info */ 1 65 1 66 dcl 1 last_station_info based (output_cd.last_station_info_ptr) aligned, 1 67 2 last_dest (output_cd.bin_max_station_count), 1 68 3 queue_iocbp ptr, 1 69 3 station_name char (12); 1 70 1 71 /* END INCLUDE FILE... cmcs_cd_dcls.incl.pl1 */ 72 2 1 /* BEGIN INCLUDE FILE... cmcs_control_hdr.incl.pl1 */ 2 2 2 3 /* This include file is the 1st part of all cobol_mcs tables */ 2 4 2 5 /* Bob May, 4/30/77 */ 2 6 2 7 dcl control_hdr_len fixed bin int static options (constant) init (32); 2 8 2 9 dcl control_hdr_ptr ptr; 2 10 2 11 dcl 1 control_hdr aligned based (control_hdr_ptr), 2 12 2 lockword bit (36) aligned, /* for process_id */ 2 13 2 version fixed bin, 2 14 2 clock_created fixed bin (71), 2 15 2 author aligned, 2 16 3 group_id char (32), /* person.proj.tag */ 2 17 3 process_id bit (36), 2 18 2 max_size fixed bin (18), /* maximum number of entries seg can hold */ 2 19 2 current_size fixed bin (18), /* index of last active entry */ 2 20 2 entry_count fixed bin (18), /* number of active entries */ 2 21 2 cmcs_control_hdr_filler (16) fixed bin; /* words (17-32) for later expansion */ 2 22 2 23 /* END INCLUDE FILE... cmcs_control_hdr.incl.pl1 */ 73 3 1 /* BEGIN INCLUDE FILE... cmcs_entry_dcls.incl.pl1 */ 3 2 3 3 3 4 3 5 /****^ HISTORY COMMENTS: 3 6* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8087), 3 7* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 3 8* MCR8087 cmcs_entry_dcls.incl.pl1 Shorten wait time for cmcs_station_ctl_. 3 9* END HISTORY COMMENTS */ 3 10 3 11 3 12 /* Entry declarations for the COBOL MCS runtime support package */ 3 13 3 14 /* Modified on 10/20/84 by FCH, [5.3-1] */ 3 15 /* Modified on 04/29/81 by FCH, [4.4-1] */ 3 16 /* Bob May, 6/01/77 */ 3 17 3 18 dcl cmcs_create_queues_ entry (fixed bin (35)); 3 19 3 20 dcl cmcs_date_time_ entry (fixed bin (71), char (6) unaligned, char (8) unaligned); 3 21 3 22 dcl cmcs_decode_status_ entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35)); 3 23 3 24 dcl cmcs_expand_tree_path_ entry (char (*), char (48), fixed bin (35)); 3 25 3 26 dcl cmcs_fillin_hdr_ entry (ptr, fixed bin, fixed bin, fixed bin, fixed bin (35)); 3 27 3 28 dcl cmcs_initiate_ctl_ entry (char (*), ptr, fixed bin (35)); 3 29 3 30 dcl cmcs_print_ entry (ptr, ptr, fixed bin (35), ptr, fixed bin (35)); 3 31 3 32 dcl cmcs_purge_queues_ entry (fixed bin, bit (1), fixed bin (35)); 3 33 3 34 dcl cmcs_queue_ctl_$accept_message_count entry (ptr, fixed bin, fixed bin (35)); 3 35 dcl cmcs_queue_ctl_$disable entry (ptr, fixed bin, char (10), fixed bin (35)); 3 36 dcl cmcs_queue_ctl_$enable entry (ptr, fixed bin, char (10), fixed bin (35)); 3 37 dcl cmcs_queue_ctl_$print entry (ptr, fixed bin, ptr, fixed bin (35)); 3 38 dcl cmcs_queue_ctl_$purge entry (ptr, fixed bin, fixed bin (35)); 3 39 dcl cmcs_queue_ctl_$receive entry (ptr, fixed bin, ptr, fixed bin, fixed bin (35)); 3 40 dcl cmcs_queue_ctl_$send entry (ptr, fixed bin, ptr, fixed bin, fixed bin, bit (36), fixed bin (35)); 3 41 dcl cmcs_queue_ctl_$stop_run entry (fixed bin, fixed bin (35)); 3 42 3 43 dcl cmcs_scramble_ entry (char (10)) returns (char (10)); 3 44 3 45 dcl cmcs_set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35)); /*[5.3-1]*/ 3 46 dcl cmcs_set_lock_$unlock entry (bit (36) aligned, fixed bin (35)); 3 47 3 48 dcl cmcs_station_ctl_$attach entry (char (12), fixed bin, fixed bin (35)); 3 49 dcl cmcs_station_ctl_$detach entry (fixed bin, fixed bin (35)); 3 50 dcl cmcs_station_ctl_$detach_name entry (char (12), fixed bin (35)); 3 51 dcl cmcs_station_ctl_$disable_input_terminal entry (ptr, char (10), fixed bin (35)); 3 52 dcl cmcs_station_ctl_$disable_output_terminal entry (ptr, char (10), fixed bin (35)); 3 53 dcl cmcs_station_ctl_$enable_input_terminal entry (ptr, char (10), fixed bin (35)); 3 54 dcl cmcs_station_ctl_$enable_output_terminal entry (ptr, char (10), fixed bin (35)); 3 55 dcl cmcs_station_ctl_$find_destination entry (char (12), fixed bin, ptr, fixed bin (35)); /*[4.4-1]*/ 3 56 dcl cmcs_station_ctl_$input_disabled entry (fixed bin, bit (1), fixed bin (35)); 3 57 dcl cmcs_station_ctl_$output_disabled entry (fixed bin, bit (1), fixed bin (35)); 3 58 dcl cmcs_station_ctl_$validate entry (char (12), fixed bin, fixed bin (35)); 3 59 3 60 dcl cmcs_status_list_ctl_$add entry (ptr, ptr, ptr, fixed bin, fixed bin (35)); 3 61 dcl cmcs_status_list_ctl_$delete entry (ptr, ptr, ptr, fixed bin, fixed bin (35)); 3 62 dcl cmcs_status_list_ctl_$move entry (ptr, ptr, ptr, fixed bin, fixed bin, fixed bin (35)); 3 63 3 64 dcl cmcs_terminal_ctl_$find entry (char (8), char (12), fixed bin (35)); 3 65 3 66 dcl cmcs_tree_ctl_$find_destination entry (char (12), fixed bin, ptr, fixed bin (35)); 3 67 dcl cmcs_tree_ctl_$find_index entry (fixed bin, ptr, fixed bin (35)); 3 68 dcl cmcs_tree_ctl_$find_tree_path entry (ptr, fixed bin, fixed bin, ptr, fixed bin (35)); 3 69 dcl cmcs_tree_ctl_$find_qual_name entry (char (12), fixed bin, ptr, char (52), fixed bin (35)); /*[4.4-1]*/ 3 70 3 71 dcl cmcs_wait_ctl_$add entry (char (48), fixed bin, fixed bin (35)); 3 72 dcl cmcs_wait_ctl_$delete entry (fixed bin, fixed bin (35)); 3 73 dcl cmcs_wait_ctl_$find entry (char (48), ptr, fixed bin (35)); 3 74 dcl cmcs_wait_ctl_$mp_available entry (fixed bin, fixed bin, fixed bin (35)); 3 75 dcl cmcs_wait_ctl_$mp_login entry (fixed bin, fixed bin (35)); 3 76 dcl cmcs_wait_ctl_$mp_logout entry (fixed bin, fixed bin (35)); 3 77 dcl cmcs_wait_ctl_$clear_mp entry (fixed bin (35)); 3 78 dcl cmcs_wait_ctl_$start_mp entry (fixed bin (35)); 3 79 dcl cmcs_wait_ctl_$stop_mp entry (fixed bin (35)); 3 80 3 81 /* END INCLUDE FILE... cmcs_entry_dcls.incl.pl1 */ 74 4 1 /* BEGIN INCLUDE FILE... cmcs_error_table_dcls.incl.pl1 */ 4 2 4 3 /* Bob May, 6/30/77 */ 4 4 4 5 dcl (cmcs_error_table_$ambiguous_tree_path, cmcs_error_table_$bad_call_parm, cmcs_error_table_$bad_dest, 4 6 cmcs_error_table_$bad_dest_count, cmcs_error_table_$bad_message_length, 4 7 cmcs_error_table_$bad_password, cmcs_error_table_$bad_queue_path, cmcs_error_table_$bad_slew, 4 8 4 9 cmcs_error_table_$bad_source, cmcs_error_table_$bad_station, 4 10 cmcs_error_table_$bad_term_devchn, cmcs_error_table_$bad_tree_path, 4 11 cmcs_error_table_$dest_already_disabled, cmcs_error_table_$dest_already_enabled, 4 12 4 13 cmcs_error_table_$dest_disabled, cmcs_error_table_$no_message, 4 14 cmcs_error_table_$no_partial_messages, cmcs_error_table_$null_partial_message, 4 15 cmcs_error_table_$queue_already_disabled, cmcs_error_table_$queue_already_enabled, 4 16 4 17 cmcs_error_table_$queue_disabled, cmcs_error_table_$source_already_disabled, 4 18 cmcs_error_table_$source_already_enabled, cmcs_error_table_$source_disabled) fixed bin (35) external; 4 19 4 20 /* END INCLUDE FILE... cmcs_error_table_dcls.incl.pl1 */ 75 5 1 /* BEGIN INCLUDE FILE ... cmcs_queue_ctl.incl.pl1 */ 5 2 5 3 /* This COBOL MCSD include file defines the structure of the cmcs_queue_ctl.control segment. */ 5 4 5 5 /* Bob May, 5/31/77 */ 5 6 5 7 dcl (queue_ctl_hdr_len init (0), 5 8 queue_ctl_entry_len init (48), 5 9 queue_ctl_version init (1)) fixed bin internal static options (constant); 5 10 5 11 dcl queue_ctl_ptr ptr int static; 5 12 5 13 dcl 1 queue_ctl aligned based (queue_ctl_ptr), 5 14 2 hdr like control_hdr, 5 15 2 entries (queue_ctl.current_size) like queue_ctl_entry; 5 16 5 17 dcl queue_ctl_eindex fixed bin; 5 18 5 19 dcl queue_ctl_eptr ptr; 5 20 5 21 dcl 1 queue_ctl_entry aligned based (queue_ctl_eptr), 5 22 2 lockword bit (36) aligned, 5 23 2 tree_ctl_eindex fixed bin, /* index of corresponding entry in tree_ctl */ 5 24 2 tree_path, 5 25 3 level_names (4) char (12), 5 26 2 queue_name char (32), /* includes suffix */ 5 27 2 msg_no fixed bin (35), /* always increasing, until reset manually */ 5 28 2 flags, 5 29 (3 input_disabled_sw bit (1), 5 30 3 mp_entered_sw bit (1), 5 31 3 mp_active_sw bit (1), 5 32 3 mp_sw bit (1), 5 33 3 cmd_sw bit (1), 5 34 3 filler bit (31)) unaligned, 5 35 2 filler (10) fixed bin (35), 5 36 2 mp_lockword bit (36) aligned, /* process_id of message processor */ 5 37 2 status_lists_lockword bit (36) aligned, /* only to manipulate the status lists */ 5 38 2 status_list_ctl_entries (4) like status_list_ctl_entry; /* everything belonging to this queue */ 5 39 5 40 dcl status_list_ctl_eindex fixed bin; 5 41 5 42 dcl status_list_ctl_eptr ptr; 5 43 5 44 dcl 1 status_list_ctl_entry aligned based (status_list_ctl_eptr), 5 45 2 count fixed bin, 5 46 2 descrs, 5 47 3 f_descr like vfile_descr, 5 48 3 b_descr like vfile_descr; 5 49 5 50 /* END INCLUDE FILE ... cmcs_queue_ctl.incl.pl1 */ 76 6 1 /* BEGIN INCLUDE FILE... cmcs_station_ctl.incl.pl1 */ 6 2 6 3 /* This include file defines the station control structure for COBOL MCS */ 6 4 6 5 /* Bob May, 5/31/77 */ 6 6 6 7 dcl (station_ctl_hdr_len init (0), /* no special fields in hdr */ 6 8 station_ctl_entry_len init (6), 6 9 station_ctl_version init (1)) fixed bin int static options (constant); 6 10 6 11 dcl station_ctl_ptr ptr int static; 6 12 6 13 dcl 1 station_ctl aligned based (station_ctl_ptr), 6 14 2 hdr like control_hdr, 6 15 2 entries (station_ctl.current_size) like station_ctl_entry; 6 16 6 17 dcl station_ctl_eindex fixed bin; 6 18 6 19 dcl station_ctl_eptr ptr; 6 20 6 21 dcl 1 station_ctl_entry aligned based (station_ctl_eptr), 6 22 2 station_name char (12), 6 23 2 lockword bit (36) aligned, /* owner process_id */ 6 24 2 flags, 6 25 (3 inactive_sw bit (1), /* station is currently not legal to use */ 6 26 3 destination_sw bit (1), /* station attached as a destination */ 6 27 3 input_disabled_sw bit (1), /* if terminal, can't input */ 6 28 3 output_disabled_sw bit (1), /* if terminal, can't get output */ 6 29 3 filler bit (32)) unaligned, 6 30 2 filler fixed bin; 6 31 6 32 /* END INCLUDE FILE... cmcs_station_ctl.incl.pl1 */ 77 7 1 /* BEGIN INCLUDE FILE ... cmcs_system_ctl.incl.pl1 */ 7 2 7 3 /* 7 4* This COBOL MCS include file holds all the COBOL MCS system-wide parameters. 7 5**/ 7 6 7 7 /* Bob May, 5/31/77 */ 7 8 7 9 dcl (system_ctl_hdr_len init (32), 7 10 system_ctl_entry_len init (0), 7 11 system_ctl_version init (1)) fixed bin internal static options (constant); 7 12 7 13 dcl system_ctl_ptr ptr int static; 7 14 7 15 dcl 1 system_ctl aligned based (system_ctl_ptr), 7 16 2 hdr like control_hdr, 7 17 2 flags, 7 18 (3 mp_started_sw bit (1), 7 19 3 filler bit (35)) unaligned, 7 20 2 mp_started_count fixed bin, /* zero for this version */ 7 21 2 mp_active_count fixed bin, /* number that have logged in so far, less the logouts */ 7 22 2 password char (10), /* scrambled password for all cmcs functions */ 7 23 2 lock_wait_time fixed bin, /* number of seconds to wait before giving up */ 7 24 2 filler (25) fixed bin (35); 7 25 7 26 /* END INCLUDE FILE ... cmcs_system_ctl.incl.pl1 */ 78 8 1 /* BEGIN INCLUDE FILE ... cmcs_tree_ctl.incl.pl1 */ 8 2 8 3 /* 8 4* This COBOL MCS include file defines the sstructure used for accessing 8 5* the MCS queue hierarchy and controlling message I/O for each entry. 8 6**/ 8 7 8 8 /* Bob May, 5/31/77 */ 8 9 8 10 dcl (tree_ctl_hdr_len init (32), 8 11 tree_ctl_entry_len init (144), /* 136, plus fudge for ptr alignments */ 8 12 tree_ctl_version init (1)) fixed bin internal static options (constant); 8 13 8 14 dcl tree_ctl_ptr ptr int static; 8 15 8 16 dcl 1 tree_ctl aligned based (tree_ctl_ptr), 8 17 2 hdr like control_hdr, 8 18 2 queue_count fixed bin, /* total of queue entries for hierarchy */ 8 19 2 filler (31) fixed bin (35), 8 20 2 entries (tree_ctl.current_size) like tree_ctl_entry; 8 21 8 22 dcl tree_ctl_eindex fixed bin; 8 23 8 24 dcl tree_ctl_eptr ptr; 8 25 8 26 dcl 1 tree_ctl_entry aligned based (tree_ctl_eptr), 8 27 2 level_info, /* len = 15 */ 8 28 3 tree_path, 8 29 4 level_names (4) char (12), 8 30 3 entry_flags, 8 31 (4 inactive_sw bit (1), 8 32 4 cmd_sw bit (1), 8 33 4 mp_sw bit (1), 8 34 /* switch separator */ 8 35 4 cobol_program_id_sw bit (1), 8 36 4 queue_sw bit (1), 8 37 4 filler bit (31)) unaligned, 8 38 3 level_no fixed bin, /* level within the hierarchy */ 8 39 3 subtree_count fixed bin, 8 40 2 static_queue_info, /* len = 9 */ 8 41 3 queue_name char (32), /* without the .cmcs_queue suffix */ 8 42 3 queue_ctl_eindex fixed bin, /* to compute addr of table entry */ 8 43 2 command_info, /* len = 75 */ 8 44 3 cmd_line_len fixed bin, 8 45 3 cmd_line char (128), 8 46 3 mp_line_len fixed bin, 8 47 3 mp_line char (128), 8 48 3 cobol_program_id_len fixed bin, 8 49 3 cobol_program_id char (32), 8 50 2 io_info, /* len = 37, sum of all level 3s */ 8 51 3 io_flags, /* len = 1 */ 8 52 (4 io_in_process_sw bit (1), 8 53 4 partial_in_process_sw bit (1), 8 54 4 rcv_wait_sw bit (1), 8 55 /* switch separator */ 8 56 4 rcv_msg_sw bit (1), /* on if user did a receive msg */ 8 57 4 rcv_seg_sw bit (1), /* on if user did a receive seg */ 8 58 4 filler bit (31)) unaligned, 8 59 3 dynamic_queue_info, /* len = 13 */ 8 60 4 switch_name char (32) unaligned, 8 61 4 queue_ctl_eptr ptr, 8 62 4 iocb_ptr ptr, 8 63 4 vfile_status fixed bin, /* 0 - not active/detached */ 8 64 /* 1 - attached, but not open */ 8 65 /* 2 - open */ 8 66 3 msg_hdr_info, /* len = 9 */ 8 67 4 msg_hdr_ptr ptr, /* ptr to base of current msg */ 8 68 4 io_type fixed bin, 8 69 4 io_subtype fixed bin, 8 70 4 seg_count fixed bin (35), /* total no of msg segments */ 8 71 4 msg_len fixed bin (35), /* total msg length (sum of all segments) */ 8 72 4 msg_descr like vfile_descr, 8 73 4 msg_key, 8 74 5 msg_no fixed bin (35), 8 75 5 seg_no fixed bin (35), 8 76 3 tseg_info, /* len = 3 */ 8 77 4 tseg_ptr ptr, /* temp seg to build segment */ 8 78 4 tseg_len fixed bin (35), 8 79 3 msg_seg_info, /* len = 6 */ 8 80 4 msg_seg_ptr ptr, /* ptr to base of current msg_seg */ 8 81 4 msg_seg_descr like vfile_descr, 8 82 4 msg_seg_len fixed bin (35), 8 83 4 msg_seg_left_index fixed bin (35), 8 84 4 msg_seg_left_len fixed bin (35), 8 85 3 buffer_info, /* len = 5 */ 8 86 4 buffer_ptr ptr, 8 87 4 buffer_len fixed bin (35), 8 88 4 buffer_left_index fixed bin (35), 8 89 4 buffer_left_len fixed bin (35); 8 90 8 91 /* END INCLUDE FILE ... cmcs_tree_ctl.incl.pl1 */ 79 9 1 /* BEGIN INCLUDE FILE ... cmcs_user_ctl.incl.pl1 */ 9 2 9 3 /* 9 4* This COBOL MCS include file defines the global, process-dependent variables that are 9 5* not part of the PD copy of cmcs_tree_ctl.control. 9 6**/ 9 7 9 8 /* Modified on 05/06/81 by FCH, [4.4-1], attach command */ 9 9 /* Bob May, 5/31/77 */ 9 10 9 11 dcl user_ctl_exists_sw bit (1) aligned int static init ("0"b); /* indicates legitimacy of external_user_ctl_ptr */ 9 12 9 13 dcl external_user_ctl_ptr ptr external; /* global ptr for user_ctl */ 9 14 9 15 dcl user_ctl_ptr ptr int static; 9 16 9 17 dcl 1 user_ctl aligned based (user_ctl_ptr), 9 18 9 19 /* Flags */ 9 20 9 21 2 init_sw, 9 22 3 terminal_ctl bit(1), 9 23 3 tree_ctl bit(1), 9 24 3 status_list_ctl bit(1), 9 25 3 station_ctl bit(1), 9 26 3 queue_ctl bit(1), 9 27 3 set_lock bit(1), 9 28 3 wait_ctl bit(1), 9 29 3 purge_queues bit(1), 9 30 3 create_queues bit(1), 9 31 3 initiate_ctl bit(1), 9 32 3 mcs bit(1), 9 33 2 flags, 9 34 (3 initialized_sw bit (1), 9 35 3 interactive_sw bit (1), 9 36 3 mp_sw bit (1), /* message processor process */ 9 37 3 terminal_sw bit (1), /* user terminal process */ 9 38 3 admin_sw bit (1), /* cobol_mcs_admin */ 9 39 3 attach_bit bit(1), /*[4.4-1]*/ 9 40 3 rec bit(1), /*[4.4-1]*/ 9 41 3 filler bit (29)) unaligned, 9 42 2 cmcs_dir char (168), 9 43 2 output_file char(168), /*[4.4-1]*/ 9 44 2 station_name char (12), /* current station */ 9 45 2 station_ctl_eindex fixed bin, /* current station */ 9 46 2 process_id bit (36), 9 47 2 process_type fixed bin, /* 0 - not defined, 1 - MP, 2 - terminal, 3 - admin */ 9 48 2 filler fixed bin (35), /* to explicitly align ptrs */ 9 49 2 control_ptrs, 9 50 3 queue_ctl_ptr ptr, 9 51 3 iocb_ptr ptr, /*[4.4-1]*/ 9 52 3 station_ctl_ptr ptr, 9 53 3 system_ctl_ptr ptr, 9 54 3 terminal_ctl_ptr ptr, 9 55 3 tree_ctl_ptr ptr, 9 56 3 wait_ctl_ptr ptr, 9 57 3 filler_ptrs (4) ptr, 9 58 2 terminal_info, 9 59 3 term_id char (4), 9 60 3 term_type fixed bin, 9 61 3 term_channel char (8), 9 62 2 last_receive_info, 9 63 3 tree_path char (48), 9 64 3 tree_ctl_eindex fixed bin, 9 65 3 tree_ctl_eptr ptr, 9 66 2 last_send_info, 9 67 3 dest_name char (12), 9 68 3 tree_ctl_eindex fixed bin, 9 69 3 tree_ctl_eptr ptr, 9 70 2 station_info, 9 71 3 station_count fixed bin, /* must be 1 for phase 1 */ 9 72 3 station_entries (2), 9 73 4 station_name char (12), 9 74 4 station_ctl_eptr ptr, 9 75 4 station_ctl_eindex fixed bin, 9 76 2 wait_info, 9 77 3 wait_ctl_eptr ptr, 9 78 3 wait_ctl_eindex fixed bin, 9 79 3 wait_ctl_mp_eindex fixed bin, /* only for message processors */ 9 80 3 wait_ctl_mp_eptr ptr, 9 81 3 ev_wait_chn fixed bin (71), /* for message processors */ 9 82 3 ev_call_chn fixed bin (71), /* for terminals, to get message responses */ 9 83 3 ev_wait_list_ptr ptr, /* for ipc_$block */ 9 84 3 ev_info_ptr ptr; /* for wakeup */ 9 85 9 86 /* END INCLUDE FILE ... cmcs_user_ctl.incl.pl1 */ 80 10 1 /* BEGIN INCLUDE FILE... cmcs_vfile_rs.incl.pl1 */ 10 2 10 3 /* This COBOL MCS include file is used to reference records by their 10 4* vfile_ descriptors. It is used mainly in the maintenance of 10 5* message status lists. */ 10 6 10 7 /* Bob May, 6/30/77 */ 10 8 10 9 dcl vfile_rs_version fixed bin int static options (constant) init (1); 10 10 10 11 dcl vfile_rs_ptr ptr; 10 12 10 13 dcl 1 vfile_rs aligned based (vfile_rs_ptr), 10 14 2 version fixed bin, /* currently must be set to 1 */ 10 15 2 flags, 10 16 (3 lock_sw bit (1), /* "1"b */ 10 17 3 unlock_sw bit (1), /* "1"b */ 10 18 3 create_sw bit (1), /* "0"b */ 10 19 /* switch separator */ 10 20 3 locate_sw bit (1), /* "0"b for current_rec, "1"b to use descriptor */ 10 21 3 filler bit (32)) unaligned, /* (32) "0"b */ 10 22 2 rec_len fixed bin (21), 10 23 2 max_rec_len fixed bin (21), 10 24 2 rec_ptr ptr, 10 25 2 descr like vfile_descr, /* process INdependent addressing */ 10 26 2 filler fixed bin; /* 0 */ 10 27 10 28 dcl 1 vfile_descr, /* process INdependent addressing */ 10 29 (2 comp_no fixed bin (17), /* component of MSF */ 10 30 2 comp_offset bit (18)) unaligned; /* offset of record in component */ 10 31 10 32 /* END INCLUDE FILE... cmcs_vfile_rs.incl.pl1 */ 81 82 83 /* %include cmcs_wait_ctl; */ 84 85 /* */ 86 87 accept: 88 entry (a_input_cdp, a_code); 89 90 /*[4.4-1]*/ 91 if ^(external_user_ctl_ptr -> user_ctl.init_sw.mcs) 92 then call setup; 93 94 io_subtype = 1; /* and in this case only, only 1 */ 95 96 call cmcs_queue_ctl_$accept_message_count (a_input_cdp, io_subtype, a_code); 97 return; 98 99 100 /* */ 101 102 receive: 103 entry (a_input_cdp, a_rcv_type, a_buffer_ptr, a_bin_buffer_len, a_code); 104 105 /*[4.4-1]*/ 106 if ^(external_user_ctl_ptr -> user_ctl.init_sw.mcs) 107 then call setup; 108 109 if a_rcv_type = 0 110 then io_subtype = 2; /* convert to std form, 0 input = message, no wait */ 111 else if a_rcv_type = 1 112 then io_subtype = 1; /* 1 input = segment, no wait */ 113 114 call cmcs_queue_ctl_$receive (a_input_cdp, io_subtype, a_buffer_ptr, a_bin_buffer_len, a_code); 115 return; 116 117 118 /* */ 119 120 receive_wait: 121 entry (a_input_cdp, a_rcv_type, a_buffer_ptr, a_bin_buffer_len, a_code); 122 123 /*[4.4-1]*/ 124 if ^(external_user_ctl_ptr -> user_ctl.init_sw.mcs) 125 then call setup; 126 127 if a_rcv_type = 0 128 then io_subtype = 4; /* convert to std form, 0 input = message (wait) */ 129 else if a_rcv_type = 1 130 then io_subtype = 3; /* 1 input = segment (wait) */ 131 132 call cmcs_queue_ctl_$receive (a_input_cdp, io_subtype, a_buffer_ptr, a_bin_buffer_len, a_code); 133 return; 134 135 136 /* */ 137 138 send: 139 entry (a_output_cdp, a_buffer_ptr, a_char_max_buffer_len, a_char_delim, a_slew_ctl, a_code); 140 141 /*[4.4-1]*/ 142 if ^(external_user_ctl_ptr -> user_ctl.init_sw.mcs) 143 then call setup; 144 145 io_subtype = index ("0123", a_char_delim) - 1; 146 147 if io_subtype < 0 /* not 0-3 */ 148 then io_subtype = 0; 149 150 output_cdp = a_output_cdp; 151 152 buffer_len = output_cd.text_len; 153 max_buffer_len = fixed (a_char_max_buffer_len, 17); 154 155 /*[4.4-2]*/ 156 if io_subtype = 0 & (buffer_len = 0 | a_buffer_ptr = null ()) 157 then do; 158 159 output_cd.status_key = "60"; 160 a_code = cmcs_error_table_$null_partial_message; 161 return; 162 end; 163 164 165 if buffer_len > max_buffer_len 166 then do; 167 168 a_code = cmcs_error_table_$bad_message_length; 169 output_cd.status_key = "50"; 170 return; 171 end; 172 173 output_cd.bin_max_station_count = output_cd.char_max_station_count; 174 station_count = output_cd.station_count; 175 176 if output_cd.bin_max_station_count < station_count | station_count = 0 177 then do; 178 179 output_cd.status_key = "30"; 180 a_code = cmcs_error_table_$bad_dest_count; 181 return; 182 end; 183 184 /* The following call uses parameters different than those passed to cobol_mcs_. Specifically, buffer_len and 185* station_count are used instead of max_buffer_len (and nothing). Since the validity checks are done here, there is 186* no reason that we must continue passing character representations of numeric data. */ 187 188 call cmcs_queue_ctl_$send (a_output_cdp, io_subtype, a_buffer_ptr, buffer_len, station_count, a_slew_ctl, 189 a_code); 190 191 return; 192 193 194 /* */ 195 196 purge: 197 entry (a_output_cdp, a_code); /* CODASYL PURGE, sends only */ 198 199 /*[4.4-1]*/ 200 if ^(external_user_ctl_ptr -> user_ctl.init_sw.mcs) 201 then call setup; 202 203 if a_output_cdp ^= null () 204 then do; 205 206 output_cdp = a_output_cdp; 207 output_cd.bin_max_station_count = output_cd.char_max_station_count; 208 station_count = output_cd.station_count; 209 210 if (output_cd.bin_max_station_count < station_count) | station_count = 0 211 then do; 212 213 output_cd.status_key = "30"; 214 a_code = cmcs_error_table_$bad_dest_count; 215 return; 216 end; 217 end; 218 219 io_subtype = 1; /* sends only, per CODASYL */ 220 221 call cmcs_queue_ctl_$purge (a_output_cdp, io_subtype, a_code); 222 223 return; 224 225 226 /* */ 227 228 enable_input_queue: 229 entry (a_input_cdp, a_password, a_code); 230 231 /*[4.4-1]*/ 232 if ^(external_user_ctl_ptr -> user_ctl.init_sw.mcs) 233 then call setup; 234 235 call check_password; /* also gets fixed size password */ 236 237 if a_code ^= 0 238 then do; 239 240 input_cdp = a_input_cdp; 241 input_cd.status_key = "40"; 242 return; 243 end; 244 245 io_subtype = 1; 246 247 call cmcs_queue_ctl_$enable (a_input_cdp, io_subtype, password, a_code); 248 return; 249 250 251 /* */ 252 253 disable_input_queue: 254 entry (a_input_cdp, a_password, a_code); 255 256 /*[4.4-1]*/ 257 if ^(external_user_ctl_ptr -> user_ctl.init_sw.mcs) 258 then call setup; 259 260 call check_password; /* also gets fixed size password */ 261 262 if a_code ^= 0 263 then do; 264 265 input_cdp = a_input_cdp; 266 input_cd.status_key = "40"; 267 return; 268 end; 269 270 io_subtype = 1; 271 272 call cmcs_queue_ctl_$disable (a_input_cdp, io_subtype, password, a_code); 273 274 return; 275 276 277 /* */ 278 279 enable_input_terminal: 280 entry (a_input_cdp, a_password, a_code); 281 282 /*[4.4-1]*/ 283 if ^(external_user_ctl_ptr -> user_ctl.init_sw.mcs) 284 then call setup; 285 286 call check_password; /* also gets fixed size password */ 287 288 if a_code ^= 0 289 then do; 290 291 input_cdp = a_input_cdp; 292 input_cd.status_key = "40"; 293 return; 294 end; 295 296 io_subtype = 2; 297 298 call cmcs_station_ctl_$enable_input_terminal (a_input_cdp, password, a_code); 299 300 return; 301 302 303 /* */ 304 305 disable_input_terminal: 306 entry (a_input_cdp, a_password, a_code); 307 308 /*[4.4-1]*/ 309 if ^(external_user_ctl_ptr -> user_ctl.init_sw.mcs) 310 then call setup; 311 312 call check_password; /* also gets fixed size password */ 313 314 if a_code ^= 0 315 then do; 316 317 input_cdp = a_input_cdp; 318 input_cd.status_key = "40"; 319 return; 320 end; 321 322 io_subtype = 2; 323 324 call cmcs_station_ctl_$disable_input_terminal (a_input_cdp, password, a_code); 325 326 return; 327 328 329 /* */ 330 331 enable_output: 332 entry (a_output_cdp, a_password, a_code); 333 334 /*[4.4-1]*/ 335 if ^(external_user_ctl_ptr -> user_ctl.init_sw.mcs) 336 then call setup; 337 338 call check_password; /* also gets fixed size password */ 339 340 if a_code ^= 0 341 then do; 342 343 output_cdp = a_output_cdp; 344 output_cd.status_key = "40"; 345 return; 346 end; 347 348 io_subtype = 3; 349 350 call cmcs_station_ctl_$enable_output_terminal (a_output_cdp, password, a_code); 351 352 353 return; 354 355 356 /* */ 357 358 disable_output: 359 entry (a_output_cdp, a_password, a_code); 360 361 /*[4.4-1]*/ 362 if ^(external_user_ctl_ptr -> user_ctl.init_sw.mcs) 363 then call setup; 364 365 call check_password; /* also gets fixed size password */ 366 367 if a_code ^= 0 368 then do; 369 370 output_cdp = a_output_cdp; 371 output_cd.status_key = "40"; 372 return; 373 end; 374 375 io_subtype = 3; 376 377 call cmcs_station_ctl_$disable_output_terminal (a_output_cdp, password, a_code); 378 379 return; 380 381 ret: /*[4.4-1]*/ 382 return; 383 384 /* */ 385 386 check_password: 387 proc (); 388 389 password = a_password; /* need fixed size */ 390 scrambled_password = cmcs_scramble_ (password); 391 password = ""; /* at least eliminate OUR password visibility */ 392 393 if scrambled_password = system_ctl.password 394 then a_code = 0; 395 else a_code = cmcs_error_table_$bad_password; 396 397 return; 398 399 end /* check_password */; 400 401 402 /* */ 403 404 stop_run: 405 entry (); 406 407 if ^(external_user_ctl_ptr -> user_ctl.init_sw.mcs) 408 then return; /* temporary test to see if user doesn't use cmcs */ 409 410 call cmcs_queue_ctl_$stop_run (1, code); 411 412 if code ^= 0 413 then call sub_err_ (code, my_name, "c", null (), sub_err_retval, 414 "From purge (and queue detach) initiated by stop_run."); 415 416 return; 417 418 /* end of stop_run entrypoint */ 419 420 421 cleanup_handler: 422 call sub_err_ (0, my_name, "c", null (), sub_err_retval, 423 "The cleanup condition was detected. A stop_run will be simulated."); 424 425 call cmcs_queue_ctl_$stop_run (1, code); 426 427 if code ^= 0 428 then call sub_err_ (code, my_name, "c", null (), sub_err_retval, 429 "From purge (and queue detach) initiated by stop_run."); 430 431 call continue_to_signal_ (code); 432 433 if code ^= 0 434 then call sub_err_ (code, my_name, "c", null (), sub_err_retval, 435 "From attempt to continue signalling up the stack. Continuing."); 436 return; 437 438 /* end of cleanup_handler code */ 439 440 /* */ 441 setup: 442 proc; 443 444 if user_ctl_exists_sw /* must be running in the proper environment */ 445 then do; 446 447 user_ctl_ptr = external_user_ctl_ptr; /* set local variable from global */ 448 449 queue_ctl_ptr = user_ctl.queue_ctl_ptr; 450 station_ctl_ptr = user_ctl.station_ctl_ptr; 451 system_ctl_ptr = user_ctl.system_ctl_ptr; 452 terminal_ctl_ptr = user_ctl.terminal_ctl_ptr; 453 tree_ctl_ptr = user_ctl.tree_ctl_ptr; 454 wait_ctl_ptr = user_ctl.wait_ctl_ptr; 455 456 on cleanup go to cleanup_handler; 457 458 user_ctl.init_sw.mcs = "1"b; 459 a_code = 0; 460 461 end; 462 else do; 463 464 a_code = error_table_$action_not_performed; 465 call sub_err_ (a_code, my_name, "c", null (), sub_err_retval, 466 "Private COBOL application programs using CMCS must be run under the cobol_mcs command (execute request). Please consult with your CMCS Administrator on procedures." 467 ); 468 469 go to ret; 470 end; 471 472 end /* setup */; 473 474 /* */ 475 476 test: 477 entry (); 478 479 test_sw = "1"b; 480 return; 481 482 /* */ 483 484 set_user_ctl_exists_sw: 485 entry (a_sw); 486 487 user_ctl_exists_sw = a_sw; 488 return; 489 490 /* */ 491 492 get_user_ctl_exists_sw: 493 entry (a_sw); 494 495 a_sw = user_ctl_exists_sw; 496 return; 497 498 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 72 1 03/27/82 0439.5 cmcs_cd_dcls.incl.pl1 >ldd>include>cmcs_cd_dcls.incl.pl1 73 2 03/27/82 0439.5 cmcs_control_hdr.incl.pl1 >ldd>include>cmcs_control_hdr.incl.pl1 74 3 05/24/89 0811.5 cmcs_entry_dcls.incl.pl1 >spec>install>MR12.3-1048>cmcs_entry_dcls.incl.pl1 75 4 03/27/82 0439.5 cmcs_error_table_dcls.incl.pl1 >ldd>include>cmcs_error_table_dcls.incl.pl1 76 5 03/27/82 0439.5 cmcs_queue_ctl.incl.pl1 >ldd>include>cmcs_queue_ctl.incl.pl1 77 6 03/27/82 0439.6 cmcs_station_ctl.incl.pl1 >ldd>include>cmcs_station_ctl.incl.pl1 78 7 03/27/82 0439.6 cmcs_system_ctl.incl.pl1 >ldd>include>cmcs_system_ctl.incl.pl1 79 8 03/27/82 0439.6 cmcs_tree_ctl.incl.pl1 >ldd>include>cmcs_tree_ctl.incl.pl1 80 9 03/27/82 0431.5 cmcs_user_ctl.incl.pl1 >ldd>include>cmcs_user_ctl.incl.pl1 81 10 03/27/82 0439.6 cmcs_vfile_rs.incl.pl1 >ldd>include>cmcs_vfile_rs.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. a_bin_buffer_len parameter fixed bin(17,0) dcl 27 set ref 102 114* 120 132* a_buffer_ptr parameter pointer dcl 27 set ref 102 114* 120 132* 138 156 188* a_char_delim parameter char(1) packed unaligned dcl 27 ref 138 145 a_char_max_buffer_len parameter char(4) packed unaligned dcl 27 ref 138 153 a_code parameter fixed bin(35,0) dcl 27 set ref 87 96* 102 114* 120 132* 138 160* 168* 180* 188* 196 214* 221* 228 237 247* 253 262 272* 279 288 298* 305 314 324* 331 340 350* 358 367 377* 393* 395* 459* 464* 465* a_input_cdp parameter pointer dcl 27 set ref 87 96* 102 114* 120 132* 228 240 247* 253 265 272* 279 291 298* 305 317 324* a_output_cdp parameter pointer dcl 27 set ref 138 150 188* 196 203 206 221* 331 343 350* 358 370 377* a_password parameter char packed unaligned dcl 27 ref 228 253 279 305 331 358 389 a_rcv_type parameter fixed bin(17,0) dcl 27 ref 102 109 111 120 127 129 a_slew_ctl parameter bit(36) packed unaligned dcl 27 set ref 138 188* a_sw parameter bit(1) dcl 27 set ref 484 487 492 495* bin_max_station_count 3 based fixed bin(17,0) level 2 dcl 1-43 set ref 173* 176 207* 210 buffer_len 000100 automatic fixed bin(17,0) dcl 41 set ref 152* 156 165 188* char_max_station_count 4 based picture(4) level 2 dcl 1-43 ref 173 207 cleanup 000000 stack reference condition dcl 67 ref 456 cmcs_error_table_$bad_dest_count 000066 external static fixed bin(35,0) dcl 4-5 ref 180 214 cmcs_error_table_$bad_message_length 000070 external static fixed bin(35,0) dcl 4-5 ref 168 cmcs_error_table_$bad_password 000072 external static fixed bin(35,0) dcl 4-5 ref 395 cmcs_error_table_$null_partial_message 000074 external static fixed bin(35,0) dcl 4-5 ref 160 cmcs_queue_ctl_$accept_message_count 000036 constant entry external dcl 3-34 ref 96 cmcs_queue_ctl_$disable 000040 constant entry external dcl 3-35 ref 272 cmcs_queue_ctl_$enable 000042 constant entry external dcl 3-36 ref 247 cmcs_queue_ctl_$purge 000044 constant entry external dcl 3-38 ref 221 cmcs_queue_ctl_$receive 000046 constant entry external dcl 3-39 ref 114 132 cmcs_queue_ctl_$send 000050 constant entry external dcl 3-40 ref 188 cmcs_queue_ctl_$stop_run 000052 constant entry external dcl 3-41 ref 410 425 cmcs_scramble_ 000054 constant entry external dcl 3-43 ref 390 cmcs_station_ctl_$disable_input_terminal 000056 constant entry external dcl 3-51 ref 324 cmcs_station_ctl_$disable_output_terminal 000060 constant entry external dcl 3-52 ref 377 cmcs_station_ctl_$enable_input_terminal 000062 constant entry external dcl 3-53 ref 298 cmcs_station_ctl_$enable_output_terminal 000064 constant entry external dcl 3-54 ref 350 code 000103 automatic fixed bin(35,0) dcl 41 set ref 410* 412 412* 425* 427 427* 431* 433 433* continue_to_signal_ 000034 constant entry external dcl 69 ref 431 control_hdr based structure level 1 dcl 2-11 control_ptrs 150 based structure level 2 dcl 9-17 error_table_$action_not_performed 000032 external static fixed bin(35,0) dcl 62 ref 464 external_user_ctl_ptr 000076 external static pointer dcl 9-13 ref 91 106 124 142 200 232 257 283 309 335 362 407 447 fixed builtin function dcl 53 ref 153 index builtin function dcl 53 ref 145 init_sw based structure level 2 dcl 9-17 input_cd based structure level 1 dcl 1-13 input_cdp 000114 automatic pointer dcl 1-9 set ref 240* 241 265* 266 291* 292 317* 318 io_subtype 000102 automatic fixed bin(17,0) dcl 41 set ref 94* 96* 109* 111* 114* 127* 129* 132* 145* 147 147* 156 188* 219* 221* 245* 247* 270* 272* 296* 322* 348* 375* max_buffer_len 000101 automatic fixed bin(17,0) dcl 41 set ref 153* 165 mcs 12 based bit(1) level 3 dcl 9-17 set ref 91 106 124 142 200 232 257 283 309 335 362 407 458* my_name 000010 internal static char(10) initial packed unaligned dcl 49 set ref 412* 421* 427* 433* 465* null builtin function dcl 53 ref 156 203 412 412 421 421 427 427 433 433 465 465 output_cd based structure level 1 dcl 1-43 output_cdp 000116 automatic pointer dcl 1-39 set ref 150* 152 159 169 173 173 174 176 179 206* 207 207 208 210 213 343* 344 370* 371 password 43 based char(10) level 2 in structure "system_ctl" dcl 7-15 in procedure "cobol_mcs_" ref 393 password 000107 automatic char(10) packed unaligned dcl 41 in procedure "cobol_mcs_" set ref 247* 272* 298* 324* 350* 377* 389* 390* 391* queue_ctl_entry based structure level 1 dcl 5-21 queue_ctl_ptr 150 based pointer level 3 in structure "user_ctl" dcl 9-17 in procedure "cobol_mcs_" ref 449 queue_ctl_ptr 000014 internal static pointer dcl 5-11 in procedure "cobol_mcs_" set ref 449* scrambled_password 000104 automatic char(10) packed unaligned dcl 41 set ref 390* 393 station_count 000113 automatic fixed bin(17,0) dcl 60 in procedure "cobol_mcs_" set ref 174* 176 176 188* 208* 210 210 station_count 5 based picture(4) level 2 in structure "output_cd" dcl 1-43 in procedure "cobol_mcs_" ref 174 208 station_ctl_entry based structure level 1 dcl 6-21 station_ctl_ptr 154 based pointer level 3 in structure "user_ctl" dcl 9-17 in procedure "cobol_mcs_" ref 450 station_ctl_ptr 000016 internal static pointer dcl 6-11 in procedure "cobol_mcs_" set ref 450* status_key 42(27) based char(2) level 2 in structure "input_cd" packed packed unaligned dcl 1-13 in procedure "cobol_mcs_" set ref 241* 266* 292* 318* status_key 7 based char(2) level 2 in structure "output_cd" packed packed unaligned dcl 1-43 in procedure "cobol_mcs_" set ref 159* 169* 179* 213* 344* 371* status_list_ctl_entry based structure level 1 dcl 5-44 sub_err_ 000030 constant entry external dcl 56 ref 412 421 427 433 465 sub_err_retval 000112 automatic fixed bin(35,0) dcl 59 set ref 412* 421* 427* 433* 465* system_ctl based structure level 1 dcl 7-15 system_ctl_ptr 156 based pointer level 3 in structure "user_ctl" dcl 9-17 in procedure "cobol_mcs_" ref 451 system_ctl_ptr 000020 internal static pointer dcl 7-13 in procedure "cobol_mcs_" set ref 393 451* terminal_ctl_ptr 160 based pointer level 3 dcl 9-17 set ref 452* 452 test_sw 000013 internal static bit(1) initial packed unaligned dcl 51 set ref 479* text_len 6 based picture(4) level 2 dcl 1-43 ref 152 tree_ctl_entry based structure level 1 dcl 8-26 tree_ctl_ptr 162 based pointer level 3 in structure "user_ctl" dcl 9-17 in procedure "cobol_mcs_" ref 453 tree_ctl_ptr 000022 internal static pointer dcl 8-14 in procedure "cobol_mcs_" set ref 453* user_ctl based structure level 1 dcl 9-17 user_ctl_exists_sw 000024 internal static bit(1) initial dcl 9-11 set ref 444 487* 495 user_ctl_ptr 000026 internal static pointer dcl 9-15 set ref 447* 449 450 451 452 452 453 454 454 458 vfile_descr 000120 automatic structure level 1 packed packed unaligned dcl 10-28 wait_ctl_ptr 164 based pointer level 3 dcl 9-17 set ref 454* 454 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. a_char_buffer_len automatic char(4) packed unaligned dcl 27 addr builtin function dcl 53 cmcs_create_queues_ 000000 constant entry external dcl 3-18 cmcs_date_time_ 000000 constant entry external dcl 3-20 cmcs_decode_status_ 000000 constant entry external dcl 3-22 cmcs_error_table_$ambiguous_tree_path external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$bad_call_parm external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$bad_dest external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$bad_queue_path external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$bad_slew external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$bad_source external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$bad_station external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$bad_term_devchn external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$bad_tree_path external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$dest_already_disabled external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$dest_already_enabled external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$dest_disabled external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$no_message external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$no_partial_messages external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$queue_already_disabled external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$queue_already_enabled external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$queue_disabled external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$source_already_disabled external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$source_already_enabled external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$source_disabled external static fixed bin(35,0) dcl 4-5 cmcs_expand_tree_path_ 000000 constant entry external dcl 3-24 cmcs_fillin_hdr_ 000000 constant entry external dcl 3-26 cmcs_initiate_ctl_ 000000 constant entry external dcl 3-28 cmcs_print_ 000000 constant entry external dcl 3-30 cmcs_purge_queues_ 000000 constant entry external dcl 3-32 cmcs_queue_ctl_$print 000000 constant entry external dcl 3-37 cmcs_set_lock_$lock 000000 constant entry external dcl 3-45 cmcs_set_lock_$unlock 000000 constant entry external dcl 3-46 cmcs_station_ctl_$attach 000000 constant entry external dcl 3-48 cmcs_station_ctl_$detach 000000 constant entry external dcl 3-49 cmcs_station_ctl_$detach_name 000000 constant entry external dcl 3-50 cmcs_station_ctl_$find_destination 000000 constant entry external dcl 3-55 cmcs_station_ctl_$input_disabled 000000 constant entry external dcl 3-56 cmcs_station_ctl_$output_disabled 000000 constant entry external dcl 3-57 cmcs_station_ctl_$validate 000000 constant entry external dcl 3-58 cmcs_status_list_ctl_$add 000000 constant entry external dcl 3-60 cmcs_status_list_ctl_$delete 000000 constant entry external dcl 3-61 cmcs_status_list_ctl_$move 000000 constant entry external dcl 3-62 cmcs_terminal_ctl_$find 000000 constant entry external dcl 3-64 cmcs_tree_ctl_$find_destination 000000 constant entry external dcl 3-66 cmcs_tree_ctl_$find_index 000000 constant entry external dcl 3-67 cmcs_tree_ctl_$find_qual_name 000000 constant entry external dcl 3-69 cmcs_tree_ctl_$find_tree_path 000000 constant entry external dcl 3-68 cmcs_wait_ctl_$add 000000 constant entry external dcl 3-71 cmcs_wait_ctl_$clear_mp 000000 constant entry external dcl 3-77 cmcs_wait_ctl_$delete 000000 constant entry external dcl 3-72 cmcs_wait_ctl_$find 000000 constant entry external dcl 3-73 cmcs_wait_ctl_$mp_available 000000 constant entry external dcl 3-74 cmcs_wait_ctl_$mp_login 000000 constant entry external dcl 3-75 cmcs_wait_ctl_$mp_logout 000000 constant entry external dcl 3-76 cmcs_wait_ctl_$start_mp 000000 constant entry external dcl 3-78 cmcs_wait_ctl_$stop_mp 000000 constant entry external dcl 3-79 com_err_ 000000 constant entry external dcl 56 control_hdr_len internal static fixed bin(17,0) initial dcl 2-7 control_hdr_ptr automatic pointer dcl 2-9 error_table_$noentry external static fixed bin(35,0) dcl 62 ioa_ 000000 constant entry external dcl 56 last_station_info based structure level 1 dcl 1-66 purge_ptr automatic pointer dcl 41 queue_ctl based structure level 1 dcl 5-13 queue_ctl_eindex automatic fixed bin(17,0) dcl 5-17 queue_ctl_entry_len internal static fixed bin(17,0) initial dcl 5-7 queue_ctl_eptr automatic pointer dcl 5-19 queue_ctl_hdr_len internal static fixed bin(17,0) initial dcl 5-7 queue_ctl_version internal static fixed bin(17,0) initial dcl 5-7 station_ctl based structure level 1 dcl 6-13 station_ctl_eindex automatic fixed bin(17,0) dcl 6-17 station_ctl_entry_len internal static fixed bin(17,0) initial dcl 6-7 station_ctl_eptr automatic pointer dcl 6-19 station_ctl_hdr_len internal static fixed bin(17,0) initial dcl 6-7 station_ctl_version internal static fixed bin(17,0) initial dcl 6-7 status_list_ctl_eindex automatic fixed bin(17,0) dcl 5-40 status_list_ctl_eptr automatic pointer dcl 5-42 substr builtin function dcl 53 system_ctl_entry_len internal static fixed bin(17,0) initial dcl 7-9 system_ctl_hdr_len internal static fixed bin(17,0) initial dcl 7-9 system_ctl_version internal static fixed bin(17,0) initial dcl 7-9 tree_ctl based structure level 1 dcl 8-16 tree_ctl_eindex automatic fixed bin(17,0) dcl 8-22 tree_ctl_entry_len internal static fixed bin(17,0) initial dcl 8-10 tree_ctl_eptr automatic pointer dcl 8-24 tree_ctl_hdr_len internal static fixed bin(17,0) initial dcl 8-10 tree_ctl_version internal static fixed bin(17,0) initial dcl 8-10 vfile_rs based structure level 1 dcl 10-13 vfile_rs_ptr automatic pointer dcl 10-11 vfile_rs_version internal static fixed bin(17,0) initial dcl 10-9 NAMES DECLARED BY EXPLICIT CONTEXT. accept 000166 constant entry external dcl 87 check_password 001731 constant entry internal dcl 386 ref 235 260 286 312 338 365 cleanup_handler 001463 constant label dcl 421 ref 456 cobol_mcs_ 000154 constant entry external dcl 24 disable_input_queue 000772 constant entry external dcl 253 disable_input_terminal 001142 constant entry external dcl 305 disable_output 001307 constant entry external dcl 358 enable_input_queue 000705 constant entry external dcl 228 enable_input_terminal 001057 constant entry external dcl 279 enable_output 001225 constant entry external dcl 331 get_user_ctl_exists_sw 001717 constant entry external dcl 492 purge 000576 constant entry external dcl 196 receive 000232 constant entry external dcl 102 receive_wait 000311 constant entry external dcl 120 ret 001367 constant label dcl 381 ref 469 send 000374 constant entry external dcl 138 set_user_ctl_exists_sw 001702 constant entry external dcl 484 setup 001770 constant entry internal dcl 441 ref 91 106 124 142 200 232 257 283 309 335 362 stop_run 001371 constant entry external dcl 404 test 001666 constant entry external dcl 476 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2560 2660 2127 2570 Length 3346 2127 100 452 430 20 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_mcs_ 308 external procedure is an external procedure. check_password internal procedure shares stack frame of external procedure cobol_mcs_. setup 142 internal procedure enables or reverts conditions. on unit on line 456 64 on unit STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 my_name cobol_mcs_ 000013 test_sw cobol_mcs_ 000014 queue_ctl_ptr cobol_mcs_ 000016 station_ctl_ptr cobol_mcs_ 000020 system_ctl_ptr cobol_mcs_ 000022 tree_ctl_ptr cobol_mcs_ 000024 user_ctl_exists_sw cobol_mcs_ 000026 user_ctl_ptr cobol_mcs_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_mcs_ 000100 buffer_len cobol_mcs_ 000101 max_buffer_len cobol_mcs_ 000102 io_subtype cobol_mcs_ 000103 code cobol_mcs_ 000104 scrambled_password cobol_mcs_ 000107 password cobol_mcs_ 000112 sub_err_retval cobol_mcs_ 000113 station_count cobol_mcs_ 000114 input_cdp cobol_mcs_ 000116 output_cdp cobol_mcs_ 000120 vfile_descr cobol_mcs_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out call_int_this return_mac tra_ext_1 enable_op ext_entry ext_entry_desc int_entry any_to_any_truncate_unpack_picture THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cmcs_queue_ctl_$accept_message_count cmcs_queue_ctl_$disable cmcs_queue_ctl_$enable cmcs_queue_ctl_$purge cmcs_queue_ctl_$receive cmcs_queue_ctl_$send cmcs_queue_ctl_$stop_run cmcs_scramble_ cmcs_station_ctl_$disable_input_terminal cmcs_station_ctl_$disable_output_terminal cmcs_station_ctl_$enable_input_terminal cmcs_station_ctl_$enable_output_terminal continue_to_signal_ sub_err_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cmcs_error_table_$bad_dest_count cmcs_error_table_$bad_message_length cmcs_error_table_$bad_password cmcs_error_table_$null_partial_message error_table_$action_not_performed external_user_ctl_ptr LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 24 000153 87 000161 91 000176 94 000206 96 000210 97 000224 102 000225 106 000244 109 000255 111 000263 114 000267 115 000306 120 000307 124 000323 127 000334 129 000342 132 000346 133 000365 138 000366 142 000406 145 000417 147 000431 150 000433 152 000436 153 000446 156 000462 159 000472 160 000475 161 000500 165 000501 168 000504 169 000507 170 000512 173 000513 174 000524 176 000533 179 000541 180 000543 181 000546 188 000547 191 000573 196 000574 200 000606 203 000617 206 000624 207 000627 208 000637 210 000646 213 000654 214 000656 215 000661 219 000662 221 000664 223 000700 228 000701 232 000723 235 000734 237 000735 240 000737 241 000743 242 000746 245 000747 247 000751 248 000767 253 000770 257 001010 260 001021 262 001022 265 001024 266 001030 267 001033 270 001034 272 001036 274 001054 279 001055 283 001075 286 001106 288 001107 291 001111 292 001115 293 001120 296 001121 298 001123 300 001137 305 001140 309 001160 312 001171 314 001172 317 001174 318 001200 319 001203 322 001204 324 001206 326 001222 331 001223 335 001243 338 001254 340 001255 343 001257 344 001263 345 001265 348 001266 350 001270 353 001304 358 001305 362 001325 365 001336 367 001337 370 001341 371 001345 372 001347 375 001350 377 001352 379 001366 381 001367 404 001370 407 001376 410 001403 412 001415 416 001462 421 001463 425 001530 427 001543 431 001610 433 001617 436 001664 476 001665 479 001673 480 001676 484 001677 487 001707 488 001714 492 001715 495 001724 496 001730 386 001731 389 001732 390 001740 391 001751 393 001754 395 001764 397 001766 441 001767 444 001775 447 001777 449 002002 450 002005 451 002010 452 002013 453 002017 454 002021 456 002023 458 002042 459 002046 461 002050 464 002051 465 002054 469 002116 472 002121 ----------------------------------------------------------- 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