COMPILATION LISTING OF SEGMENT linus_match_star_name Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 09/16/83 1802.3 mst Fri Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 12 /* */ 13 /* N__a_m_e: match_star_name_ */ 14 /* */ 15 /* This subroutine implements the Multics Storage System Star Convention. */ 16 /* */ 17 /* E__n_t_r_y: match_star_name_$match_star_name_ */ 18 /* */ 19 /* This entry point compares a star name with another name (called the source name) */ 20 /* and returns an error code indicating whether or not the two names match. */ 21 /* */ 22 /* U__s_a_g_e */ 23 /* */ 24 /* dcl match_star_name_ entry (char(*), char(*), fixed bin(35)); */ 25 /* */ 26 /* call match_star_name_ (sourcename, starname, code); */ 27 /* */ 28 /* 1) sourcename is the name to be compared with the star name. (In) */ 29 /* */ 30 /* 2) starname is the star name. (In) */ 31 /* */ 32 /* 3) code is a status code. (Out) */ 33 /* */ 34 /* 0 the two names match. */ 35 /* */ 36 /* error_table_$nomatch */ 37 /* the two names do not match. */ 38 /* */ 39 /* error_table_$badstar */ 40 /* the star name has a bad format. */ 41 /* */ 42 /* E__n_t_r_y: check_star_name_$path */ 43 /* */ 44 /* This entry point checks the final entry of a path name to see if it is a valid */ 45 /* star name, and classifies the star name as one of three kinds: star name contains */ 46 /* no "*" or "?" characters; star name is "**", or its equivalent; or star name contains */ 47 /* "*" or "?" characters, but is not equivalent to "**". */ 48 /* */ 49 /* U__s_a_g_e */ 50 /* */ 51 /* dcl check_star_name_$path entry (char(*), fixed bin(35)); */ 52 /* */ 53 /* call check_star_name_$path (starpath, code); */ 54 /* */ 55 /* 1) starpath the path name whose final entry is to be validated */ 56 /* and classified as a star name. (In) */ 57 /* 2) code is one of the following status codes. (Out) */ 58 /* */ 59 /* 0 star name is valid, but contains no "*"'s or "?"'s. */ 60 /* */ 61 /* 1 star name is valid, and contains "*"'s or "?"'s, but is not equivalent*/ 62 /* to a star name of "**". */ 63 /* */ 64 /* 2 star name is valid, and is equivalent to a star name of "**". */ 65 /* */ 66 /* error_table_$badstar */ 67 /* star name has a bad format. */ 68 /* */ 69 /* E__n_t_r_y: check_star_name_$entry */ 70 /* */ 71 /* This entry point works like check_star_name_, except that its arguments identify */ 72 /* a single entry name which is to be validated and classified as a star name, rather */ 73 /* than a path name. */ 74 /* */ 75 /* U__s_a_g_e */ 76 /* */ 77 /* dcl check_star_name_$entry entry (char(*), fixed bin(35)); */ 78 /* */ 79 /* call check_star_name_$entry (starentry, code); */ 80 /* */ 81 /* 1) starentry the entry name to be validated and classified as a star */ 82 /* name. (In) */ 83 /* 2) code is the same code returned by check_star_name_$path. (Out) */ 84 /* */ 85 /* S__t_a_t_u_s */ 86 /* */ 87 /* 0) Created: Jun, 1973 by G. C. Dixon */ 88 /* a) full convention implemented, including: */ 89 /* i) ?'s */ 90 /* ii) components of form: O?*?O */ 91 /* iii) ** as _a_n_y component */ 92 /* b) check_star_ and check_star_$check_entry_name entry points integrated into */ 93 /* match_star_name_, and improved to perform complete error checking. */ 94 /* 1) Modified: Jun, 1973 by G. C. Dixon */ 95 /* a) components of form: O?*?O removed from code temporarily to allow */ 96 /* transition from undocumented use of * (eg, !************** matches unique */ 97 /* names); *'s in components other than * or ** interpreted as ?. */ 98 /* 2) Modified: Jul, 1973 by G. C. Dixon */ 99 /* a) renamed from match_star_ to match_star_name_ */ 100 /* b) renamed from check_star_ to check_star_name_$path */ 101 /* c) renamed from check_star_$check_entry_name_ to check_star_name_$entry */ 102 /* 3) Modified: Nov, 1973 by G. C. Dixon */ 103 /* a) remove modification 1 to fully support the documented star convention. */ 104 /* 4) Modified: 7 July 1979 by G. Palter */ 105 /* a) change check_star_name_$path to really accept relative pathnames */ 106 /* b) improve performance by using EIS where possible. */ 107 /* 5) Modified 05/04/81 S. Herbst to add match_star_name_$string */ 108 /* 6) Stole this program and renamed it from value_match_ to linus_match_star_name until */ 109 /* the match_star_name_$string is officially installed. */ 110 /* */ 111 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 112 113 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 114 /* */ 115 /* A__l_g_o_r_i_t_h_m: */ 116 /* */ 117 /* The basic algorithm employed in comparing the star name with the source name is: */ 118 /* */ 119 /* 1) Parse the star name into components. */ 120 /* a) each component is classified as of one of the following types: */ 121 /* _t_y_p_e _f_o_r_m_a_t _d_e_s_c_r_i_p_t_i_o_n */ 122 /* 12 ** a double star component. */ 123 /* 13 * a single star component. */ 124 /* 14 O? a mixture of question marks (?) and other chars */ 125 /* 15 O?*?O a mixture of ?'s and other chars, with a * */ 126 /* 16 BAD a bad star name component. */ 127 /* 2) Parse the source name into components. */ 128 /* 3) Compare each star name component with the corresponding source name component. */ 129 /* 4) If all of the corresponding components match, then the two names match. */ 130 /* */ 131 /* The hardest part of this process is parsing the starname into typed components, */ 132 /* while checking for a bad star name during the parsing process. The current restraints */ 133 /* on the format of star names are: */ 134 /* */ 135 /* 1) 0 < length(star name) <= 32 */ 136 /* a) the length used in the relation above is computed by stripping trailing blanks */ 137 /* from the star name. */ 138 /* 2) A star name may be composed of up to 16 components, in an arbitrary mixture of the */ 139 /* types specified above, _e_x_c_e_p_t that only one double star component may */ 140 /* appear in any star name. */ 141 /* 3) With the exception of the double star component, a component may contain, at most */ 142 /* one star (*). */ 143 /* 4) A star name may _n_o_t contain a null component (eg, *..pl1); that is, two periods in */ 144 /* a row are illegal, and a star name may not begin or end with a period. */ 145 /* 5) A star name may contain any ASCII character, except ">" or "<"; that is, */ 146 /* (star-name-char <= PAD) & (star-name-char ^= "<") & (star-name-char ^= ">"). */ 147 /* */ 148 /* Each component of the star name is parsed by a finite state machine, the diagram */ 149 /* of which is shown below. The process of parsing each component begins in state _s_t_a_r_t, */ 150 /* and it continues through the machine, according to the characters of the star name */ 151 /* component ("*", "?", ".", or another character) a period ends the component, or */ 152 /* until all of the characters of the star name have been exhausted. The parsing process */ 153 /* identifies bad star names (terminal state B_A_D_), and it also classifies each valid */ 154 /* component as being one of the component types mentioned above. The type is defined */ 155 /* to be the state value of the finite state machine when the component has been parsed */ 156 /* (ie, after a period is encountered). During the parsing, information about the */ 157 /* location and length of each component (and of subcomponents) is gathered for later use */ 158 /* during the comparison phase. */ 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 /* _________ * 177* | |------------------------------ 178* ------------------| start | | 179* | ? |________0_|----------------- | 180* | |. O | | 181* | | | | 182* | V | | 183* | 16(BAD) | | 184* | | | 185* | * _________ . | | 186* --------|-----------------| |---> 14(O?) | | 187* | | | OO | | | 188* | | ------------|________5_|<----------- | | 189* | | | ? |O A | | | 190* | | | | | | | | 191* | | | |_____| | | | 192* | | | | | | 193* | _V______V__ O O__|____V___ | 194* | | |---------------------------->| | | 195* | | ? | | O | | 196* | |________3_|<----------------------------|________1_| | 197* | .| |* |? ? A *| |. | 198* | | | | | | | | 199* | V | | ------- | | V | 200* | 14(O?) | | | | | | 14(O?) | 201* | | | _V_____?__|_ O | | | 202* | | ---------->| |----------- | | 203* | | | ?? | | | 204* | | |________6_|--->14(O?) | | 205* | | . |* | | 206* | | | | | 207* | | ____V_____ | | 208* | -------------->| |<-------------- | 209* | | O?* |. | 210* ------------------------>|_______1_0_|--->15(O?*?O) | 211* ?| |* |O | 212* --------------------- | ------------------- | 213* | V | | 214* | 16(BAD) | | 215* | | | 216* | | | 217* | | | 218* 219* | | | 220* | | | 221* | | | 222* | | | 223* | * _________ . | | 224* | 16(BAD)<---| |--->15(O?*?O) | | 225* | | *OO | | | 226* | ------------|________7_|<---------- | | 227* | | ? |O A | | | 228* | | | | | | | 229* | | |_____| | | | 230* | | | | | 231* . _V______V__ O O_|_____V___ . | 232* 15(O?*?O)<---| |---------------------------->| |----------|--->15(O?*?O) 233* | *? | | *O | | 234* 16(BAD)<---|________4_|<----------------------------|________2_|----------|--->16(BAD) 235* * A ?| ? A A * | 236* | | | | | 237* | | ------- | | | 238* | | | | | | | 239* | | _V______?__| O | | | 240* | ----------->| |------------ | | 241* | | *?? | | | 242* | 15(O?*?O)<---|________8_|--->16(BAD) | | 243* | . * | | 244* | | | 245* | ? _________ O | | 246* ------------------| |------------------ | 247* | * | | 248* 13(*)<---|_______1_1_|<----------------------------- 249* . |* 250* | 251* | 252* ____V_____ 253* .| |*O? 254* 12(**)<---| ** |--->16(BAD) 255* |________9_| 256* */ 257 258 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 259 /* */ 260 /* The finite state table is defined by the variable, nstate, in the program below. */ 261 /* */ 262 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 263 264 265 /* The parsing algorithm divides the star name into a series of components */ 266 /* (the character string of the star name separated by periods), and further divides */ 267 /* each component into subcomponent strings of the following types: */ 268 /* _t_y_p_e _f_o_r_m_a_t _d_e_s_c_r_i_p_t_i_o_n */ 269 /* 1 O's a string containing chars besides *, ?, or . */ 270 /* 2 ?'s a string of question marks */ 271 /* 3 * a string of one or two stars */ 272 /* The star name components are split into two groups: those that preceed any (type 12) */ 273 /* "**" component; and those which follow any "**" component. */ 274 /* The star name is then compared with the source name, as follows: */ 275 /* */ 276 /* 1) Appropriate tests are made to insure that the source name has the minimum number of */ 277 /* components required by the star name. */ 278 /* 2) The star name components preceeding any "**" component are compared with the */ 279 /* corresponding components of the source name; that is, 1st star is compared with */ 280 /* 1st source, 2nd star is compared with 2nd source, ... */ 281 /* 3) If these components match, then the star name components which follow any ** */ 282 /* components are compared with the corresponding source name components; that is, */ 283 /* last star compared with last source, last-1 star compared with last-1 source, ... */ 284 /* 4) If all comparisons match, then the source name matches the star name. */ 285 /* */ 286 /* Each star name component is compared with a source name component, according */ 287 /* to the type of the star name component: */ 288 /* */ 289 /* 1) According to the above component-by-component comparison algorithm, no attempt will */ 290 /* be made to compare any source name component with a double star (**) component. */ 291 /* 2) A single star (*) component matches any source name component, including a */ 292 /* null component. */ 293 /* 3) A component which contains no "*" (O?) is compared, subcomponent by */ 294 /* subcomponent, with the corresponding strings of the source component. Appropriate */ 295 /* checks are made to insure that the source component has the same length as the */ 296 /* star component. */ 297 /* 4) A component which contains a "*" (O?*?O) is compared as follows: */ 298 /* a) The length of the source name component is checked to insure that it is at */ 299 /* least as long as the star component, minus the single star. */ 300 /* b) The subcomponents of the star component which preceed the star are compared, */ 301 /* one by one, with the corresponding strings of the source name. */ 302 /* c) If these subcomponents match, then those which follow the star are compared */ 303 /* with the corresponding strings at the end of the source name. */ 304 /* d) If these subcomponents match, then the components match. */ 305 /* */ 306 /* The star name "**", "*.**", and "**.*" are special-cased to provide an immediate */ 307 /* match for any source name which is not longer than 32 characters. In addition, these */ 308 /* star names, and "*" match any null source name. */ 309 /* */ 310 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 311 312 linus_match_star_name: procedure (Asource, Astar, code); 313 314 /* TEMPORARY VERSION FOR value_, BOUND INTO bound_exec_com_ */ 315 316 dcl Asource char(*), /* the source name to be compared with Astar.(In) */ 317 Astar char(*), /* the star name. (In) */ 318 code fixed bin(35); /* the status code returned.(Out) */ 319 320 dcl 1 Csc (33) aligned automatic, /* array elements identify source name components.*/ 321 2 Isc fixed bin, /* index of component into source name. */ 322 2 Lsc fixed bin, /* length of component. */ 323 1 Cst (17) aligned automatic, /* array elements identify star name components. */ 324 2 Ist fixed bin, /* index of component into star name. */ 325 2 Lst fixed bin, /* length of component. */ 326 2 Tst fixed bin, /* type of component: */ 327 /* 12 = double star component */ 328 /* 13 = single star component */ 329 /* 14 = O? */ 330 /* 15 = O?*?O */ 331 2 SCst fixed bin, /* index into Csub of 1st subcomponent of this */ 332 /* component. */ 333 1 Csub (32) aligned automatic, /* table of subcomponents */ 334 2 Isub fixed bin, /* index into the component of the start of the */ 335 /* subcomponent. */ 336 2 Lsub fixed bin, /* length of subcomponent. */ 337 2 Tsub fixed bin, /* type of subcomponent: */ 338 /* 1 = string containing other chars */ 339 /* 2 = string of ?'s */ 340 /* 3 = a single * */ 341 Lsource fixed bin, /* real length of the source name. */ 342 Lstar fixed bin, /* real length of the star name. */ 343 Nsc fixed bin, /* number of components in source name. */ 344 Nst fixed bin, /* number of components in star name. */ 345 Nsub fixed bin, /* number of subcomponents in star name. */ 346 before_star_subcomponent bit(1) aligned, /* on if no * subcomponent encountered in any of */ 347 /* subcomponent of a given component. */ 348 double_star bit(1) aligned, /* on if ** component has already been parsed. */ 349 string_entry_sw bit(1) aligned, /* on if $string to omit 32-char length test. */ 350 char char(1) aligned, 351 (i, j) fixed bin, 352 source char(1000) aligned, /* aligned copy of source name. */ 353 star char(1000) aligned, /* aligned copy of star name. */ 354 state fixed bin; /* number of current state of finite state machine*/ 355 356 dcl 1 Osource aligned based (addr (source)), 357 2 char (1000) char(1) unal, /* overlay for source name. */ 358 1 Ostar aligned based (addr (star)), 359 2 char (1000) char(1) unal; /* overlay for star name. */ 360 361 dcl (addr, length, reverse, search, substr, rtrim) 362 builtin; 363 364 365 dcl PAD char(1) aligned int static options (constant) init (""), 366 /* An ASCII PAD char \177. */ 367 Tbad fixed bin int static options (constant) init (16), 368 /* type code used for a bad star name. */ 369 Tnostar fixed bin int static options (constant) init (14), 370 /* type for component of form: O? */ 371 Tstar fixed bin int static options (constant) init (13), 372 /* type for component which is "*". */ 373 Tstarstar fixed bin int static options (constant) init (12), 374 /* type for component which is "**". */ 375 (error_table_$badstar, 376 error_table_$nomatch) fixed bin(35) ext static, 377 nstate (0:11, 4) fixed bin int static options (constant) init ( 378 /* */ 379 /* TABLE OF NEXT STATES */ 380 /* */ 381 /* Current S t a r N a m e C h a r a c t e r */ 382 /* _S__t_a_t_e_ "_._"_ "_*_"_ "_?_"_ O__t_h_e_r */ 383 /* */ 384 /* 0 */ 16, 11, 3, 1, 385 /* 1 */ 14, 10, 3, 5, 386 /* 2 */ 15, 16, 4, 7, 387 /* 3 */ 14, 10, 6, 1, 388 /* 4 */ 15, 16, 8, 2, 389 /* 5 */ 14, 10, 3, 5, 390 /* 6 */ 14, 10, 6, 1, 391 /* 7 */ 15, 16, 4, 7, 392 /* 8 */ 15, 16, 8, 2, 393 /* 9 */ 12, 16, 16, 16, 394 /* 10 */ 15, 16, 4, 2, 395 /* 11 */ 13, 9, 4, 2); 396 397 398 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 399 400 401 402 string_entry_sw = "1"b; 403 404 COMMON: 405 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 406 /* */ 407 /* 1) compute and validate real length of star name. */ 408 /* 2) parse the star name into components and subcomponents. */ 409 /* */ 410 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 411 412 Lstar = length (rtrim (Astar)); 413 if Lstar > 32 & ^string_entry_sw then /* a star name longer than 32 characters is bad. */ 414 go to bad; 415 if Lstar = 0 then /* a null string is a bad star name. */ 416 go to bad; 417 star = Astar; /* copy star name to aligned temp for efficiency. */ 418 call parse_star_name; /* parse the star name. */ 419 420 421 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 422 /* */ 423 /* 1) compute real length of source name, making sure its not too long. */ 424 /* 2) if star name was "**", "**.*", or "*.**" then look no further. It matches */ 425 /* any source name which passed the length test. */ 426 /* 3) finish computing length of source name. */ 427 /* 4) parse source name into components. */ 428 /* */ 429 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 430 431 Lsource = length (rtrim (Asource)); 432 if Lsource > 32 & ^string_entry_sw then /* Can't match a source name that is too long. */ 433 go to nomatch; 434 435 if Nst = 1 then 436 if Tst(1) = Tstarstar then 437 go to match; /* star = "**" */ 438 else; 439 else if Nst = 2 then 440 if Tst(1) = Tstarstar then 441 if Tst(2) = Tstar then 442 go to match; /* star = "**.*" */ 443 else; 444 else if Tst(1) = Tstar then 445 if Tst(2) = Tstarstar then 446 go to match; /* star = "*.**" */ 447 448 source = Asource; /* copy source name to aligned temp for efficiency*/ 449 450 if Lsource = 0 then /* Only a star name of * or ** or *.** or **.* */ 451 if Nst = 1 then /* matches a null source name. */ 452 if Tst(1) = Tstar then 453 go to match; 454 else 455 go to nomatch; 456 else 457 go to nomatch; 458 459 Nsc = 1; /* parse source name into components. */ 460 Isc(1) = 1; 461 Lsc(1) = 0; 462 do i = 1 to Lsource; 463 if Osource.char(i) = "." then do; 464 Nsc = Nsc + 1; 465 Isc(Nsc) = i+1; 466 Lsc(Nsc) = 0; 467 end; 468 else 469 Lsc(Nsc) = Lsc(Nsc) + 1; 470 end; 471 472 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 473 /* */ 474 /* See if star name matches source name: */ 475 /* 1) are there enough components in source name to meet star name's requirements? */ 476 /* 2) do star components before any "**" component match the corresponding */ 477 /* source components? */ 478 /* 3) do star components after any "**" component match the corresponding */ 479 /* source components? */ 480 /* Then source name matches star name. */ 481 /* */ 482 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 483 484 if double_star then 485 if Nsc < Nst - 1 then 486 go to nomatch; 487 else; 488 else 489 if Nsc = Nst then; 490 else 491 go to nomatch; 492 493 do i = 1 to Nst while (Tst(i) ^= Tstarstar); 494 call match_ (i, i); 495 end; 496 497 do i = Nst to i+1 by -1; 498 call match_ (i, Nsc-(Nst-i)); 499 end; 500 501 match: code = 0; /* The star name matches the source name. Yay */ 502 return; 503 504 nomatch: code = error_table_$nomatch; /* The star name doesn't match the source name. */ 505 return; /* Boo Hoo. */ 506 507 bad: code = error_table_$badstar; /* The star name has a bad form. */ 508 return; 509 510 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 511 512 513 514 515 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 516 517 518 path: entry (Astar, code); 519 520 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 521 /* */ 522 /* 1) separate the directory part of the path name from the final entry name. */ 523 /* We deal only with the entry name. */ 524 /* */ 525 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 526 527 Lstar = length (rtrim (Astar)); /* get length of input argument without blanks */ 528 if Lstar = 0 then 529 go to bad; /* can't be null */ 530 i = search (reverse (Astar), "<>"); /* search for "end" of pathname */ 531 if i = 0 then 532 star = Astar; /* an entryname only */ 533 else do; 534 i = length (Astar) - i + 1; /* adjust index */ 535 Lstar = Lstar - i; /* adjust length of entryname part */ 536 star = substr (Astar, (i+1), Lstar); 537 end; 538 go to common; 539 540 541 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 542 543 544 entry: entry (Astar, code); 545 546 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 547 /* */ 548 /* 1) strip trailing blanks from star name. */ 549 /* 2) make sure 0 < length(star name) <= 32. */ 550 /* 3) parse star name into components, checking for validity of each component. */ 551 /* 4) check component classifications to find gross type of star name: */ 552 /* 0 => star name contains no *'s or ?'s. */ 553 /* 1 => star name contains *'s or ?'s, but is not equivalent to "**". */ 554 /* 2 => star name is equivalent to "**". */ 555 /* (ie, star name is "**", or "*.**", or "**.*") */ 556 /* */ 557 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 558 559 Lstar = length (rtrim (Astar)); 560 star = substr (Astar, 1, Lstar); /* copy star name to aligned temp for efficiency. */ 561 562 common: if Lstar <= 0 then /* validate length. */ 563 go to bad; 564 if Lstar > 32 then 565 go to bad; 566 call parse_star_name; /* parse the star name in the aligned temp into */ 567 /* classified component types. */ 568 569 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 570 /* */ 571 /* If we get here, star name is guaranteed to be valid. We now must find its type.*/ 572 /* */ 573 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 574 575 if Nst = 1 then /* Check type for "**" or its equivalent. */ 576 if Tst(1) = Tstarstar then 577 go to starstar; /* star name = "**" */ 578 else; 579 else if Nst = 2 then 580 if Tst(1) = Tstarstar then 581 if Tst(2) = Tstar then 582 go to starstar; /* star name = "**.*" */ 583 else; 584 else if Tst(1) = Tstar then 585 if Tst(2) = Tstarstar then 586 go to starstar; /* star name = "*.**" */ 587 588 do i = 1 to Nst; /* look for a * or a ?. */ 589 if Tst(i) ^= Tnostar then /* component class says component contains a *. */ 590 go to star_question_mark; 591 if SCst(i+1) - SCst(i) > 1 then /* if component contains more than one */ 592 go to star_question_mark; /* subcomponent, then it contains ?'s, since */ 593 /* it doesn't contain a * subcomponent, it must */ 594 /* contain a ? subcomponent. */ 595 else if Tsub(SCst(i)) > 1 then /* check for only subcomponent being 1 or more ?'s*/ 596 go to star_question_mark; 597 end; 598 599 code = 0; /* all components contain no *'s or ?'s. */ 600 return; 601 602 star_question_mark: 603 code = 1; /* some components contain *'s or ?'s. */ 604 return; 605 606 starstar: code = 2; /* star name equivalent to "**". */ 607 return; 608 609 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 610 611 612 613 614 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 615 616 617 618 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 619 /* */ 620 /* This internal procedure compares a star name component with a source name */ 621 /* component. A different type of comparison is used for each type of star */ 622 /* name component. */ 623 /* */ 624 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 625 626 627 match_: procedure (Nst, Nsc); 628 629 dcl Nst fixed bin, /* number of the star name component. */ 630 Nsc fixed bin; /* number of the source name component. */ 631 632 dcl I fixed bin, /* index of subcomponent being matched into */ 633 /* component. */ 634 L fixed bin, /* length of subcomponent. */ 635 Lsc fixed bin, /* length of source name component. */ 636 Lst fixed bin, /* length of star name component. */ 637 Psc ptr, /* ptr to source name component. */ 638 Pst ptr; /* ptr to star name component. */ 639 640 dcl sc char(Lsc) based (Psc), 641 /* source name component begin compared with */ 642 /* the star name component. */ 643 st char(Lst) based (Pst); 644 /* the star name component. */ 645 646 Pst = addr (Ostar.char(Ist(Nst))); /* overlay the star name component. */ 647 Lst = Cst(Nst).Lst; 648 Psc = addr (Osource.char(Isc(Nsc))); /* overlay the source name component. */ 649 Lsc = Csc(Nsc).Lsc; 650 651 before_star_subcomponent = "1"b; /* indicate no * subcomponent encountered so far. */ 652 go to comp (Tst(Nst)); /* perform comparison of component, according to */ 653 /* type of star name component. */ 654 655 comp(13): return; /* star component = * (automatic match) */ 656 657 comp(14): /* star component is a combination of type 1 & 2 */ 658 /* subcomponents (ie, O?). */ 659 if Lst = Lsc then /* length of star and source components must be */ 660 go to sub_loop; /* the same. */ 661 else 662 go to nomatch; 663 664 comp(15): /* star component is a combination of type 1, 2 */ 665 /* and 3 subcomponents (ie, O?*?O). */ 666 if Lst-1 > Lsc then /* star component, minus the *, cannot be longer */ 667 go to nomatch; /* than the source component. */ 668 669 670 sub_loop: do j = SCst(Nst) to SCst(Nst+1) - 1; /* process each subcomponent of star component. */ 671 go to sub_comp (Tsub(j)); /* each type of subcomponent is a special case. */ 672 673 sub_comp(1): I = Isub(j); /* copy subcomponent index and length for effic. */ 674 L = Lsub(j); 675 if before_star_subcomponent then /* if no star subcomponent has been encountered, */ 676 if substr (st, I, L) = substr (sc, I, L) then; 677 else /* compare star subcomponent with a subcomponent */ 678 go to nomatch; /* of the source name which has the same length */ 679 /* as star subcomponent, and which begins at the */ 680 /* same index from _s_t_a_r_t of source component as */ 681 /* the star subcomponent is from the _s_t_a_r_t of the */ 682 /* star component. */ 683 else /* otherwise, compare the star subcomponent with */ 684 if substr (st, I, L) = substr (sc, Lsc-Lst+I, L) then; 685 else /* a subcomponent of source name which has the */ 686 go to nomatch; /* same length as the star subcomponent, and */ 687 /* which has the same index from the _e_n_d of */ 688 /* the source component as the star subcomponent */ 689 /* has from the _e_n_d of the star component. */ 690 691 sub_comp(2): go to end_sub_loop; /* subcomponent of ?'s always matches. */ 692 693 sub_comp(3): before_star_subcomponent = "0"b; /* a star subcomponent matches anything. */ 694 695 end_sub_loop: end sub_loop; 696 697 end match_; 698 699 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 700 701 702 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 703 704 705 706 707 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 708 /* */ 709 /* This internal procedure parses a star name into classified components, */ 710 /* and further parses each component into subcomponents. The star name is */ 711 /* assumed to reside is _s_t_a_r, and L__s_t_a_r is assumed to be its length. */ 712 /* */ 713 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 714 715 parse_star_name: procedure; 716 717 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 718 /* */ 719 /* initialize variables used to parse the star name. */ 720 /* */ 721 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 722 723 state = 0; /* start parsing each star name component in state*/ 724 double_star = "0"b; /* zero. No ** components encountered so far. */ 725 726 Nst = 1; /* Start parsing 1st component of star name. */ 727 Ist(1) = 1; /* 1st component starts with 1st char of star name*/ 728 Lst(1) = 0; /* and has zero length so far. */ 729 SCst(1) = 1; /* 1st subcomponent in 1st component */ 730 /* is subcomponent number 1. */ 731 732 Nsub = 0; /* we don't have any subcomponents so far. */ 733 734 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 735 /* */ 736 /* Use the finite state machine to parse the star name, 1 character at a time. */ 737 /* 1) validate each character (char ^= ">", ^= "<", <= PAD) */ 738 /* 2) transfer to next parsing state, according to character value (".", "*", "?", */ 739 /* or another character). */ 740 /* 3) each non-terminal state updates the information in the component and */ 741 /* subcomponent array tables which record the location, and length of each */ 742 /* component, and the location (relative to the start of the component), length */ 743 /* and position relative to any star in the component of each subcomponent. */ 744 /* Each terminal state updates the indices into these arrays to begin parsing */ 745 /* a new component and subcomponent. */ 746 /* */ 747 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 748 749 750 751 do i = 1 to Lstar; 752 char = Ostar.char(i); /* copy character for efficiency. */ 753 if char = "." then 754 state = nstate (state, 1); 755 else if char = "*" then 756 state = nstate (state, 2); 757 else if char = "?" then 758 state = nstate (state, 3); 759 else if char = ">" then 760 go to bad; 761 else if char = "<" then 762 go to bad; 763 else if char > PAD then 764 go to bad; 765 else 766 state = nstate (state, 4); 767 go to parse (state); 768 769 parse(1): /* state = O; input was another char. */ 770 parse(2): /* state = *O; input was another char. */ 771 Nsub = Nsub + 1; /* this char starts a new subcomponent. */ 772 Isub(Nsub) = Lst(Nst) + 1; /* record index into component of start of */ 773 Lsub(Nsub) = 1; /* subcomponent, and start with a length of 1. */ 774 Tsub(Nsub) = 1; /* record type of 1 (O's). */ 775 go to next_char; 776 777 parse(3): /* state = ?; input was a ?. */ 778 parse(4): /* state = *?; input was a ?. */ 779 Nsub = Nsub + 1; /* this char starts a new subcomponent. */ 780 Isub(Nsub) = Lst(Nst) + 1; /* record index into component of start of */ 781 Lsub(Nsub) = 1; /* subcomponent, and start with a length of 1. */ 782 Tsub(Nsub) = 2; /* record type of 2 (?'s). */ 783 go to next_char; 784 785 parse(5): /* state = OO; input was another char. */ 786 parse(6): /* state = ??; input was a ?. */ 787 parse(7): /* state = *OO; input was another char. */ 788 parse(8): /* state = *??; input was a ?. */ 789 parse(9): /* state = **; input was a *. */ 790 Lsub(Nsub) = Lsub(Nsub) + 1; /* add this char to length count of subcomponent. */ 791 go to next_char; 792 793 parse(10): /* state = O?*; input was a *. */ 794 parse(11): /* state = *; input was a *. */ 795 Nsub = Nsub + 1; /* this char begins a new subcomponent. */ 796 Isub(Nsub) = Lst(Nst) + 1; /* record index into component of start of */ 797 Lsub(Nsub) = 1; /* subcomponent, and start with a length of 1. */ 798 Tsub(Nsub) = 3; /* record type of 3 (*). */ 799 go to next_char; 800 801 parse(12): /* terminal state = **; input was a "." */ 802 if double_star then /* make sure there's only 1 double star component */ 803 go to bad; /* in the star name. */ 804 double_star = "1"b; 805 806 parse(13): /* terminal state = *; input was a "." */ 807 parse(14): /* terminal state = O or OO or ? or ??; input "." */ 808 parse(15): /* terminal state = O?*, *O, *OO, *?, or *??; */ 809 /* input = "." */ 810 Tst(Nst) = state; /* type of this component is state number. */ 811 Nst = Nst + 1; /* prepare to process the next component. */ 812 Ist(Nst) = i + 1; /* next component begins with next char. */ 813 Lst(Nst) = -1; /* it has 0 length so far. */ 814 /* (This value will be 0 when it is updated to */ 815 /* reflect the "." we're processing now.) */ 816 SCst(Nst) = Nsub + 1; /* component begins with next subcomponent. */ 817 state = 0; /* switch to the state used to begin parsing a */ 818 go to next_char; /* component. */ 819 820 parse(16): go to bad; /* terminal state = bad star name. */ 821 822 next_char: Lst(Nst) = Lst(Nst) + 1; /* update component's length to include current */ 823 end; /* input char, then parse the next input char. */ 824 825 state = nstate (state, 1); /* fudge contents of component array to make it */ 826 if state = Tbad then /* look like star name ended with a null */ 827 go to bad; /* component. Fill in state of last component */ 828 if state = Tstarstar then do; /* if state is valid (not bad star name state, */ 829 if double_star then /* or 2nd double star component). */ 830 go to bad; 831 double_star = "1"b; 832 end; 833 Tst(Nst) = state; 834 SCst(Nst+1) = Nsub + 1; 835 836 end parse_star_name; 837 838 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 839 840 841 end linus_match_star_name; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 09/16/83 1740.0 linus_match_star_name.pl1 >spec>on>09/16/83-linus>linus_match_star_name.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. Asource parameter char unaligned dcl 316 ref 312 431 448 Astar parameter char unaligned dcl 316 ref 312 404 417 518 527 530 531 534 536 544 559 560 Csc 000100 automatic structure array level 1 dcl 320 Cst 000202 automatic structure array level 1 dcl 320 Csub 000306 automatic structure array level 1 dcl 320 I 001466 automatic fixed bin(17,0) dcl 632 set ref 673* 675 675 683 683 Isc 000100 automatic fixed bin(17,0) array level 2 dcl 320 set ref 460* 465* 648 Ist 000202 automatic fixed bin(17,0) array level 2 dcl 320 set ref 646 727* 812* Isub 000306 automatic fixed bin(17,0) array level 2 dcl 320 set ref 673 772* 780* 796* L 001467 automatic fixed bin(17,0) dcl 632 set ref 674* 675 675 683 683 Lsc 1 000100 automatic fixed bin(17,0) array level 2 in structure "Csc" dcl 320 in procedure "linus_match_star_name" set ref 461* 466* 468* 468 649 Lsc 001470 automatic fixed bin(17,0) dcl 632 in procedure "match_" set ref 649* 657 664 675 683 683 Lsource 000446 automatic fixed bin(17,0) dcl 320 set ref 431* 432 450 462 Lst 1 000202 automatic fixed bin(17,0) array level 2 in structure "Cst" dcl 320 in procedure "linus_match_star_name" set ref 647 728* 772 780 796 813* 822* 822 Lst 001471 automatic fixed bin(17,0) dcl 632 in procedure "match_" set ref 647* 657 664 675 683 683 Lstar 000447 automatic fixed bin(17,0) dcl 320 set ref 404* 413 415 527* 528 535* 535 536 559* 560 562 564 751 Lsub 1 000306 automatic fixed bin(17,0) array level 2 dcl 320 set ref 674 773* 781* 785* 785 797* Nsc 000450 automatic fixed bin(17,0) dcl 320 in procedure "linus_match_star_name" set ref 459* 464* 464 465 466 468 468 484 488 498 Nsc parameter fixed bin(17,0) dcl 629 in procedure "match_" ref 627 648 649 Nst 000451 automatic fixed bin(17,0) dcl 320 in procedure "linus_match_star_name" set ref 435 439 450 484 488 493 497 498 575 579 588 726* 772 780 796 806 811* 811 812 813 816 822 822 833 834 Nst parameter fixed bin(17,0) dcl 629 in procedure "match_" ref 627 646 647 652 670 670 Nsub 000452 automatic fixed bin(17,0) dcl 320 set ref 732* 769* 769 772 773 774 777* 777 780 781 782 785 785 793* 793 796 797 798 816 834 Osource based structure level 1 dcl 356 Ostar based structure level 1 dcl 356 PAD constant char(1) initial dcl 365 ref 763 Psc 001472 automatic pointer dcl 632 set ref 648* 675 683 Pst 001474 automatic pointer dcl 632 set ref 646* 675 683 SCst 3 000202 automatic fixed bin(17,0) array level 2 dcl 320 set ref 591 591 595 670 670 729* 816* 834* Tbad constant fixed bin(17,0) initial dcl 365 ref 826 Tnostar constant fixed bin(17,0) initial dcl 365 ref 589 Tst 2 000202 automatic fixed bin(17,0) array level 2 dcl 320 set ref 435 439 439 444 444 450 493 575 579 579 584 584 589 652 806* 833* Tstar constant fixed bin(17,0) initial dcl 365 ref 439 444 450 579 584 Tstarstar constant fixed bin(17,0) initial dcl 365 ref 435 439 444 493 575 579 584 828 Tsub 2 000306 automatic fixed bin(17,0) array level 2 dcl 320 set ref 595 671 774* 782* 798* addr builtin function dcl 361 ref 463 646 646 648 648 752 before_star_subcomponent 000453 automatic bit(1) dcl 320 set ref 651* 675 693* char based char(1) array level 2 in structure "Osource" packed unaligned dcl 356 in procedure "linus_match_star_name" set ref 463 648 char 000456 automatic char(1) dcl 320 in procedure "linus_match_star_name" set ref 752* 753 755 757 759 761 763 char based char(1) array level 2 in structure "Ostar" packed unaligned dcl 356 in procedure "linus_match_star_name" set ref 646 752 code parameter fixed bin(35,0) dcl 316 set ref 312 501* 504* 507* 518 544 599* 602* 606* double_star 000454 automatic bit(1) dcl 320 set ref 484 724* 801 804* 829 831* error_table_$badstar 000010 external static fixed bin(35,0) dcl 365 ref 507 error_table_$nomatch 000012 external static fixed bin(35,0) dcl 365 ref 504 i 000457 automatic fixed bin(17,0) dcl 320 set ref 462* 463 465* 493* 493* 494* 494* 497* 497* 498* 498* 530* 531 534* 534 535 536 588* 589 591 591 595* 751* 752 812* j 000460 automatic fixed bin(17,0) dcl 320 set ref 670* 671 673 674* length builtin function dcl 361 ref 404 431 527 534 559 nstate 000026 constant fixed bin(17,0) initial array dcl 365 ref 753 755 757 765 825 reverse builtin function dcl 361 ref 530 rtrim builtin function dcl 361 ref 404 431 527 559 sc based char unaligned dcl 640 ref 675 683 search builtin function dcl 361 ref 530 source 000461 automatic char(1000) dcl 320 set ref 448* 463 648 st based char unaligned dcl 640 ref 675 683 star 001053 automatic char(1000) dcl 320 set ref 417* 531* 536* 560* 646 752 state 001445 automatic fixed bin(17,0) dcl 320 set ref 723* 753* 753 755* 755 757* 757 765* 765 767 806 817* 825* 825 826 828 833 string_entry_sw 000455 automatic bit(1) dcl 320 set ref 402* 413 432 substr builtin function dcl 361 ref 536 560 675 675 683 683 NAMES DECLARED BY EXPLICIT CONTEXT. COMMON 000141 constant label dcl 404 bad 000400 constant label dcl 507 ref 413 415 528 562 564 759 761 763 801 820 826 829 common 000544 constant label dcl 562 ref 538 comp 000000 constant label array(13:15) dcl 655 ref 652 end_sub_loop 000751 constant label dcl 695 ref 691 entry 000504 constant entry external dcl 544 linus_match_star_name 000115 constant entry external dcl 312 match 000372 constant label dcl 501 ref 435 439 444 450 match_ 000636 constant entry internal dcl 627 ref 494 498 next_char 001153 constant label dcl 822 ref 775 783 791 799 818 nomatch 000374 constant label dcl 504 ref 432 450 454 484 488 661 664 675 683 parse 000006 constant label array(16) dcl 769 ref 767 parse_star_name 000754 constant entry internal dcl 715 ref 418 566 path 000410 constant entry external dcl 518 star_question_mark 000630 constant label dcl 602 ref 589 591 595 starstar 000633 constant label dcl 606 ref 575 579 584 sub_comp 000003 constant label array(3) dcl 673 ref 671 sub_loop 000701 constant label dcl 670 ref 657 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1502 1516 1423 1512 Length 1700 1423 14 145 57 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME linus_match_star_name 844 external procedure is an external procedure. match_ internal procedure shares stack frame of external procedure linus_match_star_name. parse_star_name internal procedure shares stack frame of external procedure linus_match_star_name. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME linus_match_star_name 000100 Csc linus_match_star_name 000202 Cst linus_match_star_name 000306 Csub linus_match_star_name 000446 Lsource linus_match_star_name 000447 Lstar linus_match_star_name 000450 Nsc linus_match_star_name 000451 Nst linus_match_star_name 000452 Nsub linus_match_star_name 000453 before_star_subcomponent linus_match_star_name 000454 double_star linus_match_star_name 000455 string_entry_sw linus_match_star_name 000456 char linus_match_star_name 000457 i linus_match_star_name 000460 j linus_match_star_name 000461 source linus_match_star_name 001053 star linus_match_star_name 001445 state linus_match_star_name 001466 I match_ 001467 L match_ 001470 Lsc match_ 001471 Lst match_ 001472 Psc match_ 001474 Pst match_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. return ext_entry_desc NO EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badstar error_table_$nomatch LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 312 000111 402 000137 404 000141 413 000161 415 000165 417 000167 418 000173 431 000174 432 000211 435 000215 438 000223 439 000224 443 000234 444 000235 448 000242 450 000246 454 000256 459 000257 460 000261 461 000262 462 000263 463 000273 464 000277 465 000300 466 000306 467 000307 468 000310 470 000313 484 000315 487 000323 488 000324 493 000327 494 000343 495 000345 497 000347 498 000357 499 000367 501 000372 502 000373 504 000374 505 000377 507 000400 508 000403 518 000404 527 000425 528 000445 530 000446 531 000461 534 000466 535 000472 536 000474 538 000501 544 000502 559 000521 560 000541 562 000544 564 000546 566 000550 575 000551 578 000557 579 000560 583 000570 584 000571 588 000576 589 000605 591 000612 595 000617 597 000624 599 000626 600 000627 602 000630 604 000632 606 000633 607 000635 627 000636 646 000640 647 000647 648 000652 649 000662 651 000664 652 000666 655 000671 657 000672 661 000674 664 000675 670 000701 671 000711 673 000715 674 000717 675 000722 683 000734 691 000747 693 000750 695 000751 697 000753 715 000754 723 000755 724 000756 726 000757 727 000761 728 000762 729 000763 732 000764 751 000765 752 000775 753 001001 755 001011 757 001020 759 001027 761 001031 763 001033 765 001036 767 001042 769 001043 772 001044 773 001055 774 001057 775 001060 777 001061 780 001062 781 001073 782 001075 783 001077 785 001100 791 001103 793 001104 796 001105 797 001116 798 001120 799 001122 801 001123 804 001125 806 001127 811 001134 812 001135 813 001143 816 001145 817 001150 818 001151 820 001152 822 001153 823 001156 825 001160 826 001164 828 001166 829 001170 831 001172 833 001174 834 001201 836 001204 ----------------------------------------------------------- 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