COMPILATION LISTING OF SEGMENT substr Compiled by: Multics PL/I Compiler, Release 32f, of October 9, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 11/11/89 1011.6 mst Sat Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* *********************************************************** */ 8 9 10 11 /****^ HISTORY COMMENTS: 12* 1) change(80-10-31,Herbst), approve(), audit(), install(): 13* TR6700 Add uppercase -leading 10/31/80 S. Herbst 14* 2) change(83-10-03,Spitzer), approve(), audit(), install(): 15* TR11275 correct error msg for cpch 10/03/83 C. Spitzer 16* 3) change(84-01-03,Loepere), approve(), audit(), install(): 17* use ioa_ for bce compatibility 01/03/84 K. Loepere 18* 4) change(85-01-04,Lippard), approve(85-01-23,MCR7151), 19* audit(85-11-07,Spitzer), install(86-02-21,MR12.0-1024): 20* Add reverse_substr 01/04/85 Jim Lippard 21* END HISTORY COMMENTS */ 22 23 24 substr: procedure; 25 26 dcl 27 Larg (3) fixed bin, 28 Lret fixed bin, 29 Nargs fixed bin, 30 Npic pic "(10)z9", 31 Parg (3) ptr, 32 Pret ptr, 33 Scommand bit (1) aligned, 34 arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin(35)) variable, 35 args_sw bit (1), 36 bit3 bit(3) aligned, 37 bit4 bit(4) aligned, 38 char3 char(3) aligned, 39 char4 char(4) aligned, 40 (cleanup, conversion) condition, 41 code fixed bin(35), 42 e fixed bin, 43 error entry options (variable) variable, 44 (i, j, n) fixed bin, 45 leading_sw bit (1); 46 47 dcl 48 arg1 char(Larg(1)) based (Parg(1)), 49 arg2 char(Larg(2)) based (Parg(2)), 50 arg3 char(Larg(3)) based (Parg(3)), 51 ret char(Lret) varying based (Pret); 52 53 dcl (addr, after, before, bit, bool, character, collate, collate9, convert, copy, decat, 54 high, high9, index, length, low, ltrim, min, null, reverse, rtrim, search, 55 substr, translate, verify) 56 builtin; 57 58 dcl 59 active_fnc_err_ entry options (variable), 60 com_err_ entry options (variable), 61 (cu_$af_return_arg, 62 cu_$af_arg_ptr, 63 cu_$arg_ptr) entry (fixed bin, ptr, fixed bin, fixed bin(35)), 64 cu_$arg_count entry returns (fixed bin), 65 (get_temp_segment_, 66 release_temp_segment_) entry (char(*), ptr, fixed bin(35)), 67 ioa_ entry() options(variable); 68 69 dcl 70 UP_A char (2) int static options (constant) init ("^a"), 71 UPPERCASE char (26) aligned int static options (constant) init 72 ("ABCDEFGHIJKLMNOPQRSTUVWXYZ"), 73 LOWERCASE char (26) aligned int static options (constant) init 74 ("abcdefghijklmnopqrstuvwxyz"), 75 (error_table_$bad_arg, 76 error_table_$bad_conversion, 77 error_table_$badopt, 78 error_table_$wrong_no_of_args) 79 fixed bin(35) ext static, 80 81 ep (28) char(15) int static options(constant) init ( 82 "after", /* Name of entry points supported herein. */ 83 "before", 84 "bool", 85 "collate", 86 "collate9", 87 "copy_characters", 88 "decat", 89 "high", 90 "high9", 91 "index", 92 "length", 93 "low", 94 "lower_case", 95 "ltrim", 96 "reverse", 97 "reverse_after", 98 "reverse_before", 99 "reverse_decat", 100 "reverse_index", 101 "reverse_search", 102 "reverse_substr", 103 "reverse_verify", 104 "rtrim", 105 "search", 106 "substr", 107 "translate", 108 "upper_case", 109 "verify"), 110 max_args (28) fixed bin int static options(constant) init ( 111 2, 2, 3, 0, 0, 2, 3, 1, 1, 2, 112 1, 1, 999, 2, 1, 2, 2, 3, 2, 2, 113 3, 2, 2, 2, 3, 3, 999, 2), 114 min_args (28) fixed bin int static options(constant) init ( 115 2, 2, 3, 0, 0, 2, 3, 1, 1, 2, 116 1, 1, 1, 1, 1, 2, 2, 3, 2, 2, 117 2, 2, 1, 2, 2, 2, 1, 2), 118 options (28) char(52) int static options(constant) init ( 119 "source_string indexing_string", 120 "source_string indexing_string", 121 "bit_string bit_string 4_bit_string", 122 "", 123 "", 124 "string number_of_copies", 125 "source_string indexing_string 3_bit_string", 126 "number_of_copies", 127 "number_of_copies", 128 "source_string indexing_string", 129 "string", 130 "number_of_copies", 131 "strings", 132 "source_string search_string", 133 "string", 134 "source_string indexing_string", 135 "source_string indexing_string", 136 "source_string indexing_string 3_bit_string", 137 "source_string indexing_string", 138 "source_string search_string", 139 "string starting_index_number {length}", 140 "source_string verify_string", 141 "source_string search_string", 142 "source_string search_string", 143 "string starting_index_number {length}", 144 "string translate_to_string {translate_from_string}", 145 "strings", 146 "source_string verify_string"), 147 sys_info$max_seg_size fixed bin(35) ext static; 148 149 dcl TRUE bit (1) aligned internal static options (constant) init ("1"b), 150 FALSE bit (1) aligned internal static options (constant) init ("0"b); 151 152 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 153 154 155 e = 25; /* substr */ 156 go to COMMON; 157 158 159 after: af: entry; 160 161 e = 1; 162 go to COMMON; 163 164 165 before: be: entry; 166 167 e = 2; 168 go to COMMON; 169 170 171 bool: entry; 172 173 e = 3; 174 go to COMMON; 175 176 177 collate: entry; 178 179 e = 4; 180 go to COMMON; 181 182 183 collate9: entry; 184 185 e = 5; 186 go to COMMON; 187 188 189 copy_characters: cpch: entry; 190 191 e = 6; 192 go to COMMON; 193 194 195 decat: entry; 196 197 e = 7; 198 go to COMMON; 199 200 201 high: entry; 202 203 e = 8; 204 go to COMMON; 205 206 207 high9: entry; 208 209 e = 9; 210 go to COMMON; 211 212 213 index: entry; 214 215 e = 10; 216 go to COMMON; 217 218 219 length: ln: entry; 220 221 e = 11; 222 go to COMMON; 223 224 225 low: entry; 226 227 e = 12; 228 go to COMMON; 229 230 231 lower_case: lowercase: entry; 232 233 e = 13; 234 go to COMMON; 235 236 237 ltrim: entry; 238 239 e = 14; 240 go to COMMON; 241 242 243 reverse: rv: entry; 244 245 e = 15; 246 go to COMMON; 247 248 249 reverse_after: rvaf: entry; 250 251 e = 16; 252 go to COMMON; 253 254 255 reverse_before: rvbe: entry; 256 257 e = 17; 258 go to COMMON; 259 260 261 reverse_decat: rvdecat: entry; 262 263 e = 18; 264 go to COMMON; 265 266 267 reverse_index: rvindex: entry; 268 269 e = 19; 270 go to COMMON; 271 272 273 reverse_search: rvsrh: entry; 274 275 e = 20; 276 go to COMMON; 277 278 reverse_substr: rvsubstr: entry; 279 280 e = 21; 281 go to COMMON; 282 283 reverse_verify: rvverify: entry; 284 285 e = 22; 286 go to COMMON; 287 288 289 rtrim: entry; 290 291 e = 23; 292 go to COMMON; 293 294 295 search: srh: entry; 296 297 e = 24; 298 go to COMMON; 299 300 301 translate: entry; 302 303 e = 26; 304 go to COMMON; 305 306 307 upper_case: uppercase: entry; 308 309 e = 27; 310 go to COMMON; 311 312 313 verify: entry; 314 315 e = 28; 316 go to COMMON; 317 318 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 319 320 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 321 COMMON: call cu_$af_return_arg (Nargs, Pret, Lret, code); /* get arg count, see how called, get ret val. */ 322 if code = 0 then do; /* called as an active function. */ 323 error = active_fnc_err_; 324 arg_ptr = cu_$af_arg_ptr; 325 Scommand = FALSE; 326 end; 327 else do; /* called as a command. */ 328 error = com_err_; 329 arg_ptr = cu_$arg_ptr; 330 Scommand = TRUE; 331 Nargs = cu_$arg_count(); 332 Pret = null; 333 on cleanup call janitor(); 334 call get_temp_segment_ (ep(e), Pret, code); 335 if code ^= 0 then go to NO_TEMP_SEG; 336 Lret = (sys_info$max_seg_size - 1) * 4; 337 end; 338 339 if Nargs < min_args(e) then /* too few input arguments. */ 340 go to wnoa; 341 if Nargs > max_args(e) then /* too many input arguments. */ 342 go to wnoa; 343 do i = 1 to min (Nargs, 3); /* address input arguments. */ 344 call arg_ptr (i, Parg(i), Larg(i), code); 345 end; 346 347 ret = ""; /* clear return arg. */ 348 go to do(e); /* process according to input requirements. */ 349 350 do( 1): /* after. */ 351 ret = double_quotes(after(arg1,arg2)); 352 go to return; 353 354 do( 2): /* before */ 355 ret = double_quotes(before (arg1, arg2)); 356 go to return; 357 358 do( 3): /* bool */ 359 i = verify(arg1, "01"); 360 if i > 0 then do; 361 i = 1; 362 go to bad_conversion; 363 end; 364 i = verify(arg2, "01"); 365 if i > 0 then do; 366 i = 2; 367 go to bad_conversion; 368 end; 369 if Larg(3) ^= 4 then do; 370 i = 4; 371 go to bad_bit_string; 372 end; 373 char4 = arg3; 374 i = verify(char4, "01"); 375 if i > 0 then do; 376 i = 3; 377 go to bad_conversion; 378 end; 379 bit4 = bit(char4, 4); 380 ret = character(bool(bit(arg1), bit(arg2), bit4)); 381 go to return; 382 383 do( 4): /* collate */ 384 if Scommand then /* when invoked as a command, print collating seq */ 385 ret = collate(); 386 else do; 387 ret = """"; 388 ret = ret || substr (collate(),1,35); 389 ret = ret || substr (collate(),35); /* double the quote in the quoted string. */ 390 ret = ret || """"; 391 end; 392 go to return; 393 394 do( 5): /* collate9 */ 395 if Scommand then 396 ret = collate9(); 397 else do; 398 ret = """"; 399 ret = ret || substr (collate(),1,35); 400 ret = ret || substr (collate9(),35); 401 ret = ret || """"; 402 end; 403 go to return; 404 405 do( 6): /* copy */ 406 on conversion begin; 407 i = 2; 408 go to bad_conversion; 409 end; 410 n = convert(n, arg2); 411 revert conversion; 412 if n < 0 then do; 413 i = 2; 414 go to nonnegative_arg; 415 end; 416 else if n = 0 then; 417 else 418 ret = double_quotes(copy (arg1, n)); 419 go to return; 420 421 do( 7): /* decat */ 422 if Larg(3) ^= 3 then do; 423 i = 3; 424 go to bad_bit_string; 425 end; 426 char3 = arg3; 427 i = verify (char3, "01"); 428 if i > 0 then do; 429 i = 3; 430 go to bad_conversion; 431 end; 432 bit3 = bit(char3, 3); 433 ret = double_quotes(decat (arg1, arg2, bit3)); 434 go to return; 435 436 do( 8): /* high */ 437 do( 9): /* high9 */ 438 do(12): /* low */ 439 on conversion begin; 440 i = 1; 441 go to bad_conversion; 442 end; 443 n = convert(n, arg1); 444 revert conversion; 445 if n < 0 then do; 446 i = 1; 447 go to nonnegative_arg; 448 end; 449 else if n = 0 then 450 go to return; 451 else go to do_hl(e); 452 do_hl(8): 453 ret = high(n); 454 go to return; 455 do_hl(9): 456 ret = high9(n); 457 go to return; 458 do_hl(12): 459 ret = low(n); 460 go to return; 461 462 do(10): /* index */ 463 i = index (arg1, arg2); 464 ret_num: Npic = i; 465 ret = ltrim(Npic); 466 go to return; 467 468 do(11): /* length */ 469 i = Larg(1); 470 go to ret_num; 471 472 do(13): /* lower_case */ 473 do i = 1 to Nargs; 474 call arg_ptr (i, Parg (1), Larg (1), 0); 475 if ret ^= "" then ret = ret || " "; 476 ret = ret || double_quotes (translate (arg1, LOWERCASE, UPPERCASE)); 477 end; 478 go to return; 479 480 do(14): /* ltrim */ 481 if Nargs = 2 then 482 ret = double_quotes(ltrim(arg1, arg2)); 483 else ret = double_quotes(ltrim(arg1)); 484 go to return; 485 486 do(15): /* reverse */ 487 if Larg(1) <= 0 then; 488 else 489 ret = double_quotes(reverse (arg1)); 490 go to return; 491 492 do(16): /* reverse after */ 493 if index(arg1, arg2) > 0 then 494 ret = double_quotes(reverse(before(reverse(arg1), reverse(arg2)))); 495 else ret = ""; 496 go to return; 497 498 do(17): /* reverse before */ 499 if index(arg1, arg2) > 0 then 500 ret = double_quotes(reverse(after(reverse(arg1), reverse(arg2)))); 501 else ret = double_quotes(arg1); 502 go to return; 503 504 do(18): /* reverse decat */ 505 if Larg(3) ^= 3 then do; 506 i = 3; 507 go to bad_bit_string; 508 end; 509 char3 = arg3; 510 i = verify (char3, "01"); 511 if i > 0 then do; 512 i = 3; 513 go to bad_conversion; 514 end; 515 bit3 = bit(char3, 3); 516 if index(arg1, arg2) > 0 then 517 ret = double_quotes(reverse(decat(reverse(arg1), reverse(arg2), reverse(bit3)))); 518 else ret = double_quotes(decat(arg1, arg2, bit3)); 519 go to return; 520 521 do(19): /* reverse_index */ 522 i = index (reverse(arg1), reverse(arg2)); 523 if i > 0 then 524 i = Larg(1) - i + 2 - Larg(2); 525 go to ret_num; 526 527 do(20): /* reverse_search */ 528 i = search (reverse(arg1), arg2); 529 if i > 0 then 530 i = Larg(1) - i + 1; 531 go to ret_num; 532 533 do(21): /* reverse_substr */ 534 on conversion begin; 535 i = 2; 536 go to bad_conversion; 537 end; 538 i = convert(i, arg2); 539 revert conversion; 540 if Nargs = 3 then do; 541 on conversion begin; 542 i = 3; 543 go to bad_conversion; 544 end; 545 j = convert(j, arg3); 546 revert conversion; 547 end; 548 else 549 j = Larg(1); 550 if i <= 0 then do; 551 i = 2; 552 go to positive_arg; 553 end; 554 else if i > Larg(1) then; 555 else if j < 0 then do; 556 i = 3; 557 go to nonnegative_arg; 558 end; 559 else if j = 0 then; 560 else do; 561 if i+j-1 > Larg(1) then 562 j = Larg(1) - i + 1; 563 ret = double_quotes(reverse (substr (reverse (arg1), i, j))); 564 end; 565 go to return; 566 567 do(22): /* reverse_verify */ 568 i = verify (reverse(arg1), arg2); 569 if i > 0 then 570 i = Larg(1) - i + 1; 571 go to ret_num; 572 573 do(23): /* rtrim */ 574 if Nargs = 2 then 575 ret = double_quotes(rtrim(arg1, arg2)); 576 else ret = double_quotes(rtrim(arg1)); 577 go to return; 578 579 do(24): /* search */ 580 i = search (arg1, arg2); 581 go to ret_num; 582 583 do(25): /* substr */ 584 on conversion begin; 585 i = 2; 586 go to bad_conversion; 587 end; 588 i = convert(i, arg2); 589 revert conversion; 590 if Nargs = 3 then do; 591 on conversion begin; 592 i = 3; 593 go to bad_conversion; 594 end; 595 j = convert(j, arg3); 596 revert conversion; 597 end; 598 else 599 j = Larg(1); 600 if i <= 0 then do; 601 i = 2; 602 go to positive_arg; 603 end; 604 else if i > Larg(1) then; 605 else if j < 0 then do; 606 i = 3; 607 go to nonnegative_arg; 608 end; 609 else if j = 0 then; 610 else do; 611 if i+j-1 > Larg(1) then 612 j = Larg(1) - i + 1; 613 ret = double_quotes(substr (arg1, i, j)); 614 end; 615 go to return; 616 617 do(26): /* translate */ 618 if Nargs = 2 then 619 ret = double_quotes(translate (arg1, arg2)); 620 else 621 ret = double_quotes(translate (arg1, arg2, arg3)); 622 go to return; 623 624 do(27): /* upper_case */ 625 args_sw, leading_sw = "0"b; 626 do i = 1 to Nargs; 627 call arg_ptr (i, Parg (1), Larg (1), 0); 628 if ^args_sw & substr (arg1, 1, 1) = "-" then 629 if arg1 = "-leading" then leading_sw = "1"b; 630 else if arg1 = "-arguments" | arg1 = "-ag" then args_sw = "1"b; 631 else do; 632 call error (error_table_$badopt, "uppercase", "^a", arg1); 633 return; 634 end; 635 else do; 636 args_sw = "1"b; 637 if leading_sw then do; 638 if ret ^= "" then ret = ret || " "; 639 ret = ret || double_quotes (arg1); 640 end; 641 else do; 642 if ret ^= "" then ret = ret || " "; 643 ret = ret || double_quotes (translate (arg1, UPPERCASE, LOWERCASE)); 644 end; 645 end; 646 end; 647 648 if leading_sw then do; 649 substr (ret, 1, 1) = translate (substr (ret, 1, 1), UPPERCASE, LOWERCASE); 650 do i = 2 to length (ret); 651 if index (LOWERCASE, substr (ret, i, 1)) ^= 0 then 652 if index (UPPERCASE || LOWERCASE || "'-", substr (ret, i - 1, 1)) = 0 then 653 /* lowercase alpha preceded by nonalpha -> upper */ 654 substr (ret, i, 1) = translate (substr (ret, i, 1), UPPERCASE, LOWERCASE); 655 end; 656 end; 657 go to return; 658 659 do(28): /* verify */ 660 i = verify (arg1, arg2); 661 go to ret_num; 662 663 return: if Scommand then do; 664 call ioa_ (UP_A, ret); 665 call release_temp_segment_ (ep(e), Pret, code); 666 end; 667 return; 668 669 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 670 671 672 positive_arg: 673 j = 1; 674 go to bad_arg; 675 nonnegative_arg: 676 j = 2; 677 bad_arg: Parg(1) = Parg(i); 678 Larg(1) = Larg(i); 679 call error (error_table_$bad_arg, ep(e), " ^a 680 Argument ^d must be a ^[positive^;nonnegative^] integer.", arg1, i, j); 681 call janitor(); 682 return; 683 684 wnoa: call error (error_table_$wrong_no_of_args, ep(e), " 685 Usage: ^[[^]^a ^a^[]^]", ^Scommand, ep(e), options(e), ^Scommand); 686 call janitor(); 687 return; 688 689 NO_TEMP_SEG: 690 call error (code, ep(e), "^/While obtaining a temporary segment."); 691 return; 692 693 bad_bit_string: 694 call error (error_table_$bad_arg, ep(e), " ^a 695 Third argument must be a bit string of length ^d. 696 Usage: ^[[^]^a ^a^[]^]", arg3, i, ^Scommand, ep(e), options(e), ^Scommand); 697 call janitor(); 698 return; 699 700 bad_conversion: 701 Parg(1) = Parg(i); 702 Larg(1) = Larg(i); 703 call error (error_table_$bad_conversion, ep(e), " ^a 704 Usage: ^[[^]^a ^a^[]^]", arg1, ^Scommand,ep(e), options(e), ^Scommand); 705 call janitor(); 706 return; 707 708 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 709 710 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 711 712 713 double_quotes: procedure (string) returns (char(*) varying); 714 /* internal procedure to double all quotes in */ 715 /* a string. */ 716 717 dcl string char(*); 718 719 dcl (i, j) fixed bin; 720 721 722 dcl copied_string char(length(string)*2+2) varying; 723 724 dcl string_begin char(i-1) based (addr(string_array(j))), 725 string_end char(length(string)-(j-1)) based(addr(string_array(j))), 726 string_array (length(string)) char(1) based (addr(string)); 727 728 if Scommand then return (string); 729 i = search(string,""""); 730 if i = 0 then return("""" || string || """"); 731 j = 1; 732 copied_string = """"; 733 do while (i > 0); 734 copied_string = copied_string || string_begin; 735 copied_string = copied_string || """"""; 736 j = i+j; 737 i = search (string_end, """"); 738 end; 739 copied_string = copied_string || string_end; 740 copied_string = copied_string || """"; 741 return (copied_string); 742 743 744 end double_quotes; 745 746 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 747 748 749 janitor: procedure; 750 751 if Scommand & Pret ^= null then 752 call release_temp_segment_ (ep(e), Pret, code); 753 754 end janitor; 755 756 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 757 758 759 end substr; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/11/89 0803.9 substr.pl1 >spec>install>1111>substr.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. FALSE constant bit(1) initial dcl 149 ref 325 LOWERCASE 001056 constant char(26) initial dcl 69 ref 476 476 643 643 649 651 651 651 Larg 000100 automatic fixed bin(17,0) array dcl 26 set ref 344* 350 350 350 350 354 354 354 354 358 364 369 373 380 380 410 417 417 421 426 433 433 433 433 443 462 462 468 474* 476 476 480 480 480 480 483 483 486 488 488 492 492 492 492 492 492 498 498 498 498 498 498 501 501 504 509 516 516 516 516 516 516 518 518 518 518 521 521 523 523 527 527 529 538 545 548 554 561 561 563 563 567 567 569 573 573 573 573 576 576 579 579 588 595 598 604 611 611 613 613 617 617 617 617 620 620 620 620 620 620 627* 628 628 630 630 632 632 639 639 643 643 659 659 678* 678 679 679 693 693 702* 702 703 703 Lret 000103 automatic fixed bin(17,0) dcl 26 set ref 321* 336* 347 350 354 380 383 387 388 389 390 394 398 399 400 401 417 433 452 455 458 465 475 476 480 483 488 492 495 498 501 516 518 563 573 576 613 617 620 638 639 642 643 664 Nargs 000104 automatic fixed bin(17,0) dcl 26 set ref 321* 331* 339 341 343 472 480 540 573 590 617 626 Npic 000105 automatic picture(11) packed unaligned dcl 26 set ref 464* 465 Parg 000110 automatic pointer array dcl 26 set ref 344* 350 350 350 350 354 354 354 354 358 364 373 380 380 410 417 417 426 433 433 443 462 462 474* 476 476 480 480 480 480 483 483 488 488 492 492 492 492 492 492 498 498 498 498 498 498 501 509 516 516 516 516 516 516 518 518 521 521 527 527 538 545 563 563 567 567 573 573 573 573 576 576 579 579 588 595 613 613 617 617 617 617 620 620 620 620 620 620 627* 628 628 630 630 632 639 643 643 659 659 677* 677 679 693 700* 700 703 Pret 000116 automatic pointer dcl 26 set ref 321* 332* 334* 347 350 354 380 383 387 388 388 389 389 390 390 394 398 399 399 400 400 401 401 417 433 452 455 458 465 475 475 475 476 476 480 483 488 492 495 498 501 516 518 563 573 576 613 617 620 638 638 638 639 639 642 642 642 643 643 649 649 650 651 651 651 651 664 665* 751 751* Scommand 000120 automatic bit(1) dcl 26 set ref 325* 330* 383 394 663 684 684 693 693 703 703 728 751 TRUE constant bit(1) initial dcl 149 ref 330 UPPERCASE 001065 constant char(26) initial dcl 69 ref 476 476 643 643 649 651 651 UP_A 001110 constant char(2) initial packed unaligned dcl 69 set ref 664* active_fnc_err_ 000012 constant entry external dcl 58 ref 323 addr builtin function dcl 53 ref 734 734 737 737 739 739 after builtin function dcl 53 ref 350 350 498 498 arg1 based char packed unaligned dcl 47 set ref 350 350 354 354 358 380 417 417 433 443 462 476 476 480 480 483 483 488 488 492 492 492 498 498 498 501* 516 516 516 518 521 527 563 563 567 573 573 576 576 579 613 613 617 617 620 620 628 628 630 630 632* 639* 643 643 659 679* 703* arg2 based char packed unaligned dcl 47 ref 350 350 354 354 364 380 410 433 462 480 480 492 492 492 498 498 498 516 516 516 518 521 527 538 567 573 573 579 588 617 617 620 620 659 arg3 based char packed unaligned dcl 47 set ref 373 426 509 545 595 620 620 693* arg_ptr 000122 automatic entry variable dcl 26 set ref 324* 329* 344 474 627 args_sw 000126 automatic bit(1) packed unaligned dcl 26 set ref 624* 628 630* 636* before builtin function dcl 53 ref 354 354 492 492 bit builtin function dcl 53 ref 379 380 380 432 515 bit3 000127 automatic bit(3) dcl 26 set ref 432* 433 515* 516 516 518 bit4 000130 automatic bit(4) dcl 26 set ref 379* 380 bool builtin function dcl 53 ref 380 char3 000131 automatic char(3) dcl 26 set ref 426* 427 432 509* 510 515 char4 000132 automatic char(4) dcl 26 set ref 373* 374 379 character builtin function dcl 53 ref 380 cleanup 000134 stack reference condition dcl 26 ref 333 code 000150 automatic fixed bin(35,0) dcl 26 set ref 321* 322 334* 335 344* 665* 689* 751* collate builtin function dcl 53 ref 383 388 389 399 collate9 builtin function dcl 53 ref 394 400 com_err_ 000014 constant entry external dcl 58 ref 328 conversion 000142 stack reference condition dcl 26 ref 405 411 436 444 533 539 541 546 583 589 591 596 convert builtin function dcl 53 ref 410 443 538 545 588 595 copied_string 000102 automatic varying char dcl 722 set ref 732* 734* 734 735* 735 739* 739 740* 740 741 copy builtin function dcl 53 ref 417 417 cu_$af_arg_ptr 000020 constant entry external dcl 58 ref 324 cu_$af_return_arg 000016 constant entry external dcl 58 ref 321 cu_$arg_count 000024 constant entry external dcl 58 ref 331 cu_$arg_ptr 000022 constant entry external dcl 58 ref 329 decat builtin function dcl 53 ref 433 516 516 518 e 000151 automatic fixed bin(17,0) dcl 26 set ref 155* 161* 167* 173* 179* 185* 191* 197* 203* 209* 215* 221* 227* 233* 239* 245* 251* 257* 263* 269* 275* 280* 285* 291* 297* 303* 309* 315* 334 339 341 348 451 665 679 684 684 684 689 693 693 693 703 703 703 751 ep 000705 constant char(15) initial array packed unaligned dcl 69 set ref 334* 665* 679* 684* 684* 689* 693* 693* 703* 703* 751* error 000152 automatic entry variable dcl 26 set ref 323* 328* 632 679 684 689 693 703 error_table_$bad_arg 000034 external static fixed bin(35,0) dcl 69 set ref 679* 693* error_table_$bad_conversion 000036 external static fixed bin(35,0) dcl 69 set ref 703* error_table_$badopt 000040 external static fixed bin(35,0) dcl 69 set ref 632* error_table_$wrong_no_of_args 000042 external static fixed bin(35,0) dcl 69 set ref 684* get_temp_segment_ 000026 constant entry external dcl 58 ref 334 high builtin function dcl 53 ref 452 high9 builtin function dcl 53 ref 455 i 000156 automatic fixed bin(17,0) dcl 26 in procedure "substr" set ref 343* 344* 344 344* 358* 360 361* 364* 365 366* 370* 374* 375 376* 407* 413* 423* 427* 428 429* 440* 446* 462* 464 468* 472* 474* 506* 510* 511 512* 521* 523 523* 523 527* 529 529* 529 535* 538* 538 542* 550 551* 554 556* 561 561 563 563 567* 569 569* 569 579* 585* 588* 588 592* 600 601* 604 606* 611 611 613 613 626* 627* 650* 651 651 651 651* 659* 677 678 679* 693* 700 702 i 000100 automatic fixed bin(17,0) dcl 719 in procedure "double_quotes" set ref 729* 730 733 734 736 737* index builtin function dcl 53 ref 462 492 498 516 521 651 651 ioa_ 000032 constant entry external dcl 58 ref 664 j 000101 automatic fixed bin(17,0) dcl 719 in procedure "double_quotes" set ref 731* 734 736* 736 737 737 739 739 j 000157 automatic fixed bin(17,0) dcl 26 in procedure "substr" set ref 545* 545 548* 555 559 561 561* 563 563 595* 595 598* 605 609 611 611* 613 613 672* 675* 679* leading_sw 000161 automatic bit(1) packed unaligned dcl 26 set ref 624* 628* 637 648 length builtin function dcl 53 ref 650 722 737 739 low builtin function dcl 53 ref 458 ltrim builtin function dcl 53 ref 465 480 480 483 483 max_args 000651 constant fixed bin(17,0) initial array dcl 69 ref 341 min builtin function dcl 53 ref 343 min_args 000615 constant fixed bin(17,0) initial array dcl 69 ref 339 n 000160 automatic fixed bin(17,0) dcl 26 set ref 410* 410 412 416 417 417 443* 443 445 449 452 455 458 null builtin function dcl 53 ref 332 751 options 000041 constant char(52) initial array packed unaligned dcl 69 set ref 684* 693* 703* release_temp_segment_ 000030 constant entry external dcl 58 ref 665 751 ret based varying char dcl 47 set ref 347* 350* 354* 380* 383* 387* 388* 388 389* 389 390* 390 394* 398* 399* 399 400* 400 401* 401 417* 433* 452* 455* 458* 465* 475 475* 475 476* 476 480* 483* 488* 492* 495* 498* 501* 516* 518* 563* 573* 576* 613* 617* 620* 638 638* 638 639* 639 642 642* 642 643* 643 649* 649 650 651 651 651* 651 664* reverse builtin function dcl 53 ref 488 488 492 492 492 492 492 492 498 498 498 498 498 498 516 516 516 516 516 516 516 516 521 521 527 563 563 563 563 567 rtrim builtin function dcl 53 ref 573 573 576 576 search builtin function dcl 53 ref 527 579 729 737 string parameter char packed unaligned dcl 717 set ref 713 722 728 729 730 734 737 737 739 739 string_array based char(1) array packed unaligned dcl 724 set ref 734 737 739 string_begin based char packed unaligned dcl 724 ref 734 string_end based char packed unaligned dcl 724 ref 737 739 substr builtin function dcl 53 set ref 388 389 399 400 563 563 613 613 628 649* 649 651 651 651* 651 sys_info$max_seg_size 000044 external static fixed bin(35,0) dcl 69 ref 336 translate builtin function dcl 53 ref 476 476 617 617 620 620 643 643 649 651 verify builtin function dcl 53 ref 358 364 374 427 510 567 659 NAMES DECLARED BY EXPLICIT CONTEXT. COMMON 002243 constant label dcl 321 ref 156 162 168 174 180 186 192 198 204 210 216 222 228 234 240 246 252 258 264 270 276 281 286 292 298 304 310 316 NO_TEMP_SEG 006226 constant label dcl 689 ref 335 af 001510 constant entry external dcl 159 after 001517 constant entry external dcl 159 bad_arg 006060 constant label dcl 677 ref 674 bad_bit_string 006256 constant label dcl 693 set ref 371 424 507 bad_conversion 006357 constant label dcl 700 set ref 362 367 377 408 430 441 513 536 543 586 593 be 001530 constant entry external dcl 165 before 001537 constant entry external dcl 165 bool 001550 constant entry external dcl 171 collate 001561 constant entry external dcl 177 collate9 001572 constant entry external dcl 183 copy_characters 001612 constant entry external dcl 189 cpch 001603 constant entry external dcl 189 decat 001623 constant entry external dcl 195 do 000000 constant label array(28) dcl 350 ref 348 do_hl 000034 constant label array(8:12) dcl 452 ref 451 double_quotes 006463 constant entry internal dcl 713 ref 350 354 417 433 476 480 483 488 492 498 501 516 518 563 573 576 613 617 620 639 643 high 001634 constant entry external dcl 201 high9 001645 constant entry external dcl 207 index 001656 constant entry external dcl 213 janitor 006725 constant entry internal dcl 749 ref 333 681 686 697 705 length 001676 constant entry external dcl 219 ln 001667 constant entry external dcl 219 low 001707 constant entry external dcl 225 lower_case 001727 constant entry external dcl 231 lowercase 001720 constant entry external dcl 231 ltrim 001740 constant entry external dcl 237 nonnegative_arg 006056 constant label dcl 675 set ref 414 447 557 607 positive_arg 006053 constant label dcl 672 ref 552 602 ret_num 003501 constant label dcl 464 ref 470 525 531 571 581 661 return 006002 constant label dcl 663 ref 352 356 381 392 403 419 434 449 454 457 460 466 478 484 490 496 502 519 565 577 615 622 657 reverse 001760 constant entry external dcl 243 reverse_after 002000 constant entry external dcl 249 reverse_before 002020 constant entry external dcl 255 reverse_decat 002040 constant entry external dcl 261 reverse_index 002060 constant entry external dcl 267 reverse_search 002100 constant entry external dcl 273 reverse_substr 002120 constant entry external dcl 278 reverse_verify 002140 constant entry external dcl 283 rtrim 002151 constant entry external dcl 289 rv 001751 constant entry external dcl 243 rvaf 001771 constant entry external dcl 249 rvbe 002011 constant entry external dcl 255 rvdecat 002031 constant entry external dcl 261 rvindex 002051 constant entry external dcl 267 rvsrh 002071 constant entry external dcl 273 rvsubstr 002111 constant entry external dcl 278 rvverify 002131 constant entry external dcl 283 search 002171 constant entry external dcl 295 srh 002162 constant entry external dcl 295 substr 001477 constant entry external dcl 24 translate 002202 constant entry external dcl 301 upper_case 002222 constant entry external dcl 307 uppercase 002213 constant entry external dcl 307 verify 002233 constant entry external dcl 313 wnoa 006141 constant label dcl 684 ref 339 341 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 10634 10702 7777 10644 Length 11210 7777 46 272 635 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME substr 344 external procedure is an external procedure. on unit on line 333 64 on unit on unit on line 405 64 on unit on unit on line 436 64 on unit on unit on line 533 64 on unit on unit on line 541 64 on unit on unit on line 583 64 on unit on unit on line 591 64 on unit double_quotes 73 internal procedure uses auto adjustable storage, uses returns(char(*)) or returns(bit(*)), and is called during a stack extension. janitor 78 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME double_quotes 000100 i double_quotes 000101 j double_quotes 000102 copied_string double_quotes substr 000100 Larg substr 000103 Lret substr 000104 Nargs substr 000105 Npic substr 000110 Parg substr 000116 Pret substr 000120 Scommand substr 000122 arg_ptr substr 000126 args_sw substr 000127 bit3 substr 000130 bit4 substr 000131 char3 substr 000132 char4 substr 000150 code substr 000151 e substr 000152 error substr 000156 i substr 000157 j substr 000160 n substr 000161 leading_sw substr THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp alloc_bit_temp cat_realloc_chars call_ent_var_desc call_ent_var call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other return_mac tra_ext_1 alloc_auto_adj mpfx2 enable_op shorten_stack ext_entry int_entry int_entry_desc fetch_bits repeat reverse_cs reverse_bs set_chars_eis set_bits_eis index_chars_eis return_chars_eis verify_eis search_eis any_to_any_truncate_ translate_2 translate_3 index_before_cs index_after_cs verify_for_ltrim verify_for_rtrim ix_rev_chars verify_rev_chars search_rev_chars THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. active_fnc_err_ com_err_ cu_$af_arg_ptr cu_$af_return_arg cu_$arg_count cu_$arg_ptr get_temp_segment_ ioa_ pl1_decat_char_ release_temp_segment_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_arg error_table_$bad_conversion error_table_$badopt error_table_$wrong_no_of_args sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 24 001476 155 001504 156 001506 159 001507 161 001524 162 001526 165 001527 167 001544 168 001546 171 001547 173 001555 174 001557 177 001560 179 001566 180 001570 183 001571 185 001577 186 001601 189 001602 191 001617 192 001621 195 001622 197 001630 198 001632 201 001633 203 001641 204 001643 207 001644 209 001652 210 001654 213 001655 215 001663 216 001665 219 001666 221 001703 222 001705 225 001706 227 001714 228 001716 231 001717 233 001734 234 001736 237 001737 239 001745 240 001747 243 001750 245 001765 246 001767 249 001770 251 002005 252 002007 255 002010 257 002025 258 002027 261 002030 263 002045 264 002047 267 002050 269 002065 270 002067 273 002070 275 002105 276 002107 278 002110 280 002125 281 002127 283 002130 285 002145 286 002147 289 002150 291 002156 292 002160 295 002161 297 002176 298 002200 301 002201 303 002207 304 002211 307 002212 309 002227 310 002231 313 002232 315 002240 316 002242 321 002243 322 002260 323 002262 324 002267 325 002272 326 002273 328 002274 329 002301 330 002304 331 002306 332 002314 333 002316 334 002340 335 002365 336 002367 339 002402 341 002406 343 002410 344 002421 345 002437 347 002441 348 002442 350 002444 352 002515 354 002517 356 002564 358 002566 360 002602 361 002603 362 002605 364 002606 365 002622 366 002623 367 002625 369 002626 370 002631 371 002633 373 002634 374 002640 375 002652 376 002653 377 002655 379 002656 380 002666 381 002761 383 002763 387 002777 388 003010 389 003022 390 003034 392 003043 394 003044 398 003060 399 003071 400 003103 401 003115 403 003124 405 003125 407 003141 408 003144 410 003147 411 003157 412 003160 413 003162 414 003164 416 003165 417 003167 419 003226 421 003230 423 003233 424 003235 426 003236 427 003243 428 003255 429 003256 430 003260 432 003261 433 003271 434 003353 436 003355 440 003371 441 003374 443 003377 444 003407 445 003410 446 003412 447 003414 449 003415 451 003416 452 003420 454 003434 455 003436 457 003452 458 003454 460 003470 462 003472 464 003501 465 003510 466 003532 468 003533 470 003535 472 003536 474 003545 475 003562 476 003577 477 003640 478 003643 480 003644 483 003720 484 003773 486 003775 488 004000 490 004034 492 004036 495 004122 496 004123 498 004124 501 004215 502 004250 504 004252 506 004255 507 004257 509 004260 510 004265 511 004277 512 004300 513 004302 515 004303 516 004313 518 004433 519 004516 521 004520 523 004527 525 004535 527 004536 529 004544 531 004551 533 004552 535 004566 536 004571 538 004574 539 004604 540 004605 541 004610 542 004624 543 004627 545 004632 546 004642 547 004643 548 004644 550 004646 551 004650 552 004652 554 004653 555 004656 556 004660 557 004662 559 004663 561 004665 563 004675 564 004743 565 004744 567 004745 569 004753 571 004760 573 004761 576 005034 577 005106 579 005110 581 005116 583 005117 585 005133 586 005136 588 005141 589 005151 590 005152 591 005155 592 005171 593 005174 595 005177 596 005207 597 005210 598 005211 600 005213 601 005215 602 005217 604 005220 605 005223 606 005225 607 005227 609 005230 611 005232 613 005242 614 005302 615 005303 617 005304 620 005347 622 005411 624 005413 626 005415 627 005425 628 005442 630 005461 632 005474 633 005532 634 005533 636 005534 637 005536 638 005540 639 005555 640 005610 642 005612 643 005627 644 005670 646 005671 648 005673 649 005675 650 005705 651 005715 655 005767 657 005772 659 005773 661 006001 663 006002 664 006004 665 006025 667 006052 672 006053 674 006055 675 006056 677 006060 678 006064 679 006067 681 006134 682 006140 684 006141 686 006221 687 006225 689 006226 691 006255 693 006256 697 006352 698 006356 700 006357 702 006363 703 006366 705 006455 706 006461 713 006462 722 006476 728 006507 729 006522 730 006537 731 006571 732 006573 733 006602 734 006604 735 006624 736 006636 737 006640 738 006660 739 006661 740 006705 741 006714 749 006724 751 006732 754 006765 ----------------------------------------------------------- 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