COMPILATION LISTING OF SEGMENT run Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-04-18_1140.23_Tue_mdt Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 run: 12 proc; 13 14 /* This procedure is the run command. The syntax is: 15* run {-control_structure} {main_program} {program_args} 16* If no exec_com is specified and -no_exec_com is not specified, main_program.run.ec in the main program's 17* directory is used. 18**/ 19 /* coded by Melanie Weaver August 1977 */ 20 /* modified June 1979 by Melanie Weaver */ 21 22 dcl (i, j, k, m, alng, nargs, nprogargs, ref_name_spec_count) 23 fixed bin; 24 dcl code fixed bin (35); 25 dcl type fixed bin (2); 26 dcl bit_cnt fixed bin (24); 27 28 dcl me char (3) init ("run") static options (constant); 29 dcl arg char (alng) based (aptr); 30 dcl (main_dir, arg_ec_name) 31 char (168); 32 dcl ec_name char (168) var; 33 dcl main_ename char (32); 34 35 dcl (no_ec, have_main) bit (1) aligned; 36 37 dcl (aptr, arglist_ptr, new_arglist_ptr, sys_areap) 38 ptr; 39 40 dcl (error_table_$noarg, error_table_$badopt) 41 fixed bin (35) ext; 42 43 dcl system_area area based (sys_areap); 44 45 dcl 1 control_structure aligned like run_control_structure; 46 47 dcl 1 char_desc aligned, 48 2 flag bit (1) unal init ("1"b), 49 2 type fixed bin (5) unal init (21), 50 2 packed bit (1) unal init ("1"b), 51 2 number_dims bit (4) unal init ("0"b), 52 2 size fixed bin (23) unal; 53 54 dcl 1 old_arglist aligned based (arglist_ptr), 55 2 (arg_count, code) fixed bin (17) unal, 56 2 (desc_count, mbz) fixed (17) unal, 57 2 args (nargs) ptr, 58 2 descs (nargs) ptr; 59 60 dcl 1 new_arglist aligned based (new_arglist_ptr), 61 2 (arg_count, code) fixed bin (17) unal, 62 2 (desc_count, mbz) fixed bin (17) unal, 63 2 args (nprogargs) ptr, 64 2 descs (nprogargs) ptr; 65 66 dcl (addr, hbound, length, null, rtrim, substr, unspec) 67 builtin; 68 69 dcl main_entry entry variable; 70 71 dcl cu_$arg_count entry () returns (fixed bin); 72 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 73 dcl cu_$arg_list_ptr entry () returns (ptr); 74 dcl com_err_ entry options (variable); 75 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 76 dcl hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), 77 fixed bin (35)); 78 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); 79 dcl hcs_$make_entry entry (ptr, char (*), char (*), entry, fixed bin (35)); 80 dcl cv_entry_ entry (char (*), ptr, fixed bin (35)) returns (entry); 81 dcl run_ entry (entry, ptr, ptr, fixed bin (35)); 82 dcl get_wdir_ entry () returns (char (168)); 83 dcl get_system_free_area_ entry () returns (ptr); 84 85 1 1 /* BEGIN INCLUDE FILE ... run_control_structure.incl.pl1 */ 1 2 1 3 /* written 3 April 1979 by Melanie Weaver */ 1 4 1 5 declare run_cs_ptr pointer; 1 6 1 7 declare 1 run_control_structure 1 8 aligned based (run_cs_ptr), 1 9 2 version fixed bin, 1 10 2 flags aligned, 1 11 3 ec bit (1) unaligned, /* on if run_ is to call exec_com */ 1 12 3 pad bit (35) unaligned, 1 13 2 reference_name_switch 1 14 fixed bin, /* indicates what reference names are used in run unit */ 1 15 2 time_limit fixed bin (35); /* interval in cpu seconds after which program is 1 16* to be interrupted */ 1 17 1 18 declare NEW_REFERENCE_NAMES fixed bin internal static options (constant) init (0); 1 19 declare COPY_REFERENCE_NAMES fixed bin internal static options (constant) init (1); 1 20 declare OLD_REFERENCE_NAMES fixed bin internal static options (constant) init (2); 1 21 1 22 declare run_control_structure_version_1 1 23 fixed bin internal static options (constant) init (1); 1 24 1 25 /* END INCLUDE FILE ... run_control_structure.incl.pl1 */ 86 87 88 unspec (control_structure) = "0"b; 89 control_structure.version = run_control_structure_version_1; 90 no_ec = "0"b; 91 ref_name_spec_count = 0; 92 93 nargs = cu_$arg_count (); 94 95 do i = 1 to nargs; /* find all control args */ 96 97 call cu_$arg_ptr (i, aptr, alng, code); 98 if code ^= 0 99 then do; 100 if code = error_table_$noarg 101 then goto no_main; 102 call com_err_ (code, me); 103 return; 104 end; 105 106 if (arg = "-exec_com") | (arg = "-ec") 107 then do; 108 i = i + 1; 109 control_structure.flags.ec = "1"b; 110 no_ec = "0"b; 111 call cu_$arg_ptr (i, aptr, alng, code); 112 if code ^= 0 113 then do; 114 call com_err_ (code, me, "exec_com name"); 115 return; 116 end; 117 ec_name = arg; 118 end; 119 120 else if (arg = "-no_exec_com") | (arg = "-nec") 121 then do; 122 control_structure.flags.ec = "0"b; 123 no_ec = "1"b; 124 end; 125 126 else if (arg = "-limit") | (arg = "-li") 127 then do; 128 i = i + 1; 129 call cu_$arg_ptr (i, aptr, alng, code); 130 if code ^= 0 131 then do; 132 call com_err_ (code, me, "time limit"); 133 return; 134 end; 135 control_structure.time_limit = cv_dec_check_ (arg, code); 136 if code ^= 0 137 then do; 138 call com_err_ (0, me, "Invalid time limit specification ^a.", arg); 139 return; 140 end; 141 end; 142 143 else if (arg = "-copy_reference_names") | (arg = "-crn") 144 then do; 145 control_structure.reference_name_switch = COPY_REFERENCE_NAMES; 146 ref_name_spec_count = ref_name_spec_count + 1; 147 end; 148 149 else if (arg = "-old_reference_names") | (arg = "-orn") 150 then do; 151 control_structure.reference_name_switch = OLD_REFERENCE_NAMES; 152 ref_name_spec_count = ref_name_spec_count + 1; 153 end; 154 155 else if (arg = "-new_reference_names") | (arg = "-nrn") 156 then do; 157 control_structure.reference_name_switch = NEW_REFERENCE_NAMES; 158 ref_name_spec_count = ref_name_spec_count + 1; 159 end; 160 161 else if substr (arg, 1, 1) = "-" 162 then do; 163 call com_err_ (error_table_$badopt, me, arg); 164 return; 165 end; 166 167 else do; /* main program name */ 168 169 if ^control_structure.flags.ec 170 then do; /* need to know dir of main program */ 171 call expand_pathname_ (arg, main_dir, main_ename, code); 172 if code ^= 0 173 then do; 174 call com_err_ (code, me, arg); 175 return; 176 end; 177 end; 178 have_main = "1"b; 179 goto setup_entry_var; 180 end; 181 182 end; 183 184 no_main: 185 have_main = "0"b; 186 187 setup_entry_var: 188 if ref_name_spec_count > 1 189 then do; 190 call com_err_ (0, me, "Only one reference name control argument may be specified."); 191 return; 192 end; 193 194 if control_structure.flags.ec 195 then if no_ec 196 then do; 197 call com_err_ (0, me, "Incompatible exec_com arguments specified."); 198 return; 199 end; 200 201 if ^control_structure.flags.ec 202 then if ^no_ec 203 then do; /* look for main_program.run.ec */ 204 if ^have_main 205 then do; 206 call com_err_ (0, me, "No exec_com or main program specified."); 207 return; 208 end; 209 call hcs_$status_minf (main_dir, rtrim (main_ename) || ".run.ec", 1, type, bit_cnt, code); 210 if code = 0 211 then do; 212 control_structure.flags.ec = "1"b; 213 ec_name = rtrim (main_dir) || ">" || rtrim (main_ename) || ".run.ec"; 214 end; 215 end; 216 217 if control_structure.flags.ec 218 then do; /* this is not an else clause because flag 219* could have been reset */ 220 call hcs_$make_entry (null, "exec_com", "exec_com", main_entry, code); 221 if code ^= 0 222 then do; 223 call com_err_ (code, me, "exec_com"); 224 return; 225 end; 226 i = i - 1; /* must pass ec name to ec */ 227 end; 228 229 else do; /* no exec_com; i is index of main */ 230 i = i + 1; /* don't pass name of main to main */ 231 main_entry = cv_entry_ (arg, null, code); 232 if code ^= 0 233 then do; 234 call com_err_ (code, me, arg); 235 return; 236 end; 237 end; 238 239 if i > nargs 240 then nprogargs = 0; 241 else nprogargs = nargs - i + 1; 242 243 sys_areap = get_system_free_area_ (); 244 allocate new_arglist in (sys_areap -> system_area) set (new_arglist_ptr); 245 246 arglist_ptr = cu_$arg_list_ptr (); 247 248 new_arglist.arg_count, new_arglist.desc_count = nprogargs * 2; 249 new_arglist.code = 4; 250 if control_structure.flags.ec 251 then do; /* set up ec_name arg */ 252 m = 2; 253 arg_ec_name = ec_name; /* can't pass varying string in command arglist */ 254 new_arglist.args (1) = addr (arg_ec_name); 255 char_desc.size = length (ec_name); 256 new_arglist.descs (1) = addr (char_desc); 257 end; 258 else m = 1; /* first arg is from original arg list */ 259 260 do j = m to nprogargs; 261 k = j + i - 1; 262 new_arglist.args (j) = old_arglist.args (k); 263 new_arglist.descs (j) = old_arglist.descs (k); 264 end; 265 266 call run_ (main_entry, new_arglist_ptr, addr (control_structure), code); 267 268 if code ^= 0 269 then call com_err_ (code, me); 270 271 free new_arglist_ptr -> new_arglist; 272 273 return; 274 275 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/00 1140.2 run.pl1 >udd>sm>ds>w>ml>run.pl1 86 1 03/27/82 0539.3 run_control_structure.incl.pl1 >ldd>incl>run_control_structure.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. COPY_REFERENCE_NAMES constant fixed bin(17,0) initial dcl 1-19 ref 145 NEW_REFERENCE_NAMES constant fixed bin(17,0) initial dcl 1-18 ref 157 OLD_REFERENCE_NAMES constant fixed bin(17,0) initial dcl 1-20 ref 151 addr builtin function dcl 66 ref 254 256 266 266 alng 000104 automatic fixed bin(17,0) dcl 22 set ref 97* 106 106 111* 117 120 120 126 126 129* 135 135 138 138 143 143 149 149 155 155 161 163 163 171 171 174 174 231 231 234 234 aptr 000324 automatic pointer dcl 37 set ref 97* 106 106 111* 117 120 120 126 126 129* 135 138 143 143 149 149 155 155 161 163 171 174 231 234 arg based char packed unaligned dcl 29 set ref 106 106 117 120 120 126 126 135* 138* 143 143 149 149 155 155 161 163* 171* 174* 231* 234* arg_count based fixed bin(17,0) level 2 packed packed unaligned dcl 60 set ref 248* arg_ec_name 000165 automatic char(168) packed unaligned dcl 30 set ref 253* 254 arglist_ptr 000326 automatic pointer dcl 37 set ref 246* 262 263 args 2 based pointer array level 2 in structure "old_arglist" dcl 54 in procedure "run" ref 262 args 2 based pointer array level 2 in structure "new_arglist" dcl 60 in procedure "run" set ref 254* 262* bit_cnt 000112 automatic fixed bin(24,0) dcl 26 set ref 209* char_desc 000340 automatic structure level 1 dcl 47 set ref 256 code 0(18) based fixed bin(17,0) level 2 in structure "new_arglist" packed packed unaligned dcl 60 in procedure "run" set ref 249* code 000110 automatic fixed bin(35,0) dcl 24 in procedure "run" set ref 97* 98 100 102* 111* 112 114* 129* 130 132* 135* 136 171* 172 174* 209* 210 220* 221 223* 231* 232 234* 266* 268 268* com_err_ 000022 constant entry external dcl 74 ref 102 114 132 138 163 174 190 197 206 223 234 268 control_structure 000334 automatic structure level 1 dcl 45 set ref 88* 266 266 cu_$arg_count 000014 constant entry external dcl 71 ref 93 cu_$arg_list_ptr 000020 constant entry external dcl 73 ref 246 cu_$arg_ptr 000016 constant entry external dcl 72 ref 97 111 129 cv_dec_check_ 000030 constant entry external dcl 78 ref 135 cv_entry_ 000034 constant entry external dcl 80 ref 231 desc_count 1 based fixed bin(17,0) level 2 packed packed unaligned dcl 60 set ref 248* descs based pointer array level 2 in structure "old_arglist" dcl 54 in procedure "run" ref 263 descs based pointer array level 2 in structure "new_arglist" dcl 60 in procedure "run" set ref 256* 263* ec 1 000334 automatic bit(1) level 3 packed packed unaligned dcl 45 set ref 109* 122* 169 194 201 212* 217 250 ec_name 000237 automatic varying char(168) dcl 32 set ref 117* 213* 253 255 error_table_$badopt 000012 external static fixed bin(35,0) dcl 40 set ref 163* error_table_$noarg 000010 external static fixed bin(35,0) dcl 40 ref 100 expand_pathname_ 000024 constant entry external dcl 75 ref 171 flag 000340 automatic bit(1) initial level 2 packed packed unaligned dcl 47 set ref 47* flags 1 000334 automatic structure level 2 dcl 45 get_system_free_area_ 000040 constant entry external dcl 83 ref 243 have_main 000323 automatic bit(1) dcl 35 set ref 178* 184* 204 hcs_$make_entry 000032 constant entry external dcl 79 ref 220 hcs_$status_minf 000026 constant entry external dcl 76 ref 209 i 000100 automatic fixed bin(17,0) dcl 22 set ref 95* 97* 108* 108 111* 128* 128 129* 226* 226 230* 230 239 241 261 j 000101 automatic fixed bin(17,0) dcl 22 set ref 260* 261 262 263* k 000102 automatic fixed bin(17,0) dcl 22 set ref 261* 262 263 length builtin function dcl 66 ref 255 m 000103 automatic fixed bin(17,0) dcl 22 set ref 252* 258* 260 main_dir 000113 automatic char(168) packed unaligned dcl 30 set ref 171* 209* 213 main_ename 000312 automatic char(32) packed unaligned dcl 33 set ref 171* 209 213 main_entry 000342 automatic entry variable dcl 69 set ref 220* 231* 266* me 000000 constant char(3) initial packed unaligned dcl 28 set ref 102* 114* 132* 138* 163* 174* 190* 197* 206* 223* 234* 268* nargs 000105 automatic fixed bin(17,0) dcl 22 set ref 93* 95 239 241 263 new_arglist based structure level 1 dcl 60 set ref 244 271 new_arglist_ptr 000330 automatic pointer dcl 37 set ref 244* 248 248 249 254 256 262 263 266* 271 no_ec 000322 automatic bit(1) dcl 35 set ref 90* 110* 123* 194 201 nprogargs 000106 automatic fixed bin(17,0) dcl 22 set ref 239* 241* 244 244 248 256 260 263 271 271 null builtin function dcl 66 ref 220 220 231 231 number_dims 0(08) 000340 automatic bit(4) initial level 2 packed packed unaligned dcl 47 set ref 47* old_arglist based structure level 1 dcl 54 packed 0(07) 000340 automatic bit(1) initial level 2 packed packed unaligned dcl 47 set ref 47* ref_name_spec_count 000107 automatic fixed bin(17,0) dcl 22 set ref 91* 146* 146 152* 152 158* 158 187 reference_name_switch 2 000334 automatic fixed bin(17,0) level 2 dcl 45 set ref 145* 151* 157* rtrim builtin function dcl 66 ref 209 213 213 run_ 000036 constant entry external dcl 81 ref 266 run_control_structure based structure level 1 dcl 1-7 run_control_structure_version_1 constant fixed bin(17,0) initial dcl 1-22 ref 89 size 0(12) 000340 automatic fixed bin(23,0) level 2 packed packed unaligned dcl 47 set ref 255* substr builtin function dcl 66 ref 161 sys_areap 000332 automatic pointer dcl 37 set ref 243* 244 system_area based area(1024) dcl 43 ref 244 time_limit 3 000334 automatic fixed bin(35,0) level 2 dcl 45 set ref 135* type 000111 automatic fixed bin(2,0) dcl 25 in procedure "run" set ref 209* type 0(01) 000340 automatic fixed bin(5,0) initial level 2 in structure "char_desc" packed packed unaligned dcl 47 in procedure "run" set ref 47* unspec builtin function dcl 66 set ref 88* version 000334 automatic fixed bin(17,0) level 2 dcl 45 set ref 89* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. get_wdir_ 000000 constant entry external dcl 82 hbound builtin function dcl 66 run_cs_ptr automatic pointer dcl 1-5 NAMES DECLARED BY EXPLICIT CONTEXT. no_main 000721 constant label dcl 184 ref 100 run 000155 constant entry external dcl 11 setup_entry_var 000722 constant label dcl 187 ref 179 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1760 2022 1606 1770 Length 2226 1606 42 167 152 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME run 314 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME run 000100 i run 000101 j run 000102 k run 000103 m run 000104 alng run 000105 nargs run 000106 nprogargs run 000107 ref_name_spec_count run 000110 code run 000111 type run 000112 bit_cnt run 000113 main_dir run 000165 arg_ec_name run 000237 ec_name run 000312 main_ename run 000322 no_ec run 000323 have_main run 000324 aptr run 000326 arglist_ptr run 000330 new_arglist_ptr run 000332 sys_areap run 000334 control_structure run 000340 char_desc run 000342 main_entry run THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out return_mac shorten_stack ext_entry op_alloc_ op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_count cu_$arg_list_ptr cu_$arg_ptr cv_dec_check_ cv_entry_ expand_pathname_ get_system_free_area_ hcs_$make_entry hcs_$status_minf run_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$noarg LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000154 47 000162 88 000174 89 000177 90 000201 91 000202 93 000203 95 000211 97 000221 98 000236 100 000240 102 000243 103 000257 106 000260 108 000272 109 000273 110 000275 111 000276 112 000313 114 000315 115 000344 117 000345 118 000356 120 000357 122 000367 123 000371 124 000373 126 000374 128 000404 129 000405 130 000422 132 000424 133 000451 135 000452 136 000475 138 000477 139 000533 141 000534 143 000535 145 000545 146 000547 147 000550 149 000551 151 000561 152 000563 153 000564 155 000565 157 000575 158 000577 159 000600 161 000601 163 000605 164 000631 169 000632 171 000635 172 000665 174 000667 175 000713 178 000714 179 000716 182 000717 184 000721 187 000722 190 000725 191 000752 194 000753 197 000761 198 001006 201 001007 204 001013 206 001015 207 001042 209 001043 210 001130 212 001133 213 001135 214 001211 217 001212 220 001215 221 001253 223 001255 224 001301 226 001302 227 001304 230 001305 231 001306 232 001340 234 001342 235 001366 239 001367 241 001374 243 001400 244 001407 246 001420 248 001427 249 001441 250 001443 252 001446 253 001450 254 001454 255 001456 256 001460 257 001464 258 001465 260 001467 261 001477 262 001502 263 001512 264 001532 266 001534 268 001553 271 001572 273 001601 ----------------------------------------------------------- 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