COMPILATION LISTING OF SEGMENT directory_commands_ Compiled by: Multics PL/I Compiler, Release 33a, of May 30, 1990 Compiled at: ACTC Technologies Inc. Compiled on: 09/04/90 1202.2 mdt Tue Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1990 * 4* * * 5* * Copyright, (C) Honeywell Bull Inc., 1988 * 6* * * 7* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 8* * * 9* * Copyright (c) 1972 by Massachusetts Institute of * 10* * Technology and Honeywell Information Systems, Inc. * 11* * * 12* *********************************************************** */ 13 14 15 16 /****^ HISTORY COMMENTS: 17* 1) change(88-04-28,TLNguyen), approve(88-04-28,MCR7839), 18* audit(88-06-02,Lippard), install(88-07-05,MR12.2-1054): 19* SCP6361 requested to add new functions to change_wdir (cwd), print_dir 20* (pwd) and working_dir (wd). For details, see the MTB 775. 21* 2) change(90-01-25,Vu), approve(90-01-25,MCR8153), audit(90-06-21,Huen), 22* install(90-09-04,MR12.4-1032): 23* The active function for working_dir will now return quoted string. 24* 3) change(90-01-25,Vu), approve(90-01-25,MCR8154), audit(90-06-21,Huen), 25* install(90-09-04,MR12.4-1032): 26* The wd command with an argument of 0 should return the current directory. 27* END HISTORY COMMENTS */ 28 29 directory_commands_: 30 proc options (variable); 31 32 /* * Commands and subroutines for manipulating the working directory and default working directory. */ 33 /* * Completely rewritten, 05/24/79 W. Olin Sibert */ 34 /* Fix bugs, remove checks before calling hcs_$fs_search_set_wdir */ 35 36 /* constants */ 37 dcl ALLOWED_DIGITS char (10) internal static options (constant) init ("0123456789"); 38 dcl MAX_LENGTH_LABEL_NAME fixed bin (17) internal static options (constant) init (32); 39 40 /* automatic variables */ 41 dcl (LOCATION_after_colon, LOCATION_before_colon) char (32) varying; 42 dcl active_function bit (1) aligned; 43 dcl ap ptr; 44 dcl al fixed bin; 45 dcl arg_index fixed bin; 46 dcl array_index fixed bin; 47 dcl clear_entire_stack_flag bit (1) aligned; 48 dcl clear_wdir_flag bit (1) aligned; 49 dcl code fixed bin (35); 50 dcl current_wdir char (168); 51 dcl current_wdir_length fixed bin; 52 dcl given_label_name char (32); 53 dcl error_count fixed bin; 54 dcl label_current_wdir_for_rotation bit (1) aligned; 55 dcl labels_the_current_wdir char (32); 56 dcl location_array (0:9999) fixed bin (35); 57 dcl match bit (1) aligned; 58 dcl max_array_index fixed bin; 59 dcl nargs fixed bin; 60 dcl pathname char (168); 61 dcl pathname_count fixed bin; 62 dcl pop_wdir_flag bit (1) aligned; 63 dcl push_wdir_flag bit (1) aligned; 64 dcl rotate_wdir_flag bit (1) aligned; 65 dcl stack_location fixed bin (35); 66 dcl temp_ptr ptr; 67 dcl whoami char (32); 68 69 /* static variables */ 70 dcl area_ptr ptr internal static init (null); 71 dcl total_number_of_pushes fixed bin (35) internal static init (0); /* total number of prior wdirs */ 72 dcl default_wdir_set bit (1) aligned internal static initial ("0"b); /* turned on after we've been called once */ 73 dcl default_wdir_pathname char (168) aligned internal static init (""); /* the static default wdir pathname */ 74 dcl first_node_ptr ptr internal static init (null); 75 dcl last_node_ptr ptr internal static init (null); 76 dcl label_name_of_current_wdir char (32) varying internal static init (""); 77 dcl current_wdir_pathname char (168) varying internal static init (""); 78 79 /* based */ 80 dcl arg char (al) based (ap); 81 82 dcl 1 stack_linked_list aligned based, 83 2 back_ptr ptr, 84 2 label_name char (32) varying, 85 2 wdir_name char (168) varying; 86 87 dcl system_area area based (area_ptr); 88 89 90 /* external entries */ 91 dcl active_fnc_err_ entry options (variable); 92 dcl com_err_ entry options (variable); 93 dcl cu_$af_return_arg entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); 94 dcl cu_$arg_count entry (fixed bin, fixed bin (35)); 95 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 96 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); 97 dcl expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35)); 98 dcl get_system_free_area_ entry returns (ptr); 99 dcl hcs_$fs_search_get_wdir entry (ptr, fixed bin); 100 dcl hcs_$fs_search_set_wdir entry (char (*), fixed bin (35)); 101 dcl ioa_ entry options (variable); 102 dcl requote_string_ entry (char (*)) returns (char (*)); 103 dcl sub_err_ entry options (variable); 104 dcl user_info_$homedir entry (char (*) aligned); 105 106 dcl (error_table_$argerr, 107 error_table_$bad_arg, 108 error_table_$badopt, 109 error_table_$bigarg, 110 error_table_$no_wdir, 111 error_table_$not_act_fnc) fixed bin (35) ext static; 112 /* builtin */ 113 dcl (abs, after, addr, before, char, index, ltrim, length, null, rtrim, substr, verify) builtin; 114 115 /*--------------------------------------------------------------------------*/ 116 117 change_wdir: 118 cwd: entry options (variable); 119 120 /* The following internal procedures are belonged to change_wdir entry. */ 121 /* They are listed first before you can reach the main program of */ 122 /* change_wdir entry. There are other internal procedures which belong to */ 123 /* this entry are listed at the end of directory_commands_.pl1 since they */ 124 /* are also called by working_dir entry. */ 125 /* */ 126 /* This entry is documented in the MTB 775 and approved in MCR7839. */ 127 /* It syntax: cwd {path} {-control_args} */ 128 /* control arguments: -push {LABEL}; -pop {LOCATION} default is stack */ 129 /* location 1; -rotate {LOCATION {LABEL}} default is the top stack at */ 130 /* stack location 1; -clear {LOCATIONs} default is the entire stack. */ 131 /* LOCATION can be either stack location N or a text string LABEL. */ 132 /* */ 133 /* The design of data structure: singlely linked circular list to implement */ 134 /* a stack of prior working directory that you have been visited. */ 135 /* */ 136 /* first_node_ptr : points to the node containing the least recent wdir. */ 137 /* last_node_ptr : points to the node containing the most recent_wdir. */ 138 /* total_number_of_pushes: indicates the number of nodes currently on the */ 139 /* stack of prior working directories. */ 140 /* */ 141 /* for an empty linked list: */ 142 /* first_node_ptr = null */ 143 /* last_node_ptr = null */ 144 /* total_number_of_pushes = 0 */ 145 /* */ 146 /* for a linked list of one node: */ 147 /* total_number_of_pushes = 1 */ 148 /* */ 149 /* first_node_ptr last_node_ptr */ 150 /* | | */ 151 /* ______|___________|_________ */ 152 /* | | | | */ 153 /* <____ | LABEL | PRIOR WDIR | */ 154 /* | |__|_______|________________| */ 155 /* | | */ 156 /* |________>_________| 157*/* */ 158 /* */ 159 /* for a linked list of n nodes: */ 160 /* total_number_of_pushes = n (where n is a numeric digit) */ 161 /* */ 162 /* first_node_ptr last_node_ptr */ 163 /* | | */ 164 /* ____|______ ___________ ___________ ____|______ */ 165 /* | | | | | | | | | | | | | | | | */ 166 /* <___ | | |<____ | | |<_____ | | |<___ ... <____ | | | */ 167 /* | |__|__|___| |__|__|___| |__|__|___| |__|__|___| */ 168 /* | | */ 169 /* |______________>______________________________>_______________| */ 170 /* */ 171 /*----------------------------------------------*/ 172 173 LOCATION_validation: proc (P_arg, P_stack_position, P_label_name, P_label_current_wdir_for_rotation, P_labels_the_cur_wdir, 174 P_clear_flag, P_push_flag); 175 176 /* verify that LOCATION specified is valid, where LOCATION can be a stack */ 177 /* position N or a text string LABEL. */ 178 /* N must be within a stack of prior wdirs. LABEL's max. lenghth is 32 */ 179 /* characters and it cannot begin with a minus sign or a numeric digit. */ 180 /* LABEL cannot include a colon since a colon indicates a range. */ 181 /* LABEL cannot be a reserved word such as first (f), last (l), all (a). */ 182 183 /* parameters */ 184 dcl P_arg char (*); 185 dcl P_clear_flag bit (1) aligned; 186 dcl P_labels_the_cur_wdir char (*); 187 dcl P_label_current_wdir_for_rotation bit (1) aligned; 188 dcl P_label_name char (*); 189 dcl P_push_flag bit (1) aligned; 190 dcl P_stack_position fixed bin (35); 191 /* local */ 192 dcl err_count fixed bin; 193 194 /* begin coding */ 195 code = 0; 196 LOCATION_before_colon = ""; 197 LOCATION_after_colon = ""; 198 err_count = 0; 199 200 if index (P_arg, "-") = 1 then do; 201 code = error_table_$badopt; 202 return; 203 end; 204 205 if index (P_arg, ":") ^= 0 then do; /* a range is specified */ 206 if ^P_clear_flag then do; /* only -clear allowed a range */ 207 ERR_RET: 208 code = error_table_$bad_arg; 209 return; 210 end; 211 212 else do; /* prepare for parsing a range */ 213 LOCATION_before_colon = before (P_arg, ":"); 214 LOCATION_after_colon = after (P_arg, ":"); 215 216 if (LOCATION_before_colon = "") | (LOCATION_after_colon = "") then 217 goto ERR_RET; 218 end; 219 end; 220 221 if verify (substr (P_arg, 1, 1), ALLOWED_DIGITS) = 0 then do; 222 /* LOCATION is a stack position N. */ 223 if ^P_clear_flag then do; 224 if P_push_flag then /* -push allowed only LABEL */ 225 goto ERR_RET; 226 227 /* -pop, -rotate allow both LABEL and stack location N */ 228 P_stack_position = cv_dec_check_ (P_arg, code); 229 if code ^= 0 then goto ERR_RET; 230 231 if (P_stack_position < 1) | (P_stack_position > total_number_of_pushes) then 232 goto ERR_RET; /* the specified stack position N is without the stack of prior wdirs */ 233 234 P_stack_position = abs (P_stack_position); 235 end; 236 else do; /* -clear */ 237 if index (P_arg, ":") > 1 then do; /* LOCATION is a range (e.g. 10:l 15:LABEL 8:12) */ 238 P_stack_position = cv_dec_check_ ((LOCATION_before_colon), code); 239 if code ^= 0 then goto ERR_RET; 240 241 if P_stack_position = 0 then /* stack position N must begin at 1 and end at total_number_of_pushes */ 242 goto ERR_RET; 243 244 P_stack_position = abs (P_stack_position); 245 /* save it */ 246 call save_a_valid_LOCATION (max_array_index, P_stack_position); 247 248 call LOCATION_continue_validation ((LOCATION_after_colon), max_array_index, P_stack_position, code); 249 end; 250 else do; /* LOCATION is a stack location N */ 251 P_stack_position = cv_dec_check_ (P_arg, code); 252 if code ^= 0 then goto ERR_RET; 253 254 /* make sure a specified stack position N is within the stack of prior wdirs */ 255 if P_stack_position = 0 | P_stack_position > total_number_of_pushes then 256 goto ERR_RET; 257 258 P_stack_position = abs (P_stack_position); 259 call save_a_valid_LOCATION (max_array_index, P_stack_position); 260 end; 261 end; 262 end; 263 264 else if P_clear_flag then do; 265 if P_arg = "first" | P_arg = "f" then do; 266 P_stack_position = 1; 267 call save_a_valid_LOCATION (max_array_index, P_stack_position); 268 end; 269 270 else if P_arg = "last" | P_arg = "l" then do; 271 P_stack_position = total_number_of_pushes; 272 call save_a_valid_LOCATION (max_array_index, P_stack_position); 273 end; 274 275 else if P_arg = "all" | P_arg = "a" then do; 276 P_stack_position = 1; 277 call save_a_valid_LOCATION (max_array_index, P_stack_position); 278 P_stack_position = total_number_of_pushes; 279 call CONTINUE_save_good_data (max_array_index, P_stack_position, code); 280 end; 281 282 else if index (P_arg, ":") = 0 then 283 call LABEL_validation (P_arg, max_array_index, P_stack_position, code); 284 285 else do; 286 if LOCATION_before_colon = "first" | LOCATION_before_colon = "f" then do; 287 P_stack_position = 1; 288 call save_a_valid_LOCATION (max_array_index, P_stack_position); 289 end; 290 291 else if LOCATION_before_colon = "last" | LOCATION_before_colon = "l" then 292 goto ERR_RET; 293 294 else if LOCATION_before_colon = "all" | LOCATION_before_colon = "a" then 295 goto ERR_RET; 296 297 else call LABEL_validation ((LOCATION_before_colon), max_array_index, P_stack_position, code); 298 299 call LOCATION_continue_validation ((LOCATION_after_colon), max_array_index, P_stack_position, code); 300 end; 301 end; 302 303 else do; 304 if P_arg = "all" | P_arg = "a" then err_count = err_count + 1; 305 if P_arg = "first" | P_arg = "f" then err_count = err_count + 1; 306 if P_arg = "last" | P_arg = "l" then err_count = err_count + 1; 307 308 if err_count > 0 then do; 309 error_count = -1; /* mark that an error encountered */ 310 goto ERR_RET; 311 end; 312 313 if length (P_arg) > MAX_LENGTH_LABEL_NAME then do; 314 code = error_table_$bigarg; 315 return; 316 end; 317 318 if P_label_current_wdir_for_rotation then /* want to label the current wdir before rotation begins */ 319 P_labels_the_cur_wdir = P_arg; 320 else P_label_name = P_arg; 321 end; 322 323 return; /* return to change_wdir entry */ 324 325 end LOCATION_validation; 326 327 /*---------------------------------------------*/ 328 329 array_selection_sort: proc; 330 331 /* sort the contents of location_array from array index 1 through */ 332 /* max_array_index in an ascending order (increasing value). All duplicate */ 333 /* stack locations containing in an array are eliminated so that the array */ 334 /* only contains unique stack location values. */ 335 /* */ 336 /* Currently, all LOCATIONs containing in an array are not in order and */ 337 /* may be duplicated. For example: */ 338 /* */ 339 /* Before sorting: max_array_index = 6, location_array contains stack */ 340 /* locations 1, 6, 7, 3, 5, and 3. */ 341 /* */ 342 /* After sorting, max_arry_index = 5, the contents of location_array are */ 343 /* 1, 3, 5, 6, and 7. */ 344 /* */ 345 /* before sorting after sorting */ 346 /* */ 347 /* ________ ________ */ 348 /* 1 | 1 | 1 | 1 | */ 349 /* |______| |______| */ 350 /* 2 | 6 | 2 | 3 | */ 351 /* |______| |______| */ 352 /* 3 | 7 | =====> 3 | 5 | */ 353 /* |______| |______| */ 354 /* 4 | 3 | 4 | 6 | */ 355 /* |______| |______| */ 356 /* 5 | 5 | 5 | 7 | */ 357 /* |______| |______| */ 358 /* 6 | 3 | 6 | -1 | */ 359 /* |______| |______| */ 360 /* */ 361 /* local */ 362 dcl (i_index, j_index, k_index) fixed bin; 363 dcl smallest_index_for_unsorted_array fixed bin; 364 dcl temp_data fixed bin (35); 365 366 367 /* begin coding */ 368 i_index = 1; 369 temp_data = 0; 370 371 do while (i_index < max_array_index); 372 /* prepare for the inner loop */ 373 smallest_index_for_unsorted_array = i_index; 374 j_index = i_index + 1; 375 376 do while (j_index <= max_array_index); /* find the minimum location (which stored early) so far */ 377 if location_array (j_index) < location_array (smallest_index_for_unsorted_array) then 378 smallest_index_for_unsorted_array = j_index; 379 380 else if location_array (j_index) = location_array (smallest_index_for_unsorted_array) then do; 381 /* duplicate stack location value is found, so get rid of it */ 382 /* by move the contents of an array underneath of the duplicate value up to 1 level */ 383 do k_index = j_index to (max_array_index - 1); 384 location_array (k_index) = location_array (k_index + 1); 385 end; 386 /* re-initialize the contents of location_array at subcript max_array_index */ 387 location_array (max_array_index) = - 1; 388 /* update the actual maximum array index value after overwritten the duplicate */ 389 max_array_index = max_array_index - 1; 390 /* forget about the duplicate, assume that no duplication found at subcript j_index */ 391 j_index = j_index - 1; 392 end; 393 394 j_index = j_index + 1; 395 end; 396 /* swapping: move the smaller location found into a temp. place */ 397 temp_data = location_array (smallest_index_for_unsorted_array); 398 /* move the larger location into the place where the smaller location used to live */ 399 location_array (smallest_index_for_unsorted_array) = location_array (i_index); 400 401 location_array (i_index) = temp_data; 402 403 i_index = i_index + 1; 404 end; 405 406 return; /* return to do_clear internal procedure of change_wdir entry */ 407 408 end array_selection_sort; 409 410 /*--------------------------------------------*/ 411 412 move_to_top_stack_dir: proc (p_travel_ptr, p_temp_ptr, p_dir_pathname); 413 414 /* set the most recent prior wdir at the top stack to become the current */ 415 /* wdir. Since all prior wdirs are stored in a singlely circular linked */ 416 /* list, links such as first_node_ptr which points to the least recent wdir */ 417 /* at the bottom stack and temp_ptr which points to the current wdir must be */ 418 /* updated after appended the current wdir to the bottom stack. */ 419 /* parameters */ 420 dcl p_dir_pathname char (*); 421 dcl p_temp_ptr ptr; 422 dcl p_travel_ptr ptr; 423 424 /* begin coding */ 425 /* update pointers */ 426 p_temp_ptr -> stack_linked_list.back_ptr = p_travel_ptr -> stack_linked_list.back_ptr; 427 first_node_ptr -> stack_linked_list.back_ptr = p_temp_ptr; 428 429 first_node_ptr = p_temp_ptr; 430 last_node_ptr = p_travel_ptr -> stack_linked_list.back_ptr; 431 432 /* get the most recent wdir and its associated label name */ 433 p_dir_pathname = p_travel_ptr -> stack_linked_list.wdir_name; 434 label_name_of_current_wdir = p_travel_ptr -> stack_linked_list.label_name; 435 436 /* remove the node containing most recent wdir and label from the list */ 437 free p_travel_ptr -> stack_linked_list in (system_area); 438 p_temp_ptr = null; 439 p_travel_ptr = null; 440 441 return; /* return to do_rotate internal procedure of change_wdir entry */ 442 end move_to_top_stack_dir; 443 444 /*--------------------------------------------*/ 445 446 move_to_a_specified_dir: proc (para_travel_ptr, para_previous_ptr, para_temp_ptr, para_pathname); 447 448 /* set the prior wdir at a specified LOCATION to become the current wdir. */ 449 /* Since all prior wdirs are stored in a singlely circular linked list, */ 450 /* links (pointers) must be updated depending on which LOCATION you want */ 451 /* to move to (e.g. middle, end, or any LOCATION on the stack). */ 452 453 dcl para_travel_ptr ptr; 454 dcl para_pathname char (*); 455 dcl para_previous_ptr ptr; 456 dcl para_temp_ptr ptr; 457 458 /* begin coding */ 459 /* update links */ 460 para_temp_ptr -> stack_linked_list.back_ptr = last_node_ptr; 461 first_node_ptr -> stack_linked_list.back_ptr = para_temp_ptr; 462 463 para_previous_ptr -> stack_linked_list.back_ptr = para_travel_ptr -> stack_linked_list.back_ptr; 464 465 first_node_ptr = para_previous_ptr; 466 last_node_ptr = para_travel_ptr -> stack_linked_list.back_ptr; 467 468 /* get a prior wdir and its associated label name at that specified LOCATION */ 469 para_pathname = para_travel_ptr -> stack_linked_list.wdir_name; 470 label_name_of_current_wdir = para_travel_ptr -> stack_linked_list.label_name; 471 472 /* remove the node at that specified LOCATION from the linked list */ 473 free para_travel_ptr -> stack_linked_list in (system_area); 474 475 para_previous_ptr = null; 476 para_temp_ptr = null; 477 para_travel_ptr = null; 478 479 return; /* return to do_rotate internal procedure of change_wdir entry */ 480 end move_to_a_specified_dir; 481 482 /*------------------------------------------*/ 483 484 do_clear: proc (p_total_numb_of_pushes, p_err_cnt); 485 486 /* remove working directories from the stack without changing the current */ 487 /* wdir. Assume that specified LOCATIONs or reserved words are valid at */ 488 /* at this point. All stack locations where prior wdirs will be cleared out */ 489 /* are stored earlier in an array. */ 490 /* The array containing stack locations must be sorted in increasing order */ 491 /* before removing prior wdirs from the stack. */ 492 /* Start the linked list from the node containing the most recent wdir and */ 493 /* stop at the node containing the prior wdir to be cleared out. Remove it */ 494 /* from the linked list after taken care of links (pointers). */ 495 /* If there are more prior wdirs to be cleared out then continue walk on the */ 496 /* linked list from previous stop, since stack locations where prior wdirs */ 497 /* to be deleted are already sorted, until specified prior wdirs are removed */ 498 /* from the stack. */ 499 500 /* parameters */ 501 dcl p_err_cnt fixed bin; 502 dcl p_total_numb_of_pushes fixed bin (35); 503 /* local */ 504 dcl clear_index fixed bin (35); 505 dcl previous_pointer pointer; 506 dcl skip_node_index fixed bin (35); 507 508 /* begin coding */ 509 array_index = 0; 510 p_err_cnt = 0; 511 clear_index = 0; 512 previous_pointer = null; 513 skip_node_index = 0; 514 515 if last_node_ptr = null & p_total_numb_of_pushes = 0 then do; 516 if rtrim (pathname) ^= "" then /* allows to change to the NEW current wdir instead of return as an error */ 517 call ioa_ ("Warning: the stack of prior wdirs is empty."); 518 else do; 519 p_err_cnt = p_err_cnt + 1; /* the stack is empty */ 520 call com_err_ (0, whoami, "Empty stack."); 521 end; 522 return; 523 end; 524 525 if clear_entire_stack_flag then do; /* wanted to clear the entire stack of prior wdirs */ 526 do clear_index = 1 to p_total_numb_of_pushes; 527 temp_ptr = last_node_ptr; 528 last_node_ptr = temp_ptr -> stack_linked_list.back_ptr; 529 first_node_ptr -> stack_linked_list.back_ptr = last_node_ptr; 530 531 free temp_ptr -> stack_linked_list in (system_area); 532 end; 533 534 p_total_numb_of_pushes = 0; 535 last_node_ptr = null; 536 first_node_ptr = null; 537 return; 538 end; 539 540 if max_array_index > 1 then 541 call array_selection_sort; /* sort given stack locations in ascending order */ 542 543 temp_ptr = last_node_ptr; /* prepare for looking a target */ 544 545 if max_array_index = 1 then do; /* want to clear out only a single prior wdir from the stack */ 546 547 if location_array (max_array_index) = 1 then do; /* want to clear out the most recent wdir from the stack */ 548 last_node_ptr = temp_ptr -> stack_linked_list.back_ptr; 549 first_node_ptr -> stack_linked_list.back_ptr = last_node_ptr; 550 551 if p_total_numb_of_pushes = 1 then do; /* the linked list contains only one node to be cleared out */ 552 last_node_ptr = null; 553 first_node_ptr = null; 554 end; 555 end; 556 else do; 557 /* walk on the linked list from the node containing the most recent wdir */ 558 /* and stop at the node located at (n-1)th before reaching the */ 559 /* node containing the prior wdir to be deleted at stack position n */ 560 do skip_node_index = 1 to (location_array (max_array_index) - 1); 561 previous_pointer = temp_ptr; 562 temp_ptr = temp_ptr -> stack_linked_list.back_ptr; 563 end; 564 /* prepare to clear out the least recent wdir at bottom stack */ 565 if location_array (max_array_index) = p_total_numb_of_pushes then do; 566 first_node_ptr = previous_pointer; 567 first_node_ptr -> stack_linked_list.back_ptr = last_node_ptr; 568 end; 569 /* prepare to clear out a prior wdir at a specified stack location */ 570 else previous_pointer -> stack_linked_list.back_ptr = temp_ptr -> stack_linked_list.back_ptr; 571 end; 572 /* remove a prior wdir from the stack */ 573 free temp_ptr -> stack_linked_list in (system_area); 574 /* update the total number of nodes currently in the linked list */ 575 p_total_numb_of_pushes = p_total_numb_of_pushes - 1; 576 end; /* remove only a single prior wdir from the stack */ 577 else do; /* remove at least two prior wdirs from the stack of prior wdirs */ 578 do array_index = 1 to max_array_index; 579 /* prepare to clear out the most recent wdir from the stack */ 580 if location_array (array_index) = 1 then do; 581 last_node_ptr = temp_ptr -> stack_linked_list.back_ptr; 582 first_node_ptr -> stack_linked_list.back_ptr = last_node_ptr; 583 end; 584 /* prepare to remove several consective prior wdirs (e.g. 1 2 3; 7 8 9) */ 585 if (location_array (array_index)) = (location_array (array_index - 1) + 1) then do; 586 587 if previous_pointer ^= null then do; 588 temp_ptr = previous_pointer -> stack_linked_list.back_ptr; 589 previous_pointer -> stack_linked_list.back_ptr = temp_ptr -> stack_linked_list.back_ptr; 590 591 /* prepare to clear out the least recent wdir */ 592 if location_array (array_index) = p_total_numb_of_pushes then 593 first_node_ptr = previous_pointer; 594 end; 595 else do; /* update pointer pointing to the node containing the most recent wdir and */ 596 /* back pointer of the bottom stack node which contains the least recent wdir */ 597 last_node_ptr = temp_ptr -> stack_linked_list.back_ptr; 598 first_node_ptr -> stack_linked_list.back_ptr = last_node_ptr; 599 end; 600 end; 601 else do; /* clear out several prior wdirs at NON consective stack locations */ 602 if array_index = 1 then do; /* prepare to clear a prior wdir FOR THE FIRST TIME looping */ 603 /* skip the node containing the most recent wdir at stack location 1 to */ 604 /* the node at stack location (n -1) before reaching the node containing */ 605 /* the prior wdir to be deleted at stack location n */ 606 do skip_node_index = 1 to (location_array (array_index) - 1); 607 previous_pointer = temp_ptr; 608 temp_ptr = temp_ptr -> stack_linked_list.back_ptr; 609 end; 610 end; /* prepare to clear out a prior wdir FOR THE FIRST TIME looping */ 611 else do; /* prepare to clear out ANOTHER prior wdir from the stack */ 612 if previous_pointer ^= null then /* continue to walk on the linked list from the previous stop */ 613 temp_ptr = previous_pointer -> stack_linked_list.back_ptr; 614 615 /* continue to skip nodes before reaching the node to be cleared out */ 616 do skip_node_index = (location_array (array_index - 1) + 1) to (location_array (array_index) - 1); 617 previous_pointer = temp_ptr; 618 temp_ptr = temp_ptr -> stack_linked_list.back_ptr; 619 end; 620 end; /* prepare to clear out ANOTHER prior wdir from the stack */ 621 /* prepare to clear out the least recent prior wdir at the bottom linked list */ 622 if location_array (array_index) = p_total_numb_of_pushes then do; 623 first_node_ptr = previous_pointer; 624 first_node_ptr -> stack_linked_list.back_ptr = last_node_ptr; 625 end; 626 /* prepare to clear out another prior wdir at a specified stack location */ 627 else if previous_pointer ^= null then 628 previous_pointer -> stack_linked_list.back_ptr = temp_ptr -> stack_linked_list.back_ptr; 629 end; /* clear out several prior wdirs at NON-consective stack locations */ 630 /* finally, remove a prior wdir at a specified stack location from the stack */ 631 free temp_ptr -> stack_linked_list in (system_area); 632 633 temp_ptr = last_node_ptr; /* prepare to walk on the linked list again */ 634 end; /* do loop */ 635 /* update the total number of nodes left over on the linked list */ 636 p_total_numb_of_pushes = p_total_numb_of_pushes - max_array_index; 637 end; /* complete the request of removing prior wdirs from the stack */ 638 639 if p_total_numb_of_pushes = 0 then do; /* become empty after complete the request of removing prior wdir(s) from the stack */ 640 last_node_ptr = null; 641 first_node_ptr = null; 642 end; 643 644 return; /* return to change_wdir entry */ 645 646 end do_clear; 647 648 /*--------------------------------------------*/ 649 650 do_pop: proc (para_npushes, para_pathname, para_error_count); 651 652 /* pop to the wdir identified by LOCATION, where LOCATION can be a stack */ 653 /* location N or a LABEL associated with a prior wdir. The prior wdir */ 654 /* popped to becomes the NEW current wdir. Prior directories ABOVE the */ 655 /* the selected directory are REMOVED from the stack. However, */ 656 /* directories BELOW the selected prior wdir REMAIN on the stack. */ 657 658 /* parameters */ 659 dcl para_error_count fixed bin; /* input */ 660 dcl para_npushes fixed bin (35); /* in/out */ 661 dcl para_pathname char (*); /* output */ 662 663 dcl pop_index fixed bin; /* local */ 664 dcl remove_index fixed bin; 665 dcl dispose_node_ptr ptr; 666 667 668 /* begin coding */ 669 dispose_node_ptr = null; /* initialized local variables */ 670 pop_index = 0; 671 remove_index = 0; 672 673 match = "0"b; /* for double check */ 674 temp_ptr = null; 675 676 if last_node_ptr = null & para_npushes = 0 then do; /* case of an EMPTY stack */ 677 para_error_count = para_error_count + 1; 678 call com_err_ (0, whoami, "An empty stack of prior wdirs."); 679 return; 680 end; 681 682 temp_ptr = last_node_ptr; 683 684 if stack_location ^= - 1 then do; /* LOCATION is N */ 685 do pop_index = 1 to (stack_location - 1); /* remove all directories ABOVE the selected directory at stack location N */ 686 last_node_ptr = temp_ptr -> stack_linked_list.back_ptr; 687 first_node_ptr -> stack_linked_list.back_ptr = last_node_ptr; 688 689 free temp_ptr -> stack_linked_list in (system_area); 690 691 temp_ptr = last_node_ptr; 692 end; 693 694 para_npushes = para_npushes - stack_location; 695 end; 696 697 if given_label_name ^= " " then do; /* LOCATION is LABEL */ 698 do pop_index = 1 to para_npushes while (^match); /* scan the entire singely circular linked list to find a match of label name */ 699 if temp_ptr -> stack_linked_list.label_name = given_label_name then 700 match = "1"b; 701 else temp_ptr = temp_ptr -> stack_linked_list.back_ptr; 702 end; 703 704 if (pop_index > para_npushes) & (^match) then do; /* for the case of no matched label name, cwd treats as an error */ 705 para_error_count = para_error_count + 1; 706 call com_err_ (0, whoami, "No match ^a. Directory not popped.", given_label_name); 707 return; 708 end; 709 710 pop_index = pop_index - 1; /* correct the pop_index value after left the above do loop. */ 711 712 do remove_index = 1 to (pop_index - 1); /* remove all directories ABOVE the matched labelled directory. */ 713 dispose_node_ptr = last_node_ptr; 714 last_node_ptr = dispose_node_ptr -> stack_linked_list.back_ptr; 715 first_node_ptr -> stack_linked_list.back_ptr = last_node_ptr; 716 717 free dispose_node_ptr -> stack_linked_list in (system_area); 718 end; 719 720 para_npushes = para_npushes - pop_index; 721 end; 722 723 /* get the selected prior wdir and its associated label name */ 724 para_pathname = temp_ptr -> stack_linked_list.wdir_name; 725 label_name_of_current_wdir = temp_ptr -> stack_linked_list.label_name; 726 727 /* finally, remove this selected directory from the stack of prior wdirs. */ 728 if para_npushes = 0 then do; 729 last_node_ptr = null; 730 first_node_ptr = null; 731 end; 732 else do; 733 first_node_ptr -> stack_linked_list.back_ptr = temp_ptr -> stack_linked_list.back_ptr; 734 last_node_ptr = temp_ptr -> stack_linked_list.back_ptr; 735 end; 736 737 free temp_ptr -> stack_linked_list in (system_area); 738 739 return; /* return to change_wdir entry */ 740 741 end do_pop; 742 743 /*-------------------------------------------*/ 744 745 do_push: proc (parameter_npushes); 746 747 /* push the current wdir into a stack of prior wdirs. If LABEL is */ 748 /* specified, it is attached to the current wdir. Note that the stack is */ 749 /* a singely circular linked list. No finite limit to the total number */ 750 /* of wdirs to be pushed on the stack. The only limit will be the amount */ 751 /* of available spae in the system free area. */ 752 753 dcl parameter_npushes fixed bin (35); 754 755 /* begin coding */ 756 /* create a new node in system_area and set temp_ptr points to it */ 757 allocate stack_linked_list in (system_area) set (temp_ptr); 758 759 if last_node_ptr = null then do; /* empty singlely linked CIRCULAR list */ 760 /* statics pointers point to the newly created node since it is */ 761 /* only node in the list */ 762 first_node_ptr = temp_ptr; 763 last_node_ptr = temp_ptr; 764 /* back pointer of the newly created node points to itself because of circular */ 765 temp_ptr -> stack_linked_list.back_ptr = temp_ptr; 766 end; 767 else do; /* at least one node in the singely circular linked list */ 768 temp_ptr -> stack_linked_list.back_ptr = last_node_ptr; 769 first_node_ptr -> stack_linked_list.back_ptr = temp_ptr; 770 last_node_ptr = temp_ptr; 771 end; 772 773 /* fill in the current wdir and the value of label_name_of_current_wdir */ 774 /* example: ! print_wdir all 775* LOC LABEL PATHNAME 776* 777* 0 x >udd>m>TLNguyen>cwd_dev 778* 1 >udd>m>TLNguyen>canon_dev 779* 2 y >udd>m>TLNguyen>meetings 780* 781* ! cwd subcwd_dev -push 782* 783* temp_ptr 784* | 785* _______________|___________________________ 786* | | | | 787* <--- | x | >udd>m>TLNguyen>cwd_dev>subcwd_dev| 788* |_|___|___________________________________| 789**/ 790 791 temp_ptr -> stack_linked_list.wdir_name = rtrim (current_wdir); 792 temp_ptr -> stack_linked_list.label_name = label_name_of_current_wdir; 793 794 795 /* this is time to RE-label the label name of the current wdir */ 796 if given_label_name ^= "" then /* wanted to label the current wdir */ 797 temp_ptr -> stack_linked_list.label_name = rtrim (given_label_name); 798 799 label_name_of_current_wdir = ""; /* must reinitialize this static variable after pushed the current wdir */ 800 /* and either its existing associated label or the newly given label onto the stack */ 801 802 parameter_npushes = parameter_npushes + 1; /* update the total number of nodes currently in the linked list */ 803 804 return; /* return to change_wdir entry */ 805 806 end do_push; 807 808 /*---------------------------------------------*/ 809 810 do_rotate: proc (p_pathname, p_error_count); 811 812 /* move to the prior wdir indentified by LOCATION, where LOCATION can be */ 813 /* either stack location N or a LABEL. Rotation occurs by placing the */ 814 /* current wdir at the BOTTOM of the stack and set the NEW current wdir */ 815 /* from the top stack identified by a given LOCATION. For a specified N, */ 816 /* rotate Nth times, the wdir at the Nth location becomes the NEW current */ 817 /* wdir. For a specified LABEL, rotate until a matched label name is */ 818 /* is found, the wdir associated with a matched LABEL becomes the NEW */ 819 /* current wdir. */ 820 /* output parameters */ 821 dcl p_error_count fixed bin; 822 dcl p_pathname char (*); /* prior wdir at a specified LOCCATION */ 823 /* local */ 824 dcl rotate_index fixed bin; 825 dcl travel_ptr ptr; 826 dcl prev_travel_ptr ptr; 827 828 /* begin coding */ 829 rotate_index = 0; 830 travel_ptr = null; 831 prev_travel_ptr = null; 832 833 match = "0"b; /* for double check */ 834 835 if last_node_ptr = null & total_number_of_pushes = 0 then do; /* an empty stack */ 836 p_error_count = p_error_count + 1; 837 call com_err_ (0, whoami, "Empty stack."); 838 return; 839 end; 840 /* APPEND the current wdir to the stack. Labels it if requested. */ 841 allocate stack_linked_list in (system_area) set (temp_ptr); 842 843 temp_ptr -> stack_linked_list.wdir_name = current_wdir; 844 temp_ptr -> stack_linked_list.label_name = label_name_of_current_wdir; 845 846 if labels_the_current_wdir ^= "" then /* either -rotate N LABEL or -rotate LABEL LABEL; The second LABEL */ 847 temp_ptr -> stack_linked_list.label_name = rtrim (labels_the_current_wdir); 848 849 /* prepare for moving to a prior wdir at a specified LOCATION */ 850 travel_ptr = last_node_ptr; 851 852 if stack_location ^= - 1 then do; /* LOCATION is a stack location N */ 853 if stack_location = 1 then 854 call move_to_top_stack_dir (travel_ptr, temp_ptr, p_pathname); 855 else do; 856 do rotate_index = 1 to (stack_location - 1); 857 prev_travel_ptr = travel_ptr; 858 travel_ptr = travel_ptr -> stack_linked_list.back_ptr; 859 end; 860 861 call move_to_a_specified_dir (travel_ptr, prev_travel_ptr, temp_ptr, p_pathname); 862 end; 863 end; 864 865 if given_label_name ^= " " then do; /* -rotate LABEL */ 866 if travel_ptr -> stack_linked_list.label_name = rtrim (given_label_name) then 867 call move_to_top_stack_dir (travel_ptr, temp_ptr, p_pathname); 868 else do; 869 do rotate_index = 2 to total_number_of_pushes while (^match); 870 prev_travel_ptr = travel_ptr; 871 travel_ptr = travel_ptr -> stack_linked_list.back_ptr; 872 873 if travel_ptr -> stack_linked_list.label_name = rtrim (given_label_name) then 874 match = "1"b; 875 end; 876 877 if (rotate_index > total_number_of_pushes) & (^match) then do; 878 p_error_count = p_error_count + 1; 879 880 free temp_ptr -> stack_linked_list in (system_area); 881 882 call com_err_ (0, whoami, "No matched ^a. Directory not rotated.", given_label_name); 883 return; 884 end; 885 886 call move_to_a_specified_dir (travel_ptr, prev_travel_ptr, temp_ptr, p_pathname); 887 end; 888 end; 889 890 return; /* return to change_wdir entry */ 891 892 end do_rotate; 893 894 /*-----------------------------------------------*/ 895 896 initialization: proc (); 897 898 max_array_index = 0; 899 location_array (*) = - 1; 900 current_wdir = ""; 901 labels_the_current_wdir = ""; 902 label_current_wdir_for_rotation = "0"b; 903 clear_entire_stack_flag = "0"b; 904 clear_wdir_flag = "0"b; 905 code = 0; 906 given_label_name = ""; 907 error_count = 0; 908 match = "0"b; 909 rotate_wdir_flag = "0"b; 910 pathname = ""; 911 pathname_count = 0; 912 pop_wdir_flag = "0"b; 913 push_wdir_flag = "0"b; 914 stack_location = - 1; 915 temp_ptr = null; 916 917 return; /* return to change_wdir entry */ 918 919 end initialization; 920 921 /*-------------------------------------------------*/ 922 923 /* main program of change_wdir entry */ 924 925 whoami = "change_wdir"; /* my name is change_wdir */ 926 927 call initialization; /* initialize automatic variables */ 928 929 if area_ptr = null then /* get system free area */ 930 area_ptr = get_system_free_area_ (); 931 932 call cu_$arg_count (nargs, code); /* get the total number of input arguments specified on the command line. */ 933 if code ^= 0 then do; 934 call com_err_ (code, whoami); 935 return; 936 end; 937 938 if nargs = 0 then do; 939 label_name_of_current_wdir = ""; /* must re-initialized */ 940 pathname = get_default_wdir_ (); /* set pathname to default wdir */ 941 end; 942 else do; 943 do arg_index = 1 to nargs; /* validate input arguments */ 944 call cu_$arg_ptr (arg_index, ap, al, code); 945 if code ^= 0 then do; 946 call com_err_ (code, whoami); 947 return; 948 end; 949 950 if index (arg, "-") = 1 then do; 951 if arg = "-clear" | arg = "-cl" then do; 952 clear_wdir_flag = "1"b; 953 954 if arg_index = nargs then /* clear out the entire stack */ 955 clear_entire_stack_flag = "1"b; 956 else do; /* LOCATION specifier for -clear */ 957 do arg_index = (arg_index + 1) to nargs while (code = 0); 958 call cu_$arg_ptr (arg_index, ap, al, code); 959 if code ^= 0 then do; 960 call com_err_ (code, whoami); 961 return; 962 end; 963 964 if arg = "0" then do; 965 call com_err_ (0, whoami, "^a is not in the stack of prior wdirs.", arg); 966 return; 967 end; 968 969 call LOCATION_validation (arg, stack_location, given_label_name, label_current_wdir_for_rotation, 970 labels_the_current_wdir, clear_wdir_flag, push_wdir_flag); 971 if code ^= 0 then do; 972 if arg = "-pop" | arg = "-push" | arg = "-rotate" then 973 call com_err_ (0, whoami, "-clear is mutually exclusive with ^a.", arg); 974 else call com_err_ (code, whoami, "^a", arg); 975 return; 976 end; 977 end; 978 end; 979 end; 980 981 else if arg = "-pop" then do; 982 pop_wdir_flag = "1"b; 983 984 if arg_index = nargs then 985 stack_location = 1; /* by default */ 986 else do; 987 arg_index = arg_index + 1; 988 call cu_$arg_ptr (arg_index, ap, al, code); 989 if code ^= 0 then do; 990 call com_err_ (code, whoami); 991 return; 992 end; 993 994 if arg = "0" then do; 995 call com_err_ (0, whoami, "^a is not in the stack of prior wdirs.", arg); 996 return; 997 end; 998 999 call LOCATION_validation (arg, stack_location, given_label_name, label_current_wdir_for_rotation, 1000 labels_the_current_wdir, clear_wdir_flag, push_wdir_flag); 1001 if code ^= 0 then do; 1002 if arg = "-clear" | arg = "-push" | arg = "-rotate" then 1003 call com_err_ (0, whoami, "-pop is mutually exclusive with ^a.", arg); 1004 else do; 1005 call com_err_ (code, whoami, "^a", arg); 1006 if error_count ^= 0 then 1007 call ioa_ ("A label cannot be a reserved word (all, a, first, f, last, l)."); 1008 1009 return; 1010 end; 1011 end; 1012 end; 1013 end; 1014 1015 else if arg = "-push" then do; 1016 push_wdir_flag = "1"b; 1017 1018 if arg_index = nargs then; /* -push */ 1019 else do; /* -push LABEL */ 1020 arg_index = arg_index + 1; 1021 call cu_$arg_ptr (arg_index, ap, al, code); 1022 if code ^= 0 then do; 1023 call com_err_ (code, whoami); 1024 return; 1025 end; 1026 1027 call LOCATION_validation (arg, stack_location, given_label_name, label_current_wdir_for_rotation, 1028 labels_the_current_wdir, clear_wdir_flag, push_wdir_flag); 1029 if code ^= 0 then do; 1030 if arg = "-clear" | arg = "-pop" | arg = "-rotate" then 1031 call com_err_ (0, whoami, "-push is mutually exclusive with ^a", arg); 1032 else do; 1033 call com_err_ (code, whoami, "^a", arg); 1034 if error_count ^= 0 then 1035 call ioa_ ("A label cannot be a reserved word (all, a, first, f, last, l)."); 1036 1037 return; 1038 end; 1039 end; 1040 end; 1041 end; 1042 1043 else if arg = "-rotate" then do; 1044 rotate_wdir_flag = "1"b; 1045 1046 if arg_index = nargs then 1047 stack_location = 1; /* by default */ 1048 else do; /* LOCATION is specified for -rotate */ 1049 arg_index = arg_index + 1; 1050 call cu_$arg_ptr (arg_index, ap, al, code); 1051 if code ^= 0 then do; 1052 call com_err_ (code, whoami); 1053 return; 1054 end; 1055 1056 call LOCATION_validation (arg, stack_location, given_label_name, label_current_wdir_for_rotation, 1057 labels_the_current_wdir, clear_wdir_flag, push_wdir_flag); 1058 if code ^= 0 then do; 1059 if arg = "-clear" | arg = "-pop" | arg = "-push" then 1060 call com_err_ (0, whoami, "-rotate is mutually exclusive with ^a.", arg); 1061 else do; 1062 call com_err_ (code, whoami, "^a", arg); 1063 if error_count ^= 0 then 1064 call ioa_ ("A label cannot be a reserved word (all, a, first, f, last, l)."); 1065 1066 return; 1067 end; 1068 end; 1069 1070 if (arg_index + 1) <= nargs then do; 1071 /* want to label the current wdir (e.g. cwd -rotate 2 label_the_current_wdir) */ 1072 label_current_wdir_for_rotation = "1"b; 1073 1074 arg_index = arg_index + 1; 1075 call cu_$arg_ptr (arg_index, ap, al, code); 1076 if code ^= 0 then do; 1077 call com_err_ (code, whoami); 1078 return; 1079 end; 1080 1081 call LOCATION_validation (arg, stack_location, given_label_name, label_current_wdir_for_rotation, 1082 labels_the_current_wdir, clear_wdir_flag, push_wdir_flag); 1083 if code ^= 0 then do; 1084 call com_err_ (code, whoami, "^a", arg); 1085 if error_count ^= 0 then 1086 call ioa_ ("A label cannot be a reserved word (all, a, first, f, last, l)."); 1087 1088 return; 1089 end; 1090 end; 1091 end; 1092 end; 1093 1094 else do; 1095 call com_err_ (error_table_$bad_arg, whoami, "^a", arg); 1096 return; 1097 end; 1098 end; 1099 else do; /* PATH is specified */ 1100 if (rotate_wdir_flag | pop_wdir_flag) then do; 1101 /* examples: cwd -rotate 2 lable_current_wdir error; cwd -pop 2 error */ 1102 call com_err_ (error_table_$bad_arg, whoami, "^a", arg); 1103 return; 1104 end; 1105 1106 pathname_count = pathname_count + 1; /* trying to protect cwd when more than one PATH is specified */ 1107 if pathname_count > 1 then do; /* for example: cwd change_wdir_directory canonicalize_directory */ 1108 call com_err_ (0, whoami, "Only one PATH is allowed. ^a ^a", rtrim (pathname), arg); 1109 return; 1110 end; 1111 1112 call expand_path_ (ap, al, addr (pathname), null, code); 1113 if code ^= 0 then do; 1114 call com_err_ (code, whoami, "^a", arg); 1115 return; 1116 end; 1117 end; 1118 end; 1119 end; /* complete validating all input arguments specified on the command level. */ 1120 1121 error_count = 0; /* for double check */ 1122 1123 if nargs > 2 then do; /* for violating syntax, display an usage message */ 1124 if pop_wdir_flag then 1125 error_count = error_count + 1; 1126 1127 if (rotate_wdir_flag | push_wdir_flag) & (nargs > 3) then 1128 error_count = error_count + 1; 1129 1130 if error_count > 0 then do; 1131 call com_err_ (0, whoami, "Usage: cwd {PATH} {-control_args}"); 1132 call ioa_ (" "); 1133 call ioa_ ("Optional control arguments:^/-clear {N;LABEL} Default: the entire stack^/-pop {N;LABEL} Default: 1^/-push {LABEL}^/-rotate {LABEL; N {LABEL}} Default: 1"); 1134 call ioa_ (" "); 1135 call ioa_ ("Note that -push, -pop, -rotate, and -clear are exclusive to each other. PATH is exclusive to -pop or -rotate"); 1136 return; 1137 end; 1138 end; 1139 /* for inconsistent combination of optional arguments, cwd treats as an error */ 1140 if (pathname ^= "") & (pop_wdir_flag | rotate_wdir_flag) then do; 1141 call com_err_ (error_table_$argerr, whoami); 1142 return; 1143 end; 1144 1145 /* do cwd */ 1146 /* The following three lines of coding is needed instead of calling the */ 1147 /* existing get_wdir internal procedure because don't want the current */ 1148 /* pathname value which contains user's specified PATH to be altered */ 1149 1150 call hcs_$fs_search_get_wdir (addr (current_wdir), current_wdir_length); 1151 if current_wdir_length = 0 then 1152 current_wdir = ""; /* to indicate there is no current wdir */ 1153 else substr (current_wdir, current_wdir_length + 1) = "";/* fill out the rest with white spaces */ 1154 1155 if current_wdir ^= "" then /* save it for displaying purpose only when it will be deleted later */ 1156 current_wdir_pathname = current_wdir; /* the current wdir is stored in a static variable */ 1157 1158 if pathname ^= "" then do; /* PATH is specified */ 1159 if push_wdir_flag then do; 1160 if current_wdir ^= "" then /* push the current wdir onto the stack */ 1161 call do_push (total_number_of_pushes); 1162 /* allow to change wdir to PATH even if could not find the current wdir */ 1163 else call ioa_ ("Warning: current wdir not pushed. It has been deleted. ^a", rtrim (current_wdir_pathname)); 1164 end; 1165 1166 if clear_wdir_flag then do; 1167 call do_clear (total_number_of_pushes, error_count); 1168 if error_count > 0 then return; 1169 end; 1170 end; 1171 else do; /* PATH is omitted */ 1172 if push_wdir_flag then do; 1173 call get_default_wdir (); /* for -push, if PATH is omitted, then sets pathname to the default wdir */ 1174 1175 if current_wdir ^= "" then /* push the current wdir onto the stack */ 1176 call do_push (total_number_of_pushes); 1177 1178 else if pathname = "" then do; /* no current wdir and no default wdir */ 1179 call com_err_ (0, whoami, "No default wdir set for this process."); 1180 return; 1181 end; 1182 /* allow to change to the default wdir even if there is no current wdir */ 1183 else call ioa_ ("Warning: current wdir not pushed. It has been deleted. ^a", rtrim (current_wdir_pathname)); 1184 end; 1185 1186 if pop_wdir_flag then /* pop the prior wdir at a specified LOCATION out the stack */ 1187 call do_pop (total_number_of_pushes, pathname, error_count); 1188 1189 if rotate_wdir_flag then do; 1190 if current_wdir ^= "" then 1191 call do_rotate (pathname, error_count); /* get the prior wdir at a specified LOCATION */ 1192 else do; 1193 call com_err_ (error_table_$no_wdir, whoami); 1194 return; 1195 end; 1196 end; 1197 1198 if clear_wdir_flag then 1199 call do_clear (total_number_of_pushes, error_count); 1200 1201 if error_count > 0 then 1202 return; 1203 end; 1204 1205 if pathname ^= "" then do; 1206 call hcs_$fs_search_set_wdir (pathname, code); /* set pathname value to be the NEW current wdir. */ 1207 if code ^= 0 then do; 1208 if push_wdir_flag then do; 1209 if current_wdir ^= "" then 1210 call com_err_ (code, whoami, "^a. Directory ^a already pushed for you.", rtrim (pathname), rtrim (current_wdir)); 1211 else call com_err_ (code, whoami, "^a. Directory not pushed.", rtrim (pathname)); 1212 end; 1213 else call com_err_ (code, whoami, "^a", rtrim (pathname)); 1214 end; 1215 end; 1216 1217 return; /* finish cwd */ 1218 1219 /*------------------------------------------------------------------------*/ 1220 1221 change_default_wdir: 1222 cdwd: entry options (variable); 1223 1224 /* Get the number of arguments by calling the cu_$arg_count entrypoint. */ 1225 /* Since this entry only allows one optional argument, if more than one */ 1226 /* argument is given, treats as an error. If no optional argument, the */ 1227 /* get_wdir internal procedure is called to get the pathname of the */ 1228 /* current working directory. Othewise it calls the expand_path_ to get */ 1229 /* the address of the pathname of the PATH specified. */ 1230 /* Stores the pathname value into the default_wdir_pathname and sets */ 1231 /* the default_wdir_set flag before terminating normality. */ 1232 1233 /* begin coding */ 1234 whoami = "change_default_wdir"; 1235 1236 call cu_$arg_count (nargs, code); 1237 if code ^= 0 then do; 1238 call com_err_ (code, whoami); 1239 return; 1240 end; 1241 if nargs > 1 then do; 1242 call com_err_ (0, whoami, 1243 "More than one optional argument supplied.^/Usage: ^a {PATH}", whoami); 1244 return; 1245 end; 1246 else if nargs = 0 then do; /* get the default wdir */ 1247 call get_wdir (); 1248 if pathname = "" then do; 1249 call com_err_ (error_table_$no_wdir, whoami); 1250 return; 1251 end; 1252 end; 1253 else do; 1254 call cu_$arg_ptr (1, ap, al, code); 1255 if code ^= 0 then do; 1256 call com_err_ (code, whoami); 1257 return; 1258 end; 1259 1260 call expand_path_ (ap, al, addr (pathname), null, code); 1261 if code ^= 0 then do; 1262 call com_err_ (code, whoami, "^a", arg); 1263 return; 1264 end; 1265 end; 1266 1267 default_wdir_pathname = pathname; 1268 default_wdir_set = "1"b; 1269 1270 return; 1271 1272 /*-------------------------------------------------------------------------*/ 1273 1274 working_dir: 1275 wd: 1276 print_wdir: 1277 pwd: entry options (variable); 1278 1279 /* This entry is documented in the MTB 775 and approved in MCR7839. */ 1280 /* */ 1281 /* Its syntax either "wd {LOCATIONs} {-he; -nhe}" or "[wd {LOCATIONs}]". */ 1282 /* */ 1283 /* LOCATION can be either stack location N within a stack of prior wdirs */ 1284 /* or a text string LABEL associated with a stack entry or can be one of */ 1285 /* the following reserved words: */ 1286 /* first (f) indicates the current wdir at location 0. */ 1287 /* last (l) indicates the least recent wdir at stack location N. */ 1288 /* all (a) indicates the current wdir at location 0 and all prior */ 1289 /* wdirs begin at stack location 1 and end at location N. */ 1290 /* */ 1291 /* Note that the most recent wdir is located at stack location 1 and in */ 1292 /* the stack of prior wdirs. The current wdir is NOT in the stack. */ 1293 1294 /* automatic variables */ 1295 dcl control_string char (45) varying; 1296 dcl header_control_string char (25) varying; 1297 dcl comments char (31); 1298 dcl longest_label_length fixed bin (35); 1299 dcl no_header bit (1) aligned; 1300 dcl print_index fixed bin; 1301 dcl ret_ptr pointer; 1302 dcl ret_len fixed bin (21); 1303 dcl want_header bit (1) aligned; 1304 1305 /* based */ 1306 dcl ret_arg char (ret_len) varying based (ret_ptr); 1307 1308 /*--------------------------------------------------------*/ 1309 1310 wd_input_argument_validation: proc; 1311 1312 /* This internal procedure called by working_dir entry is self documented. */ 1313 /* Several lines of documentation are followed by primary lines of coding. */ 1314 1315 /* begin coding */ 1316 code = 0; 1317 LOCATION_before_colon = ""; 1318 LOCATION_after_colon = ""; 1319 1320 do arg_index = 1 to nargs; /* scan through all input arguments specified on the command level */ 1321 1322 call cu_$arg_ptr (arg_index, ap, al, code); /* get an input argument specified on the command level */ 1323 if code ^= 0 then do; 1324 if active_function then 1325 call active_fnc_err_ (code, whoami); 1326 else call com_err_ (code, whoami); 1327 return; 1328 end; 1329 1330 if index (arg, "-") = 1 then do; /* the first character of a specified input argument is a minus sign */ 1331 1332 if arg = "-header" | arg = "-he" then do; 1333 want_header = "1"b; 1334 1335 error_count = error_count + 1; /* prepare for the case of -he and -nhe are both specified */ 1336 end; 1337 else if arg = "-no_header" | arg = "-nhe" then do; 1338 no_header = "1"b; 1339 1340 error_count = error_count + 1; /* prepare for the case of both -he and -nhe are specified */ 1341 end; 1342 else do; /* neither -header (-he) nor -no_header (-nhe) specified, wd reports an error */ 1343 code = error_table_$badopt; 1344 RETURN: 1345 if active_function then 1346 call active_fnc_err_ (code, whoami, "^a", arg); 1347 else call com_err_ (code, whoami, "^a", arg); 1348 return; 1349 end; 1350 end; /* the first character of a specified input argument is a minus sign */ 1351 1352 else do; /* the specified input argument is a LOCATION */ 1353 if index (arg, ":") > 0 then do; 1354 /* LOCATION is a stack range identified by a given colon in it */ 1355 LOCATION_before_colon = before (arg, ":"); 1356 LOCATION_after_colon = after (arg, ":"); 1357 1358 if LOCATION_before_colon = "" | LOCATION_after_colon = "" then do; 1359 code = error_table_$bad_arg; 1360 goto RETURN; 1361 end; 1362 end; 1363 1364 if arg = "first" | arg = "f" then do; /* LOCATION is a reserved word named first (f) */ 1365 stack_location = 0; 1366 call save_a_valid_LOCATION (max_array_index, stack_location); 1367 end; 1368 1369 else if arg = "last" | arg = "l" then do; /* LOCATION is a reerved word named last (l) */ 1370 if total_number_of_pushes > 0 then do; 1371 stack_location = total_number_of_pushes; 1372 call save_a_valid_LOCATION (max_array_index, stack_location); 1373 end; 1374 else do; 1375 if active_function then 1376 call active_fnc_err_ (0, whoami, "Empty stack of prior wdir."); 1377 else call com_err_ (0, whoami, "Empty stack of prior wdir."); 1378 return; 1379 end; 1380 end; 1381 1382 else if arg = "all" | arg = "a" then do; /* LOCATION is a reserved word named last (l) */ 1383 stack_location = 0; 1384 call save_a_valid_LOCATION (max_array_index, stack_location); 1385 1386 if total_number_of_pushes > 0 then do; 1387 stack_location = total_number_of_pushes; 1388 call CONTINUE_save_good_data (max_array_index, stack_location, code); 1389 end; 1390 else; /* do not treat as an error. Let print or return the current wdir */ 1391 end; 1392 1393 else if verify (substr (arg, 1, 1), ALLOWED_DIGITS) = 0 then do; 1394 /* the first character of LOCATION is specified as a decimal digit */ 1395 1396 if index (arg, ":") = 0 then do; 1397 /* it is considered as a stack position N */ 1398 stack_location = cv_dec_check_ (arg, code); 1399 if code ^= 0 then 1400 goto RETURN; 1401 1402 if stack_location > total_number_of_pushes then do; 1403 code = error_table_$bad_arg; 1404 goto RETURN; 1405 end; 1406 1407 stack_location = abs (stack_location); 1408 call save_a_valid_LOCATION (max_array_index, stack_location); 1409 end; 1410 else do; /* it is a mix range of N and one of the following: N, LABEL, or a reserved word */ 1411 stack_location = cv_dec_check_ ((LOCATION_before_colon), code); 1412 if code ^= 0 then 1413 goto RETURN; 1414 /* save the first part of a range which is a stack position N into an array */ 1415 if stack_location > total_number_of_pushes then do; 1416 code = error_table_$bad_arg; 1417 goto RETURN; 1418 end; 1419 1420 stack_location = abs (stack_location); 1421 call save_a_valid_LOCATION (max_array_index, stack_location); 1422 /* continue to validate the second part of the range */ 1423 call LOCATION_continue_validation ((LOCATION_after_colon), max_array_index, stack_location, code); 1424 end; 1425 end; /* the first character of LOCATION is a decimal digit */ 1426 1427 else do; /* LOCATION is specified a text string */ 1428 if index (arg, ":") = 0 then 1429 call LABEL_validation (arg, max_array_index, stack_location, code); 1430 else do; /* the text string specified is a stack range */ 1431 if LOCATION_before_colon = "first" | LOCATION_before_colon = "f" then do; 1432 stack_location = 0; 1433 call save_a_valid_LOCATION (max_array_index, stack_location); 1434 end; 1435 1436 else if LOCATION_before_colon = "last" | LOCATION_before_colon = "l" then do; 1437 code = error_table_$bad_arg; 1438 goto RETURN; 1439 end; 1440 1441 else if LOCATION_before_colon = "all" | LOCATION_before_colon = "a" then do; 1442 code = error_table_$bad_arg; 1443 goto RETURN; 1444 end; 1445 1446 else do; 1447 call LABEL_validation ((LOCATION_before_colon), max_array_index, stack_location, code); 1448 if code ^= 0 then goto RETURN; 1449 end; 1450 1451 call LOCATION_continue_validation ((LOCATION_after_colon), max_array_index, stack_location, code); 1452 if code ^= 0 then do; 1453 if (LOCATION_after_colon = "last" | LOCATION_after_colon = "l") & total_number_of_pushes = 0 then 1454 code = 0; /* let pwd print the first portion of the range (e.g. pwd f:l) */ 1455 end; 1456 end; /* the text string specified is a range */ 1457 end; /* LOCATION is specified as a text string */ 1458 1459 if code ^= 0 then goto RETURN; /* an error found during parsing a specified LOCATION */ 1460 end; /* the specified input argument is a LOCATION */ 1461 end; /* validate each input argument given on the command level */ 1462 1463 return; /* return to working_dir entry */ 1464 1465 end wd_input_argument_validation; 1466 1467 /*---------------------------------------------*/ 1468 1469 /* main program of working_dir */ 1470 temp_ptr = null; 1471 max_array_index = 0; 1472 stack_location = - 1; 1473 location_array (*) = - 1; 1474 longest_label_length = 0; 1475 want_header = "0"b; 1476 no_header = "0"b; 1477 error_count = 0; 1478 1479 call get_wdir (); /* sets pathname to current working dir */ 1480 1481 whoami = "working_dir"; /* my primary name is working_dir */ 1482 1483 call cu_$af_return_arg (nargs, ret_ptr, ret_len, code); 1484 if code ^= 0 then do; 1485 if code = error_table_$not_act_fnc then /* i was specified as a command */ 1486 active_function = "0"b; 1487 else do; 1488 call active_fnc_err_ (code, whoami); 1489 return; 1490 end; 1491 end; 1492 else do; /* i was specified as an active function */ 1493 active_function = "1"b; 1494 ret_arg = ""; 1495 end; 1496 1497 if nargs = 0 then do; /* users interest on the current wdir only */ 1498 if pathname = " " then do; /* the current wdir has been deleted */ 1499 code = error_table_$no_wdir; 1500 if active_function then 1501 call active_fnc_err_ (code, whoami); 1502 else call com_err_ (code, whoami); 1503 return; 1504 end; 1505 1506 if active_function then /* return the current wdir */ 1507 ret_arg = requote_string_ (rtrim(pathname)); 1508 else call ioa_ ("^a", rtrim (pathname)); /* print out the current wdir */ 1509 end; 1510 1511 1512 call wd_input_argument_validation; /* validate each input argument given on the command level */ 1513 if code ^= 0 then return; 1514 1515 if error_count > 1 then do; 1516 call com_err_ (0, whoami, "Both -header (-he) and -no_header (-nhe) are specified."); 1517 return; 1518 end; 1519 else error_count = 0; 1520 1521 if (want_header | no_header) & active_function then do; 1522 call active_fnc_err_ (0, whoami, "Usage: [wd {LOCATIONs}]"); 1523 return; 1524 end; 1525 1526 1527 /* case only a valid control argument is specified on the command level */ 1528 if nargs = 1 then do; 1529 if arg = "-header" | arg = "-he" | arg = "-no_header" | arg = "-nhe" then do; 1530 if pathname = " " then do; 1531 call com_err_ (error_table_$no_wdir, whoami); 1532 return; 1533 end; 1534 1535 if arg = "-header" | arg = "-he" then do; 1536 call ioa_ ("LOC LABEL PATHNAME"); 1537 call ioa_ (" "); 1538 end; 1539 1540 call ioa_ ("^10x^a", rtrim (pathname)); 1541 end; 1542 end; 1543 1544 1545 /* for indentation, find the longest length of label name, given LOCATIONS */ 1546 do array_index = 1 to max_array_index; /* loop through the entire array which contains one or more LOCATIONs to be printed */ 1547 1548 if location_array (array_index) = 0 then do; /* indicate the current wdir */ 1549 if length (label_name_of_current_wdir) > longest_label_length then 1550 longest_label_length = length (label_name_of_current_wdir); 1551 end; 1552 1553 temp_ptr = last_node_ptr; 1554 /* scan the linked list of prior wdirs from index 1 to a specified LOCATION */ 1555 do print_index = 1 to location_array (array_index); 1556 1557 /* have i reached a specified LOCATION yet? */ 1558 if print_index = location_array (array_index) then do; 1559 /* is the label length at that specified LOCATION longest length? */ 1560 if length (temp_ptr -> stack_linked_list.label_name) > longest_label_length then 1561 longest_label_length = length (temp_ptr -> stack_linked_list.label_name); 1562 end; 1563 else temp_ptr = temp_ptr -> stack_linked_list.back_ptr; 1564 end; 1565 end; 1566 1567 /* then build control string for ioa_ calls later. Indentation purpose only */ 1568 if want_header | ^no_header then do; /* either users want header when only a single LOCATION is printed or */ 1569 /* pwd only prints a header when more than one LOCATIONs are printed (by default) */ 1570 if longest_label_length < 5 then 1571 longest_label_length = 5; /* 5 indicates the total number of characters of "LABEL" */ 1572 end; 1573 /* for stack entry, adjust the distance between associated label and a wdir */ 1574 control_string = "^4d ^" || ltrim (char (longest_label_length)); 1575 control_string = control_string || "a ^a"; 1576 /* for the header, adjust the distance between "LABEL" and "PATHNAME" */ 1577 header_control_string = " LOC LABEL^" || ltrim (char (longest_label_length - 5)); 1578 header_control_string = header_control_string || "x PATHNAME"; 1579 1580 if pathname ^= "" then 1581 current_wdir_pathname = pathname; /* save the current wdir for printting only if it is deleted and want to print it */ 1582 1583 /* print or return wdir(s) at specified LOCATION(s) */ 1584 do array_index = 1 to max_array_index; 1585 1586 temp_ptr = last_node_ptr; 1587 1588 if (array_index = 1) & (max_array_index > 1) & (^active_function) then do; 1589 /* as a command, print out the header once when more than one LOCATION is asked */ 1590 if ^no_header then do; /* by default */ 1591 call ioa_ (header_control_string); 1592 call ioa_ (" "); 1593 end; 1594 end; 1595 1596 if location_array (array_index) = 0 then do; /* is it the current wdir? */ 1597 print_index = 0; /* to indicate the current wdir */ 1598 1599 if max_array_index = 1 then do; /* case of only the current wdir is printed or returned */ 1600 if pathname = " " then do; /* the current wdir has been deleted */ 1601 if active_function then 1602 call active_fnc_err_ (error_table_$no_wdir, whoami); 1603 else call com_err_ (error_table_$no_wdir, whoami); 1604 return; 1605 end; 1606 else do; /* the current wdir still exists */ 1607 if active_function then 1608 ret_arg = rtrim (pathname); /* return the current wdir */ 1609 else do; /* print out the current wdir on the terminal */ 1610 if want_header then do; /* users also want the header to be printed */ 1611 call ioa_ (header_control_string); 1612 call ioa_ (" "); 1613 end; 1614 1615 call ioa_ (control_string, print_index, label_name_of_current_wdir, rtrim (pathname)); 1616 end; 1617 end; 1618 end; /* case of printing or returning only the current wdir */ 1619 else do; /* print or return the current wdir and AT LEAST one prior wdir */ 1620 if active_function then do; /* as an active function, needs to find out whether the current wdir exists or not */ 1621 if array_index ^= 1 then /* not the first time go into the do loop */ 1622 ret_arg = ret_arg || " "; /* prepare to return the next prior wdir pathname */ 1623 1624 if pathname ^= "" then /* the current wdir exists. Return it to an user */ 1625 ret_arg = ret_arg || rtrim (pathname); 1626 /* the current wdir has been deleted, returns it, its value was saved earlier */ 1627 else ret_arg = ret_arg || rtrim (current_wdir_pathname); 1628 end; /* as an active function */ 1629 else do; /* as a command, must find out whether the current wdir exist or not */ 1630 if pathname ^= " " then /* if the current wdir still exists, print it out */ 1631 call ioa_ (control_string, print_index, rtrim (label_name_of_current_wdir), rtrim (pathname)); 1632 else do; /* the current wdir has been deleted */ 1633 comments = "[current wdir has been deleted]"; 1634 1635 call ioa_ (control_string, print_index, rtrim (label_name_of_current_wdir), 1636 rtrim (current_wdir_pathname) || " " || comments); 1637 end; /* the current wdir has been deleted */ 1638 end; /* as a command, must find out whether the current wdir exists or not */ 1639 end; /* case of the current wdir and AT LEAST ONE MORE stack entry are printed or returned */ 1640 end; /* finish to print or return the current wdir */ 1641 1642 /* scan the linked list of prior wdirs from index 1 to a specified LOCATION */ 1643 do print_index = 1 to location_array (array_index); 1644 1645 if (print_index = 1) & (max_array_index = 1) & (^active_function) then do; 1646 if want_header then do; /* users want to print the header when only one LOCATION is printed out */ 1647 call ioa_ (header_control_string); 1648 call ioa_ (" "); 1649 end; 1650 end; 1651 1652 if print_index = location_array (array_index) then do; 1653 1654 if active_function then do; /* return a prior wdir at a specified LOCATION */ 1655 if print_index ^= 1 | ret_arg ^= " " then 1656 ret_arg = ret_arg || " "; /* for returning several stack entries, separated by a white space */ 1657 ret_arg = ret_arg || temp_ptr -> stack_linked_list.wdir_name; 1658 end; 1659 /* print out a prior wdir at a specified LOCATION */ 1660 else call ioa_ (control_string, print_index, temp_ptr -> stack_linked_list.label_name, temp_ptr -> stack_linked_list.wdir_name); 1661 end; 1662 /* have not reached a specified LOCATION yet */ 1663 else temp_ptr = temp_ptr -> stack_linked_list.back_ptr; 1664 end; /* complete printed or returned a single wdir at a specified LOCATION */ 1665 end; /* complete printed or returned wdir(s) at specified LOCATION(s) */ 1666 1667 return; /* complete working_dir */ 1668 1669 /*---------------------------------------------------------------------------*/ 1670 1671 print_default_wdir: 1672 pdwd: entry options (variable); 1673 1674 /* begin coding */ 1675 whoami = "print_default_wdir"; 1676 1677 call cu_$arg_count (nargs, code); 1678 if code ^= 0 then do; 1679 call com_err_ (code, whoami); 1680 return; 1681 end; 1682 1683 if nargs > 0 then do; /* no arguments allowed at all ... */ 1684 call com_err_ (0, whoami, "This command takes no arguments.^/Usage:^_^a", whoami); 1685 return; 1686 end; 1687 1688 call get_default_wdir (); /* get the default wdir */ 1689 1690 if pathname = "" then /* no default wdir */ 1691 call com_err_ (error_table_$no_wdir, whoami); 1692 else call ioa_ ("^a", rtrim (pathname)); /* prints it out */ 1693 1694 return; /* all done with print_default_wdir */ 1695 1696 /*-------------------------------------------------------------------------- */ 1697 1698 get_wdir_: entry () returns (char (168)); 1699 1700 call get_wdir (); /* sets pathname */ 1701 1702 if pathname = "" then do; /* no wdir, warn the user */ 1703 call sub_err_ (error_table_$no_wdir, "get_wdir_", "h", null (), (0), ""); 1704 return (""); /* return nothing */ 1705 end; 1706 1707 return (pathname); /* all done with get_wdir_ */ 1708 1709 /*---------------------------------------------------------------------------*/ 1710 1711 get_default_wdir_: entry () returns (char (168)); 1712 1713 /* begin coding */ 1714 call get_default_wdir (); /* sets pathname to the default wdir */ 1715 1716 return (pathname); /* all done with get_default_wdir_ */ 1717 1718 /*--------------------------------------------------------------------------*/ 1719 1720 change_wdir_: entry (P_pathname, P_code); 1721 1722 dcl (P_pathname char (168), 1723 P_code fixed bin (35)) parameter; 1724 1725 call hcs_$fs_search_set_wdir (P_pathname, P_code); /* set it, and just return the code */ 1726 1727 return; /* all done with change_wdir_ */ 1728 1729 /*---------------------------------------------------------------------------*/ 1730 1731 change_default_wdir_: entry (P_pathname, P_code); 1732 1733 default_wdir_pathname = P_pathname; 1734 default_wdir_set = "1"b; 1735 1736 P_code = 0; 1737 1738 return; /* all done with change_default_wdir_ */ 1739 1740 /*--------------------------------------------------------------------------*/ 1741 1742 get_wdir: proc (); 1743 1744 /* sets pathname to the current wdir pathname. If there is no current wdir */ 1745 /* pathname is set to a null string. */ 1746 1747 call hcs_$fs_search_get_wdir (addr (pathname), current_wdir_length); 1748 1749 if current_wdir_length = 0 then 1750 pathname = ""; /* set it to the null string to indicate no wdir */ 1751 1752 else substr (pathname, current_wdir_length + 1) = ""; /* otherwise, fill the rest with spaces */ 1753 1754 return; 1755 1756 end get_wdir; 1757 1758 /*-------------------------------------------------------------------------*/ 1759 1760 get_default_wdir: proc (); 1761 1762 if ^default_wdir_set then do; /* first call, sets the default wdir to home_dir */ 1763 call user_info_$homedir (default_wdir_pathname); 1764 1765 default_wdir_set = "1"b; /* indicate this has been done */ 1766 end; 1767 1768 pathname = default_wdir_pathname; /* sets pathname */ 1769 1770 return; 1771 1772 end get_default_wdir; 1773 /*-------------------------------------------------------------------------*/ 1774 1775 CONTINUE_save_good_data: proc (p_max_array_index, p_stack_pos, p_ec); 1776 1777 /* Several consective stack locations are saved in an array. */ 1778 /* Note that a specified LOCATION was identified as a range of either a */ 1779 /* stack location range (e.g. 3:7), a label range (e.g. x:y), or a mixed */ 1780 /* range (e.g. x:5; 3:z; first:z; first:3, ect.). This range of a certain */ 1781 /* kind will be stored in an array as numeric digits. */ 1782 1783 /* parameter */ 1784 dcl p_max_array_index fixed bin; 1785 dcl p_ec fixed bin (35); 1786 dcl p_stack_pos fixed bin (35); 1787 /* local */ 1788 dcl next_stack_position fixed bin (35); 1789 dcl next_stack_pos fixed bin (35); 1790 1791 /* begin coding */ 1792 if p_stack_pos <= location_array (p_max_array_index) then do; 1793 p_ec = error_table_$bad_arg; /* for examples: 10:10 10:4 */ 1794 return; 1795 end; 1796 else do; 1797 next_stack_pos = location_array (p_max_array_index) + 1; 1798 1799 do next_stack_position = next_stack_pos to p_stack_pos; 1800 p_max_array_index = p_max_array_index + 1; 1801 location_array (p_max_array_index) = next_stack_position; 1802 end; 1803 end; 1804 1805 return; 1806 1807 end CONTINUE_save_good_data; 1808 1809 /*---------------------------------------------------------------------------*/ 1810 1811 LOCATION_continue_validation: proc (p_LOCATION_after_colon, p_max_arr_indx, p_stack_loctn, p_ecode); 1812 1813 /* continue to validate the remaining character string after a colon */ 1814 /* character was found. (e.g. 3:7, 5:label_x, first:y, z:w, ect) when */ 1815 /* LOCATION was specified as a range which known by a colon character. */ 1816 1817 /* parameters */ 1818 dcl p_LOCATION_after_colon char (*); 1819 dcl p_ecode fixed bin (35); 1820 dcl p_max_arr_indx fixed bin; 1821 dcl p_stack_loctn fixed bin (35); 1822 /* local */ 1823 dcl found bit (1) aligned; 1824 dcl search_index fixed bin (35); 1825 dcl search_ptr ptr; 1826 dcl skip_index fixed bin (35); 1827 1828 /* begin coding */ 1829 found = "0"b; 1830 skip_index = 0; 1831 search_index = 0; 1832 search_ptr = null; 1833 1834 if verify (substr (p_LOCATION_after_colon, 1, 1), ALLOWED_DIGITS) = 0 then do; 1835 /* LOCATION is a range of stack positions (e.g. 10:16) */ 1836 p_stack_loctn = cv_dec_check_ (p_LOCATION_after_colon, p_ecode); 1837 if p_ecode ^= 0 then return; 1838 1839 if p_stack_loctn > total_number_of_pushes then do; 1840 p_ecode = error_table_$bad_arg; 1841 return; 1842 end; 1843 1844 p_stack_loctn = abs (p_stack_loctn); 1845 /* save them */ 1846 call CONTINUE_save_good_data (p_max_arr_indx, p_stack_loctn, p_ecode); 1847 end; 1848 1849 else if p_LOCATION_after_colon = "first" | p_LOCATION_after_colon = "f" then 1850 p_ecode = error_table_$bad_arg; /* e.g. 10:first */ 1851 1852 else if p_LOCATION_after_colon = "all" | p_LOCATION_after_colon = "a" then 1853 p_ecode = error_table_$bad_arg; 1854 1855 else if p_LOCATION_after_colon = "last" | p_LOCATION_after_colon = "l" then do; 1856 p_stack_loctn = total_number_of_pushes; /* e.g. 10:last */ 1857 1858 call CONTINUE_save_good_data (p_max_arr_indx, p_stack_loctn, p_ecode); 1859 end; 1860 1861 else do; 1862 if index (p_LOCATION_after_colon, "-") = 1 then do; 1863 p_ecode = error_table_$badopt; 1864 return; 1865 end; 1866 1867 if index (p_LOCATION_after_colon, ":") > 0 then do; 1868 p_ecode = error_table_$bad_arg; 1869 return; 1870 end; 1871 1872 if length (p_LOCATION_after_colon) > MAX_LENGTH_LABEL_NAME then do; 1873 p_ecode = error_table_$bigarg; 1874 return; 1875 end; 1876 /* search for a matched label name */ 1877 search_ptr = last_node_ptr; 1878 do skip_index = 1 to p_stack_loctn; 1879 search_ptr = search_ptr -> stack_linked_list.back_ptr; 1880 end; 1881 1882 do search_index = (p_stack_loctn + 1) to total_number_of_pushes while (^found); 1883 if p_LOCATION_after_colon = search_ptr -> stack_linked_list.label_name then 1884 found = "1"b; 1885 else search_ptr = search_ptr -> stack_linked_list.back_ptr; 1886 end; 1887 1888 if (search_index > total_number_of_pushes) & (^found) then do; 1889 p_ecode = error_table_$bad_arg; 1890 return; 1891 end; 1892 1893 search_index = search_index - 1; /* calculate the correct value of search_index after leaving do loop */ 1894 p_stack_loctn = abs (search_index); 1895 1896 call CONTINUE_save_good_data (p_max_arr_indx, p_stack_loctn, p_ecode); 1897 end; 1898 1899 return; 1900 1901 end LOCATION_continue_validation; 1902 1903 /*---------------------------------------------------------------------------*/ 1904 1905 save_a_valid_LOCATION: proc (p_max_arr_index, p_stack_loc); 1906 1907 /* save a valid stack location into an array. */ 1908 /* parameter */ 1909 dcl p_max_arr_index fixed bin; 1910 dcl p_stack_loc fixed bin (35); 1911 1912 /* begin coding */ 1913 p_max_arr_index = p_max_arr_index + 1; 1914 location_array (p_max_arr_index) = p_stack_loc; 1915 1916 return; 1917 1918 end save_a_valid_LOCATION; 1919 1920 /*---------------------------------------------------------------------------*/ 1921 1922 LABEL_validation: proc (para_arg, para_max_array_index, para_stack_pos, para_ec); 1923 1924 /* validate that a given LABEL length is less or equal the maximum length */ 1925 /* allowed, 32 characters. Also it must be defined that means it must be */ 1926 /* attached to a prior wdir in some earlier time. */ 1927 1928 /* parameter */ 1929 dcl para_arg char (*); 1930 dcl para_ec fixed bin (35); 1931 dcl para_max_array_index fixed bin; 1932 dcl para_stack_pos fixed bin (35); 1933 /* local */ 1934 dcl match_label_name bit (1) aligned; 1935 dcl searching_index fixed bin (35); 1936 dcl searching_ptr ptr; 1937 1938 /* begin coding */ 1939 match_label_name = "0"b; 1940 searching_ptr = null; 1941 1942 if length (para_arg) > MAX_LENGTH_LABEL_NAME then do; 1943 para_ec = error_table_$bigarg; 1944 return; 1945 end; 1946 1947 searching_ptr = last_node_ptr; 1948 do searching_index = 1 to total_number_of_pushes while (^match_label_name); 1949 if searching_ptr -> stack_linked_list.label_name = para_arg then 1950 match_label_name = "1"b; 1951 else searching_ptr = searching_ptr -> stack_linked_list.back_ptr; 1952 end; 1953 1954 if searching_index > total_number_of_pushes & ^match_label_name then do; 1955 para_ec = error_table_$bad_arg; 1956 return; 1957 end; 1958 1959 searching_index = searching_index - 1; /* calculate the correct value of search_index after leaving the do loop */ 1960 para_stack_pos = abs (searching_index); 1961 1962 call save_a_valid_LOCATION (para_max_array_index, para_stack_pos); 1963 1964 return; 1965 1966 end LABEL_validation; 1967 1968 /*--------------------------------------------------------------------------*/ 1969 1970 end directory_commands_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 09/04/90 1202.2 directory_commands_.pl1 >spec>install>1032>directory_commands_.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. ALLOWED_DIGITS 000000 constant char(10) initial packed unaligned dcl 37 ref 221 1393 1834 LOCATION_after_colon 000100 automatic varying char(32) dcl 41 set ref 197* 214* 216 248 299 1318* 1356* 1358 1423 1451 1453 1453 LOCATION_before_colon 000111 automatic varying char(32) dcl 41 set ref 196* 213* 216 238 286 286 291 291 294 294 297 1317* 1355* 1358 1411 1431 1431 1436 1436 1441 1441 1447 MAX_LENGTH_LABEL_NAME constant fixed bin(17,0) initial dcl 38 ref 313 1872 1942 P_arg parameter char packed unaligned dcl 184 set ref 173 200 205 213 214 221 228* 237 251* 265 265 270 270 275 275 282 282* 304 304 305 305 306 306 313 318 320 P_clear_flag parameter bit(1) dcl 185 ref 173 206 223 264 P_code parameter fixed bin(35,0) dcl 1722 set ref 1720 1725* 1731 1736* P_label_current_wdir_for_rotation parameter bit(1) dcl 187 ref 173 318 P_label_name parameter char packed unaligned dcl 188 set ref 173 320* P_labels_the_cur_wdir parameter char packed unaligned dcl 186 set ref 173 318* P_pathname parameter char(168) packed unaligned dcl 1722 set ref 1720 1725* 1731 1733 P_push_flag parameter bit(1) dcl 189 ref 173 224 P_stack_position parameter fixed bin(35,0) dcl 190 set ref 173 228* 231 231 234* 234 238* 241 244* 244 246* 248* 251* 255 255 258* 258 259* 266* 267* 271* 272* 276* 277* 278* 279* 282* 287* 288* 297* 299* abs builtin function dcl 113 ref 234 244 258 1407 1420 1844 1894 1960 active_fnc_err_ 000156 constant entry external dcl 91 ref 1324 1344 1375 1488 1500 1522 1601 active_function 000122 automatic bit(1) dcl 42 set ref 1324 1344 1375 1485* 1493* 1500 1506 1521 1588 1601 1607 1620 1645 1654 addr builtin function dcl 113 ref 1112 1112 1150 1150 1260 1260 1747 1747 after builtin function dcl 113 ref 214 1356 al 000126 automatic fixed bin(17,0) dcl 44 set ref 944* 950 951 951 958* 964 965 965 969 969 972 972 972 972 972 974 974 981 988* 994 995 995 999 999 1002 1002 1002 1002 1002 1005 1005 1015 1021* 1027 1027 1030 1030 1030 1030 1030 1033 1033 1043 1050* 1056 1056 1059 1059 1059 1059 1059 1062 1062 1075* 1081 1081 1084 1084 1095 1095 1102 1102 1108 1108 1112* 1114 1114 1254* 1260* 1262 1262 1322* 1330 1332 1332 1337 1337 1344 1344 1347 1347 1353 1355 1356 1364 1364 1369 1369 1382 1382 1393 1396 1398 1398 1428 1428 1428 1529 1529 1529 1529 1535 1535 ap 000124 automatic pointer dcl 43 set ref 944* 950 951 951 958* 964 965 969 972 972 972 972 974 981 988* 994 995 999 1002 1002 1002 1002 1005 1015 1021* 1027 1030 1030 1030 1030 1033 1043 1050* 1056 1059 1059 1059 1059 1062 1075* 1081 1084 1095 1102 1108 1112* 1114 1254* 1260* 1262 1322* 1330 1332 1332 1337 1337 1344 1347 1353 1355 1356 1364 1364 1369 1369 1382 1382 1393 1396 1398 1428 1428 1529 1529 1529 1529 1535 1535 area_ptr 000010 internal static pointer initial dcl 70 set ref 437 473 531 573 631 689 717 737 757 841 880 929 929* arg based char packed unaligned dcl 80 set ref 950 951 951 964 965* 969* 972 972 972 972* 974* 981 994 995* 999* 1002 1002 1002 1002* 1005* 1015 1027* 1030 1030 1030 1030* 1033* 1043 1056* 1059 1059 1059 1059* 1062* 1081* 1084* 1095* 1102* 1108* 1114* 1262* 1330 1332 1332 1337 1337 1344* 1347* 1353 1355 1356 1364 1364 1369 1369 1382 1382 1393 1396 1398* 1428 1428* 1529 1529 1529 1529 1535 1535 arg_index 000127 automatic fixed bin(17,0) dcl 45 set ref 943* 944* 954 957* 957* 958* 984 987* 987 988* 1018 1020* 1020 1021* 1046 1049* 1049 1050* 1070 1074* 1074 1075* 1320* 1322* array_index 000130 automatic fixed bin(17,0) dcl 46 set ref 509* 578* 580 585 585 592 602 606 616 616 622* 1546* 1548 1555 1558* 1584* 1588 1596 1621 1643 1652* back_ptr based pointer level 2 dcl 82 set ref 426* 426 427* 430 460* 461* 463* 463 466 528 529* 548 549* 562 567* 570* 570 581 582* 588 589* 589 597 598* 608 612 618 624* 627* 627 686 687* 701 714 715* 733* 733 734 765* 768* 769* 858 871 1563 1663 1879 1885 1951 before builtin function dcl 113 ref 213 1355 char builtin function dcl 113 ref 1574 1577 clear_entire_stack_flag 000131 automatic bit(1) dcl 47 set ref 525 903* 954* clear_index 024070 automatic fixed bin(35,0) dcl 504 set ref 511* 526* clear_wdir_flag 000132 automatic bit(1) dcl 48 set ref 904* 952* 969* 999* 1027* 1056* 1081* 1166 1198 code 000133 automatic fixed bin(35,0) dcl 49 set ref 195* 201* 207* 228* 229 238* 239 248* 251* 252 279* 282* 297* 299* 314* 905* 932* 933 934* 944* 945 946* 957 958* 959 960* 971 974* 988* 989 990* 1001 1005* 1021* 1022 1023* 1029 1033* 1050* 1051 1052* 1058 1062* 1075* 1076 1077* 1083 1084* 1112* 1113 1114* 1206* 1207 1209* 1211* 1213* 1236* 1237 1238* 1254* 1255 1256* 1260* 1261 1262* 1316* 1322* 1323 1324* 1326* 1343* 1344* 1347* 1359* 1388* 1398* 1399 1403* 1411* 1412 1416* 1423* 1428* 1437* 1442* 1447* 1448 1451* 1452 1453* 1459 1483* 1484 1485 1488* 1499* 1500* 1502* 1513 1677* 1678 1679* com_err_ 000160 constant entry external dcl 92 ref 520 678 706 837 882 934 946 960 965 972 974 990 995 1002 1005 1023 1030 1033 1052 1059 1062 1077 1084 1095 1102 1108 1114 1131 1141 1179 1193 1209 1211 1213 1238 1242 1249 1256 1262 1326 1347 1377 1502 1516 1531 1603 1679 1684 1690 comments 023773 automatic char(31) packed unaligned dcl 1297 set ref 1633* 1635 control_string 023746 automatic varying char(45) dcl 1295 set ref 1574* 1575* 1575 1615* 1630* 1635* 1660* cu_$af_return_arg 000162 constant entry external dcl 93 ref 1483 cu_$arg_count 000164 constant entry external dcl 94 ref 932 1236 1677 cu_$arg_ptr 000166 constant entry external dcl 95 ref 944 958 988 1021 1050 1075 1254 1322 current_wdir 000134 automatic char(168) packed unaligned dcl 50 set ref 791 843 900* 1150 1150 1151* 1153* 1155 1155 1160 1175 1190 1209 1209 1209 current_wdir_length 000206 automatic fixed bin(17,0) dcl 51 set ref 1150* 1151 1153 1747* 1749 1752 current_wdir_pathname 000103 internal static varying char(168) initial dcl 77 set ref 1155* 1163 1163 1183 1183 1580* 1627 1635 cv_dec_check_ 000170 constant entry external dcl 96 ref 228 238 251 1398 1411 1836 default_wdir_pathname 000014 internal static char(168) initial dcl 73 set ref 1267* 1733* 1763* 1768 default_wdir_set 000013 internal static bit(1) initial dcl 72 set ref 1268* 1734* 1762 1765* dispose_node_ptr 024116 automatic pointer dcl 665 set ref 669* 713* 714 717 err_count 024030 automatic fixed bin(17,0) dcl 192 set ref 198* 304* 304 305* 305 306* 306 308 error_count 000217 automatic fixed bin(17,0) dcl 53 set ref 309* 907* 1006 1034 1063 1085 1121* 1124* 1124 1127* 1127 1130 1167* 1168 1186* 1190* 1198* 1201 1335* 1335 1340* 1340 1477* 1515 1519* error_table_$argerr 000212 external static fixed bin(35,0) dcl 106 set ref 1141* error_table_$bad_arg 000214 external static fixed bin(35,0) dcl 106 set ref 207 1095* 1102* 1359 1403 1416 1437 1442 1793 1840 1849 1852 1868 1889 1955 error_table_$badopt 000216 external static fixed bin(35,0) dcl 106 ref 201 1343 1863 error_table_$bigarg 000220 external static fixed bin(35,0) dcl 106 ref 314 1873 1943 error_table_$no_wdir 000222 external static fixed bin(35,0) dcl 106 set ref 1193* 1249* 1499 1531* 1601* 1603* 1690* 1703* error_table_$not_act_fnc 000224 external static fixed bin(35,0) dcl 106 ref 1485 expand_path_ 000172 constant entry external dcl 97 ref 1112 1260 first_node_ptr 000066 internal static pointer initial dcl 74 set ref 427 429* 461 465* 529 536* 549 553* 566* 567 582 592* 598 623* 624 641* 687 715 730* 733 762* 769 found 000100 automatic bit(1) dcl 1823 set ref 1829* 1882 1883* 1888 get_system_free_area_ 000174 constant entry external dcl 98 ref 929 given_label_name 000207 automatic char(32) packed unaligned dcl 52 set ref 697 699 706* 796 796 865 866 873 882* 906* 969* 999* 1027* 1056* 1081* hcs_$fs_search_get_wdir 000176 constant entry external dcl 99 ref 1150 1747 hcs_$fs_search_set_wdir 000200 constant entry external dcl 100 ref 1206 1725 header_control_string 023763 automatic varying char(25) dcl 1296 set ref 1577* 1578* 1578 1591* 1611* 1647* i_index 024040 automatic fixed bin(17,0) dcl 362 set ref 368* 371 373 374 399 401 403* 403 index builtin function dcl 113 ref 200 205 237 282 950 1330 1353 1396 1428 1862 1867 ioa_ 000202 constant entry external dcl 101 ref 516 1006 1034 1063 1085 1132 1133 1134 1135 1163 1183 1508 1536 1537 1540 1591 1592 1611 1612 1615 1630 1635 1647 1648 1660 1692 j_index 024041 automatic fixed bin(17,0) dcl 362 set ref 374* 376 377 377 380 383 391* 391 394* 394 k_index 024042 automatic fixed bin(17,0) dcl 362 set ref 383* 384 384* label_current_wdir_for_rotation 000220 automatic bit(1) dcl 54 set ref 902* 969* 999* 1027* 1056* 1072* 1081* label_name 2 based varying char(32) level 2 dcl 82 set ref 434 470 699 725 792* 796* 844* 846* 866 873 1560 1560 1660* 1883 1949 label_name_of_current_wdir 000072 internal static varying char(32) initial dcl 76 set ref 434* 470* 725* 792 799* 844 939* 1549 1549 1615* 1630 1630 1635 1635 labels_the_current_wdir 000221 automatic char(32) packed unaligned dcl 55 set ref 846 846 901* 969* 999* 1027* 1056* 1081* last_node_ptr 000070 internal static pointer initial dcl 75 set ref 430* 460 466* 515 527 528* 529 535* 543 548* 549 552* 567 581* 582 597* 598 624 633 640* 676 682 686* 687 691 713 714* 715 729* 734* 759 763* 768 770* 835 850 1553 1586 1877 1947 length builtin function dcl 113 ref 313 1549 1549 1560 1560 1872 1942 location_array 000231 automatic fixed bin(35,0) array dcl 56 set ref 377 377 380 380 384* 384 387* 397 399* 399 401* 547 560 565 580 585 585 592 606 616 616 622 899* 1473* 1548 1555 1558 1596 1643 1652 1792 1797 1801* 1914* longest_label_length 024003 automatic fixed bin(35,0) dcl 1298 set ref 1474* 1549 1549* 1560 1560* 1570 1570* 1574 1577 ltrim builtin function dcl 113 ref 1574 1577 match 023651 automatic bit(1) dcl 57 set ref 673* 698 699* 704 833* 869 873* 877 908* match_label_name 000100 automatic bit(1) dcl 1934 set ref 1939* 1948 1949* 1954 max_array_index 023652 automatic fixed bin(17,0) dcl 58 set ref 246* 248* 259* 267* 272* 277* 279* 282* 288* 297* 299* 371 376 383 387 389* 389 540 545 547 560 565 578 636 898* 1366* 1372* 1384* 1388* 1408* 1421* 1423* 1428* 1433* 1447* 1451* 1471* 1546 1584 1588 1599 1645 nargs 023653 automatic fixed bin(17,0) dcl 59 set ref 932* 938 943 954 957 984 1018 1046 1070 1123 1127 1236* 1241 1246 1320 1483* 1497 1528 1677* 1683 next_stack_pos 000101 automatic fixed bin(35,0) dcl 1789 set ref 1797* 1799 next_stack_position 000100 automatic fixed bin(35,0) dcl 1788 set ref 1799* 1801* no_header 024004 automatic bit(1) dcl 1299 set ref 1338* 1476* 1521 1568 1590 null builtin function dcl 113 ref 438 439 475 476 477 512 515 535 536 552 553 587 612 627 640 641 669 674 676 729 730 759 78k^*@78k>^*@78lk&SP:_ll>^alR72.ec SPD!6[$lplh>^aCwl@lp*@SlHl8l*SlPl@P*@SlXlH*Sl`lPz*SlhlX*Sl`^*@Sl8>^*@SDurand wll& P 4ll>^al37.ec Plbp̠$ll>^awll*@ lll* llP*@ ll* llz* ll* l^*@ l>^*@ lRl&$P&%sll>^alQ95.ec $P'bq$lJlB>^a _wllJ*@$l"ll*$l*lP*@$l2l"*$l:l*z*$lBl2*$l:^*@$l>^*@$ll&$P&) lZlZ>^alR 138.ec $P'!i$ll>^awwll*@$llxl*$llP*@$ll*$llz*$ll*$l^*@$lx>^*@$mlR&PS(Vll>^al111.ec PU k#$mm>^a\wlm*@lll*llP*@ll*mlz*ml*m^*@l>^*@ml&B|PCm&m&>^am287.ec B|Po .$m|mt>^awmLm|*@B|mTmDl*B|m\mLP*@B|mdmT*B|mlm\z*B|mtmd*B|ml^*@B|mD>^*@B|mm&B|Py{mm>^am)349.ec B|Pq!i9$mm>^abwmm*@B|mml*B|mmP*@B|mm*B|mmz*B|mm*B|m^*@B|m>^*@B|mPm&B|Pmm>^am114.ec B|P .@$mHm@>^a|wmmH*@B|m ml*B|m(mP*@B|m0m *B|m8m(z*B|m@m0*B|m8^*@B|m>^*@B|mm&AQmXmX>^amP424.ec AQHbqy$mm>^awm~m*@Ammvl*Amm~P*@Amm*Ammz*Amm*Am^*@Amv>^*@AnmP& Q ]mm>zam 503 QxH . $nm>zawm^*@ mm* mmz* mm* mnP*@ parameter pointer dcl 456 set ref 446 460 461 476* para_travel_ptr parameter pointer dcl 453 set ref 446 463 466 469 470 473 477* parameter_npushes parameter fixed bin(35,0) dcl 753 set ref 745 802* 802 pathname 023654 automatic char(168) packed unaligned dcl 60 set ref 516 910* 940* 1108 1108 1112 1112 1140 1158 1178 1186* 1190* 1205 1206* 1209 1209 1211 1211 1213 1213 1248 1260 1260 1267 1498 1506 1506 1508 1508 1530 1540 1540 1580 1580 1600 1607 1615 1615 1624 1624 1630 1630 1630 1690 1692 1692 1702 1707 1716 1747 1747 1749* 1752* 1768* pathname_count 023726 automatic fixed bin(17,0) dcl 61 set ref 911* 1106* 1106 1107 pop_index 024114 automatic fixed bin(17,0) dcl 663 set ref 670* 685* 698* 704 710* 710 712 720 pop_wdir_flag 023727 automatic bit(1) dcl 62 set ref 912* 982* 1100 1124 1140 1186 prev_travel_ptr 024144 automatic pointer dcl 826 set ref 831* 857* 861* 870* 886* previous_pointer 024072 automatic pointer dcl 505 set ref 512* 561* 566 570 587 588 589 592 607* 612 612 617* 623 627 627 print_index 024005 automatic fixed bin(17,0) dcl 1300 set ref 1555* 1558* 1597* 1615* 1630* 1635* 1643* 1645 1652 1655 1660* push_wdir_flag 023730 automatic bit(1) dcl 63 set ref 913* 969* 999* 1016* 1027* 1056* 1081* 1127 1159 1172 1208 remove_index 024115 automatic fixed bin(17,0) dcl 664 set ref 671* 712* requote_string_ 000204 constant entry external dcl 102 ref 1506 ret_arg based varying char dcl 1306 set ref 1494* 1506* 1607* 1621* 1621 1624* 1624 1627* 1627 1655 1655* 1655 1657* 1657 ret_len 024010 automatic fixed bin(21,0) dcl 1302 set ref 1483* 1494 1506 1607 1621 1624 1627 1655 1657 ret_ptr 024006 automatic pointer dcl 1301 set ref 1483* 1494 1506 1607 1621 1621 1624 1624 1627 1627 1655 1655 1655 1657 1657 rotate_index 024140 automatic fixed bin(17,0) dcl 824 set ref 829* 856* 869* 877 rotate_wdir_flag 023731 automatic bit(1) dcl 64 set ref 909* 1044* 1100 1127 1140 1189 rtrim builtin function dcl 113 ref 516 791 796 846 866 873 1108 1108 1163 1163 1183 1183 1209 1209 1209 1209 1211 1211 1213 1213 1506 1506 1508 1508 1540 1540 1607 1615 1615 1624 1627 1630 1630 1630 1630 1635 1635 1635 1692 1692 search_index 000101 automatic fixed bin(35,0) dcl 1824 set ref 1831* 1882* 1888 1893* 1893 1894 search_ptr 000102 automatic pointer dcl 1825 set ref 1832* 1877* 1879* 1879 1883 1885* 1885 searching_index 000101 automatic fixed bin(35,0) dcl 1935 set ref 1948* 1954 1959* 1959 1960 searching_ptr 000102 automatic pointer dcl 1936 set ref 1940* 1947* 1949 1951* 1951 skip_index 000104 automatic fixed bin(35,0) dcl 1826 set ref 1830* 1878* skip_node_index 024074 automatic fixed bin(35,0) dcl 506 set ref 513* 560* 606* 616* smallest_index_for_unsorted_array 024043 automatic fixed bin(17,0) dcl 363 set ref 373* 377 377* 380 397 399 stack_linked_list based structure level 1 dcl 82 set ref 437 473 531 573 631 689 717 737 757 841 880 stack_location 023732 automatic fixed bin(35,0) dcl 65 set ref 684 685 694 852 853 856 914* 969* 984* 999* 1027* 1046* 1056* 1081* 1365* 1366* 1371* 1372* 1383* 1384* 1387* 1388* 1398* 1402 1407* 1407 1408* 1411* 1415 1420* 1420 1421* 1423* 1428* 1432* 1433* 1447* 1451* 1472* sub_err_ 000206 constant entry external dcl 103 ref 1703 substr builtin function dcl 113 set ref 221 1153* 1393 1752* 1834 system_area based area(1024) dcl 87 ref 437 473 531 573 631 689 717 737 757 841 880 temp_data 024044 automatic fixed bin(35,0) dcl 364 set ref 369* 397* 401 temp_ptr 023734 automatic pointer dcl 66 set ref 527* 528 531 543* 548 561 562* 562 570 573 581 588* 589 597 607 608* 608 612* 617 618* 618 627 631 633* 674* 682* 686 689 691* 699 701* 701 724 725 733 734 737 757* 762 763 765 765 768 769 770 791 792 796 841* 843 844 846 853* 861* 866* 880 886* 915* 1470* 1553* 1560 1560 1563* 1563 1586* 1657 1660 1660 1663* 1663 total_number_of_pushes 000012 internal static fixed bin(35,0) initial dcl 71 set ref 231 255 271 278 835 869 877 1160* 1167* 1175* 1186* 1198* 1370 1371 1386 1387 1402 1415 1453 1839 1856 1882 1888 1948 1954 travel_ptr 024142 automatic pointer dcl 825 set ref 830* 850* 853* 857 858* 858 861* 866 866* 870 871* 871 873 886* user_info_$homedir 000210 constant entry external dcl 104 ref 1763 verify builtin function dcl 113 ref 221 1393 1834 want_header 024011 automatic bit(1) dcl 1303 set ref 1333* 1475* 1521 1568 1610 1646 wdir_name 13 based varying char(168) level 2 dcl 82 set ref 433 469 724 791* 843* 1657 1660* whoami 023736 automatic char(32) packed unaligned dcl 67 set ref 520* 678* 706* 837* 882* 925* 934* 946* 960* 965* 972* 974* 990* 995* 1002* 1005* 1023* 1030* 1033* 1052* 1059* 1062* 1077* 1084* 1095* 1102* 1108* 1114* 1131* 1141* 1179* 1193* 1209* 1211* 1213* 1234* 1238* 1242* 1242* 1249* 1256* 1262* 1324* 1326* 1344* 1347* 1375* 1377* 1481* 1488* 1500* 1502* 1516* 1522* 1531* 1601* 1603* 1675* 1679* 1684* 1684* 1690* NAMES DECLARED BY EXPLICIT CONTEXT. CONTINUE_save_good_data 013433 constant entry internal dcl 1775 ref 279 1388 1846 1858 1896 ERR_RET 007303 constant label dcl 207 ref 216 224 229 231 239 241 252 255 291 294 310 LABEL_validation 014062 constant entry internal dcl 1922 ref 282 297 1428 1447 LOCATION_continue_validation 013501 constant entry internal dcl 1811 ref 248 299 1423 1451 LOCATION_validation 007216 constant entry internal dcl 173 ref 969 999 1027 1056 1081 RETURN 012363 constant label dcl 1344 ref 1360 1399 1404 1412 1417 1438 1443 1448 1459 array_selection_sort 010217 constant entry internal dcl 329 ref 540 cdwd 004173 constant entry external dcl 1221 change_default_wdir 004204 constant entry external dcl 1221 change_default_wdir_ 007167 constant entry external dcl 1731 change_wdir 000640 constant entry external dcl 117 change_wdir_ 007131 constant entry external dcl 1720 cwd 000627 constant entry external dcl 117 directory_commands_ 000616 constant entry external dcl 29 do_clear 010442 constant entry internal dcl 484 ref 1167 1198 do_pop 011122 constant entry internal dcl 650 ref 1186 do_push 011425 constant entry internal dcl 745 ref 1160 1175 do_rotate 011535 constant entry internal dcl 810 ref 1190 get_default_wdir 013407 constant entry internal dcl 1760 ref 1173 1688 1714 get_default_wdir_ 007102 constant entry external dcl 1711 ref 940 get_wdir 013356 constant entry internal dcl 1742 ref 1247 1479 1700 get_wdir_ 006766 constant entry external dcl 1698 initialization 012155 constant entry internal dcl 896 ref 927 move_to_a_specified_dir 010362 constant entry internal dcl 446 ref 861 886 move_to_top_stack_dir 010306 constant entry internal dcl 412 ref 853 866 pdwd 006546 constant entry external dcl 1671 print_default_wdir 006557 constant entry external dcl 1671 print_wdir 004535 constant entry external dcl 1274 pwd 004524 constant entry external dcl 1274 save_a_valid_LOCATION 014045 constant entry internal dcl 1905 ref 246 259 267 272 277 288 1366 1372 1384 1408 1421 1433 1962 wd 004546 constant entry external dcl 1274 wd_input_argument_validation 012224 constant entry internal dcl 1310 ref 1512 working_dir 004557 constant entry external dcl 1274 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 14656 15104 14226 14666 Length 15532 14226 226 412 427 146 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME directory_commands_ 10738 external procedure is an external procedure. LOCATION_validation internal procedure shares stack frame of external procedure directory_commands_. array_selection_sort internal procedure shares stack frame of external procedure directory_commands_. move_to_top_stack_dir internal procedure shares stack frame of external procedure directory_commands_. move_to_a_specified_dir internal procedure shares stack frame of external procedure directory_commands_. do_clear internal procedure shares stack frame of external procedure directory_commands_. do_pop internal procedure shares stack frame of external procedure directory_commands_. do_push internal procedure shares stack frame of external procedure directory_commands_. do_rotate internal procedure shares stack frame of external procedure directory_commands_. initialization internal procedure shares stack frame of external procedure directory_commands_. wd_input_argument_validation internal procedure shares stack frame of external procedure directory_commands_. get_wdir internal procedure shares stack frame of external procedure directory_commands_. get_default_wdir internal procedure shares stack frame of external procedure directory_commands_. CONTINUE_save_good_data 67 internal procedure is called by several nonquick procedures. LOCATION_continue_validation 86 internal procedure is called during a stack extension. save_a_valid_LOCATION 64 internal procedure is called by several nonquick procedures. LABEL_validation 78 internal procedure is called during a stack extension. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 area_ptr directory_commands_ 000012 total_number_of_pushes directory_commands_ 000013 default_wdir_set directory_commands_ 000014 default_wdir_pathname directory_commands_ 000066 first_node_ptr directory_commands_ 000070 last_node_ptr directory_commands_ 000072 label_name_of_current_wdir directory_commands_ 000103 current_wdir_pathname directory_commands_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME CONTINUE_save_good_data 000100 next_stack_position CONTINUE_save_good_data 000101 next_stack_pos CONTINUE_save_good_data LABEL_validation 000100 match_label_name LABEL_validation 000101 searching_index LABEL_validation 000102 searching_ptr LABEL_validation LOCATION_continue_validation 000100 found LOCATION_continue_validation 000101 search_index LOCATION_continue_validation 000102 search_ptr LOCATION_continue_validation 000104 skip_index LOCATION_continue_validation directory_commands_ 000100 LOCATION_after_colon directory_commands_ 000111 LOCATION_before_colon directory_commands_ 000122 active_function directory_commands_ 000124 ap directory_commands_ 000126 al directory_commands_ 000127 arg_index directory_commands_ 000130 array_index directory_commands_ 000131 clear_entire_stack_flag directory_commands_ 000132 clear_wdir_flag directory_commands_ 000133 code directory_commands_ 000134 current_wdir directory_commands_ 000206 current_wdir_length directory_commands_ 000207 given_label_name directory_commands_ 000217 error_count directory_commands_ 000220 label_current_wdir_for_rotation directory_commands_ 000221 labels_the_current_wdir directory_commands_ 000231 location_array directory_commands_ 023651 match directory_commands_ 023652 max_array_index directory_commands_ 023653 nargs directory_commands_ 023654 pathname directory_commands_ 023726 pathname_count directory_commands_ 023727 pop_wdir_flag directory_commands_ 023730 push_wdir_flag directory_commands_ 023731 rotate_wdir_flag directory_commands_ 023732 stack_location directory_commands_ 023734 temp_ptr directory_commands_ 023736 whoami directory_commands_ 023746 control_string directory_commands_ 023763 header_control_string directory_commands_ 023773 comments directory_commands_ 024003 longest_label_length directory_commands_ 024004 no_header directory_commands_ 024005 print_index directory_commands_ 024006 ret_ptr directory_commands_ 024010 ret_len directory_commands_ 024011 want_header directory_commands_ 024030 err_count LOCATION_validation 024040 i_index array_selection_sort 024041 j_index array_selection_sort 024042 k_index array_selection_sort 024043 smallest_index_for_unsorted_array array_selection_sort 024044 temp_data array_selection_sort 024070 clear_index do_clear 024072 previous_pointer do_clear 024074 skip_node_index do_clear 024114 pop_index do_pop 024115 remove_index do_pop 024116 dispose_node_ptr do_pop 024140 rotate_index do_rotate 024142 travel_ptr do_rotate 024144 prev_travel_ptr do_rotate THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_char_temp cat_realloc_chars call_ext_in call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other return_mac signal_op shorten_stack ext_entry int_entry int_entry_desc op_alloc_ op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. active_fnc_err_ com_err_ cu_$af_return_arg cu_$arg_count cu_$arg_ptr cv_dec_check_ expand_path_ get_system_free_area_ hcs_$fs_search_get_wdir hcs_$fs_search_set_wdir ioa_ requote_string_ sub_err_ user_info_$homedir THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$argerr error_table_$bad_arg error_table_$badopt error_table_$bigarg error_table_$no_wdir error_table_$not_act_fnc LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 29 000615 117 000625 925 000647 927 000652 929 000653 932 000666 933 000677 934 000701 935 000716 938 000725 939 000727 940 000731 941 000737 943 000740 944 000747 945 000764 946 000766 947 001003 950 001012 951 001026 952 001036 954 001040 957 001045 958 001055 959 001072 960 001074 961 001111 964 001120 965 001126 966 001162 969 001171 971 001231 972 001233 974 001306 975 001340 977 001347 979 001351 981 001352 982 001356 984 001360 987 001366 988 001367 989 001404 990 001406 991 001423 994 001432 995 001440 996 001474 999 001503 1001 001543 1002 001545 1005 001620 1006 001652 1009 001670 1013 001677 1015 001700 1016 001704 1018 001706 1020 001712 1021 001713 1022 001730 1023 001732 1024 001747 1027 001756 1029 002016 1030 002020 1033 002073 1034 002125 1037 002143 1041 002152 1043 002153 1044 002157 1046 002161 1049 002167 1050 002170 1051 002205 1052 002207 1053 002224 1056 002233 1058 002273 1059 002275 1062 002350 1063 002402 1066 002420 1070 002427 1072 002433 1074 002435 1075 002436 1076 002453 1077 002455 1078 002472 1081 002501 1083 002541 1084 002543 1085 002575 1088 002613 1092 002622 1095 002623 1096 002655 1098 002664 1100 002665 1102 002671 1103 002723 1106 002732 1107 002733 1108 002736 1109 003016 1112 003026 1113 003051 1114 003053 1115 003105 1118 003114 1121 003116 1123 003117 1124 003122 1127 003125 1130 003135 1131 003137 1132 003164 1133 003177 1134 003213 1135 003226 1136 003242 1140 003251 1141 003261 1142 003276 1150 003305 1151 003320 1153 003326 1155 003334 1158 003346 1159 003352 1160 003355 1163 003371 1164 003432 1166 003433 1167 003436 1168 003447 1170 003460 1172 003461 1173 003464 1175 003465 1178 003501 1179 003505 1180 003532 1183 003541 1184 003602 1186 003603 1189 003626 1190 003630 1193 003640 1194 003655 1198 003664 1201 003700 1205 003711 1206 003715 1207 003732 1208 003734 1209 003737 1211 004040 1212 004111 1213 004113 1214 004162 1217 004163 1221 004172 1234 004213 1236 004216 1237 004227 1238 004231 1239 004246 1241 004255 1242 004260 1244 004310 1246 004317 1247 004321 1248 004322 1249 004326 1250 004343 1252 004352 1254 004353 1255 004372 1256 004374 1257 004411 1260 004420 1261 004443 1262 004445 1263 004477 1267 004506 1268 004512 1270 004514 1274 004523 1470 004566 1471 004570 1472 004571 1473 004573 1474 004605 1475 004606 1476 004607 1477 004610 1479 004611 1481 004612 1483 004615 1484 004632 1485 004634 1488 004641 1489 004655 1491 004664 1493 004665 1494 004667 1497 004670 1498 004672 1499 004676 1500 004701 1502 004720 1503 004734 1506 004743 1508 005020 1509 005060 1512 005061 1513 005062 1515 005073 1516 005076 1517 005123 1519 005132 1521 005133 1522 005141 1523 005171 1528 005200 1529 005203 1530 005231 1531 005235 1532 005252 1535 005261 1536 005263 1537 005302 1540 005315 1541 005354 1546 005355 1548 005365 1549 005367 1553 005374 1555 005377 1558 005407 1560 005412 1562 005417 1563 005420 1564 005423 1565 005425 1568 005427 1570 005433 1574 005440 1575 005504 1577 005517 1578 005571 1580 005604 1584 005616 1586 005625 1588 005630 1590 005637 1591 005641 1592 005651 1596 005664 1597 005667 1599 005670 1600 005673 1601 005677 1603 005717 1604 005734 1607 005743 1610 005767 1611 005771 1612 006002 1615 006015 1616 006062 1618 006063 1620 006064 1621 006066 1624 006101 1627 006133 1628 006162 1630 006163 1632 006256 1633 006257 1635 006262 1637 006367 1643 006370 1645 006401 1646 006410 1647 006412 1648 006423 1652 006436 1654 006442 1655 006444 1657 006464 1658 006477 1660 006500 1661 006526 1663 006527 1664 006532 1665 006534 1667 006536 1671 006545 1675 006566 1677 006571 1678 006602 1679 006604 1680 006621 1683 006630 1684 006632 1685 006662 1688 006671 1690 006672 1692 006714 1694 006753 1698 006763 1700 006774 1702 006775 1703 007001 1704 007050 1707 007064 1711 007100 1714 007110 1716 007111 1720 007125 1725 007140 1727 007156 1731 007165 1733 007176 1734 007204 1736 007206 1738 007207 173 007216 195 007241 196 007242 197 007243 198 007244 200 007245 201 007262 202 007265 205 007266 206 007300 207 007303 209 007306 213 007307 214 007324 216 007346 221 007360 223 007370 224 007373 228 007376 229 007417 231 007421 234 007430 235 007435 237 007436 238 007441 239 007471 241 007474 244 007477 246 007503 248 007513 249 007547 251 007551 252 007572 255 007574 258 007602 259 007607 262 007617 264 007620 265 007623 266 007634 267 007636 268 007646 270 007647 271 007657 272 007662 273 007672 275 007673 276 007703 277 007705 278 007715 279 007721 280 007733 282 007734 286 007763 287 007775 288 007777 289 010007 291 010010 294 010022 297 010034 299 010067 300 010124 301 010125 304 010126 305 010140 306 010151 308 010162 309 010164 310 010166 313 010167 314 010172 315 010175 318 010176 320 010210 323 010216 329 010217 368 010220 369 010222 371 010223 373 010227 374 010230 376 010232 377 010235 380 010244 383 010245 384 010255 385 010260 387 010262 389 010265 391 010267 394 010271 395 010272 397 010273 399 010276 401 010301 403 010303 404 010304 406 010305 412 010306 426 010317 427 010325 429 010331 430 010334 433 010340 434 010346 437 010353 438 010355 439 010360 441 010361 446 010362 460 010373 461 010400 463 010403 465 010410 466 010413 469 010417 470 010425 473 010432 475 010434 476 010437 477 010440 479 010441 484 010442 509 010444 510 010445 511 010446 512 010447 513 010451 515 010452 516 010460 519 010512 520 010513 522 010540 525 010541 526 010543 527 010553 528 010556 529 010561 531 010562 532 010564 534 010571 535 010573 536 010576 537 010577 540 010600 543 010604 545 010607 547 010612 548 010615 549 010620 551 010621 552 010625 553 010627 555 010630 560 010631 561 010646 562 010650 563 010652 565 010657 566 010664 567 010667 568 010671 570 010672 573 010675 575 010677 576 010706 578 010707 580 010715 581 010720 582 010724 585 010725 587 010736 588 010742 589 010745 592 010747 594 010756 597 010757 598 010763 600 010764 602 010765 606 010770 607 011004 608 011006 609 011010 610 011015 612 011016 616 011025 617 011042 618 011044 619 011046 622 011053 623 011060 624 011063 625 011065 627 011066 631 011075 633 011077 634 011102 636 011104 639 011113 640 011115 641 011120 644 011121 650 011122 669 011133 670 011135 671 011136 673 011137 674 011140 676 011141 677 011150 678 011151 679 011175 682 011176 684 011200 685 011203 686 011220 687 011224 689 011225 691 011227 692 011232 694 011234 697 011243 698 011247 699 011261 701 011272 702 011274 704 011276 705 011303 706 011304 707 011334 710 011335 712 011337 713 011347 714 011352 715 011355 717 011356 718 011360 720 011362 724 011371 725 011401 728 011407 729 011411 730 011413 731 011414 733 011415 734 011417 737 011422 739 011424 745 011425 757 011427 759 011435 762 011442 763 011443 765 011444 766 011445 768 011446 769 011450 770 011452 791 011454 792 011475 796 011502 799 011526 802 011527 804 011534 810 011535 829 011546 830 011547 831 011551 833 011552 835 011553 836 011561 837 011563 838 011610 841 011611 843 011617 844 011624 846 011632 850 011656 852 011660 853 011663 856 011707 857 011724 858 011726 859 011730 861 011732 865 011756 866 011762 869 012024 870 012037 871 012041 873 012043 875 012064 877 012066 878 012073 880 012075 882 012077 883 012127 886 012130 890 012154 896 012155 898 012156 899 012157 900 012171 901 012174 902 012177 903 012200 904 012201 905 012202 906 012203 907 012206 908 012207 909 012210 910 012211 911 012214 912 012215 913 012216 914 012217 915 012221 917 012223 1310 012224 1316 012225 1317 012226 1318 012227 1320 012230 1322 012237 1323 012254 1324 012256 1326 012276 1327 012313 1330 012314 1332 012330 1333 012340 1335 012342 1336 012343 1337 012344 1338 012354 1340 012356 1341 012357 1343 012360 1344 012363 1347 012420 1348 012452 1350 012453 1353 012454 1355 012466 1356 012502 1358 012524 1359 012536 1360 012541 1364 012542 1365 012552 1366 012553 1367 012563 1369 012564 1370 012574 1371 012577 1372 012600 1373 012610 1375 012611 1377 012640 1378 012664 1380 012665 1382 012666 1383 012676 1384 012677 1386 012707 1387 012712 1388 012713 1391 012725 1393 012726 1396 012736 1398 012740 1399 012763 1402 012765 1403 012771 1404 012773 1407 012774 1408 013001 1409 013011 1411 013012 1412 013042 1415 013045 1416 013051 1417 013053 1420 013054 1421 013061 1423 013071 1424 013124 1425 013125 1428 013126 1431 013157 1432 013171 1433 013172 1434 013202 1436 013203 1437 013215 1438 013220 1441 013221 1442 013233 1443 013236 1447 013237 1448 013272 1451 013275 1452 013330 1453 013333 1459 013351 1461 013353 1463 013355 1742 013356 1747 013357 1749 013372 1752 013400 1754 013406 1760 013407 1762 013410 1763 013413 1765 013423 1768 013426 1770 013431 1775 013432 1792 013440 1793 013446 1794 013450 1797 013451 1799 013455 1800 013465 1801 013467 1802 013472 1805 013477 1811 013500 1829 013514 1830 013515 1831 013516 1832 013517 1834 013521 1836 013533 1837 013552 1839 013555 1840 013561 1841 013563 1844 013564 1846 013571 1847 013604 1849 013605 1852 013621 1855 013634 1856 013644 1858 013646 1859 013661 1862 013662 1863 013674 1864 013676 1867 013677 1868 013710 1869 013712 1872 013713 1873 013716 1874 013720 1877 013721 1878 013723 1879 013733 1880 013736 1882 013743 1883 013761 1885 013775 1886 013777 1888 014004 1889 014011 1890 014014 1893 014015 1894 014023 1896 014030 1899 014043 1905 014044 1913 014052 1914 014054 1916 014060 1922 014061 1939 014075 1940 014076 1942 014100 1943 014103 1944 014106 1947 014107 1948 014111 1949 014123 1951 014137 1952 014141 1954 014146 1955 014153 1956 014156 1959 014157 1960 014165 1962 014172 1964 014203 ----------------------------------------------------------- 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