COMPILATION LISTING OF SEGMENT get_shortest_path_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 03/29/84 1505.5 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ 11 12 get_shortest_path_: 13 proc (P_path) returns (char (168)); 14 15 /* DESCRIPTION: 16* 17* Replaces every directory component it has access to with the 18* shortest name on the directory. If for any component multiple 19* shortest names are found, three steps are taken to give what is 20* hopefully the optimum name for the user. First, try to get rid of 21* any names with upper case characters in them and reduce the list 22* of candidate names to this set. If multiple names still exist, 23* take the first char. of the primary name and take the first short 24* name whose first char. matches it case independently. If this fails, 25* return the first shortest name found. 26**/ 27 28 /* HISTORY: 29* 30*Written by S. Herbst, 10/01/81. 31*Modified: 32*11/16/82 by S. Herbst: Added cleanup handler and made it replace names 33* of links to dirs. 34*09/13/83 by Lee A. Newcomb: made to give precidence to names without upper 35* case chars, then names matching 1st char of primary name. Also 36* made status_branch an automatic structure, and fixed bug where 37* status_entry_names structure was never freed. 38*01/30/84 by L. A. Newcomb: fixed bug in freeing the status_entry_names 39* structure if the pathname supplied is a link (i.e., the last 40* pathname component is a link, but we don't care about the other 41* directory components of the pathname). 42**/ 43 44 /* START OF DECLARATIONS */ 45 /* Parameter */ 46 dcl 47 P_path char (*) /* path to get shortest_path of */ 48 parameter; 49 50 /* Automatic */ 51 dcl ( 52 code fixed bin (35), /* status/error code */ 53 ename char (32), /* used in hcs_$status_ to get all enames */ 54 entry_names_p ptr, /* for getting to (status_)entry_names faster */ 55 i fixed bin (21), /* used in indexing into orginal_path */ 56 input_path char (528) varying, /* 528 max. for paths */ 57 original_path char (528), /* after being pased through absolute_pathname_ */ 58 output_path char (528) varying, /* we build it as we go */ 59 start fixed bin (21) /* for walking through the given name */ 60 ) automatic; 61 62 /* Automatic Structures */ 63 dcl 64 1 local_status_branch like status_branch aligned 65 automatic; 66 67 /* CONSTANTS */ 68 dcl ( 69 LOWER_CHARS char (26) init ("abcdefghijklmnopqrstuvwxyz"), 70 NO_CHASE fixed bin (1) init (0), 71 UPPER_CHARS char (26) init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ") 72 ) internal static options (constant); 73 74 /* Based */ 75 dcl 76 entry_names aligned char (32) /* like status_entry_names */ 77 dim (status_branch.nnames) based (entry_names_p), 78 status_area area based (status_area_ptr); 79 80 /* Entries */ 81 dcl 82 absolute_pathname_ entry (char (*), char (*), fixed (35)), 83 get_system_free_area_ entry returns (ptr), 84 hcs_$status_ entry (char (*), char (*), fixed (1), ptr, ptr, fixed (35)); 85 86 /* Builtins & Conditions */ 87 dcl 88 (addr, index, length, 89 null, pointer, rtrim, 90 search, substr, translate) builtin, 91 cleanup condition; 92 93 /* END OF DECLARATIONS */ 94 95 call absolute_pathname_ (P_path, original_path, code); /* get the complete pathname string */ 96 if code ^= 0 then /* failure, can only return input data */ 97 return (P_path); 98 99 if original_path = ">" then /* the ROOT is kind of short to start with */ 100 return (">"); 101 102 input_path = rtrim (original_path); /* copy to varying string */ 103 output_path = ">"; /* always start at the ROOT */ 104 start = 2; /* ignore first ">" in path */ 105 status_area_ptr = get_system_free_area_ (); /* where to allocate status_names */ 106 status_ptr = addr (local_status_branch); /* use auto storage for the basic structure */ 107 status_branch.names_relp = ""b; /* for cleanup */ 108 entry_names_p = null (); /* for safety in cleanup */ 109 110 on cleanup begin; 111 if status_branch.names_relp ^= ""b then 112 if entry_names_p ^= null () then /* take care of window between setting names_relp and ptr */ 113 free entry_names in (status_area); /* so we don't free twice */ 114 end; 115 116 do while (start <= length (input_path)); /* main loop, go until nothing left */ 117 /* get next ename to shorten */ 118 i = index (substr (input_path, start), ">"); 119 if i ^= 0 then 120 ename = substr (input_path, start, i - 1); 121 else do; 122 ename = substr (input_path, start); 123 i = length (input_path) + 1; /* to stop loop */ 124 end; 125 126 call hcs_$status_ ((output_path), ename, NO_CHASE, status_ptr, status_area_ptr, code); 127 if code = 0 then /* make freeing work */ 128 entry_names_p = pointer (status_area_ptr, status_branch.names_relp); 129 130 if code = 0 & 131 (status_branch.type = Directory | /* replace only directory names */ 132 (status_branch.type = Link & i <= length (input_path))) then /* and names of links to dirs */ 133 ename = select_shortest_entry_name (); /* possibly replace original name */ 134 135 136 if code = 0 then do; /* must free names struct. */ 137 status_branch.names_relp = ""b; /* to prevent multiple frees by cleanup handler */ 138 free entry_names in (status_area); /* and use our version of the structure for freeing */ 139 entry_names_p = null (); /* so ptr is null between relp setting and ptr calculation */ 140 end; 141 142 /* ename still holds name to use */ 143 if length (output_path) > 1 then /* most common case */ 144 output_path = output_path || ">" || rtrim (ename); 145 else output_path = ">" || rtrim (ename); /* don't double up the first ">" */ 146 start = start + i; /* update loop control */ 147 end; 148 149 150 return ((output_path)); 151 152 /* end get_shortest_path_; */ 153 154 select_shortest_entry_name: 155 proc () returns (char (32)); 156 157 /* This procedure selects the shortest name in the currently available */ 158 /* status_entry_names array. For efficiency and ease of programming, */ 159 /* the entry_names array has been declared and given an explicit ptr. */ 160 /* The necessity for this procedure is to allocate the name index */ 161 /* as we have no idea at the time get_shortest_path_'s stack frame is */ 162 /* laid down what the max size required will be. */ 163 164 /* START OF DECLARATIONS */ 165 /* Automatic */ 166 dcl ( 167 curr_shortest_length fixed bin (21), /* shortest entryname length at any point in selection */ 168 name_idx fixed bin, /* for walking throught status_names struct. */ 169 n_lower_names fixed bin, /* # of entrynames of the same length with no upper */ 170 /* case chars; must be <= n_shortest_names */ 171 n_shortest_names fixed bin, /* # of shortest entrynames of same length */ 172 primary_ename_fchar char (1) aligned, /* 1st char. of primary entryname for selecting */ 173 /* between multiple shortest names of same length */ 174 shortest_name_idxs fixed bin dim (status_branch.nnames) /* for getting the SHORTEST entrynames */ 175 /* dcl'd this way to not have to program */ 176 /* for a staticly dcl'd array overflow */ 177 ) automatic; 178 179 /* END OF DECLARATIONS */ 180 181 n_shortest_names = 1; /* to start */ 182 shortest_name_idxs (1) = 1; 183 curr_shortest_length = length (rtrim (entry_names (1))); 184 185 do name_idx = 2 to status_branch.nnames; 186 187 if length (rtrim (entry_names (name_idx))) < curr_shortest_length then do; 188 /* new shortest length */ 189 curr_shortest_length = length (rtrim (entry_names (name_idx))); 190 n_shortest_names = 1; /* must restart list */ 191 shortest_name_idxs (1) = name_idx; 192 end; 193 194 else if length (rtrim (entry_names (name_idx))) = curr_shortest_length then do; 195 /* add to current list */ 196 n_shortest_names = n_shortest_names + 1; 197 shortest_name_idxs (n_shortest_names) = name_idx; 198 end; 199 200 else ; /* name too long ==> uninteresting */ 201 end; 202 203 /* if only one name is left, we have our answer */ 204 205 if n_shortest_names = 1 then /* done */ 206 return (entry_names (shortest_name_idxs (1))); 207 208 /* More work needed: all names we have saved indices of are of the same */ 209 /* length see if any are all lower case or valid non-alpha chars. We */ 210 /* will share the current index array if any names show up not containing */ 211 /* any upper case characters. */ 212 213 n_lower_names = 0; /* we share the current index array */ 214 do name_idx = 1 to n_shortest_names; 215 216 if search (entry_names (shortest_name_idxs (name_idx)), UPPER_CHARS) = 0 then do; 217 218 n_lower_names = n_lower_names + 1; /* no upper case chars */ 219 shortest_name_idxs (n_lower_names) = shortest_name_idxs (name_idx); 220 end; 221 end; 222 223 /* If one non-upper name was found, we return it */ 224 225 if n_lower_names = 1 then /* done */ 226 return (entry_names (shortest_name_idxs (1))); 227 228 /* We know we need to do compare with first char of primary name case */ 229 /* independently. First, we make sure we have that char in lower */ 230 /* if it is upper case. */ 231 232 primary_ename_fchar = translate (substr (entry_names (1), 1, 1), LOWER_CHARS, UPPER_CHARS); 233 234 /* If we know only non-upper case names are around, do small optimization */ 235 236 if n_lower_names > 1 then do; 237 238 do name_idx = 1 to n_lower_names; /* will break out of loop on a match */ 239 240 if primary_ename_fchar = substr (entry_names (shortest_name_idxs (name_idx)), 1, 1) then 241 return (entry_names (shortest_name_idxs (name_idx))); /* done */ 242 end; 243 /* no match, return 1st non-upper name */ 244 return (entry_names (shortest_name_idxs (1))); /* done */ 245 end; 246 247 /* If there were no non-upper case names, we must do a translation for */ 248 /* the fchar compare. This is the only effective difference between the */ 249 /* previous compare loop and the following one. */ 250 251 do name_idx = 1 to n_shortest_names; 252 253 if primary_ename_fchar = translate (substr (entry_names ( 254 shortest_name_idxs (name_idx)), 1, 1), LOWER_CHARS, UPPER_CHARS) then 255 256 return (entry_names (shortest_name_idxs (name_idx))); /* done */ 257 end; 258 259 /* no first char match on multiple names of same shortest length. */ 260 /* We just return the first shortest name found */ 261 262 return (entry_names (shortest_name_idxs (1))); /* done */ 263 264 end select_shortest_entry_name; 1 1 /* --------------- BEGIN include file status_structures.incl.pl1 --------------- */ 1 2 1 3 /* Revised from existing include files 09/26/78 by C. D. Tavares */ 1 4 1 5 /* This include file contains branch and link structures returned by 1 6* hcs_$status_ and hcs_$status_long. */ 1 7 1 8 dcl 1 status_branch aligned based (status_ptr), 1 9 2 short aligned, 1 10 3 type fixed bin (2) unaligned unsigned, /* seg, dir, or link */ 1 11 3 nnames fixed bin (16) unaligned unsigned, /* number of names */ 1 12 3 names_relp bit (18) unaligned, /* see entry_names dcl */ 1 13 3 dtcm bit (36) unaligned, /* date/time contents last modified */ 1 14 3 dtu bit (36) unaligned, /* date/time last used */ 1 15 3 mode bit (5) unaligned, /* caller's effective access */ 1 16 3 raw_mode bit (5) unaligned, /* caller's raw "rew" modes */ 1 17 3 pad1 bit (8) unaligned, 1 18 3 records_used fixed bin (18) unaligned unsigned, /* number of NONZERO pages used */ 1 19 1 20 /* Limit of information returned by hcs_$status_ */ 1 21 1 22 2 long aligned, 1 23 3 dtd bit (36) unaligned, /* date/time last dumped */ 1 24 3 dtem bit (36) unaligned, /* date/time branch last modified */ 1 25 3 lvid bit (36) unaligned, /* logical volume ID */ 1 26 3 current_length fixed bin (12) unaligned unsigned, /* number of last page used */ 1 27 3 bit_count fixed bin (24) unaligned unsigned, /* reported length in bits */ 1 28 3 pad2 bit (8) unaligned, 1 29 3 copy_switch bit (1) unaligned, /* copy switch */ 1 30 3 tpd_switch bit (1) unaligned, /* transparent to paging device switch */ 1 31 3 mdir_switch bit (1) unaligned, /* is a master dir */ 1 32 3 damaged_switch bit (1) unaligned, /* salvager warned of possible damage */ 1 33 3 synchronized_switch bit (1) unaligned, /* DM synchronized file */ 1 34 3 pad3 bit (5) unaligned, 1 35 3 ring_brackets (0:2) fixed bin (6) unaligned unsigned, 1 36 3 uid bit (36) unaligned; /* unique ID */ 1 37 1 38 dcl 1 status_link aligned based (status_ptr), 1 39 2 type fixed bin (2) unaligned unsigned, /* as above */ 1 40 2 nnames fixed bin (16) unaligned unsigned, 1 41 2 names_relp bit (18) unaligned, 1 42 2 dtem bit (36) unaligned, 1 43 2 dtd bit (36) unaligned, 1 44 2 pathname_length fixed bin (17) unaligned, /* see pathname */ 1 45 2 pathname_relp bit (18) unaligned; /* see pathname */ 1 46 1 47 dcl status_entry_names (status_branch.nnames) character (32) aligned 1 48 based (pointer (status_area_ptr, status_branch.names_relp)), 1 49 /* array of names returned */ 1 50 status_pathname character (status_link.pathname_length) aligned 1 51 based (pointer (status_area_ptr, status_link.pathname_relp)), 1 52 /* link target path */ 1 53 status_area_ptr pointer, 1 54 status_ptr pointer; 1 55 1 56 dcl (Link initial (0), 1 57 Segment initial (1), 1 58 Directory initial (2)) fixed bin internal static options (constant); 1 59 /* values for type fields declared above */ 1 60 1 61 /* ---------------- END include file status_structures.incl.pl1 ---------------- */ 265 266 267 end get_shortest_path_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 03/15/84 0819.2 get_shortest_path_.pl1 >special_ldd>on>6290>get_shortest_path_.pl1 265 1 11/22/82 0955.7 status_structures.incl.pl1 >ldd>include>status_structures.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. Directory constant fixed bin(17,0) initial dcl 1-56 ref 130 LOWER_CHARS 000007 constant char(26) initial unaligned dcl 68 ref 232 253 Link constant fixed bin(17,0) initial dcl 1-56 ref 130 NO_CHASE 000020 constant fixed bin(1,0) initial dcl 68 set ref 126* P_path parameter char unaligned dcl 46 set ref 12 95* 96 UPPER_CHARS 000000 constant char(26) initial unaligned dcl 68 ref 216 232 253 absolute_pathname_ 000010 constant entry external dcl 81 ref 95 addr builtin function dcl 87 ref 106 cleanup 000746 stack reference condition dcl 87 ref 110 code 000100 automatic fixed bin(35,0) dcl 51 set ref 95* 96 126* 127 130 136 curr_shortest_length 000100 automatic fixed bin(21,0) dcl 166 set ref 183* 187 189* 194 ename 000101 automatic char(32) unaligned dcl 51 set ref 119* 122* 126* 130* 143 145 entry_names based char(32) array dcl 75 ref 111 138 183 187 189 194 205 216 225 232 240 240 244 253 253 262 entry_names_p 000112 automatic pointer dcl 51 set ref 108* 111 111 127* 138 139* 183 187 189 194 205 216 225 232 240 240 244 253 253 262 get_system_free_area_ 000012 constant entry external dcl 81 ref 105 hcs_$status_ 000014 constant entry external dcl 81 ref 126 i 000114 automatic fixed bin(21,0) dcl 51 set ref 118* 119 119 123* 130 146 index builtin function dcl 87 ref 118 input_path 000115 automatic varying char(528) dcl 51 set ref 102* 116 118 119 122 123 130 length builtin function dcl 87 ref 116 123 130 143 183 187 189 194 local_status_branch 000734 automatic structure level 1 dcl 63 set ref 106 n_lower_names 000102 automatic fixed bin(17,0) dcl 166 set ref 213* 218* 218 219 225 236 238 n_shortest_names 000103 automatic fixed bin(17,0) dcl 166 set ref 181* 190* 196* 196 197 205 214 251 name_idx 000101 automatic fixed bin(17,0) dcl 166 set ref 185* 187 189 191 194 197* 214* 216 219* 238* 240 240* 251* 253 253* names_relp 0(18) based bit(18) level 3 packed unaligned dcl 1-8 set ref 107* 111 127 137* nnames 0(02) based fixed bin(16,0) level 3 packed unsigned unaligned dcl 1-8 ref 111 138 166 185 null builtin function dcl 87 ref 108 111 139 original_path 000322 automatic char(528) unaligned dcl 51 set ref 95* 99 102 output_path 000526 automatic varying char(528) dcl 51 set ref 103* 126 143 143* 143 145* 150 pointer builtin function dcl 87 ref 127 primary_ename_fchar 000104 automatic char(1) dcl 166 set ref 232* 240 253 rtrim builtin function dcl 87 ref 102 143 145 183 187 189 194 search builtin function dcl 87 ref 216 short based structure level 2 dcl 1-8 shortest_name_idxs 000105 automatic fixed bin(17,0) array dcl 166 set ref 182* 191* 197* 205 216 219* 219 225 240 240 244 253 253 262 start 000733 automatic fixed bin(21,0) dcl 51 set ref 104* 116 118 119 122 146* 146 status_area based area(1024) dcl 75 ref 111 138 status_area_ptr 000754 automatic pointer dcl 1-47 set ref 105* 111 126* 127 138 status_branch based structure level 1 dcl 1-8 status_ptr 000756 automatic pointer dcl 1-47 set ref 106* 107 111 111 126* 127 130 130 137 138 166 185 substr builtin function dcl 87 ref 118 119 122 232 240 253 translate builtin function dcl 87 ref 232 253 type based fixed bin(2,0) level 3 packed unsigned unaligned dcl 1-8 ref 130 130 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Segment internal static fixed bin(17,0) initial dcl 1-56 status_entry_names based char(32) array dcl 1-47 status_link based structure level 1 dcl 1-38 status_pathname based char dcl 1-47 NAMES DECLARED BY EXPLICIT CONTEXT. get_shortest_path_ 000040 constant entry external dcl 12 select_shortest_entry_name 000511 constant entry internal dcl 154 ref 130 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1536 1554 1437 1546 Length 1746 1437 16 156 76 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME get_shortest_path_ 542 external procedure is an external procedure. on unit on line 110 64 on unit select_shortest_entry_name 94 internal procedure uses auto adjustable storage. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME get_shortest_path_ 000100 code get_shortest_path_ 000101 ename get_shortest_path_ 000112 entry_names_p get_shortest_path_ 000114 i get_shortest_path_ 000115 input_path get_shortest_path_ 000322 original_path get_shortest_path_ 000526 output_path get_shortest_path_ 000733 start get_shortest_path_ 000734 local_status_branch get_shortest_path_ 000754 status_area_ptr get_shortest_path_ 000756 status_ptr get_shortest_path_ select_shortest_entry_name 000100 curr_shortest_length select_shortest_entry_name 000101 name_idx select_shortest_entry_name 000102 n_lower_names select_shortest_entry_name 000103 n_shortest_names select_shortest_entry_name 000104 primary_ename_fchar select_shortest_entry_name 000105 shortest_name_idxs select_shortest_entry_name THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out call_int_this return alloc_auto_adj enable shorten_stack ext_entry_desc int_entry free_based THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. absolute_pathname_ get_system_free_area_ hcs_$status_ NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 12 000034 95 000053 96 000074 99 000106 102 000120 103 000140 104 000144 105 000146 106 000155 107 000157 108 000161 110 000163 111 000177 114 000215 116 000216 118 000221 119 000240 122 000246 123 000252 126 000255 127 000321 130 000331 136 000354 137 000356 138 000360 139 000366 143 000370 145 000442 146 000475 147 000500 150 000501 154 000510 166 000516 181 000526 182 000530 183 000531 185 000544 187 000553 189 000574 190 000577 191 000601 192 000603 194 000604 196 000605 197 000606 201 000612 205 000614 213 000632 214 000633 216 000641 218 000661 219 000662 221 000666 225 000670 232 000706 236 000715 238 000716 240 000725 242 000747 244 000751 251 000764 253 000773 257 001021 262 001023 ----------------------------------------------------------- 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