COMPILATION LISTING OF SEGMENT expand_by_name Compiled by: Multics PL/I Compiler, Release 32d, of September 19, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 09/22/89 1400.6 mst Fri Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 15 /****^ HISTORY COMMENTS: 16* 1) change(89-07-10,RWaters), approve(89-07-10,MCR8121), audit(89-08-09,Vu), 17* install(89-09-22,MR12.3-1073): 18* Changed references to error 134 to 135. 19* END HISTORY COMMENTS */ 20 21 22 /* Written: 26 Dec 1979 by PCK to implement by name assignment 23* * Modified 06 June 89 by RWaters changed references to error msg 134 to 135 24* */ 25 /* format: style3,^indattr,ifthendo,ifthen,^indnoniterdo,^elsestmt,dclind9 */ 26 expand_by_name: 27 procedure (blk, stmnt, tree); 28 29 /* parameters */ 30 31 dcl (blk, stmnt, tree) ptr parameter; 32 33 /* external static */ 34 35 dcl pl1_stat_$by_name_parts_tree ptr external static; 36 dcl pl1_stat_$by_name_parts_free_list ptr external static; 37 dcl pl1_stat_$by_name_free_list ptr external static; 38 dcl pl1_stat_$by_name_ref_list ptr external static; 39 40 /* builtins */ 41 42 dcl (null, addr) builtin; 43 44 /* constants */ 45 46 dcl TRUE bit (1) aligned internal static options (constant) init ("1"b); 47 dcl FALSE bit (1) aligned internal static options (constant) init ("0"b); 48 49 /* automatic */ 50 51 dcl root_of_any_struc ptr; 52 53 /* global variables (automatic) */ 54 55 dcl CUR_STMNT ptr; 56 dcl ERR_REF ptr; 57 dcl TARGET_LIST ptr; 58 dcl NO_OF_TARGETS fixed bin; 59 dcl ASSIGNMENT_GENERATED bit (1) aligned; 60 61 62 /* program */ 63 64 ASSIGNMENT_GENERATED = FALSE; 65 TARGET_LIST = tree -> operand (1); 66 CUR_STMNT = stmnt; 67 NO_OF_TARGETS = TARGET_LIST -> list.number; 68 69 /* Recycle the by_name_agg nodes created in the last invocation 70* * of expand_by_name 71* */ 72 73 if pl1_stat_$by_name_parts_tree ^= null then 74 call free_by_name_parts_tree; 75 76 /* Recycle the list nodes (by_name_ref nodes) created in the last 77* * invocation of expand_by_name 78* */ 79 80 if pl1_stat_$by_name_ref_list ^= null then 81 call free_by_name_refs; 82 83 /* Indicate the context of the structure references to lookup */ 84 85 this_context = (36)"0"b; 86 def_this_context.suppress_cross_ref = TRUE; 87 def_this_context.by_name_lookup = TRUE; 88 89 /* Process the LHS references of the assignment statement */ 90 91 call traverse_target_list; 92 93 /* Process the RHS references of the assignment statement */ 94 95 call traverse_expression ((tree -> operand (2))); 96 97 /* At this point all structure references in the statement have been 98* * located and now may now be expanded according to the definition 99* * of by name assignment 100* */ 101 102 /* Get a pointer to the root of a structure, any will do. */ 103 104 root_of_any_struc = pl1_stat_$by_name_ref_list -> list.element (1); 105 106 /* Traverse the set of structures and generate assignment statements */ 107 108 call traverse_structures (root_of_any_struc); 109 110 /* Issue a warning if the by name expansion generated no assignment statements */ 111 112 if ^ASSIGNMENT_GENERATED then do; 113 call semantic_translator$error (380, null); 114 stmnt -> statement.statement_type = null_statement; 115 stmnt -> statement.root = null; 116 tree = null; 117 end; 118 else 119 call build_assignment; 120 121 return; 122 123 /* Examine each target of the assign by name statement, verify 124* * that each reference is to a structure or an array of structures, 125* * and append each target reference to pl1_stat_$by_name_ref_list 126* */ 127 traverse_target_list: 128 procedure (); 129 130 dcl i fixed bin; 131 dcl (targ_ptr, s) ptr; 132 133 /* Build a linked list of pointers to the symbol nodes 134* * of the targets; verify that each reference is to a structure. 135* */ 136 137 def_this_context.left_side = TRUE; 138 139 do i = 1 to TARGET_LIST -> list.number; 140 targ_ptr = TARGET_LIST -> list.element (i); 141 ERR_REF = targ_ptr; 142 143 /* targ_ptr must point to either a reference or token node */ 144 145 if targ_ptr -> node.type ^= token_node & targ_ptr -> node.type ^= reference_node then 146 call semantic_translator$abort (378, ERR_REF); 147 148 /* All targets must be structures; therefore, they must be declared. */ 149 150 if ^lookup (blk, stmnt, targ_ptr, s, this_context) then 151 call semantic_translator$abort (379, ERR_REF); 152 153 if s -> node.type = label_node then 154 call semantic_translator$abort (135, ERR_REF); 155 156 if ^s -> symbol.structure then 157 call semantic_translator$abort (379, ERR_REF); 158 159 /* Add symbol node pointer to list */ 160 161 call append (s); 162 163 end; 164 165 /* All references with left side context have been processed */ 166 167 def_this_context.left_side = FALSE; 168 return; 169 170 end traverse_target_list; 171 172 /* Traverses an expression recursively and searches for structure references 173* * that are (1) not part of a qualifier, (2) not in an argument list, 174* * and (3) not in a subscript list. All other structure references are 175* * saved in a list for later use in expanding the assignment statement 176* */ 177 traverse_expression: 178 procedure (operand_ptr); 179 180 dcl operand_ptr ptr parameter; 181 182 dcl i fixed bin; 183 dcl s ptr; 184 185 if operand_ptr -> node.type = operator_node then 186 do i = 2 to operand_ptr -> operator.number; 187 call traverse_expression ((operand_ptr -> operand (i))); 188 end; 189 else if lookup (blk, stmnt, operand_ptr, s, this_context) then do; 190 /* If it is a reference to a label, do nothing */ 191 192 if s -> node.type ^= symbol_node then 193 return; 194 195 /* If it is a reference to a structure, save the reference */ 196 197 if s -> symbol.structure then 198 call append (s); 199 200 end; 201 202 return; 203 204 end traverse_expression; 205 206 /* 207* * Append a node onto pl1_stat_$by_name_ref_list 208* */ 209 append: 210 procedure (sym_ptr); 211 212 dcl sym_ptr ptr parameter; 213 214 dcl by_name_ref ptr; 215 216 by_name_ref = get_by_name_ref (); 217 218 /* Points to symbol node of structure referenced in statement, 219* * and is used as a cursor during the traversal of the structures 220* */ 221 222 by_name_ref -> list.element (1) = sym_ptr; 223 224 /* Points to next node in list */ 225 226 by_name_ref -> list.element (2) = pl1_stat_$by_name_ref_list; 227 228 pl1_stat_$by_name_ref_list = by_name_ref; 229 230 return; 231 232 end append; 233 234 /* Simultaneously traverses the collection of structures representing the 235* * structure references in the by name assignment statement. During 236* * the traversal, a tree, called the by name parts tree, is built. 237* * It is a tree representation of the by name parts list discussed in 238* * the ANSI PL/I standard. It is used by expand_primitive to determine 239* * how to expand structure references in the by name assignment into 240* * a tree of join operators. 241* * 242* * The algorithm proceeds as follows: 243* * (1) A structure is selected for preorder traversal. 244* * 245* * (2) As it is being traversed, the other structures are checked for 246* * the existance of nodes at the same level. If no such 247* * nodes exist, the traversal of the substructure rooted at this 248* * node is terminated; the traversal of the rest of the structure 249* * is continued. 250* * 251* * (3) Next, the other structures are checked for nodes at the same 252* * level that have identifiers that match the identifier of 253* * node of the structure being traversed. If a structure exists 254* * that does not satisfy this condition, the traversal of 255* * the substructure is terminated as before. 256* * 257* * (4) When a leaf of the structure is encountered, all other structures 258* * are checked for the existance of leaves with matching 259* * identifiers on the same level. If the matching leaves 260* * are found in every structure, an intersection is recorded 261* * using the symbols corresponding to the leaves. Otherwise, 262* * the traversal is continued until completed. 263* */ 264 traverse_structures: 265 procedure (root); 266 267 dcl root ptr parameter; 268 269 /* global variables (automatic) */ 270 271 dcl SUB_STRUC ptr; 272 dcl CUR_BNA_NODE ptr; 273 dcl TRAVERSE_STRUCTURE bit (1) aligned; 274 275 /* Assume that the root node has been matched. */ 276 277 SUB_STRUC = root; 278 pl1_stat_$by_name_parts_tree = get_by_name_agg (); 279 pl1_stat_$by_name_parts_tree -> by_name_agg.ok_to_free = FALSE; 280 CUR_BNA_NODE = pl1_stat_$by_name_parts_tree; 281 call push; 282 283 /* Simulate recursive walk of structure */ 284 285 TRAVERSE_STRUCTURE = TRUE; 286 287 do while (TRAVERSE_STRUCTURE); 288 if matching_ids_exist (SUB_STRUC) then do; 289 if SUB_STRUC -> symbol.son = null then do; 290 call record_intersection; 291 call pop; 292 end; 293 else 294 call push; 295 end; 296 else 297 call pop; 298 end; 299 300 /* 301* * Push implicit stacks 302* */ 303 push: 304 procedure (); 305 306 dcl (bna, by_name_ref) ptr; 307 308 SUB_STRUC = SUB_STRUC -> symbol.son; 309 310 bna = get_by_name_agg (); 311 312 bna -> by_name_agg.token = SUB_STRUC -> symbol.token; 313 bna -> by_name_agg.father = CUR_BNA_NODE; 314 CUR_BNA_NODE -> by_name_agg.son = bna; 315 316 CUR_BNA_NODE = bna; 317 318 by_name_ref = pl1_stat_$by_name_ref_list; 319 do while (by_name_ref ^= null); 320 by_name_ref -> list.element (1) = by_name_ref -> list.element (1) -> symbol.son; 321 by_name_ref = by_name_ref -> list.element (2); 322 end; 323 324 end push; 325 326 /* 327* * Pop implicit stacks until a brother or the root is found; 328* * delete nodes from the by name aggregate tree where necessary 329* */ 330 pop: 331 procedure (); 332 333 dcl (bna, by_name_ref) ptr; 334 335 if SUB_STRUC -> symbol.brother = null then 336 do while (SUB_STRUC -> symbol.brother = null); 337 SUB_STRUC = SUB_STRUC -> symbol.father; 338 bna = CUR_BNA_NODE; 339 CUR_BNA_NODE = CUR_BNA_NODE -> by_name_agg.father; 340 341 if bna -> by_name_agg.ok_to_free then do; 342 343 if bna -> by_name_agg.left_brother ^= null then 344 bna -> by_name_agg.left_brother -> by_name_agg.right_brother = null; 345 else 346 bna -> by_name_agg.father -> by_name_agg.son = null; 347 348 call free_by_name_agg (bna); 349 end; 350 351 if SUB_STRUC = root then do; 352 TRAVERSE_STRUCTURE = FALSE; 353 return; 354 end; 355 356 by_name_ref = pl1_stat_$by_name_ref_list; 357 do while (by_name_ref ^= null); 358 by_name_ref -> list.element (1) = by_name_ref -> list.element (1) -> symbol.father; 359 by_name_ref = by_name_ref -> list.element (2); 360 end; 361 end; 362 363 SUB_STRUC = SUB_STRUC -> symbol.brother; 364 365 if CUR_BNA_NODE -> by_name_agg.ok_to_free then 366 bna = CUR_BNA_NODE; 367 else do; 368 bna = get_by_name_agg (); 369 bna -> by_name_agg.left_brother = CUR_BNA_NODE; 370 CUR_BNA_NODE -> by_name_agg.right_brother = bna; 371 bna -> by_name_agg.father = CUR_BNA_NODE -> by_name_agg.father; 372 CUR_BNA_NODE = bna; 373 end; 374 375 CUR_BNA_NODE -> by_name_agg.token = SUB_STRUC -> symbol.token; 376 377 by_name_ref = pl1_stat_$by_name_ref_list; 378 do while (by_name_ref ^= null); 379 by_name_ref -> list.element (1) = by_name_ref -> list.element (1) -> symbol.father -> symbol.son; 380 by_name_ref = by_name_ref -> list.element (2); 381 end; 382 383 return; 384 385 end pop; 386 387 /* 388* * Do symbol nodes with identical identifiers exist in all structures 389* * being traversed 390* */ 391 matching_ids_exist: 392 procedure (symbol_ptr) returns (bit (1) aligned); 393 394 dcl symbol_ptr ptr parameter; 395 396 dcl (token_ptr, to_be_matched_ptr, to_be_fixed_ptr, sym_to_be_matched) ptr; 397 dcl match bit (1) aligned; 398 399 token_ptr = symbol_ptr -> symbol.token; 400 401 /* Assume that a match is possible */ 402 403 match = TRUE; 404 405 /* Now traverse list of symbol node pointers matching identifiers if possible */ 406 407 to_be_matched_ptr = pl1_stat_$by_name_ref_list; 408 do while (to_be_matched_ptr ^= null & match); 409 sym_to_be_matched = to_be_matched_ptr -> list.element (1); 410 match = FALSE; 411 do while (sym_to_be_matched ^= null & ^match); 412 413 /* Check for matching identifiers */ 414 415 if token_ptr = sym_to_be_matched -> symbol.token then 416 match = TRUE; 417 else 418 sym_to_be_matched = sym_to_be_matched -> symbol.brother; 419 end; 420 421 /* If a match is possible, both symbols must have the same 422* * structure attribute. 423* */ 424 425 if match then do; 426 match = (symbol_ptr -> symbol.structure = sym_to_be_matched -> symbol.structure); 427 428 if match then do; /* A match occurred, record it */ 429 to_be_matched_ptr -> list.element (1) = sym_to_be_matched; 430 to_be_matched_ptr = to_be_matched_ptr -> list.element (2); 431 end; 432 end; 433 end; 434 435 return (match); 436 437 end matching_ids_exist; 438 439 /* 440* * Create a by name aggregate node 441* */ 442 get_by_name_agg: 443 procedure () returns (ptr aligned); 444 445 dcl 1 pl1_nodes_template_$by_name_agg_template like by_name_agg aligned external static; 446 dcl pl1_stat_$node_uses (32) fixed bin ext static; 447 448 dcl bna ptr aligned; 449 450 /* Return a node from the free list if there are any; 451* * otherwise allocate one 452* */ 453 454 if pl1_stat_$by_name_parts_free_list ^= null then do; 455 bna = pl1_stat_$by_name_parts_free_list; 456 pl1_stat_$by_name_parts_free_list = pl1_stat_$by_name_parts_free_list -> by_name_agg.next; 457 end; 458 else do; 459 allocate by_name_agg set (bna) in (xeq_tree_area); 460 pl1_stat_$node_uses (20) = pl1_stat_$node_uses (20) + 1; 461 end; 462 463 bna -> by_name_agg = pl1_nodes_template_$by_name_agg_template; 464 return (bna); 465 466 end get_by_name_agg; 467 468 /* 469* * Record an intersection--successful matchup of names 470* */ 471 record_intersection: 472 procedure (); 473 474 dcl bna ptr; 475 476 bna = CUR_BNA_NODE; 477 478 /* Retain all the nodes in the bna tree from the current node, 479* * a leaf, to the root 480* */ 481 482 do while (bna -> by_name_agg.ok_to_free); 483 bna -> by_name_agg.ok_to_free = FALSE; 484 bna = bna -> by_name_agg.father; 485 end; 486 487 ASSIGNMENT_GENERATED = TRUE; 488 489 return; 490 491 end record_intersection; 492 493 end traverse_structures; 494 495 /* 496* * Transforms the by name assignment into a form acceptable 497* * to expression_semantics 498* */ 499 build_assignment: 500 procedure (); 501 502 dcl (new_stmnt, new_assignment, LHS_symbol, LHS_reference) ptr; 503 dcl targ_idx fixed bin; 504 505 stmnt -> statement.expanded_by_name = TRUE; 506 tree -> operator.op_code = assign; 507 508 if NO_OF_TARGETS = 1 then 509 tree -> operator.operand (1) = TARGET_LIST -> list.element (1); 510 else do; 511 LHS_symbol = create_symbol (null, null, by_compiler); 512 LHS_symbol -> symbol.temporary = TRUE; 513 LHS_reference = LHS_symbol -> symbol.reference; 514 LHS_reference -> reference.shared = FALSE; 515 LHS_reference -> reference.ref_count = NO_OF_TARGETS + 1; 516 517 tree -> operator.operand (1) = LHS_reference; 518 519 new_stmnt = stmnt; 520 do targ_idx = 1 to NO_OF_TARGETS; 521 new_stmnt = create_statement (assignment_statement, new_stmnt, null, (stmnt -> statement.prefix)); 522 new_assignment = create_operator (assign, 2); 523 new_assignment -> operand (1) = TARGET_LIST -> list.element (targ_idx); 524 new_assignment -> operand (2) = LHS_reference; 525 new_stmnt -> statement.generated = TRUE; 526 new_stmnt -> statement.expanded_by_name = TRUE; 527 new_stmnt -> statement.root = new_assignment; 528 end; 529 end; 530 531 return; 532 533 end build_assignment; 534 535 /* 536* * Creates list nodes for pl1_stat_$by_name_ref_list 537* */ 538 get_by_name_ref: 539 procedure () returns (ptr); 540 541 dcl by_name_ref ptr; 542 543 /* Recycle a node on the free list if possible */ 544 545 if pl1_stat_$by_name_free_list = null then 546 by_name_ref = create_list (2); 547 else do; 548 by_name_ref = pl1_stat_$by_name_free_list; 549 pl1_stat_$by_name_free_list = by_name_ref -> list.element (2); 550 by_name_ref -> list.element (*) = null; 551 end; 552 553 return (by_name_ref); 554 555 end get_by_name_ref; 556 557 /* 558* * Free a by name aggregate node by putting it on the free list 559* */ 560 free_by_name_agg: 561 procedure (bna); 562 563 dcl bna ptr parameter; 564 565 bna -> by_name_agg.next = pl1_stat_$by_name_parts_free_list; 566 pl1_stat_$by_name_parts_free_list = bna; 567 568 return; 569 570 end free_by_name_agg; 571 572 /* 573* * Put list nodes on pl1_stat_$by_name_ref_list on 574* * pl1_stat_$by_name_free_list 575* */ 576 free_by_name_refs: 577 procedure (); 578 579 dcl by_name_ref ptr; 580 581 /* Find last entry of list and then append the whole list to the free list */ 582 583 by_name_ref = pl1_stat_$by_name_ref_list; 584 do while (by_name_ref -> list.element (2) ^= null); 585 by_name_ref = by_name_ref -> list.element (2); 586 end; 587 588 by_name_ref -> list.element (2) = pl1_stat_$by_name_free_list; 589 pl1_stat_$by_name_free_list = pl1_stat_$by_name_ref_list; 590 pl1_stat_$by_name_ref_list = null; 591 592 return; 593 594 end free_by_name_refs; 595 596 /* 597* * Free the nodes of the by_name_parts tree during a postorder traversal 598* */ 599 free_by_name_parts_tree: 600 procedure (); 601 602 /* global variables (automatic) */ 603 604 dcl CUR_BNA ptr; 605 dcl TRAVERSE_TREE bit (1); 606 607 CUR_BNA = pl1_stat_$by_name_parts_tree; 608 609 /* Tree has no subtrees */ 610 611 if CUR_BNA -> by_name_agg.son = null then do; 612 call free_by_name_agg (CUR_BNA); 613 pl1_stat_$by_name_parts_tree = null; 614 return; 615 end; 616 617 /* Tree has at least 1 subtree */ 618 619 TRAVERSE_TREE = TRUE; 620 621 do while (TRAVERSE_TREE); 622 if CUR_BNA -> by_name_agg.son = null then 623 call pop; 624 else 625 CUR_BNA = CUR_BNA -> by_name_agg.son; 626 end; 627 628 return; 629 630 /* 631* * Pop implicit stacks freeing nodes as they are encountered 632* */ 633 pop: 634 procedure (); 635 636 dcl bna ptr; 637 638 if CUR_BNA -> by_name_agg.right_brother = null then 639 do while (CUR_BNA -> by_name_agg.right_brother = null); 640 bna = CUR_BNA; 641 CUR_BNA = CUR_BNA -> by_name_agg.father; 642 call free_by_name_agg (bna); 643 644 if CUR_BNA = pl1_stat_$by_name_parts_tree then do; 645 call free_by_name_agg (CUR_BNA); 646 pl1_stat_$by_name_parts_tree = null; 647 TRAVERSE_TREE = FALSE; 648 return; 649 end; 650 651 end; 652 653 bna = CUR_BNA; 654 CUR_BNA = CUR_BNA -> by_name_agg.right_brother; 655 call free_by_name_agg (bna); 656 657 return; 658 659 end pop; 660 661 end free_by_name_parts_tree; 662 1 1 /* BEGIN INCLUDE FILE .. by_name_agg.incl.pl1 */ 1 2 1 3 dcl 1 by_name_agg based aligned, 1 4 2 node_type bit(9) unal, 1 5 2 pad bit(26) unal, 1 6 2 ok_to_free bit(1) unal, 1 7 2 token ptr unal, 1 8 2 father ptr unal, 1 9 2 left_brother ptr unal, 1 10 2 right_brother ptr unal, 1 11 2 son ptr unal, 1 12 2 next ptr unal; 1 13 1 14 /* END INCLUDE FILE ... by_name_agg.incl.pl1 */ 663 664 2 1 /* BEGIN INCLUDE FILE ... declare_type.incl.pl1 */ 2 2 2 3 /* Modified: 25 Apr 1979 by PCK to implement 4-bit decimal */ 2 4 2 5 dcl ( by_declare initial("001"b), 2 6 by_explicit_context initial("010"b), 2 7 by_context initial("011"b), 2 8 by_implication initial("100"b), 2 9 by_compiler initial("101"b)) int static bit(3) aligned options(constant); 2 10 2 11 /* END INCLUDE FILE ... declare_type.incl.pl1 */ 665 666 3 1 /* BEGIN INCLUDE FILE ... list.incl.pl1 */ 3 2 3 3 /* Modified 26 June 81 by EBush to add max_list_elements */ 3 4 3 5 3 6 dcl 1 list based aligned, 3 7 2 node_type bit(9) unaligned, 3 8 2 reserved bit(12) unaligned, 3 9 2 number fixed(14) unaligned, 3 10 2 element dimension(n refer(list.number)) ptr unaligned; 3 11 3 12 dcl max_list_elements fixed bin(17) internal static options (constant) 3 13 init(16383); 3 14 3 15 /* END INCLUDE FILE ... list.incl.pl1 */ 667 668 4 1 /* BEGIN INCLUDE FILE ... nodes.incl.pl1 */ 4 2 4 3 /* Modified: 26 Dec 1979 by PCK to implement by name assignment */ 4 4 4 5 dcl ( block_node initial("000000001"b), 4 6 statement_node initial("000000010"b), 4 7 operator_node initial("000000011"b), 4 8 reference_node initial("000000100"b), 4 9 token_node initial("000000101"b), 4 10 symbol_node initial("000000110"b), 4 11 context_node initial("000000111"b), 4 12 array_node initial("000001000"b), 4 13 bound_node initial("000001001"b), 4 14 format_value_node initial("000001010"b), 4 15 list_node initial("000001011"b), 4 16 default_node initial("000001100"b), 4 17 machine_state_node initial("000001101"b), 4 18 source_node initial("000001110"b), 4 19 label_node initial("000001111"b), 4 20 cross_reference_node initial("000010000"b), 4 21 sf_par_node initial("000010001"b), 4 22 temporary_node initial("000010010"b), 4 23 label_array_element_node initial("000010011"b), 4 24 by_name_agg_node initial("000010100"b)) 4 25 bit(9) internal static aligned options(constant); 4 26 4 27 dcl 1 node based aligned, 4 28 2 type unal bit(9), 4 29 2 source_id unal structure, 4 30 3 file_number bit(8), 4 31 3 line_number bit(14), 4 32 3 statement_number bit(5); 4 33 4 34 /* END INCLUDE FILE ... nodes.incl.pl1 */ 669 670 5 1 /* BEGIN INCLUDE FILE ... op_codes.incl.pl1 */ 5 2 5 3 /* Modified: 25 Apr 1979 by PCK 4-bit decimal */ 5 4 /* Modified: 6 Jun 1979 by PG to add rank and byte */ 5 5 /* Modified: 26 Dec 1979 by PCK to add assign_by_name */ 5 6 /* Modified: 26 July 82 BIM wordno, segno */ 5 7 5 8 dcl ( add initial("000010001"b), /* opnd(1) <- opnd(2)+opnd(3) */ 5 9 sub initial("000010010"b), /* opnd(1) <- opnd(2)-opnd(3) */ 5 10 mult initial("000010011"b), /* opnd(1) <- opnd(2)*opnd(3) */ 5 11 div initial("000010100"b), /* opnd(1) <- opnd(2)/opnd(3) */ 5 12 negate initial("000010101"b), /* opnd(1) <- -opnd(2) */ 5 13 exp initial("000010110"b), /* opnd(1) <- opnd(2) ** opnd(3) */ 5 14 5 15 and_bits initial("000100001"b), /* opnd(1) <- opnd(2) & opnd(3) */ 5 16 or_bits initial("000100010"b), /* opnd(1) <- opnd(2)|opnd(3) */ 5 17 xor_bits initial("000100011"b), /* opnd(1) <- opnd(2) xor opnd(3) */ 5 18 not_bits initial("000100100"b), /* opnd(1) <- ^opnd(2) */ 5 19 cat_string initial("000100101"b), /* opnd(1) <- opnd(2)||opnd(3) */ 5 20 bool_fun initial("000100110"b), /* opnd(1) <- bool(opnd(2),opnd(3),opnd(4)) */ 5 21 5 22 assign initial("000110001"b), /* opnd(1) <- opnd(2) */ 5 23 assign_size_ck initial("000110010"b), /* opnd(1) <- opnd(2) */ 5 24 assign_zero initial("000110011"b), /* opnd(1) <- 0 */ 5 25 copy_words initial("000110100"b), /* move opnd(2) to opnd(1) by opnd(3) words */ 5 26 copy_string initial("000110101"b), /* move opnd(2) to opnd(1) by opnd(3) units */ 5 27 make_desc initial("000110110"b), /* opnd(1) <- descriptor(opnd(2),opnd(3)) */ 5 28 assign_round initial("000110111"b), /* opnd(1) <- opnd(2) rounded */ 5 29 pack initial("000111000"b), /* opnd(1) <- encode to picture opnd(2) */ 5 30 unpack initial("000111001"b), /* opnd(1) <- decode from picture opnd(2) */ 5 31 5 32 less_than initial("001000100"b), /* opnd(1) <- opnd(2) < opnd(3) */ 5 33 greater_than initial("001000101"b), /* opnd(1) <- opnd(2) > opnd(3) */ 5 34 equal initial("001000110"b), /* opnd(1) <- opnd(2) = opnd(3) */ 5 35 not_equal initial("001000111"b), /* opnd(1) <- opnd(2) ^= opnd(3) */ 5 36 less_or_equal initial("001001000"b), /* opnd(1) <- opnd(2) <= opnd(3) */ 5 37 greater_or_equal initial("001001001"b), /* opnd(1) <- opnd(2) >= opnd(3) */ 5 38 5 39 jump initial("001010001"b), /* go to opnd(1) unconditionally */ 5 40 jump_true initial("001010010"b), /* go to opnd(1) if opnd(2) is not 0 */ 5 41 jump_false initial("001010011"b), /* go to opnd(1) if opnd(2) is all 0 */ 5 42 jump_if_lt initial("001010100"b), /* go to opnd(1) if opnd(2) < opnd(3) */ 5 43 jump_if_gt initial("001010101"b), /* go to opnd(1) if opnd(2) > opnd(3) */ 5 44 jump_if_eq initial("001010110"b), /* go to opnd(1) if opnd(2) = opnd(3) */ 5 45 jump_if_ne initial("001010111"b), /* go to opnd(1) if opnd(2) ^= opnd(3) */ 5 46 jump_if_le initial("001011000"b), /* go to opnd(1) if opnd(2) <= opnd(3) */ 5 47 jump_if_ge initial("001011001"b), /* go to opnd(1) if opnd(2) >= opnd(3) */ 5 48 5 49 std_arg_list initial("001100001"b), /* opnd(1) <- arglist(opnd(2) desclist(opnd(3))) */ 5 50 return_words initial("001100010"b), /* return aggregate opnd(1), opnd(2) is length in words */ 5 51 std_call initial("001100011"b), /* opnd(1) <- call opnd(2) with opnd(3) */ 5 52 return_bits initial("001100100"b), /* return aggregate opnd(1), opnd(2) is length in bits */ 5 53 std_entry initial("001100101"b), /* entry(opnd(1)... opnd(n)) */ 5 54 return_string initial("001100110"b), /* return string opnd(1) */ 5 55 ex_prologue initial("001100111"b), /* execute the prologue -no operands- */ 5 56 allot_auto initial("001101000"b), /* opnd(1) <- addrel(stack,opnd(2)) */ 5 57 param_ptr initial("001101001"b), /* opnd(1) <- ptr to opnd(2) in block opnd(3) */ 5 58 param_desc_ptr initial("001101010"b), /* opnd(1) <- ptr to opnd(2) in block opnd(3) */ 5 59 std_return initial("001101011"b), /* return -no arguments- */ 5 60 allot_ctl initial("001101100"b), /* allocate opnd(1) , length in words is opnd(2) */ 5 61 free_ctl initial("001101101"b), /* free opnd(1) */ 5 62 stop initial("001101110"b), /* stop - terminate run unit */ 5 63 5 64 mod_bit initial("001110000"b), /* opnd(1) <- mod(opnd(3),36), 5 65* opnd(2) <- opnd(3) / 36 */ 5 66 mod_byte initial("001110001"b), /* opnd(1) <- mod(opnd(3),4), 5 67* opnd(2) <- opnd(3) / 4 */ 5 68 mod_half initial("001110010"b), /* opnd(1) <- mod(opnd(3),2), 5 69* opnd(2) <- opnd(3) / 2 */ 5 70 mod_word initial("001110011"b), /* TO BE DEFINED BY BLW */ 5 71 5 72 bit_to_char initial("010000000"b), /* opnd(1) <- (opnd(2)+8)/9 */ 5 73 bit_to_word initial("010000001"b), /* opnd(1) <- (opnd(2)+35)/36 */ 5 74 char_to_word initial("010000010"b), /* opnd(1) <- (opnd(2)+3)/4 */ 5 75 half_to_word initial("010000011"b), /* opnd(1) <- (opnd(2)+1)/2 */ 5 76 word_to_mod2 initial("010000100"b), /* opnd(1) <- (opnd(2)+1)/2*2 */ 5 77 word_to_mod4 initial("010000101"b), /* opnd(1) <- (opnd(2)+3)/4*4 */ 5 78 word_to_mod8 initial("010000110"b), /* opnd(1) <- (opnd(2)+7)/8*8 */ 5 79 rel_fun initial("010000111"b), /* opnd(1) <- rel(opnd(2)) */ 5 80 baseno_fun initial("010001000"b), /* opnd(1) <- baseno(opnd(2)) */ 5 81 desc_size initial("010001001"b), /* opnd(1) <- substr(opnd(2),13,24) */ 5 82 bit_pointer initial("010001010"b), /* opnd(1) <- bit offset of opnd(2) */ 5 83 index_before_fun initial("010001011"b), /* opnd(1) <- length of before(opnd(2),opnd(3)) */ 5 84 index_after_fun initial("010001100"b), /* opnd(1) <- offset of after(opnd(2),opnd(3)) in opnd(2) */ 5 85 verify_ltrim_fun initial("010001101"b), /* opnd(1) <- offset of ltrim(opnd(2),opnd(3)) in opnd(2) */ 5 86 verify_rtrim_fun initial("010001110"b), /* opnd(1) <- length(opnd(2))-length(rtrim(opnd(2),opnd(3))) */ 5 87 digit_to_bit initial("010001111"b), /* opnd(1) <- 9*opnd(2)/2 */ 5 88 5 89 ceil_fun initial("010010000"b), /* opnd(1) <- ceil(opnd(2)) */ 5 90 floor_fun initial("010010001"b), /* opnd(1) <- floor(opnd(2)) */ 5 91 round_fun initial("010010010"b), /* opnd(1) <- round(opnd(2)) */ 5 92 sign_fun initial("010010011"b), /* opnd(1) <- sign(opnd(2)) */ 5 93 abs_fun initial("010010100"b), /* opnd(1) <- abs(opnd(2)) */ 5 94 trunc_fun initial("010010101"b), /* opnd(1) <- trunc(opnd(2)) */ 5 95 byte_fun initial("010010110"b), /* opnd(1) <- byte(opnd(2)) */ 5 96 rank_fun initial("010010111"b), /* opnd(1) <- rank(opnd(2)) */ 5 97 index_rev_fun initial("010011000"b), /* opnd(1) <- index(reverse(opnd(2)),reverse(opnd(3))) */ 5 98 search_rev_fun initial("010011001"b), /* opnd(1) <- search(reverse(opnd(2)),opnd(3)) */ 5 99 verify_rev_fun initial("010011010"b), /* opnd(1) <- verify(reverse(opnd(2)),opnd(3)) */ 5 100 wordno_fun initial("010011011"b), /* opnd(1) <- wordno (opnd(2)) */ 5 101 segno_fun initial("010011100"b), /* opnd(1) <- segno (opnd(2)) */ 5 102 bitno_fun initial("010011101"b), /* opnd(1) <- bitno (opnd(2)) */ 5 103 charno_fun initial("010011110"b), /* opnd(1) <- charno (opnd(2)) */ 5 104 5 105 index_fun initial("010100000"b), /* opnd(1) <- index(opnd(2),opnd(3)) */ 5 106 off_fun initial("010100001"b), /* opnd(1) <- offset(opnd(2),opnd(3)) */ 5 107 complex_fun initial("010100010"b), /* opnd(1) <- complex(opnd(2),opnd(3)) */ 5 108 conjg_fun initial("010100011"b), /* opnd(1) <- conjg(opnd(2),opnd(3)) */ 5 109 mod_fun initial("010100100"b), /* opnd(1) <- mod(opnd(2),opnd(3)) */ 5 110 repeat_fun initial("010100101"b), /* opnd(1) <- repeat(opnd(2),opnd(3)) */ 5 111 verify_fun initial("010100110"b), /* opnd(1) <- verify(opnd(2),opnd(3)) */ 5 112 translate_fun initial("010100111"b), /* opnd(1) <- translate(opnd(2),opnd(3))*/ 5 113 real_fun initial("010101001"b), /* opnd(1) <- real(opnd(2)) */ 5 114 imag_fun initial("010101010"b), /* opnd(1) <- imag(opnd(2)) */ 5 115 length_fun initial("010101011"b), /* opnd(1) <- length(opnd(2)) */ 5 116 pl1_mod_fun initial("010101100"b), /* opnd(1) <- mod(opnd(2)) */ 5 117 search_fun initial("010101101"b), /* opnd(1) <- search(opnd(2),opnd(3)) */ 5 118 allocation_fun initial("010101110"b), /* opnd(1) <- allocation(opnd(2)) */ 5 119 reverse_fun initial("010101111"b), /* opnd(1) <- reverse(opnd(2)) */ 5 120 5 121 addr_fun initial("010110000"b), /* opnd(1) <- addr(opnd(2)) */ 5 122 addr_fun_bits initial("010110001"b), /* opnd(1) <- addr(opnd(2)) */ 5 123 ptr_fun initial("010110010"b), /* opnd(1) <- ptr(opnd(2),opnd(3)) */ 5 124 baseptr_fun initial("010110011"b), /* opnd(1) <- baseptr(opnd(2)) */ 5 125 addrel_fun initial("010110100"b), /* opnd(1) <- addrel(opnd(2),opnd(3)) */ 5 126 codeptr_fun initial("010110101"b), /* opnd(1) <- codeptr(opnd(2)) */ 5 127 environmentptr_fun initial("010110110"b), /* opnd(1) <- environmentptr(opnd(2)) */ 5 128 stackbaseptr_fun initial("010110111"b), /* opnd(1) is ptr to base of current stack */ 5 129 stackframeptr_fun initial("010111000"b), /* opnd(1) is ptr to current block's stack frame */ 5 130 setcharno_fun initial("010111001"b), /* opnd(1) <- opnd(2) with charno opnd(3) */ 5 131 addcharno_fun initial("010111010"b), /* opnd(1) <- opnd(2) with charno = charno + opnd(3) */ 5 132 setbitno_fun initial("010111011"b), /* setcharno for bitsno */ 5 133 addbitno_fun initial("010111100"b), /* addcharno for bitno */ 5 134 5 135 min_fun initial("011000000"b), /* opnd(1) <- min(opnd(1),opnd(2),...) */ 5 136 max_fun initial("011000001"b), /* opnd(1) <- max(opnd(1),opnd(2),...) */ 5 137 5 138 stack_ptr initial("011010001"b), /* opnd(1) <- stack frame ptr */ 5 139 empty_area initial("011010010"b), /* empty opnd(1), length in words is opnd(2) */ 5 140 enable_on initial("011010100"b), /* opnd(1) is the cond name 5 141* opnd(2) is the file name 5 142* opnd(3) is the block */ 5 143 revert_on initial("011010101"b), /* opnd(1) is the cond name, 5 144* opnd(2) is the file name */ 5 145 signal_on initial("011010110"b), /* opnd(1) is the cond name 5 146* opnd(2) is the file name */ 5 147 5 148 lock_fun initial("011010111"b), /* opnd(1) <- stac(opnd(2),opnd(3)) */ 5 149 stacq_fun initial("011011000"b), /* opnd(1) is result, opnd(2) is ptr to lock word, 5 150* opnd(3) is old value, (4) is new value. */ 5 151 clock_fun initial("011011001"b), /* opnd(1) is the clock time */ 5 152 vclock_fun initial("011011010"b), /* opnd(1) is the virtual clock time */ 5 153 5 154 bound_ck initial("011100000"b), /* opnd(1) <- opnd(2) if opnd(3) <= opnd(2) <= opnd(4) */ 5 155 range_ck initial("011100001"b), /* opnd(1) <- opnd(2) if opnd(3) <= opnd(2) <= opnd(4) */ 5 156 loop initial("011100010"b), /* do opnd(1) for opnd(2) from opnd(3) to opnd(4) by 1, 5 157* opnd(5) is the list */ 5 158 join initial("011100011"b), /* do opnd(1), opnd(2) ... opnd(n) */ 5 159 allot_based initial("011100100"b), /* allocate opnd(2) words in opnd(3), set opnd(1) */ 5 160 free_based initial("011100101"b), /* free opnd(1) in opnd(3), length is opnd(2) words */ 5 161 5 162 r_parn initial("011110001"b), /* format op code */ 5 163 l_parn initial("011110010"b), 5 164 r_format initial("011110011"b), 5 165 c_format initial("011110100"b), 5 166 f_format initial("011110101"b), 5 167 e_format initial("011110110"b), 5 168 b_format initial("011110111"b), 5 169 a_format initial("011111000"b), 5 170 x_format initial("011111001"b), 5 171 skip_format initial("011111010"b), 5 172 column_format initial("011111011"b), 5 173 page_format initial("011111100"b), 5 174 line_format initial("011111101"b), 5 175 picture_format initial("011111110"b), 5 176 bn_format initial("011111111"b), /* bit format, length(opnd(2)), radix factor(opnd(3)) */ 5 177 5 178 get_list_trans initial("100000000"b), /* getlist(opnd(2) with desc(opnd(1))) */ 5 179 get_edit_trans initial("100000001"b), /* getedit(opnd(2) with desc(opnd(1))) */ 5 180 get_data_trans initial("100000010"b), /* getdata(opnd(1) to opnd(n)) */ 5 181 put_list_trans initial("100000011"b), /* putlist(opnd(2) with desc(opnd(1))) */ 5 182 put_edit_trans initial("100000100"b), /* putedit(opnd(2) with desc(opnd(1))) */ 5 183 put_data_trans initial("100000101"b), /* putdata(opnd(2)) with subscript-list opnd(1) */ 5 184 terminate_trans initial("100000110"b), /* terminate stream transmission */ 5 185 stream_prep initial("100000111"b), /* initiate stream transmission */ 5 186 record_io initial("100001000"b), /* perform record io operation */ 5 187 fortran_read initial("100001001"b), /* A complete read statement */ 5 188 fortran_write initial("100001010"b), /* A complete write statement */ 5 189 ftn_file_manip initial("100001011"b), /* endfile,backspace,rewind,etc. */ 5 190 ftn_trans_loop initial("100001100"b), /* An implied do in i/o list */ 5 191 put_control initial("100001101"b), /* put control opnd(1) opnd(2) times */ 5 192 put_field initial("100001110"b), /* putlist(opnd(2)) of length(opnd(1)) */ 5 193 put_field_chk initial("100001111"b), /* putlist(op(2)) of len(op(1)) check char index(op(3)) */ 5 194 5 195 /* These operators are produced by the parse but are not used as input to the code generator. */ 5 196 /* They are processed by the semantic translator. */ 5 197 5 198 return_value initial("100010010"b), /* return(opnd(1)) */ 5 199 allot_var initial("100010011"b), /* allot opnd(1) in opnd(2) */ 5 200 free_var initial("100010100"b), /* free opnd(1) out of opnd(2) */ 5 201 get_file initial("100010101"b), /* opnd(1) is filename,opnd(2) is copy */ 5 202 /* opnd(3) is skip, opnd(4) is list */ 5 203 get_string initial("100010110"b), /* opnd(1) is string,opnd(2) is list */ 5 204 put_file initial("100010111"b), /* opnd(1) is filename,opnd(2) is page */ 5 205 /* opnd(3) is skip,opnd(4) is line */ 5 206 put_string initial("100011000"b), /* opnd(1) is string,opnd(2) is list */ 5 207 open_file initial("100011001"b), 5 208 close_file initial("100011010"b), 5 209 read_file initial("100011011"b), 5 210 write_file initial("100011100"b), 5 211 locate_file initial("100011101"b), 5 212 do_fun initial("100011110"b), /* opnd(1) is join of a list */ 5 213 /* opnd(2) is control variable ref */ 5 214 /* opnd(3) is specification operator */ 5 215 do_spec initial("100011111"b), /* opnd(1) to opnd(2) by opnd(3) */ 5 216 /* repeat opnd(4) while opnd(5) */ 5 217 /* opnd(6) is next specification */ 5 218 5 219 rewrite_file initial("100100000"b), 5 220 delete_file initial("100100001"b), 5 221 unlock_file initial("100100010"b), 5 222 lock_file initial("100100011"b), 5 223 refer initial("100100101"b), /* opnd(1) refer(opnd(2)) */ 5 224 prefix_plus initial("100100110"b), /* opnd(1) <- +opnd(2) */ 5 225 nop initial("100100111"b), /* no-op */ 5 226 assign_by_name initial("100101000"b), /* opnd(1) <- opnd(2),by name */ 5 227 5 228 /* These operators are produced by the semantic translator in processing the math 5 229* builtin functions and are used as input to the code generator */ 5 230 5 231 sqrt_fun initial("100110000"b), /* opnd(1) <- sqrt(opnd(2)) */ 5 232 sin_fun initial("100110001"b), /* opnd(1) <- sin(opnd(2)) */ 5 233 sind_fun initial("100110010"b), /* opnd(1) <- sind(opnd(2)) */ 5 234 cos_fun initial("100110011"b), /* opnd(1) <- cos(opnd(2)) */ 5 235 cosd_fun initial("100110100"b), /* opnd(1) <- cosd(opnd(2)) */ 5 236 tan_fun initial("100110101"b), /* opnd(1) <- tan(opnd(2)) */ 5 237 tand_fun initial("100110110"b), /* opnd(1) <- tand(opnd(2)) */ 5 238 asin_fun initial("100110111"b), /* opnd(1) <- asin(opnd(2)) */ 5 239 asind_fun initial("100111000"b), /* opnd(1) <- asind(opnd(2)) */ 5 240 acos_fun initial("100111001"b), /* opnd(1) <- acos(opnd(2)) */ 5 241 acosd_fun initial("100111010"b), /* opnd(1) <- acosd(opnd(2)) */ 5 242 atan_fun initial("100111011"b), /* opnd(1) <- atan(opnd(2)[,opnd(3)]) */ 5 243 atand_fun initial("100111100"b), /* opnd(1) <- atand(opnd(2)[,opnd(3)]) */ 5 244 log2_fun initial("100111101"b), /* opnd(1) <- log2(opnd(2)) */ 5 245 log_fun initial("100111110"b), /* opnd(1) <- s structure unaligned, 8 69 3 substr bit(1), 8 70 3 padded_for_store_ref bit(1), 8 71 3 aligned_for_store_ref bit(1), 8 72 3 mbz bit(15), 8 73 2 store_ins bit(18) unaligned; 8 74 8 75 /* END INCLUDE FILE ... reference.incl.pl1 */ 677 678 9 1 /* BEGIN INCLUDE FILE ... semant.incl.pl1 */ 9 2 9 3 /* Modified: 30 Aug 1979 by PCK to fix 1804 and 1823 */ 9 4 /* Modified: 26 Aug 1979 by PCK to implement by name assignment */ 9 5 9 6 9 7 declare alloc_semantics entry(pointer,pointer,pointer); 9 8 /* parameter 1: (input) block node pointer */ 9 9 /* parameter 2: (input) statement node pointer */ 9 10 /* parameter 3: (in/out) tree pointer */ 9 11 9 12 declare alloc_semantics$init_only entry(pointer,pointer,pointer); 9 13 /* parameter 1: (input) qualifier pointer */ 9 14 /* parameter 2: (input) statement node pointer */ 9 15 /* parameter 3: (input) symbol node pointer */ 9 16 9 17 declare builtin entry(pointer,pointer,pointer,pointer,pointer,bit(36) aligned) 9 18 returns(pointer); 9 19 /* parameter 1: (input) block node pointer */ 9 20 /* parameter 2: (input) statement node pointer */ 9 21 /* parameter 3: (input) tree pointer */ 9 22 /* parameter 4: (input) subscript pointer */ 9 23 /* parameter 5: (input) builtin symbol node pointer */ 9 24 /* parameter 6: (in/out) context */ 9 25 /* return: (output) tree pointer */ 9 26 9 27 declare check_star_extents entry(pointer,pointer); 9 28 /* parameter 1: (input) symbol node of procedure */ 9 29 /* parameter 2: (input) argument list pointer */ 9 30 9 31 declare compare_declaration entry(pointer,pointer,bit(1) aligned) reducible 9 32 returns(bit(1) aligned); 9 33 /* parameter 1: (input) reference or symbol node ptr */ 9 34 /* parameter 2: (input) symbol node ptr */ 9 35 /* parameter 3: (input) "1"b if aligned attribute ignored for string */ 9 36 /* return: (output) compare bit */ 9 37 9 38 declare context_processor entry(pointer,label); 9 39 /* parameter 1: (input) root block node pointer */ 9 40 9 41 declare declare entry(pointer); 9 42 /* parameter 1: (input) symbol node pointer */ 9 43 9 44 declare declare_structure entry(pointer); 9 45 /* parameter 1: (input) symbol node pointer */ 9 46 9 47 declare defined_reference entry(pointer,pointer,pointer,pointer,pointer,bit(36) aligned) 9 48 returns(pointer); 9 49 /* parameter 1: (input) block node pointer */ 9 50 /* parameter 2: (input) statement node pointer */ 9 51 /* parameter 3: (input) tree pointer */ 9 52 /* parameter 4: (input) subscript list pointer or null*/ 9 53 /* parameter 5: (input) symbol node pointer */ 9 54 /* parameter 6: (in/out) context */ 9 55 /* return: (output) tree pointer */ 9 56 9 57 declare do_semantics entry(pointer,pointer,pointer); 9 58 /* parameter 1: (input) block node pointer */ 9 59 /* parameter 2: (input) statement node pointer */ 9 60 /* parameter 3: (input) tree pointer */ 9 61 9 62 declare expand_assign entry(pointer,pointer,pointer,bit(36) aligned,pointer) 9 63 returns(pointer); 9 64 /* parameter 1: (input) block node pointer */ 9 65 /* parameter 2: (input) statement node pointer */ 9 66 /* parameter 3: (input) tree pointer */ 9 67 /* parameter 4: (in/out) context */ 9 68 /* parameter 5: (input) aggregate reference node ptr */ 9 69 /* return: (output) tree pointer */ 9 70 9 71 declare expand_by_name entry(pointer,pointer,pointer); 9 72 /* parameter 1: (input) block node pointer */ 9 73 /* parameter 2: (input) statement node pointer */ 9 74 /* parameter 3: (input/output) tree pointer */ 9 91 /* parameter 2: (input) target reference node pointer */ 10 92 /* return: (output) target value tree pointer */ 10 93 10 94 declare copy_expression entry(pointer unaligned) 10 95 returns(pointer); 10 96 /* parameter 1: (input) any node pointer */ 10 97 /* return: (output) any node pointer */ 10 98 10 99 declare copy_expression$copy_sons entry(pointer,pointer); 10 100 /* parameter 1: (input) father symbol node pointer */ 10 101 /* parameter 2: (input) stepfather symbol node ptr */ 10 102 10 103 declare copy_unique_expression entry(pointer) 10 104 returns(pointer); 10 105 /* parameter 1: (input) any node pointer */ 10 106 /* return: (output) any node pointer */ 10 107 10 108 declare create_array entry() 10 109 returns(pointer); 10 110 /* return: (output) array node pointer */ 10 111 10 112 declare create_block entry(bit(9) aligned,pointer) 10 113 returns(pointer); 10 114 /* parameter 1: (input) block type */ 10 115 /* parameter 2: (input) father block node pointer */ 10 116 /* return: (output) block node pointer */ 10 117 10 118 declare create_bound entry() 10 119 returns(pointer); 10 120 /* return: (output) bound node pointer */ 10 121 10 122 declare create_context entry(pointer,pointer) 10 123 returns(pointer); 10 124 /* parameter 1: (input) block node pointer */ 10 125 /* parameter 2: (input) token pointer */ 10 126 /* return: (output) context node pointer */ 10 127 10 128 declare create_cross_reference entry() 10 129 returns(pointer); 10 130 /* return: (output) cross reference node pointer */ 10 131 10 132 declare create_default entry 10 133 returns(pointer); 10 134 /* return: (output) default node pointer */ 10 135 10 136 declare create_identifier entry() 10 137 returns(pointer); 10 138 /* return: (output) token node pointer */ 10 139 10 140 declare create_label entry(pointer,pointer,bit(3) aligned) 10 141 returns(pointer); 10 142 /* parameter 1: (input) block node pointer */ 10 143 /* parameter 2: (input) token node pointer */ 10 144 /* parameter 3: (input) declare type */ 10 145 /* return: (output) label node pointer */ 10 146 10 147 declare create_list entry(fixed bin(15)) 10 148 returns(pointer); 10 149 /* parameter 1: (input) number of list elements */ 10 150 /* return: (output) list node pointer */ 10 151 10 152 declare create_operator entry(bit(9) aligned,fixed bin(15)) 10 153 returns(pointer); 10 154 /* parameter 1: (input) operator type */ 10 155 /* parameter 2: (input) number of operands */ 10 156 /* return: (output) operator node pointer */ 10 157 10 158 declare create_reference entry(pointer) 10 159 returns(pointer); 10 160 /* parameter 1: (input) symbol node pointer */ 10 161 /* return: (output) reference node pointer */ 10 162 10 163 declare create_statement entry(bit(9) aligned,pointer,pointer,bit(12) aligned) 10 164 returns(pointer); 10 165 /* parameter 1: (input) statement type */ 10 166 /* parameter 2: (input) block node pointer */ 10 167 /* parameter 3: (input) label node pointer */ 10 168 /* parameter 4: (input) conditions */ 10 169 /* return: (output) statement node pointer */ 10 170 10 171 declare create_statement$prologue entry(bit(9) aligned,pointer,pointer,bit(12) aligned) 10 172 returns(pointer); 10 173 /* parameter 1: (input) statement type */ 10 174 /* parameter 2: (input) block node pointer */ 10 175 /* parameter 3: (input) label node pointer */ 10 176 /* parameter 4: (input) conditions */ 10 177 /* return: (output) statement node pointer */ 10 178 10 179 declare create_storage entry(fixed bin(15)) 10 180 returns(pointer); 10 181 /* parameter 1: (input) number of words */ 10 182 /* return: (output) storage block pointer */ 10 183 10 184 declare create_symbol entry(pointer,pointer,bit(3) aligned) 10 185 returns(pointer); 10 186 /* parameter 1: (input) block node pointer */ 10 187 /* parameter 2: (input) token node pointer */ 10 188 /* parameter 3: (input) declare type */ 10 189 /* return: (output) symbol node pointer */ 10 190 10 191 declare create_token entry (character (*), bit (9) aligned) 10 192 returns (ptr); 10 193 /* parameter 1: (input) token string */ 10 194 /* parameter 2: (input) token type */ 10 195 /* return: (output) token node ptr */ 10 196 10 197 declare create_token$init_hash_table entry (); 10 198 10 199 declare create_token$protected entry (char (*), bit (9) aligned, bit (18) aligned) 10 200 returns (ptr); 10 201 /* parameter 1: (input) token string */ 10 202 /* parameter 2: (input) token type */ 10 203 /* parameter 3: (input) protected flag */ 10 204 /* return: (output) token node ptr */ 10 205 10 206 declare decbin entry(character(*) aligned) reducible 10 207 returns(fixed bin(31)); 10 208 /* parameter 1: (input) decimal character string */ 10 209 /* return: (output) binary value */ 10 210 10 211 declare declare_constant entry(bit(*) aligned,bit(36) aligned,fixed bin(31),fixed bin(15)) 10 212 returns(pointer); 10 213 /* parameter 1: (input) value */ 10 214 /* parameter 2: (input) type */ 10 215 /* parameter 3: (input) size */ 10 216 /* parameter 4: (input) scale */ 10 217 /* return: (output) reference node pointer */ 10 218 10 219 declare declare_constant$bit entry(bit(*) aligned) 10 220 returns(pointer); 10 221 /* parameter 1: (input) bit */ 10 222 /* return: (output) reference node pointer */ 10 223 10 224 declare declare_constant$char entry(character(*) aligned) 10 225 returns(pointer); 10 226 /* parameter 1: (input) character */ 10 227 /* return: (output) reference node pointer */ 10 228 10 229 declare declare_constant$desc entry(bit(*) aligned) 10 230 returns(pointer); 10 231 /* parameter 1: (input) descriptor bit value */ 10 232 /* return: (output) reference node pointer */ 10 233 10 234 declare declare_constant$integer entry(fixed bin(31)) /* note...should really be fixed bin(24) */ 10 235 returns(pointer); 10 236 /* parameter 1: (input) integer */ 10 237 /* return: (output) reference node pointer */ 10 238 10 239 declare declare_descriptor entry(pointer,pointer,pointer,pointer,bit(2) aligned) 10 240 returns(pointer); 10 241 /* parameter 1: (input) block node pointer */ 10 242 /* parameter 2: (input) statement node pointer */ 10 243 /* parameter 3: (input) symbol node pointer */ 10 244 /* parameter 4: (input) loc pointer */ 10 245 /* parameter 5: (input) array descriptor bit 10 246* cross_section bit */ 10 247 /* return: (output) reference node pointer */ 10 248 10 249 declare declare_descriptor$ctl entry(pointer,pointer,pointer,pointer,bit(2) aligned) 10 250 returns(pointer); 10 251 /* parameter 1: (input) block node pointer */ 10 252 /* parameter 2: (input) statement node pointer */ 10 253 /* parameter 3: (input) symbol node pointer */ 10 254 /* parameter 4: (input) loc pointer */ 10 255 /* parameter 5: (input) array descriptor bit 10 256* cross_section bit */ 10 257 /* return: (output) reference node pointer */ 10 258 10 259 declare declare_descriptor$param entry(pointer,pointer,pointer,pointer,bit(2) aligned) 10 260 returns(pointer); 10 261 /* parameter 1: (input) block node pointer */ 10 262 /* parameter 2: (input) statement node pointer */ 10 263 /* parameter 3: (input) symbol node pointer */ 10 264 /* parameter 4: (input) loc pointer */ 10 265 /* parameter 5: (input) array descriptor bit 10 266* cross_section bit */ 10 267 /* return: (output) reference node pointer */ 10 268 10 269 declare declare_integer entry(pointer) 10 270 returns(pointer); 10 271 /* parameter 1: (input) block node pointer */ 10 272 /* return: (output) reference node pointer */ 10 273 10 274 declare declare_picture entry(char(*)aligned,pointer,fixed bin(15)); 10 275 /* parameter 1: (input) picture string */ 10 276 /* parameter 2: (input) symbol node pointer */ 10 277 /* parameter 3: (output) error code, if any */ 10 278 10 279 declare declare_picture_temp entry(char(*) aligned,fixed bin(31),bit(1) aligned,bit(1) aligned) 10 280 returns(pointer); 10 281 /* parameter 1: (input) picture string */ 10 282 /* parameter 2: (input) scalefactor of picture */ 10 283 /* parameter 3: (input) ="1"b => complex picture */ 10 284 /* parameter 4: (input) ="1"b => unaligned temp */ 10 285 /* return: (output) reference node pointer */ 10 286 10 287 declare declare_pointer entry(pointer) 10 288 returns(pointer); 10 289 /* parameter 1: (input) block node pointer */ 10 290 /* return: (output) reference node pointer */ 10 291 10 292 declare declare_temporary entry(bit(36) aligned,fixed bin(31),fixed bin(15),pointer) 10 293 returns(pointer); 10 294 /* parameter 1: (input) type */ 10 295 /* parameter 2: (input) precision */ 10 296 /* parameter 3: (input) scale */ 10 297 /* parameter 4: (input) length */ 10 298 /* return: (output) reference node pointer */ 10 299 10 300 declare decode_node_id entry(pointer,bit(1) aligned) 10 301 returns(char(120) varying); 10 302 /* parameter 1: (input) node pointer */ 10 303 /* parameter 2: (input) ="1"b => capitals */ 10 304 /* return: (output) source line id */ 10 305 10 306 declare decode_source_id entry( 11 1 1 structure unaligned, 11 2 2 /* file_number */ bit(8), 11 3 2 /* line_number */ bit(14), 11 4 2 /* stmt_number */ bit(5), 10 307 10 308 bit(1) aligned) 10 309 returns(char(120) varying); 10 310 /* parameter 1: (input) source id */ 10 311 /* parameter 2: (input) ="1"b => capitals */ 10 312 /* return: (output) source line id */ 10 313 10 314 declare error entry(fixed bin(15),pointer,pointer); 10 315 /* parameter 1: (input) error number */ 10 316 /* parameter 2: (input) statement node pointer or null*/ 10 317 /* parameter 3: (input) token node pointer */ 10 318 10 319 declare error$omit_text entry(fixed bin(15),pointer,pointer); 10 320 /* parameter 1: (input) error number */ 10 321 /* parameter 2: (input) statement node pointer or null*/ 10 322 /* parameter 3: (input) token node pointer */ 10 323 10 324 declare error_ entry(fixed bin(15), 12 1 1 structure unaligned, 12 2 2 /* file_number */ bit(8), 12 3 2 /* line_number */ bit(14), 12 4 2 /* stmt_number */ bit(5), 10 325 10 326 pointer,fixed bin(8),fixed bin(23),fixed bin(11)); 10 327 /* parameter 1: (input) error number */ 10 328 /* parameter 2: (input) statement id */ 10 329 /* parameter 3: (input) any node pointer */ 10 330 /* parameter 4: (input) source segment */ 10 331 /* parameter 5: (input) source starting character */ 10 332 /* parameter 6: (input) source length */ 10 333 10 334 declare error_$no_text entry(fixed bin(15), 13 1 1 structure unaligned, 13 2 2 /* file_number */ bit(8), 13 3 2 /* line_number */ bit(14), 13 4 2 /* stmt_number */ bit(5), 10 335 10 336 pointer); 10 337 /* parameter 1: (input) error number */ 10 338 /* parameter 2: (input) statement id */ 10 339 /* parameter 3: (input) any node pointer */ 10 340 10 341 declare error_$initialize_error entry(); 10 342 10 343 declare error_$finish entry(); 10 344 10 345 declare free_node entry(pointer); 10 346 /* parameter 1: any node pointer */ 10 347 10 348 declare get_array_size entry(pointer,fixed bin(3)); 10 349 /* parameter 1: (input) symbol node pointer */ 10 350 /* parameter 2: (input) units */ 10 351 10 352 declare get_size entry(pointer); 10 353 /* parameter 1: (input) symbol node pointer */ 10 354 10 355 declare merge_attributes external entry(pointer,pointer) 10 356 returns(bit(1) aligned); 10 357 /* parameter 1: (input) target symbol node pointer */ 10 358 /* parameter 2: (input) source symbol node pointer */ 10 359 /* return: (output) "1"b if merge was unsuccessful */ 10 360 10 361 declare optimizer entry(pointer); 10 362 /* parameter 1: (input) root pointer */ 10 363 10 364 declare parse_error entry(fixed bin(15),pointer); 10 365 /* parameter 1: (input) error number */ 10 366 /* parameter 2: (input) any node pointer */ 10 367 10 368 declare parse_error$no_text entry(fixed bin(15),pointer); 10 369 /* parameter 1: (input) error number */ 10 370 /* parameter 2: (input) any node pointer */ 10 371 10 372 declare pl1_error_print$write_out 10 373 entry(fixed bin(15), 14 1 1 structure unaligned, 14 2 2 /* file_number */ bit(8), 14 3 2 /* line_number */ bit(14), 14 4 2 /* stmt_number */ bit(5), 10 374 10 375 pointer,fixed bin(11),fixed bin(31),fixed bin(31),fixed bin(15)); 10 376 /* parameter 1: (input) error number */ 10 377 /* parameter 2: (input) statement identification */ 10 378 /* parameter 3: (input) any node pointer */ 10 379 /* parameter 4: (input) source segment */ 10 380 /* parameter 5: (input) source character index */ 10 381 /* parameter 6: (input) source length */ 10 382 /* parameter 7: (input) source line */ 10 383 10 384 declare pl1_error_print$listing_segment 10 385 entry(fixed bin(15), 15 1 1 structure unaligned, 15 2 2 /* file_number */ bit(8), 15 3 2 /* line_number */ bit(14), 15 4 2 /* stmt_number */ bit(5), 10 386 10 387 pointer); 10 388 /* parameter 1: (input) error number */ 10 389 /* parameter 2: (input) statement identification */ 10 390 /* parameter 3: (input) token node pointer */ 10 391 10 392 declare pl1_print$varying entry(character(*) aligned varying); 10 393 /* parameter 1: (input) string */ 10 394 10 395 declare pl1_print$varying_nl entry(character(*) aligned varying); 10 396 /* parameter 1: (input) string */ 10 397 10 398 declare pl1_print$non_varying entry(character(*) aligned,fixed bin(31)); 10 399 /* parameter 1: (input) string */ 10 400 /* parameter 2: (input) string length or 0 */ 10 401 10 402 declare pl1_print$non_varying_nl entry(character(*) aligned,fixed bin(31)); 10 403 /* parameter 1: (input) string */ 10 404 /* parameter 2: (input) string length or 0 */ 10 405 10 406 declare pl1_print$string_pointer entry(pointer,fixed bin(31)); 10 407 /* parameter 1: (input) string pointer */ 10 408 /* parameter 2: (input) string size */ 10 409 10 410 declare pl1_print$string_pointer_nl entry(pointer,fixed bin(31)); 10 411 /* parameter 1: (input) string pointer */ 10 412 /* parameter 2: (input) string length or 0 */ 10 413 10 414 declare pl1_print$unaligned_nl entry(character(*) unaligned,fixed bin(31)); 10 415 /* parameter 1: (input) string */ 10 416 /* parameter 2: (input) length */ 10 417 10 418 declare pl1_print$for_lex entry (ptr, fixed bin (14), fixed bin (21), fixed bin (21), bit (1) aligned, bit (1) aligned); 10 419 /* parameter 1: (input) ptr to base of source segment */ 10 420 /* parameter 2: (input) line number */ 10 421 /* parameter 3: (input) starting offset in source seg */ 10 422 /* parameter 4: (input) number of chars to copy */ 10 423 /* parameter 5: (input) ON iff shd print line number */ 10 424 /* parameter 6: (input) ON iff line begins in comment */ 10 425 10 426 declare refer_extent entry(pointer,pointer); 10 427 /* parameter 1: (input/output) null,ref node,op node pointer */ 10 428 /* parameter 2: (input) null,ref node,op node pointer */ 10 429 10 430 declare reserve$clear entry() 10 431 returns(pointer); 10 432 /* return: (output) pointer */ 10 433 10 434 declare reserve$declare_lib entry(fixed bin(15)) 10 435 returns(pointer); 10 436 /* parameter 1: (input) builtin function number */ 10 437 /* return: (output) pointer */ 10 438 10 439 declare reserve$read_lib entry(fixed bin(15)) 10 440 returns(pointer); 10 441 /* parameter 1: (input) builtin function number */ 10 442 /* return: (output) pointer */ 10 443 10 444 declare semantic_translator entry(); 10 445 10 446 declare semantic_translator$abort entry(fixed bin(15),pointer); 10 447 /* parameter 1: (input) error number */ 10 448 /* parameter 2: (input) any node pointer */ 10 449 10 450 declare semantic_translator$error entry(fixed bin(15),pointer); 10 451 /* parameter 1: (input) error number */ 10 452 /* parameter 2: (input) any node pointer */ 10 453 10 454 declare share_expression entry(ptr) 10 455 returns(ptr); 10 456 /* parameter 1: (input) usually operator node pointer */ 10 457 /* return: (output) tree pointer or null */ 10 458 10 459 declare token_to_binary entry(ptr) reducible 10 460 returns(fixed bin(31)); 10 461 /* parameter 1: (input) token node pointer */ 10 462 /* return: (output) converted binary value */ 10 463 10 464 /* END INCLUDE FILE ... language_utility.incl.pl1 */ 9 228 9 229 /* END INCLUDE FILE ... semant.incl.pl1 */ 679 680 16 1 /* BEGIN INCLUDE FILE ... semantic_bits.incl.pl1 */ 16 2 16 3 /* Modified: 26 Dec 1979 by PCK to implement by name assignment */ 16 4 16 5 dcl context aligned bit(36), 16 6 this_context aligned bit(36); 16 7 16 8 dcl 1 def_context aligned based(addr(context)), 16 9 2 aggregate unaligned bit(1), 16 10 2 arg_list unaligned bit(1), 16 11 2 left_side unaligned bit(1), 16 12 2 return unaligned bit(1), 16 13 2 evaluate_offset unaligned bit(1), 16 14 2 top unaligned bit(1), 16 15 2 RHS_aggregate unaligned bit(1), 16 16 2 return_from_empty unaligned bit(1), 16 17 2 ignore_based unaligned bit(1), 16 18 2 ext_param unaligned bit(1), 16 19 2 cross_section unaligned bit(1), 16 20 2 string_unspec unaligned bit(1), 16 21 2 f_offset_to_be_added unaligned bit(1), 16 22 2 suppress_cross_ref unaligned bit(1), 16 23 2 by_name_assignment unaligned bit(1), 16 24 2 by_name_lookup unaligned bit(1), 16 25 2 pad unaligned bit(20); 16 26 16 27 dcl 1 def_this_context aligned like def_context based(addr(this_context)); 16 28 16 29 /* END INCLUDE FILE ... semantic_bits.incl.pl1 */ 681 682 17 1 /* BEGIN INCLUDE FILE ... symbol.incl.pl1 */ 17 2 17 3 dcl 1 symbol based aligned, 17 4 2 node_type bit(9) unal, 17 5 2 source_id structure unal, 17 6 3 file_number bit(8), 17 7 3 line_number bit(14), 17 8 3 statement_number bit(5), 17 9 2 location fixed(18) unal unsigned, 17 10 2 allocated bit(1) unal, 17 11 2 dcl_type bit(3) unal, 17 12 2 reserved bit(6) unal, 17 13 2 pix unal, 17 14 3 pic_fixed bit(1) unal, 17 15 3 pic_float bit(1) unal, 17 16 3 pic_char bit(1) unal, 17 17 3 pic_scale fixed(7) unal, 17 18 3 pic_size fixed(7) unal, 17 19 2 level fixed(8) unal, 17 20 2 boundary fixed(3) unal, 17 21 2 size_units fixed(3) unal, 17 22 2 scale fixed(7) unal, 17 23 2 runtime bit(18) unal, 17 24 2 runtime_offset bit(18) unal, 17 25 2 block_node ptr unal, 17 26 2 token ptr unal, 17 27 2 next ptr unal, 17 28 2 multi_use ptr unal, 17 29 2 cross_references ptr unal, 17 30 2 initial ptr unal, 17 31 2 array ptr unal, 17 32 2 descriptor ptr unal, 17 33 2 equivalence ptr unal, 17 34 2 reference ptr unal, 17 35 2 general ptr unal, 17 36 2 father ptr unal, 17 37 2 brother ptr unal, 17 38 2 son ptr unal, 17 39 2 word_size ptr unal, 17 40 2 bit_size ptr unal, 17 41 2 dcl_size ptr unal, 17 42 2 symtab_size ptr unal, 17 43 2 c_word_size fixed(24), 17 44 2 c_bit_size fixed(24), 17 45 2 c_dcl_size fixed(24), 17 46 17 47 2 attributes structure aligned, 17 48 3 data_type structure unal, 17 49 4 structure bit(1) , 17 50 4 fixed bit(1), 17 51 4 float bit(1), 17 52 4 bit bit(1), 17 53 4 char bit(1), 17 54 4 ptr bit(1), 17 55 4 offset bit(1), 17 56 4 area bit(1), 17 57 4 label bit(1), 17 58 4 entry bit(1), 17 59 4 file bit(1), 17 60 4 arg_descriptor bit(1), 17 61 4 storage_block bit(1), 17 62 4 explicit_packed bit(1), /* options(packed) */ 17 63 4 condition bit(1), 17 64 4 format bit(1), 17 65 4 builtin bit(1), 17 66 4 generic bit(1), 17 67 4 picture bit(1), 17 68 17 69 3 misc_attributes structure unal, 17 70 4 dimensioned bit(1), 17 71 4 initialed bit(1), 17 72 4 aligned bit(1), 17 73 4 unaligned bit(1), 17 74 4 signed bit(1), 17 75 4 unsigned bit(1), 17 76 4 precision bit(1), 17 77 4 varying bit(1), 17 78 4 local bit(1), 17 79 4 decimal bit(1), 17 80 4 binary bit(1), 17 81 4 real bit(1), 17 82 4 complex bit(1), 17 83 4 variable bit(1), 17 84 4 reducible bit(1), 17 85 4 irreducible bit(1), 17 86 4 returns bit(1), 17 87 4 position bit(1), 17 88 4 internal bit(1), 17 89 4 external bit(1), 17 90 4 like bit(1), 17 91 4 member bit(1), 17 92 4 non_varying bit(1), 17 93 4 options bit(1), 17 94 4 variable_arg_list bit(1), /* options(variable) */ 17 95 4 alloc_in_text bit(1), /* options(constant) */ 17 96 17 97 3 storage_class structure unal, 17 98 4 auto bit(1), 17 99 4 based bit(1), 17 100 4 static bit(1), 17 101 4 controlled bit(1), 17 102 4 defined bit(1), 17 103 4 parameter bit(1), 17 104 4 param_desc bit(1), 17 105 4 constant bit(1), 17 106 4 temporary bit(1), 17 107 4 return_value bit(1), 17 108 17 109 3 file_attributes structure unal, 17 110 4 print bit(1), 17 111 4 input bit(1), 17 112 4 output bit(1), 17 113 4 update bit(1), 17 114 4 stream bit(1), 17 115 4 reserved_1 bit(1), 17 116 4 record bit(1), 17 117 4 sequential bit(1), 17 118 4 direct bit(1), 17 119 4 interactive bit(1), /* env(interactive) */ 17 120 4 reserved_2 bit(1), 17 121 4 reserved_3 bit(1), 17 122 4 stringvalue bit(1), /* env(stringvalue) */ 17 123 4 keyed bit(1), 17 124 4 reserved_4 bit(1), 17 125 4 environment bit(1), 17 126 17 127 3 compiler_developed structure unal, 17 128 4 aliasable bit(1), 17 129 4 packed bit(1), 17 130 4 passed_as_arg bit(1), 17 131 4 allocate bit(1), 17 132 4 set bit(1), 17 133 4 exp_extents bit(1), 17 134 4 refer_extents bit(1), 17 135 4 star_extents bit(1), 17 136 4 isub bit(1), 17 137 4 put_in_symtab bit(1), 17 138 4 contiguous bit(1), 17 139 4 put_data bit(1), 17 140 4 overlayed bit(1), 17 141 4 error bit(1), 17 142 4 symtab_processed bit(1), 17 143 4 overlayed_by_builtin bit(1), 17 144 4 defaulted bit(1), 17 145 4 connected bit(1); 17 146 17 147 /* END INCLUDE FILE ... symbol.incl.pl1 */ 683 684 18 1 /* statement types */ 18 2 18 3 dcl ( unknown_statement initial("000000000"b), 18 4 allocate_statement initial("000000001"b), 18 5 assignment_statement initial("000000010"b), 18 6 begin_statement initial("000000011"b), 18 7 call_statement initial("000000100"b), 18 8 close_statement initial("000000101"b), 18 9 declare_statement initial("000000110"b), 18 10 lock_statement initial("000000111"b), 18 11 delete_statement initial("000001000"b), 18 12 display_statement initial("000001001"b), 18 13 do_statement initial("000001010"b), 18 14 else_clause initial("000001011"b), 18 15 end_statement initial("000001100"b), 18 16 entry_statement initial("000001101"b), 18 17 exit_statement initial("000001110"b), 18 18 format_statement initial("000001111"b), 18 19 free_statement initial("000010000"b), 18 20 get_statement initial("000010001"b), 18 21 goto_statement initial("000010010"b), 18 22 if_statement initial("000010011"b), 18 23 locate_statement initial("000010100"b), 18 24 null_statement initial("000010101"b), 18 25 on_statement initial("000010110"b), 18 26 open_statement initial("000010111"b), 18 27 procedure_statement initial("000011000"b), 18 28 put_statement initial("000011001"b), 18 29 read_statement initial("000011010"b), 18 30 return_statement initial("000011011"b), 18 31 revert_statement initial("000011100"b), 18 32 rewrite_statement initial("000011101"b), 18 33 signal_statement initial("000011110"b), 18 34 stop_statement initial("000011111"b), 18 35 system_on_unit initial("000100000"b), 18 36 unlock_statement initial("000100001"b), 18 37 wait_statement initial("000100010"b), 18 38 write_statement initial("000100011"b), 18 39 default_statement initial("000100100"b), 18 40 continue_statement initial("000100101"b)) bit(9) internal static aligned options(constant); 685 686 19 1 /* *********************************************************** 19 2* * * 19 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 19 4* * * 19 5* *********************************************************** */ 19 6 /* BEGIN INCLUDE FILE ... statement.incl.pl1 */ 19 7 /* Internal interface of the PL/I compiler */ 19 8 19 9 dcl 1 statement based aligned, 19 10 2 node_type bit(9) unaligned, 19 11 2 source_id structure unaligned, 19 12 3 file_number bit(8), 19 13 3 line_number bit(14), 19 14 3 statement_number bit(5), 19 15 2 next ptr unaligned, 19 16 2 back ptr unaligned, 19 17 2 root ptr unaligned, 19 18 2 labels ptr unaligned, 19 19 2 reference_list ptr unaligned, 19 20 2 state_list ptr unaligned, 19 21 2 reference_count fixed(17) unaligned, 19 22 2 ref_count_copy fixed(17) unaligned, 19 23 2 object structure unaligned, 19 24 3 start fixed(17), 19 25 3 finish fixed(17), 19 26 2 source structure unaligned, 19 27 3 segment fixed(11), 19 28 3 start fixed(23), 19 29 3 length fixed(11), 19 30 2 prefix bit(12) unaligned, 19 31 2 optimized bit(1) unaligned, 19 32 2 free_temps bit(1) unaligned, 19 33 2 LHS_in_RHS bit(1) unaligned, 19 34 2 statement_type bit(9) unaligned, 19 35 2 bits structure unaligned, 19 36 3 processed bit(1) unaligned, 19 37 3 put_in_profile bit(1) unaligned, 19 38 3 generated bit(1) unaligned, 19 39 3 snap bit(1) unaligned, 19 40 3 system bit(1) unaligned, 19 41 3 irreducible bit(1) unaligned, 19 42 3 checked bit(1) unaligned, 19 43 3 save_temps bit(1) unaligned, 19 44 3 suppress_warnings bit(1) unaligned, 19 45 3 force_nonquick bit(1) unaligned, 19 46 3 expanded_by_name bit(1) unaligned, 19 47 3 begins_loop bit(1) unaligned, 19 48 3 pad bit(24) unaligned; 19 49 19 50 /* END INCLUDE FILE ... statement.incl.pl1 */ 687 688 689 end expand_by_name; 690 691 SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 09/22/89 1400.0 expand_by_name.pl1 >spec>install>1073>expand_by_name.pl1 663 1 07/21/80 1546.3 by_name_agg.incl.pl1 >ldd>include>by_name_agg.incl.pl1 665 2 10/25/79 1645.8 declare_type.incl.pl1 >ldd>include>declare_type.incl.pl1 667 3 08/13/81 2211.5 list.incl.pl1 >ldd>include>list.incl.pl1 669 4 07/21/80 1546.3 nodes.incl.pl1 >ldd>include>nodes.incl.pl1 671 5 04/07/83 1635.0 op_codes.incl.pl1 >ldd>include>op_codes.incl.pl1 673 6 07/21/80 1546.3 operator.incl.pl1 >ldd>include>operator.incl.pl1 675 7 07/21/80 1546.3 pl1_tree_areas.incl.pl1 >ldd>include>pl1_tree_areas.incl.pl1 677 8 07/21/80 1546.3 reference.incl.pl1 >ldd>include>reference.incl.pl1 679 9 07/21/80 1546.3 semant.incl.pl1 >ldd>include>semant.incl.pl1 9-228 10 08/01/89 1239.9 language_utility.incl.pl1 >ldd>include>language_utility.incl.pl1 10-307 11 05/06/74 1746.9 source_id_descriptor.incl.pl1 >ldd>include>source_id_descriptor.incl.pl1 10-325 12 05/06/74 1746.9 source_id_descriptor.incl.pl1 >ldd>include>source_id_descriptor.incl.pl1 10-335 13 05/06/74 1746.9 source_id_descriptor.incl.pl1 >ldd>include>source_id_descriptor.incl.pl1 10-374 14 05/06/74 1746.9 source_id_descriptor.incl.pl1 >ldd>include>source_id_descriptor.incl.pl1 10-386 15 05/06/74 1746.9 source_id_descriptor.incl.pl1 >ldd>include>source_id_descriptor.incl.pl1 681 16 07/21/80 1546.3 semantic_bits.incl.pl1 >ldd>include>semantic_bits.incl.pl1 683 17 12/07/83 1701.7 symbol.incl.pl1 >ldd>include>symbol.incl.pl1 685 18 05/03/76 1320.4 statement_types.incl.pl1 >ldd>include>statement_types.incl.pl1 687 19 04/07/83 1635.0 statement.incl.pl1 >ldd>include>statement.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. ASSIGNMENT_GENERATED 000111 automatic bit(1) dcl 59 set ref 64* 112 487* CUR_BNA 000312 automatic pointer dcl 604 set ref 607* 611 612* 622 624* 624 638 638 640 641* 641 644 645* 653 654* 654 CUR_BNA_NODE 000160 automatic pointer dcl 272 set ref 280* 313 314 316* 338 339* 339 365 365 369 370 371 372* 375 476 CUR_STMNT 000102 automatic pointer dcl 55 set ref 66* ERR_REF 000104 automatic pointer dcl 56 set ref 141* 145* 150* 153* 156* FALSE constant bit(1) initial dcl 47 ref 64 167 279 352 410 483 514 647 LHS_reference 000262 automatic pointer dcl 502 set ref 513* 514 515 517 524 LHS_symbol 000260 automatic pointer dcl 502 set ref 511* 512 513 NO_OF_TARGETS 000110 automatic fixed bin(17,0) dcl 58 set ref 67* 508 515 520 SUB_STRUC 000156 automatic pointer dcl 271 set ref 277* 288* 289 308* 308 312 335 335 337* 337 351 363* 363 375 TARGET_LIST 000106 automatic pointer dcl 57 set ref 65* 67 139 140 508 523 TRAVERSE_STRUCTURE 000162 automatic bit(1) dcl 273 set ref 285* 287 352* TRAVERSE_TREE 000314 automatic bit(1) packed unaligned dcl 605 set ref 619* 621 647* TRUE constant bit(1) initial dcl 46 ref 86 87 137 285 403 415 487 505 512 525 526 619 addr builtin function dcl 42 ref 86 87 137 167 assign 000001 constant bit(9) initial dcl 5-8 set ref 506 522* assignment_statement 000000 constant bit(9) initial dcl 18-3 set ref 521* attributes 31 based structure level 2 dcl 17-3 bits 13 based structure level 2 packed packed unaligned dcl 19-9 blk parameter pointer dcl 31 set ref 26 150* 189* bna 000324 automatic pointer dcl 636 in procedure "pop" set ref 640* 642* 653* 655* bna 000172 automatic pointer dcl 306 in procedure "push" set ref 310* 312 313 314 316 bna parameter pointer dcl 563 in procedure "free_by_name_agg" ref 560 565 566 bna 000234 automatic pointer dcl 448 in procedure "get_by_name_agg" set ref 455* 459* 463 464 bna 000204 automatic pointer dcl 333 in procedure "pop" set ref 338* 341 343 343 345 348* 365* 368* 369 370 371 372 bna 000244 automatic pointer dcl 474 in procedure "record_intersection" set ref 476* 482 483 484* 484 brother 20 based pointer level 2 packed packed unaligned dcl 17-3 ref 335 335 363 417 by_compiler 000002 constant bit(3) initial dcl 2-5 set ref 511* by_name_agg based structure level 1 dcl 1-3 set ref 459 463* by_name_lookup 0(15) based bit(1) level 2 packed packed unaligned dcl 16-27 set ref 87* by_name_ref 000174 automatic pointer dcl 306 in procedure "push" set ref 318* 319 320 320 321* 321 by_name_ref 000206 automatic pointer dcl 333 in procedure "pop" set ref 356* 357 358 358 359* 359 377* 378 379 379 380* 380 by_name_ref 000110 automatic pointer dcl 541 in procedure "get_by_name_ref" set ref 545* 548* 549 550 553 by_name_ref 000302 automatic pointer dcl 579 in procedure "free_by_name_refs" set ref 583* 584 585* 585 588 by_name_ref 000100 automatic pointer dcl 214 in procedure "append" set ref 216* 222 226 228 create_list 000024 constant entry external dcl 10-147 ref 545 create_operator 000026 constant entry external dcl 10-152 ref 522 create_statement 000030 constant entry external dcl 10-163 ref 521 create_symbol 000032 constant entry external dcl 10-184 ref 511 data_type 31 based structure level 3 packed packed unaligned dcl 17-3 def_context based structure level 1 dcl 16-8 def_this_context based structure level 1 dcl 16-27 element 1 based pointer array level 2 packed packed unaligned dcl 3-6 set ref 104 140 222* 226* 320* 320 321 358* 358 359 379* 379 380 409 429* 430 508 523 549 550* 584 585 588* expanded_by_name 13(10) based bit(1) level 3 packed packed unaligned dcl 19-9 set ref 505* 526* father 17 based pointer level 2 in structure "symbol" packed packed unaligned dcl 17-3 in procedure "expand_by_name" ref 337 358 379 father 2 based pointer level 2 in structure "by_name_agg" packed packed unaligned dcl 1-3 in procedure "expand_by_name" set ref 313* 339 345 371* 371 484 641 generated 13(02) based bit(1) level 3 packed packed unaligned dcl 19-9 set ref 525* i 000122 automatic fixed bin(17,0) dcl 130 in procedure "traverse_target_list" set ref 139* 140* i 000100 automatic fixed bin(17,0) dcl 182 in procedure "traverse_expression" set ref 185* 187* label_node constant bit(9) initial dcl 4-5 ref 153 left_brother 3 based pointer level 2 packed packed unaligned dcl 1-3 set ref 343 343 369* left_side 0(02) based bit(1) level 2 packed packed unaligned dcl 16-27 set ref 137* 167* list based structure level 1 dcl 3-6 lookup 000022 constant entry external dcl 9-153 ref 150 189 match 000224 automatic bit(1) dcl 397 set ref 403* 408 410* 411 415* 425 426* 428 435 new_assignment 000256 automatic pointer dcl 502 set ref 522* 523 524 527 new_stmnt 000254 automatic pointer dcl 502 set ref 519* 521* 521* 525 526 527 next 6 based pointer level 2 packed packed unaligned dcl 1-3 set ref 456 565* node based structure level 1 dcl 4-27 null builtin function dcl 42 ref 73 80 113 113 115 116 289 319 335 335 343 343 345 357 378 408 411 454 511 511 511 511 521 521 545 550 584 590 611 613 622 638 638 646 null_statement constant bit(9) initial dcl 18-3 ref 114 number 0(21) based fixed bin(14,0) level 2 in structure "operator" packed packed unaligned dcl 6-6 in procedure "expand_by_name" ref 185 number 0(21) based fixed bin(14,0) level 2 in structure "list" packed packed unaligned dcl 3-6 in procedure "expand_by_name" ref 67 139 550 ok_to_free 0(35) based bit(1) level 2 packed packed unaligned dcl 1-3 set ref 279* 341 365 482 483* op_code 0(09) based bit(9) level 2 packed packed unaligned dcl 6-6 set ref 506* operand 1 based pointer array level 2 packed packed unaligned dcl 6-6 set ref 65 95 187 508* 517* 523* 524* operand_ptr parameter pointer dcl 180 set ref 177 185 185 187 189* operator based structure level 1 dcl 6-6 operator_node constant bit(9) initial dcl 4-5 ref 185 pl1_nodes_template_$by_name_agg_template 000040 external static structure level 1 dcl 445 ref 463 pl1_stat_$by_name_free_list 000014 external static pointer dcl 37 set ref 545 548 549* 588 589* pl1_stat_$by_name_parts_free_list 000012 external static pointer dcl 36 set ref 454 455 456* 456 565 566* pl1_stat_$by_name_parts_tree 000010 external static pointer dcl 35 set ref 73 278* 279 280 607 613* 644 646* pl1_stat_$by_name_ref_list 000016 external static pointer dcl 38 set ref 80 104 226 228* 318 356 377 407 583 589 590* pl1_stat_$node_uses 000042 external static fixed bin(17,0) array dcl 446 set ref 460* 460 pl1_stat_$xeq_tree_area_ptr 000020 external static pointer dcl 7-7 ref 459 prefix 12(12) based bit(12) level 2 packed packed unaligned dcl 19-9 ref 521 ref_count 0(18) based fixed bin(17,0) level 2 packed packed unaligned dcl 8-3 set ref 515* reference based structure level 1 dcl 8-3 in procedure "expand_by_name" reference 15 based pointer level 2 in structure "symbol" packed packed unaligned dcl 17-3 in procedure "expand_by_name" ref 513 reference_node constant bit(9) initial dcl 4-5 ref 145 right_brother 4 based pointer level 2 packed packed unaligned dcl 1-3 set ref 343* 370* 638 638 654 root 3 based pointer level 2 in structure "statement" packed packed unaligned dcl 19-9 in procedure "expand_by_name" set ref 115* 527* root parameter pointer dcl 267 in procedure "traverse_structures" ref 264 277 351 root_of_any_struc 000100 automatic pointer dcl 51 set ref 104* 108* s 000126 automatic pointer dcl 131 in procedure "traverse_target_list" set ref 150* 153 156 161* s 000102 automatic pointer dcl 183 in procedure "traverse_expression" set ref 189* 192 197 197* semantic_translator$abort 000034 constant entry external dcl 10-446 ref 145 150 153 156 semantic_translator$error 000036 constant entry external dcl 10-450 ref 113 shared 0(11) based bit(1) level 2 packed packed unaligned dcl 8-3 set ref 514* son 21 based pointer level 2 in structure "symbol" packed packed unaligned dcl 17-3 in procedure "expand_by_name" ref 289 308 320 379 son 5 based pointer level 2 in structure "by_name_agg" packed packed unaligned dcl 1-3 in procedure "expand_by_name" set ref 314* 345* 611 622 624 statement based structure level 1 dcl 19-9 statement_type 12(27) based bit(9) level 2 packed packed unaligned dcl 19-9 set ref 114* stmnt parameter pointer dcl 31 set ref 26 66 114 115 150* 189* 505 519 521 storage_class 32(09) based structure level 3 packed packed unaligned dcl 17-3 structure 31 based bit(1) level 4 packed packed unaligned dcl 17-3 ref 156 197 426 426 suppress_cross_ref 0(13) based bit(1) level 2 packed packed unaligned dcl 16-27 set ref 86* sym_ptr parameter pointer dcl 212 ref 209 222 sym_to_be_matched 000222 automatic pointer dcl 396 set ref 409* 411 415 417* 417 426 429 symbol based structure level 1 dcl 17-3 symbol_node constant bit(9) initial dcl 4-5 ref 192 symbol_ptr parameter pointer dcl 394 ref 391 399 426 targ_idx 000264 automatic fixed bin(17,0) dcl 503 set ref 520* 523* targ_ptr 000124 automatic pointer dcl 131 set ref 140* 141 145 145 150* temporary 32(17) based bit(1) level 4 packed packed unaligned dcl 17-3 set ref 512* this_context 000112 automatic bit(36) dcl 16-5 set ref 85* 86 87 137 150* 167 189* to_be_matched_ptr 000220 automatic pointer dcl 396 set ref 407* 408 409 429 430* 430 token 1 based pointer level 2 in structure "by_name_agg" packed packed unaligned dcl 1-3 in procedure "expand_by_name" set ref 312* 375* token 5 based pointer level 2 in structure "symbol" packed packed unaligned dcl 17-3 in procedure "expand_by_name" ref 312 375 399 415 token_node constant bit(9) initial dcl 4-5 ref 145 token_ptr 000216 automatic pointer dcl 396 set ref 399* 415 tree parameter pointer dcl 31 set ref 26 65 95 116* 506 508 517 type based bit(9) level 2 packed packed unaligned dcl 4-27 ref 145 145 153 185 192 xeq_tree_area based area(1024) dcl 7-5 ref 459 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. a_format internal static bit(9) initial dcl 5-8 abs_fun internal static bit(9) initial dcl 5-8 acos_fun internal static bit(9) initial dcl 5-8 acosd_fun internal static bit(9) initial dcl 5-8 add internal static bit(9) initial dcl 5-8 addbitno_fun internal static bit(9) initial dcl 5-8 addcharno_fun internal static bit(9) initial dcl 5-8 addr_fun internal static bit(9) initial dcl 5-8 addr_fun_bits internal static bit(9) initial dcl 5-8 addrel_fun internal static bit(9) initial dcl 5-8 adjust_count 000000 constant entry external dcl 10-20 alloc_semantics 000000 constant entry external dcl 9-7 alloc_semantics$init_only 000000 constant entry external dcl 9-12 allocate_statement internal static bit(9) initial dcl 18-3 allocation_fun internal static bit(9) initial dcl 5-8 allot_auto internal static bit(9) initial dcl 5-8 allot_based internal static bit(9) initial dcl 5-8 allot_ctl internal static bit(9) initial dcl 5-8 allot_var internal static bit(9) initial dcl 5-8 and_bits internal static bit(9) initial dcl 5-8 array_node internal static bit(9) initial dcl 4-5 asin_fun internal static bit(9) initial dcl 5-8 asind_fun internal static bit(9) initial dcl 5-8 assign_by_name internal static bit(9) initial dcl 5-8 assign_round internal static bit(9) initial dcl 5-8 assign_size_ck internal static bit(9) initial dcl 5-8 assign_zero internal static bit(9) initial dcl 5-8 atan_fun internal static bit(9) initial dcl 5-8 atand_fun internal static bit(9) initial dcl 5-8 b_format internal static bit(9) initial dcl 5-8 baseno_fun internal static bit(9) initial dcl 5-8 baseptr_fun internal static bit(9) initial dcl 5-8 begin_statement internal static bit(9) initial dcl 18-3 binary_to_octal_string 000000 constant entry external dcl 10-38 binary_to_octal_var_string 000000 constant entry external dcl 10-43 bindec 000000 constant entry external dcl 10-23 bindec$vs 000000 constant entry external dcl 10-28 binoct 000000 constant entry external dcl 10-33 bit_pointer internal static bit(9) initial dcl 5-8 bit_to_char internal static bit(9) initial dcl 5-8 bit_to_word internal static bit(9) initial dcl 5-8 bitno_fun internal static bit(9) initial dcl 5-8 block_node internal static bit(9) initial dcl 4-5 bn_format internal static bit(9) initial dcl 5-8 bool_fun internal static bit(9) initial dcl 5-8 bound_ck internal static bit(9) initial dcl 5-8 bound_node internal static bit(9) initial dcl 4-5 builtin 000000 constant entry external dcl 9-17 by_context internal static bit(3) initial dcl 2-5 by_declare internal static bit(3) initial dcl 2-5 by_explicit_context internal static bit(3) initial dcl 2-5 by_implication internal static bit(3) initial dcl 2-5 by_name_agg_node internal static bit(9) initial dcl 4-5 byte_fun internal static bit(9) initial dcl 5-8 c_format internal static bit(9) initial dcl 5-8 call_statement internal static bit(9) initial dcl 18-3 cat_string internal static bit(9) initial dcl 5-8 ceil_fun internal static bit(9) initial dcl 5-8 char_to_word internal static bit(9) initial dcl 5-8 charno_fun internal static bit(9) initial dcl 5-8 check_star_extents 000000 constant entry external dcl 9-27 clock_fun internal static bit(9) initial dcl 5-8 close_file internal static bit(9) initial dcl 5-8 close_statement internal static bit(9) initial dcl 18-3 codeptr_fun internal static bit(9) initial dcl 5-8 column_format internal static bit(9) initial dcl 5-8 compare_declaration 000000 constant entry external dcl 9-31 compare_expression 000000 constant entry external dcl 10-48 complex_fun internal static bit(9) initial dcl 5-8 conjg_fun internal static bit(9) initial dcl 5-8 constant_length 000000 constant entry external dcl 10-54 context automatic bit(36) dcl 16-5 context_node internal static bit(9) initial dcl 4-5 context_processor 000000 constant entry external dcl 9-38 continue_statement internal static bit(9) initial dcl 18-3 convert 000000 constant entry external dcl 10-60 convert$from_builtin 000000 constant entry external dcl 10-72 convert$to_integer 000000 constant entry external dcl 10-66 convert$to_target 000000 constant entry external dcl 10-88 convert$to_target_fb 000000 constant entry external dcl 10-82 convert$validate 000000 constant entry external dcl 10-78 copy_expression 000000 constant entry external dcl 10-94 copy_expression$copy_sons 000000 constant entry external dcl 10-99 copy_string internal static bit(9) initial dcl 5-8 copy_unique_expression 000000 constant entry external dcl 10-103 copy_words internal static bit(9) initial dcl 5-8 cos_fun internal static bit(9) initial dcl 5-8 cosd_fun internal static bit(9) initial dcl 5-8 create_array 000000 constant entry external dcl 10-108 create_block 000000 constant entry external dcl 10-112 create_bound 000000 constant entry external dcl 10-118 create_context 000000 constant entry external dcl 10-122 create_cross_reference 000000 constant entry external dcl 10-128 create_default 000000 constant entry external dcl 10-132 create_identifier 000000 constant entry external dcl 10-136 create_label 000000 constant entry external dcl 10-140 create_reference 000000 constant entry external dcl 10-158 create_statement$prologue 000000 constant entry external dcl 10-171 create_storage 000000 constant entry external dcl 10-179 create_token 000000 constant entry external dcl 10-191 create_token$init_hash_table 000000 constant entry external dcl 10-197 create_token$protected 000000 constant entry external dcl 10-199 cross_reference_node internal static bit(9) initial dcl 4-5 decbin 000000 constant entry external dcl 10-206 declare 000000 constant entry external dcl 9-41 declare_constant 000000 constant entry external dcl 10-211 declare_constant$bit 000000 constant entry external dcl 10-219 declare_constant$char 000000 constant entry external dcl 10-224 declare_constant$desc 000000 constant entry external dcl 10-229 declare_constant$integer 000000 constant entry external dcl 10-234 declare_descriptor 000000 constant entry external dcl 10-239 declare_descriptor$ctl 000000 constant entry external dcl 10-249 declare_descriptor$param 000000 constant entry external dcl 10-259 declare_integer 000000 constant entry external dcl 10-269 declare_picture 000000 constant entry external dcl 10-274 declare_picture_temp 000000 constant entry external dcl 10-279 declare_pointer 000000 constant entry external dcl 10-287 declare_statement internal static bit(9) initial dcl 18-3 declare_structure 000000 constant entry external dcl 9-44 declare_temporary 000000 constant entry external dcl 10-292 decode_node_id 000000 constant entry external dcl 10-300 decode_source_id 000000 constant entry external dcl 10-306 default_node internal static bit(9) initial dcl 4-5 default_statement internal static bit(9) initial dcl 18-3 defined_reference 000000 constant entry external dcl 9-47 delete_file internal static bit(9) initial dcl 5-8 delete_statement internal static bit(9) initial dcl 18-3 desc_size internal static bit(9) initial dcl 5-8 digit_to_bit internal static bit(9) initial dcl 5-8 display_statement internal static bit(9) initial dcl 18-3 div internal static bit(9) initial dcl 5-8 do_fun internal static bit(9) initial dcl 5-8 do_semantics 000000 constant entry external dcl 9-57 do_spec internal static bit(9) initial dcl 5-8 do_statement internal static bit(9) initial dcl 18-3 e_format internal static bit(9) initial dcl 5-8 else_clause internal static bit(9) initial dcl 18-3 empty_area internal static bit(9) initial dcl 5-8 enable_on internal static bit(9) initial dcl 5-8 end_statement internal static bit(9) initial dcl 18-3 entry_statement internal static bit(9) initial dcl 18-3 environmentptr_fun internal static bit(9) initial dcl 5-8 equal internal static bit(9) initial dcl 5-8 error 000000 constant entry external dcl 10-314 error$omit_text 000000 constant entry external dcl 10-319 error_ 000000 constant entry external dcl 10-324 error_$finish 000000 constant entry external dcl 10-343 error_$initialize_error 000000 constant entry external dcl 10-341 error_$no_text 000000 constant entry external dcl 10-334 ex_prologue internal static bit(9) initial dcl 5-8 exit_statement internal static bit(9) initial dcl 18-3 exp internal static bit(9) initial dcl 5-8 exp_fun internal static bit(9) initial dcl 5-8 expand_assign 000000 constant entry external dcl 9-62 expand_by_name 000000 constant entry external dcl 9-71 expand_infix 000000 constant entry external dcl 9-76 expand_initial 000000 constant entry external dcl 9-84 expand_prefix 000000 constant entry external dcl 9-89 expand_primitive 000000 constant entry external dcl 9-97 expression_semantics 000000 constant entry external dcl 9-105 f_format internal static bit(9) initial dcl 5-8 fill_refer 000000 constant entry external dcl 9-113 floor_fun internal static bit(9) initial dcl 5-8 format_statement internal static bit(9) initial dcl 18-3 format_value_node internal static bit(9) initial dcl 4-5 fortran_read internal static bit(9) initial dcl 5-8 fortran_write internal static bit(9) initial dcl 5-8 free_based internal static bit(9) initial dcl 5-8 free_ctl internal static bit(9) initial dcl 5-8 free_node 000000 constant entry external dcl 10-345 free_statement internal static bit(9) initial dcl 18-3 free_var internal static bit(9) initial dcl 5-8 ftn_file_manip internal static bit(9) initial dcl 5-8 ftn_trans_loop internal static bit(9) initial dcl 5-8 function 000000 constant entry external dcl 9-125 generic_selector 000000 constant entry external dcl 9-134 get_array_size 000000 constant entry external dcl 10-348 get_data_trans internal static bit(9) initial dcl 5-8 get_edit_trans internal static bit(9) initial dcl 5-8 get_file internal static bit(9) initial dcl 5-8 get_list_trans internal static bit(9) initial dcl 5-8 get_size 000000 constant entry external dcl 10-352 get_statement internal static bit(9) initial dcl 18-3 get_string internal static bit(9) initial dcl 5-8 goto_statement internal static bit(9) initial dcl 18-3 greater_or_equal internal static bit(9) initial dcl 5-8 greater_than internal static bit(9) initial dcl 5-8 half_to_word internal static bit(9) initial dcl 5-8 if_statement internal static bit(9) initial dcl 18-3 imag_fun internal static bit(9) initial dcl 5-8 index_after_fun internal static bit(9) initial dcl 5-8 index_before_fun internal static bit(9) initial dcl 5-8 index_fun internal static bit(9) initial dcl 5-8 index_rev_fun internal static bit(9) initial dcl 5-8 io_data_list_semantics 000000 constant entry external dcl 9-143 io_data_list_semantics$format_list_semantics 000000 constant entry external dcl 9-120 io_semantics 000000 constant entry external dcl 9-148 join internal static bit(9) initial dcl 5-8 jump internal static bit(9) initial dcl 5-8 jump_false internal static bit(9) initial dcl 5-8 jump_if_eq internal static bit(9) initial dcl 5-8 jump_if_ge internal static bit(9) initial dcl 5-8 jump_if_gt internal static bit(9) initial dcl 5-8 jump_if_le internal static bit(9) initial dcl 5-8 jump_if_lt internal static bit(9) initial dcl 5-8 jump_if_ne internal static bit(9) initial dcl 5-8 jump_true internal static bit(9) initial dcl 5-8 l_parn internal static bit(9) initial dcl 5-8 label_array_element_node internal static bit(9) initial dcl 4-5 length_fun internal static bit(9) initial dcl 5-8 less_or_equal internal static bit(9) initial dcl 5-8 less_than internal static bit(9) initial dcl 5-8 line_format internal static bit(9) initial dcl 5-8 list_node internal static bit(9) initial dcl 4-5 locate_file internal static bit(9) initial dcl 5-8 locate_statement internal static bit(9) initial dcl 18-3 lock_file internal static bit(9) initial dcl 5-8 lock_fun internal static bit(9) initial dcl 5-8 lock_statement internal static bit(9) initial dcl 18-3 log10_fun internal static bit(9) initial dcl 5-8 log2_fun internal static bit(9) initial dcl 5-8 log_fun internal static bit(9) initial dcl 5-8 loop internal static bit(9) initial dcl 5-8 machine_state_node internal static bit(9) initial dcl 4-5 make_desc internal static bit(9) initial dcl 5-8 make_non_quick 000000 constant entry external dcl 9-162 match_arguments 000000 constant entry external dcl 9-166 max_fun internal static bit(9) initial dcl 5-8 max_list_elements internal static fixed bin(17,0) initial dcl 3-12 max_number_of_operands internal static fixed bin(15,0) initial dcl 6-15 merge_attributes 000000 constant entry external dcl 10-355 min_fun internal static bit(9) initial dcl 5-8 mod_bit internal static bit(9) initial dcl 5-8 mod_byte internal static bit(9) initial dcl 5-8 mod_fun internal static bit(9) initial dcl 5-8 mod_half internal static bit(9) initial dcl 5-8 mod_word internal static bit(9) initial dcl 5-8 mult internal static bit(9) initial dcl 5-8 negate internal static bit(9) initial dcl 5-8 nop internal static bit(9) initial dcl 5-8 not_bits internal static bit(9) initial dcl 5-8 not_equal internal static bit(9) initial dcl 5-8 off_fun internal static bit(9) initial dcl 5-8 offset_adder 000000 constant entry external dcl 9-172 on_statement internal static bit(9) initial dcl 18-3 open_file internal static bit(9) initial dcl 5-8 open_statement internal static bit(9) initial dcl 18-3 operator_semantics 000000 constant entry external dcl 9-184 optimizer 000000 constant entry external dcl 10-361 or_bits internal static bit(9) initial dcl 5-8 pack internal static bit(9) initial dcl 5-8 page_format internal static bit(9) initial dcl 5-8 param_desc_ptr internal static bit(9) initial dcl 5-8 param_ptr internal static bit(9) initial dcl 5-8 parse_error 000000 constant entry external dcl 10-364 parse_error$no_text 000000 constant entry external dcl 10-368 picture_format internal static bit(9) initial dcl 5-8 pl1_error_print$listing_segment 000000 constant entry external dcl 10-384 pl1_error_print$write_out 000000 constant entry external dcl 10-372 pl1_mod_fun internal static bit(9) initial dcl 5-8 pl1_print$for_lex 000000 constant entry external dcl 10-418 pl1_print$non_varying 000000 constant entry external dcl 10-398 pl1_print$non_varying_nl 000000 constant entry external dcl 10-402 pl1_print$string_pointer 000000 constant entry external dcl 10-406 pl1_print$string_pointer_nl 000000 constant entry external dcl 10-410 pl1_print$unaligned_nl 000000 constant entry external dcl 10-414 pl1_print$varying 000000 constant entry external dcl 10-392 pl1_print$varying_nl 000000 constant entry external dcl 10-395 pl1_stat_$tree_area_ptr external static pointer dcl 7-7 prefix_plus internal static bit(9) initial dcl 5-8 procedure_statement internal static bit(9) initial dcl 18-3 propagate_bit 000000 constant entry external dcl 9-192 ptr_fun internal static bit(9) initial dcl 5-8 put_control internal static bit(9) initial dcl 5-8 put_data_trans internal static bit(9) initial dcl 5-8 put_edit_trans internal static bit(9) initial dcl 5-8 put_field internal static bit(9) initial dcl 5-8 put_field_chk internal static bit(9) initial dcl 5-8 put_file internal static bit(9) initial dcl 5-8 put_list_trans internal static bit(9) initial dcl 5-8 put_statement internal static bit(9) initial dcl 18-3 put_string internal static bit(9) initial dcl 5-8 r_format internal static bit(9) initial dcl 5-8 r_parn internal static bit(9) initial dcl 5-8 range_ck internal static bit(9) initial dcl 5-8 rank_fun internal static bit(9) initial dcl 5-8 read_file internal static bit(9) initial dcl 5-8 read_statement internal static bit(9) initial dcl 18-3 real_fun internal static bit(9) initial dcl 5-8 record_io internal static bit(9) initial dcl 5-8 refer internal static bit(9) initial dcl 5-8 refer_extent 000000 constant entry external dcl 10-426 rel_fun internal static bit(9) initial dcl 5-8 repeat_fun internal static bit(9) initial dcl 5-8 reserve$clear 000000 constant entry external dcl 10-430 reserve$declare_lib 000000 constant entry external dcl 10-434 reserve$read_lib 000000 constant entry external dcl 10-439 return_bits internal static bit(9) initial dcl 5-8 return_statement internal static bit(9) initial dcl 18-3 return_string internal static bit(9) initial dcl 5-8 return_value internal static bit(9) initial dcl 5-8 return_words internal static bit(9) initial dcl 5-8 reverse_fun internal static bit(9) initial dcl 5-8 revert_on internal static bit(9) initial dcl 5-8 revert_statement internal static bit(9) initial dcl 18-3 rewrite_file internal static bit(9) initial dcl 5-8 rewrite_statement internal static bit(9) initial dcl 18-3 round_fun internal static bit(9) initial dcl 5-8 search_fun internal static bit(9) initial dcl 5-8 search_rev_fun internal static bit(9) initial dcl 5-8 segno_fun internal static bit(9) initial dcl 5-8 semantic_translator 000000 constant entry external dcl 10-444 semantic_translator$call_es 000000 constant entry external dcl 9-196 setbitno_fun internal static bit(9) initial dcl 5-8 setcharno_fun internal static bit(9) initial dcl 5-8 sf_par_node internal static bit(9) initial dcl 4-5 share_expression 000000 constant entry external dcl 10-454 sign_fun internal static bit(9) initial dcl 5-8 signal_on internal static bit(9) initial dcl 5-8 signal_statement internal static bit(9) initial dcl 18-3 simplify_expression 000000 constant entry external dcl 9-205 simplify_offset 000000 constant entry external dcl 9-212 sin_fun internal static bit(9) initial dcl 5-8 sind_fun internal static bit(9) initial dcl 5-8 skip_format internal static bit(9) initial dcl 5-8 source_node internal static bit(9) initial dcl 4-5 sqrt_fun internal static bit(9) initial dcl 5-8 stack_ptr internal static bit(9) initial dcl 5-8 stackbaseptr_fun internal static bit(9) initial dcl 5-8 stackframeptr_fun internal static bit(9) initial dcl 5-8 stacq_fun internal static bit(9) initial dcl 5-8 statement_node internal static bit(9) initial dcl 4-5 std_arg_list internal static bit(9) initial dcl 5-8 std_call internal static bit(9) initial dcl 5-8 std_entry internal static bit(9) initial dcl 5-8 std_return internal static bit(9) initial dcl 5-8 stop internal static bit(9) initial dcl 5-8 stop_statement internal static bit(9) initial dcl 18-3 stream_prep internal static bit(9) initial dcl 5-8 sub internal static bit(9) initial dcl 5-8 subscripter 000000 constant entry external dcl 9-216 system_on_unit internal static bit(9) initial dcl 18-3 tan_fun internal static bit(9) initial dcl 5-8 tand_fun internal static bit(9) initial dcl 5-8 temporary_node internal static bit(9) initial dcl 4-5 terminate_trans internal static bit(9) initial dcl 5-8 to_be_fixed_ptr automatic pointer dcl 396 token_to_binary 000000 constant entry external dcl 10-459 translate_fun internal static bit(9) initial dcl 5-8 tree_area based area(1024) dcl 7-4 trunc_fun internal static bit(9) initial dcl 5-8 unknown_statement internal static bit(9) initial dcl 18-3 unlock_file internal static bit(9) initial dcl 5-8 unlock_statement internal static bit(9) initial dcl 18-3 unpack internal static bit(9) initial dcl 5-8 validate 000000 constant entry external dcl 9-225 vclock_fun internal static bit(9) initial dcl 5-8 verify_fun internal static bit(9) initial dcl 5-8 verify_ltrim_fun internal static bit(9) initial dcl 5-8 verify_rev_fun internal static bit(9) initial dcl 5-8 verify_rtrim_fun internal static bit(9) initial dcl 5-8 wait_statement internal static bit(9) initial dcl 18-3 word_to_mod2 internal static bit(9) initial dcl 5-8 word_to_mod4 internal static bit(9) initial dcl 5-8 word_to_mod8 internal static bit(9) initial dcl 5-8 wordno_fun internal static bit(9) initial dcl 5-8 write_file internal static bit(9) initial dcl 5-8 write_statement internal static bit(9) initial dcl 18-3 x_format internal static bit(9) initial dcl 5-8 xor_bits internal static bit(9) initial dcl 5-8 NAMES DECLARED BY EXPLICIT CONTEXT. append 000423 constant entry internal dcl 209 ref 161 197 build_assignment 001072 constant entry internal dcl 499 ref 118 expand_by_name 000020 constant entry external dcl 26 free_by_name_agg 001323 constant entry internal dcl 560 ref 348 612 642 645 655 free_by_name_parts_tree 001363 constant entry internal dcl 599 ref 73 free_by_name_refs 001335 constant entry internal dcl 576 ref 80 get_by_name_agg 001013 constant entry internal dcl 442 ref 278 310 368 get_by_name_ref 001251 constant entry internal dcl 538 ref 216 matching_ids_exist 000714 constant entry internal dcl 391 ref 288 pop 000555 constant entry internal dcl 330 in procedure "traverse_structures" ref 291 296 pop 001420 constant entry internal dcl 633 in procedure "free_by_name_parts_tree" ref 622 push 000515 constant entry internal dcl 303 ref 281 293 record_intersection 001052 constant entry internal dcl 471 ref 290 traverse_expression 000313 constant entry internal dcl 177 ref 95 187 traverse_structures 000445 constant entry internal dcl 264 ref 108 traverse_target_list 000140 constant entry internal dcl 127 ref 91 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1744 2010 1522 1754 Length 2612 1522 44 565 222 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME expand_by_name 280 external procedure is an external procedure. traverse_target_list internal procedure shares stack frame of external procedure expand_by_name. traverse_expression 106 internal procedure calls itself recursively. append 82 internal procedure is called by several nonquick procedures. traverse_structures internal procedure shares stack frame of external procedure expand_by_name. push internal procedure shares stack frame of external procedure expand_by_name. pop internal procedure shares stack frame of external procedure expand_by_name. matching_ids_exist internal procedure shares stack frame of external procedure expand_by_name. get_by_name_agg internal procedure shares stack frame of external procedure expand_by_name. record_intersection internal procedure shares stack frame of external procedure expand_by_name. build_assignment internal procedure shares stack frame of external procedure expand_by_name. get_by_name_ref internal procedure shares stack frame of internal procedure append. free_by_name_agg internal procedure shares stack frame of external procedure expand_by_name. free_by_name_refs internal procedure shares stack frame of external procedure expand_by_name. free_by_name_parts_tree internal procedure shares stack frame of external procedure expand_by_name. pop internal procedure shares stack frame of external procedure expand_by_name. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME append 000100 by_name_ref append 000110 by_name_ref get_by_name_ref expand_by_name 000100 root_of_any_struc expand_by_name 000102 CUR_STMNT expand_by_name 000104 ERR_REF expand_by_name 000106 TARGET_LIST expand_by_name 000110 NO_OF_TARGETS expand_by_name 000111 ASSIGNMENT_GENERATED expand_by_name 000112 this_context expand_by_name 000122 i traverse_target_list 000124 targ_ptr traverse_target_list 000126 s traverse_target_list 000156 SUB_STRUC traverse_structures 000160 CUR_BNA_NODE traverse_structures 000162 TRAVERSE_STRUCTURE traverse_structures 000172 bna push 000174 by_name_ref push 000204 bna pop 000206 by_name_ref pop 000216 token_ptr matching_ids_exist 000220 to_be_matched_ptr matching_ids_exist 000222 sym_to_be_matched matching_ids_exist 000224 match matching_ids_exist 000234 bna get_by_name_agg 000244 bna record_intersection 000254 new_stmnt build_assignment 000256 new_assignment build_assignment 000260 LHS_symbol build_assignment 000262 LHS_reference build_assignment 000264 targ_idx build_assignment 000302 by_name_ref free_by_name_refs 000312 CUR_BNA free_by_name_parts_tree 000314 TRAVERSE_TREE free_by_name_parts_tree 000324 bna pop traverse_expression 000100 i traverse_expression 000102 s traverse_expression THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as unpk_to_pk call_ext_out call_int_this call_int_other return_mac ext_entry int_entry op_alloc_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. create_list create_operator create_statement create_symbol lookup semantic_translator$abort semantic_translator$error THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. pl1_nodes_template_$by_name_agg_template pl1_stat_$by_name_free_list pl1_stat_$by_name_parts_free_list pl1_stat_$by_name_parts_tree pl1_stat_$by_name_ref_list pl1_stat_$node_uses pl1_stat_$xeq_tree_area_ptr LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 26 000014 64 000025 65 000026 66 000033 67 000036 73 000042 80 000047 85 000055 86 000056 87 000060 91 000062 95 000063 104 000076 108 000103 112 000105 113 000107 114 000124 115 000131 116 000133 117 000135 118 000136 121 000137 127 000140 137 000141 139 000143 140 000155 141 000157 145 000160 150 000201 153 000241 156 000260 161 000277 163 000305 167 000307 168 000311 177 000312 185 000320 187 000337 188 000352 189 000355 192 000402 197 000406 202 000421 209 000422 216 000430 222 000432 226 000437 228 000443 230 000444 264 000445 277 000447 278 000452 279 000461 280 000465 281 000467 285 000470 287 000472 288 000474 289 000501 290 000505 291 000506 292 000507 293 000510 295 000511 296 000512 298 000513 493 000514 303 000515 308 000516 310 000521 312 000523 313 000527 314 000531 316 000532 318 000533 319 000537 320 000544 321 000551 322 000553 324 000554 330 000555 335 000556 337 000566 338 000570 339 000572 341 000574 343 000577 345 000607 348 000612 351 000614 352 000621 353 000622 356 000623 357 000627 358 000634 359 000641 360 000643 361 000644 363 000645 365 000647 368 000655 369 000657 370 000662 371 000663 372 000665 375 000666 377 000672 378 000676 379 000702 380 000710 381 000712 383 000713 391 000714 399 000716 403 000722 407 000724 408 000730 409 000736 410 000741 411 000742 415 000750 417 000760 419 000762 425 000763 426 000765 428 001001 429 001002 430 001004 433 001006 435 001007 442 001013 454 001015 455 001022 456 001025 457 001027 459 001030 460 001037 463 001042 464 001047 471 001052 476 001053 482 001055 483 001061 484 001063 485 001066 487 001067 489 001071 499 001072 505 001073 506 001100 508 001104 511 001114 512 001134 513 001137 514 001141 515 001143 517 001146 519 001152 520 001155 521 001165 522 001215 523 001232 524 001236 525 001240 526 001243 527 001245 528 001246 531 001250 538 001251 545 001253 548 001273 549 001276 550 001301 553 001317 560 001323 565 001325 566 001333 568 001334 576 001335 583 001336 584 001342 585 001346 586 001350 588 001351 589 001355 590 001360 592 001362 599 001363 607 001364 611 001370 612 001374 613 001376 614 001401 619 001402 621 001404 622 001406 624 001414 626 001416 628 001417 633 001420 638 001421 640 001432 641 001433 642 001435 644 001437 645 001444 646 001446 647 001451 648 001452 651 001453 653 001454 654 001455 655 001457 657 001461 ----------------------------------------------------------- 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