COMPILATION LISTING OF SEGMENT set_search_paths Compiled by: Multics PL/I Compiler, Release 30, of February 16, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 03/01/88 1331.6 mst Tue Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 15 /****^ HISTORY COMMENTS: 16* 1) change(87-10-15,Lippard), approve(87-10-26,MCR7788), 17* audit(88-01-13,GWMay), install(88-01-19,MR12.2-1016): 18* Added -inhibit_error (-ihe) and -no_inhibit_error (-nihe) to 19* where_search_paths. 20* 2) change(87-10-29,Lippard), approve(87-11-23,MCR7797), 21* audit(88-01-13,GWMay), install(88-01-19,MR12.2-1016): 22* Added -force (-fc), -inhibit_error (-ihe), and -no_inhibit_error (-nihe) 23* to add_search_paths. 24* 3) change(87-11-17,Lippard), approve(87-12-21,MCR7822), 25* audit(88-02-11,Blair), install(88-02-16,MR12.2-1023): 26* Added -initiated_segments (-is). 27* 4) change(87-11-19,Lippard), approve(87-12-21,MCR7822), 28* audit(88-02-11,Blair), install(88-02-16,MR12.2-1023): 29* Changed to use UIDs in pathname comparisons. 30* 5) change(87-11-23,Lippard), approve(87-12-21,MCR7822), 31* audit(88-02-11,Blair), install(88-02-16,MR12.2-1023): 32* Modified to requote pathnames returned by psp and wsp AFs, reject null 33* pathnames, and correct error message given when asp modifiers are given 34* out of position. 35* 6) change(88-02-25,Lippard), approve(87-12-21,PBF7822), 36* audit(88-02-25,Farley), install(88-03-01,MR12.2-1031): 37* Modified to consider matching UIDs on segments with different entry 38* names to be a non-match, so that peculiar uses of search paths 39* (e.g. azm's "structure" search list) will continue to work. 40* END HISTORY COMMENTS */ 41 42 43 /* format: off */ 44 45 /* Search Facility Command Interface 46* 47* Rewritten 06-Sep-78 by Monte Davidoff. 48* ssp -default added 07/01/80 S. Herbst 49**/ 50 set_search_paths: 51 ssp: 52 procedure; 53 54 /* automatic */ 55 56 declare af_return_string_length 57 fixed binary (21); 58 declare af_return_string_ptr pointer; 59 declare af_sw bit (1); /* on for active function, off for command */ 60 declare af_usage char (44); /* active function usage message */ 61 declare arg_list_ptr pointer; /* pointer to command's argument list */ 62 declare args_arg_count fixed binary; 63 declare args_ptr pointer; 64 declare cleanup_new_sl_info_ptr 65 pointer; /* pointers for cleanup_ */ 66 declare cleanup_sl_info_ptr pointer; 67 declare cleanup_sl_list_ptr pointer; 68 declare command char (32); /* what command this is */ 69 declare sys_err_ entry options (variable) variable; 70 declare usage char (44); /* command usage message */ 71 72 /* based */ 73 74 declare af_return_string char (af_return_string_length) varying based (af_return_string_ptr); 75 76 declare 1 args based (args_ptr), 77 2 arg_count fixed binary, /* how many arguments the command has */ 78 2 first_arg fixed binary, /* index of first non-control-arg argument */ 79 2 arg (args_arg_count refer (args.arg_count)), 80 3 ptr pointer, /* pointer to argument */ 81 3 len fixed binary (21), /* length of argument */ 82 3 next_arg fixed binary, /* index of next parsed argument */ 83 3 pathx fixed binary; /* if used, index of this argument in sl_info */ 84 85 /* builtin */ 86 87 declare addr builtin; 88 declare hbound builtin; 89 declare lbound builtin; 90 declare length builtin; 91 declare ltrim builtin; 92 declare null builtin; 93 declare rtrim builtin; 94 declare search builtin; 95 declare substr builtin; 96 97 /* condition */ 98 99 declare cleanup condition; 100 101 /* internal static */ 102 103 declare CHASE fixed bin (1) internal static options (constant) initial (1); 104 105 declare HT char (1) internal static options (constant) initial (" "); 106 declare SP char (1) internal static options (constant) initial (" "); 107 108 /* external static */ 109 110 declare error_table_$action_not_performed 111 fixed binary (35) external static; 112 declare error_table_$badarg fixed binary (35) external static; 113 declare error_table_$badopt fixed binary (35) external static; 114 declare error_table_$new_search_list 115 fixed binary (35) external static; 116 declare error_table_$not_act_fnc 117 fixed binary (35) external static; 118 119 /* external entry */ 120 121 declare absolute_pathname_ entry (char (*), char (*), fixed binary (35)); 122 declare active_fnc_err_ entry options (variable); 123 declare active_fnc_err_$af_suppress_name 124 entry options (variable); 125 declare com_err_ entry options (variable); 126 declare com_err_$suppress_name entry options (variable); 127 declare cu_$af_arg_count_rel entry (fixed binary, fixed binary (35), pointer); 128 declare cu_$af_return_arg_rel entry (fixed binary, pointer, fixed binary (21), fixed binary (35), pointer); 129 declare cu_$arg_list_ptr entry (pointer); 130 declare cu_$arg_ptr_rel entry (fixed binary, pointer, fixed binary (21), fixed binary (35), pointer); 131 declare expand_pathname_ entry (char (*), char (*), char (*), fixed binary (35)); 132 declare get_pdir_ entry returns(char(168)); 133 declare get_system_free_area_ entry () returns (pointer); 134 declare hcs_$get_uid_file entry (char (*), char (*), bit (36) aligned, fixed binary (35)); 135 declare hcs_$status_minf entry (char (*), char (*), fixed binary (1), fixed binary (2), fixed binary (24), 136 fixed binary (35)); 137 declare ioa_ entry options (variable); 138 declare ioa_$rsnnl entry options (variable); 139 declare search_paths_$delete_list 140 entry (char (*), pointer, fixed binary (35)); 141 declare search_paths_$find_all entry (char (*), pointer, char (*), char (*), pointer, fixed binary, pointer, 142 fixed binary (35)); 143 declare search_paths_$find_dir entry (char (*), pointer, char (*), char (*), char (*), fixed binary (35)); 144 declare search_paths_$get entry (char (*), bit (36), char (*), pointer, pointer, fixed binary, pointer, 145 fixed binary (35)); 146 declare search_paths_$list entry (pointer, pointer, fixed binary, pointer, fixed binary (35)); 147 declare search_paths_$set entry (char (*), pointer, pointer, fixed binary (35)); 148 declare user_info_$homedir entry (char(*)); 149 1 1 /* BEGIN INCLUDE FILE . . . sl_info.incl.pl1 */ 1 2 1 3 1 4 1 5 /****^ HISTORY COMMENTS: 1 6* 1) change(87-11-16,Lippard), approve(87-12-21,MCR7822), 1 7* audit(88-02-09,Blair), install(88-02-16,MR12.2-1023): 1 8* Modified to add INITIATED_SEGS type. 1 9* 2) change(87-11-19,Lippard), approve(87-12-21,MCR7822), 1 10* audit(88-02-09,Blair), install(88-02-16,MR12.2-1023): 1 11* Added uid to sl_info structure. 1 12* END HISTORY COMMENTS */ 1 13 1 14 1 15 declare 1 sl_info aligned based (sl_info_p), 1 16 2 version fixed binary, /* Must be 1 */ 1 17 2 num_paths fixed binary, /* Number of search paths */ 1 18 2 change_index_p pointer, /* Pointer to search list's update count */ 1 19 2 change_index fixed binary (71), /* This search list's update count */ 1 20 2 pad1 (6) bit (36), /* Must be zero */ 1 21 2 paths (sl_info_num_paths refer (sl_info.num_paths)), 1 22 3 type fixed binary, /* Type of search path */ 1 23 3 code fixed binary (35), /* Standard status code of search path */ 1 24 3 uid bit (36), /* Unique ID */ 1 25 3 pathname char (168) unaligned; /* Search pathname */ 1 26 1 27 declare sl_info_num_paths fixed binary; 1 28 declare sl_info_p pointer; 1 29 declare sl_info_version_1 fixed binary internal static options (constant) initial (1); 1 30 1 31 /* Keyword Types */ 1 32 1 33 declare ABSOLUTE_PATH fixed binary internal static options (constant) initial (0); 1 34 declare UNEXPANDED_PATH fixed binary internal static options (constant) initial (1); 1 35 declare REFERENCING_DIR fixed binary internal static options (constant) initial (3); 1 36 declare WORKING_DIR fixed binary internal static options (constant) initial (4); 1 37 declare PROCESS_DIR fixed binary internal static options (constant) initial (5); 1 38 declare HOME_DIR fixed binary internal static options (constant) initial (6); 1 39 declare INITIATED_SEGS fixed binary internal static options (constant) initial (7); 1 40 1 41 /* END INCLUDE FILE . . . sl_info.incl.pl1 */ 150 2 1 /* BEGIN INCLUDE FILE . . . sl_control_s.incl.pl1 */ 2 2 2 3 declare 1 sl_control_s unaligned based (addr (sl_control)), 2 4 2 af_pathname bit (1), /* "1"b => expand active functions */ 2 5 2 pad1 bit (1), /* Must be zero */ 2 6 2 key_ref_dir bit (1), /* "1"b => expand -referencing_dir keyword */ 2 7 2 key_work_dir bit (1), /* "1"b => expand -working_dir keyword */ 2 8 2 key_proc_dir bit (1), /* "1"b => expand -process_dir keyword */ 2 9 2 key_home_dir bit (1), /* "1"b => expand -home_dir keyword */ 2 10 2 pad2 bit (30); /* Must be zero */ 2 11 2 12 declare sl_control bit (36); 2 13 declare sl_control_default bit (36) internal static options (constant) initial ("101111"b); 2 14 2 15 /* END INCLUDE FILE . . . sl_control_s.incl.pl1 */ 151 3 1 /* BEGIN INCLUDE FILE . . . sl_list.incl.pl1 */ 3 2 3 3 declare 1 sl_list based, 3 4 2 version fixed binary, /* Must be 2 */ 3 5 2 link pointer, /* Pointer to structure for next list */ 3 6 2 name_count fixed binary, /* Number of synonyms of this search list */ 3 7 2 pad (3) bit (36), /* Must be zero */ 3 8 2 names (sl_list_name_count refer (sl_list.name_count)) char (32); 3 9 /* Synonyms of this search list */ 3 10 3 11 declare sl_list_name_count fixed binary; 3 12 declare sl_list_version_2 fixed binary internal static options (constant) initial (2); 3 13 3 14 /* END INCLUDE FILE . . . sl_list.incl.pl1 */ 152 4 1 /* --------------- BEGIN include file status_structures.incl.pl1 --------------- */ 4 2 4 3 /* Revised from existing include files 09/26/78 by C. D. Tavares */ 4 4 4 5 /* This include file contains branch and link structures returned by 4 6* hcs_$status_ and hcs_$status_long. */ 4 7 4 8 dcl 1 status_branch aligned based (status_ptr), 4 9 2 short aligned, 4 10 3 type fixed bin (2) unaligned unsigned, /* seg, dir, or link */ 4 11 3 nnames fixed bin (16) unaligned unsigned, /* number of names */ 4 12 3 names_relp bit (18) unaligned, /* see entry_names dcl */ 4 13 3 dtcm bit (36) unaligned, /* date/time contents last modified */ 4 14 3 dtu bit (36) unaligned, /* date/time last used */ 4 15 3 mode bit (5) unaligned, /* caller's effective access */ 4 16 3 raw_mode bit (5) unaligned, /* caller's raw "rew" modes */ 4 17 3 pad1 bit (8) unaligned, 4 18 3 records_used fixed bin (18) unaligned unsigned, /* number of NONZERO pages used */ 4 19 4 20 /* Limit of information returned by hcs_$status_ */ 4 21 4 22 2 long aligned, 4 23 3 dtd bit (36) unaligned, /* date/time last dumped */ 4 24 3 dtem bit (36) unaligned, /* date/time branch last modified */ 4 25 3 lvid bit (36) unaligned, /* logical volume ID */ 4 26 3 current_length fixed bin (12) unaligned unsigned, /* number of last page used */ 4 27 3 bit_count fixed bin (24) unaligned unsigned, /* reported length in bits */ 4 28 3 pad2 bit (8) unaligned, 4 29 3 copy_switch bit (1) unaligned, /* copy switch */ 4 30 3 tpd_switch bit (1) unaligned, /* transparent to paging device switch */ 4 31 3 mdir_switch bit (1) unaligned, /* is a master dir */ 4 32 3 damaged_switch bit (1) unaligned, /* salvager warned of possible damage */ 4 33 3 synchronized_switch bit (1) unaligned, /* DM synchronized file */ 4 34 3 pad3 bit (5) unaligned, 4 35 3 ring_brackets (0:2) fixed bin (6) unaligned unsigned, 4 36 3 uid bit (36) unaligned; /* unique ID */ 4 37 4 38 dcl 1 status_link aligned based (status_ptr), 4 39 2 type fixed bin (2) unaligned unsigned, /* as above */ 4 40 2 nnames fixed bin (16) unaligned unsigned, 4 41 2 names_relp bit (18) unaligned, 4 42 2 dtem bit (36) unaligned, 4 43 2 dtd bit (36) unaligned, 4 44 2 pathname_length fixed bin (17) unaligned, /* see pathname */ 4 45 2 pathname_relp bit (18) unaligned; /* see pathname */ 4 46 4 47 dcl status_entry_names (status_branch.nnames) character (32) aligned 4 48 based (pointer (status_area_ptr, status_branch.names_relp)), 4 49 /* array of names returned */ 4 50 status_pathname character (status_link.pathname_length) aligned 4 51 based (pointer (status_area_ptr, status_link.pathname_relp)), 4 52 /* link target path */ 4 53 status_area_ptr pointer, 4 54 status_ptr pointer; 4 55 4 56 dcl (Link initial (0), 4 57 Segment initial (1), 4 58 Directory initial (2)) fixed bin internal static options (constant); 4 59 /* values for type fields declared above */ 4 60 4 61 /* ---------------- END include file status_structures.incl.pl1 ---------------- */ 153 154 155 /* set_search_paths */ 156 157 call initialize ("set_search_paths", "search_list {search_paths} {-control_args}", ""); 158 call cu_$arg_list_ptr (arg_list_ptr); 159 on cleanup 160 call cleanup_; 161 call set_search_paths_; 162 call cleanup_; 163 return; 164 165 add_search_paths: 166 asp: 167 entry; 168 169 call initialize ("add_search_paths", "search_list search_paths", ""); 170 call cu_$arg_list_ptr (arg_list_ptr); 171 on cleanup 172 call cleanup_; 173 call add_search_paths_; 174 call cleanup_; 175 return; 176 177 delete_search_paths: 178 dsp: 179 entry; 180 181 call initialize ("delete_search_paths", "search_list {search_paths} {-control_args}", ""); 182 call cu_$arg_list_ptr (arg_list_ptr); 183 on cleanup 184 call cleanup_; 185 call delete_search_paths_; 186 call cleanup_; 187 return; 188 189 print_search_paths: 190 psp: 191 entry; 192 193 call initialize ("print_search_paths", "{search_lists} {-control_args}", "search_list {-control_args}"); 194 call cu_$arg_list_ptr (arg_list_ptr); 195 on cleanup 196 call cleanup_; 197 call print_search_paths_; 198 call cleanup_; 199 return; 200 201 where_search_paths: 202 wsp: 203 entry; 204 205 call initialize ("where_search_paths", "search_list entryname {-control_args}", ""); 206 call cu_$arg_list_ptr (arg_list_ptr); 207 on cleanup 208 call cleanup_; 209 call where_search_paths_; 210 call cleanup_; 211 return; 212 213 set_search_paths_: 214 procedure; 215 216 declare argx fixed binary; 217 declare code fixed binary (35); 218 declare control_arg_sws (2) bit (1); 219 declare old_argx fixed binary; 220 declare parsed_arg_count fixed binary; 221 declare pathx fixed binary; 222 declare sl_name char (32); 223 224 declare argx_string char (args.arg (argx).len) based (args.arg (argx).ptr); 225 226 declare 1 ssp_args aligned internal static options (constant), 227 2 keywords (10) char (20) 228 initial ("-home_dir", "-hd", "-process_dir", "-pd", "-referencing_dir", "-rd", 229 "-working_dir", "-wd", "-initiated_segments", "-is"), 230 2 modifiers, 231 3 name (1) char (1) initial (""), 232 3 has_arg (1) bit (1) initial ("0"b), 233 2 control_args, 234 3 name (4) char (8) initial ("-brief", "-bf", "-default", "-df"), 235 3 switch (4) fixed binary initial (1, 1, 2, 2), 236 3 value (4) bit (1) initial ("1"b, "1"b, "1"b, "1"b); 237 declare BRIEF_SW fixed binary internal static options (constant) initial (1); 238 declare DEFAULT_SW fixed binary internal static options (constant) initial (2); 239 240 call get_args (arg_list_ptr, ssp_args, control_arg_sws, parsed_arg_count, code); 241 if code ^= 0 242 then return; 243 244 if parsed_arg_count = 0 245 then do; 246 call usage_err_; 247 return; 248 end; 249 250 if parsed_arg_count > 1 & control_arg_sws (DEFAULT_SW) 251 then do; 252 call sys_err_ (0, command, "Search paths cannot be specified with -default."); 253 return; 254 end; 255 256 argx = args.first_arg; 257 call check_search_list_name (argx_string, sl_name, code); 258 if code ^= 0 259 then return; 260 261 /* -initiated_segments may only be used with linker search paths. */ 262 old_argx = argx; 263 do argx = args.arg (argx).next_arg repeat args.arg (argx).next_arg while (argx ^= 0); 264 if (argx_string = "-initiated_segments" | argx_string = "-is") & sl_name ^= "linker" 265 then do; 266 code = error_table_$badopt; 267 call sys_err_ ((0), command, "The ""^a"" keyword may only be used with the linker search list.", argx_string); 268 return; 269 end; 270 end; 271 argx = old_argx; 272 273 call create_sl_info (parsed_arg_count - 1, cleanup_sl_info_ptr); 274 275 args.arg (*).pathx = 0; 276 if cleanup_sl_info_ptr ^= null 277 then do pathx = 1 to cleanup_sl_info_ptr -> sl_info.num_paths; 278 argx = args.arg (argx).next_arg; 279 280 if args.arg (argx).len = 0 281 then do; 282 code = error_table_$badarg; 283 call sys_err_ (code, command, """"""); 284 return; 285 end; 286 287 call get_path_type (argx_string, cleanup_sl_info_ptr -> sl_info.paths (pathx).type, 288 cleanup_sl_info_ptr -> sl_info.paths (pathx).pathname, code); 289 if code ^= 0 290 then return; 291 292 if path_index (cleanup_sl_info_ptr, cleanup_sl_info_ptr -> sl_info.paths (pathx).pathname) < pathx 293 then do; 294 call sys_err_ (0, command, "Search path specified twice. ^a", 295 cleanup_sl_info_ptr -> sl_info.paths (pathx).pathname); 296 return; 297 end; 298 299 args.arg (argx).pathx = pathx; 300 end; 301 302 call set_the_search_paths_of_a_search_list (sl_name, control_arg_sws (BRIEF_SW), cleanup_sl_info_ptr, code); 303 if code ^= 0 & code ^= error_table_$new_search_list 304 then return; 305 306 call check_paths_for_warnings (sl_name, cleanup_sl_info_ptr); 307 end set_search_paths_; 308 309 add_search_paths_: 310 procedure; 311 312 declare argx fixed binary; 313 declare code fixed binary (35); 314 declare control_arg_sws (2) bit (1); 315 declare ignore_current_list bit (1); 316 declare old_argx fixed binary; 317 declare parsed_arg_count fixed binary; 318 declare path_count fixed binary; 319 declare pathx fixed binary; 320 declare sl_name char (32); 321 322 declare argx_string char (args.arg (argx).len) based (args.arg (argx).ptr); 323 324 declare 1 asp_args aligned internal static options (constant), 325 2 keywords (10) char (20) 326 initial ("-home_dir", "-hd", "-process_dir", "-pd", "-referencing_dir", "-rd", 327 "-working_dir", "-wd", "-initiated_segments", "-is"), 328 2 modifiers, 329 3 name (8) char (8) 330 initial ("-first", "-ft", "-last", "-lt", "-before", "-be", "-after", "-af"), 331 3 has_arg (8) bit (1) initial ("0"b, "0"b, "0"b, "0"b, "1"b, "1"b, "1"b, "1"b), 332 2 control_args, 333 3 name (8) char (17) initial ("-force", "-fc", "-no_force", "-nfc", "-inhibit_error", "-ihe", "-no_inhibit_error", "-nihe"), 334 3 switch (8) fixed binary initial (1, 1, 1, 1, 2, 2, 2, 2), 335 3 value (8) bit (1) initial ("1"b, "1"b, "0"b, "0"b, "1"b, "1"b, "0"b, "0"b); 336 declare FORCE_SW fixed binary internal static options (constant) initial (1); 337 declare INHIBIT_ERR_SW fixed binary internal static options (constant) initial (2); 338 339 call get_args (arg_list_ptr, asp_args, control_arg_sws, parsed_arg_count, code); 340 if code ^= 0 341 then return; 342 343 if parsed_arg_count < 2 344 then do; 345 call usage_err_; 346 return; 347 end; 348 349 argx = args.first_arg; 350 call check_search_list_name (argx_string, sl_name, code); 351 if code ^= 0 352 then return; 353 354 /* -initiated_segments may only be used with linker search paths. */ 355 old_argx = argx; 356 do argx = args.arg (argx).next_arg repeat args.arg (argx).next_arg while (argx ^= 0); 357 if (argx_string = "-initiated_segments" | argx_string = "-is") & sl_name ^= "linker" 358 then do; 359 code = error_table_$badopt; 360 call sys_err_ ((0), command, "The ""^a"" keyword may only be used with the linker search list.", argx_string); 361 return; 362 end; 363 end; 364 argx = old_argx; 365 366 call search_paths_$get (sl_name, ""b, "", null, get_system_free_area_ (), sl_info_version_1, cleanup_sl_info_ptr, 367 code); 368 if code ^= 0 369 then do; 370 call sys_err_ (code, command, "^a", sl_name); 371 return; 372 end; 373 374 ignore_current_list = "0"b; 375 376 /* Begin block with local variables for compatibility with the style of 377* the rest of program (and because this block contains local variables 378* having the same names as others outside the block). */ 379 if control_arg_sws (FORCE_SW) 380 then begin; 381 declare delete_count fixed binary; 382 declare new_pathx fixed binary; 383 declare pathname character (168); 384 declare pathx fixed binary; 385 386 /* See which paths are duplicates, and delete them. */ 387 delete_count = 0; 388 do argx = args.arg (argx).next_arg repeat args.arg (argx).next_arg while (argx ^= 0); 389 call get_path_type (argx_string, (0), pathname, code); 390 if code ^= 0 391 then return; 392 pathx = path_index (cleanup_sl_info_ptr, pathname); 393 if pathx ^= 0 394 then do; 395 cleanup_sl_info_ptr -> sl_info.paths (pathx).type = 0; 396 cleanup_sl_info_ptr -> sl_info.paths (pathx).pathname = ""; 397 delete_count = delete_count + 1; 398 end; 399 end; 400 401 /* They're all duplicates. */ 402 if delete_count = cleanup_sl_info_ptr -> sl_info.num_paths 403 then do; 404 ignore_current_list = "1"b; 405 path_count = 0; 406 end; 407 408 /* Delete the duplicates. */ 409 else if delete_count ^= 0 410 then do; 411 call create_sl_info (cleanup_sl_info_ptr -> sl_info.num_paths - delete_count, cleanup_new_sl_info_ptr); 412 413 new_pathx = 1; 414 do pathx = 1 to cleanup_sl_info_ptr -> sl_info.num_paths 415 while (new_pathx <= cleanup_new_sl_info_ptr -> sl_info.num_paths); 416 if cleanup_sl_info_ptr -> sl_info.paths (pathx).pathname ^= "" 417 then do; 418 cleanup_new_sl_info_ptr -> sl_info.paths (new_pathx).type = 419 cleanup_sl_info_ptr -> sl_info.paths (pathx).type; 420 cleanup_new_sl_info_ptr -> sl_info.paths (new_pathx).pathname = 421 cleanup_sl_info_ptr -> sl_info.paths (pathx).pathname; 422 cleanup_new_sl_info_ptr -> sl_info.paths (new_pathx).uid = 423 cleanup_sl_info_ptr -> sl_info.paths (pathx).uid; 424 new_pathx = new_pathx + 1; 425 end; 426 end; 427 428 free cleanup_sl_info_ptr -> sl_info; 429 cleanup_sl_info_ptr = cleanup_new_sl_info_ptr; 430 cleanup_new_sl_info_ptr = null (); 431 end; 432 end; 433 434 /* If they're all duplicates, just create a whole new search list. */ 435 if ignore_current_list 436 then do; 437 call create_sl_info (parsed_arg_count - 1, cleanup_new_sl_info_ptr); 438 cleanup_new_sl_info_ptr -> sl_info.paths (*).type = 0; 439 cleanup_new_sl_info_ptr -> sl_info.paths (*).pathname = ""; 440 cleanup_new_sl_info_ptr -> sl_info.paths (*).uid = ""b; 441 end; 442 443 /* Otherwise, just add the new and duplicate paths. */ 444 else do; 445 path_count = cleanup_sl_info_ptr -> sl_info.num_paths; 446 call create_sl_info (path_count + parsed_arg_count - 1, cleanup_new_sl_info_ptr); 447 cleanup_new_sl_info_ptr -> sl_info.paths (*).type = 0; 448 cleanup_new_sl_info_ptr -> sl_info.paths (*).pathname = ""; 449 cleanup_new_sl_info_ptr -> sl_info.paths (*).uid = ""b; 450 451 do pathx = 1 to path_count; 452 cleanup_new_sl_info_ptr -> sl_info.paths (pathx).type = 453 cleanup_sl_info_ptr -> sl_info.paths (pathx).type; 454 cleanup_new_sl_info_ptr -> sl_info.paths (pathx).pathname = 455 cleanup_sl_info_ptr -> sl_info.paths (pathx).pathname; 456 cleanup_new_sl_info_ptr -> sl_info.paths (pathx).uid = 457 cleanup_sl_info_ptr -> sl_info.paths (pathx).uid; 458 end; 459 end; 460 461 free cleanup_sl_info_ptr -> sl_info; 462 cleanup_sl_info_ptr = null; 463 464 call add_search_paths_to_sl_info (sl_name, cleanup_new_sl_info_ptr, control_arg_sws (INHIBIT_ERR_SW), path_count, code); 465 if code ^= 0 466 then return; 467 468 call create_sl_info (path_count, cleanup_sl_info_ptr); 469 do pathx = 1 to path_count; 470 cleanup_sl_info_ptr -> sl_info.paths (pathx).type = cleanup_new_sl_info_ptr -> sl_info.paths (pathx).type; 471 cleanup_sl_info_ptr -> sl_info.paths (pathx).pathname = 472 cleanup_new_sl_info_ptr -> sl_info.paths (pathx).pathname; 473 cleanup_sl_info_ptr -> sl_info.paths (pathx).uid = 474 cleanup_new_sl_info_ptr -> sl_info.paths (pathx).uid; 475 end; 476 477 free cleanup_new_sl_info_ptr -> sl_info; 478 cleanup_new_sl_info_ptr = null; 479 480 call set_the_search_paths_of_a_search_list (sl_name, "0"b, cleanup_sl_info_ptr, code); 481 if code ^= 0 482 then return; 483 484 if ^control_arg_sws (INHIBIT_ERR_SW) 485 then call check_paths_for_warnings (sl_name, cleanup_sl_info_ptr); 486 end add_search_paths_; 487 488 delete_search_paths_: 489 procedure; 490 491 declare argx fixed binary; 492 declare code fixed binary (35); 493 declare control_arg_sws (1) bit (1); 494 declare old_argx fixed binary; 495 declare parsed_arg_count fixed binary; 496 declare sl_name char (32); 497 498 declare argx_string char (args.arg (argx).len) based (args.arg (argx).ptr); 499 500 declare 1 dsp_args aligned internal static options (constant), 501 2 keywords (10) char (20) 502 initial ("-home_dir", "-hd", "-process_dir", "-pd", "-referencing_dir", "-rd", "-working_dir", "-wd", "-initiated_segments", "-is"), 503 2 modifiers, 504 3 name (1) char (1) initial (""), 505 3 has_arg (1) bit (1) initial ("0"b), 506 2 control_args, 507 3 name (2) char (4) initial ("-all", "-a"), 508 3 switch (2) fixed binary initial (1, 1), 509 3 value (2) bit (1) initial ("1"b, "1"b); 510 declare ALL_SW fixed binary internal static options (constant) initial (1); 511 512 call get_args (arg_list_ptr, dsp_args, control_arg_sws, parsed_arg_count, code); 513 if code ^= 0 514 then return; 515 516 if parsed_arg_count = 0 517 then do; 518 call usage_err_; 519 return; 520 end; 521 522 argx = args.first_arg; 523 call check_search_list_name (argx_string, sl_name, code); 524 if code ^= 0 525 then return; 526 527 /* -initiated_segments may only be used with linker search paths. */ 528 old_argx = argx; 529 do argx = args.arg (argx).next_arg repeat args.arg (argx).next_arg while (argx ^= 0); 530 if (argx_string = "-initiated_segments" | argx_string = "-is") & sl_name ^= "linker" 531 then do; 532 code = error_table_$badopt; 533 call sys_err_ ((0), command, "The ""^a"" keyword may only be used with the linker search list.", argx_string); 534 return; 535 end; 536 end; 537 argx = old_argx; 538 539 if control_arg_sws (ALL_SW) 540 then do; 541 call search_paths_$delete_list (sl_name, null, code); 542 if code ^= 0 543 then do; 544 call sys_err_ (code, command, "^a", sl_name); 545 return; 546 end; 547 end; 548 else begin; 549 declare delete_count fixed binary; 550 declare new_pathx fixed binary; 551 declare pathname character (168); 552 declare pathx fixed binary; 553 554 call search_paths_$get (sl_name, ""b, "", null, get_system_free_area_ (), sl_info_version_1, 555 cleanup_sl_info_ptr, code); 556 if code ^= 0 557 then do; 558 call sys_err_ (code, command, "^a", sl_name); 559 return; 560 end; 561 562 delete_count = 0; 563 do argx = args.arg (argx).next_arg repeat args.arg (argx).next_arg while (argx ^= 0); 564 if args.arg (argx).len = 0 565 then do; 566 code = error_table_$badarg; 567 call sys_err_ (code, command, """"""); 568 return; 569 end; 570 call get_path_type (argx_string, (0), pathname, code); 571 if code ^= 0 572 then return; 573 pathx = path_index (cleanup_sl_info_ptr, pathname); 574 if pathx = 0 575 then call sys_err_ (0, command, "Search path ^a is not in the ^a search list.", argx_string, sl_name) 576 ; 577 else do; 578 cleanup_sl_info_ptr -> sl_info.paths (pathx).type = 0; 579 cleanup_sl_info_ptr -> sl_info.paths (pathx).pathname = ""; 580 cleanup_sl_info_ptr -> sl_info.paths (pathx).uid = ""b; 581 delete_count = delete_count + 1; 582 end; 583 end; 584 585 if delete_count = cleanup_sl_info_ptr -> sl_info.num_paths 586 then do; 587 call sys_err_ (error_table_$action_not_performed, command, "The search list would be empty."); 588 return; 589 end; 590 591 if delete_count = 0 592 then do; 593 call sys_err_ (0, command, "No search paths deleted."); 594 return; 595 end; 596 597 call create_sl_info (cleanup_sl_info_ptr -> sl_info.num_paths - delete_count, cleanup_new_sl_info_ptr); 598 599 new_pathx = 1; 600 do pathx = 1 to cleanup_sl_info_ptr -> sl_info.num_paths 601 while (new_pathx <= cleanup_new_sl_info_ptr -> sl_info.num_paths); 602 if cleanup_sl_info_ptr -> sl_info.paths (pathx).pathname ^= "" 603 then do; 604 cleanup_new_sl_info_ptr -> sl_info.paths (new_pathx).type = 605 cleanup_sl_info_ptr -> sl_info.paths (pathx).type; 606 cleanup_new_sl_info_ptr -> sl_info.paths (new_pathx).pathname = 607 cleanup_sl_info_ptr -> sl_info.paths (pathx).pathname; 608 cleanup_new_sl_info_ptr -> sl_info.paths (new_pathx).uid = 609 cleanup_sl_info_ptr -> sl_info.paths (pathx).uid; 610 new_pathx = new_pathx + 1; 611 end; 612 end; 613 614 call set_the_search_paths_of_a_search_list (sl_name, "0"b, cleanup_new_sl_info_ptr, code); 615 end; 616 end delete_search_paths_; 617 618 print_search_paths_: 619 procedure; 620 621 declare code fixed binary (35); 622 declare control_arg_sws (1) bit (1); 623 declare parsed_arg_count fixed binary; 624 625 declare 1 psp_args aligned internal static options (constant), 626 2 keywords (1) char (1) initial (""), 627 2 modifiers, 628 3 name (1) char (1) initial (""), 629 3 has_arg (1) bit (1) initial ("0"b), 630 2 control_args, 631 3 name (2) char (12) initial ("-expanded", "-exp"), 632 3 switch (2) fixed binary initial (1, 1), 633 3 value (2) bit (1) initial ("1"b, "1"b); 634 declare EXPAND_SW fixed binary internal static options (constant) initial (1); 635 636 call check_for_active_function (arg_list_ptr, code); 637 if code ^= 0 638 then return; 639 640 call get_args (arg_list_ptr, psp_args, control_arg_sws, parsed_arg_count, code); 641 if code ^= 0 642 then return; 643 644 if af_sw & parsed_arg_count ^= 1 645 then do; 646 call usage_err_; 647 return; 648 end; 649 650 if parsed_arg_count = 0 651 then do; 652 call search_paths_$list (null, get_system_free_area_ (), sl_list_version_2, cleanup_sl_list_ptr, code); 653 if code ^= 0 654 then do; 655 call sys_err_ (code, command); 656 return; 657 end; 658 659 if cleanup_sl_list_ptr = null 660 then call sys_err_ (0, command, "Search segment is empty."); 661 else begin; 662 declare namex fixed binary; 663 declare sl_list_ptr pointer; 664 665 do sl_list_ptr = cleanup_sl_list_ptr repeat sl_list_ptr -> sl_list.link 666 while (sl_list_ptr ^= null); 667 do namex = 1 to sl_list_ptr -> sl_list.name_count; 668 call output_one_line (sl_list_ptr -> sl_list.names (namex)); 669 end; 670 call print_search_list (sl_list_ptr -> sl_list.names (1), "0"b, 671 control_arg_sws (EXPAND_SW), cleanup_sl_info_ptr); 672 end; 673 end; 674 end; 675 else begin; 676 declare argx fixed binary; 677 declare sl_name char (32); 678 679 declare argx_string char (args.arg (argx).len) based (args.arg (argx).ptr); 680 681 do argx = args.first_arg repeat args.arg (argx).next_arg while (argx ^= 0); 682 call check_search_list_name (argx_string, sl_name, code); 683 if code = 0 684 then call print_search_list (sl_name, ^af_sw, control_arg_sws (EXPAND_SW), cleanup_sl_info_ptr); 685 end; 686 end; 687 end print_search_paths_; 688 689 where_search_paths_: 690 procedure; 691 692 declare argx fixed binary; 693 declare code fixed binary (35); 694 declare control_arg_sws (2) bit (1); 695 declare old_argx fixed binary; 696 declare parsed_arg_count fixed binary; 697 declare sl_name char (32); 698 699 declare argx_string char (args.arg (argx).len) based (args.arg (argx).ptr); 700 701 declare 1 wsp_args aligned internal static options (constant), 702 2 keywords (1) char (1) initial (""), 703 2 modifiers, 704 3 name (1) char (1) initial (""), 705 3 has_arg (1) bit (1) initial ("0"b), 706 2 control_args, 707 3 name (6) char (17) initial ("-all", "-a", "-inhibit_error", "-ihe", "-no_inhibit_error", "-nihe"), 708 3 switch (6) fixed binary initial (1, 1, 2, 2, 2, 2), 709 3 value (6) bit (1) initial ("1"b, "1"b, "1"b, "1"b, "0"b, "0"b); 710 declare ALL_SW fixed binary internal static options (constant) initial (1); 711 declare INHIBIT_ERR_SW fixed binary internal static options (constant) initial (2); 712 713 call check_for_active_function (arg_list_ptr, code); 714 if code ^= 0 715 then return; 716 717 call get_args (arg_list_ptr, wsp_args, control_arg_sws, parsed_arg_count, code); 718 if code ^= 0 719 then return; 720 721 if parsed_arg_count ^= 2 722 then do; 723 call usage_err_; 724 return; 725 end; 726 727 argx = args.first_arg; 728 call check_search_list_name (argx_string, sl_name, code); 729 if code ^= 0 730 then return; 731 732 /* -initiated_segments may only be used with linker search paths. */ 733 old_argx = argx; 734 do argx = args.arg (argx).next_arg repeat args.arg (argx).next_arg while (argx ^= 0); 735 if (argx_string = "-initiated_segments" | argx_string = "-is") & sl_name ^= "linker" 736 then do; 737 code = error_table_$badopt; 738 call sys_err_ (code, command, "^a", argx_string); 739 return; 740 end; 741 end; 742 argx = old_argx; 743 744 argx = args.arg (argx).next_arg; 745 if args.arg (argx).len = 0 746 then do; 747 code = error_table_$badarg; 748 call sys_err_ (code, command, """"""); 749 return; 750 end; 751 if control_arg_sws (ALL_SW) 752 then begin; 753 declare pathx fixed binary; 754 755 call search_paths_$find_all (sl_name, null, argx_string, "", get_system_free_area_ (), sl_info_version_1, 756 cleanup_sl_info_ptr, code); 757 if code ^= 0 758 then do; 759 if control_arg_sws (INHIBIT_ERR_SW) & af_sw then af_return_string = ""; 760 else call sys_err_ (code, command, "^a in ^a search list.", argx_string, sl_name); 761 return; 762 end; 763 764 do pathx = 1 to cleanup_sl_info_ptr -> sl_info.num_paths; 765 call output_pathname (cleanup_sl_info_ptr -> sl_info.paths (pathx).pathname, argx_string); 766 end; 767 end; 768 else begin; 769 declare dir_name char (168); 770 771 call search_paths_$find_dir (sl_name, null, argx_string, "", dir_name, code); 772 if code ^= 0 773 then do; 774 if control_arg_sws (INHIBIT_ERR_SW) & af_sw then af_return_string = ""; 775 else call sys_err_ (code, command, "^a in ^a search list.", argx_string, sl_name); 776 return; 777 end; 778 call output_pathname (dir_name, argx_string); 779 end; 780 end where_search_paths_; 781 782 /* Add the search path arguments of add_search_paths to an sl_info structure. 783* 784* The sl_info structure must have enough room for all the possible 785* search paths in the argument list. 786**/ 787 add_search_paths_to_sl_info: 788 procedure (sl_name, sl_info_ptr, inhibit_err, path_count, code); 789 790 declare sl_name char (*); /* (Input) search list name */ 791 declare sl_info_ptr pointer; /* (Input) pointer to a "large enough" sl_info */ 792 declare inhibit_err bit (1); /* (Input) if warnings shouldn't be printed */ 793 declare path_count fixed binary; /* (Updated) number of paths in sl_info */ 794 declare code fixed binary (35); /* (Output) standard status code */ 795 796 declare argx fixed binary; 797 declare dname char (168); 798 declare ename char (32); 799 declare error bit (1); 800 declare insert_index fixed binary; 801 declare pathname char (168); 802 declare type fixed binary; 803 declare uid bit (36) aligned; 804 805 code = 0; 806 807 args.arg (*).pathx = 0; 808 do argx = args.arg (args.first_arg).next_arg repeat args.arg (argx).next_arg while (argx ^= 0); 809 if args.arg (argx).len = 0 810 then do; 811 code = error_table_$badarg; 812 call sys_err_ (code, command, """"""); 813 return; 814 end; 815 call get_search_path_and_position (sl_info_ptr, path_count, argx, inhibit_err, type, pathname, insert_index, error, code); 816 if code ^= 0 817 then return; 818 819 if ^error 820 then begin; 821 declare pathx fixed binary; 822 823 do pathx = path_count to insert_index by -1; 824 sl_info_ptr -> sl_info.paths (pathx + 1).type = sl_info_ptr -> sl_info.paths (pathx).type; 825 sl_info_ptr -> sl_info.paths (pathx + 1).pathname = 826 sl_info_ptr -> sl_info.paths (pathx).pathname; 827 sl_info_ptr -> sl_info.paths (pathx + 1).uid = 828 sl_info_ptr -> sl_info.paths (pathx).uid; 829 end; 830 831 path_count = path_count + 1; 832 sl_info_ptr -> sl_info.paths (insert_index).type = type; 833 sl_info_ptr -> sl_info.paths (insert_index).pathname = pathname; 834 835 /* The following two expansions need to be done for the linker search 836* list in order to set the UID correctly. */ 837 if type = PROCESS_DIR 838 then pathname = get_pdir_ (); 839 840 else if type = HOME_DIR 841 then call user_info_$homedir (pathname); 842 843 uid = ""b; 844 if type = ABSOLUTE_PATH | type = HOME_DIR | type = PROCESS_DIR 845 then do; 846 call expand_pathname_ (pathname, dname, ename, code); 847 if code = 0 848 then call hcs_$get_uid_file (dname, ename, uid, (0)); 849 end; 850 sl_info_ptr -> sl_info.paths (insert_index).uid = uid; 851 852 do pathx = 1 to argx - 1; 853 if args.arg (pathx).pathx >= insert_index 854 then args.arg (pathx).pathx = args.arg (pathx).pathx + 1; 855 end; 856 857 args.arg (argx).pathx = insert_index; 858 end; 859 end; 860 return; 861 862 /* Convert an argument of add_search_paths to a search path and figure 863* out where to put it in the sl_info structure. 864* 865* This looks at modifiers that may follow an argument. 866**/ 867 get_search_path_and_position: 868 procedure (sl_info_ptr, path_count, argx, inhibit_err, type, pathname, insert_index, error, code); 869 870 declare sl_info_ptr pointer; /* (Input) pointer to a "large enough" sl_info */ 871 declare path_count fixed binary; /* (Input) number of paths in sl_info */ 872 declare argx fixed binary; /* (Input) current argument number */ 873 declare inhibit_err bit (1); /* (Input) if warnings shouldn't be printed */ 874 declare type fixed binary; /* (Output) type of the new search path */ 875 declare pathname char (*); /* (Output) new search pathname */ 876 declare insert_index fixed binary; /* (Output) where to insert search path in sl_info */ 877 declare error bit (1); /* (Output) on means there was a non-fatal error */ 878 declare code fixed binary (35); /* (Output) standard status code */ 879 880 declare next_arg fixed binary; 881 declare old_pathname char (168); 882 declare old_type fixed binary; 883 declare pathx fixed binary; 884 885 declare argx_string char (args.arg (argx).len) based (args.arg (argx).ptr); 886 declare next_arg_string char (args.arg (next_arg).len) based (args.arg (next_arg).ptr); 887 888 type = 0; 889 pathname = ""; 890 insert_index = path_count + 1; 891 error = "0"b; 892 code = 0; 893 894 call get_path_type (argx_string, type, pathname, code); 895 if code ^= 0 896 then return; 897 898 if path_index (sl_info_ptr, pathname) > 0 & ^inhibit_err 899 then do; 900 error = "1"b; 901 call sys_err_ (0, command, "Warning. ^a is already in the ^a search list.", pathname, sl_name); 902 end; 903 904 if argx >= args.arg_count 905 then return; /* no modifiers */ 906 907 next_arg = argx + 1; 908 if next_arg_string = "-first" | next_arg_string = "-ft" 909 then do; 910 insert_index = 1; 911 return; 912 end; 913 914 if next_arg_string = "-last" | next_arg_string = "-lt" 915 then do; 916 insert_index = path_count + 1; 917 return; 918 end; 919 920 if next_arg_string = "-before" | next_arg_string = "-be" 921 then insert_index = 0; 922 else if next_arg_string = "-after" | next_arg_string = "-af" 923 then insert_index = 1; 924 else return; 925 926 next_arg = next_arg + 1; 927 if next_arg > args.arg_count 928 then do; 929 code = error_table_$badopt; 930 call sys_err_ (0, command, "A search path must follow ^[-before^;-after^].", insert_index = 0); 931 return; 932 end; 933 934 call get_path_type (next_arg_string, old_type, old_pathname, code); 935 if code ^= 0 936 then return; 937 938 pathx = path_index (sl_info_ptr, old_pathname); 939 if pathx = 0 940 then do; 941 error = "1"b; 942 call sys_err_ (0, command, "Search path ^a was not in the ^a search list.", old_pathname, sl_name); 943 end; 944 945 insert_index = pathx + insert_index; 946 end get_search_path_and_position; 947 948 end add_search_paths_to_sl_info; 949 950 /* Initialize global variables 951* 952* If af_usage_msg is null, then usage_msg is used. 953**/ 954 initialize: 955 procedure (command_name, usage_msg, af_usage_msg); 956 957 declare command_name char (*); /* (Input) what command this is */ 958 declare usage_msg char (*); /* (Input) command usage message */ 959 declare af_usage_msg char (*); /* (Input) active function usage message */ 960 961 command = command_name; 962 usage = usage_msg; 963 if af_usage_msg = "" 964 then af_usage = usage_msg; 965 else af_usage = af_usage_msg; 966 967 af_sw = "0"b; 968 sys_err_ = com_err_; 969 970 args_ptr = null; 971 cleanup_new_sl_info_ptr = null; 972 cleanup_sl_info_ptr = null; 973 cleanup_sl_list_ptr = null; 974 end initialize; 975 976 /* Find out if this command was called as an active function */ 977 978 check_for_active_function: 979 procedure (arg_list_ptr, code); 980 981 declare arg_list_ptr pointer; /* (Input) pointer to argument list */ 982 declare code fixed binary (35); /* (Output) standard status code */ 983 984 declare arg_count fixed binary; 985 986 call cu_$af_return_arg_rel (arg_count, af_return_string_ptr, af_return_string_length, code, arg_list_ptr); 987 if code = 0 988 then do; 989 af_sw = "1"b; 990 sys_err_ = active_fnc_err_; 991 af_return_string = ""; 992 end; 993 else if code = error_table_$not_act_fnc 994 then code = 0; 995 else call sys_err_ (code, command); 996 end check_for_active_function; 997 998 /* Parse the command's arguments. 999* 1000* Pointers to the arguments are placed in a structure. 1001* Control-arguments are checked, and a switch is set when one is 1002* found. A parsed_arg_count is returned which gives the number of 1003* arguments not including control-arguments and modifiers. The 1004* parsed arguments are linked together so it is possible to loop 1005* through them and ignore control-arguments and modifiers. 1006* 1007*Note: The first argument cannot have a modifier. (add_search_paths is the 1008* only command which allows modifiers and the first argument of 1009* add_search_paths is a search list, not a search path). 1010**/ 1011 get_args: 1012 procedure (arg_list_ptr, command_args, control_arg_sws, parsed_arg_count, code); 1013 1014 declare arg_list_ptr pointer; /* (Input) pointer to argument list */ 1015 declare 1 command_args aligned, /* (Input) expected arguments description */ 1016 2 keywords (*) char (*), /* control-arg-like keywords that aren't control args */ 1017 2 modifiers, /* positional control-args that can follow an argument */ 1018 3 name (*) char (*), /* modifier's name */ 1019 3 has_arg (*) bit (1), /* on if the modifier takes an argument */ 1020 2 control_args, /* what control-arguments there are */ 1021 3 name (*) char (*), /* control-arguments name */ 1022 3 switch (*) fixed binary, /* what switch to set if found */ 1023 3 value (*) bit (1); /* what value to set the switch */ 1024 declare control_arg_sws (*) bit (1); /* (Output) what control arguments were found */ 1025 declare parsed_arg_count fixed binary; /* (Output) how many args excluding control-args and modifiers */ 1026 declare code fixed binary (35); /* (Output) standard status code */ 1027 1028 declare argx fixed binary; 1029 declare namex fixed binary; 1030 declare last_parsed_arg fixed binary; 1031 1032 declare argx_string char (args.arg (argx).len) based (args.arg (argx).ptr); 1033 1034 control_arg_sws (*) = "0"b; 1035 parsed_arg_count = 0; 1036 code = 0; 1037 1038 call cu_$af_arg_count_rel (args_arg_count, code, arg_list_ptr); 1039 if code = error_table_$not_act_fnc 1040 then code = 0; 1041 if code ^= 0 1042 then do; 1043 call sys_err_ (code, command); 1044 return; 1045 end; 1046 1047 if args_arg_count = 0 1048 then return; 1049 allocate args; 1050 1051 args.first_arg = 0; 1052 args.arg (*).next_arg = 0; 1053 1054 do argx = 1 to args.arg_count; 1055 call cu_$arg_ptr_rel (argx, args.arg (argx).ptr, args.arg (argx).len, code, arg_list_ptr); 1056 if code ^= 0 1057 then do; 1058 call sys_err_ (code, command, "Argument ^d.", argx); 1059 return; 1060 end; 1061 end; 1062 1063 last_parsed_arg = -1; 1064 argx = 1; 1065 do while (argx <= args.arg_count); 1066 if ^is_control_arg (argx_string) | string_array_index (command_args.keywords (*), argx_string) > 0 1067 then do; 1068 parsed_arg_count = parsed_arg_count + 1; 1069 if last_parsed_arg < 0 1070 then args.first_arg = argx; 1071 else args.arg (last_parsed_arg).next_arg = argx; 1072 last_parsed_arg = argx; 1073 end; 1074 else do; 1075 namex = string_array_index (command_args.control_args.name (*), argx_string); 1076 if namex > 0 1077 then control_arg_sws (command_args.control_args.switch (namex)) = command_args.control_args.value (namex); 1078 else do; 1079 namex = string_array_index (command_args.modifiers.name (*), argx_string); 1080 if last_parsed_arg = argx - 1 & last_parsed_arg > 1 & namex > 0 1081 then if command_args.modifiers.has_arg (namex) 1082 then argx = argx + 1; 1083 else ; 1084 else do; 1085 code = error_table_$badopt; 1086 if namex > 0 1087 then call sys_err_ ((0), command, "The modifier ""^a"" may only follow a path or keyword.", argx_string); 1088 else call sys_err_ (code, command, "^a", argx_string); 1089 return; 1090 end; 1091 end; 1092 end; 1093 1094 argx = argx + 1; 1095 end; 1096 end get_args; 1097 1098 /* Make sure the search list name is valid */ 1099 1100 check_search_list_name: 1101 procedure (given_search_list_name, sl_name, code); 1102 1103 declare given_search_list_name char (*); /* (Input) supplied search list name */ 1104 declare sl_name char (*); /* (Output) search list name */ 1105 declare code fixed binary (35); /* (Output) non-standard status code */ 1106 1107 declare pos fixed binary; 1108 1109 sl_name = ""; 1110 code = 0; 1111 1112 if is_control_arg (given_search_list_name) 1113 then do; 1114 code = -1; 1115 call usage_err_; 1116 return; 1117 end; 1118 1119 if length (given_search_list_name) > length (sl_name) 1120 then do; 1121 code = -1; 1122 call sys_err_ (0, command, "Search list name too long. ^a", given_search_list_name); 1123 return; 1124 end; 1125 1126 pos = search (given_search_list_name, "<>"); 1127 if pos ^= 0 1128 then do; 1129 code = -1; 1130 call sys_err_ (0, command, "Invalid character ""^a"" in search list name. ^a", 1131 substr (given_search_list_name, pos, 1), given_search_list_name); 1132 return; 1133 end; 1134 1135 if given_search_list_name = "" 1136 then do; 1137 code = -1; 1138 call sys_err_ (0, command, "Null search list name."); 1139 return; 1140 end; 1141 1142 sl_name = given_search_list_name; 1143 end check_search_list_name; 1144 1145 /* Allocate and initialize an sl_info structure */ 1146 1147 create_sl_info: 1148 procedure (path_count, sl_info_ptr); 1149 1150 declare path_count fixed binary; /* (Input) number of search paths in sl_info */ 1151 declare sl_info_ptr pointer; /* (Output) pointer to sl_info */ 1152 1153 sl_info_ptr = null; 1154 if path_count ^= 0 1155 then do; 1156 sl_info_num_paths = path_count; 1157 allocate sl_info set (sl_info_ptr); 1158 1159 sl_info_ptr -> sl_info.version = sl_info_version_1; 1160 sl_info_ptr -> sl_info.change_index_p = null; 1161 sl_info_ptr -> sl_info.change_index = 0; 1162 sl_info_ptr -> sl_info.pad1 (*) = ""b; 1163 sl_info_ptr -> sl_info.paths (*).code = 0; 1164 sl_info_ptr -> sl_info.paths (*).uid = ""b; 1165 end; 1166 end create_sl_info; 1167 1168 /* Convert an argument into a search path type and pathname */ 1169 1170 get_path_type: 1171 procedure (search_path, type, pathname, code); 1172 1173 declare search_path char (*); /* (Input) search path to convert */ 1174 declare type fixed binary; /* (Output) search path type */ 1175 declare pathname char (*); /* (Output) search pathname */ 1176 declare code fixed binary (35); /* (Output) standard status code */ 1177 1178 type = 0; 1179 pathname = search_path; 1180 code = 0; 1181 if is_control_arg (search_path) 1182 then if search_path = "-home_dir" | search_path = "-hd" 1183 then do; 1184 type = HOME_DIR; 1185 pathname = "-home_dir"; 1186 end; 1187 else if search_path = "-process_dir" | search_path = "-pd" 1188 then do; 1189 type = PROCESS_DIR; 1190 pathname = "-process_dir"; 1191 end; 1192 else if search_path = "-referencing_dir" | search_path = "-rd" 1193 then do; 1194 type = REFERENCING_DIR; 1195 pathname = "-referencing_dir"; 1196 end; 1197 else if search_path = "-working_dir" | search_path = "-wd" 1198 then do; 1199 type = WORKING_DIR; 1200 pathname = "-working_dir"; 1201 end; 1202 else if search_path = "-initiated_segments" | search_path = "-is" 1203 then do; 1204 type = INITIATED_SEGS; 1205 pathname = "-initiated_segments"; 1206 end; 1207 else do; 1208 code = error_table_$badopt; 1209 call sys_err_ (code, command, "^a", search_path); 1210 end; 1211 else do; 1212 if search (search_path, "[]") = 0 1213 then type = ABSOLUTE_PATH; 1214 else type = UNEXPANDED_PATH; 1215 1216 call absolute_pathname_ (search_path, pathname, code); 1217 if code ^= 0 1218 then call sys_err_ (code, command, "^a", search_path); 1219 end; 1220 end get_path_type; 1221 1222 /* Check if an argument is a control-argument. 1223* 1224* A control-argument is defined for this procedure to be anything starting with a hyphen. 1225**/ 1226 is_control_arg: 1227 procedure (arg) returns (bit (1)); 1228 1229 declare arg char (*); /* (Input) a command argument */ 1230 1231 if arg = "" 1232 then return ("0"b); 1233 else return (substr (arg, 1, 1) = "-"); 1234 end is_control_arg; 1235 1236 /* Find the index of a search path in sl_info */ 1237 1238 path_index: 1239 procedure (sl_info_ptr, pathname) returns (fixed binary); 1240 1241 declare sl_info_ptr pointer; /* (Input) pointer to sl_info */ 1242 declare pathname char (*); /* (Input) pathname to look for */ 1243 1244 declare code fixed binary (35); 1245 1246 declare dname char (168); 1247 declare ename char (32); 1248 1249 declare entry_type fixed binary (2); 1250 1251 declare pathx fixed binary; 1252 1253 declare uid bit (36) aligned; 1254 1255 entry_type = 0; 1256 uid = ""b; 1257 call expand_pathname_ (pathname, dname, ename, code); 1258 if code = 0 1259 then do; 1260 call hcs_$status_minf (dname, ename, CHASE, entry_type, (0), code); 1261 if code = 0 1262 then call hcs_$get_uid_file (dname, ename, uid, (0)); 1263 end; 1264 do pathx = 1 to sl_info_ptr -> sl_info.num_paths while (unique_pathname ()); 1265 end; 1266 if pathx > sl_info_ptr -> sl_info.num_paths 1267 then return (0); 1268 else return (pathx); 1269 1270 unique_pathname: procedure () returns (bit (1) aligned); 1271 dcl sl_dname char (168); 1272 dcl sl_ename char (32); 1273 1274 if pathname = sl_info_ptr -> sl_info.paths (pathx).pathname 1275 then return ("0"b); 1276 1277 if (uid ^= sl_info_ptr -> sl_info.paths (pathx).uid 1278 | uid = ""b | sl_info_ptr -> sl_info.paths (pathx).uid = ""b) 1279 then return ("1"b); /* unique */ 1280 1281 /* In the case of search lists of segment pathnames, we want to consider 1282* different names on the same entry to be different. So if UIDs match 1283* but the entry names are different, we consider it not to be a match. */ 1284 1285 if entry_type ^= Segment 1286 then return ("0"b); 1287 call expand_pathname_ (sl_info_ptr -> sl_info.paths (pathx).pathname, sl_dname, sl_ename, code); 1288 if code ^= 0 1289 then return ("0"b); 1290 if ename ^= sl_ename 1291 then return ("1"b); /* unique */ 1292 else return ("0"b); 1293 end unique_pathname; 1294 end path_index; 1295 1296 /* Find the index of a character string in a character string array */ 1297 1298 string_array_index: 1299 procedure (array, string) returns (fixed binary); 1300 1301 declare array (*) char (*) aligned; 1302 /* (Input) array of character strings */ 1303 declare string char (*); /* (Input) string to look for */ 1304 1305 declare arrayx fixed binary; 1306 1307 do arrayx = lbound (array, 1) to hbound (array, 1) while (string ^= array (arrayx)); 1308 end; 1309 if arrayx > hbound (array, 1) 1310 then return (0); 1311 else return (arrayx); 1312 end string_array_index; 1313 1314 /* Change a search list. 1315* 1316* Appropriate error and warning messages are printed. 1317**/ 1318 set_the_search_paths_of_a_search_list: 1319 procedure (sl_name, brief_sw, sl_info_ptr, code); 1320 1321 declare sl_name char (*); /* (Input) search list name */ 1322 declare brief_sw bit (1); /* (Input) on to suppress new search list warning message */ 1323 declare sl_info_ptr pointer; /* (Updated) pointer to sl_info with the new search list */ 1324 declare code fixed binary (35); /* (Output) standard status code */ 1325 1326 call search_paths_$set (sl_name, null, sl_info_ptr, code); 1327 if code ^= 0 1328 then do; 1329 if code = error_table_$action_not_performed 1330 then begin; 1331 declare pathx fixed binary; 1332 1333 do pathx = 1 to sl_info_ptr -> sl_info.num_paths; 1334 if sl_info_ptr -> sl_info.paths (pathx).code ^= 0 1335 then call sys_err_ (sl_info_ptr -> sl_info.paths (pathx).code, command, "^a", 1336 sl_info_ptr -> sl_info.paths (pathx).pathname); 1337 end; 1338 end; 1339 1340 else if code ^= error_table_$new_search_list | ^brief_sw 1341 then call sys_err_ (code, command, "^a", sl_name); 1342 end; 1343 1344 if sl_info_ptr ^= null 1345 then do; 1346 free sl_info_ptr -> sl_info; 1347 sl_info_ptr = null; 1348 end; 1349 end set_the_search_paths_of_a_search_list; 1350 1351 /* Warn the user if directories being added to the search list don't exist */ 1352 1353 check_paths_for_warnings: 1354 procedure (sl_name, sl_info_ptr); 1355 1356 declare sl_name char (*); /* (Input) search list name */ 1357 declare sl_info_ptr pointer; /* (Output) pointer to allocate sl_info in */ 1358 1359 declare code fixed binary (35); 1360 1361 call search_paths_$get (sl_name, "1"b, "", null, get_system_free_area_ (), sl_info_version_1, sl_info_ptr, code); 1362 if sl_info_ptr ^= null 1363 then begin; 1364 declare argx fixed binary; 1365 declare pathx fixed binary; 1366 1367 do argx = args.arg (args.first_arg).next_arg repeat args.arg (argx).next_arg while (argx ^= 0); 1368 pathx = args.arg (argx).pathx; 1369 if pathx > 0 1370 then if sl_info_ptr -> sl_info.paths (pathx).type = ABSOLUTE_PATH 1371 | sl_info_ptr -> sl_info.paths (pathx).type = UNEXPANDED_PATH 1372 then begin; 1373 declare bit_count fixed binary (24); 1374 declare dir_name char (168); 1375 declare entry_type fixed binary (2); 1376 declare entryname char (32); 1377 1378 call expand_pathname_ (sl_info_ptr -> sl_info.paths (pathx).pathname, dir_name, 1379 entryname, code); 1380 call hcs_$status_minf (dir_name, entryname, 0, entry_type, bit_count, code); 1381 if code ^= 0 1382 then call sys_err_ (code, command, "Warning. ^a", 1383 sl_info_ptr -> sl_info.paths (pathx).pathname); 1384 end; 1385 end; 1386 1387 free sl_info_ptr -> sl_info; 1388 sl_info_ptr = null; 1389 end; 1390 end check_paths_for_warnings; 1391 1392 /* Output the contents of a search list */ 1393 1394 print_search_list: 1395 procedure (sl_name, print_name_sw, expand_sw, sl_info_ptr); 1396 1397 declare sl_name char (*); /* (Input) search list to print */ 1398 declare print_name_sw bit (1); /* (Input) on to print the search list name */ 1399 declare expand_sw bit (1); /* (Input) on to expand keywords */ 1400 declare sl_info_ptr pointer; /* (Output) pointer to allocate sl_info in */ 1401 1402 declare code fixed binary (35); 1403 declare pathx fixed binary; 1404 1405 if expand_sw 1406 then do; 1407 sl_control_s.af_pathname = "1"b; 1408 sl_control_s.pad1 = "0"b; 1409 sl_control_s.key_ref_dir = "0"b; 1410 sl_control_s.key_work_dir = "1"b; 1411 sl_control_s.key_proc_dir = "1"b; 1412 sl_control_s.key_home_dir = "1"b; 1413 sl_control_s.pad2 = ""b; 1414 end; 1415 else sl_control = ""b; 1416 call search_paths_$get (sl_name, sl_control, "", null, get_system_free_area_ (), sl_info_version_1, sl_info_ptr, 1417 code); 1418 if code = 0 1419 then do; 1420 if print_name_sw 1421 then call output_one_line (sl_name); 1422 do pathx = 1 to sl_info_ptr -> sl_info.num_paths; 1423 call output_one_line (HT || sl_info_ptr -> sl_info.paths (pathx).pathname); 1424 end; 1425 call output_one_line (""); 1426 end; 1427 else call sys_err_ (code, command, "^a", sl_name); 1428 1429 if sl_info_ptr ^= null 1430 then do; 1431 free sl_info_ptr -> sl_info; 1432 sl_info_ptr = null; 1433 end; 1434 end print_search_list; 1435 1436 /* Output a pathname. 1437* 1438* Handle the Root correctly. 1439**/ 1440 output_pathname: 1441 procedure (dir_name, entryname); 1442 1443 declare dir_name char (*); /* (Input) directory name */ 1444 declare entryname char (*); /* (Input) entry in the directory */ 1445 1446 declare length fixed binary (21); 1447 declare pathname char (168); 1448 1449 call ioa_$rsnnl ("^a^[>^]^a", pathname, length, dir_name, dir_name ^= ">", entryname); 1450 call output_one_line (pathname); 1451 end output_pathname; 1452 1453 /* Output a line. 1454* 1455* The line is printed if this is a command, and appended to the 1456* active function return string, if this is an active function. 1457**/ 1458 output_one_line: 1459 procedure (line); 1460 1461 declare line char (*); /* (Input) the line to output */ 1462 declare requote_string_ entry (char (*)) returns (char (*)); 1463 1464 if af_sw 1465 then do; 1466 if ltrim (rtrim (line, HT || SP), HT || SP) = "" 1467 then return; 1468 1469 if af_return_string = "" 1470 then af_return_string = 1471 requote_string_ (ltrim (rtrim (line, HT || SP), HT || SP)); 1472 else af_return_string = af_return_string || SP || 1473 requote_string_ (ltrim (rtrim (line, HT || SP), HT || SP)); 1474 end; 1475 else call ioa_ ("^a", line); 1476 end output_one_line; 1477 1478 /* Print the usage error message. 1479* 1480* Different messages are printed for commands and active functions. 1481**/ 1482 usage_err_: 1483 procedure; 1484 1485 if af_sw 1486 then call active_fnc_err_$af_suppress_name (0, command, "Usage: [^a ^a]", command, af_usage); 1487 else call com_err_$suppress_name (0, command, "Usage: ^a ^a", command, usage); 1488 end usage_err_; 1489 1490 cleanup_: 1491 procedure; 1492 1493 if args_ptr ^= null 1494 then do; 1495 free args; 1496 args_ptr = null; 1497 end; 1498 if cleanup_sl_info_ptr ^= null 1499 then do; 1500 free cleanup_sl_info_ptr -> sl_info; 1501 cleanup_sl_info_ptr = null; 1502 end; 1503 if cleanup_new_sl_info_ptr ^= null 1504 then do; 1505 free cleanup_new_sl_info_ptr -> sl_info; 1506 cleanup_new_sl_info_ptr = null; 1507 end; 1508 if cleanup_sl_list_ptr ^= null 1509 then begin; 1510 declare next_sl_list_ptr pointer; 1511 1512 do while (cleanup_sl_list_ptr ^= null); 1513 next_sl_list_ptr = cleanup_sl_list_ptr -> sl_list.link; 1514 free cleanup_sl_list_ptr -> sl_list; 1515 cleanup_sl_list_ptr = next_sl_list_ptr; 1516 end; 1517 end; 1518 end cleanup_; 1519 1520 end set_search_paths; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 03/01/88 1330.0 set_search_paths.pl1 >spec>install>1031>set_search_paths.pl1 150 1 02/18/88 2023.8 sl_info.incl.pl1 >ldd>include>sl_info.incl.pl1 151 2 01/09/79 1617.9 sl_control_s.incl.pl1 >ldd>include>sl_control_s.incl.pl1 152 3 01/09/79 1617.9 sl_list.incl.pl1 >ldd>include>sl_list.incl.pl1 153 4 11/22/82 0955.7 status_structures.incl.pl1 >ldd>include>status_structures.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. ABSOLUTE_PATH constant fixed bin(17,0) initial dcl 1-33 ref 844 1212 1369 ALL_SW constant fixed bin(17,0) initial dcl 710 in procedure "where_search_paths_" ref 751 ALL_SW constant fixed bin(17,0) initial dcl 510 in procedure "delete_search_paths_" ref 539 BRIEF_SW constant fixed bin(17,0) initial dcl 237 ref 302 CHASE 000557 constant fixed bin(1,0) initial dcl 103 set ref 1260* DEFAULT_SW constant fixed bin(17,0) initial dcl 238 ref 250 EXPAND_SW constant fixed bin(17,0) initial dcl 634 ref 670 683 FORCE_SW constant fixed bin(17,0) initial dcl 336 ref 379 HOME_DIR constant fixed bin(17,0) initial dcl 1-38 ref 840 844 1184 HT 014141 constant char(1) initial packed unaligned dcl 105 ref 1423 1466 1466 1469 1469 1469 1469 1472 1472 1472 1472 INHIBIT_ERR_SW constant fixed bin(17,0) initial dcl 711 in procedure "where_search_paths_" ref 759 774 INHIBIT_ERR_SW constant fixed bin(17,0) initial dcl 337 in procedure "add_search_paths_" ref 464 484 INITIATED_SEGS constant fixed bin(17,0) initial dcl 1-39 ref 1204 PROCESS_DIR constant fixed bin(17,0) initial dcl 1-37 ref 837 844 1189 REFERENCING_DIR constant fixed bin(17,0) initial dcl 1-35 ref 1194 SP 014140 constant char(1) initial packed unaligned dcl 106 ref 1466 1466 1469 1469 1469 1469 1472 1472 1472 1472 1472 Segment constant fixed bin(17,0) initial dcl 4-56 ref 1285 UNEXPANDED_PATH constant fixed bin(17,0) initial dcl 1-34 ref 1214 1369 WORKING_DIR constant fixed bin(17,0) initial dcl 1-36 ref 1199 absolute_pathname_ 000022 constant entry external dcl 121 ref 1216 active_fnc_err_ 000024 constant entry external dcl 122 ref 990 active_fnc_err_$af_suppress_name 000026 constant entry external dcl 123 ref 1485 addr builtin function dcl 87 ref 1407 1408 1409 1410 1411 1412 1413 af_pathname based bit(1) level 2 packed packed unaligned dcl 2-3 set ref 1407* af_return_string based varying char dcl 74 set ref 759* 774* 991* 1469 1469* 1472* 1472 af_return_string_length 000100 automatic fixed bin(21,0) dcl 56 set ref 759 774 986* 991 1469 1472 af_return_string_ptr 000102 automatic pointer dcl 58 set ref 759 774 986* 991 1469 1469 1472 1472 af_sw 000104 automatic bit(1) packed unaligned dcl 59 set ref 644 683 759 774 967* 989* 1464 1485 af_usage 000105 automatic char(44) packed unaligned dcl 60 set ref 963* 965* 1485* af_usage_msg parameter char packed unaligned dcl 959 ref 954 963 965 arg parameter char packed unaligned dcl 1229 in procedure "is_control_arg" ref 1226 1231 1233 arg 2 based structure array level 2 in structure "args" unaligned dcl 76 in procedure "ssp" arg_count 001036 automatic fixed bin(17,0) dcl 984 in procedure "check_for_active_function" set ref 986* arg_count based fixed bin(17,0) level 2 in structure "args" dcl 76 in procedure "ssp" set ref 275 807 904 927 1049* 1052 1054 1065 1495 arg_list_ptr parameter pointer dcl 981 in procedure "check_for_active_function" set ref 978 986* arg_list_ptr 000120 automatic pointer dcl 61 in procedure "ssp" set ref 158* 170* 182* 194* 206* 240* 339* 512* 636* 640* 713* 717* arg_list_ptr parameter pointer dcl 1014 in procedure "get_args" set ref 1011 1038* 1055* args based structure level 1 unaligned dcl 76 set ref 1049 1495 args_arg_count 000122 automatic fixed bin(17,0) dcl 62 set ref 1038* 1047 1049 1049 args_ptr 000124 automatic pointer dcl 63 set ref 256 257 257 257 263 264 264 264 264 267 267 267 270 275 278 280 287 287 287 299 349 350 350 350 356 357 357 357 357 360 360 360 363 388 389 389 389 399 522 523 523 523 529 530 530 530 530 533 533 533 536 563 564 570 570 570 574 574 574 583 681 682 682 682 685 727 728 728 728 734 735 735 735 735 738 738 738 741 744 745 755 755 755 760 760 760 765 765 765 771 771 771 775 775 775 778 778 778 807 808 808 809 853 853 853 857 859 894 894 894 904 908 908 908 908 914 914 914 914 920 920 920 920 922 922 922 922 927 934 934 934 970* 1049* 1051 1052 1054 1055 1055 1065 1066 1066 1066 1066 1066 1066 1069 1071 1075 1075 1075 1079 1079 1079 1086 1086 1086 1088 1088 1088 1367 1367 1368 1385 1493 1495 1496* argx 000202 automatic fixed bin(17,0) dcl 216 in procedure "set_search_paths_" set ref 256* 257 257 257 262 263* 263 263* 264 264 264 264 267 267 267* 270 271* 278* 278 280 287 287 287 299 argx 000451 automatic fixed bin(17,0) dcl 676 in begin block on line 675 set ref 681* 681* 682 682 682* 685 argx 000340 automatic fixed bin(17,0) dcl 491 in procedure "delete_search_paths_" set ref 522* 523 523 523 528 529* 529 529* 530 530 530 530 533 533 533* 536 537* 563* 563 563* 564 570 570 570 574 574 574* 583 argx 001325 automatic fixed bin(17,0) dcl 1364 in begin block on line 1362 set ref 1367* 1367* 1368* 1385 argx 000470 automatic fixed bin(17,0) dcl 692 in procedure "where_search_paths_" set ref 727* 728 728 728 733 734* 734 734* 735 735 735 735 738 738 738* 741 742* 744* 744 745 755 755 755 760 760 760 765 765 765 771 771 771 775 775 775 778 778 778 argx 000570 automatic fixed bin(17,0) dcl 796 in procedure "add_search_paths_to_sl_info" set ref 808* 808* 809 815* 852 857 859 argx parameter fixed bin(17,0) dcl 872 in procedure "get_search_path_and_position" ref 867 894 894 894 904 907 argx 000230 automatic fixed bin(17,0) dcl 312 in procedure "add_search_paths_" set ref 349* 350 350 350 355 356* 356 356* 357 357 357 357 360 360 360* 363 364* 388* 388 388* 389 389 389* 399 argx 001046 automatic fixed bin(17,0) dcl 1028 in procedure "get_args" set ref 1054* 1055* 1055 1055 1058* 1064* 1065 1066 1066 1066 1066 1066 1066 1069 1071 1072 1075 1075 1075 1079 1079 1079 1080 1080* 1080 1086 1086 1086 1088 1088 1088 1094* 1094 argx_string based char packed unaligned dcl 322 in procedure "add_search_paths_" set ref 350* 357 357 360* 389* argx_string based char packed unaligned dcl 1032 in procedure "get_args" set ref 1066* 1066* 1075* 1079* 1086* 1088* argx_string based char packed unaligned dcl 699 in procedure "where_search_paths_" set ref 728* 735 735 738* 755* 760* 765* 771* 775* 778* argx_string based char packed unaligned dcl 498 in procedure "delete_search_paths_" set ref 523* 530 530 533* 570* 574* argx_string based char packed unaligned dcl 679 in begin block on line 675 set ref 682* argx_string based char packed unaligned dcl 885 in procedure "get_search_path_and_position" set ref 894* argx_string based char packed unaligned dcl 224 in procedure "set_search_paths_" set ref 257* 264 264 267* 287* array parameter char array dcl 1301 ref 1298 1307 1307 1307 1309 arrayx 001304 automatic fixed bin(17,0) dcl 1305 set ref 1307* 1307* 1309 1311 asp_args 000104 constant structure level 1 dcl 324 set ref 339* bit_count 001327 automatic fixed bin(24,0) dcl 1373 set ref 1380* brief_sw parameter bit(1) packed unaligned dcl 1322 ref 1318 1340 change_index 4 based fixed bin(71,0) level 2 dcl 1-15 set ref 1161* change_index_p 2 based pointer level 2 dcl 1-15 set ref 1160* cleanup 000164 stack reference condition dcl 99 ref 159 171 183 195 207 cleanup_new_sl_info_ptr 000126 automatic pointer dcl 64 set ref 411* 414 418 420 422 429 430* 437* 438 439 440 446* 447 448 449 452 454 456 464* 470 471 473 477 478* 597* 600 604 606 608 614* 971* 1503 1505 1506* cleanup_sl_info_ptr 000130 automatic pointer dcl 66 set ref 273* 276 276 287 287 292* 292 294 302* 306* 366* 392* 395 396 402 411 414 416 418 420 422 428 429* 445 452 454 456 461 462* 468* 470 471 473 480* 484* 554* 573* 578 579 580 585 597 600 602 604 606 608 670* 683* 755* 764 765 972* 1498 1500 1501* cleanup_sl_list_ptr 000132 automatic pointer dcl 67 set ref 652* 659 665 973* 1508 1512 1513 1514 1515* code 001324 automatic fixed bin(35,0) dcl 1359 in procedure "check_paths_for_warnings" set ref 1361* 1378* 1380* 1381 1381* code 000203 automatic fixed bin(35,0) dcl 217 in procedure "set_search_paths_" set ref 240* 241 257* 258 266* 282* 283* 287* 289 302* 303 303 code parameter fixed bin(35,0) dcl 1324 in procedure "set_the_search_paths_of_a_search_list" set ref 1318 1326* 1327 1329 1340 1340* code 15 based fixed bin(35,0) array level 3 in structure "sl_info" dcl 1-15 in procedure "ssp" set ref 1163* 1334 1334* code 000471 automatic fixed bin(35,0) dcl 693 in procedure "where_search_paths_" set ref 713* 714 717* 718 728* 729 737* 738* 747* 748* 755* 757 760* 771* 772 775* code 001116 automatic fixed bin(35,0) dcl 1244 in procedure "path_index" set ref 1257* 1258 1260* 1261 1287* 1288 code parameter fixed bin(35,0) dcl 1176 in procedure "get_path_type" set ref 1170 1180* 1208* 1209* 1216* 1217 1217* code 000231 automatic fixed bin(35,0) dcl 313 in procedure "add_search_paths_" set ref 339* 340 350* 351 359* 366* 368 370* 389* 390 464* 465 480* 481 code 000442 automatic fixed bin(35,0) dcl 621 in procedure "print_search_paths_" set ref 636* 637 640* 641 652* 653 655* 682* 683 code 001422 automatic fixed bin(35,0) dcl 1402 in procedure "print_search_list" set ref 1416* 1418 1427* code 000341 automatic fixed bin(35,0) dcl 492 in procedure "delete_search_paths_" set ref 512* 513 523* 524 532* 541* 542 544* 554* 556 558* 566* 567* 570* 571 614* code parameter fixed bin(35,0) dcl 982 in procedure "check_for_active_function" set ref 978 986* 987 993 993* 995* code parameter fixed bin(35,0) dcl 794 in procedure "add_search_paths_to_sl_info" set ref 787 805* 811* 812* 815* 816 846* 847 code parameter fixed bin(35,0) dcl 878 in procedure "get_search_path_and_position" set ref 867 892* 894* 895 929* 934* 935 code parameter fixed bin(35,0) dcl 1026 in procedure "get_args" set ref 1011 1036* 1038* 1039 1039* 1041 1043* 1055* 1056 1058* 1085* 1088* code parameter fixed bin(35,0) dcl 1105 in procedure "check_search_list_name" set ref 1100 1110* 1114* 1121* 1129* 1137* com_err_ 000030 constant entry external dcl 125 ref 968 com_err_$suppress_name 000032 constant entry external dcl 126 ref 1487 command 000134 automatic char(32) packed unaligned dcl 68 set ref 252* 267* 283* 294* 360* 370* 533* 544* 558* 567* 574* 587* 593* 655* 659* 738* 748* 760* 775* 812* 901* 930* 942* 961* 995* 1043* 1058* 1086* 1088* 1122* 1130* 1138* 1209* 1217* 1334* 1340* 1381* 1427* 1485* 1485* 1487* 1487* command_args parameter structure level 1 dcl 1015 set ref 1011 command_name parameter char packed unaligned dcl 957 ref 954 961 control_arg_sws parameter bit(1) array packed unaligned dcl 1024 in procedure "get_args" set ref 1011 1034* 1076* control_arg_sws 000443 automatic bit(1) array packed unaligned dcl 622 in procedure "print_search_paths_" set ref 640* 670* 683* control_arg_sws 000472 automatic bit(1) array packed unaligned dcl 694 in procedure "where_search_paths_" set ref 717* 751 759 774 control_arg_sws 000342 automatic bit(1) array packed unaligned dcl 493 in procedure "delete_search_paths_" set ref 512* 539 control_arg_sws 000204 automatic bit(1) array packed unaligned dcl 218 in procedure "set_search_paths_" set ref 240* 250 302* control_arg_sws 000232 automatic bit(1) array packed unaligned dcl 314 in procedure "add_search_paths_" set ref 339* 379 464* 484 control_args parameter structure level 2 dcl 1015 cu_$af_arg_count_rel 000034 constant entry external dcl 127 ref 1038 cu_$af_return_arg_rel 000036 constant entry external dcl 128 ref 986 cu_$arg_list_ptr 000040 constant entry external dcl 129 ref 158 170 182 194 206 cu_$arg_ptr_rel 000042 constant entry external dcl 130 ref 1055 delete_count 000253 automatic fixed bin(17,0) dcl 381 in begin block on line 379 set ref 387* 397* 397 402 409 411 delete_count 000355 automatic fixed bin(17,0) dcl 549 in begin block on line 548 set ref 562* 581* 581 585 591 597 dir_name 001330 automatic char(168) packed unaligned dcl 1374 in begin block on line 1369 set ref 1378* 1380* dir_name 000507 automatic char(168) packed unaligned dcl 769 in begin block on line 768 set ref 771* 778* dir_name parameter char packed unaligned dcl 1443 in procedure "output_pathname" set ref 1440 1449* 1449 dname 001117 automatic char(168) packed unaligned dcl 1246 in procedure "path_index" set ref 1257* 1260* 1261* dname 000571 automatic char(168) packed unaligned dcl 797 in procedure "add_search_paths_to_sl_info" set ref 846* 847* dsp_args 000306 constant structure level 1 dcl 500 set ref 512* ename 001171 automatic char(32) packed unaligned dcl 1247 in procedure "path_index" set ref 1257* 1260* 1261* 1290 ename 000643 automatic char(32) packed unaligned dcl 798 in procedure "add_search_paths_to_sl_info" set ref 846* 847* entry_type 001201 automatic fixed bin(2,0) dcl 1249 in procedure "path_index" set ref 1255* 1260* 1285 entry_type 001402 automatic fixed bin(2,0) dcl 1375 in begin block on line 1369 set ref 1380* entryname parameter char packed unaligned dcl 1444 in procedure "output_pathname" set ref 1440 1449* entryname 001403 automatic char(32) packed unaligned dcl 1376 in begin block on line 1369 set ref 1378* 1380* error 000653 automatic bit(1) packed unaligned dcl 799 in procedure "add_search_paths_to_sl_info" set ref 815* 819 error parameter bit(1) packed unaligned dcl 877 in procedure "get_search_path_and_position" set ref 867 891* 900* 941* error_table_$action_not_performed 000010 external static fixed bin(35,0) dcl 110 set ref 587* 1329 error_table_$badarg 000012 external static fixed bin(35,0) dcl 112 ref 282 566 747 811 error_table_$badopt 000014 external static fixed bin(35,0) dcl 113 ref 266 359 532 737 929 1085 1208 error_table_$new_search_list 000016 external static fixed bin(35,0) dcl 114 ref 303 1340 error_table_$not_act_fnc 000020 external static fixed bin(35,0) dcl 116 ref 993 1039 expand_pathname_ 000044 constant entry external dcl 131 ref 846 1257 1287 1378 expand_sw parameter bit(1) packed unaligned dcl 1399 ref 1394 1405 first_arg 1 based fixed bin(17,0) level 2 dcl 76 set ref 256 349 522 681 727 808 1051* 1069* 1367 get_pdir_ 000046 constant entry external dcl 132 ref 837 get_system_free_area_ 000050 constant entry external dcl 133 ref 366 366 554 554 652 652 755 755 1361 1361 1416 1416 given_search_list_name parameter char packed unaligned dcl 1103 set ref 1100 1112* 1119 1122* 1126 1130 1130 1130* 1135 1142 has_arg parameter bit(1) array level 3 dcl 1015 ref 1080 hbound builtin function dcl 88 ref 1307 1309 hcs_$get_uid_file 000052 constant entry external dcl 134 ref 847 1261 hcs_$status_minf 000054 constant entry external dcl 135 ref 1260 1380 ignore_current_list 000233 automatic bit(1) packed unaligned dcl 315 set ref 374* 404* 435 inhibit_err parameter bit(1) packed unaligned dcl 792 in procedure "add_search_paths_to_sl_info" set ref 787 815* inhibit_err parameter bit(1) packed unaligned dcl 873 in procedure "get_search_path_and_position" ref 867 898 insert_index parameter fixed bin(17,0) dcl 876 in procedure "get_search_path_and_position" set ref 867 890* 910* 916* 920* 922* 930 945* 945 insert_index 000654 automatic fixed bin(17,0) dcl 800 in procedure "add_search_paths_to_sl_info" set ref 815* 823 832 833 850 853 857 ioa_ 000056 constant entry external dcl 137 ref 1475 ioa_$rsnnl 000060 constant entry external dcl 138 ref 1449 key_home_dir 0(05) based bit(1) level 2 packed packed unaligned dcl 2-3 set ref 1412* key_proc_dir 0(04) based bit(1) level 2 packed packed unaligned dcl 2-3 set ref 1411* key_ref_dir 0(02) based bit(1) level 2 packed packed unaligned dcl 2-3 set ref 1409* key_work_dir 0(03) based bit(1) level 2 packed packed unaligned dcl 2-3 set ref 1410* keywords parameter char array level 2 dcl 1015 set ref 1066* last_parsed_arg 001050 automatic fixed bin(17,0) dcl 1030 set ref 1063* 1069 1071 1072* 1080 1080 lbound builtin function dcl 89 ref 1307 len 4 based fixed bin(21,0) array level 3 dcl 76 set ref 257 257 264 264 267 267 280 287 287 350 350 357 357 360 360 389 389 523 523 530 530 533 533 564 570 570 574 574 682 682 728 728 735 735 738 738 745 755 755 760 760 765 765 771 771 775 775 778 778 809 894 894 908 908 914 914 920 920 922 922 934 934 1055* 1066 1066 1066 1066 1075 1075 1079 1079 1086 1086 1088 1088 length builtin function dcl 90 in procedure "ssp" ref 1119 1119 length 001434 automatic fixed bin(21,0) dcl 1446 in procedure "output_pathname" set ref 1449* line parameter char packed unaligned dcl 1461 set ref 1458 1466 1469 1469 1472 1472 1475* link 2 based pointer level 2 dcl 3-3 ref 672 1513 ltrim builtin function dcl 91 ref 1466 1469 1469 1472 1472 modifiers parameter structure level 2 dcl 1015 name parameter char array level 3 in structure "command_args" dcl 1015 in procedure "get_args" set ref 1079* name parameter char array level 3 in structure "command_args" dcl 1015 in procedure "get_args" set ref 1075* name_count 4 based fixed bin(17,0) level 2 dcl 3-3 ref 667 1514 names 10 based char(32) array level 2 packed packed unaligned dcl 3-3 set ref 668* 670* namex 001047 automatic fixed bin(17,0) dcl 1029 in procedure "get_args" set ref 1075* 1076 1076 1076 1079* 1080 1080 1086 namex 000445 automatic fixed bin(17,0) dcl 662 in begin block on line 661 set ref 667* 668* new_pathx 000356 automatic fixed bin(17,0) dcl 550 in begin block on line 548 set ref 599* 600 604 606 608 610* 610 new_pathx 000254 automatic fixed bin(17,0) dcl 382 in begin block on line 379 set ref 413* 414 418 420 422 424* 424 next_arg 5 based fixed bin(17,0) array level 3 in structure "args" dcl 76 in procedure "ssp" set ref 263 270 278 356 363 388 399 529 536 563 583 685 734 741 744 808 859 1052* 1071* 1367 1385 next_arg 000744 automatic fixed bin(17,0) dcl 880 in procedure "get_search_path_and_position" set ref 907* 908 908 908 908 914 914 914 914 920 920 920 920 922 922 922 922 926* 926 927 934 934 934 next_arg_string based char packed unaligned dcl 886 set ref 908 908 914 914 920 920 922 922 934* next_sl_list_ptr 000100 automatic pointer dcl 1510 set ref 1513* 1515 null builtin function dcl 92 ref 276 366 366 430 462 478 541 541 554 554 652 652 659 665 755 755 771 771 970 971 972 973 1153 1160 1326 1326 1344 1347 1361 1361 1362 1388 1416 1416 1429 1432 1493 1496 1498 1501 1503 1506 1508 1512 num_paths 1 based fixed bin(17,0) level 2 dcl 1-15 set ref 276 402 411 414 414 428 438 439 440 445 447 448 449 461 477 585 597 600 600 764 1157* 1163 1164 1264 1266 1333 1346 1387 1422 1431 1500 1505 old_argx 000473 automatic fixed bin(17,0) dcl 695 in procedure "where_search_paths_" set ref 733* 742 old_argx 000343 automatic fixed bin(17,0) dcl 494 in procedure "delete_search_paths_" set ref 528* 537 old_argx 000205 automatic fixed bin(17,0) dcl 219 in procedure "set_search_paths_" set ref 262* 271 old_argx 000234 automatic fixed bin(17,0) dcl 316 in procedure "add_search_paths_" set ref 355* 364 old_pathname 000745 automatic char(168) packed unaligned dcl 881 set ref 934* 938* 942* old_type 001017 automatic fixed bin(17,0) dcl 882 set ref 934* pad1 0(01) based bit(1) level 2 in structure "sl_control_s" packed packed unaligned dcl 2-3 in procedure "ssp" set ref 1408* pad1 6 based bit(36) array level 2 in structure "sl_info" dcl 1-15 in procedure "ssp" set ref 1162* pad2 0(06) based bit(30) level 2 packed packed unaligned dcl 2-3 set ref 1413* parsed_arg_count 000235 automatic fixed bin(17,0) dcl 317 in procedure "add_search_paths_" set ref 339* 343 437 446 parsed_arg_count parameter fixed bin(17,0) dcl 1025 in procedure "get_args" set ref 1011 1035* 1068* 1068 parsed_arg_count 000444 automatic fixed bin(17,0) dcl 623 in procedure "print_search_paths_" set ref 640* 644 650 parsed_arg_count 000206 automatic fixed bin(17,0) dcl 220 in procedure "set_search_paths_" set ref 240* 244 250 273 parsed_arg_count 000474 automatic fixed bin(17,0) dcl 696 in procedure "where_search_paths_" set ref 717* 721 parsed_arg_count 000344 automatic fixed bin(17,0) dcl 495 in procedure "delete_search_paths_" set ref 512* 516 path_count 000236 automatic fixed bin(17,0) dcl 318 in procedure "add_search_paths_" set ref 405* 445* 446 451 464* 468* 469 path_count parameter fixed bin(17,0) dcl 871 in procedure "get_search_path_and_position" ref 867 890 916 path_count parameter fixed bin(17,0) dcl 793 in procedure "add_search_paths_to_sl_info" set ref 787 815* 823 831* 831 path_count parameter fixed bin(17,0) dcl 1150 in procedure "create_sl_info" ref 1147 1154 1156 pathname 001435 automatic char(168) packed unaligned dcl 1447 in procedure "output_pathname" set ref 1449* 1450* pathname 17 based char(168) array level 3 in structure "sl_info" packed packed unaligned dcl 1-15 in procedure "ssp" set ref 287* 292* 294* 396* 416 420* 420 439* 448* 454* 454 471* 471 579* 602 606* 606 765* 825* 825 833* 1274 1287* 1334* 1378* 1381* 1423 pathname 000655 automatic char(168) packed unaligned dcl 801 in procedure "add_search_paths_to_sl_info" set ref 815* 833 837* 840* 846* pathname parameter char packed unaligned dcl 1175 in procedure "get_path_type" set ref 1170 1179* 1185* 1190* 1195* 1200* 1205* 1216* pathname 000255 automatic char(168) packed unaligned dcl 383 in begin block on line 379 set ref 389* 392* pathname 000357 automatic char(168) packed unaligned dcl 551 in begin block on line 548 set ref 570* 573* pathname parameter char packed unaligned dcl 1242 in procedure "path_index" set ref 1238 1257* 1274 pathname parameter char packed unaligned dcl 875 in procedure "get_search_path_and_position" set ref 867 889* 894* 898* 901* paths 14 based structure array level 2 dcl 1-15 pathx 001020 automatic fixed bin(17,0) dcl 883 in procedure "get_search_path_and_position" set ref 938* 939 945 pathx 000732 automatic fixed bin(17,0) dcl 821 in begin block on line 819 set ref 823* 824 824 825 825 827 827* 852* 853 853 853* pathx 000505 automatic fixed bin(17,0) dcl 753 in begin block on line 751 set ref 764* 765* pathx 6 based fixed bin(17,0) array level 3 in structure "args" dcl 76 in procedure "ssp" set ref 275* 299* 807* 853 853* 853 857* 1368 pathx 000237 automatic fixed bin(17,0) dcl 319 in procedure "add_search_paths_" set ref 451* 452 452 454 454 456 456* 469* 470 470 471 471 473 473* pathx 001423 automatic fixed bin(17,0) dcl 1403 in procedure "print_search_list" set ref 1422* 1423* pathx 000207 automatic fixed bin(17,0) dcl 221 in procedure "set_search_paths_" set ref 276* 287 287 292 292 294 299* pathx 000327 automatic fixed bin(17,0) dcl 384 in begin block on line 379 set ref 392* 393 395 396 414* 416 418 420 422* pathx 001314 automatic fixed bin(17,0) dcl 1331 in begin block on line 1329 set ref 1333* 1334 1334 1334* pathx 000431 automatic fixed bin(17,0) dcl 552 in begin block on line 548 set ref 573* 574 578 579 580 600* 602 604 606 608* pathx 001326 automatic fixed bin(17,0) dcl 1365 in begin block on line 1362 set ref 1368* 1369 1369 1369 1378 1381 pathx 001202 automatic fixed bin(17,0) dcl 1251 in procedure "path_index" set ref 1264* 1266 1268 1274 1277 1277 1287 pos 001062 automatic fixed bin(17,0) dcl 1107 set ref 1126* 1127 1130 1130 print_name_sw parameter bit(1) packed unaligned dcl 1398 ref 1394 1420 psp_args 000400 constant structure level 1 dcl 625 set ref 640* ptr 2 based pointer array level 3 dcl 76 set ref 257 264 264 267 287 350 357 357 360 389 523 530 530 533 570 574 682 728 735 735 738 755 760 765 771 775 778 894 908 908 914 914 920 920 922 922 934 1055* 1066 1066 1075 1079 1086 1088 requote_string_ 000100 constant entry external dcl 1462 ref 1469 1472 rtrim builtin function dcl 93 ref 1466 1469 1469 1472 1472 search builtin function dcl 94 ref 1126 1212 search_path parameter char packed unaligned dcl 1173 set ref 1170 1179 1181* 1181 1181 1187 1187 1192 1192 1197 1197 1202 1202 1209* 1212 1216* 1217* search_paths_$delete_list 000062 constant entry external dcl 139 ref 541 search_paths_$find_all 000064 constant entry external dcl 141 ref 755 search_paths_$find_dir 000066 constant entry external dcl 143 ref 771 search_paths_$get 000070 constant entry external dcl 144 ref 366 554 1361 1416 search_paths_$list 000072 constant entry external dcl 146 ref 652 search_paths_$set 000074 constant entry external dcl 147 ref 1326 sl_control 000173 automatic bit(36) packed unaligned dcl 2-12 set ref 1407 1408 1409 1410 1411 1412 1413 1415* 1416* sl_control_s based structure level 1 packed packed unaligned dcl 2-3 sl_dname 001214 automatic char(168) packed unaligned dcl 1271 set ref 1287* sl_ename 001266 automatic char(32) packed unaligned dcl 1272 set ref 1287* 1290 sl_info based structure level 1 dcl 1-15 set ref 428 461 477 1157 1346 1387 1431 1500 1505 sl_info_num_paths 000172 automatic fixed bin(17,0) dcl 1-27 set ref 1156* 1157 1157 sl_info_ptr parameter pointer dcl 1323 in procedure "set_the_search_paths_of_a_search_list" set ref 1318 1326* 1333 1334 1334 1334 1344 1346 1347* sl_info_ptr parameter pointer dcl 1151 in procedure "create_sl_info" set ref 1147 1153* 1157* 1159 1160 1161 1162 1163 1164 sl_info_ptr parameter pointer dcl 1400 in procedure "print_search_list" set ref 1394 1416* 1422 1423 1429 1431 1432* sl_info_ptr parameter pointer dcl 791 in procedure "add_search_paths_to_sl_info" set ref 787 815* 824 824 825 825 827 827 832 833 850 sl_info_ptr parameter pointer dcl 1241 in procedure "path_index" ref 1238 1264 1266 1274 1277 1277 1287 sl_info_ptr parameter pointer dcl 1357 in procedure "check_paths_for_warnings" set ref 1353 1361* 1362 1369 1369 1378 1381 1387 1388* sl_info_ptr parameter pointer dcl 870 in procedure "get_search_path_and_position" set ref 867 898* 938* sl_info_version_1 000557 constant fixed bin(17,0) initial dcl 1-29 set ref 366* 554* 755* 1159 1361* 1416* sl_list based structure level 1 unaligned dcl 3-3 set ref 1514 sl_list_ptr 000446 automatic pointer dcl 663 set ref 665* 665* 667 668 670* 672 sl_list_version_2 000556 constant fixed bin(17,0) initial dcl 3-12 set ref 652* sl_name parameter char packed unaligned dcl 1321 in procedure "set_the_search_paths_of_a_search_list" set ref 1318 1326* 1340* sl_name 000240 automatic char(32) packed unaligned dcl 320 in procedure "add_search_paths_" set ref 350* 357 366* 370* 464* 480* 484* sl_name 000210 automatic char(32) packed unaligned dcl 222 in procedure "set_search_paths_" set ref 257* 264 302* 306* sl_name 000452 automatic char(32) packed unaligned dcl 677 in begin block on line 675 set ref 682* 683* sl_name parameter char packed unaligned dcl 790 in procedure "add_search_paths_to_sl_info" set ref 787 901* 942* sl_name parameter char packed unaligned dcl 1397 in procedure "print_search_list" set ref 1394 1416* 1420* 1427* sl_name 000345 automatic char(32) packed unaligned dcl 496 in procedure "delete_search_paths_" set ref 523* 530 541* 544* 554* 558* 574* 614* sl_name parameter char packed unaligned dcl 1356 in procedure "check_paths_for_warnings" set ref 1353 1361* sl_name 000475 automatic char(32) packed unaligned dcl 697 in procedure "where_search_paths_" set ref 728* 735 755* 760* 771* 775* sl_name parameter char packed unaligned dcl 1104 in procedure "check_search_list_name" set ref 1100 1109* 1119 1142* ssp_args 000000 constant structure level 1 dcl 226 set ref 240* string parameter char packed unaligned dcl 1303 ref 1298 1307 substr builtin function dcl 95 ref 1130 1130 1233 switch parameter fixed bin(17,0) array level 3 dcl 1015 ref 1076 sys_err_ 000144 automatic entry variable dcl 69 set ref 252 267 283 294 360 370 533 544 558 567 574 587 593 655 659 738 748 760 775 812 901 930 942 968* 990* 995 1043 1058 1086 1088 1122 1130 1138 1209 1217 1334 1340 1381 1427 type parameter fixed bin(17,0) dcl 1174 in procedure "get_path_type" set ref 1170 1178* 1184* 1189* 1194* 1199* 1204* 1212* 1214* type 000727 automatic fixed bin(17,0) dcl 802 in procedure "add_search_paths_to_sl_info" set ref 815* 832 837 840 844 844 844 type parameter fixed bin(17,0) dcl 874 in procedure "get_search_path_and_position" set ref 867 888* 894* type 14 based fixed bin(17,0) array level 3 in structure "sl_info" dcl 1-15 in procedure "ssp" set ref 287* 395* 418* 418 438* 447* 452* 452 470* 470 578* 604* 604 824* 824 832* 1369 1369 uid 16 based bit(36) array level 3 in structure "sl_info" dcl 1-15 in procedure "ssp" set ref 422* 422 440* 449* 456* 456 473* 473 580* 608* 608 827* 827 850* 1164* 1277 1277 uid 001203 automatic bit(36) dcl 1253 in procedure "path_index" set ref 1256* 1261* 1277 1277 uid 000730 automatic bit(36) dcl 803 in procedure "add_search_paths_to_sl_info" set ref 843* 847* 850 usage 000150 automatic char(44) packed unaligned dcl 70 set ref 962* 1487* usage_msg parameter char packed unaligned dcl 958 ref 954 962 963 user_info_$homedir 000076 constant entry external dcl 148 ref 840 value parameter bit(1) array level 3 dcl 1015 ref 1076 version based fixed bin(17,0) level 2 dcl 1-15 set ref 1159* wsp_args 000415 constant structure level 1 dcl 701 set ref 717* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Directory internal static fixed bin(17,0) initial dcl 4-56 Link internal static fixed bin(17,0) initial dcl 4-56 sl_control_default internal static bit(36) initial packed unaligned dcl 2-13 sl_info_p automatic pointer dcl 1-28 sl_list_name_count automatic fixed bin(17,0) dcl 3-11 status_area_ptr automatic pointer dcl 4-47 status_branch based structure level 1 dcl 4-8 status_entry_names based char(32) array dcl 4-47 status_link based structure level 1 dcl 4-38 status_pathname based char dcl 4-47 status_ptr automatic pointer dcl 4-47 NAMES DECLARED BY EXPLICIT CONTEXT. add_search_paths 001551 constant entry external dcl 165 add_search_paths_ 002573 constant entry internal dcl 309 ref 173 add_search_paths_to_sl_info 005544 constant entry internal dcl 787 ref 464 asp 001542 constant entry external dcl 165 check_for_active_function 006676 constant entry internal dcl 978 ref 636 713 check_paths_for_warnings 011522 constant entry internal dcl 1353 ref 306 484 check_search_list_name 010012 constant entry internal dcl 1100 ref 257 350 523 682 728 cleanup_ 012716 constant entry internal dcl 1490 ref 159 162 171 174 183 186 195 198 207 210 create_sl_info 010247 constant entry internal dcl 1147 ref 273 411 437 446 468 597 delete_search_paths 001641 constant entry external dcl 177 delete_search_paths_ 003551 constant entry internal dcl 488 ref 185 dsp 001632 constant entry external dcl 177 get_args 006756 constant entry internal dcl 1011 ref 240 339 512 640 717 get_path_type 010351 constant entry internal dcl 1170 ref 287 389 570 894 934 get_search_path_and_position 006136 constant entry internal dcl 867 ref 815 initialize 006607 constant entry internal dcl 954 ref 157 169 181 193 205 is_control_arg 010675 constant entry internal dcl 1226 ref 1066 1112 1181 output_one_line 012364 constant entry internal dcl 1458 ref 668 1420 1423 1425 1450 output_pathname 012267 constant entry internal dcl 1440 ref 765 778 path_index 010733 constant entry internal dcl 1238 ref 292 392 573 898 938 print_search_list 012022 constant entry internal dcl 1394 ref 670 683 print_search_paths 001731 constant entry external dcl 189 print_search_paths_ 004436 constant entry internal dcl 618 ref 197 psp 001722 constant entry external dcl 189 set_search_paths 001461 constant entry external dcl 50 set_search_paths_ 002101 constant entry internal dcl 213 ref 161 set_the_search_paths_of_a_search_list 011315 constant entry internal dcl 1318 ref 302 480 614 ssp 001452 constant entry external dcl 50 string_array_index 011230 constant entry internal dcl 1298 ref 1066 1075 1079 unique_pathname 011120 constant entry internal dcl 1270 ref 1264 usage_err_ 012614 constant entry internal dcl 1482 ref 246 345 518 646 723 1115 where_search_paths 002021 constant entry external dcl 201 where_search_paths_ 004761 constant entry internal dcl 689 ref 209 wsp 002012 constant entry external dcl 201 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 14632 14734 14144 14642 Length 15332 14144 102 362 466 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME ssp 2116 external procedure is an external procedure. on unit on line 159 64 on unit on unit on line 171 64 on unit on unit on line 183 64 on unit on unit on line 195 64 on unit on unit on line 207 64 on unit set_search_paths_ internal procedure shares stack frame of external procedure ssp. add_search_paths_ internal procedure shares stack frame of external procedure ssp. begin block on line 379 begin block shares stack frame of external procedure ssp. delete_search_paths_ internal procedure shares stack frame of external procedure ssp. begin block on line 548 begin block shares stack frame of external procedure ssp. print_search_paths_ internal procedure shares stack frame of external procedure ssp. begin block on line 661 begin block shares stack frame of external procedure ssp. begin block on line 675 begin block shares stack frame of external procedure ssp. where_search_paths_ internal procedure shares stack frame of external procedure ssp. begin block on line 751 begin block shares stack frame of external procedure ssp. begin block on line 768 begin block shares stack frame of external procedure ssp. add_search_paths_to_sl_info internal procedure shares stack frame of external procedure ssp. begin block on line 819 begin block shares stack frame of external procedure ssp. get_search_path_and_position internal procedure shares stack frame of external procedure ssp. initialize internal procedure shares stack frame of external procedure ssp. check_for_active_function internal procedure shares stack frame of external procedure ssp. get_args internal procedure shares stack frame of external procedure ssp. check_search_list_name internal procedure shares stack frame of external procedure ssp. create_sl_info internal procedure shares stack frame of external procedure ssp. get_path_type internal procedure shares stack frame of external procedure ssp. is_control_arg internal procedure shares stack frame of external procedure ssp. path_index internal procedure shares stack frame of external procedure ssp. unique_pathname internal procedure shares stack frame of external procedure ssp. string_array_index internal procedure shares stack frame of external procedure ssp. set_the_search_paths_of_a_search_list internal procedure shares stack frame of external procedure ssp. begin block on line 1329 begin block shares stack frame of external procedure ssp. check_paths_for_warnings internal procedure shares stack frame of external procedure ssp. begin block on line 1362 begin block shares stack frame of external procedure ssp. begin block on line 1369 begin block shares stack frame of external procedure ssp. print_search_list internal procedure shares stack frame of external procedure ssp. output_pathname internal procedure shares stack frame of external procedure ssp. output_one_line internal procedure shares stack frame of external procedure ssp. usage_err_ internal procedure shares stack frame of external procedure ssp. cleanup_ 66 internal procedure is called by several nonquick procedures. begin block on line 1508 begin block shares stack frame of internal procedure cleanup_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cleanup_ 000100 next_sl_list_ptr begin block on line 1508 ssp 000100 af_return_string_length ssp 000102 af_return_string_ptr ssp 000104 af_sw ssp 000105 af_usage ssp 000120 arg_list_ptr ssp 000122 args_arg_count ssp 000124 args_ptr ssp 000126 cleanup_new_sl_info_ptr ssp 000130 cleanup_sl_info_ptr ssp 000132 cleanup_sl_list_ptr ssp 000134 command ssp 000144 sys_err_ ssp 000150 usage ssp 000172 sl_info_num_paths ssp 000173 sl_control ssp 000202 argx set_search_paths_ 000203 code set_search_paths_ 000204 control_arg_sws set_search_paths_ 000205 old_argx set_search_paths_ 000206 parsed_arg_count set_search_paths_ 000207 pathx set_search_paths_ 000210 sl_name set_search_paths_ 000230 argx add_search_paths_ 000231 code add_search_paths_ 000232 control_arg_sws add_search_paths_ 000233 ignore_current_list add_search_paths_ 000234 old_argx add_search_paths_ 000235 parsed_arg_count add_search_paths_ 000236 path_count add_search_paths_ 000237 pathx add_search_paths_ 000240 sl_name add_search_paths_ 000253 delete_count begin block on line 379 000254 new_pathx begin block on line 379 000255 pathname begin block on line 379 000327 pathx begin block on line 379 000340 argx delete_search_paths_ 000341 code delete_search_paths_ 000342 control_arg_sws delete_search_paths_ 000343 old_argx delete_search_paths_ 000344 parsed_arg_count delete_search_paths_ 000345 sl_name delete_search_paths_ 000355 delete_count begin block on line 548 000356 new_pathx begin block on line 548 000357 pathname begin block on line 548 000431 pathx begin block on line 548 000442 code print_search_paths_ 000443 control_arg_sws print_search_paths_ 000444 parsed_arg_count print_search_paths_ 000445 namex begin block on line 661 000446 sl_list_ptr begin block on line 661 000451 argx begin block on line 675 000452 sl_name begin block on line 675 000470 argx where_search_paths_ 000471 code where_search_paths_ 000472 control_arg_sws where_search_paths_ 000473 old_argx where_search_paths_ 000474 parsed_arg_count where_search_paths_ 000475 sl_name where_search_paths_ 000505 pathx begin block on line 751 000507 dir_name begin block on line 768 000570 argx add_search_paths_to_sl_info 000571 dname add_search_paths_to_sl_info 000643 ename add_search_paths_to_sl_info 000653 error add_search_paths_to_sl_info 000654 insert_index add_search_paths_to_sl_info 000655 pathname add_search_paths_to_sl_info 000727 type add_search_paths_to_sl_info 000730 uid add_search_paths_to_sl_info 000732 pathx begin block on line 819 000744 next_arg get_search_path_and_position 000745 old_pathname get_search_path_and_position 001017 old_type get_search_path_and_position 001020 pathx get_search_path_and_position 001036 arg_count check_for_active_function 001046 argx get_args 001047 namex get_args 001050 last_parsed_arg get_args 001062 pos check_search_list_name 001116 code path_index 001117 dname path_index 001171 ename path_index 001201 entry_type path_index 001202 pathx path_index 001203 uid path_index 001214 sl_dname unique_pathname 001266 sl_ename unique_pathname 001304 arrayx string_array_index 001314 pathx begin block on line 1329 001324 code check_paths_for_warnings 001325 argx begin block on line 1362 001326 pathx begin block on line 1362 001327 bit_count begin block on line 1369 001330 dir_name begin block on line 1369 001402 entry_type begin block on line 1369 001403 entryname begin block on line 1369 001422 code print_search_list 001423 pathx print_search_list 001434 length output_pathname 001435 pathname output_pathname THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_g_a r_e_as r_ne_as alloc_char_temp cat_realloc_chars call_ent_var_desc call_ext_out_desc call_ext_out call_int_this call_int_other return_mac enable_op shorten_stack ext_entry int_entry alloc_storage op_freen_ verify_for_ltrim verify_for_rtrim THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. absolute_pathname_ active_fnc_err_ active_fnc_err_$af_suppress_name com_err_ com_err_$suppress_name cu_$af_arg_count_rel cu_$af_return_arg_rel cu_$arg_list_ptr cu_$arg_ptr_rel expand_pathname_ get_pdir_ get_system_free_area_ hcs_$get_uid_file hcs_$status_minf ioa_ ioa_$rsnnl requote_string_ search_paths_$delete_list search_paths_$find_all search_paths_$find_dir search_paths_$get search_paths_$list search_paths_$set user_info_$homedir THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$action_not_performed error_table_$badarg error_table_$badopt error_table_$new_search_list error_table_$not_act_fnc LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 50 001451 157 001466 158 001502 159 001511 161 001533 162 001534 163 001540 165 001541 169 001556 170 001572 171 001601 173 001623 174 001624 175 001630 177 001631 181 001646 182 001662 183 001671 185 001713 186 001714 187 001720 189 001721 193 001736 194 001752 195 001761 197 002003 198 002004 199 002010 201 002011 205 002026 206 002042 207 002051 209 002073 210 002074 211 002100 213 002101 240 002102 241 002105 244 002110 246 002112 247 002113 250 002114 252 002123 253 002147 256 002150 257 002153 258 002200 262 002203 263 002205 264 002214 266 002235 267 002240 268 002274 270 002275 271 002300 273 002302 275 002307 276 002321 278 002335 280 002342 282 002346 283 002351 284 002373 287 002374 289 002432 292 002435 294 002465 296 002522 299 002523 300 002530 302 002532 303 002561 306 002567 307 002572 309 002573 339 002574 340 002577 343 002602 345 002605 346 002606 349 002607 350 002612 351 002637 355 002642 356 002644 357 002652 359 002673 360 002676 361 002732 363 002733 364 002736 366 002740 368 003016 370 003020 371 003045 374 003046 379 003047 387 003054 388 003055 389 003064 390 003117 392 003122 393 003125 395 003127 396 003132 397 003136 399 003137 402 003145 404 003151 405 003153 406 003154 409 003155 411 003157 413 003164 414 003166 416 003203 418 003214 420 003223 422 003227 424 003231 426 003232 428 003234 429 003242 430 003244 435 003246 437 003250 438 003255 439 003270 440 003306 441 003320 445 003321 446 003324 447 003331 448 003344 449 003362 451 003374 452 003403 454 003411 456 003416 458 003420 461 003422 462 003430 464 003432 465 003465 468 003470 469 003472 470 003501 471 003507 473 003514 475 003516 477 003520 478 003526 480 003530 481 003535 484 003540 486 003550 488 003551 512 003552 513 003555 516 003560 518 003562 519 003563 522 003564 523 003567 524 003614 528 003617 529 003621 530 003630 532 003651 533 003654 534 003710 536 003711 537 003714 539 003716 541 003723 542 003746 544 003750 545 003775 547 003776 554 003777 556 004055 558 004057 559 004104 562 004105 563 004106 564 004116 566 004123 567 004126 568 004150 570 004151 571 004201 573 004204 574 004207 578 004254 579 004257 580 004263 581 004264 583 004265 585 004273 587 004277 588 004323 591 004324 593 004326 594 004352 597 004353 599 004360 600 004362 602 004377 604 004410 606 004417 608 004423 610 004425 612 004426 614 004430 616 004435 618 004436 636 004437 637 004441 640 004444 641 004447 644 004452 646 004457 647 004460 650 004461 652 004463 653 004513 655 004515 656 004531 659 004532 665 004563 667 004572 668 004603 669 004617 670 004621 672 004655 674 004661 681 004662 682 004670 683 004716 685 004752 687 004760 689 004761 713 004762 714 004764 717 004767 718 004772 721 004775 723 005000 724 005001 727 005002 728 005005 729 005032 733 005035 734 005037 735 005046 737 005067 738 005072 739 005124 741 005125 742 005130 744 005132 745 005136 747 005141 748 005144 749 005166 751 005167 755 005174 757 005261 759 005263 760 005274 761 005333 764 005334 765 005345 766 005375 751 005377 771 005400 772 005447 774 005451 775 005462 776 005521 778 005522 780 005543 787 005544 805 005555 807 005557 808 005571 809 005600 811 005604 812 005610 813 005632 815 005633 816 005700 819 005704 823 005707 824 005717 825 005726 827 005733 829 005735 831 005740 832 005742 833 005751 837 005757 840 005772 843 006005 844 006006 846 006014 847 006041 850 006072 852 006101 853 006111 855 006120 857 006122 859 006127 860 006135 867 006136 888 006147 889 006151 890 006155 891 006160 892 006164 894 006165 895 006221 898 006225 900 006261 901 006266 904 006325 907 006332 908 006334 910 006351 911 006353 914 006354 916 006364 917 006367 920 006370 922 006402 924 006415 926 006416 927 006417 929 006422 930 006425 931 006460 934 006461 935 006512 938 006516 939 006536 941 006540 942 006545 945 006603 946 006606 954 006607 961 006632 962 006640 963 006645 965 006657 967 006662 968 006663 970 006670 971 006672 972 006673 973 006674 974 006675 978 006676 986 006700 987 006720 989 006723 990 006725 991 006732 992 006733 993 006734 995 006741 996 006755 1011 006756 1034 006762 1035 007017 1036 007020 1038 007021 1039 007034 1041 007042 1043 007044 1044 007060 1047 007061 1049 007064 1051 007074 1052 007075 1054 007110 1055 007117 1056 007141 1058 007144 1059 007174 1061 007175 1063 007177 1064 007201 1065 007203 1066 007207 1068 007274 1069 007276 1071 007304 1072 007311 1073 007312 1075 007313 1076 007410 1079 007547 1080 007616 1083 007702 1085 007703 1086 007707 1088 007751 1089 010006 1094 010007 1095 010010 1096 010011 1100 010012 1109 010030 1110 010035 1112 010036 1114 010056 1115 010061 1116 010062 1119 010063 1121 010066 1122 010071 1123 010122 1126 010123 1127 010137 1129 010140 1130 010142 1132 010204 1135 010205 1137 010212 1138 010214 1139 010240 1142 010241 1143 010246 1147 010247 1153 010251 1154 010253 1156 010255 1157 010256 1159 010267 1160 010271 1161 010273 1162 010277 1163 010313 1164 010332 1166 010350 1170 010351 1178 010367 1179 010371 1180 010377 1181 010400 1184 010433 1185 010435 1186 010442 1187 010443 1189 010453 1190 010455 1191 010462 1192 010463 1194 010473 1195 010475 1196 010502 1197 010503 1199 010513 1200 010515 1201 010522 1202 010523 1204 010533 1205 010535 1206 010542 1208 010543 1209 010546 1210 010575 1212 010576 1214 010616 1216 010620 1217 010642 1220 010674 1226 010675 1231 010706 1233 010721 1238 010733 1255 010744 1256 010745 1257 010746 1258 010775 1260 010777 1261 011035 1264 011065 1265 011104 1266 011106 1268 011116 1270 011120 1274 011122 1277 011141 1285 011153 1287 011160 1288 011210 1290 011215 1292 011225 1298 011230 1307 011246 1308 011300 1309 011302 1311 011312 1318 011315 1326 011326 1327 011356 1329 011361 1333 011364 1334 011377 1337 011441 1329 011443 1340 011444 1344 011502 1346 011507 1347 011516 1349 011521 1353 011522 1361 011533 1362 011613 1367 011620 1368 011630 1369 011633 1378 011645 1380 011702 1381 011740 1385 012000 1387 012006 1388 012016 1390 012021 1394 012022 1405 012033 1407 012041 1408 012043 1409 012045 1410 012047 1411 012051 1412 012053 1413 012055 1414 012057 1415 012060 1416 012061 1418 012137 1420 012141 1422 012160 1423 012173 1424 012211 1425 012213 1426 012216 1427 012217 1429 012247 1431 012254 1432 012263 1434 012266 1440 012267 1449 012305 1450 012360 1451 012363 1458 012364 1464 012375 1466 012377 1469 012430 1472 012500 1474 012570 1475 012572 1476 012613 1482 012614 1485 012615 1487 012657 1488 012714 1490 012715 1493 012723 1495 012730 1496 012735 1498 012740 1500 012744 1501 012752 1503 012755 1505 012761 1506 012767 1508 012772 1512 012776 1513 013003 1514 013006 1515 013014 1516 013017 1518 013020 ----------------------------------------------------------- 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