COMPILATION LISTING OF SEGMENT expand_pathname_ Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-06-29_1716.76_Thu_mdt Options: optimize list 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1984 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 expand_pathname_: 14 procedure (p_pathname, p_dname, p_ename, p_code); 15 16 /* Subroutine to convert a relative pathname into an absolute pathname */ 17 /* Coded by Bob Frankston in January 1974 as a replacement for expand_path_ */ 18 /* Improved by D.A. Moon for bound_lisp_library_ */ 19 /* Searches changed to indexes by B. Greenberg 8/76 */ 20 /* Modified 770628 by PG to add expand_pathname_$add_suffix */ 21 /* Modified 790821 by PG to add expand_pathname_$component and expand_pathname_$component_add_suffix */ 22 /* Modified 790830 by PG to add write-around for expand_path_ */ 23 /* Modified 830810 by Jim Lippard to diagnose "::foo" */ 24 25 /* Note: the only syntax errors checked for are: */ 26 /* name too long - Will lose nonblank characters when converting to */ 27 /* a 168 character absolute string */ 28 /* too many <'s - More "<" than ">" in working directory name */ 29 /* bad name - "<" embedded in absolute pathname */ 30 /* - ">>" in absolute pathname */ 31 /* archive comp - Archive component pathname given to entrypoint */ 32 /* that doesn't accept it. */ 33 34 /* Note: (1) Embedded blanks and bad star names are accepted. */ 35 /* (2) Relative pathnames may be up to 202 characters as long */ 36 /* as the separated names are within the 168 or 32 char limits.*/ 37 /* (3) All errors are diagnosed before any output arguments */ 38 /* are changed. */ 39 40 /* parameters */ 41 42 declare p_pathname char (*), /* (Input) the relative (or absolute) pathname to be expanded */ 43 p_suffix char (*), /* (Input) suffix to be added to ename or cname */ 44 p_dname char (*), /* (Output) the directory name */ 45 p_ename char (*), /* (Output) the entry name */ 46 p_cname char (*), /* (Output) the component name */ 47 p_code fixed binary (35); /* (Output) standard status code */ 48 49 /* automatic */ 50 51 declare archive_path bit (1) aligned, /* ON if the entryname contains "::" */ 52 cname char (32), /* local copy of component name */ 53 dname char (168), /* local copy of dir name */ 54 ename char (32); /* local copy of ename */ 55 56 /* entries */ 57 58 declare hcs_$fs_search_get_wdir 59 entry (pointer, fixed bin (21)); 60 61 /* builtins */ 62 63 declare (addr, index, length, max, reverse, rtrim, substr) 64 builtin; 65 66 /* external static */ 67 68 declare (error_table_$archive_pathname, error_table_$badpath, error_table_$entlong, error_table_$lesserr, 69 error_table_$no_wdir, error_table_$pathlong, error_table_$root) 70 fixed bin (35) external static; 71 72 /* program */ 73 74 /* expand_pathname_: 75* entry (p_pathname, p_dname, p_ename, p_code); */ 76 77 call expand (p_pathname); 78 79 if archive_path 80 then go to archive_pathname; 81 82 p_dname = dname; 83 p_ename = ename; 84 p_code = 0; 85 return; 86 87 expand_pathname_$add_suffix: 88 entry (p_pathname, p_suffix, p_dname, p_ename, p_code); 89 90 if p_pathname = ">" then go to root; 91 if p_pathname = "" then go to badpath; 92 93 call expand (p_pathname); 94 95 if archive_path 96 then go to archive_pathname; 97 98 call suffix (ename, p_suffix); 99 p_dname = dname; 100 p_ename = ename; 101 p_code = 0; 102 return; 103 104 expand_pathname_$component: 105 entry (p_pathname, p_dname, p_ename, p_cname, p_code); 106 107 call expand (p_pathname); 108 109 if archive_path 110 then call suffix (ename, "archive"); 111 112 p_dname = dname; 113 p_ename = ename; 114 p_cname = cname; 115 p_code = 0; 116 return; 117 118 expand_pathname_$component_add_suffix: 119 entry (p_pathname, p_suffix, p_dname, p_ename, p_cname, p_code); 120 121 call expand (p_pathname); 122 123 if archive_path 124 then do; 125 call suffix (ename, "archive"); 126 call suffix (cname, p_suffix); 127 end; 128 else call suffix (ename, p_suffix); 129 130 p_dname = dname; 131 p_ename = ename; 132 p_cname = cname; 133 p_code = 0; 134 return; 135 136 /* Write-around for obsolete expand_path_ subroutine */ 137 138 expand_path_: 139 entry (p_relpath_ptr, p_relpath_len, p_dname_ptr, p_ename_ptr, p_code); 140 141 /* parameters */ 142 143 declare ( 144 p_relpath_ptr ptr, /* (Input) ptr to relative pathname */ 145 p_relpath_len fixed bin (21), /* (Input) length of relative pathname */ 146 p_dname_ptr ptr, /* (Input) ptr to char(168) output dirname */ 147 p_ename_ptr ptr /* (Input) ptr to char(32) output entryname (may be null) */ 148 ) parameter; 149 150 /* based */ 151 152 declare based_dname char (168) based (p_dname_ptr), 153 based_ename char (32) based (p_ename_ptr), 154 relpath char (p_relpath_len) based (p_relpath_ptr); 155 156 /* builtins */ 157 158 declare null builtin; 159 160 /* entries */ 161 162 declare absolute_pathname_ entry (char (*), char (*), fixed bin (35)); 163 164 /* program */ 165 166 if p_ename_ptr = null 167 then do; 168 if p_relpath_len<=0 169 then call absolute_pathname_ ("", based_dname, p_code); 170 else call absolute_pathname_ (relpath, based_dname, p_code); 171 return; 172 end; 173 174 if p_relpath_len <= 0 175 then call expand(""); 176 else call expand (relpath); 177 178 if archive_path 179 then go to archive_pathname; 180 181 based_dname = dname; 182 based_ename = ename; 183 p_code = 0; 184 return; 185 186 /* ERROR BRANCHES */ 187 188 archive_pathname: 189 p_code = error_table_$archive_pathname; 190 return; 191 192 badpath: 193 p_code = error_table_$badpath; 194 return; 195 196 entlong: 197 p_code = error_table_$entlong; 198 return; 199 200 lesserr: 201 p_code = error_table_$lesserr; 202 return; 203 204 no_wdir: 205 p_code = error_table_$no_wdir; 206 return; 207 208 pathlong: 209 p_code = error_table_$pathlong; 210 return; 211 212 root: 213 p_code = error_table_$root; 214 return; 215 216 /* INTERNAL PROCEDURES */ 217 218 /* Procedure to split a relative pathname into dname, ename, and cname */ 219 220 expand: 221 procedure (p_pathname); 222 223 /* parameters */ 224 225 declare p_pathname char (*) parameter; 226 227 /* automatic */ 228 229 declare ename_idx fixed bin (21), /* index of first char of ename */ 230 ename_len fixed bin (21), /* number of characters before "::" */ 231 dir_length fixed bin (21), /* length of directory name */ 232 name char (202), /* for local munging...202=168+2+32 */ 233 position fixed bin (21), /* offset of first char in name after "<"s */ 234 wdir_length fixed bin (21), /* length of wdir being kept to replace "<"s */ 235 working_directory char (168) aligned; /* user's current working dir */ 236 237 /* program */ 238 239 if length (p_pathname) > length (name) 240 then if substr (p_pathname, length (name) + 1) ^= "" 241 then go to pathlong; 242 243 name = p_pathname; /* copy so it can be munged */ 244 if substr (name, 1, 1) ^= ">" 245 then do; /* we will need wdir */ 246 call hcs_$fs_search_get_wdir (addr (working_directory), wdir_length); 247 if wdir_length = 0 248 then go to no_wdir; 249 250 if working_directory = ">" & index (name, "<") ^= 0 then go to lesserr; 251 252 do position = 1 repeat (position + 1) while (substr (name, position, 1) = "<"); 253 if wdir_length < 1 254 then go to lesserr; 255 256 wdir_length = wdir_length - index (reverse (substr (working_directory, 1, wdir_length)), ">"); 257 end; 258 259 wdir_length = max (1, wdir_length); /* must be at least 1 char for ">" (root) */ 260 261 if substr (name, position) = "" /* null is special */ 262 then name = substr (working_directory, 1, wdir_length); 263 else do; 264 if wdir_length = 1 265 then wdir_length = 0; /* the root has null name */ 266 267 if length (name) - wdir_length - position + 1 >= 0 268 then if substr (name, length (name) - wdir_length - position + 1) ^= "" 269 then go to pathlong; /* don't lose nonblanks */ 270 271 name = substr (working_directory, 1, wdir_length) || ">" || substr (name, position); 272 end; 273 end; 274 275 if index (name, "<") ^= 0 276 then go to badpath; 277 278 if index (name, ">>") ^= 0 279 then go to badpath; 280 281 dir_length = length (name) - index (reverse (name), ">") - 1 + 1; 282 283 if substr (name, dir_length + 1) = ">" 284 then if name ^= ">" /* special-case the root */ 285 then go to badpath; /* pathname ends in ">" */ 286 287 if dir_length > length (dname) 288 then if substr (name, dir_length + 1) ^= "" 289 then go to pathlong; 290 291 dname = substr (name, 1, dir_length); 292 if dname = "" 293 then dname = ">"; /* special-case the root */ 294 295 ename_idx = dir_length + 2; /* step over dname and ">" */ 296 297 /* Look for archive component specification. */ 298 299 ename_len = index (substr (name, ename_idx), "::") - 1; 300 if ename_len = -1 301 then do; 302 if length (name) - ename_idx + 1 > length (ename) 303 then if substr (name, ename_idx + length (ename)) ^= "" 304 then go to entlong; 305 306 ename = substr (name, ename_idx); 307 cname = ""; 308 archive_path = "0"b; 309 return; 310 end; 311 else if ename_len = 0 then go to badpath; 312 else archive_path = "1"b; 313 314 if ename_len > length (ename) 315 then go to entlong; 316 317 ename = substr (name, ename_idx, ename_len); 318 319 if length (name) - (ename_idx + ename_len + 2) + 1 > length (cname) 320 then if substr (name, (ename_idx + ename_len + 2) + length (cname)) ^= "" 321 then go to entlong; 322 323 cname = substr (name, ename_idx + ename_len + 2); 324 return; 325 326 end /* expand */; 327 328 /* Procedure to add a suffix to an entryname */ 329 330 suffix: 331 procedure (p_name, p_suffix); 332 333 /* parameters */ 334 335 declare (p_name, p_suffix) char (*) parameter; 336 337 /* automatic */ 338 339 declare name_len fixed bin (21), 340 suffix char (32) varying; 341 342 /* program */ 343 344 if p_suffix = "" 345 then return; 346 347 suffix = "." || rtrim (p_suffix); 348 name_len = length (rtrim (p_name)); 349 350 if name_len > length (suffix) /* enough chars to have this suffix? */ 351 then if substr (p_name, name_len - length (suffix) + 1, length (suffix)) = suffix 352 then return; /* AOK...right suffix is there */ 353 if name_len + length (suffix) > length (p_name) 354 then go to entlong; 355 else substr (p_name, name_len + 1, length (suffix)) = suffix; 356 357 return; 358 359 end /* suffix */; 360 361 end /* expand_pathname_ */; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 06/29/00 1716.7 expand_pathname_.pl1 >udd>sm>ds>w>ml>expand_pathname_.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. absolute_pathname_ 000030 constant entry external dcl 162 ref 168 170 addr builtin function dcl 63 ref 246 246 archive_path 000100 automatic bit(1) dcl 51 set ref 79 95 109 123 178 308* 312* based_dname based char(168) packed unaligned dcl 152 set ref 168* 170* 181* based_ename based char(32) packed unaligned dcl 152 set ref 182* cname 000101 automatic char(32) packed unaligned dcl 51 set ref 114 126* 132 307* 319 319 323* dir_length 000222 automatic fixed bin(21,0) dcl 229 set ref 281* 283 287 287 291 295 dname 000111 automatic char(168) packed unaligned dcl 51 set ref 82 99 112 130 181 287 291* 292 292* ename 000163 automatic char(32) packed unaligned dcl 51 set ref 83 98* 100 109* 113 125* 128* 131 182 302 302 306* 314 317* ename_idx 000220 automatic fixed bin(21,0) dcl 229 set ref 295* 299 302 302 306 317 319 319 323 ename_len 000221 automatic fixed bin(21,0) dcl 229 set ref 299* 300 311 314 317 319 319 323 error_table_$archive_pathname 000012 external static fixed bin(35,0) dcl 68 ref 188 error_table_$badpath 000014 external static fixed bin(35,0) dcl 68 ref 192 error_table_$entlong 000016 external static fixed bin(35,0) dcl 68 ref 196 error_table_$lesserr 000020 external static fixed bin(35,0) dcl 68 ref 200 error_table_$no_wdir 000022 external static fixed bin(35,0) dcl 68 ref 204 error_table_$pathlong 000024 external static fixed bin(35,0) dcl 68 ref 208 error_table_$root 000026 external static fixed bin(35,0) dcl 68 ref 212 hcs_$fs_search_get_wdir 000010 constant entry external dcl 58 ref 246 index builtin function dcl 63 ref 250 256 275 278 281 299 length builtin function dcl 63 ref 239 239 239 267 267 281 287 302 302 302 314 319 319 319 348 350 350 350 353 353 355 max builtin function dcl 63 ref 259 name 000223 automatic char(202) packed unaligned dcl 229 set ref 239 239 243* 244 250 252 261 261* 267 267 267 271* 271 275 278 281 281 283 283 287 291 299 302 302 306 317 319 319 323 name_len 000370 automatic fixed bin(21,0) dcl 339 set ref 348* 350 350 353 355 null builtin function dcl 158 ref 166 p_cname parameter char packed unaligned dcl 42 set ref 104 114* 118 132* p_code parameter fixed bin(35,0) dcl 42 set ref 13 84* 87 101* 104 115* 118 133* 138 168* 170* 183* 188* 192* 196* 200* 204* 208* 212* p_dname parameter char packed unaligned dcl 42 set ref 13 82* 87 99* 104 112* 118 130* p_dname_ptr parameter pointer dcl 143 ref 138 168 170 181 p_ename parameter char packed unaligned dcl 42 set ref 13 83* 87 100* 104 113* 118 131* p_ename_ptr parameter pointer dcl 143 ref 138 166 182 p_name parameter char packed unaligned dcl 335 set ref 330 348 350 353 355* p_pathname parameter char packed unaligned dcl 225 in procedure "expand" ref 220 239 239 243 p_pathname parameter char packed unaligned dcl 42 in procedure "expand_pathname_" set ref 13 77* 87 90 91 93* 104 107* 118 121* p_relpath_len parameter fixed bin(21,0) dcl 143 ref 138 168 170 170 174 176 176 p_relpath_ptr parameter pointer dcl 143 ref 138 170 176 p_suffix parameter char packed unaligned dcl 42 in procedure "expand_pathname_" set ref 87 98* 118 126* 128* p_suffix parameter char packed unaligned dcl 335 in procedure "suffix" ref 330 344 347 position 000306 automatic fixed bin(21,0) dcl 229 set ref 252* 252* 257 261 267 267 271 relpath based char packed unaligned dcl 152 set ref 170* 176* reverse builtin function dcl 63 ref 256 281 rtrim builtin function dcl 63 ref 347 348 substr builtin function dcl 63 set ref 239 244 252 256 261 261 267 271 271 283 287 291 299 302 306 317 319 323 350 355* suffix 000371 automatic varying char(32) dcl 339 set ref 347* 350 350 350 350 353 355 355 wdir_length 000307 automatic fixed bin(21,0) dcl 229 set ref 246* 247 253 256* 256 256 259* 259 261 264 264* 267 267 271 working_directory 000310 automatic char(168) dcl 229 set ref 246 246 250 256 261 271 NAMES DECLARED BY EXPLICIT CONTEXT. archive_pathname 000654 constant label dcl 188 ref 79 95 178 badpath 000660 constant label dcl 192 ref 91 275 278 283 311 entlong 000664 constant label dcl 196 ref 302 314 319 353 expand 000710 constant entry internal dcl 220 ref 77 93 107 121 174 176 expand_path_ 000524 constant entry external dcl 138 expand_pathname_ 000023 constant entry external dcl 13 expand_pathname_$add_suffix 000112 constant entry external dcl 87 expand_pathname_$component 000235 constant entry external dcl 104 expand_pathname_$component_add_suffix 000350 constant entry external dcl 118 lesserr 000670 constant label dcl 200 ref 250 253 no_wdir 000674 constant label dcl 204 ref 247 pathlong 000700 constant label dcl 208 ref 239 267 287 root 000704 constant label dcl 212 ref 90 suffix 001340 constant entry internal dcl 330 ref 98 109 125 126 128 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1726 1760 1506 1736 Length 2156 1506 32 162 220 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME expand_pathname_ 313 external procedure is an external procedure. expand internal procedure shares stack frame of external procedure expand_pathname_. suffix internal procedure shares stack frame of external procedure expand_pathname_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME expand_pathname_ 000100 archive_path expand_pathname_ 000101 cname expand_pathname_ 000111 dname expand_pathname_ 000163 ename expand_pathname_ 000220 ename_idx expand 000221 ename_len expand 000222 dir_length expand 000223 name expand 000306 position expand 000307 wdir_length expand 000310 working_directory expand 000370 name_len suffix 000371 suffix suffix THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out return_mac shorten_stack ext_entry ext_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. absolute_pathname_ hcs_$fs_search_get_wdir THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$archive_pathname error_table_$badpath error_table_$entlong error_table_$lesserr error_table_$no_wdir error_table_$pathlong error_table_$root CONSTANTS 001462 aa 000002000000 001463 aa 000002000000 001464 aa 600000000041 001465 aa 000415000000 001466 ta 000002000000 001467 aa 000000000000 001470 aa 000004000000 001471 aa 000004000000 001472 aa 600000000041 001473 aa 000163000000 001474 aa 600000000041 001475 aa 000432000000 001476 ta 000004000000 001477 aa 000000000000 001500 ta 000003000000 001501 aa 000000000000 001502 aa 056 000 000 000 . 001503 aa 777777777777 001504 aa 074 000 000 000 < 000000 aa 526000000000 000001 aa 526000000250 000002 aa 524000000000 000003 aa 524000000007 000004 aa 526000000040 001505 aa 076 000 000 000 > 000005 aa 404000000025 000006 aa 464000000000 000007 aa 404000000043 000010 aa 526077777777 000012 aa 077777000043 000013 aa 000001000000 000014 aa 141 162 143 150 arch 000015 aa 151 166 145 000 ive BEGIN PROCEDURE expand_pathname_ ENTRY TO expand_pathname_ STATEMENT 1 ON LINE 13 expand_pathname_: procedure (p_pathname, p_dname, p_ename, p_code); 000016 at 000004000010 000017 tt 000010000010 000020 ta 000007000000 000021 ta 000016000000 000022 da 000117300000 000023 aa 000500 6270 00 eax7 320 000024 aa 7 00034 3521 20 epp2 pr7|28,* 000025 aa 2 01046 2721 00 tsp2 pr2|550 ext_entry_desc 000026 aa 000010000000 000027 aa 000000000000 000030 aa 6 00042 3735 20 epp7 pr6|34,* 000031 aa 7 00000 2361 20 ldq pr7|0,* 000032 aa 000002 6040 04 tmi 2,ic 000034 000033 aa 777777 3760 07 anq 262143,dl 000034 aa 0 00250 3761 00 anq pr0|168 = 000077777777 000035 aa 6 00402 7561 00 stq pr6|258 000036 aa 6 00032 3715 20 epp5 pr6|26,* 000037 aa 5 00004 3535 20 epp3 pr5|4,* 000040 aa 6 00176 2535 00 spri3 pr6|126 000041 aa 7 00002 3515 20 epp1 pr7|2,* 000042 aa 6 00174 2515 00 spri1 pr6|124 000043 aa 5 00006 3535 20 epp3 pr5|6,* 000044 aa 6 00202 2535 00 spri3 pr6|130 000045 aa 7 00004 3515 20 epp1 pr7|4,* 000046 aa 6 00200 2515 00 spri1 pr6|128 000047 aa 5 00010 3535 20 epp3 pr5|8,* 000050 aa 6 00210 2535 00 spri3 pr6|136 STATEMENT 1 ON LINE 77 call expand (p_pathname); 000051 aa 5 00002 3521 20 epp2 pr5|2,* p_pathname 000052 aa 6 00406 2521 00 spri2 pr6|262 000053 aa 7 00000 3521 20 epp2 pr7|0,* 000054 aa 6 00410 2521 00 spri2 pr6|264 000055 aa 6 00404 3521 00 epp2 pr6|260 000056 aa 004000 4310 07 fld 2048,dl 000057 aa 2 00000 7571 00 staq pr2|0 000060 aa 000630 6700 04 tsp4 408,ic 000710 STATEMENT 1 ON LINE 79 if archive_path then go to archive_pathname; 000061 aa 6 00100 2351 00 lda pr6|64 archive_path 000062 aa 000572 6010 04 tnz 378,ic 000654 STATEMENT 1 ON LINE 82 p_dname = dname; 000063 aa 6 00174 2361 20 ldq pr6|124,* 000064 aa 000002 6040 04 tmi 2,ic 000066 000065 aa 777777 3760 07 anq 262143,dl 000066 aa 0 00250 3761 00 anq pr0|168 = 000077777777 000067 aa 6 00176 3735 20 epp7 pr6|126,* 000070 aa 040 140 100 500 mlr (pr),(pr,rl),fill(040) 000071 aa 6 00111 00 0250 desc9a pr6|73,168 dname 000072 aa 7 00000 00 0006 desc9a pr7|0,ql p_dname STATEMENT 1 ON LINE 83 p_ename = ename; 000073 aa 6 00200 2361 20 ldq pr6|128,* 000074 aa 000002 6040 04 tmi 2,ic 000076 000075 aa 777777 3760 07 anq 262143,dl 000076 aa 0 00250 3761 00 anq pr0|168 = 000077777777 000077 aa 6 00202 3715 20 epp5 pr6|130,* 000100 aa 040 140 100 500 mlr (pr),(pr,rl),fill(040) 000101 aa 6 00163 00 0040 desc9a pr6|115,32 ename 000102 aa 5 00000 00 0006 desc9a pr5|0,ql p_ename STATEMENT 1 ON LINE 84 p_code = 0; 000103 aa 6 00210 4501 20 stz pr6|136,* p_code STATEMENT 1 ON LINE 85 return; 000104 aa 0 00631 7101 00 tra pr0|409 return_mac ENTRY TO expand_pathname_$add_suffix STATEMENT 1 ON LINE 87 expand_pathname_$add_suffix: entry (p_pathname, p_suffix, p_dname, p_ename, p_code); 000105 at 000005000010 000106 tt 000010000010 000107 tt 000010000007 000110 ta 000105000000 000111 da 000137300000 000112 aa 000500 6270 00 eax7 320 000113 aa 7 00034 3521 20 epp2 pr7|28,* 000114 aa 2 01046 2721 00 tsp2 pr2|550 ext_entry_desc 000115 aa 000012000000 000116 aa 000000000000 000117 aa 6 00042 3735 20 epp7 pr6|34,* 000120 aa 7 00000 2361 20 ldq pr7|0,* 000121 aa 000002 6040 04 tmi 2,ic 000123 000122 aa 777777 3760 07 anq 262143,dl 000123 aa 0 00250 3761 00 anq pr0|168 = 000077777777 000124 aa 6 00402 7561 00 stq pr6|258 000125 aa 7 00002 2361 20 ldq pr7|2,* 000126 aa 000002 6040 04 tmi 2,ic 000130 000127 aa 777777 3760 07 anq 262143,dl 000130 aa 0 00250 3761 00 anq pr0|168 = 000077777777 000131 aa 6 00414 7561 00 stq pr6|268 000132 aa 6 00032 3715 20 epp5 pr6|26,* 000133 aa 5 00006 3535 20 epp3 pr5|6,* 000134 aa 6 00176 2535 00 spri3 pr6|126 000135 aa 7 00004 3515 20 epp1 pr7|4,* 000136 aa 6 00174 2515 00 spri1 pr6|124 000137 aa 5 00010 3535 20 epp3 pr5|8,* 000140 aa 6 00202 2535 00 spri3 pr6|130 000141 aa 7 00006 3515 20 epp1 pr7|6,* 000142 aa 6 00200 2515 00 spri1 pr6|128 000143 aa 5 00012 3535 20 epp3 pr5|10,* 000144 aa 6 00210 2535 00 spri3 pr6|136 STATEMENT 1 ON LINE 90 if p_pathname = ">" then go to root; 000145 aa 6 00032 3735 20 epp7 pr6|26,* 000146 aa 7 00002 3715 20 epp5 pr7|2,* 000147 aa 6 00402 2351 00 lda pr6|258 000150 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 000151 aa 5 00000 00 0005 desc9a pr5|0,al p_pathname 000152 aa 001335 00 0001 desc9a 733,1 001505 = 076000000000 000153 aa 000531 6000 04 tze 345,ic 000704 STATEMENT 1 ON LINE 91 if p_pathname = "" then go to badpath; 000154 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 000155 aa 5 00000 00 0005 desc9a pr5|0,al p_pathname 000156 aa 001326 00 0000 desc9a 726,0 001502 = 056000000000 000157 aa 000501 6000 04 tze 321,ic 000660 STATEMENT 1 ON LINE 93 call expand (p_pathname); 000160 aa 7 00002 3521 20 epp2 pr7|2,* p_pathname 000161 aa 6 00406 2521 00 spri2 pr6|262 000162 aa 6 00042 3535 20 epp3 pr6|34,* 000163 aa 3 00000 3521 20 epp2 pr3|0,* 000164 aa 6 00410 2521 00 spri2 pr6|264 000165 aa 6 00404 3521 00 epp2 pr6|260 000166 aa 004000 4310 07 fld 2048,dl 000167 aa 2 00000 7571 00 staq pr2|0 000170 aa 000520 6700 04 tsp4 336,ic 000710 STATEMENT 1 ON LINE 95 if archive_path then go to archive_pathname; 000171 aa 6 00100 2351 00 lda pr6|64 archive_path 000172 aa 000462 6010 04 tnz 306,ic 000654 STATEMENT 1 ON LINE 98 call suffix (ename, p_suffix); 000173 aa 6 00163 3521 00 epp2 pr6|115 ename 000174 aa 6 00420 2521 00 spri2 pr6|272 000175 aa 6 00032 3735 20 epp7 pr6|26,* 000176 aa 7 00004 3521 20 epp2 pr7|4,* p_suffix 000177 aa 6 00422 2521 00 spri2 pr6|274 000200 aa 777604 3520 04 epp2 -124,ic 000004 = 526000000040 000201 aa 6 00424 2521 00 spri2 pr6|276 000202 aa 6 00042 3715 20 epp5 pr6|34,* 000203 aa 5 00002 3521 20 epp2 pr5|2,* 000204 aa 6 00426 2521 00 spri2 pr6|278 000205 aa 6 00416 3521 00 epp2 pr6|270 000206 aa 010000 4310 07 fld 4096,dl 000207 aa 2 00000 7571 00 staq pr2|0 000210 aa 001130 6700 04 tsp4 600,ic 001340 STATEMENT 1 ON LINE 99 p_dname = dname; 000211 aa 6 00174 2361 20 ldq pr6|124,* 000212 aa 000002 6040 04 tmi 2,ic 000214 000213 aa 777777 3760 07 anq 262143,dl 000214 aa 0 00250 3761 00 anq pr0|168 = 000077777777 000215 aa 6 00176 3735 20 epp7 pr6|126,* 000216 aa 040 140 100 500 mlr (pr),(pr,rl),fill(040) 000217 aa 6 00111 00 0250 desc9a pr6|73,168 dname 000220 aa 7 00000 00 0006 desc9a pr7|0,ql p_dname STATEMENT 1 ON LINE 100 p_ename = ename; 000221 aa 6 00200 2361 20 ldq pr6|128,* 000222 aa 000002 6040 04 tmi 2,ic 000224 000223 aa 777777 3760 07 anq 262143,dl 000224 aa 0 00250 3761 00 anq pr0|168 = 000077777777 000225 aa 6 00202 3715 20 epp5 pr6|130,* 000226 aa 040 140 100 500 mlr (pr),(pr,rl),fill(040) 000227 aa 6 00163 00 0040 desc9a pr6|115,32 ename 000230 aa 5 00000 00 0006 desc9a pr5|0,ql p_ename STATEMENT 1 ON LINE 101 p_code = 0; 000231 aa 6 00210 4501 20 stz pr6|136,* p_code STATEMENT 1 ON LINE 102 return; 000232 aa 0 00631 7101 00 tra pr0|409 return_mac ENTRY TO expand_pathname_$component STATEMENT 1 ON LINE 104 expand_pathname_$component: entry (p_pathname, p_dname, p_ename, p_cname, p_code); 000233 ta 000105000000 000234 da 000157300000 000235 aa 000500 6270 00 eax7 320 000236 aa 7 00034 3521 20 epp2 pr7|28,* 000237 aa 2 01046 2721 00 tsp2 pr2|550 ext_entry_desc 000240 aa 000012000000 000241 aa 000000000000 000242 aa 6 00042 3735 20 epp7 pr6|34,* 000243 aa 7 00000 2361 20 ldq pr7|0,* 000244 aa 000002 6040 04 tmi 2,ic 000246 000245 aa 777777 3760 07 anq 262143,dl 000246 aa 0 00250 3761 00 anq pr0|168 = 000077777777 000247 aa 6 00402 7561 00 stq pr6|258 000250 aa 6 00032 3715 20 epp5 pr6|26,* 000251 aa 5 00004 3535 20 epp3 pr5|4,* 000252 aa 6 00176 2535 00 spri3 pr6|126 000253 aa 7 00002 3515 20 epp1 pr7|2,* 000254 aa 6 00174 2515 00 spri1 pr6|124 000255 aa 5 00006 3535 20 epp3 pr5|6,* 000256 aa 6 00202 2535 00 spri3 pr6|130 000257 aa 7 00004 3515 20 epp1 pr7|4,* 000260 aa 6 00200 2515 00 spri1 pr6|128 000261 aa 5 00010 3535 20 epp3 pr5|8,* 000262 aa 6 00206 2535 00 spri3 pr6|134 000263 aa 7 00006 3515 20 epp1 pr7|6,* 000264 aa 6 00204 2515 00 spri1 pr6|132 000265 aa 5 00012 3535 20 epp3 pr5|10,* 000266 aa 6 00210 2535 00 spri3 pr6|136 STATEMENT 1 ON LINE 107 call expand (p_pathname); 000267 aa 6 00032 3735 20 epp7 pr6|26,* 000270 aa 7 00002 3521 20 epp2 pr7|2,* p_pathname 000271 aa 6 00406 2521 00 spri2 pr6|262 000272 aa 6 00042 3715 20 epp5 pr6|34,* 000273 aa 5 00000 3521 20 epp2 pr5|0,* 000274 aa 6 00410 2521 00 spri2 pr6|264 000275 aa 6 00404 3521 00 epp2 pr6|260 000276 aa 004000 4310 07 fld 2048,dl 000277 aa 2 00000 7571 00 staq pr2|0 000300 aa 000410 6700 04 tsp4 264,ic 000710 STATEMENT 1 ON LINE 109 if archive_path then call suffix (ename, "archive"); 000301 aa 6 00100 2351 00 lda pr6|64 archive_path 000302 aa 000006 6000 04 tze 6,ic 000310 000303 aa 777511 2370 04 ldaq -183,ic 000014 = 141162143150 151166145000 000304 aa 6 00432 7571 00 staq pr6|282 000305 aa 001163 3520 04 epp2 627,ic 001470 = 000004000000 000306 aa 2 00000 2351 00 lda pr2|0 000307 aa 001031 6700 04 tsp4 537,ic 001340 STATEMENT 1 ON LINE 112 p_dname = dname; 000310 aa 6 00174 2361 20 ldq pr6|124,* 000311 aa 000002 6040 04 tmi 2,ic 000313 000312 aa 777777 3760 07 anq 262143,dl 000313 aa 0 00250 3761 00 anq pr0|168 = 000077777777 000314 aa 6 00176 3735 20 epp7 pr6|126,* 000315 aa 040 140 100 500 mlr (pr),(pr,rl),fill(040) 000316 aa 6 00111 00 0250 desc9a pr6|73,168 dname 000317 aa 7 00000 00 0006 desc9a pr7|0,ql p_dname STATEMENT 1 ON LINE 113 p_ename = ename; 000320 aa 6 00200 2361 20 ldq pr6|128,* 000321 aa 000002 6040 04 tmi 2,ic 000323 000322 aa 777777 3760 07 anq 262143,dl 000323 aa 0 00250 3761 00 anq pr0|168 = 000077777777 000324 aa 6 00202 3715 20 epp5 pr6|130,* 000325 aa 040 140 100 500 mlr (pr),(pr,rl),fill(040) 000326 aa 6 00163 00 0040 desc9a pr6|115,32 ename 000327 aa 5 00000 00 0006 desc9a pr5|0,ql p_ename STATEMENT 1 ON LINE 114 p_cname = cname; 000330 aa 6 00204 2361 20 ldq pr6|132,* 000331 aa 000002 6040 04 tmi 2,ic 000333 000332 aa 777777 3760 07 anq 262143,dl 000333 aa 0 00250 3761 00 anq pr0|168 = 000077777777 000334 aa 6 00206 3535 20 epp3 pr6|134,* 000335 aa 040 140 100 500 mlr (pr),(pr,rl),fill(040) 000336 aa 6 00101 00 0040 desc9a pr6|65,32 cname 000337 aa 3 00000 00 0006 desc9a pr3|0,ql p_cname STATEMENT 1 ON LINE 115 p_code = 0; 000340 aa 6 00210 4501 20 stz pr6|136,* p_code STATEMENT 1 ON LINE 116 return; 000341 aa 0 00631 7101 00 tra pr0|409 return_mac ENTRY TO expand_pathname_$component_add_s STATEMENT 1 ON LINE 118 expand_pathname_$component_add_suffix: entry (p_pathname, p_suffix, p_dname, p_ename, p_cname, p_code); 000342 at 000006000010 000343 tt 000010000010 000344 tt 000010000010 000345 ta 000007000000 000346 ta 000342000000 000347 da 000205300000 000350 aa 000500 6270 00 eax7 320 000351 aa 7 00034 3521 20 epp2 pr7|28,* 000352 aa 2 01046 2721 00 tsp2 pr2|550 ext_entry_desc 000353 aa 000014000000 000354 aa 000000000000 000355 aa 6 00042 3735 20 epp7 pr6|34,* 000356 aa 7 00000 2361 20 ldq pr7|0,* 000357 aa 000002 6040 04 tmi 2,ic 000361 000360 aa 777777 3760 07 anq 262143,dl 000361 aa 0 00250 3761 00 anq pr0|168 = 000077777777 000362 aa 6 00402 7561 00 stq pr6|258 000363 aa 7 00002 2361 20 ldq pr7|2,* 000364 aa 000002 6040 04 tmi 2,ic 000366 000365 aa 777777 3760 07 anq 262143,dl 000366 aa 0 00250 3761 00 anq pr0|168 = 000077777777 000367 aa 6 00414 7561 00 stq pr6|268 000370 aa 6 00032 3715 20 epp5 pr6|26,* 000371 aa 5 00006 3535 20 epp3 pr5|6,* 000372 aa 6 00176 2535 00 spri3 pr6|126 000373 aa 7 00004 3515 20 epp1 pr7|4,* 000374 aa 6 00174 2515 00 spri1 pr6|124 000375 aa 5 00010 3535 20 epp3 pr5|8,* 000376 aa 6 00202 2535 00 spri3 pr6|130 000377 aa 7 00006 3515 20 epp1 pr7|6,* 000400 aa 6 00200 2515 00 spri1 pr6|128 000401 aa 5 00012 3535 20 epp3 pr5|10,* 000402 aa 6 00206 2535 00 spri3 pr6|134 000403 aa 7 00010 3515 20 epp1 pr7|8,* 000404 aa 6 00204 2515 00 spri1 pr6|132 000405 aa 5 00014 3535 20 epp3 pr5|12,* 000406 aa 6 00210 2535 00 spri3 pr6|136 STATEMENT 1 ON LINE 121 call expand (p_pathname); 000407 aa 6 00032 3735 20 epp7 pr6|26,* 000410 aa 7 00002 3521 20 epp2 pr7|2,* p_pathname 000411 aa 6 00406 2521 00 spri2 pr6|262 000412 aa 6 00042 3715 20 epp5 pr6|34,* 000413 aa 5 00000 3521 20 epp2 pr5|0,* 000414 aa 6 00410 2521 00 spri2 pr6|264 000415 aa 6 00404 3521 00 epp2 pr6|260 000416 aa 004000 4310 07 fld 2048,dl 000417 aa 2 00000 7571 00 staq pr2|0 000420 aa 000270 6700 04 tsp4 184,ic 000710 STATEMENT 1 ON LINE 123 if archive_path then do; 000421 aa 6 00100 2351 00 lda pr6|64 archive_path 000422 aa 000025 6000 04 tze 21,ic 000447 STATEMENT 1 ON LINE 125 call suffix (ename, "archive"); 000423 aa 777371 2370 04 ldaq -263,ic 000014 = 141162143150 151166145000 000424 aa 6 00432 7571 00 staq pr6|282 000425 aa 001043 3520 04 epp2 547,ic 001470 = 000004000000 000426 aa 2 00000 2351 00 lda pr2|0 000427 aa 000711 6700 04 tsp4 457,ic 001340 STATEMENT 1 ON LINE 126 call suffix (cname, p_suffix); 000430 aa 6 00101 3521 00 epp2 pr6|65 cname 000431 aa 6 00420 2521 00 spri2 pr6|272 000432 aa 6 00032 3735 20 epp7 pr6|26,* 000433 aa 7 00004 3521 20 epp2 pr7|4,* p_suffix 000434 aa 6 00422 2521 00 spri2 pr6|274 000435 aa 777347 3520 04 epp2 -281,ic 000004 = 526000000040 000436 aa 6 00424 2521 00 spri2 pr6|276 000437 aa 6 00042 3715 20 epp5 pr6|34,* 000440 aa 5 00002 3521 20 epp2 pr5|2,* 000441 aa 6 00426 2521 00 spri2 pr6|278 000442 aa 6 00416 3521 00 epp2 pr6|270 000443 aa 010000 4310 07 fld 4096,dl 000444 aa 2 00000 7571 00 staq pr2|0 000445 aa 000673 6700 04 tsp4 443,ic 001340 STATEMENT 1 ON LINE 127 end; 000446 aa 000017 7100 04 tra 15,ic 000465 STATEMENT 1 ON LINE 128 else call suffix (ename, p_suffix); 000447 aa 6 00163 3521 00 epp2 pr6|115 ename 000450 aa 6 00420 2521 00 spri2 pr6|272 000451 aa 6 00032 3735 20 epp7 pr6|26,* 000452 aa 7 00004 3521 20 epp2 pr7|4,* p_suffix 000453 aa 6 00422 2521 00 spri2 pr6|274 000454 aa 777330 3520 04 epp2 -296,ic 000004 = 526000000040 000455 aa 6 00424 2521 00 spri2 pr6|276 000456 aa 6 00042 3715 20 epp5 pr6|34,* 000457 aa 5 00002 3521 20 epp2 pr5|2,* 000460 aa 6 00426 2521 00 spri2 pr6|278 000461 aa 6 00416 3521 00 epp2 pr6|270 000462 aa 010000 4310 07 fld 4096,dl 000463 aa 2 00000 7571 00 staq pr2|0 000464 aa 000654 6700 04 tsp4 428,ic 001340 STATEMENT 1 ON LINE 130 p_dname = dname; 000465 aa 6 00174 2361 20 ldq pr6|124,* 000466 aa 000002 6040 04 tmi 2,ic 000470 000467 aa 777777 3760 07 anq 262143,dl 000470 aa 0 00250 3761 00 anq pr0|168 = 000077777777 000471 aa 6 00176 3735 20 epp7 pr6|126,* 000472 aa 040 140 100 500 mlr (pr),(pr,rl),fill(040) 000473 aa 6 00111 00 0250 desc9a pr6|73,168 dname 000474 aa 7 00000 00 0006 desc9a pr7|0,ql p_dname STATEMENT 1 ON LINE 131 p_ename = ename; 000475 aa 6 00200 2361 20 ldq pr6|128,* 000476 aa 000002 6040 04 tmi 2,ic 000500 000477 aa 777777 3760 07 anq 262143,dl 000500 aa 0 00250 3761 00 anq pr0|168 = 000077777777 000501 aa 6 00202 3715 20 epp5 pr6|130,* 000502 aa 040 140 100 500 mlr (pr),(pr,rl),fill(040) 000503 aa 6 00163 00 0040 desc9a pr6|115,32 ename 000504 aa 5 00000 00 0006 desc9a pr5|0,ql p_ename STATEMENT 1 ON LINE 132 p_cname = cname; 000505 aa 6 00204 2361 20 ldq pr6|132,* 000506 aa 000002 6040 04 tmi 2,ic 000510 000507 aa 777777 3760 07 anq 262143,dl 000510 aa 0 00250 3761 00 anq pr0|168 = 000077777777 000511 aa 6 00206 3535 20 epp3 pr6|134,* 000512 aa 040 140 100 500 mlr (pr),(pr,rl),fill(040) 000513 aa 6 00101 00 0040 desc9a pr6|65,32 cname 000514 aa 3 00000 00 0006 desc9a pr3|0,ql p_cname STATEMENT 1 ON LINE 133 p_code = 0; 000515 aa 6 00210 4501 20 stz pr6|136,* p_code STATEMENT 1 ON LINE 134 return; 000516 aa 0 00631 7101 00 tra pr0|409 return_mac ENTRY TO expand_path_ STATEMENT 1 ON LINE 138 expand_path_: entry (p_relpath_ptr, p_relpath_len, p_dname_ptr, p_ename_ptr, p_code); 000517 at 000005000006 000520 tt 000005000006 000521 tt 000006000007 000522 ta 000517000000 000523 da 000214300000 000524 aa 000500 6270 00 eax7 320 000525 aa 7 00034 3521 20 epp2 pr7|28,* 000526 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000527 aa 000012000000 000530 aa 000000000000 000531 aa 6 00032 3735 20 epp7 pr6|26,* 000532 aa 7 00012 3715 20 epp5 pr7|10,* 000533 aa 6 00210 6515 00 spri5 pr6|136 STATEMENT 1 ON LINE 166 if p_ename_ptr = null then do; 000534 aa 6 00032 3735 20 epp7 pr6|26,* 000535 aa 7 00010 2371 20 ldaq pr7|8,* p_ename_ptr 000536 aa 777254 6770 04 eraq -340,ic 000012 = 077777000043 000001000000 000537 aa 0 00460 3771 00 anaq pr0|304 = 077777000077 777777077077 000540 aa 000054 6010 04 tnz 44,ic 000614 STATEMENT 1 ON LINE 168 if p_relpath_len<=0 then call absolute_pathname_ ("", based_dname, p_code); 000541 aa 7 00004 2361 20 ldq pr7|4,* p_relpath_len 000542 aa 000024 6054 04 tpnz 20,ic 000566 000543 aa 6 00415 3521 00 epp2 pr6|269 000544 aa 6 00436 2521 00 spri2 pr6|286 000545 aa 7 00006 3715 20 epp5 pr7|6,* p_dname_ptr 000546 aa 5 00000 3521 20 epp2 pr5|0,* based_dname 000547 aa 6 00440 2521 00 spri2 pr6|288 000550 aa 6 00210 3521 20 epp2 pr6|136,* p_code 000551 aa 6 00442 2521 00 spri2 pr6|290 000552 aa 777230 3520 04 epp2 -360,ic 000002 = 524000000000 000553 aa 6 00444 2521 00 spri2 pr6|292 000554 aa 777225 3520 04 epp2 -363,ic 000001 = 526000000250 000555 aa 6 00446 2521 00 spri2 pr6|294 000556 aa 777231 3520 04 epp2 -359,ic 000007 = 404000000043 000557 aa 6 00450 2521 00 spri2 pr6|296 000560 aa 6 00434 6211 00 eax1 pr6|284 000561 aa 014000 4310 07 fld 6144,dl 000562 aa 6 00044 3701 20 epp4 pr6|36,* 000563 la 4 00030 3521 20 epp2 pr4|24,* absolute_pathname_ 000564 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc 000565 aa 000026 7100 04 tra 22,ic 000613 STATEMENT 1 ON LINE 170 else call absolute_pathname_ (relpath, based_dname, p_code); 000566 aa 526000 2760 03 orq 175104,du 000567 aa 6 00415 7561 00 stq pr6|269 000570 aa 7 00002 3715 20 epp5 pr7|2,* p_relpath_ptr 000571 aa 5 00000 3521 20 epp2 pr5|0,* relpath 000572 aa 6 00436 2521 00 spri2 pr6|286 000573 aa 7 00006 3535 20 epp3 pr7|6,* p_dname_ptr 000574 aa 3 00000 3521 20 epp2 pr3|0,* based_dname 000575 aa 6 00440 2521 00 spri2 pr6|288 000576 aa 6 00210 3521 20 epp2 pr6|136,* p_code 000577 aa 6 00442 2521 00 spri2 pr6|290 000600 aa 6 00415 3521 00 epp2 pr6|269 000601 aa 6 00444 2521 00 spri2 pr6|292 000602 aa 777177 3520 04 epp2 -385,ic 000001 = 526000000250 000603 aa 6 00446 2521 00 spri2 pr6|294 000604 aa 777203 3520 04 epp2 -381,ic 000007 = 404000000043 000605 aa 6 00450 2521 00 spri2 pr6|296 000606 aa 6 00434 6211 00 eax1 pr6|284 000607 aa 014000 4310 07 fld 6144,dl 000610 aa 6 00044 3701 20 epp4 pr6|36,* 000611 la 4 00030 3521 20 epp2 pr4|24,* absolute_pathname_ 000612 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 171 return; 000613 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 172 end; STATEMENT 1 ON LINE 174 if p_relpath_len <= 0 then call expand(""); 000614 aa 7 00004 2361 20 ldq pr7|4,* p_relpath_len 000615 aa 000005 6054 04 tpnz 5,ic 000622 000616 aa 000644 3520 04 epp2 420,ic 001462 = 000002000000 000617 aa 2 00000 2351 00 lda pr2|0 000620 aa 000070 6700 04 tsp4 56,ic 000710 000621 aa 000014 7100 04 tra 12,ic 000635 STATEMENT 1 ON LINE 176 else call expand (relpath); 000622 aa 526000 2760 03 orq 175104,du 000623 aa 6 00415 7561 00 stq pr6|269 000624 aa 7 00002 3715 20 epp5 pr7|2,* p_relpath_ptr 000625 aa 5 00000 3521 20 epp2 pr5|0,* relpath 000626 aa 6 00406 2521 00 spri2 pr6|262 000627 aa 6 00415 3521 00 epp2 pr6|269 000630 aa 6 00410 2521 00 spri2 pr6|264 000631 aa 6 00404 3521 00 epp2 pr6|260 000632 aa 004000 4310 07 fld 2048,dl 000633 aa 2 00000 7571 00 staq pr2|0 000634 aa 000054 6700 04 tsp4 44,ic 000710 STATEMENT 1 ON LINE 178 if archive_path then go to archive_pathname; 000635 aa 6 00100 2351 00 lda pr6|64 archive_path 000636 aa 000016 6010 04 tnz 14,ic 000654 STATEMENT 1 ON LINE 181 based_dname = dname; 000637 aa 6 00032 3735 20 epp7 pr6|26,* 000640 aa 7 00006 3715 20 epp5 pr7|6,* p_dname_ptr 000641 aa 5 00000 3715 20 epp5 pr5|0,* p_dname_ptr 000642 aa 040 100 100 500 mlr (pr),(pr),fill(040) 000643 aa 6 00111 00 0250 desc9a pr6|73,168 dname 000644 aa 5 00000 00 0250 desc9a pr5|0,168 based_dname STATEMENT 1 ON LINE 182 based_ename = ename; 000645 aa 7 00010 3535 20 epp3 pr7|8,* p_ename_ptr 000646 aa 3 00000 3535 20 epp3 pr3|0,* p_ename_ptr 000647 aa 040 100 100 500 mlr (pr),(pr),fill(040) 000650 aa 6 00163 00 0040 desc9a pr6|115,32 ename 000651 aa 3 00000 00 0040 desc9a pr3|0,32 based_ename STATEMENT 1 ON LINE 183 p_code = 0; 000652 aa 6 00210 4501 20 stz pr6|136,* p_code STATEMENT 1 ON LINE 184 return; 000653 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 188 archive_pathname: p_code = error_table_$archive_pathname; 000654 aa 6 00044 3701 20 epp4 pr6|36,* 000655 la 4 00012 2361 20 ldq pr4|10,* error_table_$archive_pathname 000656 aa 6 00210 7561 20 stq pr6|136,* p_code STATEMENT 1 ON LINE 190 return; 000657 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 192 badpath: p_code = error_table_$badpath; 000660 aa 6 00044 3701 20 epp4 pr6|36,* 000661 la 4 00014 2361 20 ldq pr4|12,* error_table_$badpath 000662 aa 6 00210 7561 20 stq pr6|136,* p_code STATEMENT 1 ON LINE 194 return; 000663 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 196 entlong: p_code = error_table_$entlong; 000664 aa 6 00044 3701 20 epp4 pr6|36,* 000665 la 4 00016 2361 20 ldq pr4|14,* error_table_$entlong 000666 aa 6 00210 7561 20 stq pr6|136,* p_code STATEMENT 1 ON LINE 198 return; 000667 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 200 lesserr: p_code = error_table_$lesserr; 000670 aa 6 00044 3701 20 epp4 pr6|36,* 000671 la 4 00020 2361 20 ldq pr4|16,* error_table_$lesserr 000672 aa 6 00210 7561 20 stq pr6|136,* p_code STATEMENT 1 ON LINE 202 return; 000673 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 204 no_wdir: p_code = error_table_$no_wdir; 000674 aa 6 00044 3701 20 epp4 pr6|36,* 000675 la 4 00022 2361 20 ldq pr4|18,* error_table_$no_wdir 000676 aa 6 00210 7561 20 stq pr6|136,* p_code STATEMENT 1 ON LINE 206 return; 000677 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 208 pathlong: p_code = error_table_$pathlong; 000700 aa 6 00044 3701 20 epp4 pr6|36,* 000701 la 4 00024 2361 20 ldq pr4|20,* error_table_$pathlong 000702 aa 6 00210 7561 20 stq pr6|136,* p_code STATEMENT 1 ON LINE 210 return; 000703 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 212 root: p_code = error_table_$root; 000704 aa 6 00044 3701 20 epp4 pr6|36,* 000705 la 4 00026 2361 20 ldq pr4|22,* error_table_$root 000706 aa 6 00210 7561 20 stq pr6|136,* p_code STATEMENT 1 ON LINE 214 return; 000707 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 361 end /* expand_pathname_ */; BEGIN PROCEDURE expand ENTRY TO expand STATEMENT 1 ON LINE 220 expand: procedure (p_pathname); 000710 aa 6 00212 6501 00 spri4 pr6|138 000711 aa 6 00214 2521 00 spri2 pr6|140 000712 aa 2 00002 3521 01 epp2 pr2|2,au 000713 aa 6 00216 2521 00 spri2 pr6|142 000714 aa 2 00000 2361 20 ldq pr2|0,* 000715 aa 000002 6040 04 tmi 2,ic 000717 000716 aa 777777 3760 07 anq 262143,dl 000717 aa 0 00250 3761 00 anq pr0|168 = 000077777777 000720 aa 6 00452 7561 00 stq pr6|298 STATEMENT 1 ON LINE 239 if length (p_pathname) > length (name) then if substr (p_pathname, length (name) + 1) ^= "" then go to pathlong; 000721 aa 000312 1160 07 cmpq 202,dl 000722 aa 000010 6044 04 tmoz 8,ic 000732 000723 aa 000312 1760 07 sbq 202,dl 000724 aa 6 00214 3735 20 epp7 pr6|140,* 000725 aa 7 00002 3715 20 epp5 pr7|2,* 000726 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 000727 aa 5 00062 40 0006 desc9a pr5|50(2),ql p_pathname 000730 aa 000554 00 0000 desc9a 364,0 001502 = 056000000000 000731 aa 777747 6010 04 tnz -25,ic 000700 STATEMENT 1 ON LINE 243 name = p_pathname; 000732 aa 6 00214 3735 20 epp7 pr6|140,* 000733 aa 7 00002 3715 20 epp5 pr7|2,* 000734 aa 6 00452 2351 00 lda pr6|298 000735 aa 040 100 100 540 mlr (pr,rl),(pr),fill(040) 000736 aa 5 00000 00 0005 desc9a pr5|0,al p_pathname 000737 aa 6 00223 00 0312 desc9a pr6|147,202 name STATEMENT 1 ON LINE 244 if substr (name, 1, 1) ^= ">" then do; 000740 aa 6 00223 2351 00 lda pr6|147 name 000741 aa 0 00022 3771 00 anaq pr0|18 = 777000000000 000000000000 000742 aa 076000 1150 03 cmpa 31744,du 000743 aa 000160 6000 04 tze 112,ic 001123 STATEMENT 1 ON LINE 246 call hcs_$fs_search_get_wdir (addr (working_directory), wdir_length); 000744 aa 6 00310 3535 00 epp3 pr6|200 working_directory 000745 aa 6 00454 2535 00 spri3 pr6|300 000746 aa 6 00454 3521 00 epp2 pr6|300 000747 aa 6 00460 2521 00 spri2 pr6|304 000750 aa 6 00307 3521 00 epp2 pr6|199 wdir_length 000751 aa 6 00462 2521 00 spri2 pr6|306 000752 aa 6 00456 6211 00 eax1 pr6|302 000753 aa 010000 4310 07 fld 4096,dl 000754 aa 6 00044 3701 20 epp4 pr6|36,* 000755 la 4 00010 3521 20 epp2 pr4|8,* hcs_$fs_search_get_wdir 000756 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 247 if wdir_length = 0 then go to no_wdir; 000757 aa 6 00307 2361 00 ldq pr6|199 wdir_length 000760 aa 777714 6000 04 tze -52,ic 000674 STATEMENT 1 ON LINE 250 if working_directory = ">" & index (name, "<") ^= 0 then go to lesserr; 000761 aa 040 004 106 500 cmpc (pr),(ic),fill(040) 000762 aa 6 00310 00 0250 desc9a pr6|200,168 working_directory 000763 aa 000524 00 0001 desc9a 340,1 001505 = 076000000000 000764 aa 000012 6010 04 tnz 10,ic 000776 000765 aa 000 003 124 500 scm (pr),(du),mask(000) 000766 aa 6 00223 00 0312 desc9a pr6|147,202 name 000767 aa 074000 00 0001 desc9a 30720,1 000770 aa 6 00056 0001 00 arg pr6|46 000771 aa 6 00056 2361 00 ldq pr6|46 000772 aa 000002 6070 04 ttf 2,ic 000774 000773 aa 000001 3360 07 lcq 1,dl 000774 aa 000001 0760 07 adq 1,dl 000775 aa 777673 6010 04 tnz -69,ic 000670 STATEMENT 1 ON LINE 252 do position = 1 repeat (position + 1) while (substr (name, position, 1) = "<"); 000776 aa 000001 2360 07 ldq 1,dl 000777 aa 6 00306 7561 00 stq pr6|198 position 001000 aa 6 00306 2351 00 lda pr6|198 position 001001 aa 040 004 106 505 cmpc (pr,al),(ic),fill(040) 001002 aa 6 00222 60 0001 desc9a pr6|146(3),1 name 001003 aa 000503 00 0001 desc9a 323,1 001504 = 074000000000 001004 aa 000021 6010 04 tnz 17,ic 001025 STATEMENT 1 ON LINE 253 if wdir_length < 1 then go to lesserr; 001005 aa 6 00307 2361 00 ldq pr6|199 wdir_length 001006 aa 000001 1160 07 cmpq 1,dl 001007 aa 777661 6040 04 tmi -79,ic 000670 STATEMENT 1 ON LINE 256 wdir_length = wdir_length - index (reverse (substr (working_directory, 1, wdir_length)), ">"); 001010 aa 000 003 125 540 scmr (pr,rl),(du),mask(000) 001011 aa 6 00310 00 0006 desc9a pr6|200,ql working_directory 001012 aa 076000 00 0001 desc9a 31744,1 001013 aa 6 00056 0001 00 arg pr6|46 001014 aa 6 00056 2361 00 ldq pr6|46 001015 aa 000002 6070 04 ttf 2,ic 001017 001016 aa 000001 3360 07 lcq 1,dl 001017 aa 000001 0760 07 adq 1,dl 001020 aa 6 00453 7561 00 stq pr6|299 001021 aa 6 00453 3361 00 lcq pr6|299 001022 aa 6 00307 0561 00 asq pr6|199 wdir_length STATEMENT 1 ON LINE 257 end; 001023 aa 6 00306 0541 00 aos pr6|198 position 001024 aa 777754 7100 04 tra -20,ic 001000 STATEMENT 1 ON LINE 259 wdir_length = max (1, wdir_length); 001025 aa 000001 2360 07 ldq 1,dl 001026 aa 6 00307 1161 00 cmpq pr6|199 wdir_length 001027 aa 000002 6050 04 tpl 2,ic 001031 001030 aa 6 00307 2361 00 ldq pr6|199 wdir_length 001031 aa 6 00307 7561 00 stq pr6|199 wdir_length STATEMENT 1 ON LINE 261 if substr (name, position) = "" /* null is special */ then name = substr (working_directory, 1, wdir_length); 001032 aa 6 00306 2361 00 ldq pr6|198 position 001033 aa 000001 1760 07 sbq 1,dl 001034 aa 6 00453 7561 00 stq pr6|299 001035 aa 000312 2360 07 ldq 202,dl 001036 aa 6 00453 1761 00 sbq pr6|299 001037 aa 6 00453 7561 00 stq pr6|299 001040 aa 040 004 106 545 cmpc (pr,rl,al),(ic),fill(040) 001041 aa 6 00222 60 0006 desc9a pr6|146(3),ql name 001042 aa 000442 00 0000 desc9a 290,0 001502 = 056000000000 001043 aa 000006 6010 04 tnz 6,ic 001051 001044 aa 6 00307 2351 00 lda pr6|199 wdir_length 001045 aa 040 100 100 540 mlr (pr,rl),(pr),fill(040) 001046 aa 6 00310 00 0005 desc9a pr6|200,al working_directory 001047 aa 6 00223 00 0312 desc9a pr6|147,202 name 001050 aa 000053 7100 04 tra 43,ic 001123 STATEMENT 1 ON LINE 263 else do; STATEMENT 1 ON LINE 264 if wdir_length = 1 then wdir_length = 0; 001051 aa 6 00307 2361 00 ldq pr6|199 wdir_length 001052 aa 000001 1160 07 cmpq 1,dl 001053 aa 000002 6010 04 tnz 2,ic 001055 001054 aa 6 00307 4501 00 stz pr6|199 wdir_length STATEMENT 1 ON LINE 267 if length (name) - wdir_length - position + 1 >= 0 then if substr (name, length (name) - wdir_length - position + 1) ^= "" then go to pathlong; 001055 aa 000312 2360 07 ldq 202,dl 001056 aa 6 00307 1761 00 sbq pr6|199 wdir_length 001057 aa 6 00306 1761 00 sbq pr6|198 position 001060 aa 6 00464 7561 00 stq pr6|308 001061 aa 000001 0760 07 adq 1,dl 001062 aa 000010 6040 04 tmi 8,ic 001072 001063 aa 000312 2360 07 ldq 202,dl 001064 aa 6 00464 1761 00 sbq pr6|308 001065 aa 6 00464 2351 00 lda pr6|308 001066 aa 040 004 106 545 cmpc (pr,rl,al),(ic),fill(040) 001067 aa 6 00223 00 0006 desc9a pr6|147,ql name 001070 aa 000414 00 0000 desc9a 268,0 001502 = 056000000000 001071 aa 777607 6010 04 tnz -121,ic 000700 STATEMENT 1 ON LINE 271 name = substr (working_directory, 1, wdir_length) || ">" || substr (name, position); 001072 aa 6 00307 2361 00 ldq pr6|199 wdir_length 001073 aa 000001 0760 07 adq 1,dl 001074 aa 0 00551 7001 00 tsx0 pr0|361 alloc_char_temp 001075 aa 6 00307 2351 00 lda pr6|199 wdir_length 001076 aa 040 140 100 540 mlr (pr,rl),(pr,rl),fill(040) 001077 aa 6 00310 00 0005 desc9a pr6|200,al working_directory 001100 aa 2 00000 00 0005 desc9a pr2|0,al 001101 aa 040 105 100 404 mlr (ic),(pr,al),fill(040) 001102 aa 000404 00 0001 desc9a 260,1 001505 = 076000000000 001103 aa 2 00000 00 0001 desc9a pr2|0,1 001104 aa 6 00464 7561 00 stq pr6|308 001105 aa 6 00453 0761 00 adq pr6|299 001106 aa 6 00465 7561 00 stq pr6|309 001107 aa 0 00606 7001 00 tsx0 pr0|390 cat_realloc_chars 001110 aa 6 00464 2351 00 lda pr6|308 001111 aa 6 00306 2361 00 ldq pr6|198 position 001112 aa 6 00453 7271 00 lxl7 pr6|299 001113 aa 040 145 100 546 mlr (pr,rl,ql),(pr,rl,al),fill(040) 001114 aa 6 00222 60 0017 desc9a pr6|146(3),x7 name 001115 aa 2 00000 00 0017 desc9a pr2|0,x7 001116 aa 6 00465 2351 00 lda pr6|309 001117 aa 040 100 100 540 mlr (pr,rl),(pr),fill(040) 001120 aa 2 00000 00 0005 desc9a pr2|0,al 001121 aa 6 00223 00 0312 desc9a pr6|147,202 name STATEMENT 1 ON LINE 272 end; 001122 aa 0 01014 7001 00 tsx0 pr0|524 shorten_stack STATEMENT 1 ON LINE 273 end; STATEMENT 1 ON LINE 275 if index (name, "<") ^= 0 then go to badpath; 001123 aa 000 003 124 500 scm (pr),(du),mask(000) 001124 aa 6 00223 00 0312 desc9a pr6|147,202 name 001125 aa 074000 00 0001 desc9a 30720,1 001126 aa 6 00056 0001 00 arg pr6|46 001127 aa 6 00056 2361 00 ldq pr6|46 001130 aa 000002 6070 04 ttf 2,ic 001132 001131 aa 000001 3360 07 lcq 1,dl 001132 aa 000001 0760 07 adq 1,dl 001133 aa 777525 6010 04 tnz -171,ic 000660 STATEMENT 1 ON LINE 278 if index (name, ">>") ^= 0 then go to badpath; 001134 aa 000 003 120 500 scd (pr),(du) 001135 aa 6 00223 00 0312 desc9a pr6|147,202 name 001136 aa 076076 00 0002 desc9a 31806,2 001137 aa 6 00056 0001 00 arg pr6|46 001140 aa 6 00056 2361 00 ldq pr6|46 001141 aa 000002 6070 04 ttf 2,ic 001143 001142 aa 000001 3360 07 lcq 1,dl 001143 aa 000001 0760 07 adq 1,dl 001144 aa 777514 6010 04 tnz -180,ic 000660 STATEMENT 1 ON LINE 281 dir_length = length (name) - index (reverse (name), ">") - 1 + 1; 001145 aa 000 003 125 500 scmr (pr),(du),mask(000) 001146 aa 6 00223 00 0312 desc9a pr6|147,202 name 001147 aa 076000 00 0001 desc9a 31744,1 001150 aa 6 00056 0001 00 arg pr6|46 001151 aa 6 00056 2361 00 ldq pr6|46 001152 aa 000002 6070 04 ttf 2,ic 001154 001153 aa 000001 3360 07 lcq 1,dl 001154 aa 000001 0760 07 adq 1,dl 001155 aa 6 00465 7561 00 stq pr6|309 001156 aa 000312 2360 07 ldq 202,dl 001157 aa 6 00465 1761 00 sbq pr6|309 001160 aa 6 00222 7561 00 stq pr6|146 dir_length STATEMENT 1 ON LINE 283 if substr (name, dir_length + 1) = ">" then if name ^= ">" /* special-case the root */ then go to badpath; 001161 aa 000312 2360 07 ldq 202,dl 001162 aa 6 00222 1761 00 sbq pr6|146 dir_length 001163 aa 6 00465 7561 00 stq pr6|309 001164 aa 6 00222 2351 00 lda pr6|146 dir_length 001165 aa 040 004 106 545 cmpc (pr,rl,al),(ic),fill(040) 001166 aa 6 00223 00 0006 desc9a pr6|147,ql name 001167 aa 000320 00 0001 desc9a 208,1 001505 = 076000000000 001170 aa 000005 6010 04 tnz 5,ic 001175 001171 aa 040 004 106 500 cmpc (pr),(ic),fill(040) 001172 aa 6 00223 00 0312 desc9a pr6|147,202 name 001173 aa 000314 00 0001 desc9a 204,1 001505 = 076000000000 001174 aa 777464 6010 04 tnz -204,ic 000660 STATEMENT 1 ON LINE 287 if dir_length > length (dname) then if substr (name, dir_length + 1) ^= "" then go to pathlong; 001175 aa 6 00222 2361 00 ldq pr6|146 dir_length 001176 aa 000250 1160 07 cmpq 168,dl 001177 aa 000006 6044 04 tmoz 6,ic 001205 001200 aa 6 00465 7271 00 lxl7 pr6|309 001201 aa 040 004 106 545 cmpc (pr,rl,al),(ic),fill(040) 001202 aa 6 00223 00 0017 desc9a pr6|147,x7 name 001203 aa 000301 00 0000 desc9a 193,0 001502 = 056000000000 001204 aa 777474 6010 04 tnz -196,ic 000700 STATEMENT 1 ON LINE 291 dname = substr (name, 1, dir_length); 001205 aa 040 100 100 540 mlr (pr,rl),(pr),fill(040) 001206 aa 6 00223 00 0005 desc9a pr6|147,al name 001207 aa 6 00111 00 0250 desc9a pr6|73,168 dname STATEMENT 1 ON LINE 292 if dname = "" then dname = ">"; 001210 aa 040 004 106 500 cmpc (pr),(ic),fill(040) 001211 aa 6 00111 00 0250 desc9a pr6|73,168 dname 001212 aa 000272 00 0000 desc9a 186,0 001502 = 056000000000 001213 aa 000004 6010 04 tnz 4,ic 001217 001214 aa 040 100 100 404 mlr (ic),(pr),fill(040) 001215 aa 000271 00 0001 desc9a 185,1 001505 = 076000000000 001216 aa 6 00111 00 0250 desc9a pr6|73,168 dname STATEMENT 1 ON LINE 295 ename_idx = dir_length + 2; 001217 aa 000002 0760 07 adq 2,dl 001220 aa 6 00220 7561 00 stq pr6|144 ename_idx STATEMENT 1 ON LINE 299 ename_len = index (substr (name, ename_idx), "::") - 1; 001221 aa 000001 1760 07 sbq 1,dl 001222 aa 6 00465 7561 00 stq pr6|309 001223 aa 000312 2360 07 ldq 202,dl 001224 aa 6 00465 1761 00 sbq pr6|309 001225 aa 6 00220 2351 00 lda pr6|144 ename_idx 001226 aa 6 00465 7561 00 stq pr6|309 001227 aa 000 003 120 545 scd (pr,rl,al),(du) 001230 aa 6 00222 60 0006 desc9a pr6|146(3),ql name 001231 aa 072072 00 0002 desc9a 29754,2 001232 aa 6 00056 0001 00 arg pr6|46 001233 aa 6 00056 2361 00 ldq pr6|46 001234 aa 000002 6070 04 ttf 2,ic 001236 001235 aa 000001 3360 07 lcq 1,dl 001236 aa 6 00221 7561 00 stq pr6|145 ename_len STATEMENT 1 ON LINE 300 if ename_len = -1 then do; 001237 aa 000244 1160 04 cmpq 164,ic 001503 = 777777777777 001240 aa 000030 6010 04 tnz 24,ic 001270 STATEMENT 1 ON LINE 302 if length (name) - ename_idx + 1 > length (ename) then if substr (name, ename_idx + length (ename)) ^= "" then go to entlong; 001241 aa 000312 2360 07 ldq 202,dl 001242 aa 6 00220 1761 00 sbq pr6|144 ename_idx 001243 aa 000001 0760 07 adq 1,dl 001244 aa 000040 1160 07 cmpq 32,dl 001245 aa 000012 6044 04 tmoz 10,ic 001257 001246 aa 6 00220 2361 00 ldq pr6|144 ename_idx 001247 aa 000037 0760 07 adq 31,dl 001250 aa 6 00464 7561 00 stq pr6|308 001251 aa 000312 2360 07 ldq 202,dl 001252 aa 6 00464 1761 00 sbq pr6|308 001253 aa 040 004 106 545 cmpc (pr,rl,al),(ic),fill(040) 001254 aa 6 00232 60 0006 desc9a pr6|154(3),ql name 001255 aa 000227 00 0000 desc9a 151,0 001502 = 056000000000 001256 aa 777406 6010 04 tnz -250,ic 000664 STATEMENT 1 ON LINE 306 ename = substr (name, ename_idx); 001257 aa 6 00465 7271 00 lxl7 pr6|309 001260 aa 040 100 100 545 mlr (pr,rl,al),(pr),fill(040) 001261 aa 6 00222 60 0017 desc9a pr6|146(3),x7 name 001262 aa 6 00163 00 0040 desc9a pr6|115,32 ename STATEMENT 1 ON LINE 307 cname = ""; 001263 aa 040 100 100 400 mlr (),(pr),fill(040) 001264 aa 000000 00 0000 desc9a 0,0 001265 aa 6 00101 00 0040 desc9a pr6|65,32 cname STATEMENT 1 ON LINE 308 archive_path = "0"b; 001266 aa 6 00100 4501 00 stz pr6|64 archive_path STATEMENT 1 ON LINE 309 return; 001267 aa 6 00212 6101 00 rtcd pr6|138 STATEMENT 1 ON LINE 310 end; STATEMENT 1 ON LINE 311 else if ename_len = 0 then go to badpath; 001270 aa 6 00221 2361 00 ldq pr6|145 ename_len 001271 aa 777367 6000 04 tze -265,ic 000660 STATEMENT 1 ON LINE 312 else archive_path = "1"b; 001272 aa 400000 2350 03 lda 131072,du 001273 aa 6 00100 7551 00 sta pr6|64 archive_path STATEMENT 1 ON LINE 314 if ename_len > length (ename) then go to entlong; 001274 aa 000040 1160 07 cmpq 32,dl 001275 aa 777367 6054 04 tpnz -265,ic 000664 STATEMENT 1 ON LINE 317 ename = substr (name, ename_idx, ename_len); 001276 aa 6 00220 2361 00 ldq pr6|144 ename_idx 001277 aa 6 00221 2351 00 lda pr6|145 ename_len 001300 aa 040 100 100 546 mlr (pr,rl,ql),(pr),fill(040) 001301 aa 6 00222 60 0005 desc9a pr6|146(3),al name 001302 aa 6 00163 00 0040 desc9a pr6|115,32 ename STATEMENT 1 ON LINE 319 if length (name) - (ename_idx + ename_len + 2) + 1 > length (cname) then if substr (name, (ename_idx + ename_len + 2) + length (cname)) ^= "" then go to entlong; 001303 aa 6 00221 0761 00 adq pr6|145 ename_len 001304 aa 6 00465 7561 00 stq pr6|309 001305 aa 000002 0760 07 adq 2,dl 001306 aa 6 00464 7561 00 stq pr6|308 001307 aa 000312 2360 07 ldq 202,dl 001310 aa 6 00464 1761 00 sbq pr6|308 001311 aa 000001 0760 07 adq 1,dl 001312 aa 000040 1160 07 cmpq 32,dl 001313 aa 000013 6044 04 tmoz 11,ic 001326 001314 aa 6 00464 2361 00 ldq pr6|308 001315 aa 000037 0760 07 adq 31,dl 001316 aa 6 00453 7561 00 stq pr6|299 001317 aa 000312 2360 07 ldq 202,dl 001320 aa 6 00453 1761 00 sbq pr6|299 001321 aa 6 00465 2351 00 lda pr6|309 001322 aa 040 004 106 545 cmpc (pr,rl,al),(ic),fill(040) 001323 aa 6 00233 20 0006 desc9a pr6|155(1),ql name 001324 aa 000160 00 0000 desc9a 112,0 001502 = 056000000000 001325 aa 777337 6010 04 tnz -289,ic 000664 STATEMENT 1 ON LINE 323 cname = substr (name, ename_idx + ename_len + 2); 001326 aa 6 00464 2361 00 ldq pr6|308 001327 aa 000001 1760 07 sbq 1,dl 001330 aa 6 00464 7561 00 stq pr6|308 001331 aa 000312 2360 07 ldq 202,dl 001332 aa 6 00464 1761 00 sbq pr6|308 001333 aa 6 00465 2351 00 lda pr6|309 001334 aa 040 100 100 545 mlr (pr,rl,al),(pr),fill(040) 001335 aa 6 00223 20 0006 desc9a pr6|147(1),ql name 001336 aa 6 00101 00 0040 desc9a pr6|65,32 cname STATEMENT 1 ON LINE 324 return; 001337 aa 6 00212 6101 00 rtcd pr6|138 STATEMENT 1 ON LINE 326 end /* expand */; END PROCEDURE expand BEGIN PROCEDURE suffix ENTRY TO suffix STATEMENT 1 ON LINE 330 suffix: procedure (p_name, p_suffix); 001340 aa 6 00362 6501 00 spri4 pr6|242 001341 aa 6 00364 2521 00 spri2 pr6|244 001342 aa 2 00002 3521 01 epp2 pr2|2,au 001343 aa 6 00366 2521 00 spri2 pr6|246 001344 aa 2 00000 2361 20 ldq pr2|0,* 001345 aa 000002 6040 04 tmi 2,ic 001347 001346 aa 777777 3760 07 anq 262143,dl 001347 aa 0 00250 3761 00 anq pr0|168 = 000077777777 001350 aa 6 00466 7561 00 stq pr6|310 001351 aa 2 00002 2361 20 ldq pr2|2,* 001352 aa 000002 6040 04 tmi 2,ic 001354 001353 aa 777777 3760 07 anq 262143,dl 001354 aa 0 00250 3761 00 anq pr0|168 = 000077777777 001355 aa 6 00467 7561 00 stq pr6|311 STATEMENT 1 ON LINE 344 if p_suffix = "" then return; 001356 aa 6 00364 3735 20 epp7 pr6|244,* 001357 aa 7 00004 3715 20 epp5 pr7|4,* 001360 aa 040 004 106 540 cmpc (pr,rl),(ic),fill(040) 001361 aa 5 00000 00 0006 desc9a pr5|0,ql p_suffix 001362 aa 000122 00 0000 desc9a 82,0 001502 = 056000000000 001363 aa 000002 6010 04 tnz 2,ic 001365 001364 aa 6 00362 6101 00 rtcd pr6|242 STATEMENT 1 ON LINE 347 suffix = "." || rtrim (p_suffix); 001365 aa 000 000 165 540 tctr (pr,rl) 001366 aa 5 00000 00 0006 desc9a pr5|0,ql p_suffix 001367 aa 0 76605 0001 00 arg pr0|-635 = 777777777777 001370 aa 6 00056 0001 00 arg pr6|46 001371 aa 6 00056 2361 00 ldq pr6|46 001372 aa 0 00242 3761 00 anq pr0|162 = 000777777777 001373 aa 6 00470 7561 00 stq pr6|312 001374 aa 6 00467 2361 00 ldq pr6|311 001375 aa 6 00470 1761 00 sbq pr6|312 001376 aa 6 00470 7561 00 stq pr6|312 001377 aa 000001 0760 07 adq 1,dl 001400 aa 0 00551 7001 00 tsx0 pr0|361 alloc_char_temp 001401 aa 040 100 100 404 mlr (ic),(pr),fill(040) 001402 aa 000101 00 0001 desc9a 65,1 001502 = 056000000000 001403 aa 2 00000 00 0001 desc9a pr2|0,1 001404 aa 6 00470 2351 00 lda pr6|312 001405 aa 040 140 100 540 mlr (pr,rl),(pr,rl),fill(040) 001406 aa 5 00000 00 0005 desc9a pr5|0,al p_suffix 001407 aa 2 00000 20 0005 desc9a pr2|0(1),al 001410 aa 000040 1160 07 cmpq 32,dl 001411 aa 000002 6040 04 tmi 2,ic 001413 001412 aa 000040 2360 07 ldq 32,dl 001413 aa 6 00371 7561 00 stq pr6|249 suffix 001414 aa 040 140 100 540 mlr (pr,rl),(pr,rl),fill(040) 001415 aa 2 00000 00 0006 desc9a pr2|0,ql 001416 aa 6 00372 00 0006 desc9a pr6|250,ql suffix STATEMENT 1 ON LINE 348 name_len = length (rtrim (p_name)); 001417 aa 0 01014 7001 00 tsx0 pr0|524 shorten_stack 001420 aa 7 00002 3535 20 epp3 pr7|2,* 001421 aa 6 00466 2361 00 ldq pr6|310 001422 aa 000 000 165 540 tctr (pr,rl) 001423 aa 3 00000 00 0006 desc9a pr3|0,ql p_name 001424 aa 0 76605 0001 00 arg pr0|-635 = 777777777777 001425 aa 6 00056 0001 00 arg pr6|46 001426 aa 6 00056 2361 00 ldq pr6|46 001427 aa 0 00242 3761 00 anq pr0|162 = 000777777777 001430 aa 6 00470 7561 00 stq pr6|312 001431 aa 6 00466 2361 00 ldq pr6|310 001432 aa 6 00470 1761 00 sbq pr6|312 001433 aa 6 00370 7561 00 stq pr6|248 name_len STATEMENT 1 ON LINE 350 if name_len > length (suffix) /* enough chars to have this suffix? */ then if substr (p_name, name_len - length (suffix) + 1, length (suffix)) = suffix then return; 001434 aa 6 00371 1161 00 cmpq pr6|249 suffix 001435 aa 000012 6044 04 tmoz 10,ic 001447 001436 aa 6 00371 1761 00 sbq pr6|249 suffix 001437 aa 6 00470 7561 00 stq pr6|312 001440 aa 6 00371 7271 00 lxl7 pr6|249 suffix 001441 aa 6 00371 7261 00 lxl6 pr6|249 suffix 001442 aa 040 140 106 546 cmpc (pr,rl,ql),(pr,rl),fill(040) 001443 aa 3 00000 00 0017 desc9a pr3|0,x7 p_name 001444 aa 6 00372 00 0016 desc9a pr6|250,x6 suffix 001445 aa 000002 6010 04 tnz 2,ic 001447 001446 aa 6 00362 6101 00 rtcd pr6|242 STATEMENT 1 ON LINE 353 if name_len + length (suffix) > length (p_name) then go to entlong; 001447 aa 6 00370 2361 00 ldq pr6|248 name_len 001450 aa 6 00371 0761 00 adq pr6|249 suffix 001451 aa 6 00466 1161 00 cmpq pr6|310 001452 aa 777212 6054 04 tpnz -374,ic 000664 STATEMENT 1 ON LINE 355 else substr (p_name, name_len + 1, length (suffix)) = suffix; 001453 aa 6 00370 2351 00 lda pr6|248 name_len 001454 aa 6 00371 7271 00 lxl7 pr6|249 suffix 001455 aa 6 00371 7261 00 lxl6 pr6|249 suffix 001456 aa 040 145 100 540 mlr (pr,rl),(pr,rl,al),fill(040) 001457 aa 6 00372 00 0016 desc9a pr6|250,x6 suffix 001460 aa 3 00000 00 0017 desc9a pr3|0,x7 p_name STATEMENT 1 ON LINE 357 return; 001461 aa 6 00362 6101 00 rtcd pr6|242 STATEMENT 1 ON LINE 359 end /* suffix */; END PROCEDURE suffix END PROCEDURE expand_pathname_ ----------------------------------------------------------- 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