COMPILATION LISTING OF SEGMENT cmcs_tree_ctl_ Compiled by: Multics PL/I Compiler, Release 31b, of April 24, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 05/24/89 1021.1 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 cmcs_tree_ctl_.pl1 Reformatted code to new Cobol standard. 16* END HISTORY COMMENTS */ 17 18 19 /* Modified on 05/05/81 by FCH, [4.4-3], entry name find_qual_name added, BUG468 */ 20 /* Modified on 05/05/81 by FCH, [4.4-2], destination name may be any primitive node name, BUG468 */ 21 /* Modified on 03/03/81 by FCH, [4.4-1], once per process initialization, BUG468 */ 22 /* Modified since Version 4.3 */ 23 24 /* format: style3 */ 25 cmcs_tree_ctl_: 26 proc; 27 28 return; /* invalid_entrypoint */ 29 30 /* This COBOL MCS subroutine is used to find and process the various 31* entries in cmcs_tree_ctl.control segment. */ 32 33 /* Bob May, 6/30/77 */ 34 35 dcl a_dest char (12), 36 a_index fixed bin, 37 a_eptr ptr, 38 a_count fixed bin, 39 a_code fixed bin (35), 40 a_input_cdptr ptr; 41 42 dcl (i, j) fixed bin, 43 full_tree_path char (48); 44 45 /* Internal Static */ 46 47 48 49 dcl (addr, null, string) 50 builtin; 51 52 /* */ 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 */ 53 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 */ 54 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 */ 55 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 */ 56 5 1 /* BEGIN INCLUDE FILE ... cmcs_tree_ctl.incl.pl1 */ 5 2 5 3 /* 5 4* This COBOL MCS include file defines the sstructure used for accessing 5 5* the MCS queue hierarchy and controlling message I/O for each entry. 5 6**/ 5 7 5 8 /* Bob May, 5/31/77 */ 5 9 5 10 dcl (tree_ctl_hdr_len init (32), 5 11 tree_ctl_entry_len init (144), /* 136, plus fudge for ptr alignments */ 5 12 tree_ctl_version init (1)) fixed bin internal static options (constant); 5 13 5 14 dcl tree_ctl_ptr ptr int static; 5 15 5 16 dcl 1 tree_ctl aligned based (tree_ctl_ptr), 5 17 2 hdr like control_hdr, 5 18 2 queue_count fixed bin, /* total of queue entries for hierarchy */ 5 19 2 filler (31) fixed bin (35), 5 20 2 entries (tree_ctl.current_size) like tree_ctl_entry; 5 21 5 22 dcl tree_ctl_eindex fixed bin; 5 23 5 24 dcl tree_ctl_eptr ptr; 5 25 5 26 dcl 1 tree_ctl_entry aligned based (tree_ctl_eptr), 5 27 2 level_info, /* len = 15 */ 5 28 3 tree_path, 5 29 4 level_names (4) char (12), 5 30 3 entry_flags, 5 31 (4 inactive_sw bit (1), 5 32 4 cmd_sw bit (1), 5 33 4 mp_sw bit (1), 5 34 /* switch separator */ 5 35 4 cobol_program_id_sw bit (1), 5 36 4 queue_sw bit (1), 5 37 4 filler bit (31)) unaligned, 5 38 3 level_no fixed bin, /* level within the hierarchy */ 5 39 3 subtree_count fixed bin, 5 40 2 static_queue_info, /* len = 9 */ 5 41 3 queue_name char (32), /* without the .cmcs_queue suffix */ 5 42 3 queue_ctl_eindex fixed bin, /* to compute addr of table entry */ 5 43 2 command_info, /* len = 75 */ 5 44 3 cmd_line_len fixed bin, 5 45 3 cmd_line char (128), 5 46 3 mp_line_len fixed bin, 5 47 3 mp_line char (128), 5 48 3 cobol_program_id_len fixed bin, 5 49 3 cobol_program_id char (32), 5 50 2 io_info, /* len = 37, sum of all level 3s */ 5 51 3 io_flags, /* len = 1 */ 5 52 (4 io_in_process_sw bit (1), 5 53 4 partial_in_process_sw bit (1), 5 54 4 rcv_wait_sw bit (1), 5 55 /* switch separator */ 5 56 4 rcv_msg_sw bit (1), /* on if user did a receive msg */ 5 57 4 rcv_seg_sw bit (1), /* on if user did a receive seg */ 5 58 4 filler bit (31)) unaligned, 5 59 3 dynamic_queue_info, /* len = 13 */ 5 60 4 switch_name char (32) unaligned, 5 61 4 queue_ctl_eptr ptr, 5 62 4 iocb_ptr ptr, 5 63 4 vfile_status fixed bin, /* 0 - not active/detached */ 5 64 /* 1 - attached, but not open */ 5 65 /* 2 - open */ 5 66 3 msg_hdr_info, /* len = 9 */ 5 67 4 msg_hdr_ptr ptr, /* ptr to base of current msg */ 5 68 4 io_type fixed bin, 5 69 4 io_subtype fixed bin, 5 70 4 seg_count fixed bin (35), /* total no of msg segments */ 5 71 4 msg_len fixed bin (35), /* total msg length (sum of all segments) */ 5 72 4 msg_descr like vfile_descr, 5 73 4 msg_key, 5 74 5 msg_no fixed bin (35), 5 75 5 seg_no fixed bin (35), 5 76 3 tseg_info, /* len = 3 */ 5 77 4 tseg_ptr ptr, /* temp seg to build segment */ 5 78 4 tseg_len fixed bin (35), 5 79 3 msg_seg_info, /* len = 6 */ 5 80 4 msg_seg_ptr ptr, /* ptr to base of current msg_seg */ 5 81 4 msg_seg_descr like vfile_descr, 5 82 4 msg_seg_len fixed bin (35), 5 83 4 msg_seg_left_index fixed bin (35), 5 84 4 msg_seg_left_len fixed bin (35), 5 85 3 buffer_info, /* len = 5 */ 5 86 4 buffer_ptr ptr, 5 87 4 buffer_len fixed bin (35), 5 88 4 buffer_left_index fixed bin (35), 5 89 4 buffer_left_len fixed bin (35); 5 90 5 91 /* END INCLUDE FILE ... cmcs_tree_ctl.incl.pl1 */ 57 6 1 /* BEGIN INCLUDE FILE ... cmcs_user_ctl.incl.pl1 */ 6 2 6 3 /* 6 4* This COBOL MCS include file defines the global, process-dependent variables that are 6 5* not part of the PD copy of cmcs_tree_ctl.control. 6 6**/ 6 7 6 8 /* Modified on 05/06/81 by FCH, [4.4-1], attach command */ 6 9 /* Bob May, 5/31/77 */ 6 10 6 11 dcl user_ctl_exists_sw bit (1) aligned int static init ("0"b); /* indicates legitimacy of external_user_ctl_ptr */ 6 12 6 13 dcl external_user_ctl_ptr ptr external; /* global ptr for user_ctl */ 6 14 6 15 dcl user_ctl_ptr ptr int static; 6 16 6 17 dcl 1 user_ctl aligned based (user_ctl_ptr), 6 18 6 19 /* Flags */ 6 20 6 21 2 init_sw, 6 22 3 terminal_ctl bit(1), 6 23 3 tree_ctl bit(1), 6 24 3 status_list_ctl bit(1), 6 25 3 station_ctl bit(1), 6 26 3 queue_ctl bit(1), 6 27 3 set_lock bit(1), 6 28 3 wait_ctl bit(1), 6 29 3 purge_queues bit(1), 6 30 3 create_queues bit(1), 6 31 3 initiate_ctl bit(1), 6 32 3 mcs bit(1), 6 33 2 flags, 6 34 (3 initialized_sw bit (1), 6 35 3 interactive_sw bit (1), 6 36 3 mp_sw bit (1), /* message processor process */ 6 37 3 terminal_sw bit (1), /* user terminal process */ 6 38 3 admin_sw bit (1), /* cobol_mcs_admin */ 6 39 3 attach_bit bit(1), /*[4.4-1]*/ 6 40 3 rec bit(1), /*[4.4-1]*/ 6 41 3 filler bit (29)) unaligned, 6 42 2 cmcs_dir char (168), 6 43 2 output_file char(168), /*[4.4-1]*/ 6 44 2 station_name char (12), /* current station */ 6 45 2 station_ctl_eindex fixed bin, /* current station */ 6 46 2 process_id bit (36), 6 47 2 process_type fixed bin, /* 0 - not defined, 1 - MP, 2 - terminal, 3 - admin */ 6 48 2 filler fixed bin (35), /* to explicitly align ptrs */ 6 49 2 control_ptrs, 6 50 3 queue_ctl_ptr ptr, 6 51 3 iocb_ptr ptr, /*[4.4-1]*/ 6 52 3 station_ctl_ptr ptr, 6 53 3 system_ctl_ptr ptr, 6 54 3 terminal_ctl_ptr ptr, 6 55 3 tree_ctl_ptr ptr, 6 56 3 wait_ctl_ptr ptr, 6 57 3 filler_ptrs (4) ptr, 6 58 2 terminal_info, 6 59 3 term_id char (4), 6 60 3 term_type fixed bin, 6 61 3 term_channel char (8), 6 62 2 last_receive_info, 6 63 3 tree_path char (48), 6 64 3 tree_ctl_eindex fixed bin, 6 65 3 tree_ctl_eptr ptr, 6 66 2 last_send_info, 6 67 3 dest_name char (12), 6 68 3 tree_ctl_eindex fixed bin, 6 69 3 tree_ctl_eptr ptr, 6 70 2 station_info, 6 71 3 station_count fixed bin, /* must be 1 for phase 1 */ 6 72 3 station_entries (2), 6 73 4 station_name char (12), 6 74 4 station_ctl_eptr ptr, 6 75 4 station_ctl_eindex fixed bin, 6 76 2 wait_info, 6 77 3 wait_ctl_eptr ptr, 6 78 3 wait_ctl_eindex fixed bin, 6 79 3 wait_ctl_mp_eindex fixed bin, /* only for message processors */ 6 80 3 wait_ctl_mp_eptr ptr, 6 81 3 ev_wait_chn fixed bin (71), /* for message processors */ 6 82 3 ev_call_chn fixed bin (71), /* for terminals, to get message responses */ 6 83 3 ev_wait_list_ptr ptr, /* for ipc_$block */ 6 84 3 ev_info_ptr ptr; /* for wakeup */ 6 85 6 86 /* END INCLUDE FILE ... cmcs_user_ctl.incl.pl1 */ 58 7 1 /* BEGIN INCLUDE FILE... cmcs_vfile_rs.incl.pl1 */ 7 2 7 3 /* This COBOL MCS include file is used to reference records by their 7 4* vfile_ descriptors. It is used mainly in the maintenance of 7 5* message status lists. */ 7 6 7 7 /* Bob May, 6/30/77 */ 7 8 7 9 dcl vfile_rs_version fixed bin int static options (constant) init (1); 7 10 7 11 dcl vfile_rs_ptr ptr; 7 12 7 13 dcl 1 vfile_rs aligned based (vfile_rs_ptr), 7 14 2 version fixed bin, /* currently must be set to 1 */ 7 15 2 flags, 7 16 (3 lock_sw bit (1), /* "1"b */ 7 17 3 unlock_sw bit (1), /* "1"b */ 7 18 3 create_sw bit (1), /* "0"b */ 7 19 /* switch separator */ 7 20 3 locate_sw bit (1), /* "0"b for current_rec, "1"b to use descriptor */ 7 21 3 filler bit (32)) unaligned, /* (32) "0"b */ 7 22 2 rec_len fixed bin (21), 7 23 2 max_rec_len fixed bin (21), 7 24 2 rec_ptr ptr, 7 25 2 descr like vfile_descr, /* process INdependent addressing */ 7 26 2 filler fixed bin; /* 0 */ 7 27 7 28 dcl 1 vfile_descr, /* process INdependent addressing */ 7 29 (2 comp_no fixed bin (17), /* component of MSF */ 7 30 2 comp_offset bit (18)) unaligned; /* offset of record in component */ 7 31 7 32 /* END INCLUDE FILE... cmcs_vfile_rs.incl.pl1 */ 59 60 /* */ 61 find_destination: 62 entry (a_dest, a_index, a_eptr, a_code); 63 64 /*[4.4-2]*/ 65 declare ch48 char (48), 66 loc fixed bin; 67 68 /*[4.4-3]*/ 69 call find_name; 70 71 /*[4.4-3]*/ 72 return; 73 74 find_name: 75 proc; 76 77 /*[4.4-1]*/ 78 call setup; 79 80 do i = 1 to tree_ctl.current_size; 81 82 /*[4.4-2]*/ 83 tree_ctl_eptr = addr (tree_ctl.entries (i)); /*[4.4-2]*/ 84 ch48 = string (tree_ctl_entry.tree_path); /*[4.4-2]*/ 85 loc = index (ch48, a_dest); 86 87 /*[4.4-2]*/ 88 if loc > 0 /*[4.4-2]*/ 89 then if a_dest = substr (ch48, loc) /*[4.4-2]*/ 90 then do; 91 a_index = i; /*[4.4-2]*/ 92 a_eptr = tree_ctl_eptr; /*[4.4-2]*/ 93 a_code = 0; 94 95 /*[4.4-2]*/ 96 return; /*[4.4-2]*/ 97 end; 98 99 end; 100 101 a_index = 0; /* didn't find it */ 102 a_eptr = null (); 103 a_code = cmcs_error_table_$bad_dest; 104 105 end; 106 107 find_qual_name: 108 entry (a_dest, a_index, a_eptr, qn, a_code); 109 110 /*[4.4-3]*/ 111 call find_name; /*[4.4-3]*/ 112 if a_code ^= 0 113 then return; 114 115 /*[4.4-3]*/ 116 call form_qual_name; 117 118 /*[4.4-3]*/ 119 qn = qual_name; 120 121 /*[4.4-3]*/ 122 return; 123 124 /*[4.4-3]*/ 125 declare blank_pos fixed bin; /*[4.4-3]*/ 126 declare qual_name char (52) varying; /*[4.4-3]*/ 127 declare qn char (52); 128 129 form_qual_name: 130 proc; 131 132 /*[4.4-3]*/ 133 qual_name = ""; 134 135 /*[4.4-3]*/ 136 call qual_comp (1); 137 138 /*[4.4-3]*/ 139 if blank_pos ^= 1 /*[4.4-3]*/ 140 then do; 141 call qual_comp (13); 142 143 /*[4.4-3]*/ 144 if blank_pos ^= 1 /*[4.4-3]*/ 145 then do; 146 call qual_comp (25); 147 148 /*[4.4-3]*/ 149 if blank_pos ^= 1 150 then call qual_comp (37); /*[4.4-3]*/ 151 end; /*[4.4-3]*/ 152 end; 153 end; 154 155 qual_comp: 156 proc (pos); 157 158 /*[4.4-3]*/ 159 declare pos fixed bin; 160 161 /*[4.4-3]*/ 162 blank_pos = index (substr (ch48, pos, 12), " "); 163 164 /*[4.4-3]*/ 165 if blank_pos = 1 166 then return; 167 168 /*[4.4-3]*/ 169 if blank_pos = 0 170 then blank_pos = 13; 171 172 /*[4.4-3]*/ 173 if qual_name ^= "" 174 then qual_name = qual_name || "."; 175 176 /*[4.4-3]*/ 177 qual_name = qual_name || substr (ch48, pos, blank_pos - 1); 178 179 end; 180 181 find_index: 182 entry (a_index, a_eptr, a_code); 183 184 /*[4.4-1]*/ 185 call setup; 186 187 if a_index <= tree_ctl.current_size 188 then do; 189 190 tree_ctl_eptr = addr (tree_ctl.entries (a_index)); 191 192 if ^tree_ctl_entry.inactive_sw 193 then do; 194 195 a_eptr = tree_ctl_eptr; 196 a_code = 0; 197 198 return; 199 200 end; 201 end; 202 203 a_eptr = null (); 204 a_code = cmcs_error_table_$bad_dest; 205 206 return; 207 208 /* end of find_index entrypoint */ 209 210 find_tree_path: 211 entry (a_input_cdptr, a_index, a_count, a_eptr, a_code); 212 213 /*[4.4-1]*/ 214 call setup; 215 216 full_tree_path = string (a_input_cdptr -> input_cd.tree_path); 217 218 do i = 1 to tree_ctl.current_size; 219 220 tree_ctl_eptr = addr (tree_ctl.entries (i)); 221 222 if ^tree_ctl_entry.inactive_sw 223 then if full_tree_path = string (tree_ctl_entry.tree_path) 224 then do; 225 226 a_index = i; 227 a_count = tree_ctl_entry.subtree_count; 228 a_eptr = tree_ctl_eptr; 229 a_code = 0; 230 231 return; 232 233 end; 234 end; 235 236 a_index, a_count = 0; /* didn't find it */ 237 a_eptr = null (); 238 a_code = cmcs_error_table_$bad_queue_path; /* ---- */ 239 240 return; 241 242 /* end of find_tree_path entrypoint */ 243 244 setup: 245 proc; 246 247 /*[4.4-1]*/ 248 if (external_user_ctl_ptr -> user_ctl.init_sw.tree_ctl) 249 then return; 250 251 user_ctl_ptr = external_user_ctl_ptr; /* set local variable from global */ 252 253 tree_ctl_ptr = user_ctl.tree_ctl_ptr; 254 user_ctl.init_sw.tree_ctl = "1"b; 255 256 a_code = 0; 257 258 end /* setup */; 259 260 end /* cmcs_tree_ctl_ */; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0834.0 cmcs_tree_ctl_.pl1 >spec>install>MR12.3-1048>cmcs_tree_ctl_.pl1 53 1 03/27/82 0439.5 cmcs_cd_dcls.incl.pl1 >ldd>include>cmcs_cd_dcls.incl.pl1 54 2 03/27/82 0439.5 cmcs_control_hdr.incl.pl1 >ldd>include>cmcs_control_hdr.incl.pl1 55 3 05/24/89 0811.5 cmcs_entry_dcls.incl.pl1 >spec>install>MR12.3-1048>cmcs_entry_dcls.incl.pl1 56 4 03/27/82 0439.5 cmcs_error_table_dcls.incl.pl1 >ldd>include>cmcs_error_table_dcls.incl.pl1 57 5 03/27/82 0439.6 cmcs_tree_ctl.incl.pl1 >ldd>include>cmcs_tree_ctl.incl.pl1 58 6 03/27/82 0431.5 cmcs_user_ctl.incl.pl1 >ldd>include>cmcs_user_ctl.incl.pl1 59 7 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_code parameter fixed bin(35,0) dcl 35 set ref 61 93* 103* 107 112 181 196* 204* 210 229* 238* 256* a_count parameter fixed bin(17,0) dcl 35 set ref 210 227* 236* a_dest parameter char(12) packed unaligned dcl 35 ref 61 85 88 107 a_eptr parameter pointer dcl 35 set ref 61 92* 102* 107 181 195* 203* 210 228* 237* a_index parameter fixed bin(17,0) dcl 35 set ref 61 91* 101* 107 181 187 190 210 226* 236* a_input_cdptr parameter pointer dcl 35 ref 210 216 addr builtin function dcl 49 ref 83 190 220 blank_pos 000136 automatic fixed bin(17,0) dcl 125 set ref 139 144 149 162* 165 169 169* 177 ch48 000121 automatic char(48) packed unaligned dcl 65 set ref 84* 85 88 162 177 cmcs_error_table_$bad_dest 000014 external static fixed bin(35,0) dcl 4-5 ref 103 204 cmcs_error_table_$bad_queue_path 000016 external static fixed bin(35,0) dcl 4-5 ref 238 control_hdr based structure level 1 dcl 2-11 control_ptrs 150 based structure level 2 dcl 6-17 current_size 16 based fixed bin(18,0) level 3 dcl 5-16 ref 80 187 218 entries 100 based structure array level 2 dcl 5-16 set ref 83 190 220 entry_flags 14 based structure level 3 dcl 5-26 external_user_ctl_ptr 000020 external static pointer dcl 6-13 ref 248 251 full_tree_path 000101 automatic char(48) packed unaligned dcl 42 set ref 216* 222 hdr based structure level 2 dcl 5-16 i 000100 automatic fixed bin(17,0) dcl 42 set ref 80* 83 91* 218* 220 226* inactive_sw 14 based bit(1) level 4 packed packed unaligned dcl 5-26 ref 192 222 init_sw based structure level 2 dcl 6-17 input_cd based structure level 1 dcl 1-13 level_info based structure level 2 dcl 5-26 loc 000135 automatic fixed bin(17,0) dcl 65 set ref 85* 88 88 null builtin function dcl 49 ref 102 203 237 pos parameter fixed bin(17,0) dcl 159 ref 155 162 177 qn parameter char(52) packed unaligned dcl 127 set ref 107 119* qual_name 000137 automatic varying char(52) dcl 126 set ref 119 133* 173 173* 173 177* 177 string builtin function dcl 49 ref 84 216 222 subtree_count 16 based fixed bin(17,0) level 3 dcl 5-26 ref 227 tree_ctl based structure level 1 dcl 5-16 in procedure "cmcs_tree_ctl_" tree_ctl 1 based bit(1) level 3 in structure "user_ctl" dcl 6-17 in procedure "cmcs_tree_ctl_" set ref 248 254* tree_ctl_entry based structure level 1 dcl 5-26 tree_ctl_eptr 000116 automatic pointer dcl 5-24 set ref 83* 84 92 190* 192 195 220* 222 222 227 228 tree_ctl_ptr 000010 internal static pointer dcl 5-14 in procedure "cmcs_tree_ctl_" set ref 80 83 187 190 218 220 253* tree_ctl_ptr 162 based pointer level 3 in structure "user_ctl" dcl 6-17 in procedure "cmcs_tree_ctl_" ref 253 tree_path 17 based structure level 2 in structure "input_cd" dcl 1-13 in procedure "cmcs_tree_ctl_" ref 216 tree_path based structure level 3 in structure "tree_ctl_entry" dcl 5-26 in procedure "cmcs_tree_ctl_" ref 84 222 user_ctl based structure level 1 dcl 6-17 user_ctl_ptr 000012 internal static pointer dcl 6-15 set ref 251* 253 254 vfile_descr 000120 automatic structure level 1 packed packed unaligned dcl 7-28 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. 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_count external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$bad_message_length external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$bad_password external static fixed bin(35,0) dcl 4-5 cmcs_error_table_$bad_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_$null_partial_message 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_$accept_message_count 000000 constant entry external dcl 3-34 cmcs_queue_ctl_$disable 000000 constant entry external dcl 3-35 cmcs_queue_ctl_$enable 000000 constant entry external dcl 3-36 cmcs_queue_ctl_$print 000000 constant entry external dcl 3-37 cmcs_queue_ctl_$purge 000000 constant entry external dcl 3-38 cmcs_queue_ctl_$receive 000000 constant entry external dcl 3-39 cmcs_queue_ctl_$send 000000 constant entry external dcl 3-40 cmcs_queue_ctl_$stop_run 000000 constant entry external dcl 3-41 cmcs_scramble_ 000000 constant entry external dcl 3-43 cmcs_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_$disable_input_terminal 000000 constant entry external dcl 3-51 cmcs_station_ctl_$disable_output_terminal 000000 constant entry external dcl 3-52 cmcs_station_ctl_$enable_input_terminal 000000 constant entry external dcl 3-53 cmcs_station_ctl_$enable_output_terminal 000000 constant entry external dcl 3-54 cmcs_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 control_hdr_len internal static fixed bin(17,0) initial dcl 2-7 control_hdr_ptr automatic pointer dcl 2-9 input_cdp automatic pointer dcl 1-9 j automatic fixed bin(17,0) dcl 42 last_station_info based structure level 1 dcl 1-66 output_cd based structure level 1 dcl 1-43 output_cdp automatic pointer dcl 1-39 tree_ctl_eindex automatic fixed bin(17,0) dcl 5-22 tree_ctl_entry_len internal static fixed bin(17,0) initial dcl 5-10 tree_ctl_hdr_len internal static fixed bin(17,0) initial dcl 5-10 tree_ctl_version internal static fixed bin(17,0) initial dcl 5-10 user_ctl_exists_sw internal static bit(1) initial dcl 6-11 vfile_rs based structure level 1 dcl 7-13 vfile_rs_ptr automatic pointer dcl 7-11 vfile_rs_version internal static fixed bin(17,0) initial dcl 7-9 NAMES DECLARED BY EXPLICIT CONTEXT. cmcs_tree_ctl_ 000011 constant entry external dcl 25 find_destination 000024 constant entry external dcl 61 find_index 000102 constant entry external dcl 181 find_name 000242 constant entry internal dcl 74 ref 69 111 find_qual_name 000047 constant entry external dcl 107 find_tree_path 000147 constant entry external dcl 210 form_qual_name 000325 constant entry internal dcl 129 ref 116 qual_comp 000361 constant entry internal dcl 155 ref 136 141 146 149 setup 000436 constant entry internal dcl 244 ref 78 185 214 NAMES DECLARED BY CONTEXT OR IMPLICATION. index builtin function ref 85 162 substr builtin function ref 88 162 177 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 602 624 463 612 Length 1152 463 22 312 116 4 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cmcs_tree_ctl_ 147 external procedure is an external procedure. find_name internal procedure shares stack frame of external procedure cmcs_tree_ctl_. form_qual_name internal procedure shares stack frame of external procedure cmcs_tree_ctl_. qual_comp internal procedure shares stack frame of external procedure cmcs_tree_ctl_. setup internal procedure shares stack frame of external procedure cmcs_tree_ctl_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 tree_ctl_ptr cmcs_tree_ctl_ 000012 user_ctl_ptr cmcs_tree_ctl_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cmcs_tree_ctl_ 000100 i cmcs_tree_ctl_ 000101 full_tree_path cmcs_tree_ctl_ 000116 tree_ctl_eptr cmcs_tree_ctl_ 000120 vfile_descr cmcs_tree_ctl_ 000121 ch48 cmcs_tree_ctl_ 000135 loc cmcs_tree_ctl_ 000136 blank_pos cmcs_tree_ctl_ 000137 qual_name cmcs_tree_ctl_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. return_mac ext_entry set_chars_eis index_chars_eis NO EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cmcs_error_table_$bad_dest cmcs_error_table_$bad_queue_path external_user_ctl_ptr LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 25 000010 28 000016 61 000017 69 000040 72 000041 107 000042 111 000063 112 000064 116 000066 119 000067 122 000075 181 000076 185 000116 187 000117 190 000124 192 000127 195 000132 196 000133 198 000134 203 000135 204 000137 206 000141 210 000142 214 000163 216 000164 218 000172 220 000203 222 000210 226 000217 227 000221 228 000224 229 000225 231 000226 234 000227 236 000231 237 000234 238 000236 240 000241 74 000242 78 000243 80 000244 83 000255 84 000262 85 000265 88 000275 91 000307 92 000311 93 000312 96 000313 99 000314 101 000316 102 000317 103 000321 105 000324 129 000325 133 000326 136 000327 139 000333 141 000336 144 000342 146 000345 149 000351 153 000360 155 000361 162 000363 165 000375 169 000400 173 000404 177 000420 179 000435 244 000436 248 000437 251 000445 253 000446 254 000451 256 000454 258 000455 ----------------------------------------------------------- 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