COMPILATION LISTING OF SEGMENT cref_listman_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/17/82 1629.9 mst Wed 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 /* format: style1,^inddcls,ifthenstmt,ifthendo,ifthen,indcomtxt,dclind5 */ 12 cref_listman_: proc; 13 14 /* This subroutine handles all the list structuring operations in the 15* cross-referencer database. 16* Completely redesigned and rewritten by C. D. Tavares 17* Modified by CDT 08/30/76 to fix minor chain-ordering bug in include file 18* block entry. 19* Modified 09/24/79 by CDT to make error message on line 589 more meaningful-- 20* also global cosmetic change to keep new version of PL/I compiler happy 21* (can't declare a like a anymore). 22* Modified 11/30/80 by CDT to fix misdeclared parameter. 23* Last modified 09/81 by CDT to retain language suffixes 24**/ 25 26 dcl cref_area_ptr pointer static, 27 cref_area area (sys_info$max_seg_size) based (cref_area_ptr); 28 29 dcl 1 cref_database aligned based (cref_database_ptr), 30 2 a_nullp pointer unaligned, 31 2 nullps (7) pointer unaligned, 32 2 buckets (0:2703) pointer unaligned, 33 2 environment_buckets 34 (0:127) pointer unaligned, 35 2 include_file_buckets 36 (0:127) pointer unaligned; 37 38 dcl cref_database_ptr pointer static initial (null); 39 40 dcl 1 primary_block aligned based (primary_block_ptr), 41 2 forward_chain pointer unaligned, 42 2 flags aligned, 43 3 is_segname bit (1) unaligned, 44 3 created_by_ref bit (1) unaligned, 45 3 is_external bit (1) unaligned, 46 3 ref_mismatch_noted 47 bit (1) unaligned, 48 3 only_predefined bit (1) unaligned, 49 3 predefined_unused_noted 50 bit (1) unaligned, 51 2 bound_seg_node pointer unaligned, 52 2 dir_node pointer unaligned, 53 2 synonym_forward_chain 54 pointer unaligned, 55 2 master_synonym_node 56 pointer unaligned, 57 2 definition_node pointer unaligned, 58 2 reference_node pointer unaligned, 59 2 implicit_definition_chain 60 pointer unaligned, 61 2 include_file_node pointer unaligned, 62 2 crossref_chain pointer unaligned, 63 2 crossref_chain_end pointer unaligned, 64 2 lang_suffix_node pointer unaligned, 65 2 acc_length fixed bin (8) unaligned, 66 2 name char (charlen refer (primary_block.acc_length)) 67 unaligned; 68 69 dcl primary_block_ptr pointer; 70 71 dcl 1 attribute_block aligned based (attribute_ptr), 72 2 n_entries fixed bin (35), 73 2 attribute_nodes (n_elements refer (n_entries)) pointer unaligned; 74 75 dcl attribute_ptr pointer; 76 77 dcl 1 include_file_block aligned based (include_file_ptr), 78 2 forward_chain pointer unaligned, 79 2 dtm bit (72), 80 2 crossref_chain pointer unaligned, 81 2 crossref_chain_end pointer unaligned, 82 2 acc_length fixed bin (8) unaligned, 83 2 name char 84 (charlen refer (include_file_block.acc_length)) 85 unaligned; 86 87 dcl include_file_ptr pointer; 88 89 dcl 1 string_block aligned based (string_ptr), 90 2 forward_chain pointer unaligned, 91 2 bindfile_found bit (1) unaligned, 92 2 pad bit (8) unaligned, 93 2 acc_length fixed bin (8) unaligned, 94 2 string char (charlen refer (string_block.acc_length)) 95 unaligned; 96 97 dcl string_ptr pointer; 98 99 dcl 1 crossref_block aligned based (crossref_block_ptr), 100 2 forward_chain pointer unaligned, 101 2 crossref_node pointer unaligned; 102 103 dcl crossref_block_ptr pointer; 104 105 dcl 1 implicit_def_block aligned based (implicit_def_block_ptr), 106 2 forward_chain pointer unaligned, 107 2 def_node pointer unaligned; 108 109 dcl implicit_def_block_ptr pointer; 110 111 dcl cref_filegen_$report_error 112 entry options (variable), 113 sub_err_ entry options (variable), 114 error_table_$namedup ext fixed bin (35), 115 error_table_$noentry ext fixed bin (35), 116 sys_info$max_seg_size fixed bin (35) external, 117 charlen fixed bin; 118 119 dcl i fixed bin; 120 121 create_primary_block_acc: 122 entry (acc_ptr, bound_seg_node, dir_node, is_segname, defining, 123 is_external) returns (pointer); 124 125 dcl acc_ptr pointer parameter, 126 (bound_seg_node, 127 dir_node) pointer parameter, 128 (is_segname, 129 defining, 130 is_external) bit (1) aligned; 131 132 dcl node pointer; 133 134 dcl 1 based_acc_string aligned based (acc_ptr), 135 2 length fixed bin (9) unaligned unsigned, 136 2 string char (based_acc_string.length) unaligned; 137 138 dcl temp_ptr pointer, 139 first_block_ptr pointer, 140 bucket fixed bin, 141 prev_ptr pointer; 142 143 dcl (addr, dim, hbound, 144 index, length, 145 max, null, rank, 146 rtrim, substr) builtin; 147 148 149 node = match_or_create_block ((based_acc_string.string), 150 bound_seg_node, dir_node, null, is_segname, defining, 151 ""b, is_external); 152 153 return (node); 154 155 create_primary_block_char: 156 entry (char_string, bound_seg_node, dir_node, suffix_node, 157 is_segname, defining, is_external) returns (pointer); 158 159 dcl (char_string char (*) varying, 160 suffix_node pointer) parameter; 161 162 node = match_or_create_block ((char_string), 163 bound_seg_node, dir_node, suffix_node, is_segname, defining, 164 ""b, is_external); 165 166 return (node); 167 168 predefine_primary_block_char: 169 entry (char_string, bound_seg_node, dir_node, is_segname, defining, 170 is_external) returns (pointer); 171 172 node = match_or_create_block ((char_string), 173 bound_seg_node, dir_node, null, is_segname, defining, 174 "1"b, is_external); 175 176 return (node); 177 178 /* format: ind3 */ 179 180 match_or_create_block: proc (name, bound_seg_node, dir_node, suffix_node, 181 is_segname, defining, predefining, is_external) 182 returns (pointer); 183 184 dcl name char (32) varying parameter, 185 (bound_seg_node, 186 dir_node, 187 suffix_node) pointer parameter, 188 (is_segname, 189 defining, 190 predefining, 191 is_external) bit (1) aligned parameter; 192 193 dcl found bit (1) aligned; 194 195 dcl primary_blk_ptr pointer; 196 197 dcl 1 primary_blk like primary_block aligned based (primary_blk_ptr); 198 199 dcl already_found bit (1) aligned, 200 already_found_ptr pointer; 201 202 dcl node pointer; 203 204 205 /* Try to find a block with this name already created. */ 206 207 primary_blk_ptr = null; 208 209 call find_block (name, primary_blk_ptr, is_segname, found); 210 211 if found then do; 212 213 if is_segname then do; 214 215 /* The block found must abide by certain rules controlling environment 216* matching. Prepare to see it it does. Remember where we found the first 217* matching block in case none of the rules work out. */ 218 219 first_block_ptr = primary_blk_ptr; 220 221 if defining then do; 222 223 /* Expect we really wanted to create one. Before creating, check to see that 224* no other external symbol exists in the same directory with the same name. 225* Print different error messages depending on whether both names (if found) 226* are found in the same bound segment. (unlikely, but stranger things...) */ 227 228 do while (found); 229 230 if primary_blk.dir_node = dir_node then do; 231 232 /* Claims there's a seg of the same name in the same dir. Check it out. */ 233 234 if check_dups_in_dir_ok () then 235 return (primary_blk_ptr); 236 end; 237 238 else if primary_blk.dir_node = null & 239 primary_blk.bound_seg_node = null then 240 do; 241 242 /* This block is a predefined synonym. Polish it off. */ 243 244 call set_predefined_synonym; 245 return (primary_blk_ptr); 246 end; 247 248 call find_block 249 (name, primary_blk_ptr, is_segname, found); 250 end; 251 end; 252 253 254 /* If we're not defining, we're searching. */ 255 256 else do; 257 258 /* First rule: Search for name in same bound_seg in same dir. If found, use 259* it. */ 260 261 do while (found); 262 263 if primary_blk.bound_seg_node = bound_seg_node 264 & primary_blk.dir_node = dir_node then 265 return 266 (find_master_block (primary_blk_ptr)); 267 268 call find_block 269 (name, primary_blk_ptr, is_segname, found); 270 end; 271 272 /* Second rule: Search for external occurrence of same name in same dir. If 273* found, use. */ 274 275 found = "1"b; 276 primary_blk_ptr = first_block_ptr; 277 278 do while (found); 279 280 if primary_blk.dir_node = dir_node 281 & primary_blk.is_external then 282 return 283 (find_master_block (primary_blk_ptr)); 284 285 call find_block 286 (name, primary_blk_ptr, is_segname, found); 287 end; 288 289 /* Third rule: Search for any external occurrence of segname, and use it. 290* Just for safety's sake, continue to check for another match with same 291* criteria. If more than once match does occur, complain, but stick to your 292* choice, because it's as good as any. */ 293 294 already_found = ""b; 295 found = "1"b; 296 primary_blk_ptr = first_block_ptr; 297 298 do while (found); 299 300 if primary_blk.is_external then 301 if already_found then do; 302 call cref_filegen_$report_error 303 (error_table_$namedup, 304 "cref_listman_", 305 "References to ^a are ambiguous.", 306 name); 307 308 /* Don't print the error message more than once */ 309 310 already_found_ptr -> 311 primary_blk.ref_mismatch_noted 312 = "1"b; 313 314 return (already_found_ptr); 315 end; 316 317 else do; 318 if primary_blk.ref_mismatch_noted 319 320 /* No use complaining about this one again */ 321 322 then return (find_master_block 323 (primary_blk_ptr)); 324 325 already_found_ptr = 326 find_master_block 327 (primary_blk_ptr); 328 already_found = "1"b; 329 end; 330 331 call find_block 332 (name, primary_blk_ptr, is_segname, found); 333 end; 334 335 /* Return the solid match, if we got one */ 336 337 if already_found then return (already_found_ptr); 338 339 end; 340 end; 341 342 343 /* If it isn't a segname, it's a definition. Try to match the environments */ 344 345 else do while (found); 346 if primary_blk.bound_seg_node = bound_seg_node then 347 return (primary_blk_ptr); 348 349 call find_block 350 (name, primary_blk_ptr, is_segname, found); 351 end; 352 353 end; 354 355 356 /* Couldn't find any match. Time to create a new block. */ 357 358 prev_ptr = primary_blk_ptr; 359 360 charlen = length (name); 361 allocate primary_blk in (cref_area); 362 363 /* Insert name and environmentts */ 364 365 primary_blk.name = name; 366 primary_blk.lang_suffix_node = suffix_node; 367 primary_blk.synonym_forward_chain = null; 368 primary_blk.master_synonym_node = null; 369 primary_blk.definition_node = null; 370 primary_blk.reference_node = null; 371 primary_blk.implicit_definition_chain = null; 372 primary_blk.include_file_node = null; 373 primary_blk.crossref_chain = null; 374 primary_blk.crossref_chain_end = null; 375 primary_blk.bound_seg_node = bound_seg_node; 376 primary_blk.dir_node = dir_node; 377 primary_blk.flags.is_segname = is_segname; 378 primary_blk.is_external = is_external | ^defining; 379 primary_blk.only_predefined = predefining; 380 381 /* If we are defining a synonym make sure it doesn't look like a wild ref */ 382 383 if (dir_node ^= null & bound_seg_node ^= null) then 384 primary_blk.created_by_ref = ^defining & is_segname; 385 386 call chain_on (prev_ptr, primary_blk_ptr); 387 388 return (primary_blk_ptr); 389 390 check_dups_in_dir_ok: proc returns (bit (1)); 391 392 /* Why an internal procedure? To control the damn indenting. */ 393 394 if primary_blk.bound_seg_node = bound_seg_node then do; 395 396 /* Same module already defined. What's up? */ 397 398 if (dir_node ^= null | bound_seg_node ^= null) then 399 400 /* It's a solid match, not just a don't care match... */ 401 402 if ^predefining then do; 403 404 /* ...and we're not predefining it now from a bindfile... */ 405 406 if ^primary_blk.only_predefined then 407 408 /* ...and it wasn't formerly predefined by a bindfile-- must be an error */ 409 410 call cref_filegen_$report_error 411 (error_table_$namedup, "cref_listman_", 412 "^a (^a) in ^a", name, 413 bound_seg_node -> string_block.string, 414 dir_node -> string_block.string); 415 416 /* In any case, we're defining it NOW, so turn off the predefined bit */ 417 418 else do; 419 primary_blk.only_predefined = ""b; 420 primary_blk.lang_suffix_node = suffix_node; 421 end; 422 end; 423 return ("1"b); 424 end; 425 426 else if is_external then 427 428 /* Aarrgh. The dirs are the same, but the bound segs are different. */ 429 430 if primary_blk.is_external then 431 call cref_filegen_$report_error 432 (error_table_$namedup, "cref_listman_", 433 "Multiple occurrences of ^a in ^a.", 434 name, dir_node -> string_block.string); 435 436 return ("0"b); 437 438 end check_dups_in_dir_ok; 439 440 set_predefined_synonym: proc; 441 442 443 /* Find the master synonym upon which to work our wiles. */ 444 445 if primary_blk.master_synonym_node = null then 446 temp_ptr = primary_blk_ptr; 447 else temp_ptr = 448 primary_blk.master_synonym_node; 449 450 node = temp_ptr; /* anything's OK */ 451 452 /* Chain through all the synonyms, setting the environments */ 453 454 do temp_ptr = temp_ptr repeat (node) while (node ^= null); 455 456 temp_ptr -> primary_blk.dir_node = dir_node; 457 temp_ptr -> primary_blk.bound_seg_node = bound_seg_node; 458 459 node = temp_ptr -> primary_blk.synonym_forward_chain; 460 461 end; 462 463 return; 464 465 end set_predefined_synonym; 466 467 find_block: procedure (string, primary_blk_ptr, is_segname, found); 468 469 dcl string char (32) varying parameter, 470 primary_blk_ptr pointer parameter, 471 found bit (1) aligned parameter, 472 is_segname bit (1) aligned parameter; 473 474 dcl 1 primary_blk like primary_block aligned based (primary_blk_ptr); 475 476 dcl key char (2), 477 (high_hash, low_hash) fixed bin; 478 479 dcl legal_chars char (52) static initial 480 ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"); 481 482 /* These aren't the only legal chars of course, but they are the only chars 483* allowed as the first char in a segname or entryname. */ 484 485 486 found = ""b; 487 488 /* If this is a plain old search, hash the string and get to it */ 489 490 if primary_blk_ptr = null then do; 491 (nostrz): key = string; 492 high_hash = index (legal_chars, substr (key, 1, 1)) - 1; 493 low_hash = index (legal_chars, substr (key, 2, 1)) - 1; 494 bucket = max (high_hash * length (legal_chars) + low_hash, 0); 495 496 /* Set fake prev_ptr to point to bucket chain in case first loop exits */ 497 498 prev_ptr = addr (cref_database.buckets (bucket)); 499 500 if cref_database.buckets (bucket) = null then do; 501 found = ""b; 502 primary_blk_ptr = prev_ptr; 503 return; 504 end; 505 506 primary_blk_ptr = cref_database.buckets (bucket); 507 end; 508 509 else do; 510 if primary_blk.forward_chain = null then return; 511 prev_ptr = primary_blk_ptr; 512 primary_blk_ptr = primary_blk.forward_chain; 513 end; 514 515 516 do primary_blk_ptr = primary_blk_ptr 517 repeat (primary_blk.forward_chain); 518 519 /* Look for match or at least a good place to add new block */ 520 521 if primary_blk.is_segname = is_segname then /* MUST match */ 522 if primary_blk.name = string then do; 523 found = "1"b; 524 return; 525 end; 526 527 /* If we've run too far in alphabetical order, back up and point to good place 528* to chain in */ 529 530 if primary_blk.name > string then do; 531 primary_blk_ptr = prev_ptr; 532 return; 533 end; 534 535 /* End of chain? Maybe we will want to chain in here later. */ 536 537 else if primary_blk.forward_chain = null then return; 538 539 prev_ptr = primary_blk_ptr; /* loop... */ 540 end; 541 542 end find_block; 543 544 find_master_block: proc (found_ptr) returns (ptr); 545 546 dcl found_ptr pointer; 547 548 549 if found_ptr -> primary_blk.master_synonym_node = null then 550 return (found_ptr); 551 return (found_ptr -> primary_blk.master_synonym_node); 552 553 end find_master_block; 554 end match_or_create_block; 555 556 /* format: revert */ 557 558 create_syn_block: entry (char_string, bound_seg_node, dir_node, is_external, 559 master_synonym_node); 560 561 dcl master_synonym_node pointer; 562 563 dcl master_block_ptr pointer; 564 565 566 master_block_ptr = master_synonym_node; 567 568 /* Don't syn anything to itself */ 569 570 if master_block_ptr -> primary_block.name = char_string then return; 571 572 primary_block_ptr = match_or_create_block 573 ((char_string), bound_seg_node, dir_node, null, "1"b, 574 ^master_block_ptr -> primary_block.created_by_ref, ""b, 575 is_external); 576 577 /* Don't do the same syn twice */ 578 579 if primary_block.master_synonym_node ^= null then do; 580 temp_ptr = primary_block.master_synonym_node; 581 call cref_filegen_$report_error (0, "cref_listman_", 582 "^a cannot be made synonymous with ^a; 583 ^-already synonymous to ^a.", 584 char_string, master_block_ptr -> primary_block.name, 585 temp_ptr -> primary_block.name); 586 return; 587 end; 588 589 /* Patch new block into the forward synonym chain */ 590 591 if (primary_block_ptr = null | master_block_ptr = null) then 592 call sub_err_ (0, "cross_reference", "s", null, 0, 593 "Inconsistency in synonym chains."); 594 595 primary_block_ptr -> primary_block.synonym_forward_chain = 596 master_block_ptr -> primary_block.synonym_forward_chain; 597 master_block_ptr -> primary_block.synonym_forward_chain = 598 primary_block_ptr; 599 600 /* Chain master synonym slot to head honcho synonym */ 601 602 primary_block_ptr -> primary_block.master_synonym_node = 603 master_synonym_node; 604 605 return; 606 607 create_include_file_block: entry (char_string, date_time_modified) 608 returns (pointer); 609 610 dcl date_time_modified bit (72) parameter; 611 612 dcl satisfied bit (1); 613 614 615 /* Hash by first character */ 616 617 bucket = rank (substr (char_string, 1, 1)); 618 619 satisfied = ""b; 620 621 prev_ptr = addr (cref_database.include_file_buckets (bucket)); 622 623 /* Try finding an already existing block for this include file */ 624 625 if cref_database.include_file_buckets (bucket) ^= null then 626 do include_file_ptr = 627 cref_database.include_file_buckets (bucket) 628 repeat (include_file_block.forward_chain) 629 while (^satisfied); 630 631 if include_file_block.name = char_string then 632 if include_file_block.dtm = date_time_modified then 633 return (include_file_ptr); 634 635 else if include_file_block.dtm > date_time_modified 636 then do; 637 638 /* Remember to keep them sorted by dtm */ 639 640 include_file_ptr = prev_ptr; 641 satisfied = "1"b; 642 end; 643 644 /* If we've passed it in alphabetical order, back up */ 645 646 if include_file_block.name > char_string then do; 647 include_file_ptr = prev_ptr; 648 satisfied = "1"b; 649 end; 650 651 /* If we're at the end of the chain, punt */ 652 653 else if include_file_block.forward_chain = null then 654 satisfied = "1"b; 655 656 prev_ptr = include_file_ptr; 657 end; 658 659 /* Didn't find it; looks like time to create one */ 660 661 charlen = length (char_string); 662 allocate include_file_block in (cref_area); 663 664 include_file_block.dtm = date_time_modified; 665 include_file_block.name = char_string; 666 include_file_block.forward_chain = null; 667 include_file_block.crossref_chain = null; 668 include_file_block.crossref_chain_end = null; 669 670 call chain_on (prev_ptr, include_file_ptr); 671 672 return (include_file_ptr); 673 674 create_environment: entry (description, bindfile_found) returns (pointer); 675 676 dcl description char (*) varying parameter, 677 bindfile_found bit (1) aligned parameter; 678 679 node = make_string (description); 680 return (node); 681 682 get_name: entry (node_no) returns (char (32) varying); 683 684 dcl node_no pointer parameter; 685 686 dcl temp_string char (32) varying; 687 688 primary_block_ptr = node_no; 689 temp_string = primary_block.name; 690 return (temp_string); 691 692 693 get_name_with_suffix: entry (node_no) returns (char (32) varying); 694 695 primary_block_ptr = node_no; 696 temp_string = primary_block.name; 697 string_ptr = primary_block.lang_suffix_node; 698 if string_ptr ^= null then 699 temp_string = rtrim (temp_string) || string_block.string; 700 else temp_string = rtrim (temp_string) || ".?"; 701 return (temp_string); 702 703 assign_def_block: entry (attribute_array, n_elements, master_node); 704 705 dcl master_node pointer parameter, 706 attribute_array (*) pointer parameter, 707 n_elements fixed bin; 708 709 primary_block_ptr = master_node; 710 711 primary_block.definition_node = assign_attribute_block (); 712 return; 713 714 715 assign_ref_block: entry (attribute_array, n_elements, master_node); 716 717 primary_block_ptr = master_node; 718 719 primary_block.reference_node = assign_attribute_block (); 720 return; 721 722 723 assign_include_file_block: entry (attribute_array, n_elements, master_node); 724 725 primary_block_ptr = master_node; 726 727 primary_block.include_file_node = assign_attribute_block (); 728 return; 729 730 assign_attribute_block: proc returns (pointer); 731 732 if n_elements = 0 then return (null); 733 734 allocate attribute_block in (cref_area); 735 736 do i = 1 to n_elements; 737 attribute_block.attribute_nodes (i) = attribute_array (i); 738 end; 739 740 return (attribute_ptr); 741 742 end assign_attribute_block; 743 744 /* format: ind3 */ 745 746 get_consecutive_segnames: entry (node_arg, bucket_arg) returns (pointer aligned); 747 748 dcl node_arg pointer parameter, 749 bucket_arg fixed bin parameter; 750 751 752 node = node_arg; 753 754 /* If there is no "leftover" node input value, this is the first call to me */ 755 756 if node = null then bucket_arg = 0; 757 758 /* Otherwise, start search from the next bucket */ 759 760 else do; 761 primary_block_ptr = node; 762 node = primary_block_ptr -> primary_block.forward_chain; 763 if node = null then bucket_arg = bucket_arg + 1; 764 end; 765 766 /* Chain through buckets to find next block */ 767 768 do while ("1"b); 769 770 /* Skip dead buckets */ 771 772 do bucket_arg = bucket_arg to hbound (buckets, 1) 773 while (cref_database.buckets (bucket_arg) = null); 774 end; 775 776 /* When we run out of buckets, quit */ 777 778 if bucket_arg > hbound (buckets, 1) then return (null); 779 780 /* Special initial conditions case */ 781 782 if node = null then 783 node = cref_database.buckets (bucket_arg); 784 785 primary_block_ptr = node; 786 787 do primary_block_ptr = primary_block_ptr 788 repeat (node) while (node ^= null); 789 790 if primary_block.only_predefined then do; 791 if ^primary_block.predefined_unused_noted then do; 792 call cref_filegen_$report_error 793 (0, "cref_listman_", 794 "Warning: Synonyms were defined for ^a, 795 ^-but ^a was not in the search list.", 796 primary_block.name, primary_block.name); 797 primary_block.predefined_unused_noted = "1"b; 798 end; 799 end; 800 801 802 else if primary_block.flags.is_segname then do; 803 804 /* Got one. Make sure it's not an internal synonym */ 805 806 if primary_block.is_external then return (node); 807 808 /* Of course, if it's internal and NOT a synonym, we still want it */ 809 810 else if primary_block.master_synonym_node = null then 811 return (node); 812 end; 813 814 node = primary_block.forward_chain; 815 end; 816 817 bucket_arg = bucket_arg + 1; /* next bucket */ 818 819 end; 820 821 get_consecutive_include_files: entry (node_arg, bucket_arg, char_string, date_time_modified) returns (pointer aligned); 822 823 824 /* This is much the same as the entry above. See it for comments. */ 825 826 node = node_arg; 827 828 if node = null then bucket_arg = 0; 829 830 else do; 831 include_file_ptr = node; 832 node = include_file_ptr -> include_file_block.forward_chain; 833 if node = null then bucket_arg = bucket_arg + 1; 834 end; 835 836 do bucket_arg = bucket_arg to hbound (include_file_buckets, 1) 837 while (cref_database.include_file_buckets (bucket_arg) = null); 838 end; 839 840 if bucket_arg > hbound (include_file_buckets, 1) then return (null); 841 842 if node = null then 843 node = cref_database.include_file_buckets (bucket_arg); 844 845 include_file_ptr = node; 846 847 char_string = include_file_block.name; 848 date_time_modified = include_file_block.dtm; 849 return (node); 850 851 get_refs: entry (node_arg, attribute_array, n_elements); 852 853 dcl (Refs initial (1), 854 Defs initial (2), 855 Incls initial (3)) internal static fixed bin 856 options (constant); 857 858 call get_attribute_block (Refs); 859 return; 860 861 862 get_defs: entry (node_arg, attribute_array, n_elements); 863 864 call get_attribute_block (Defs); 865 return; 866 867 868 get_include_files: entry (node_arg, attribute_array, n_elements); 869 870 call get_attribute_block (Incls); 871 return; 872 873 get_attribute_block: proc (which_type); 874 875 dcl which_type fixed bin; 876 877 dcl which_node pointer; 878 879 880 n_elements = 0; 881 882 primary_block_ptr = node_arg; 883 884 /* Don't return refs or include files for synonyms; otherwise find master 885* block for this synonym */ 886 887 if primary_block.master_synonym_node ^= null then 888 if which_type ^= Defs then return; 889 else primary_block_ptr = primary_block.master_synonym_node; 890 891 if which_type = Refs then 892 which_node = primary_block.reference_node; 893 else if which_type = Defs then 894 which_node = primary_block.definition_node; 895 else if which_type = Incls then 896 which_node = primary_block.include_file_node; 897 else which_node = null; 898 899 if which_node = null then return; 900 901 attribute_ptr = which_node; 902 903 if attribute_block.n_entries > dim (attribute_array, 1) then do; 904 n_elements = -1; 905 return; 906 end; 907 908 n_elements = attribute_block.n_entries; 909 910 do i = 1 to n_elements; 911 attribute_array (i) = attribute_block.attribute_nodes (i); 912 end; 913 914 return; 915 end get_attribute_block; 916 917 assign_crossref: entry (node_arg, crossref_node); 918 919 dcl crossref_node pointer; 920 921 dcl (Program initial (1), 922 Include_file initial (2)) static options (constant) fixed bin; 923 924 call append_crossref (Program); 925 return; 926 927 928 929 assign_include_file_crossref: entry (node_arg, crossref_node); 930 931 call append_crossref (Include_file); 932 return; 933 934 append_crossref: proc (which_type); 935 936 dcl which_type fixed bin; 937 938 allocate crossref_block in (cref_area); 939 940 crossref_block.crossref_node = crossref_node; 941 crossref_block.forward_chain = null; 942 943 if which_type = Program then do; 944 945 primary_block_ptr = node_arg; 946 947 /* Find master if this is synonym */ 948 949 if primary_block.master_synonym_node ^= null then 950 primary_block_ptr = primary_block.master_synonym_node; 951 952 if primary_block.crossref_chain = null then /* start chain */ 953 primary_block.crossref_chain = crossref_block_ptr; 954 955 else do; 956 957 /* Spend a little care to keep them in alphabetical order */ 958 959 temp_ptr = primary_block.crossref_chain_end; 960 call chain_on (temp_ptr, crossref_block_ptr); 961 end; 962 963 primary_block.crossref_chain_end = crossref_block_ptr; 964 end; 965 966 967 else if which_type = Include_file then do; 968 969 /* Same comments as above */ 970 971 include_file_ptr = node_arg; 972 973 if include_file_block.crossref_chain = null then 974 include_file_block.crossref_chain = crossref_block_ptr; 975 976 else do; 977 temp_ptr = include_file_block.crossref_chain_end; 978 call chain_on (temp_ptr, crossref_block_ptr); 979 end; 980 981 include_file_block.crossref_chain_end = crossref_block_ptr; 982 end; 983 984 return; 985 end append_crossref; 986 987 create_implicit_def: entry (node_arg, new_def_node); 988 989 dcl new_def_node pointer; 990 991 992 allocate implicit_def_block in (cref_area); 993 994 implicit_def_block.def_node = new_def_node; 995 implicit_def_block.forward_chain = null; 996 997 primary_block_ptr = node_arg; 998 999 /* Don't take any wooden synonyms */ 1000 1001 if primary_block.master_synonym_node ^= null then 1002 primary_block_ptr = primary_block.master_synonym_node; 1003 1004 if primary_block.implicit_definition_chain = null then 1005 primary_block.implicit_definition_chain = 1006 implicit_def_block_ptr; 1007 1008 else call chain_on 1009 (addr (primary_block.implicit_definition_chain), 1010 implicit_def_block_ptr); 1011 1012 return; 1013 1014 get_primary_block_long: entry (node_arg, name_array, n_names, is_synonym, 1015 dir_description, bound_segment_name); 1016 1017 dcl name_array char (32) varying dimension (*), 1018 is_synonym bit (1) aligned parameter, 1019 (dir_description, 1020 bound_segment_name) char (*) varying parameter, 1021 n_names fixed bin parameter; 1022 1023 1024 primary_block_ptr = node_arg; 1025 1026 /* No environments for things that were created by reference (unfound) or 1027* synonyms */ 1028 1029 if primary_block.created_by_ref then 1030 dir_description, bound_segment_name = ""; 1031 1032 else if primary_block.master_synonym_node ^= null then 1033 dir_description, bound_segment_name = ""; 1034 1035 1036 else do; 1037 string_ptr = primary_block.dir_node; 1038 dir_description = string_block.string; 1039 1040 string_ptr = primary_block.bound_seg_node; 1041 bound_segment_name = string_block.string; 1042 if ^string_block.bindfile_found then do; 1043 call cref_filegen_$report_error 1044 (0, "cref_listman_", 1045 "Warning - no bindfile found for ^a.", 1046 bound_segment_name); 1047 1048 /* Hack the bindfile-found bit just to shut up multiple error messages */ 1049 1050 string_block.bindfile_found = "1"b; 1051 end; 1052 1053 if primary_block.only_predefined then do; 1054 call cref_filegen_$report_error 1055 (error_table_$noentry, "cref_listman_", 1056 "Bindfile for ^a contained nonexistent component ^a", 1057 bound_segment_name, primary_block.name); 1058 1059 /* Hack this bit too, same reason */ 1060 1061 primary_block.only_predefined = ""b; 1062 end; 1063 end; 1064 1065 name_array (1) = primary_block.name; 1066 n_names = 1; 1067 1068 if primary_block.master_synonym_node ^= null then do; 1069 is_synonym = "1"b; 1070 primary_block_ptr = primary_block.master_synonym_node; 1071 1072 if dim (name_array, 1) < 2 then do; 1073 n_names = -1; 1074 return; 1075 end; 1076 1077 n_names = 2; 1078 name_array (2) = primary_block.name; 1079 return; 1080 end; 1081 1082 else is_synonym = ""b; 1083 1084 if primary_block.synonym_forward_chain ^= null then do; 1085 1086 do n_names = 2 by 1 1087 while (primary_block.synonym_forward_chain ^= null); 1088 1089 /* Fill in synonyms */ 1090 1091 primary_block_ptr = primary_block.synonym_forward_chain; 1092 1093 if n_names > dim (name_array, 1) then do; 1094 n_names = -1; 1095 return; 1096 end; 1097 1098 name_array (n_names) = primary_block.name; 1099 end; 1100 1101 n_names = n_names - 1; /* hack for loop */ 1102 end; 1103 1104 return; 1105 1106 get_implicit_defs: entry (node_arg, attribute_array, n_elements); 1107 1108 1109 /* This is like all the entries above, look up for comments. */ 1110 1111 primary_block_ptr = node_arg; 1112 n_elements = 0; 1113 1114 if primary_block.master_synonym_node ^= null then 1115 primary_block_ptr = primary_block.master_synonym_node; 1116 1117 if primary_block.implicit_definition_chain = null then return; 1118 1119 node = primary_block.implicit_definition_chain; 1120 1121 do implicit_def_block_ptr = primary_block.implicit_definition_chain 1122 repeat (node) 1123 while (node ^= null); /* chain thru, picking up implicit defs */ 1124 1125 n_elements = n_elements + 1; 1126 if n_elements > dim (attribute_array, 1) then do; 1127 n_elements = -1; 1128 return; 1129 end; 1130 1131 attribute_array (n_elements) = implicit_def_block.def_node; 1132 1133 node = implicit_def_block.forward_chain; 1134 end; 1135 1136 return; 1137 1138 get_crossrefs: entry (node_arg, attribute_array, n_elements); 1139 1140 call get_crossref_chain (Program); 1141 return; 1142 1143 1144 1145 get_include_file_crossrefs: entry (node_arg, attribute_array, n_elements); 1146 1147 call get_crossref_chain (Include_file); 1148 return; 1149 1150 get_crossref_chain: proc (which_type); 1151 1152 dcl which_type fixed bin parameter; 1153 1154 n_elements = 0; 1155 1156 if which_type = Program then do; 1157 primary_block_ptr = node_arg; 1158 1159 if primary_block.crossref_chain = null then return; 1160 1161 node = primary_block.crossref_chain; 1162 end; 1163 1164 else if which_type = Include_file then do; 1165 include_file_ptr = node_arg; 1166 1167 if include_file_block.crossref_chain = null then return; 1168 1169 node = include_file_block.crossref_chain; 1170 end; 1171 1172 do crossref_block_ptr = node 1173 repeat (node) while (node ^= null); 1174 1175 n_elements = n_elements + 1; 1176 if n_elements > dim (attribute_array, 1) then do; 1177 n_elements = -1; 1178 return; 1179 end; 1180 1181 attribute_array (n_elements) = crossref_block.crossref_node; 1182 1183 node = crossref_block.forward_chain; 1184 end; 1185 1186 return; 1187 end get_crossref_chain; 1188 1189 init: entry (segp); 1190 1191 dcl segp pointer; 1192 1193 1194 cref_area_ptr = segp; 1195 1196 allocate cref_database in (cref_area); 1197 1198 cref_database.nullps = null; /* to catch bugs */ 1199 cref_database.a_nullp = null; /* same here */ 1200 cref_database.buckets = null; 1201 cref_database.environment_buckets = null; 1202 cref_database.include_file_buckets = null; 1203 return; 1204 1205 chain_on: proc (chain_word_ptr, curr_block_ptr); 1206 1207 /* This internal subroutine causes the chain word at chain_word_ptr to point 1208* to the block at curr_block_ptr, relinking the chain after chaining the 1209* curent block in. */ 1210 1211 dcl (chain_word_ptr, curr_block_ptr) pointer parameter; 1212 1213 dcl based_pointer pointer unaligned based; 1214 1215 curr_block_ptr -> based_pointer = chain_word_ptr -> based_pointer; 1216 chain_word_ptr -> based_pointer = curr_block_ptr; 1217 return; 1218 1219 end chain_on; 1220 1221 make_string: proc (string_arg) returns (pointer); 1222 1223 dcl string_arg char (*) varying; 1224 1225 dcl satisfied bit (1) aligned; 1226 1227 1228 bucket = rank (substr (string_arg, max (1, length (string_arg) - 2), 1)); 1229 1230 /* We use the next-to-last char, not first, because using first would cause 1231* all the "bound_..." to hash into "b", all the dirs to hash into ">", and 1232* almost nothing anywhere else. Using last char would mean having a run on 1233* "_". */ 1234 1235 satisfied = ""b; 1236 1237 prev_ptr = addr (cref_database.environment_buckets (bucket)); 1238 1239 if cref_database.environment_buckets (bucket) ^= null then 1240 do string_ptr = cref_database.environment_buckets (bucket) 1241 repeat (string_block.forward_chain) 1242 while (^satisfied); 1243 1244 if string_block.string = string_arg then do; 1245 if bindfile_found then string_block.bindfile_found = "1"b; 1246 return (string_ptr); 1247 end; 1248 1249 if string_block.forward_chain = null then do; 1250 satisfied = "1"b; 1251 string_ptr = prev_ptr; 1252 end; 1253 1254 prev_ptr = string_ptr; 1255 end; 1256 1257 charlen = length (string_arg); 1258 allocate string_block in (cref_area); 1259 1260 string_block.string = string_arg; 1261 string_block.forward_chain = null; 1262 string_block.bindfile_found = bindfile_found; 1263 1264 call chain_on (prev_ptr, string_ptr); 1265 1266 return (string_ptr); 1267 end make_string; 1268 1269 end cref_listman_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/17/82 1623.3 cref_listman_.pl1 >spec>on>11/17/82>cref_listman_.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. Defs constant fixed bin(17,0) initial dcl 853 set ref 864* 887 893 Incls constant fixed bin(17,0) initial dcl 853 set ref 870* 895 Include_file constant fixed bin(17,0) initial dcl 921 set ref 931* 967 1147* 1164 Program constant fixed bin(17,0) initial dcl 921 set ref 924* 943 1140* 1156 Refs constant fixed bin(17,0) initial dcl 853 set ref 858* 891 a_nullp based pointer level 2 packed unaligned dcl 29 set ref 1199* acc_length 15 based fixed bin(8,0) level 2 in structure "primary_block" packed unaligned dcl 40 in procedure "cref_listman_" set ref 361* 365 521 530 570 581 581 581 581 689 696 792 792 792 792 1054 1054 1065 1078 1098 acc_length 1(09) based fixed bin(8,0) level 2 in structure "string_block" packed unaligned dcl 89 in procedure "cref_listman_" set ref 406 406 406 406 426 426 698 1038 1041 1244 1258* 1260 acc_length 5 based fixed bin(8,0) level 2 in structure "include_file_block" packed unaligned dcl 77 in procedure "cref_listman_" set ref 631 646 662* 665 847 acc_ptr parameter pointer dcl 125 ref 121 149 149 addr builtin function dcl 143 ref 498 621 1008 1008 1237 already_found 000210 automatic bit(1) dcl 199 set ref 294* 300 328* 337 already_found_ptr 000212 automatic pointer dcl 199 set ref 310 314 325* 337 attribute_array parameter pointer array dcl 705 set ref 703 715 723 737 851 862 868 903 911* 1106 1126 1131* 1138 1145 1176 1181* attribute_block based structure level 1 dcl 71 set ref 734 attribute_nodes 1 based pointer array level 2 packed unaligned dcl 71 set ref 737* 911 attribute_ptr 000102 automatic pointer dcl 75 set ref 734* 737 740 901* 903 908 911 based_acc_string based structure level 1 dcl 134 based_pointer based pointer unaligned dcl 1213 set ref 1215* 1215 1216* bindfile_found parameter bit(1) dcl 676 in procedure "cref_listman_" ref 674 1245 1262 bindfile_found 1 based bit(1) level 2 in structure "string_block" packed unaligned dcl 89 in procedure "cref_listman_" set ref 1042 1050* 1245* 1262* bound_seg_node 2 based pointer level 2 in structure "primary_block" packed unaligned dcl 40 in procedure "cref_listman_" ref 1040 bound_seg_node 2 based pointer level 2 in structure "primary_blk" packed unaligned dcl 197 in procedure "match_or_create_block" set ref 238 263 346 375* 394 457* bound_seg_node parameter pointer dcl 184 in procedure "match_or_create_block" ref 180 263 346 375 383 394 398 406 457 bound_seg_node parameter pointer dcl 125 in procedure "cref_listman_" set ref 121 149* 155 162* 168 172* 558 572* bound_segment_name parameter varying char dcl 1017 set ref 1014 1029* 1032* 1041* 1043* 1054* bucket 000124 automatic fixed bin(17,0) dcl 138 set ref 494* 498 500 506 617* 621 625 625 1228* 1237 1239 1239 bucket_arg parameter fixed bin(17,0) dcl 748 set ref 746 756* 763* 763 772* 772 772* 778 782 817* 817 821 828* 833* 833 836* 836 836* 840 842 buckets 10 based pointer array level 2 packed unaligned dcl 29 set ref 498 500 506 772 772 778 782 1200* chain_word_ptr parameter pointer dcl 1211 ref 1205 1215 1216 char_string parameter varying char dcl 159 set ref 155 162 168 172 558 570 572 581* 607 617 631 646 661 665 821 847* charlen 000114 automatic fixed bin(17,0) dcl 111 set ref 360* 361 361 661* 662 662 1257* 1258 1258 created_by_ref 1(01) based bit(1) level 3 in structure "primary_blk" packed unaligned dcl 197 in procedure "match_or_create_block" set ref 383* created_by_ref 1(01) based bit(1) level 3 in structure "primary_block" packed unaligned dcl 40 in procedure "cref_listman_" ref 572 1029 cref_area based area dcl 26 ref 361 662 734 938 992 1196 1258 cref_area_ptr 000010 internal static pointer dcl 26 set ref 361 662 734 938 992 1194* 1196 1258 cref_database based structure level 1 dcl 29 set ref 1196 cref_database_ptr 000012 internal static pointer initial dcl 38 set ref 498 500 506 621 625 625 772 772 778 782 836 836 840 842 1196* 1198 1199 1200 1201 1202 1237 1239 1239 cref_filegen_$report_error 000014 constant entry external dcl 111 ref 302 406 426 581 792 1043 1054 crossref_block based structure level 1 dcl 99 set ref 938 crossref_block_ptr 000110 automatic pointer dcl 103 set ref 938* 940 941 952 960* 963 973 978* 981 1172* 1181 1183* crossref_chain 12 based pointer level 2 in structure "primary_blk" packed unaligned dcl 197 in procedure "match_or_create_block" set ref 373* crossref_chain 12 based pointer level 2 in structure "primary_block" packed unaligned dcl 40 in procedure "cref_listman_" set ref 952 952* 1159 1161 crossref_chain 3 based pointer level 2 in structure "include_file_block" packed unaligned dcl 77 in procedure "cref_listman_" set ref 667* 973 973* 1167 1169 crossref_chain_end 4 based pointer level 2 in structure "include_file_block" packed unaligned dcl 77 in procedure "cref_listman_" set ref 668* 977 981* crossref_chain_end 13 based pointer level 2 in structure "primary_blk" packed unaligned dcl 197 in procedure "match_or_create_block" set ref 374* crossref_chain_end 13 based pointer level 2 in structure "primary_block" packed unaligned dcl 40 in procedure "cref_listman_" set ref 959 963* crossref_node parameter pointer dcl 919 in procedure "cref_listman_" ref 917 929 940 crossref_node 1 based pointer level 2 in structure "crossref_block" packed unaligned dcl 99 in procedure "cref_listman_" set ref 940* 1181 curr_block_ptr parameter pointer dcl 1211 ref 1205 1215 1216 date_time_modified parameter bit(72) unaligned dcl 610 set ref 607 631 635 664 821 848* def_node 1 based pointer level 2 packed unaligned dcl 105 set ref 994* 1131 defining parameter bit(1) dcl 184 in procedure "match_or_create_block" ref 180 221 378 383 defining parameter bit(1) dcl 125 in procedure "cref_listman_" set ref 121 149* 155 162* 168 172* definition_node 6 based pointer level 2 in structure "primary_blk" packed unaligned dcl 197 in procedure "match_or_create_block" set ref 369* definition_node 6 based pointer level 2 in structure "primary_block" packed unaligned dcl 40 in procedure "cref_listman_" set ref 711* 893 description parameter varying char dcl 676 set ref 674 679* dim builtin function dcl 143 ref 903 1072 1093 1126 1176 dir_description parameter varying char dcl 1017 set ref 1014 1029* 1032* 1038* dir_node 3 based pointer level 2 in structure "primary_block" packed unaligned dcl 40 in procedure "cref_listman_" ref 1037 dir_node parameter pointer dcl 125 in procedure "cref_listman_" set ref 121 149* 155 162* 168 172* 558 572* dir_node 3 based pointer level 2 in structure "primary_blk" packed unaligned dcl 197 in procedure "match_or_create_block" set ref 230 238 263 280 376* 456* dir_node parameter pointer dcl 184 in procedure "match_or_create_block" ref 180 230 263 280 376 383 398 406 426 456 dtm 1 based bit(72) level 2 dcl 77 set ref 631 635 664* 848 environment_buckets 5230 based pointer array level 2 packed unaligned dcl 29 set ref 1201* 1237 1239 1239 error_table_$namedup 000020 external static fixed bin(35,0) dcl 111 set ref 302* 406* 426* error_table_$noentry 000022 external static fixed bin(35,0) dcl 111 set ref 1054* first_block_ptr 000122 automatic pointer dcl 138 set ref 219* 276 296 flags 1 based structure level 2 in structure "primary_block" dcl 40 in procedure "cref_listman_" flags 1 based structure level 2 in structure "primary_blk" dcl 197 in procedure "match_or_create_block" flags 1 based structure level 2 in structure "primary_blk" dcl 474 in procedure "find_block" forward_chain based pointer level 2 in structure "string_block" packed unaligned dcl 89 in procedure "cref_listman_" set ref 1249 1255 1261* forward_chain based pointer level 2 in structure "implicit_def_block" packed unaligned dcl 105 in procedure "cref_listman_" set ref 995* 1133 forward_chain based pointer level 2 in structure "primary_block" packed unaligned dcl 40 in procedure "cref_listman_" ref 762 814 forward_chain based pointer level 2 in structure "crossref_block" packed unaligned dcl 99 in procedure "cref_listman_" set ref 941* 1183 forward_chain based pointer level 2 in structure "primary_blk" packed unaligned dcl 474 in procedure "find_block" ref 510 512 537 540 forward_chain based pointer level 2 in structure "include_file_block" packed unaligned dcl 77 in procedure "cref_listman_" set ref 653 657 666* 832 found 000204 automatic bit(1) dcl 193 in procedure "match_or_create_block" set ref 209* 211 228 248* 261 268* 275* 278 285* 295* 298 331* 345 349* found parameter bit(1) dcl 469 in procedure "find_block" set ref 467 486* 501* 523* found_ptr parameter pointer dcl 546 ref 544 549 549 551 hbound builtin function dcl 143 ref 772 778 836 840 high_hash 000241 automatic fixed bin(17,0) dcl 476 set ref 492* 494 i 000115 automatic fixed bin(17,0) dcl 119 set ref 736* 737 737* 910* 911 911* implicit_def_block based structure level 1 dcl 105 set ref 992 implicit_def_block_ptr 000112 automatic pointer dcl 109 set ref 992* 994 995 1004 1008* 1121* 1131 1133* implicit_definition_chain 10 based pointer level 2 in structure "primary_block" packed unaligned dcl 40 in procedure "cref_listman_" set ref 1004 1004* 1008 1008 1117 1119 1121 implicit_definition_chain 10 based pointer level 2 in structure "primary_blk" packed unaligned dcl 197 in procedure "match_or_create_block" set ref 371* include_file_block based structure level 1 dcl 77 set ref 662 include_file_buckets 5430 based pointer array level 2 packed unaligned dcl 29 set ref 621 625 625 836 836 840 842 1202* include_file_node 11 based pointer level 2 in structure "primary_block" packed unaligned dcl 40 in procedure "cref_listman_" set ref 727* 895 include_file_node 11 based pointer level 2 in structure "primary_blk" packed unaligned dcl 197 in procedure "match_or_create_block" set ref 372* include_file_ptr 000104 automatic pointer dcl 87 set ref 625* 631 631 631 635 640* 646 647* 653 656* 657* 662* 664 665 666 667 668 670* 672 831* 832 845* 847 848 971* 973 973 977 981 1165* 1167 1169 index builtin function dcl 143 ref 492 493 is_external parameter bit(1) dcl 125 in procedure "cref_listman_" set ref 121 149* 155 162* 168 172* 558 572* is_external 1(02) based bit(1) level 3 in structure "primary_block" packed unaligned dcl 40 in procedure "cref_listman_" ref 806 is_external parameter bit(1) dcl 184 in procedure "match_or_create_block" ref 180 378 426 is_external 1(02) based bit(1) level 3 in structure "primary_blk" packed unaligned dcl 197 in procedure "match_or_create_block" set ref 280 300 378* 426 is_segname parameter bit(1) dcl 125 in procedure "cref_listman_" set ref 121 149* 155 162* 168 172* is_segname parameter bit(1) dcl 469 in procedure "find_block" ref 467 521 is_segname 1 based bit(1) level 3 in structure "primary_blk" packed unaligned dcl 197 in procedure "match_or_create_block" set ref 377* is_segname parameter bit(1) dcl 184 in procedure "match_or_create_block" set ref 180 209* 213 248* 268* 285* 331* 349* 377 383 is_segname 1 based bit(1) level 3 in structure "primary_blk" packed unaligned dcl 474 in procedure "find_block" ref 521 is_segname 1 based bit(1) level 3 in structure "primary_block" packed unaligned dcl 40 in procedure "cref_listman_" ref 802 is_synonym parameter bit(1) dcl 1017 set ref 1014 1069* 1082* key 000240 automatic char(2) unaligned dcl 476 set ref 491* 492 493 lang_suffix_node 14 based pointer level 2 in structure "primary_block" packed unaligned dcl 40 in procedure "cref_listman_" ref 697 lang_suffix_node 14 based pointer level 2 in structure "primary_blk" packed unaligned dcl 197 in procedure "match_or_create_block" set ref 366* 420* legal_chars 000000 constant char(52) initial unaligned dcl 479 ref 492 493 494 length builtin function dcl 143 in procedure "cref_listman_" ref 360 494 661 1228 1257 length based fixed bin(9,0) level 2 in structure "based_acc_string" packed unsigned unaligned dcl 134 in procedure "cref_listman_" ref 149 low_hash 000242 automatic fixed bin(17,0) dcl 476 set ref 493* 494 master_block_ptr 000130 automatic pointer dcl 563 set ref 566* 570 572 581 591 595 597 master_node parameter pointer dcl 705 ref 703 709 715 717 723 725 master_synonym_node parameter pointer dcl 561 in procedure "cref_listman_" ref 558 566 602 master_synonym_node 5 based pointer level 2 in structure "primary_block" packed unaligned dcl 40 in procedure "cref_listman_" set ref 579 580 602* 810 887 889 949 949 1001 1001 1032 1068 1070 1114 1114 master_synonym_node 5 based pointer level 2 in structure "primary_blk" packed unaligned dcl 197 in procedure "match_or_create_block" set ref 368* 445 447 549 551 max builtin function dcl 143 ref 494 1228 n_elements parameter fixed bin(17,0) dcl 705 set ref 703 715 723 732 734 734 736 851 862 868 880* 904* 908* 910 1106 1112* 1125* 1125 1126 1127* 1131 1138 1145 1154* 1175* 1175 1176 1177* 1181 n_entries based fixed bin(35,0) level 2 dcl 71 set ref 734* 903 908 n_names parameter fixed bin(17,0) dcl 1017 set ref 1014 1066* 1073* 1077* 1086* 1093 1094* 1098* 1101* 1101 name 5(09) based char level 2 in structure "include_file_block" packed unaligned dcl 77 in procedure "cref_listman_" set ref 631 646 665* 847 name 15(09) based char level 2 in structure "primary_blk" packed unaligned dcl 474 in procedure "find_block" ref 521 530 name parameter varying char(32) dcl 184 in procedure "match_or_create_block" set ref 180 209* 248* 268* 285* 302* 331* 349* 360 365 406* 426* name 15(09) based char level 2 in structure "primary_blk" packed unaligned dcl 197 in procedure "match_or_create_block" set ref 365* name 15(09) based char level 2 in structure "primary_block" packed unaligned dcl 40 in procedure "cref_listman_" set ref 570 581* 581* 689 696 792* 792* 1054* 1065 1078 1098 name_array parameter varying char(32) array dcl 1017 set ref 1014 1065* 1072 1078* 1093 1098* new_def_node parameter pointer dcl 989 ref 987 994 node 000214 automatic pointer dcl 202 in procedure "match_or_create_block" set ref 450* 454 459* 461 node 000116 automatic pointer dcl 132 in procedure "cref_listman_" set ref 149* 153 162* 166 172* 176 679* 680 752* 756 761 762* 763 782 782* 785 787 806 810 814* 815 826* 828 831 832* 833 842 842* 845 849 1119* 1121 1133* 1134 1161* 1169* 1172 1172 1183* 1184 node_arg parameter pointer dcl 748 ref 746 752 821 826 851 862 868 882 917 929 945 971 987 997 1014 1024 1106 1111 1138 1145 1157 1165 node_no parameter pointer dcl 684 ref 682 688 693 695 null builtin function dcl 143 ref 149 149 172 172 207 238 238 367 368 369 370 371 372 373 374 383 383 398 398 445 454 490 500 510 537 549 572 572 579 591 591 591 591 625 653 666 667 668 698 732 756 763 772 778 782 787 810 828 833 836 840 842 887 897 899 941 949 952 973 995 1001 1004 1032 1068 1084 1086 1114 1117 1121 1159 1167 1172 1198 1199 1200 1201 1202 1239 1249 1261 nullps 1 based pointer array level 2 packed unaligned dcl 29 set ref 1198* only_predefined 1(04) based bit(1) level 3 in structure "primary_block" packed unaligned dcl 40 in procedure "cref_listman_" set ref 790 1053 1061* only_predefined 1(04) based bit(1) level 3 in structure "primary_blk" packed unaligned dcl 197 in procedure "match_or_create_block" set ref 379* 406 419* predefined_unused_noted 1(05) based bit(1) level 3 packed unaligned dcl 40 set ref 791 797* predefining parameter bit(1) dcl 184 ref 180 379 398 prev_ptr 000126 automatic pointer dcl 138 set ref 358* 386* 498* 502 511* 531 539* 621* 640 647 656* 670* 1237* 1251 1254* 1264* primary_blk based structure level 1 dcl 197 in procedure "match_or_create_block" set ref 361 primary_blk based structure level 1 dcl 474 in procedure "find_block" primary_blk_ptr 000206 automatic pointer dcl 195 in procedure "match_or_create_block" set ref 207* 209* 219 230 234 238 238 245 248* 263 263 263* 268* 276* 280 280 280* 285* 296* 300 318 318* 325* 331* 346 346 349* 358 361* 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 383 386* 388 394 406 419 420 426 445 445 447 primary_blk_ptr parameter pointer dcl 469 in procedure "find_block" set ref 467 490 502* 506* 510 511 512* 512 516* 516 521 521 530 531* 537 539* 540* primary_block based structure level 1 dcl 40 primary_block_ptr 000100 automatic pointer dcl 69 set ref 572* 579 580 591 595 597 602 688* 689 695* 696 697 709* 711 717* 719 725* 727 761* 762 785* 787* 787* 790 791 792 792 797 802 806 810 814* 882* 887 889* 889 891 893 895 945* 949 949* 949 952 952 959 963 997* 1001 1001* 1001 1004 1004 1008 1008 1024* 1029 1032 1037 1040 1053 1054 1061 1065 1068 1070* 1070 1078 1084 1086 1091* 1091 1098 1111* 1114 1114* 1114 1117 1119 1121 1157* 1159 1161 rank builtin function dcl 143 ref 617 1228 ref_mismatch_noted 1(03) based bit(1) level 3 packed unaligned dcl 197 set ref 310* 318 reference_node 7 based pointer level 2 in structure "primary_blk" packed unaligned dcl 197 in procedure "match_or_create_block" set ref 370* reference_node 7 based pointer level 2 in structure "primary_block" packed unaligned dcl 40 in procedure "cref_listman_" set ref 719* 891 rtrim builtin function dcl 143 ref 698 700 satisfied 000132 automatic bit(1) unaligned dcl 612 in procedure "cref_listman_" set ref 619* 625 641* 648* 653* satisfied 000324 automatic bit(1) dcl 1225 in procedure "make_string" set ref 1235* 1239 1250* segp parameter pointer dcl 1191 ref 1189 1194 string 1(18) based char level 2 in structure "string_block" packed unaligned dcl 89 in procedure "cref_listman_" set ref 406* 406* 426* 698 1038 1041 1244 1260* string 0(09) based char level 2 in structure "based_acc_string" packed unaligned dcl 134 in procedure "cref_listman_" ref 149 string parameter varying char(32) dcl 469 in procedure "find_block" ref 467 491 521 530 string_arg parameter varying char dcl 1223 ref 1221 1228 1228 1244 1257 1260 string_block based structure level 1 dcl 89 set ref 1258 string_ptr 000106 automatic pointer dcl 97 set ref 697* 698 698 1037* 1038 1040* 1041 1042 1050 1239* 1244 1245 1246 1249 1251* 1254* 1255* 1258* 1260 1261 1262 1264* 1266 sub_err_ 000016 constant entry external dcl 111 ref 591 substr builtin function dcl 143 ref 492 493 617 1228 suffix_node parameter pointer dcl 159 in procedure "cref_listman_" set ref 155 162* suffix_node parameter pointer dcl 184 in procedure "match_or_create_block" ref 180 366 420 synonym_forward_chain 4 based pointer level 2 in structure "primary_blk" packed unaligned dcl 197 in procedure "match_or_create_block" set ref 367* 459 synonym_forward_chain 4 based pointer level 2 in structure "primary_block" packed unaligned dcl 40 in procedure "cref_listman_" set ref 595* 595 597* 1084 1086 1091 temp_ptr 000120 automatic pointer dcl 138 set ref 445* 447* 450 454* 454* 456 457 459* 580* 581 959* 960* 977* 978* temp_string 000133 automatic varying char(32) dcl 686 set ref 689* 690 696* 698* 698 700* 700 701 which_node 000270 automatic pointer dcl 877 set ref 891* 893* 895* 897* 899 901 which_type parameter fixed bin(17,0) dcl 1152 in procedure "get_crossref_chain" ref 1150 1156 1164 which_type parameter fixed bin(17,0) dcl 875 in procedure "get_attribute_block" ref 873 887 891 893 895 which_type parameter fixed bin(17,0) dcl 936 in procedure "append_crossref" ref 934 943 967 NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. sys_info$max_seg_size external static fixed bin(35,0) dcl 111 NAMES DECLARED BY EXPLICIT CONTEXT. append_crossref 005510 constant entry internal dcl 934 ref 924 931 assign_attribute_block 005322 constant entry internal dcl 730 ref 711 719 727 assign_crossref 002723 constant entry external dcl 917 assign_def_block 001711 constant entry external dcl 703 assign_include_file_block 002027 constant entry external dcl 723 assign_include_file_crossref 002753 constant entry external dcl 929 assign_ref_block 001760 constant entry external dcl 715 chain_on 005703 constant entry internal dcl 1205 ref 386 670 960 978 1008 1264 check_dups_in_dir_ok 004660 constant entry internal dcl 390 ref 234 create_environment 001404 constant entry external dcl 674 create_implicit_def 003003 constant entry external dcl 987 create_include_file_block 001157 constant entry external dcl 607 create_primary_block_acc 000242 constant entry external dcl 121 create_primary_block_char 000360 constant entry external dcl 155 create_syn_block 000615 constant entry external dcl 558 cref_listman_ 000224 constant entry external dcl 12 find_block 005134 constant entry internal dcl 467 ref 209 248 268 285 331 349 find_master_block 005306 constant entry internal dcl 544 ref 263 280 318 325 get_attribute_block 005372 constant entry internal dcl 873 ref 858 864 870 get_consecutive_include_files 002374 constant entry external dcl 821 get_consecutive_segnames 002100 constant entry external dcl 746 get_crossref_chain 005604 constant entry internal dcl 1150 ref 1140 1147 get_crossrefs 003724 constant entry external dcl 1138 get_defs 002621 constant entry external dcl 862 get_implicit_defs 003554 constant entry external dcl 1106 get_include_file_crossrefs 003764 constant entry external dcl 1145 get_include_files 002661 constant entry external dcl 868 get_name 001467 constant entry external dcl 682 get_name_with_suffix 001535 constant entry external dcl 693 get_primary_block_long 003071 constant entry external dcl 1014 get_refs 002561 constant entry external dcl 851 init 004025 constant entry external dcl 1189 make_string 005727 constant entry internal dcl 1221 ref 679 match_or_create_block 004142 constant entry internal dcl 180 ref 149 162 172 572 predefine_primary_block_char 000476 constant entry external dcl 168 set_predefined_synonym 005077 constant entry internal dcl 440 ref 244 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 6600 6624 6200 6610 Length 7076 6200 24 235 400 4 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cref_listman_ 390 external procedure is an external procedure. match_or_create_block internal procedure shares stack frame of external procedure cref_listman_. check_dups_in_dir_ok internal procedure shares stack frame of external procedure cref_listman_. set_predefined_synonym internal procedure shares stack frame of external procedure cref_listman_. find_block internal procedure shares stack frame of external procedure cref_listman_. find_master_block internal procedure shares stack frame of external procedure cref_listman_. assign_attribute_block internal procedure shares stack frame of external procedure cref_listman_. get_attribute_block internal procedure shares stack frame of external procedure cref_listman_. append_crossref internal procedure shares stack frame of external procedure cref_listman_. get_crossref_chain internal procedure shares stack frame of external procedure cref_listman_. chain_on internal procedure shares stack frame of external procedure cref_listman_. make_string internal procedure shares stack frame of external procedure cref_listman_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 cref_area_ptr cref_listman_ 000012 cref_database_ptr cref_listman_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cref_listman_ 000100 primary_block_ptr cref_listman_ 000102 attribute_ptr cref_listman_ 000104 include_file_ptr cref_listman_ 000106 string_ptr cref_listman_ 000110 crossref_block_ptr cref_listman_ 000112 implicit_def_block_ptr cref_listman_ 000114 charlen cref_listman_ 000115 i cref_listman_ 000116 node cref_listman_ 000120 temp_ptr cref_listman_ 000122 first_block_ptr cref_listman_ 000124 bucket cref_listman_ 000126 prev_ptr cref_listman_ 000130 master_block_ptr cref_listman_ 000132 satisfied cref_listman_ 000133 temp_string cref_listman_ 000204 found match_or_create_block 000206 primary_blk_ptr match_or_create_block 000210 already_found match_or_create_block 000212 already_found_ptr match_or_create_block 000214 node match_or_create_block 000240 key find_block 000241 high_hash find_block 000242 low_hash find_block 000270 which_node get_attribute_block 000324 satisfied make_string THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs unpk_to_pk call_ext_out_desc return signal shorten_stack ext_entry ext_entry_desc alloc_based THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cref_filegen_$report_error sub_err_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$namedup error_table_$noentry LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 12 000223 121 000233 149 000262 153 000330 155 000350 162 000405 166 000447 168 000467 172 000523 176 000567 558 000607 566 000634 570 000640 572 000665 579 000736 580 000742 581 000744 586 001027 591 001044 595 001125 597 001131 602 001132 605 001136 607 001153 617 001200 619 001203 621 001204 625 001210 631 001220 635 001254 640 001262 641 001264 646 001266 647 001300 648 001302 649 001304 653 001305 656 001312 657 001314 661 001317 662 001322 664 001336 665 001342 666 001351 667 001353 668 001354 670 001355 672 001357 674 001377 679 001424 680 001442 682 001462 688 001476 689 001502 690 001513 693 001532 695 001544 696 001550 697 001561 698 001563 700 001630 701 001664 703 001704 709 001730 711 001734 712 001741 715 001756 717 001777 719 002003 720 002010 723 002025 725 002046 727 002052 728 002057 746 002074 752 002111 756 002115 761 002123 762 002124 763 002126 772 002133 774 002147 778 002151 782 002174 785 002206 787 002210 790 002216 791 002222 792 002225 797 002301 799 002304 802 002305 806 002310 810 002333 814 002357 815 002361 817 002363 819 002365 821 002366 826 002414 828 002420 831 002426 832 002427 833 002431 836 002436 838 002451 840 002453 842 002476 845 002510 847 002512 848 002532 849 002536 851 002554 858 002600 859 002602 862 002617 864 002640 865 002642 868 002657 870 002700 871 002702 917 002717 924 002732 925 002734 929 002751 931 002762 932 002764 987 003001 992 003012 994 003020 995 003024 997 003026 1001 003031 1004 003035 1008 003042 1012 003046 1014 003063 1024 003113 1029 003117 1032 003127 1037 003137 1038 003141 1040 003154 1041 003156 1042 003171 1043 003174 1050 003232 1053 003235 1054 003241 1061 003312 1065 003315 1066 003342 1068 003344 1069 003347 1070 003351 1072 003353 1073 003364 1074 003366 1077 003403 1078 003405 1079 003424 1082 003441 1084 003442 1086 003445 1091 003453 1093 003455 1094 003467 1095 003471 1098 003506 1099 003530 1101 003532 1104 003535 1106 003552 1111 003573 1112 003577 1114 003600 1117 003605 1119 003626 1121 003630 1125 003636 1126 003637 1127 003650 1128 003652 1131 003667 1133 003701 1134 003703 1136 003705 1138 003722 1140 003743 1141 003745 1145 003762 1147 004003 1148 004005 1189 004022 1194 004034 1196 004041 1198 004050 1199 004062 1200 004064 1201 004077 1202 004112 1203 004125 180 004142 207 004144 209 004146 211 004163 213 004166 219 004172 221 004174 228 004177 230 004202 234 004210 236 004221 238 004222 244 004230 245 004231 248 004235 250 004252 251 004253 261 004254 263 004257 268 004277 270 004313 275 004314 276 004316 278 004320 280 004323 285 004342 287 004356 294 004357 295 004360 296 004362 298 004364 300 004367 302 004375 310 004432 314 004435 318 004440 325 004451 328 004453 331 004455 333 004472 337 004473 340 004501 345 004502 346 004505 349 004515 351 004531 358 004532 360 004534 361 004540 365 004554 366 004564 367 004567 368 004571 369 004572 370 004573 371 004574 372 004575 373 004576 374 004577 375 004600 376 004603 377 004606 378 004614 379 004627 383 004634 386 004652 388 004654 390 004660 394 004662 398 004670 406 004703 419 004776 420 005000 423 005003 426 005011 436 005071 440 005077 445 005100 447 005106 450 005110 454 005112 456 005117 457 005124 459 005127 461 005131 463 005133 467 005134 486 005136 490 005137 491 005143 492 005151 493 005161 494 005171 498 005200 500 005204 501 005207 502 005210 503 005211 506 005212 507 005215 510 005216 511 005223 512 005225 516 005230 521 005233 523 005255 524 005257 530 005260 531 005271 532 005273 537 005274 539 005300 540 005301 542 005305 544 005306 549 005310 551 005317 730 005322 732 005324 734 005331 736 005342 737 005350 738 005364 740 005366 873 005372 880 005374 882 005375 887 005401 889 005410 891 005412 893 005421 895 005427 897 005435 899 005437 901 005444 903 005446 904 005457 905 005461 908 005462 910 005464 911 005472 912 005505 914 005507 934 005510 938 005512 940 005520 941 005524 943 005526 945 005532 949 005535 952 005542 959 005551 960 005553 963 005555 964 005560 967 005561 971 005563 973 005566 977 005574 978 005576 981 005600 984 005603 1150 005604 1154 005606 1156 005607 1157 005612 1159 005616 1161 005622 1162 005624 1164 005625 1165 005627 1167 005633 1169 005637 1172 005641 1175 005647 1176 005650 1177 005661 1178 005663 1181 005664 1183 005676 1184 005700 1186 005702 1205 005703 1215 005705 1216 005722 1217 005726 1221 005727 1228 005740 1235 005754 1237 005755 1239 005761 1244 005771 1245 006004 1246 006012 1249 006014 1250 006017 1251 006021 1254 006023 1255 006025 1257 006030 1258 006034 1260 006050 1261 006061 1262 006063 1264 006070 1266 006072 ----------------------------------------------------------- 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