COMPILATION LISTING OF SEGMENT cmcs_initiate_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 1023.3 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_initiate_ctl_.pl1 Reformatted code to new Cobol standard. 16* END HISTORY COMMENTS */ 17 18 19 /* Modified on 03/16/82 by FCH, [5.2-1], eliminate need for copy switch by using temp seg, BUG530 */ 20 /* Modified since Version 5.0 */ 21 22 23 24 25 /* format: style3 */ 26 cmcs_initiate_ctl_: 27 proc (a_name, a_ptr, a_code); 28 29 dcl a_name char (*), 30 a_ptr ptr, /* used for xxx_ctl_ptr */ 31 a_code fixed bin (35); 32 33 dcl my_name char (18) init ("cmcs_initiate_ctl_"); 34 35 dcl initiate_dir char (168); /* either WD or from user_ctl */ 36 37 dcl x_ptr ptr; /* global initiate ptr */ 38 39 dcl ioa_ entry options (variable); 40 41 42 dcl get_wdir_ entry () returns (char (168)); 43 dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); 44 45 /*[5.2-1]*/ 46 dcl get_temp_segment_ entry (char (*), ptr, fixed bin (35)); 47 /*[5.2-1]*/ 48 dcl release_temp_segments_ 49 entry (char (*), (*) ptr, fixed bin (35)); 50 /*[5.2-1]*/ 51 dcl hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)); 52 /*[5.2-1]*/ 53 dcl code fixed bin (35), 54 TYPE fixed bin (2), 55 BIT_COUNT fixed bin (24); 56 57 /*[5.2-1]*/ 58 dcl ptr_array (1) ptr static int; /*[5.2-1]*/ 59 dcl SEG bit (9 * sys_info$max_seg_size) based; 60 61 dcl error_table_$action_not_performed 62 fixed bin (35) external; 63 dcl sys_info$max_seg_size 64 fixed bin (18) static ext; 65 dcl null builtin; /* */ 1 1 /* BEGIN INCLUDE FILE... cmcs_cobol_mcs_dcls */ 1 2 1 3 dcl cobol_mcs_$accept entry (ptr, fixed bin (35)); 1 4 dcl cobol_mcs_$disable_input_queue entry (ptr, char (*), fixed bin (35)); 1 5 dcl cobol_mcs_$disable_input_terminal entry (ptr, char (*), fixed bin (35)); 1 6 dcl cobol_mcs_$disable_output entry (ptr, char (*), fixed bin (35)); 1 7 dcl cobol_mcs_$enable_input_queue entry (ptr, char (*), fixed bin (35)); 1 8 dcl cobol_mcs_$enable_input_terminal entry (ptr, char (*), fixed bin (35)); 1 9 dcl cobol_mcs_$enable_output entry (ptr, char (*), fixed bin (35)); 1 10 dcl cobol_mcs_$get_user_ctl_exists_sw entry (bit (1) aligned); 1 11 dcl cobol_mcs_$purge entry (ptr, fixed bin (35)); 1 12 dcl cobol_mcs_$receive entry (ptr, fixed bin, ptr, fixed bin, fixed bin (35)); 1 13 dcl cobol_mcs_$receive_wait entry (ptr, fixed bin, ptr, fixed bin, fixed bin (35)); 1 14 dcl cobol_mcs_$send entry (ptr, ptr, char (4), char (1), bit (36), fixed bin (35)); 1 15 dcl cobol_mcs_$set_user_ctl_exists_sw entry (bit (1) aligned); 1 16 dcl cobol_mcs_$stop_run entry (); 1 17 1 18 /* 1 19* call cobol_mcs_$accept (mcs_icdp, code); 1 20* call cobol_mcs_$disable_input_queue (mcs_icdp, password, code); 1 21* call cobol_mcs_$disable_input_terminal (mcs_icdp, password, code); 1 22* call cobol_mcs_$disable_output (mcs_ocdp, password, code); 1 23* call cobol_mcs_$enable_input_queue (mcs_icdp, password, code); 1 24* call cobol_mcs_$enable_input_terminal (mcs_icdp, password, code); 1 25* call cobol_mcs_$enable_output (mcs_ocdp, password, code); 1 26* call cobol_mcs_$get_user_ctl_exists_sw (flag); 1 27* call cobol_mcs_$purge (mcs_ocdp, code); 1 28* call cobol_mcs_$receive (mcs_icdp, type, mesp, max_meslen, code); 1 29* call cobol_mcs_$receive_wait(mcs_icdp, type, mesp, max_meslen, code); 1 30* call cobol_mcs_$send (mcs_ocdp, mesp, max_meslen, end_indicator, slew_control, code); 1 31* call cobol_mcs_$set_user_ctl_exists_sw (ON); 1 32* call cobol_mcs_$stop_run (); 1 33**/ 1 34 1 35 /* END INCLUDE FILE... cmcs_cobol_mcs_dcls */ 66 2 1 /* BEGIN INCLUDE FILE ... cmcs_user_ctl.incl.pl1 */ 2 2 2 3 /* 2 4* This COBOL MCS include file defines the global, process-dependent variables that are 2 5* not part of the PD copy of cmcs_tree_ctl.control. 2 6**/ 2 7 2 8 /* Modified on 05/06/81 by FCH, [4.4-1], attach command */ 2 9 /* Bob May, 5/31/77 */ 2 10 2 11 dcl user_ctl_exists_sw bit (1) aligned int static init ("0"b); /* indicates legitimacy of external_user_ctl_ptr */ 2 12 2 13 dcl external_user_ctl_ptr ptr external; /* global ptr for user_ctl */ 2 14 2 15 dcl user_ctl_ptr ptr int static; 2 16 2 17 dcl 1 user_ctl aligned based (user_ctl_ptr), 2 18 2 19 /* Flags */ 2 20 2 21 2 init_sw, 2 22 3 terminal_ctl bit(1), 2 23 3 tree_ctl bit(1), 2 24 3 status_list_ctl bit(1), 2 25 3 station_ctl bit(1), 2 26 3 queue_ctl bit(1), 2 27 3 set_lock bit(1), 2 28 3 wait_ctl bit(1), 2 29 3 purge_queues bit(1), 2 30 3 create_queues bit(1), 2 31 3 initiate_ctl bit(1), 2 32 3 mcs bit(1), 2 33 2 flags, 2 34 (3 initialized_sw bit (1), 2 35 3 interactive_sw bit (1), 2 36 3 mp_sw bit (1), /* message processor process */ 2 37 3 terminal_sw bit (1), /* user terminal process */ 2 38 3 admin_sw bit (1), /* cobol_mcs_admin */ 2 39 3 attach_bit bit(1), /*[4.4-1]*/ 2 40 3 rec bit(1), /*[4.4-1]*/ 2 41 3 filler bit (29)) unaligned, 2 42 2 cmcs_dir char (168), 2 43 2 output_file char(168), /*[4.4-1]*/ 2 44 2 station_name char (12), /* current station */ 2 45 2 station_ctl_eindex fixed bin, /* current station */ 2 46 2 process_id bit (36), 2 47 2 process_type fixed bin, /* 0 - not defined, 1 - MP, 2 - terminal, 3 - admin */ 2 48 2 filler fixed bin (35), /* to explicitly align ptrs */ 2 49 2 control_ptrs, 2 50 3 queue_ctl_ptr ptr, 2 51 3 iocb_ptr ptr, /*[4.4-1]*/ 2 52 3 station_ctl_ptr ptr, 2 53 3 system_ctl_ptr ptr, 2 54 3 terminal_ctl_ptr ptr, 2 55 3 tree_ctl_ptr ptr, 2 56 3 wait_ctl_ptr ptr, 2 57 3 filler_ptrs (4) ptr, 2 58 2 terminal_info, 2 59 3 term_id char (4), 2 60 3 term_type fixed bin, 2 61 3 term_channel char (8), 2 62 2 last_receive_info, 2 63 3 tree_path char (48), 2 64 3 tree_ctl_eindex fixed bin, 2 65 3 tree_ctl_eptr ptr, 2 66 2 last_send_info, 2 67 3 dest_name char (12), 2 68 3 tree_ctl_eindex fixed bin, 2 69 3 tree_ctl_eptr ptr, 2 70 2 station_info, 2 71 3 station_count fixed bin, /* must be 1 for phase 1 */ 2 72 3 station_entries (2), 2 73 4 station_name char (12), 2 74 4 station_ctl_eptr ptr, 2 75 4 station_ctl_eindex fixed bin, 2 76 2 wait_info, 2 77 3 wait_ctl_eptr ptr, 2 78 3 wait_ctl_eindex fixed bin, 2 79 3 wait_ctl_mp_eindex fixed bin, /* only for message processors */ 2 80 3 wait_ctl_mp_eptr ptr, 2 81 3 ev_wait_chn fixed bin (71), /* for message processors */ 2 82 3 ev_call_chn fixed bin (71), /* for terminals, to get message responses */ 2 83 3 ev_wait_list_ptr ptr, /* for ipc_$block */ 2 84 3 ev_info_ptr ptr; /* for wakeup */ 2 85 2 86 /* END INCLUDE FILE ... cmcs_user_ctl.incl.pl1 */ 67 68 69 /* */ 70 71 a_ptr = null (); 72 73 call cobol_mcs_$get_user_ctl_exists_sw (user_ctl_exists_sw); 74 75 if ^user_ctl_exists_sw 76 then do; 77 78 initiate_dir = get_wdir_ (); 79 call initiate (a_name); 80 81 a_ptr = x_ptr; 82 return; 83 84 end; 85 86 user_ctl_ptr = external_user_ctl_ptr; 87 initiate_dir = user_ctl.cmcs_dir; 88 89 call initiate ("cmcs_queue_ctl.control"); 90 user_ctl.queue_ctl_ptr = x_ptr; /* whether null or not */ 91 92 call initiate ("cmcs_station_ctl.control"); 93 user_ctl.station_ctl_ptr = x_ptr; /* whether null or not */ 94 95 call initiate ("cmcs_system_ctl.control"); 96 user_ctl.system_ctl_ptr = x_ptr; /* whether null or not */ 97 98 call initiate ("cmcs_terminal_ctl.control"); 99 user_ctl.terminal_ctl_ptr = x_ptr; /* whether null or not */ 100 101 call initiate ("cmcs_tree_ctl.control"); 102 103 /*[5.2-1]*/ 104 call get_temp_segment_ ("cmcs_initiate_ctl_", ptr_array (1), code); 105 106 /*[5.2-1]*/ 107 if code ^= 0 /*[5.2-1]*/ 108 then do; 109 a_code = code; /*[5.2-1]*/ 110 return; /*[5.2-1]*/ 111 end; 112 113 /*[5.2-1]*/ 114 call hcs_$status_minf (initiate_dir, "cmcs_tree_ctl.control", 1, TYPE, BIT_COUNT, code); 115 116 /*[5.2-1]*/ 117 if code ^= 0 /*[5.2-1]*/ 118 then do; 119 a_code = code; /*[5.2-1]*/ 120 return; /*[5.2-1]*/ 121 end; 122 123 /*[5.2-1]*/ 124 user_ctl.tree_ctl_ptr = ptr_array (1); /*[5.2-1]*/ 125 substr (user_ctl.tree_ctl_ptr -> SEG, 1, BIT_COUNT) = substr (x_ptr -> SEG, 1); 126 127 call initiate ("cmcs_wait_ctl.control"); 128 user_ctl.wait_ctl_ptr = x_ptr; /* whether null or not */ 129 130 a_code = 0; 131 132 return; 133 134 release: 135 entry (a_code); 136 137 /*[5.2-1]*/ 138 call release_temp_segments_ ("cmcs_initiate_ctl_", ptr_array, code); 139 140 /*[5.2-1]*/ 141 if code ^= 0 142 then a_code = code; /*[5.2-1]*/ 143 return; 144 145 /* */ 146 147 initiate: 148 proc (x_name); 149 150 dcl x_name char (*); 151 152 call hcs_$initiate (initiate_dir, x_name, "", 0, 0, x_ptr, a_code); 153 if x_ptr = null () 154 then do; 155 156 call ioa_ ("""^a"" not not available. If needed, correct and retry.", x_name); 157 return; 158 159 end; 160 161 a_code = 0; /* ptr is good, make code good too */ 162 return; 163 164 end /* initiate */; 165 166 /* */ 167 168 end /* cmcs_initiate_ctl_ */; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0836.6 cmcs_initiate_ctl_.pl1 >spec>install>MR12.3-1048>cmcs_initiate_ctl_.pl1 66 1 03/27/82 0439.5 cmcs_cobol_mcs_dcls.incl.pl1 >ldd>include>cmcs_cobol_mcs_dcls.incl.pl1 67 2 03/27/82 0431.5 cmcs_user_ctl.incl.pl1 >ldd>include>cmcs_user_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. BIT_COUNT 000164 automatic fixed bin(24,0) dcl 53 set ref 114* 125 SEG based bit packed unaligned dcl 59 set ref 125* 125 TYPE 000163 automatic fixed bin(2,0) dcl 53 set ref 114* a_code parameter fixed bin(35,0) dcl 29 set ref 26 109* 119* 130* 134 141* 152* 161* a_name parameter char packed unaligned dcl 29 set ref 26 79* a_ptr parameter pointer dcl 29 set ref 26 71* 81* cmcs_dir 14 based char(168) level 2 dcl 2-17 ref 87 cobol_mcs_$get_user_ctl_exists_sw 000034 constant entry external dcl 1-10 ref 73 code 000162 automatic fixed bin(35,0) dcl 53 set ref 104* 107 109 114* 117 119 138* 141 141 control_ptrs 150 based structure level 2 dcl 2-17 external_user_ctl_ptr 000036 external static pointer dcl 2-13 ref 86 get_temp_segment_ 000024 constant entry external dcl 46 ref 104 get_wdir_ 000020 constant entry external dcl 42 ref 78 hcs_$initiate 000022 constant entry external dcl 43 ref 152 hcs_$status_minf 000030 constant entry external dcl 51 ref 114 initiate_dir 000105 automatic char(168) packed unaligned dcl 35 set ref 78* 87* 114* 152* ioa_ 000016 constant entry external dcl 39 ref 156 my_name 000100 automatic char(18) initial packed unaligned dcl 33 set ref 33* null builtin function dcl 65 ref 71 153 ptr_array 000010 internal static pointer array dcl 58 set ref 104* 124 138* queue_ctl_ptr 150 based pointer level 3 dcl 2-17 set ref 90* release_temp_segments_ 000026 constant entry external dcl 48 ref 138 station_ctl_ptr 154 based pointer level 3 dcl 2-17 set ref 93* sys_info$max_seg_size 000032 external static fixed bin(18,0) dcl 63 ref 125 125 system_ctl_ptr 156 based pointer level 3 dcl 2-17 set ref 96* terminal_ctl_ptr 160 based pointer level 3 dcl 2-17 set ref 99* tree_ctl_ptr 162 based pointer level 3 dcl 2-17 set ref 124* 125 user_ctl based structure level 1 dcl 2-17 user_ctl_exists_sw 000012 internal static bit(1) initial dcl 2-11 set ref 73* 75 user_ctl_ptr 000014 internal static pointer dcl 2-15 set ref 86* 87 90 93 96 99 124 125 128 wait_ctl_ptr 164 based pointer level 3 dcl 2-17 set ref 128* x_name parameter char packed unaligned dcl 150 set ref 147 152* 156* x_ptr 000160 automatic pointer dcl 37 set ref 81 90 93 96 99 125 128 152* 153 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. cobol_mcs_$accept 000000 constant entry external dcl 1-3 cobol_mcs_$disable_input_queue 000000 constant entry external dcl 1-4 cobol_mcs_$disable_input_terminal 000000 constant entry external dcl 1-5 cobol_mcs_$disable_output 000000 constant entry external dcl 1-6 cobol_mcs_$enable_input_queue 000000 constant entry external dcl 1-7 cobol_mcs_$enable_input_terminal 000000 constant entry external dcl 1-8 cobol_mcs_$enable_output 000000 constant entry external dcl 1-9 cobol_mcs_$purge 000000 constant entry external dcl 1-11 cobol_mcs_$receive 000000 constant entry external dcl 1-12 cobol_mcs_$receive_wait 000000 constant entry external dcl 1-13 cobol_mcs_$send 000000 constant entry external dcl 1-14 cobol_mcs_$set_user_ctl_exists_sw 000000 constant entry external dcl 1-15 cobol_mcs_$stop_run 000000 constant entry external dcl 1-16 error_table_$action_not_performed external static fixed bin(35,0) dcl 61 NAMES DECLARED BY EXPLICIT CONTEXT. cmcs_initiate_ctl_ 000133 constant entry external dcl 26 initiate 000500 constant entry internal dcl 147 ref 79 89 92 95 98 101 127 release 000434 constant entry external dcl 134 NAME DECLARED BY CONTEXT OR IMPLICATION. substr builtin function ref 125 125 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1014 1054 646 1024 Length 1304 646 40 214 146 6 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cmcs_initiate_ctl_ 226 external procedure is an external procedure. initiate internal procedure shares stack frame of external procedure cmcs_initiate_ctl_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 ptr_array cmcs_initiate_ctl_ 000012 user_ctl_exists_sw cmcs_initiate_ctl_ 000014 user_ctl_ptr cmcs_initiate_ctl_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cmcs_initiate_ctl_ 000100 my_name cmcs_initiate_ctl_ 000105 initiate_dir cmcs_initiate_ctl_ 000160 x_ptr cmcs_initiate_ctl_ 000162 code cmcs_initiate_ctl_ 000163 TYPE cmcs_initiate_ctl_ 000164 BIT_COUNT cmcs_initiate_ctl_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return_mac ext_entry ext_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cobol_mcs_$get_user_ctl_exists_sw get_temp_segment_ get_wdir_ hcs_$initiate hcs_$status_minf ioa_ release_temp_segments_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. external_user_ctl_ptr sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 33 000117 26 000127 71 000152 73 000155 75 000164 78 000170 79 000176 81 000210 82 000213 86 000214 87 000217 89 000223 90 000231 92 000235 93 000243 95 000247 96 000255 98 000261 99 000267 101 000273 104 000301 107 000330 109 000332 110 000333 114 000334 117 000376 119 000400 120 000401 124 000402 125 000406 127 000415 128 000423 130 000427 132 000430 134 000431 138 000445 141 000474 143 000477 147 000500 152 000511 153 000556 156 000562 157 000604 161 000605 162 000606 ----------------------------------------------------------- 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