COMPILATION LISTING OF SEGMENT builtin Compiled by: Multics PL/I Compiler, Release 32c, of June 16, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 07/31/89 1412.9 mst Mon Options: optimize map 1 /****^ ****************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* ****************************************************** */ 9 10 11 /****^ HISTORY COMMENTS: 12* 1) change(87-04-15,RWaters), approve(87-04-15,MCR7639), audit(87-04-28,Huen), 13* install(87-05-21,MR12.1-1033): 14* Fixes bugs #1926,2145 15* 2) change(87-06-26,Huen), approve(87-06-26,MCR7712), audit(87-12-01,RWaters), 16* install(87-12-01,MR12.2-1005): 17* Fix bug2042 18* 3) change(88-01-29,RWaters), approve(88-01-29,MCR7724), audit(88-02-05,Huen), 19* install(88-02-16,MR12.2-1024): 20* Allow option(constant) variables as arguments to builtin functions. 21* 4) change(89-03-28,Huen), approve(89-03-28,MCR8077), audit(89-04-03,JRGray), 22* install(89-04-24,MR12.3-1032): 23* Fix bug 2193 - Display the existing error message (#127) when the first 24* argument to hbound builtin is not an array value. 25* 5) change(89-07-10,RWaters), approve(89-07-10,MCR8118), audit(89-07-19,Vu), 26* install(89-07-31,MR12.3-1066): 27* Fix reference thru null pointer in action (33). 28* END HISTORY COMMENTS */ 29 30 /* format: style2,^indattr,ifthendo,ifthen,^indnoniterdo,^elsestmt,dclind9 */ 31 builtin: 32 proc (cur_block, statement_ptr, input_tree, subscripts, builtin_symbol, context) returns (ptr); 33 34 /* Modified 770617 by PG to add clock, vclock, stacq 35* Modified 780213 by RAB to fix 1707 36* Modified 780329 by PCK to add stackframeptr, stackbaseptr, environmentptr, and codeptr builtins 37* Modified 780412 by PG to fix 1723, and to fix unreported bugs in decat and unspec 38* Modified 780807 by RAB to fix 1749 39* Modified 780824 by PCK to fix 1701, 1766, and 1777 40* Modified 780825 by RAB to fix 1780 41* Modified Dec 1978 by David Spector to make addr arg non-set xref 42* Modified 790416 by PCK to implement 4-bit decimal fix bugs 1826 and 1830 43* Modified 790516 by RAB for reference.substr 44* Modified 790606 by PG to add byte and rank 45* Modified 791107 by BSG for index (reverse) etc. 46* Modified: 26 Dec 1979 by PCK to implement by name assignment 47* Modified 820726 by BIM for segno, wordno 48* Modified 830909 by BIM never to have bif return unsigned. 49* assign_op gets CONFUSED. 50* Modified 870727 by RW to fix phx16821 & phx16584, invalid substr ranges. 51* Modified 870523 by SH to fix bug 2042 by displaying new error 390 if the 52* argument used in rank builtin is not a non_varying 53* character string of length 1. 54* Modified 880129 by RW to fix bug 1994 and bug 2186. 55* Modified 890302 by SH to display error 127 if the first argument to hbound 56* builtin is not an array value. (pl1_2193) 57* Modified 890714 by RW to check for null pointer in action(33) 58**/ 59 60 dcl (cur_block, builtin_symbol, statement_ptr, subscripts, input_tree, tree) ptr; 61 62 dcl ( 63 arg (128), 64 ref (128), 65 arg_symbol (128), 66 length, 67 offset, 68 p, 69 q, 70 r, 71 rlength, 72 s, 73 t, 74 off, 75 save_arg_one 76 ) ptr, 77 cur_length (2) ptr, 78 (agg_ref, dcl_length) ptr init (null), 79 (units, cunits) fixed bin (3), 80 error_number fixed bin (15), 81 constant fixed bin, 82 (arg_number, builtin_number, code, i, indicator, jump_index, m, reserved_number, rprecision, rscale, 83 temp_size) fixed bin (31), 84 (c_length, c_offset, coff, integer, number, substr_index, p1, p2, q1, q2, rcount) fixed bin (31), 85 integer_24 fixed bin (24), 86 based_type bit (36) based, 87 (desc_reqd, decimal_result, arith_size_ck, string_size_ck) bit (1) aligned init ("0"b), 88 pseudo_variable bit (1) aligned init ("0"b), 89 (full_attribute_set, not_flag) bit (1) aligned, 90 bit4 bit (4) aligned, 91 modified bit (1) aligned, 92 opcode bit (9) aligned, 93 constant_string_length fixed bin (21), 94 constant_char_string char (constant_string_length) based, 95 constant_bit_string bit (constant_string_length) based, 96 builtin_string char (8) aligned, 97 collating_sequence char (128) aligned internal static init (" 98  !""#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~"); 99 100 dcl pl1_data$long_collating_sequence char (512) aligned ext static; 101 102 dcl pl1_stat_$use_old_area bit (1) aligned ext static, 103 pl1_stat_$check_ansi bit (1) aligned ext static, 104 pl1_stat_$eis_mode bit (1) aligned ext static, 105 pl1_stat_$root ptr ext static, 106 pl1_stat_$cur_statement ptr ext static; 107 108 dcl (addr, bit, divide, fixed, max, min, null, reverse, string, substr, unspec) builtin; 109 110 /* 111*abs 13 112*acos 54 113*add 14 114*addr 33 115*addrel 41 116*after 55 117* 118*allocation 36 119*asin 54 120*atan 25 121*atand 25 122*atanh 25 123*baseno 39 124*segno 70 125* 126*baseptr 41 127*before 56 128*bin 15 129*binary 15 130*bit 18 131* 132*bool 23 133*byte 68 134*ceil 16 135*char 18 136*clock 62 137*codeptr 63 138*collate 1 139*collate9 59 140* 141*complex 17 142*conjg 50 143*convert 46 144*copy 9 145*cos 25 146* 147*cosd 25 148*cosh 25 149*cplx 17 150*currentsize 64 151*date 31 152*dec 15 153* 154*decat 24 155*decimal 18 156*dim 26 157*divide 14 158*dot 45 159* 160*empty 28 161*environmentptr 63 162*erf 25 163*erfc 25 164*exp 25 165*fixed 3 166* 167*float 2 168*floor 16 169*hbound 26 170*high 5 171*high9 60 172* 173*imag 19 174*index 6 175*lbound 26 176*length 7 177*lineno 30 178* 179*log 25 180*log10 25 181*log2 25 182*low 8 183*ltrim 57 184* 185*max 20 186*maxlength 65 187*min 20 188*mod 21 189*multiply 14 190*null 29 191* 192*nullo 44 193*onchar 51 194*oncode 53 195*onfield 42 196*onfile 42 197* 198*onkey 42 199*onloc 42 200*onsource 52 201*pageno 30 202*pointer 34 203* 204*prec 4 205*prod 43 206*ptr 34 207*rank 69 208*real 19 209*rel 39 210*wordno 71 211*charno 72 212*bitno 73 213*addwordno 41 214*addcharno 41 215*addbitno 41 216*setwordno 41 217*setcharno 41 218*setbitno 41 219* 220*reverse 27 221*round 22 222*rtrim 58 223*search 37 224*sign 38 225* 226*sin 25 227*sind 25 228*sinh 25 229*size 47 230*sqrt 25 231* 232*stac 40 233*stackbaseptr 61 234*stackframeptr 61 235*stacq 66 236*string 10 237*substr 11 238*substraddr 67 239*subtract 14 240*sum 43 241*tan 25 242* 243*tand 25 244*tanh 25 245*time 32 246*translate 49 247*trunc 16 248* 249*unspec 12 250*valid 48 251*vclock 62 252*verify 37 253**/ 254 255 dcl 1 rtype like type; 256 257 dcl 1 arg_type (128) like type; 258 259 dcl defined_arg_type (128) bit (36) defined (arg_type); 260 261 dcl 1 as_if_type (128) like type; 262 263 dcl defined_as_if_type (128) bit (36) defined (as_if_type); 264 265 dcl targ_type bit (36) aligned; 266 dcl targ_prec fixed bin (31); 267 268 dcl save_context bit (36), 269 1 def_save_context defined (save_context), 270 2 aggregate bit (1), 271 2 arg_list bit (1), 272 2 left_side bit (1), 273 2 return bit (1), 274 2 evaluate_offset bit (1), 275 2 top bit (1), 276 2 RHS_aggregate bit (1), 277 2 return_from_empty bit (1), 278 2 ignore_based bit (1), 279 2 ext_param bit (1), 280 2 cross_section bit (1), 281 2 string_unspec bit (1); 282 283 tree = input_tree; 284 285 if def_context.top then 286 if statement_ptr -> statement.statement_type = call_statement then 287 call semantic_translator$abort (224, builtin_symbol); 288 289 if subscripts = null then 290 arg_number = 0; 291 else 292 arg_number = subscripts -> list.number; 293 294 builtin_number = builtin_symbol -> symbol.c_dcl_size; 295 opcode = pl1_data$builtin_name.description (builtin_number).opcode; 296 jump_index = pl1_data$builtin_name.description (builtin_number).jump_index; 297 reserved_number = pl1_data$builtin_name.description (builtin_number).reserve_list_number; 298 299 if pl1_stat_$check_ansi then 300 if pl1_data$builtin_name.description (builtin_number).nonstandard then 301 call semantic_translator$error (202, builtin_symbol); 302 303 304 indicator = pl1_data$builtin_name.description (builtin_number).check_indicator; 305 306 if indicator = 1 then 307 if arg_number ^= pl1_data$builtin_name.description (builtin_number).number1 then 308 call semantic_translator$abort (121, builtin_symbol); 309 else 310 ; 311 else if indicator = 2 then 312 if arg_number < pl1_data$builtin_name.description (builtin_number).number1 then 313 call semantic_translator$abort (122, builtin_symbol); 314 else 315 ; 316 else if indicator = 3 then 317 if arg_number < pl1_data$builtin_name.description (builtin_number).number1 318 | arg_number > pl1_data$builtin_name.description (builtin_number).number2 then 319 call semantic_translator$abort (123, builtin_symbol); 320 321 if def_context.left_side then do; 322 builtin_string = builtin_symbol -> symbol.token -> token.string; 323 324 if builtin_string ^= "real" & builtin_string ^= "imag" & builtin_string ^= "string" 325 & builtin_string ^= "substr" & builtin_string ^= "unspec" & builtin_string ^= "onchar" 326 & builtin_string ^= "onsource" & builtin_string ^= "pageno" then 327 call semantic_translator$abort (244, builtin_symbol); 328 else 329 pseudo_variable = "1"b; 330 end; 331 332 save_context = "0"b; 333 334 do i = 1 to arg_number; 335 336 this_context = "0"b; 337 if i = 1 & (jump_index = 10 | jump_index = 12 | jump_index = 33) /* string, unspec, addr */ then do; 338 def_this_context.evaluate_offset = "1"b; 339 340 if jump_index ^= 33 then 341 def_this_context.string_unspec = "1"b; 342 end; 343 344 if (jump_index = 46 & i = 1) /* convert */ | jump_index = 47 /* size */ then 345 def_this_context.ignore_based = "1"b; 346 347 if i = 1 348 & (def_context.f_offset_to_be_added | jump_index = 11 /* substr */ 349 | (jump_index >= 55 & jump_index <= 58)) /* after, before, ltrim, rtrim */ then 350 def_this_context.f_offset_to_be_added = "1"b; 351 352 arg (i) = 353 expression_semantics (cur_block, statement_ptr, (subscripts -> element (arg_number + 1 - i)), 354 this_context); 355 356 if def_this_context.aggregate then do; 357 if pl1_data$builtin_name.description (builtin_number).descriptor (i).check_code = 5 then 358 if jump_index ^= 11 /* substr */ then 359 goto err124; 360 361 if pl1_data$builtin_name.description (builtin_number).aggregate_result then 362 if ^def_context.by_name_assignment then do; 363 subscripts -> element (arg_number + 1 - i), arg (i) = 364 expand_primitive (cur_block, statement_ptr, arg (i), this_context); 365 end; 366 else 367 go to err381; 368 end; 369 370 save_context = save_context | this_context; 371 372 ref (i) = arg (i); 373 374 do while (ref (i) -> node.type = operator_node); 375 ref (i) = ref (i) -> operand (1); 376 end; 377 378 if ref (i) -> node.type = token_node then do; 379 ref (i), arg_symbol (i) = null; 380 if arg (i) -> token.type = dec_integer then 381 defined_arg_type (i) = dec_integer_type; 382 else 383 defined_arg_type (i) = decoded_type (fixed (arg (i) -> token.type, 15)); 384 end; 385 else if ref (i) -> node.type = label_node then do; 386 arg_symbol (i) = ref (i); 387 ref (i) = null; 388 defined_arg_type (i) = "0"b; 389 end; 390 else if ref (i) -> node.type = reference_node then do; 391 arg_symbol (i) = ref (i) -> reference.symbol; 392 defined_arg_type (i) = 393 substr (string (arg_symbol (i) -> symbol.attributes), 1, 36) & ^dimensioned_mask 394 & ^initialed_mask; 395 end; 396 end; 397 398 this_context = "0"b; 399 400 /* Processing of aggregate arguments */ 401 402 if def_save_context.aggregate then 403 if pl1_data$builtin_name.description (builtin_number).aggregate_result then do; 404 if jump_index = 24 /* decat */ then 405 call semantic_translator$abort (478, builtin_symbol); 406 407 if def_context.left_side then 408 call propagate_bit (arg_symbol (1), set_bit); 409 410 def_context.aggregate = "1"b; 411 tree = expand_arguments (); 412 413 goto exit; 414 end; 415 416 do i = 1 to min (arg_number, pl1_data$builtin_name.description (builtin_number).number_of_descriptions); 417 418 code = pl1_data$builtin_name.description (builtin_number).descriptor (i).check_code; 419 string (type) = pl1_data$builtin_name.description (builtin_number).descriptor (i).type; 420 421 if code = 0 then 422 goto next_descriptor; 423 424 if code = 1 then 425 if string (type) & defined_arg_type (i) then 426 goto conv_arg; 427 else 428 goto err124; 429 430 if code = 2 then 431 goto conv_arg; 432 433 if code = 3 | code = 11 then do; 434 if code = 11 then 435 if arg_type (i).complex then 436 goto err124; 437 438 if arg_type (i).picture | arg_type (i).decimal | arg_type (i).char then do; 439 if arg_type (i).decimal then 440 string (type) = defined_arg_type (i) & ^fixed_mask | float_mask; 441 else if arg_type (i).complex then 442 string (type) = float_decimal_complex_mask; 443 else 444 string (type) = float_decimal_real_mask; 445 t = convert$from_builtin ((arg (i)), string (type)); 446 /* call by value to protect arg(i) */ 447 if t -> node.type = operator_node then 448 t = t -> operand (1) -> reference.symbol; 449 else 450 t = t -> reference.symbol; 451 targ_type = string (type); 452 if decimal_result then 453 targ_prec = max (targ_prec, t -> symbol.c_dcl_size); 454 else if i = 1 then do; 455 decimal_result = "1"b; 456 targ_prec = t -> symbol.c_dcl_size; 457 end; 458 end; 459 string (type) = float_mask | binary_mask; 460 goto conv_arg; 461 end; 462 463 if code = 4 then do; 464 if arg_type (i).bit then 465 string (type) = fixed_binary_real_mask; 466 else if arg_type (i).char then 467 string (type) = fixed_decimal_real_mask; 468 else if arg_type (i).picture then 469 if arg_symbol (i) -> symbol.complex then 470 if arg_symbol (i) -> symbol.pix.pic_float then 471 string (type) = float_decimal_complex_mask; 472 else 473 string (type) = fixed_decimal_complex_mask; 474 else if arg_symbol (i) -> symbol.pix.pic_float then 475 string (type) = float_decimal_real_mask; 476 else 477 string (type) = fixed_decimal_real_mask; 478 else if defined_arg_type (i) & arithmetic_mask then 479 string (type) = defined_arg_type (i); 480 else 481 goto err124; 482 483 goto conv_arg; 484 end; 485 486 if code = 5 then do; 487 string (type) = fixed_binary_real_mask; 488 489 if arg_type (i).fixed | arg_type (i).float then do; 490 ref (i), arg (i) = convert$to_integer (arg (i), integer_type); 491 492 if ref (i) -> node.type = operator_node then do; 493 ref (i) -> operator.processed = "1"b; 494 ref (i) = ref (i) -> operand (1); 495 end; 496 497 arg_symbol (i) = ref (i) -> reference.symbol; 498 defined_arg_type (i) = integer_type; 499 500 goto next_descriptor; 501 end; 502 503 goto conv_arg; 504 end; 505 506 if code = 6 then do; 507 if arg (i) -> node.type = reference_node then 508 if symbol_is_constant (arg_symbol (i)) then 509 if ^arg_type (i).fixed | ^arg_type (i).binary | ^arg_type (i).real then 510 arg (i) = subscripts -> element (arg_number + 1 - i); 511 else 512 goto next_descriptor; 513 else 514 goto err124; 515 516 if arg (i) -> node.type ^= token_node then 517 goto err124; 518 519 520 if arg (i) -> token.type ^= dec_integer then 521 goto err124; 522 523 string (type) = fixed_binary_real_mask; 524 525 goto conv_arg; 526 end; 527 528 if code = 7 then do; 529 if arg_type (i).bit | arg_type (i).char then 530 string (type) = defined_arg_type (i); 531 else if arg_type (i).binary | arg_type (i).picture | arg_type (i).decimal then 532 string (type) = char_mask; 533 else 534 goto err124; 535 536 goto conv_arg; 537 end; 538 539 if code = 8 then do; 540 if arg_type (i).bit then 541 string (type) = bit_mask; 542 else if arg_type (i).fixed | arg_type (i).float then do; 543 ref (i), arg (i) = convert$to_integer (arg (i), integer_type); 544 545 if ref (i) -> node.type = operator_node then do; 546 ref (i) -> operator.processed = "1"b; 547 ref (i) = ref (i) -> operand (1); 548 end; 549 550 arg_symbol (i) = ref (i) -> reference.symbol; 551 defined_arg_type (i) = integer_type; 552 553 go to next_descriptor; 554 end; 555 else 556 string (type) = fixed_binary_real_mask; 557 558 go to conv_arg; 559 560 end; 561 562 if code = 9 then 563 if ref (i) = null then 564 goto err124; 565 else 566 goto next_descriptor; 567 568 if code = 10 then do; 569 if (defined_arg_type (i) & computational_mask) = "0"b then 570 goto err124; 571 572 goto next_descriptor; 573 end; 574 575 if code = 12 then do; 576 if ^arg_type (i).label & ^arg_type (i).entry & ^arg_type (i).format 577 & arg (i) -> node.type ^= label_node then 578 go to err124; 579 go to next_descriptor; 580 end; 581 582 conv_arg: 583 call convert_arg; 584 585 next_descriptor: 586 end; 587 588 string (rtype) = defined_arg_type (1) & ^unaligned_mask | aligned_mask; 589 590 rprecision, rscale = 0; 591 rlength = null; 592 593 do i = 1 to arg_number; 594 if ref (i) ^= null then 595 if ref (i) -> reference.varying_ref then do; 596 if i = 1 then 597 if jump_index = 9 /* copy */ | jump_index = 24 /* decat */ | jump_index = 27 /* reverse */ 598 | jump_index = 49 /* translate */ then do; 599 rlength = create_length_fun (arg (1)); 600 string (rtype) = string (rtype) & ^varying_mask; 601 end; 602 end; 603 end; 604 605 if arg_number ^= 0 & arg_symbol (1) ^= null then 606 if arg_symbol (1) -> node.type = symbol_node then do; 607 rprecision = arg_symbol (1) -> symbol.c_dcl_size; 608 if arg_type (1).bit | arg_type (1).char then 609 if rlength = null then 610 rprecision = ref (1) -> reference.c_length; 611 else 612 rprecision = 0; 613 614 rscale = fixed (arg_symbol (1) -> symbol.scale, 31, 0); 615 616 if ref (1) ^= null & rlength = null then 617 if jump_index = 9 /* copy */ | jump_index = 24 /* decat */ | jump_index = 27 /* reverse */ 618 | jump_index = 49 /* translate */ then do; 619 rlength = share_expression ((ref (1) -> reference.length)); 620 string (rtype) = string (rtype) & ^varying_mask; 621 end; 622 623 end; 624 625 goto action (jump_index); 626 627 action (0): 628 call semantic_translator$abort (131, builtin_symbol); 629 goto ret; 630 631 action (1): /* collate */ 632 tree = declare_constant$char (collating_sequence); 633 634 goto ret; 635 636 action (2): /* float */ 637 string (rtype) = float_mask; 638 639 if arg_number = 2 then 640 rprecision = constant_value (arg_symbol (2)); 641 else do; 642 rprecision = 0; 643 if pl1_stat_$check_ansi then 644 call semantic_translator$error (172, builtin_symbol); 645 end; 646 647 goto convert_to_arith; 648 649 action (3): /* fixed */ 650 /* Warn users away from fixed(...) */ 651 if arg (1) -> node.type = token_node then 652 if arg (1) -> token.type = dec_integer then 653 call semantic_translator$error (484, null); 654 655 string (rtype) = fixed_mask; 656 657 if arg_number = 3 then 658 rscale = constant_value (arg_symbol (3)); 659 else 660 rscale = 0; 661 662 if arg_number >= 2 then 663 rprecision = constant_value (arg_symbol (2)); 664 else do; 665 rprecision = 0; 666 if pl1_stat_$check_ansi then 667 call semantic_translator$error (172, builtin_symbol); 668 end; 669 670 goto convert_to_arith; 671 672 action (4): /* prec 673* precision */ 674 if arg_type (1).char then 675 string (rtype) = fixed_decimal_real_mask | aligned_mask; 676 else if arg_type (1).bit then 677 string (rtype) = fixed_binary_real_mask | aligned_mask; 678 679 if arg_type (1).float & arg_number = 3 then 680 call semantic_translator$abort (167, builtin_symbol); 681 682 if arg_number = 3 then 683 rscale = constant_value (arg_symbol (3)); 684 685 rprecision = constant_value (arg_symbol (2)); 686 687 full_attribute_set = "1"b; 688 689 goto check_prec_scale; 690 691 action (5): /* high */ 692 arg (2) = arg (1); 693 ref (2) = ref (1); 694 arg_symbol (2) = arg_symbol (1); 695 696 arg (1), ref (1) = declare_constant ("001111111"b, char_type, 1, 0); 697 arg_symbol (1) = arg (1) -> reference.symbol; 698 699 arg_number = 2; 700 string (rtype) = char_type; 701 702 goto repeat; 703 704 action (6): /* index */ 705 if arg_type (1).bit & arg_type (2).bit then 706 string (type) = bit_mask; 707 else 708 string (type) = char_mask; 709 710 do i = 1 to 2; 711 call convert_arg; 712 end; 713 714 if type.char then 715 if check_reverse (arg (1)) then do; 716 opcode = index_rev_fun; /* Will use reverse index */ 717 arg (1) = arg (1) -> operator.operand (2); 718 /* Use the unreversed thing */ 719 if check_reverse (arg (2)) /* If 2 is a reverse too, .. */ then 720 arg (2) = arg (2) -> operator.operand (2); 721 /* Eliminate it.. or */ 722 else 723 arg (2) = make_builtin_reference ("reverse", 1, arg (2), null, null); 724 end; 725 726 string (rtype) = fixed_binary_real_mask; 727 rprecision = max_length_precision; 728 729 goto create_operator_node; 730 731 action (7): /* length */ 732 action (65): /* maxlength */ 733 if arg (1) -> node.type = operator_node then 734 if arg (1) -> op_code = std_call then do; 735 s = create_statement (call_statement, (statement_ptr -> statement.back), null, 736 (statement_ptr -> statement.prefix)); 737 s -> statement.root = share_expression (arg (1)); 738 end; 739 740 if ref (1) -> reference.varying_ref then do; 741 if jump_index = 7 then do; 742 743 /* length */ 744 745 string (rtype) = integer_type; 746 rprecision = max_length_precision; 747 goto create_operator_node; 748 end; 749 750 else do; 751 752 /* maxlength */ 753 754 if arg_symbol (1) -> symbol.dcl_size = null then 755 tree = declare_constant$integer ((arg_symbol (1) -> symbol.c_dcl_size)); 756 else do; 757 tree = copy_expression (arg_symbol (1) -> symbol.dcl_size); 758 if arg_symbol (1) -> symbol.refer_extents then 759 call refer_extent (tree, (ref (1) -> reference.qualifier)); 760 tree = expression_semantics ((arg_symbol (1) -> symbol.block_node), statement_ptr, tree, "0"b); 761 tree = convert$to_integer (tree, integer_type); 762 end; 763 764 goto ret; 765 end; 766 end; 767 768 if ref (1) -> reference.length = null then 769 tree = declare_constant$integer ((ref (1) -> reference.c_length)); 770 else 771 tree = ref (1) -> reference.length; 772 773 goto ret; 774 775 action (8): /* low */ 776 arg (2) = arg (1); 777 ref (2) = ref (1); 778 arg_symbol (2) = arg_symbol (1); 779 780 arg (1), ref (1) = declare_constant ("000000000"b, char_type, 1, 0); 781 arg_symbol (1) = arg (1) -> reference.symbol; 782 783 arg_number = 2; 784 string (rtype) = char_type; 785 786 goto repeat; 787 788 action (9): /* copy */ 789 repeat: 790 if symbol_is_constant (arg_symbol (2)) then 791 m = constant_value (arg_symbol (2)); 792 793 if ref (1) -> reference.varying_ref then 794 length = rlength; 795 else if ref (1) -> reference.length ^= null then 796 length = ref (1) -> reference.length; 797 else if ^symbol_is_constant (arg_symbol (2)) then 798 length = declare_constant$integer ((ref (1) -> reference.c_length)); 799 else 800 length = null; 801 802 if length ^= null then do; 803 rprecision = 0; 804 arg (2) = share_expression (arg (2)); 805 if ref (1) -> reference.c_length = 1 then 806 rlength = arg (2); 807 else do; 808 rlength = create_operator (mult, 3); 809 rlength -> operand (1) = declare_temporary (integer_type, max_length_precision, 0, null); 810 rlength -> operand (2) = length; 811 rlength -> operand (3) = arg (2); 812 rlength -> operator.processed = "1"b; 813 end; 814 end; 815 else do; 816 rprecision = ref (1) -> reference.c_length * max (m, 0); 817 if jump_index ^= 9 /* we have told users we will NOT optimize this for copy */ then 818 if m = 1 then 819 goto return_arg1; 820 end; 821 822 goto create_operator_node; 823 824 action (10): /* string */ 825 if arg (1) -> node.type = token_node then do; 826 i = 1; 827 if arg_type (1).bit then 828 string (type) = defined_arg_type (1); 829 else 830 string (type) = char_mask; 831 832 call convert_arg; 833 834 if def_context.left_side then 835 call semantic_translator$abort (141, builtin_symbol); 836 837 goto return_arg1; 838 end; 839 840 if arg (1) -> node.type = reference_node & arg (1) = arg_symbol (1) -> symbol.reference then 841 arg (1), ref (1) = copy_expression ((ref (1))); 842 843 string (rtype) = defined_arg_type (1); 844 845 if def_context.left_side then 846 call propagate_bit (arg_symbol (1), set_bit); 847 848 if arg (1) -> node.type = operator_node then do; 849 if arg (1) -> operator.op_code = loop | arg (1) -> operator.op_code = join | arg_type (1).structure 850 | ref (1) -> reference.array_ref then 851 call semantic_translator$abort (294, builtin_symbol); 852 853 i = 1; 854 if arg_type (1).bit then 855 string (type) = defined_arg_type (1); 856 else 857 string (type) = char_mask; 858 859 call convert_arg; 860 861 if def_context.left_side then 862 call semantic_translator$abort (141, builtin_symbol); 863 864 goto return_arg1; 865 end; 866 867 if arg_type (1).structure then do; 868 p = arg_symbol (1); 869 do while (p -> symbol.structure); 870 p = p -> symbol.son; 871 end; 872 873 if p -> symbol.bit then 874 units = bit_; 875 else if p -> symbol.char | p -> symbol.picture then 876 units = character_; 877 else 878 goto err124; 879 880 call check_strings ((arg_symbol (1) -> symbol.son)); 881 882 goto aggregate; 883 end; 884 885 if arg_type (1).bit | arg_type (1).char | arg_type (1).picture then do; 886 if ^ref (1) -> reference.array_ref then do; 887 if ^arg_type (1).picture then 888 goto return_arg1; 889 else do; 890 units = character_; 891 c_length = ref (1) -> reference.c_length; 892 length = null; 893 goto make_reference; 894 end; 895 end; 896 897 if arg_type (1).bit then 898 units = bit_; 899 else 900 units = character_; 901 902 if arg_symbol (1) -> symbol.packed then 903 goto aggregate; 904 905 if def_context.left_side then 906 call semantic_translator$abort (141, builtin_symbol); 907 else 908 call semantic_translator$abort (142, builtin_symbol); 909 goto ret; 910 end; 911 else do; 912 if arg (1) -> reference.array_ref then 913 call semantic_translator$abort (139, arg_symbol (1)); 914 915 i = 1; 916 string (type) = char_mask; 917 call convert_arg; 918 919 goto return_arg1; 920 end; 921 922 action (11): /* substr */ 923 if rtype.bit then 924 units = bit_; 925 else 926 units = character_; 927 928 if arg (1) -> node.type = operator_node then do; 929 if def_context.left_side then 930 call semantic_translator$abort (148, builtin_symbol); 931 932 ref (1) = arg (1) -> operand (1); 933 end; 934 else if def_context.left_side then do; 935 call propagate_bit (arg_symbol (1), set_bit); 936 arg_symbol (1) -> symbol.passed_as_arg = "1"b; 937 end; 938 939 /* If user didn't specify 3rd argument (new length), or stringrange is enabled, save info 940* about length of first argument now. */ 941 942 if arg_number = 2 | substr (statement_ptr -> statement.prefix, 8, 1) /* stringrange */ then do; 943 if ref (1) -> reference.varying_ref then do; 944 length = create_length_fun (arg (1)); 945 c_length = 0; 946 end; 947 else do; 948 length = ref (1) -> reference.length; 949 c_length = ref (1) -> reference.c_length; 950 if length ^= null then 951 if arg (1) -> node.type = operator_node | ref (1) -> reference.ref_count > 1 then 952 length = share_expression (length); 953 end; 954 955 if arg_number = 2 & substr (statement_ptr -> statement.prefix, 8, 1) then 956 if length ^= null then 957 length = share_expression (length); 958 end; 959 960 /* Compute (offset - 1) and save it in "offset". */ 961 962 if symbol_is_constant (arg_symbol (2)) then do; 963 offset = null; 964 c_offset = constant_value (arg_symbol (2)) - 1; 965 end; 966 else do; 967 c_offset = 0; 968 969 if arg (2) -> node.type = operator_node then 970 if arg (2) -> operator.op_code = add then 971 if arg (2) -> operand (3) -> node.type = reference_node then 972 if symbol_is_constant ((arg (2) -> operand (3) -> reference.symbol)) then 973 if constant_value ((arg (2) -> operand (3) -> reference.symbol)) = 1 then 974 if fb1_value ((arg (2) -> operand (3) -> reference.symbol)) then do; 975 r = arg (2) -> operand (2); 976 if r -> node.type = operator_node then 977 r = r -> operand (1); 978 979 if fb1_value ((r -> reference.symbol)) then do; 980 offset = arg (2) -> operand (2); 981 go to chk_context; 982 end; 983 end; 984 985 offset = create_operator (sub, 3); 986 offset -> operand (2) = arg (2); 987 offset -> operand (3) = declare_constant$integer (1); 988 end; 989 990 chk_context: 991 if def_context.arg_list then do; 992 tree, p = create_operator (assign, 2); 993 r = create_symbol (null, null, by_compiler); 994 r -> symbol.temporary = "1"b; 995 p -> operand (1) = r -> symbol.reference; 996 p -> operand (2) = arg (1); 997 end; 998 999 if arg (1) -> node.type = operator_node | arg_symbol (1) -> symbol.picture then do; 1000 s = create_symbol (null, null, by_compiler); 1001 p = s -> symbol.reference; 1002 t = ref (1) -> reference.symbol; 1003 s -> symbol = t -> symbol; /* structure assignment */ 1004 s -> symbol.next = null; 1005 s -> symbol.reference = p; 1006 s -> symbol.defined, s -> symbol.overlayed, s -> symbol.position = "1"b; 1007 s -> symbol.return_value, s -> symbol.temporary = "0"b; 1008 p -> reference.qualifier = arg (1); 1009 p -> reference.shared = "0"b; 1010 p -> reference.ref_count = 1; 1011 1012 if s -> symbol.picture then do; 1013 s -> symbol.picture = "0"b; 1014 s -> symbol.char = "1"b; 1015 s -> symbol.general = null; 1016 end; 1017 1018 if arg (1) -> node.type ^= operator_node then do; 1019 1020 /* move the offset from the defined variable up */ 1021 1022 if ref (1) = arg_symbol (1) -> symbol.reference then 1023 p -> reference.qualifier, ref (1) = copy_expression ((ref (1))); 1024 else if ref (1) -> reference.ref_count > 1 then do; 1025 ref (1) -> reference.ref_count = ref (1) -> reference.ref_count - 1; 1026 r = create_reference (null); 1027 r -> reference = ref (1) -> reference; 1028 r -> reference.ref_count = 1; 1029 call reuse_qual_and_offset (r); 1030 p -> reference.qualifier, ref (1) = r; 1031 end; 1032 p -> reference.offset = ref (1) -> reference.offset; 1033 p -> reference.c_offset = ref (1) -> reference.c_offset; 1034 p -> reference.units = ref (1) -> reference.units; 1035 p -> reference.modword_in_offset = ref (1) -> reference.modword_in_offset; 1036 ref (1) -> reference.offset = null; 1037 ref (1) -> reference.c_offset = 0; 1038 ref (1) -> reference.modword_in_offset = "0"b; 1039 1040 /* this must not be commoned by optimizer */ 1041 1042 ref (1) -> reference.inhibit = "1"b; 1043 end; 1044 end; 1045 else do; 1046 p = create_reference ((ref (1) -> reference.symbol)); 1047 p -> reference = ref (1) -> reference; /* structure assignment */ 1048 p -> reference.shared = "0"b; 1049 p -> reference.ref_count = 1; 1050 if ^ref (1) -> reference.shared then do; 1051 rcount, ref (1) -> reference.ref_count = ref (1) -> reference.ref_count - 1; 1052 if rcount > 0 then 1053 call reuse_qual_and_offset (p); /* we may have substr(varying,) */ 1054 end; 1055 end; 1056 1057 /* Begin filling in the new reference node expressing the 1058* result of substr. Save the original argument because 1059* we still need some of the info in it. */ 1060 1061 save_arg_one = arg (1); 1062 arg (1) = p; 1063 1064 arg (1) -> reference.varying_ref, arg (1) -> reference.padded_ref, arg (1) -> reference.aligned_ref = "0"b; 1065 1066 off = arg (1) -> reference.offset; 1067 coff = arg (1) -> reference.c_offset; 1068 cunits = arg (1) -> reference.units; 1069 call offset_adder (off, coff, cunits, (arg (1) -> reference.modword_in_offset), (offset), (c_offset), units, 1070 "0"b, arg (1) -> reference.fo_in_qual); 1071 arg (1) -> reference.offset = off; 1072 arg (1) -> reference.c_offset = coff; 1073 arg (1) -> reference.units = cunits; 1074 arg (1) -> reference.modword_in_offset = "0"b; 1075 1076 if ^pl1_stat_$eis_mode then 1077 if arg (1) -> reference.offset ^= null then 1078 if arg (1) -> reference.units <= half_ then do; 1079 if arg (1) -> reference.units = bit_ then 1080 opcode = mod_bit; 1081 else if arg (1) -> reference.units = character_ then 1082 opcode = mod_byte; 1083 else 1084 opcode = mod_half; 1085 1086 p = create_operator (opcode, 3); 1087 p -> operand (1), p -> operand (2) = 1088 declare_temporary (integer_type, default_fix_bin_p, 0, null); 1089 p -> operand (3) = arg (1) -> reference.offset; 1090 1091 arg (1) -> reference.offset = p; 1092 end; 1093 1094 /* Fill in length of result. */ 1095 1096 if arg_number = 2 then 1097 if length = null & offset = null then 1098 arg (1) -> reference.c_length = c_length - c_offset; 1099 else do; 1100 p = create_operator (sub, 3); 1101 p -> operand (1) = declare_temporary (fixed_binary_real_mask, default_fix_bin_p, 0, null); 1102 p -> operand (2) = length; 1103 p -> operand (3) = offset; 1104 1105 arg (1) -> reference.length = p; 1106 arg (1) -> reference.c_length = 0; 1107 1108 if length = null then 1109 p -> operand (2) = declare_constant$integer (c_length); 1110 1111 if offset = null then 1112 p -> operand (3) = declare_constant$integer (c_offset); 1113 else do; 1114 if offset -> node.type = operator_node then 1115 offset = expression_semantics (cur_block, statement_ptr, offset, "0"b); 1116 1117 offset = share_expression (offset); 1118 end; 1119 end; 1120 else if symbol_is_constant (arg_symbol (3)) then do; 1121 arg (1) -> reference.c_length = constant_value (arg_symbol (3)); 1122 arg (1) -> reference.length = null; 1123 end; 1124 else do; 1125 arg (1) -> reference.c_length = 0; 1126 arg (1) -> reference.length = arg (3); 1127 end; 1128 1129 if substr (statement_ptr -> statement.prefix, 8, 1) /* stringrange */ then 1130 if symbol_is_constant (arg_symbol (2)) /* if 2nd arg (offset) is a constant */ 1131 & arg (1) -> reference.length = null /* and new length is constant */ 1132 & length = null /* and old length is constant */ then do; 1133 /* then make checks now */ 1134 substr_index = constant_value (arg_symbol (2)); 1135 1136 if substr_index < 1 then 1137 call semantic_translator$error (147, builtin_symbol); 1138 1139 /* if there is a problem here, diagnose it later */ 1140 if arg (1) -> reference.c_length < 0 then 1141 c_length = substr_index - 1; 1142 1143 if c_length < (substr_index + arg (1) -> reference.c_length - 1) then 1144 call semantic_translator$error (147, builtin_symbol); 1145 end; 1146 else do; 1147 if arg (1) -> reference.length = null then do; 1148 arg (1) -> reference.length = declare_constant$integer ((arg (1) -> reference.c_length)); 1149 arg (1) -> reference.c_length = 0; 1150 end; 1151 1152 /* Generate operator to check that: 1153* 0 <= new_length <= (orig_length - offset + 1) */ 1154 1155 p = create_operator (range_ck, 4); 1156 p -> operand (1) = declare_temporary (integer_type, default_fix_bin_p, 0, null); 1157 p -> operand (2) = arg (1) -> reference.length; 1158 p -> operand (3) = declare_constant$integer (0); 1159 1160 p -> operand (4) = create_operator (sub, 3); 1161 p -> operand (4) -> operand (1) = declare_temporary (integer_type, default_fix_bin_p, 0, null); 1162 1163 /* Fill in length of original argument */ 1164 1165 if length = null then 1166 p -> operand (4) -> operand (2) = declare_constant$integer (c_length); 1167 else 1168 p -> operand (4) -> operand (2) = length; 1169 1170 if offset = null then 1171 p -> operand (4) -> operand (3) = declare_constant$integer (c_offset); 1172 else 1173 p -> operand (4) -> operand (3) = copy_expression ((offset)); 1174 1175 if offset = null & length = null then 1176 if c_offset < 0 | c_offset > c_length then 1177 call semantic_translator$abort (147, builtin_symbol); 1178 else 1179 ; 1180 else do; 1181 r = create_operator (range_ck, 4); 1182 r -> operand (1) = declare_temporary (integer_type, default_fix_bin_p, 0, null); 1183 r -> operand (2) = p -> operand (4) -> operand (3); 1184 r -> operand (3) = declare_constant$integer (0); 1185 r -> operand (4) = copy_expression ((p -> operand (4) -> operand (2))); 1186 1187 p -> operand (4) -> operand (3) = r; 1188 end; 1189 1190 arg (1) -> reference.length = p; 1191 end; 1192 1193 /* fix to avoid problems later in convert 1194* if a constant substr length is < 0 */ 1195 if arg (1) -> reference.c_length < 0 then do; 1196 call semantic_translator$error (147, builtin_symbol); 1197 arg (1) -> reference.c_length = 0; 1198 end; 1199 1200 arg (1) -> reference.length = 1201 expression_semantics (cur_block, statement_ptr, (arg (1) -> reference.length), "0"b); 1202 if arg (1) -> reference.length ^= null then 1203 arg (1) -> reference.length = convert$to_integer ((arg (1) -> reference.length), integer_type); 1204 1205 arg (1) -> reference.offset = 1206 expression_semantics (cur_block, statement_ptr, (arg (1) -> reference.offset), "0"b); 1207 if arg (1) -> reference.offset ^= null then 1208 arg (1) -> reference.offset = convert$to_integer ((arg (1) -> reference.offset), integer_type); 1209 1210 arg (1) -> reference.substr = "1"b; 1211 1212 call simplify_offset (arg (1), context); 1213 1214 if def_context.arg_list then do; 1215 tree -> operand (2) = arg (1); 1216 tree = operator_semantics (cur_block, statement_ptr, tree, this_context); 1217 goto ret; 1218 end; 1219 1220 goto return_arg1; 1221 1222 action (12): /* unspec */ 1223 if arg (1) -> node.type = token_node then do; 1224 call semantic_translator$error (485, null); 1225 i = 1; 1226 string (type) = defined_arg_type (1); 1227 call convert_arg; 1228 end; 1229 1230 if arg (1) -> node.type = reference_node & arg (1) = arg_symbol (1) -> symbol.reference then 1231 arg (1), ref (1) = copy_expression ((ref (1))); 1232 1233 string (rtype) = bit_mask; 1234 units = bit_; 1235 1236 if def_context.left_side then 1237 if arg (1) -> node.type = operator_node then 1238 call semantic_translator$abort (148, builtin_symbol); 1239 else do; 1240 call propagate_bit (arg_symbol (1), set_bit); 1241 arg_symbol (1) -> symbol.passed_as_arg = "1"b; 1242 end; 1243 1244 if arg_type (1).structure | ref (1) -> reference.array_ref then do; 1245 if pl1_stat_$check_ansi then 1246 call semantic_translator$error (172, builtin_symbol); 1247 goto aggregate; 1248 end; 1249 1250 if ref (1) -> reference.varying_ref then do; 1251 length = create_length_fun (arg (1)); 1252 c_length = 0; 1253 end; 1254 else do; 1255 length = ref (1) -> reference.length; 1256 c_length = ref (1) -> reference.c_length; 1257 end; 1258 1259 if arg_symbol (1) -> symbol.bit then 1260 goto make_reference; 1261 1262 if arg_symbol (1) -> symbol.char | arg_symbol (1) -> symbol.picture then do; 1263 if length ^= null then do; 1264 p = create_operator (mult, 3); 1265 p -> operand (2) = length; 1266 p -> operand (3) = declare_constant$integer (bits_per_character); 1267 length = p; 1268 end; 1269 else 1270 c_length = c_length * bits_per_character; 1271 1272 goto make_reference; 1273 end; 1274 1275 aggregate: 1276 if arg (1) -> node.type = operator_node then 1277 call semantic_translator$abort (294, builtin_symbol); 1278 1279 if arg_symbol (1) -> symbol.array ^= null & ^ref (1) -> reference.array_ref then do; 1280 c_length = arg_symbol (1) -> symbol.array -> array.c_element_size_bits; 1281 length = copy_expression (arg_symbol (1) -> symbol.array -> array.element_size_bits); 1282 end; 1283 else do; 1284 c_length = arg_symbol (1) -> symbol.c_bit_size; 1285 length = copy_expression (arg_symbol (1) -> symbol.bit_size); 1286 1287 if ref (1) -> reference.offset ^= null then 1288 if ref (1) -> reference.offset -> node.type = list_node then 1289 call semantic_translator$abort (338, ref (1)); 1290 end; 1291 1292 if units = character_ then 1293 if length ^= null then do; 1294 p = create_operator (bit_to_char, 2); 1295 p -> operand (2) = length; 1296 1297 length = p; 1298 end; 1299 else 1300 c_length = divide (c_length, bits_per_character, 15, 0); 1301 1302 1303 if arg_symbol (1) -> symbol.defined then 1304 if arg_symbol (1) -> symbol.structure | ref (1) -> reference.array_ref then 1305 arg (1) = defined_reference (cur_block, statement_ptr, arg (1), null, arg_symbol (1), "0"b); 1306 1307 make_reference: 1308 if arg (1) -> node.type = operator_node then do; 1309 call make_assignment; 1310 1311 if agg_ref = null then 1312 arg (1) = p -> operand (1); 1313 else do; 1314 arg (1) = agg_ref; 1315 defined_arg_type (1) = string (agg_ref -> reference.symbol -> symbol.attributes); 1316 c_length = agg_ref -> reference.symbol -> symbol.c_bit_size; 1317 length = copy_expression (agg_ref -> reference.symbol -> symbol.bit_size); 1318 end; 1319 1320 if arg_type (1).bit | jump_index = 12 then 1321 units = bit_; 1322 else 1323 units = character_; 1324 end; 1325 1326 if def_context.arg_list then do; 1327 tree, p = create_operator (assign, 2); 1328 r = create_symbol (null, null, by_compiler); 1329 r -> symbol.temporary = "1"b; 1330 p -> operand (1) = r -> symbol.reference; 1331 p -> operand (2) = arg (1); 1332 end; 1333 1334 if units = character_ then 1335 string (rtype) = char_mask; 1336 else 1337 string (rtype) = bit_mask; 1338 1339 rtype.unaligned = arg_symbol (1) -> symbol.packed; 1340 1341 if ^arg_symbol (1) -> symbol.overlayed_by_builtin then 1342 call propagate_bit (arg_symbol (1), overlayed_by_builtin_bit); 1343 1344 p = declare_defined_overlay (string (rtype), c_length, 0, length, arg (1)); 1345 1346 /* we omit setting ref(1)->reference.c_length=0 because ref(1) might be a constant and, 1347* therefore, still a symbol.reference since copy_expression works differently here */ 1348 ref (1) -> reference.length = null; 1349 1350 p -> reference.padded_ref = "0"b; 1351 1352 1353 /* move the offsets from the defined variable up */ 1354 1355 p -> reference.qualifier = arg (1); 1356 p -> reference.fo_in_qual = ref (1) -> reference.fo_in_qual; 1357 p -> reference.offset = arg (1) -> reference.offset; 1358 p -> reference.c_offset = arg (1) -> reference.c_offset; 1359 p -> reference.units = arg (1) -> reference.units; 1360 p -> reference.modword_in_offset = arg (1) -> reference.modword_in_offset; 1361 1362 if ^pl1_stat_$eis_mode then 1363 if p -> reference.offset ^= null then 1364 if p -> reference.units <= half_ then do; 1365 if p -> reference.units = bit_ then 1366 opcode = mod_bit; 1367 else if p -> reference.units = character_ then 1368 opcode = mod_byte; 1369 else 1370 opcode = mod_half; 1371 1372 offset = create_operator (opcode, 3); 1373 offset -> operand (1), offset -> operand (2) = 1374 declare_temporary (integer_type, default_fix_bin_p, 0, null); 1375 offset -> operand (3) = p -> reference.offset; 1376 1377 p -> reference.offset = offset; 1378 end; 1379 1380 if (p -> reference.units = character_ | p -> reference.units = digit_) & units = bit_ & pl1_stat_$eis_mode 1381 then do; /* string(bit_structure) or unspec */ 1382 p -> reference.c_offset = p -> reference.c_offset * bits_per_character; 1383 1384 if p -> reference.units = digit_ then 1385 p -> reference.c_offset = divide (p -> reference.c_offset, packed_digits_per_character, 24, 0); 1386 1387 if p -> reference.offset ^= null & ^p -> reference.modword_in_offset then 1388 if p -> reference.units = character_ then do; 1389 offset = create_operator (mult, 3); 1390 offset -> operand (2) = declare_constant$integer (bits_per_character); 1391 offset -> operand (3) = p -> reference.offset; 1392 p -> reference.offset = offset; 1393 end; 1394 else do; 1395 offset = create_operator (digit_to_bit, 2); 1396 offset -> operand (2) = p -> reference.offset; 1397 p -> reference.offset = offset; 1398 end; 1399 p -> reference.units = bit_; 1400 end; 1401 1402 if p -> reference.qualifier -> node.type = reference_node then do; 1403 p -> reference.qualifier -> reference.c_offset = 0; 1404 p -> reference.qualifier -> reference.offset = null; 1405 p -> reference.qualifier -> reference.modword_in_offset = "0"b; 1406 p -> reference.qualifier -> reference.inhibit = "1"b; 1407 end; 1408 1409 p -> reference.length = fill_refer ((p -> reference.length), (ref (1) -> reference.qualifier), "1"b); 1410 p -> reference.length = expression_semantics (cur_block, statement_ptr, (p -> reference.length), "0"b); 1411 if p -> reference.length ^= null then 1412 p -> reference.length = convert$to_integer ((p -> reference.length), integer_type); 1413 1414 p -> reference.offset = expression_semantics (cur_block, statement_ptr, (p -> reference.offset), "0"b); 1415 if p -> reference.offset ^= null then 1416 p -> reference.offset = convert$to_integer ((p -> reference.offset), integer_type); 1417 1418 call simplify_offset (p, context); 1419 1420 if def_context.arg_list then do; 1421 tree -> operand (2) = p; 1422 tree = operator_semantics (cur_block, statement_ptr, tree, this_context); 1423 end; 1424 else 1425 tree = p; 1426 1427 goto ret; 1428 1429 action (13): /* abs */ 1430 string (rtype) = defined_arg_type (1) & ^unaligned_mask & ^complex_mask | real_mask | aligned_mask; 1431 1432 goto create_operator_node; 1433 1434 action (14): /* add 1435* divide 1436* multiply 1437* subtract */ 1438 string (rtype) = "0"b; 1439 1440 do i = 1 to 2; 1441 defined_as_if_type (i) = defined_arg_type (i); 1442 1443 if as_if_type (i).bit then 1444 defined_as_if_type (i) = fixed_binary_real_mask; 1445 else if as_if_type (i).char then 1446 defined_as_if_type (i) = fixed_decimal_real_mask; 1447 else if as_if_type (i).picture then 1448 if arg_symbol (i) -> symbol.complex then 1449 if arg_symbol (i) -> symbol.pix.pic_float then 1450 defined_as_if_type (i) = float_decimal_complex_mask; 1451 else 1452 defined_as_if_type (i) = fixed_decimal_complex_mask; 1453 else if arg_symbol (i) -> symbol.pix.pic_float then 1454 defined_as_if_type (i) = float_decimal_real_mask; 1455 else 1456 defined_as_if_type (i) = fixed_decimal_real_mask; 1457 end; 1458 1459 if as_if_type (1).fixed & as_if_type (2).fixed then 1460 string (rtype) = string (rtype) | fixed_mask; 1461 else 1462 string (rtype) = string (rtype) & ^fixed_mask | float_mask; 1463 1464 if as_if_type (1).decimal & as_if_type (2).decimal then 1465 string (rtype) = string (rtype) | decimal_mask; 1466 else 1467 string (rtype) = string (rtype) & ^decimal_mask | binary_mask; 1468 1469 if ^as_if_type (1).complex & ^as_if_type (2).complex then 1470 string (rtype) = string (rtype) | real_mask; 1471 else 1472 string (rtype) = string (rtype) & ^real_mask | complex_mask; 1473 1474 string (type) = string (rtype); 1475 1476 do i = 1 to 2; 1477 call convert_arg; 1478 end; 1479 1480 if rtype.float & arg_number = 4 then 1481 call semantic_translator$abort (167, builtin_symbol); 1482 1483 if arg_number = 4 then 1484 rscale = constant_value (arg_symbol (4)); 1485 1486 rprecision = constant_value (arg_symbol (3)); 1487 1488 if rtype.decimal & rprecision > max_p_dec then 1489 goto err146; 1490 1491 if rtype.fixed & rprecision > max_p_fix_bin_2 | rtype.float & rprecision > max_p_flt_bin_2 then 1492 goto err146; 1493 1494 arg_number = 2; 1495 1496 goto create_operator_node; 1497 1498 action (15): /* bin 1499* binary 1500* dec 1501* decimal */ 1502 string (rtype) = pl1_data$builtin_name.description (builtin_number).descriptor (1).type | aligned_mask; 1503 1504 if arg_number = 3 then 1505 rscale = constant_value (arg_symbol (3)); 1506 else 1507 rscale = 0; 1508 1509 if arg_number >= 2 then 1510 rprecision = constant_value (arg_symbol (2)); 1511 else 1512 rprecision = 0; 1513 1514 goto convert_to_arith; 1515 1516 action (16): /* ceil 1517* floor 1518* trunc */ 1519 if arg_type (1).complex then 1520 goto err124; 1521 1522 if arg_type (1).fixed then 1523 if arg_type (1).binary then 1524 rprecision = min (max_p_fix_bin_2, max (rprecision - rscale + 1, 1)); 1525 else 1526 rprecision = min (max_p_dec, max (rprecision - rscale + 1, 1)); 1527 rscale = 0; 1528 1529 goto create_operator_node; 1530 1531 action (17): /* complex 1532* cplx */ 1533 string (rtype) = "0"b; 1534 1535 do i = 1 to 2; 1536 defined_as_if_type (i) = defined_arg_type (i); 1537 1538 if as_if_type (i).bit then 1539 defined_as_if_type (i) = fixed_binary_real_mask; 1540 else if as_if_type (i).char then 1541 defined_as_if_type (i) = fixed_decimal_real_mask; 1542 else if as_if_type (i).picture then 1543 if arg_symbol (i) -> symbol.pix.pic_float then 1544 defined_as_if_type (i) = float_decimal_real_mask; 1545 else 1546 defined_as_if_type (i) = fixed_decimal_real_mask; 1547 1548 if as_if_type (i).complex then 1549 goto err124; 1550 end; 1551 1552 if as_if_type (1).fixed & as_if_type (2).fixed then 1553 string (rtype) = string (rtype) | fixed_mask; 1554 else 1555 string (rtype) = string (rtype) & ^fixed_mask | float_mask; 1556 1557 if as_if_type (1).decimal & as_if_type (2).decimal then 1558 string (rtype) = string (rtype) | decimal_mask; 1559 else 1560 string (rtype) = string (rtype) & ^decimal_mask | binary_mask; 1561 1562 string (type) = string (rtype); 1563 string (rtype) = string (rtype) & ^real_mask | complex_mask; 1564 1565 do i = 1 to 2; 1566 call convert_arg; 1567 end; 1568 1569 p1 = arg_symbol (1) -> symbol.c_dcl_size; 1570 p2 = arg_symbol (2) -> symbol.c_dcl_size; 1571 q1 = fixed (arg_symbol (1) -> symbol.scale, 31, 0); 1572 q2 = fixed (arg_symbol (2) -> symbol.scale, 31, 0); 1573 1574 rscale = max (q1, q2); 1575 1576 if rtype.fixed & rtype.binary then 1577 rprecision = min (max_p_fix_bin_2, max (p1 - q1, p2 - q2) + rscale); 1578 else 1579 rprecision = min (max_p_flt_bin_2, max (p1 - q1, p2 - q2) + rscale); 1580 1581 if rtype.decimal then 1582 rprecision = min (max_p_dec, max (p1 - q1, p2 - q2) + rscale); 1583 1584 goto create_operator_node; 1585 1586 action (18): /* bit 1587* char */ 1588 string (rtype) = pl1_data$builtin_name.description (builtin_number).descriptor (1).type | aligned_mask; 1589 1590 string_size_ck = "1"b; 1591 1592 if arg_number = 2 then 1593 if symbol_is_constant (arg_symbol (2)) then do; 1594 rprecision = constant_value (arg_symbol (2)); 1595 rlength = null; 1596 end; 1597 else do; 1598 rprecision = 0; 1599 rlength = copy_expression ((arg (2))); 1600 end; 1601 1602 full_attribute_set = arg_number > 1; 1603 1604 if arg (1) -> node.type = token_node then do; 1605 arg (1) = convert$from_builtin (arg (1), string (rtype)); 1606 if ^full_attribute_set then 1607 rprecision = arg (1) -> reference.c_length; 1608 opcode = assign; 1609 arg_number = 1; 1610 1611 goto create_operator_node; 1612 end; 1613 1614 goto convert_label; 1615 1616 action (19): /* imag 1617* real */ 1618 string (rtype) = string (rtype) & ^complex_mask | real_mask; 1619 1620 if ^def_context.arg_list then do; 1621 if arg_symbol (1) -> symbol.packed then 1622 string (rtype) = string (rtype) & ^aligned_mask | unaligned_mask; 1623 1624 t = declare_defined_overlay (string (rtype), rprecision, (rscale), rlength, arg (1)); 1625 s = t -> reference.symbol; 1626 1627 s -> symbol.boundary = arg_symbol (1) -> symbol.boundary; 1628 1629 if def_context.left_side then 1630 call propagate_bit (arg_symbol (1), set_bit); 1631 1632 arg_symbol (1) -> symbol.overlayed_by_builtin = "1"b; 1633 1634 if opcode = imag_fun /* imag */ then 1635 if s -> symbol.decimal then do; 1636 if s -> symbol.unaligned then do; 1637 t -> reference.units = digit_; 1638 t -> reference.c_offset = divide (s -> symbol.c_bit_size, bits_per_digit, 15, 0); 1639 end; 1640 else do; 1641 t -> reference.units = character_; 1642 t -> reference.c_offset = divide (s -> symbol.c_bit_size, bits_per_character, 15, 0); 1643 end; 1644 end; 1645 else do; 1646 if s -> symbol.packed then do; 1647 t -> reference.units = bit_; 1648 t -> reference.c_offset = s -> symbol.c_bit_size; 1649 end; 1650 else do; 1651 t -> reference.units = word_; 1652 t -> reference.c_offset = s -> symbol.c_word_size; 1653 end; 1654 end; 1655 1656 if arg (1) -> node.type = operator_node then do; 1657 r = create_statement (assignment_statement, (statement_ptr -> statement.back), null, 1658 (statement_ptr -> statement.prefix)); 1659 r -> statement.root = share_expression (arg (1)); 1660 r -> statement.generated = "1"b; 1661 1662 ref (1) = arg (1) -> operand (1); 1663 end; 1664 else if arg (1) = arg_symbol (1) -> symbol.reference then 1665 arg (1), ref (1) = copy_expression ((arg (1))); 1666 1667 off = t -> reference.offset; 1668 coff = t -> reference.c_offset; 1669 cunits = t -> reference.units; 1670 1671 call offset_adder (off, coff, cunits, "0"b, (ref (1) -> reference.offset), (ref (1) -> reference.c_offset), 1672 (ref (1) -> reference.units), (ref (1) -> reference.modword_in_offset), 1673 ref (1) -> reference.fo_in_qual); 1674 1675 t -> reference.offset = off; 1676 t -> reference.c_offset = coff; 1677 t -> reference.units = cunits; 1678 ref (1) -> reference.offset = null; 1679 ref (1) -> reference.c_offset = 0; 1680 ref (1) -> reference.modword_in_offset = "0"b; 1681 ref (1) -> reference.inhibit = "1"b; 1682 t -> reference.qualifier = arg (1); 1683 t -> reference.fo_in_qual = ref (1) -> reference.fo_in_qual; 1684 1685 if t -> reference.offset ^= null then do; 1686 t -> reference.offset = 1687 expression_semantics (cur_block, statement_ptr, (t -> reference.offset), "0"b); 1688 call simplify_offset (t, "0"b); 1689 end; 1690 1691 1692 tree = t; 1693 goto ret; 1694 end; 1695 1696 goto create_operator_node; 1697 1698 action (20): /* max 1699* min */ 1700 string (rtype) = "0"b; 1701 rprecision, rscale = 0; 1702 1703 do i = 1 to arg_number; 1704 defined_as_if_type (i) = defined_arg_type (i); 1705 1706 if as_if_type (i).bit then 1707 defined_as_if_type (i) = fixed_binary_real_mask; 1708 else if as_if_type (i).char then 1709 defined_as_if_type (i) = fixed_decimal_real_mask; 1710 else if as_if_type (i).picture then 1711 if arg_symbol (i) -> symbol.pix.pic_float then 1712 defined_as_if_type (i) = float_decimal_real_mask; 1713 else 1714 defined_as_if_type (i) = fixed_decimal_real_mask; 1715 1716 if as_if_type (i).complex then 1717 goto err124; 1718 end; 1719 1720 do i = 1 to arg_number; 1721 rtype.float = rtype.float | as_if_type (i).float; 1722 rtype.binary = rtype.binary | as_if_type (i).binary; 1723 end; 1724 1725 if ^rtype.float then 1726 rtype.fixed = "1"b; 1727 1728 if ^rtype.binary then 1729 rtype.decimal = "1"b; 1730 1731 rtype.real = "1"b; 1732 1733 string (type) = string (rtype); 1734 1735 do i = 1 to arg_number; 1736 call convert_arg; 1737 rprecision = max (rprecision, arg_symbol (i) -> symbol.c_dcl_size); 1738 rscale = max (rscale, fixed (arg_symbol (i) -> symbol.scale, 31, 0)); 1739 end; 1740 1741 goto create_operator_node; 1742 1743 action (21): /* mod */ 1744 string (rtype) = real_mask | aligned_mask; 1745 rprecision, rscale = 0; 1746 1747 do i = 1 to 2; 1748 defined_as_if_type (i) = defined_arg_type (i); 1749 1750 if as_if_type (i).bit then 1751 defined_as_if_type (i) = fixed_binary_real_mask; 1752 else if as_if_type (i).char then 1753 defined_as_if_type (i) = fixed_decimal_real_mask; 1754 else if as_if_type (i).picture then 1755 if arg_symbol (i) -> symbol.pix.pic_float then 1756 defined_as_if_type (i) = float_decimal_real_mask; 1757 else 1758 defined_as_if_type (i) = fixed_decimal_real_mask; 1759 1760 if as_if_type (i).complex then 1761 goto err124; 1762 end; 1763 1764 if as_if_type (1).fixed & as_if_type (2).fixed then 1765 string (rtype) = string (rtype) | fixed_mask; 1766 else 1767 string (rtype) = string (rtype) & ^fixed_mask | float_mask; 1768 1769 if as_if_type (1).decimal & as_if_type (2).decimal then 1770 string (rtype) = string (rtype) | decimal_mask; 1771 else 1772 string (rtype) = string (rtype) & ^decimal_mask | binary_mask; 1773 1774 string (type) = string (rtype); 1775 1776 do i = 1 to 2; 1777 call convert_arg; 1778 end; 1779 1780 p1 = arg_symbol (1) -> symbol.c_dcl_size; 1781 p2 = arg_symbol (2) -> symbol.c_dcl_size; 1782 q1 = fixed (arg_symbol (1) -> symbol.scale, 31, 0); 1783 q2 = fixed (arg_symbol (2) -> symbol.scale, 31, 0); 1784 1785 rscale = max (q1, q2); 1786 1787 if rtype.float then 1788 rprecision = max (p1, p2); 1789 else if rtype.binary then 1790 rprecision = min (max_p_fix_bin_2, p2 - q2 + rscale); 1791 else 1792 rprecision = min (max_p_dec, p2 - q2 + rscale); 1793 1794 goto create_operator_node; 1795 1796 action (22): /* round */ 1797 i = constant_value (arg_symbol (2)); 1798 1799 if rtype.fixed then do; 1800 if rtype.decimal then 1801 rprecision = 1802 max (1, 1803 min (arg_symbol (1) -> symbol.c_dcl_size - arg_symbol (1) -> symbol.scale + 1 + i, max_p_dec)); 1804 else 1805 rprecision = 1806 max (1, 1807 min (arg_symbol (1) -> symbol.c_dcl_size - arg_symbol (1) -> symbol.scale + 1 + i, 1808 max_p_fix_bin_2)); 1809 rscale = i; 1810 end; 1811 if rtype.float then do; 1812 if i <= 0 then 1813 call semantic_translator$abort (271, builtin_symbol); 1814 1815 if rtype.decimal then 1816 rprecision = min (i, max_p_dec); 1817 else 1818 rprecision = min (i, max_p_flt_bin_2); 1819 end; 1820 1821 goto create_operator_node; 1822 1823 action (23): /* bool */ 1824 do i = 1 to 2; 1825 if ref (i) -> reference.varying_ref then 1826 cur_length (i) = create_length_fun (arg (i)); 1827 else if ref (i) -> reference.length ^= null then 1828 cur_length (i) = share_expression ((ref (i) -> reference.length)); 1829 else 1830 cur_length (i) = null; 1831 end; 1832 1833 if cur_length (1) = null & cur_length (2) = null then 1834 rprecision = max (ref (1) -> reference.c_length, ref (2) -> reference.c_length); 1835 else do; 1836 rprecision = 0; 1837 rlength = create_operator (max_fun, 3); 1838 rlength -> operand (1) = declare_temporary (integer_type, default_fix_bin_p, 0, null); 1839 rlength -> operand (2) = cur_length (1); 1840 rlength -> operand (3) = cur_length (2); 1841 1842 if cur_length (1) = null then 1843 rlength -> operand (2) = declare_constant$integer ((ref (1) -> reference.c_length)); 1844 1845 if cur_length (2) = null then 1846 rlength -> operand (3) = declare_constant$integer ((ref (2) -> reference.c_length)); 1847 end; 1848 1849 if ^arg_symbol (3) -> symbol.constant then do; 1850 t = declare_temporary (bit_mask, 4, 0, null); 1851 arg (3) = convert$to_target (arg (3), t); 1852 goto create_operator_node; 1853 end; 1854 1855 if rlength ^= null | rprecision > bits_per_double then 1856 goto create_operator_node; 1857 1858 bit4 = substr (arg_symbol (3) -> symbol.initial -> based_type, 1, 4); 1859 not_flag = substr (bit4, 1, 1); 1860 1861 if not_flag then 1862 bit4 = ^bit4; 1863 1864 if bit4 = "0000"b then do; 1865 tree = create_operator (assign, 2); 1866 tree -> operand (2) = declare_constant$bit ("000000000000000000000000000000000000"b); 1867 end; 1868 else if bit4 = "0011"b then do; 1869 tree = create_operator (assign, 2); 1870 tree -> operand (2) = arg (1); 1871 end; 1872 else if bit4 = "0101"b then do; 1873 tree = create_operator (assign, 2); 1874 tree -> operand (2) = arg (2); 1875 end; 1876 1877 else do; 1878 if bit4 = "0001"b then 1879 opcode = and_bits; 1880 else if bit4 = "0111"b then 1881 opcode = or_bits; 1882 else if bit4 = "0110"b then 1883 opcode = xor_bits; 1884 1885 else do; 1886 opcode = and_bits; 1887 1888 if bit4 = "0100"b then 1889 m = 1; 1890 else 1891 m = 2; 1892 1893 r = create_operator (assign, 2); 1894 r -> operand (1) = declare_temporary (bit_mask, rprecision, 0, rlength); 1895 r -> operand (2) = arg (m); 1896 1897 p = create_operator (not_bits, 2); 1898 p -> operand (1) = declare_temporary (bit_mask, rprecision, 0, rlength); 1899 p -> operand (2) = r; 1900 1901 arg (m) = p; 1902 end; 1903 1904 tree = create_operator (opcode, 3); 1905 tree -> operand (2) = arg (1); 1906 tree -> operand (3) = arg (2); 1907 end; 1908 1909 tree -> operand (1) = declare_temporary (bit_mask, rprecision, 0, rlength); 1910 1911 if not_flag then do; 1912 p = create_operator (not_bits, 2); 1913 p -> operand (1) = declare_temporary (bit_mask, rprecision, 0, rlength); 1914 p -> operand (2) = tree; 1915 1916 tree = p; 1917 end; 1918 1919 goto ret; 1920 1921 action (24): /* decat */ 1922 if arg_type (1).bit & arg_type (2).bit then 1923 string (type) = bit_mask; 1924 else do; 1925 string (type) = char_mask; 1926 reserved_number = reserved_number + 1; 1927 end; 1928 1929 do i = 1 to 2; 1930 call convert_arg; 1931 end; 1932 1933 string (type) = bit_mask; /* i will be 3 at this point */ 1934 call convert_arg; 1935 1936 do i = 1 to arg_number; 1937 if ref (i) -> reference.varying_ref then do; 1938 length = create_length_fun (arg (i)); 1939 1940 p = create_operator (assign, 2); 1941 ref (i), p -> operand (1) = declare_temporary (string (rtype) & ^varying_mask, 0, 0, length); 1942 p -> operand (2) = arg (i); 1943 1944 arg (i) = p; 1945 arg_symbol (i) = ref (i) -> reference.symbol; 1946 end; 1947 end; 1948 1949 desc_reqd = "1"b; 1950 1951 goto create_call; 1952 1953 action (25): /* atanh 1954* cosh 1955* erf 1956* erfc 1957* sinh 1958* tanh */ 1959 if arg_type (1).complex then 1960 reserved_number = reserved_number + 2; 1961 1962 if rprecision > max_p_flt_bin_1 then 1963 reserved_number = reserved_number + 1; 1964 1965 goto create_call; 1966 1967 action (26): /* dim 1968* hbound 1969* lbound */ 1970 if arg_symbol (1) = null then 1971 call semantic_translator$abort (127, builtin_symbol); 1972 1973 if arg_symbol (1) -> node.type = label_node then do; 1974 /* bug 2193: Error 127 is printed when the first argument 1975* to hbound is not an array value */ 1976 if ^(arg_symbol (1) -> label.array) then 1977 call semantic_translator$abort (127, builtin_symbol); 1978 if reserved_number = 1 then 1979 number = arg_symbol (1) -> label.low_bound; 1980 else if reserved_number = 2 then 1981 number = arg_symbol (1) -> label.high_bound; 1982 else 1983 number = arg_symbol (1) -> label.high_bound - arg_symbol (1) -> label.low_bound + 1; 1984 1985 tree = declare_constant (unspec (number), integer_type, max_offset_precision, 0); 1986 1987 goto ret; 1988 end; 1989 1990 if arg_symbol (1) -> symbol.array = null then 1991 call semantic_translator$abort (127, builtin_symbol); 1992 1993 if arg_symbol (1) -> symbol.defined then 1994 arg (1) = defined_reference (cur_block, statement_ptr, arg (1), null, arg_symbol (1), "0"b); 1995 1996 p = arg_symbol (1) -> symbol.array; 1997 1998 if ^symbol_is_constant (arg_symbol (2)) then do; 1999 ref (3), arg (3) = declare_constant$integer ((p -> array.number_of_dimensions)); 2000 arg_symbol (3) = arg (3) -> reference.symbol; 2001 2002 ref (4), arg (4) = declare_constant$integer (reserved_number); 2003 arg_symbol (4) = arg (4) -> reference.symbol; 2004 2005 reserved_number = 6; 2006 arg_number = 4; 2007 string (rtype) = fixed_binary_real_mask; 2008 rprecision = max_offset_precision; 2009 rscale = 0; 2010 2011 goto create_call; 2012 end; 2013 2014 integer = constant_value (arg_symbol (2)); 2015 2016 if integer > p -> array.number_of_dimensions | integer < 1 then 2017 call semantic_translator$abort (128, builtin_symbol); 2018 2019 p = p -> array.bounds; 2020 do i = 1 to arg_symbol (1) -> symbol.array -> array.number_of_dimensions - integer; 2021 p = p -> bound.next; 2022 end; 2023 2024 if p -> bound.lower ^= null then do; 2025 call simplify_expression ((p -> bound.lower), constant, modified); 2026 if modified then do; 2027 p -> bound.c_lower = constant; 2028 p -> bound.lower = null; 2029 end; 2030 end; 2031 2032 if p -> bound.upper ^= null then do; 2033 call simplify_expression ((p -> bound.upper), constant, modified); 2034 if modified then do; 2035 p -> bound.c_upper = constant; 2036 p -> bound.upper = null; 2037 end; 2038 end; 2039 2040 if reserved_number = 1 then 2041 if p -> bound.lower = null then do; 2042 tree = declare_constant (unspec (p -> bound.c_lower), integer_type, max_offset_precision, 0); 2043 goto ret; 2044 end; 2045 else do; 2046 tree = copy_expression (p -> bound.lower); 2047 tree = fill_refer (tree, (ref (1) -> reference.qualifier), "1"b); 2048 tree = expression_semantics (cur_block, statement_ptr, tree, this_context); 2049 2050 arg (1) = tree; 2051 goto create_assign; 2052 end; 2053 2054 if reserved_number = 2 then 2055 if p -> bound.upper = null then do; 2056 tree = declare_constant (unspec (p -> bound.c_upper), integer_type, max_offset_precision, 0); 2057 goto ret; 2058 end; 2059 else do; 2060 tree = copy_expression (p -> bound.upper); 2061 tree = fill_refer (tree, (ref (1) -> reference.qualifier), "1"b); 2062 tree = expression_semantics (cur_block, statement_ptr, tree, this_context); 2063 2064 arg (1) = tree; 2065 goto create_assign; 2066 end; 2067 2068 if p -> bound.upper = null & p -> bound.lower = null then do; 2069 number = p -> bound.c_upper - p -> bound.c_lower + 1; 2070 tree = declare_constant (unspec (number), integer_type, max_offset_precision, 0); 2071 2072 goto ret; 2073 end; 2074 2075 arg (1) = copy_expression (p -> bound.upper); 2076 if arg (1) = null then 2077 arg (1) = declare_constant$integer ((p -> bound.c_upper)); 2078 else do; 2079 arg (1) = fill_refer (arg (1), (ref (1) -> reference.qualifier), "1"b); 2080 2081 if arg (1) -> node.type = token_node then 2082 arg (1) = expression_semantics (cur_block, statement_ptr, arg (1), "0"b); 2083 2084 if arg (1) -> node.type = reference_node then 2085 if arg (1) -> reference.symbol -> symbol.arg_descriptor then do; 2086 t = create_operator (assign, 2); 2087 t -> operand (1) = declare_temporary (integer_type, max_offset_precision, 0, null); 2088 t -> operand (2) = arg (1); 2089 arg (1) = t; 2090 end; 2091 end; 2092 2093 arg (2) = copy_expression (p -> bound.lower); 2094 if arg (2) = null then 2095 arg (2) = declare_constant$integer (p -> bound.c_lower - 1); 2096 else do; 2097 arg (2) = fill_refer (arg (2), (ref (1) -> reference.qualifier), "1"b); 2098 2099 if arg (2) -> node.type = token_node then 2100 arg (2) = expression_semantics (cur_block, statement_ptr, arg (2), "0"b); 2101 2102 if arg (2) -> node.type = reference_node then 2103 if arg (2) -> reference.symbol -> symbol.arg_descriptor then do; 2104 t = create_operator (assign, 2); 2105 t -> operand (1) = declare_temporary (integer_type, default_fix_bin_p, 0, null); 2106 t -> operand (2) = arg (2); 2107 arg (2) = t; 2108 end; 2109 2110 p = create_operator (sub, 3); 2111 p -> operand (1) = declare_temporary (fixed_binary_real_mask, max_offset_precision, 0, null); 2112 p -> operand (2) = arg (2); 2113 p -> operand (3) = declare_constant$integer (1); 2114 2115 arg (2) = p; 2116 end; 2117 2118 do i = 1 to 2; 2119 arg (i) = expression_semantics (cur_block, statement_ptr, arg (i), "0"b); 2120 end; 2121 2122 string (rtype) = fixed_binary_real_mask; 2123 rprecision = max_offset_precision; 2124 rscale = 0; 2125 2126 goto create_operator_node; 2127 2128 action (27): /* reverse */ 2129 if check_reverse (arg (1)) then do; /* reverse (reverse (..)) */ 2130 tree = arg (1) -> operator.operand (2); 2131 go to ret; 2132 end; 2133 if is_this_constant (arg (1)) then do; 2134 constant_string_length = arg (1) -> reference.c_length; 2135 if arg_type (1).bit then 2136 tree = declare_constant$bit (reverse (arg_symbol (1) -> symbol.initial -> constant_bit_string)); 2137 else 2138 tree = declare_constant$char (reverse (arg_symbol (1) -> symbol.initial -> constant_char_string)); 2139 go to exit; 2140 end; 2141 if ref (1) -> reference.c_length = 1 then do; /* reverse of 1 doesn't reverse */ 2142 tree = arg (1); 2143 go to ret; 2144 end; 2145 goto create_operator_node; 2146 2147 action (28): /* empty */ 2148 if pl1_stat_$cur_statement -> statement.root -> operand (2) ^= tree 2149 & pl1_stat_$cur_statement -> statement.root -> operand (2) ^= tree -> reference.symbol -> symbol.token then 2150 call semantic_translator$abort (187, builtin_symbol); 2151 2152 arg (2) = pl1_stat_$cur_statement -> statement.root -> operand (1); 2153 arg_symbol (2) = arg (2) -> reference.symbol; 2154 2155 if string (arg_symbol (2) -> symbol.data_type) = "0"b then do; 2156 arg_symbol (2) -> symbol.area = "1"b; 2157 arg_symbol (2) -> symbol.c_dcl_size, arg_symbol (2) -> symbol.c_word_size = min_area_size; 2158 integer_24 = min_area_size; 2159 end; 2160 else if ^arg_symbol (2) -> symbol.area then 2161 call semantic_translator$abort (188, arg (2)); 2162 else if arg_symbol (2) -> symbol.dcl_size = null then 2163 integer_24 = arg_symbol (2) -> symbol.c_dcl_size; 2164 else 2165 integer_24 = 0; /* this will get reset anyway if dcl_size^=0 */ 2166 2167 2168 if arg_symbol (2) -> symbol.structure then 2169 call semantic_translator$abort (265, arg_symbol (2)); 2170 2171 if arg (2) -> reference.array_ref then do; 2172 t = expand_primitive (cur_block, statement_ptr, arg (2), "0"b); 2173 2174 do r = t repeat t -> operand (1) while (r -> operand (1) -> node.type = operator_node); 2175 end; 2176 2177 arg (2) = r -> operand (1); 2178 end; 2179 else 2180 r = null; 2181 2182 if ^pl1_stat_$use_old_area then do; 2183 p = create_operator (empty_area, 2); /* op(1) of empty is the area, op(2) is its size */ 2184 p -> operand (1) = arg (2); 2185 if integer_24 ^= 0 then 2186 p -> operand (2) = declare_constant$integer ((integer_24)); 2187 else do; 2188 q = copy_expression (arg_symbol (2) -> symbol.dcl_size); 2189 2190 if arg_symbol (2) -> symbol.refer_extents then 2191 q = fill_refer (q, (arg (2) -> reference.qualifier), "1"b); 2192 2193 q = expression_semantics (cur_block, statement_ptr, q, "0"b); 2194 p -> operand (2) = q; 2195 end; 2196 end; 2197 2198 else do; 2199 2200 p = create_operator (copy_words, 3); 2201 p -> operand (1) = arg (2); 2202 p -> operand (2) = declare_constant$bit ((84)"0"b || bit (integer_24, 24) || (36)"0"b); 2203 p -> operand (3) = declare_constant$integer (4); 2204 2205 if arg_symbol (2) -> symbol.dcl_size ^= null then do; 2206 if arg (2) -> reference.offset ^= null | arg (2) -> reference.c_offset ^= 0 then do; 2207 /* not to destroy the offsets of arg(2) used in copy_words */ 2208 q = create_reference (null); 2209 q -> reference = arg (2) -> reference; 2210 arg (2) = q; 2211 if ^q -> reference.shared then do; 2212 q -> reference.ref_count = 0; 2213 if q -> reference.offset ^= null then 2214 q -> reference.offset = copy_expression (q -> reference.offset); 2215 if q -> reference.qualifier ^= null then 2216 q -> reference.qualifier = copy_expression (q -> reference.qualifier); 2217 end; 2218 end; 2219 2220 q = create_operator (assign, 2); 2221 q -> operand (1) = declare_integer (cur_block); 2222 q -> operand (2) = copy_expression (arg_symbol (2) -> symbol.dcl_size); 2223 2224 if arg_symbol (2) -> symbol.refer_extents then 2225 q -> operand (2) = fill_refer ((q -> operand (2)), (arg (2) -> reference.qualifier), "1"b); 2226 2227 q -> operand (2) = expression_semantics (cur_block, p, (q -> operand (2)), "0"b); 2228 2229 arg (2) = expression_semantics (cur_block, statement_ptr, arg (2), "0"b); 2230 2231 q -> operand (1) -> reference.units = word_; 2232 q -> operand (1) -> reference.offset = arg (2) -> reference.offset; 2233 q -> operand (1) -> reference.c_offset = arg (2) -> reference.c_offset + 2; 2234 2235 q -> operand (1) -> reference.qualifier = copy_expression ((arg (2))); 2236 2237 arg (2) -> reference.offset = null; 2238 arg (2) -> reference.c_offset = 0; 2239 2240 q -> operand (1) -> reference.symbol -> symbol.defined, 2241 q -> operand (1) -> reference.symbol -> symbol.position, 2242 q -> operand (1) -> reference.symbol -> symbol.overlayed, q -> operator.processed = "1"b; 2243 2244 q -> operand (1) -> reference.shared, q -> operand (1) -> reference.symbol -> symbol.auto = "0"b; 2245 q -> operand (1) -> reference.ref_count = 1; 2246 2247 2248 tree = create_operator (join, 2); 2249 tree -> operand (1) = p; 2250 tree -> operand (2) = q; 2251 2252 p = tree; 2253 end; 2254 end; 2255 2256 if r ^= null then do; 2257 r -> operand (1) = p; 2258 tree = t; 2259 end; 2260 else 2261 tree = p; 2262 2263 2264 def_context.return_from_empty = "1"b; 2265 2266 goto ret; 2267 2268 action (29): /* null */ 2269 p = null; 2270 tree = declare_constant (unspec (p), pointer_type, 0, 0); 2271 2272 goto exit; 2273 2274 action (30): /* lineno 2275* pageno */ 2276 if def_save_context.aggregate then 2277 goto err124; 2278 if def_context.left_side then do; 2279 tree = create_operator (std_call, 3); 2280 tree -> operand (2) = reserve$declare_lib (reserved_number - 7); 2281 tree -> operand (3) = create_operator (std_arg_list, 3); 2282 tree -> operand (3) -> operand (1) = declare_temporary (storage_block_type, 6, 0, null); 2283 tree -> operand (3) -> operand (2) = create_list (2); 2284 tree -> operand (3) -> operand (2) -> element (1) = arg (1); 2285 2286 tree -> operand (3) -> operand (2) -> element (2) = 2287 convert$to_integer ((pl1_stat_$cur_statement -> statement.root -> operand (2)), integer_type); 2288 2289 def_context.return_from_empty = "1"b; 2290 2291 goto ret; 2292 end; 2293 2294 rprecision = max_p_fix_bin_1; 2295 string (rtype) = integer_type; 2296 2297 goto create_call; 2298 2299 action (31): /* date */ 2300 string (rtype) = char_mask; 2301 rprecision = 6; 2302 2303 goto create_call; 2304 2305 action (32): /* time */ 2306 string (rtype) = char_mask; 2307 rprecision = 12; 2308 2309 goto create_call; 2310 2311 action (33): /* addr */ 2312 if arg (1) -> node.type ^= reference_node & pl1_stat_$check_ansi then 2313 call semantic_translator$abort (132, builtin_symbol); 2314 else if arg (1) -> reference.temp_ref then 2315 call semantic_translator$error (299, builtin_symbol); 2316 /* temp must mean an expression */ 2317 2318 if arg_symbol (1) -> symbol.constant then 2319 if arg_symbol (1) -> symbol.initial ^= null then 2320 call semantic_translator$abort (132, builtin_symbol); 2321 2322 call propagate_bit (arg_symbol (1), aliasable_bit); 2323 call propagate_bit (arg_symbol (1), set_bit); 2324 if arg_symbol (1) -> symbol.cross_references ^= null then 2325 arg_symbol (1) -> symbol.cross_references -> cross_reference.set_reference = "0"b; 2326 /* Arg of "addr" is not considered a set xref */ 2327 2328 if arg_symbol (1) -> symbol.defined & (arg (1) -> reference.array_ref | arg_symbol (1) -> symbol.structure) 2329 then do; 2330 arg (1) = defined_reference (cur_block, statement_ptr, arg (1), null, arg_symbol (1), "0"b); 2331 if arg (1) -> reference.offset ^= null then 2332 arg (1) -> reference.offset = 2333 expression_semantics (cur_block, statement_ptr, (arg (1) -> reference.offset), "0"b); 2334 end; 2335 2336 if arg (1) -> reference.units < word_ & arg (1) -> reference.units ^= 0 | arg (1) -> reference.fo_in_qual then 2337 opcode = addr_fun_bits; 2338 2339 goto prepare_pointer; 2340 2341 action (34): /* pointer 2342* ptr */ 2343 if def_save_context.aggregate then 2344 goto err124; 2345 if arg_type (1).offset then 2346 if ^arg_type (2).area then 2347 call semantic_translator$abort (437, arg (2)); 2348 else 2349 goto prepare_pointer; 2350 2351 if ^arg_type (1).ptr then 2352 call semantic_translator$abort (438, arg (1)); 2353 2354 if pl1_stat_$check_ansi then 2355 call semantic_translator$error (172, builtin_symbol); 2356 2357 if ^arg_type (1).aligned then do; 2358 p = create_operator (assign, 2); 2359 p -> operand (1) = declare_temporary (pointer_type, 0, 0, null); 2360 p -> operand (2) = arg (1); 2361 arg (1) = p; 2362 end; 2363 2364 if arg_type (2).bit then do; 2365 i = 2; 2366 string (type) = bit_mask; 2367 call convert_arg; 2368 2369 goto prepare_pointer; 2370 end; 2371 2372 if arg_type (2).char | defined_arg_type (2) & arithmetic_mask then do; 2373 i = 2; 2374 string (type) = fixed_binary_real_mask; 2375 call convert_arg; 2376 2377 goto prepare_pointer; 2378 end; 2379 else 2380 call semantic_translator$abort (436, arg (2)); 2381 2382 action (35): /* offset */ 2383 if def_save_context.aggregate then 2384 goto err124; 2385 string (rtype) = offset_mask; 2386 2387 goto create_operator_node; 2388 2389 action (36): /* allocation */ 2390 if arg_symbol (1) -> symbol.father ^= null | ^arg_symbol (1) -> symbol.controlled then 2391 call semantic_translator$abort (124, builtin_symbol); 2392 2393 /* prevent evaluation of a length expression when allocation = 0 2394* (fixes bug 1645) */ 2395 2396 if ^arg (1) -> reference.shared then 2397 arg (1) -> reference.length = null; 2398 2399 string (rtype) = integer_type; 2400 rprecision = default_fix_bin_p; 2401 rscale = 0; 2402 rlength = null; 2403 2404 goto create_operator_node; 2405 2406 action (37): /* search 2407* verify */ 2408 if check_reverse (arg (1)) then do; 2409 arg (1) = arg (1) -> operator.operand (2); 2410 if opcode = search_fun then 2411 opcode = search_rev_fun; 2412 else 2413 opcode = verify_rev_fun; 2414 end; 2415 2416 string (rtype) = fixed_binary_real_mask; 2417 rprecision = max_length_precision; 2418 2419 goto create_operator_node; 2420 2421 action (38): /* sign */ 2422 if rtype.complex then 2423 goto err124; 2424 2425 string (rtype) = fixed_binary_real_mask; 2426 rprecision = default_fix_bin_p; 2427 rscale = 0; 2428 2429 goto create_operator_node; 2430 2431 action (39): /* baseno 2432* rel */ 2433 if def_save_context.aggregate then 2434 goto err124; 2435 if ^arg_type (1).ptr then 2436 goto err124; 2437 2438 string (rtype) = bit_mask; 2439 rprecision = 18; 2440 2441 goto create_operator_node; 2442 2443 action (70): /* segno */ 2444 rprecision = 15; 2445 go to pointer_decomp_common; 2446 action (71): /* wordno */ 2447 rprecision = 18; 2448 go to pointer_decomp_common; 2449 action (72): /* charno */ 2450 rprecision = 21; 2451 go to pointer_decomp_common; 2452 action (73): /* bitno */ 2453 rprecision = 24; 2454 2455 pointer_decomp_common: 2456 if def_save_context.aggregate then 2457 goto err124; 2458 if ^arg_type (1).ptr then 2459 goto err124; 2460 2461 string (rtype) = fixed_binary_real_mask; 2462 rscale = 0; 2463 rlength = null; 2464 2465 goto create_operator_node; 2466 2467 action (74): /* setcharno ... addbitno */ 2468 if def_save_context.aggregate then 2469 goto err124; 2470 2471 go to prepare_pointer; 2472 2473 action (40): /* stac */ 2474 string (rtype) = bit_mask; 2475 rprecision = 1; 2476 2477 goto create_operator_node; 2478 2479 action (41): /* addrel 2480* baseptr */ 2481 if def_save_context.aggregate then 2482 goto err124; 2483 goto prepare_pointer; 2484 2485 action (42): /* onfield 2486* onfile 2487* onkey 2488* onloc */ 2489 arg (1) = declare_temporary (char_mask, 256, 0, null); 2490 arg_symbol (1) = arg (1) -> reference.symbol; 2491 2492 desc_reqd = "1"b; 2493 2494 goto create_call; 2495 2496 action (43): /* prod 2497* sum */ 2498 if arg_symbol (1) = null then 2499 call semantic_translator$abort (127, builtin_symbol); 2500 2501 if arg_type (1).bit then do; 2502 string (rtype) = fixed_binary_real_mask; 2503 rprecision = max_p_fix_bin_2; 2504 rscale = 0; 2505 end; 2506 else if arg_type (1).char then do; 2507 string (rtype) = fixed_decimal_real_mask; 2508 rprecision = max_p_dec; 2509 rscale = 0; 2510 end; 2511 else if arg_type (1).picture then do; 2512 rprecision = arg_symbol (1) -> symbol.pix.pic_size; 2513 rscale = arg_symbol (1) -> symbol.pix.pic_scale; 2514 if arg_type (1).complex then 2515 if arg_symbol (1) -> symbol.pix.pic_float then 2516 string (rtype) = float_decimal_complex_mask; 2517 else 2518 string (rtype) = fixed_decimal_complex_mask; 2519 else if arg_symbol (1) -> symbol.pix.pic_float then 2520 string (rtype) = float_decimal_real_mask; 2521 else 2522 string (rtype) = fixed_decimal_real_mask; 2523 end; 2524 2525 if rtype.fixed then 2526 if opcode = mult & rscale ^= 0 then do; 2527 if rtype.binary then 2528 rprecision = max_p_flt_bin_2; 2529 else 2530 rprecision = max_p_dec; 2531 rscale = 0; 2532 string (type), string (rtype) = string (rtype) & ^fixed_mask | float_mask; 2533 end; 2534 else if rtype.binary then 2535 rprecision = max_p_fix_bin_2; 2536 else 2537 rprecision = max_p_dec; 2538 2539 if arg (1) -> node.type ^= operator_node then 2540 arg (1) = expand_primitive (cur_block, statement_ptr, arg (1), "0"b); 2541 2542 if arg (1) -> operator.op_code ^= loop then 2543 call semantic_translator$abort (127, builtin_symbol); 2544 2545 product: 2546 p = arg (1); 2547 do while (p -> operand (1) -> node.type = operator_node); 2548 if p -> operand (1) -> operator.op_code = loop then 2549 p = p -> operand (1); 2550 else 2551 goto leave; 2552 end; 2553 2554 leave: 2555 r = create_operator (opcode, 3); 2556 r -> operand (3) = p -> operand (1); 2557 2558 q = create_operator (assign, 2); 2559 q -> operand (2) = r; 2560 2561 t = create_symbol (cur_block, null, by_compiler); 2562 substr (string (t -> symbol.attributes), 1, 36) = string (rtype) & undesirable_mask & ^unaligned_mask; 2563 t -> symbol.c_dcl_size = rprecision; 2564 t -> symbol.scale = rscale; 2565 t -> symbol.auto, t -> symbol.precision, t -> symbol.allocate = "1"b; 2566 2567 call declare (t); 2568 2569 t = t -> symbol.reference; 2570 2571 q -> operand (1), r -> operand (2) = t; 2572 2573 p -> operand (1) = expression_semantics (cur_block, statement_ptr, q, this_context); 2574 2575 r = create_statement (assignment_statement, (statement_ptr -> statement.back), null, 2576 (statement_ptr -> statement.prefix)); 2577 r -> statement.generated = "1"b; 2578 2579 p = create_operator (assign, 2); 2580 p -> operand (1) = t; 2581 if opcode = add then 2582 p -> operand (2) = create_token ("0", dec_integer); 2583 else 2584 p -> operand (2) = create_token ("1", dec_integer); 2585 2586 r -> statement.root = operator_semantics (cur_block, r, p, this_context); 2587 2588 r = create_statement (assignment_statement, r, null, (r -> statement.prefix)); 2589 r -> statement.generated = "1"b; 2590 r -> statement.root = operator_semantics (cur_block, r, arg (1), this_context); 2591 2592 tree = t; 2593 2594 goto ret; 2595 2596 action (44): /* nullo */ 2597 i = -1; 2598 tree = declare_constant (unspec (i), offset_mask, 0, 0); 2599 2600 goto exit; 2601 2602 action (45): /* dot */ 2603 p = create_operator (mult, 3); 2604 p -> operand (2) = arg (1); 2605 p -> operand (3) = arg (2); 2606 2607 p = expand_infix (cur_block, statement_ptr, p, "0"b); 2608 2609 if p -> operator.op_code ^= loop then 2610 call semantic_translator$abort (190, builtin_symbol); 2611 if p -> operand (1) -> operator.op_code ^= mult then 2612 call semantic_translator$abort (190, builtin_symbol); 2613 2614 r = p -> operand (1) -> operand (1); 2615 string (rtype) = string (r -> reference.symbol -> symbol.attributes); 2616 rprecision = constant_value (arg_symbol (3)); 2617 if arg_number = 4 then 2618 rscale = constant_value (arg_symbol (4)); 2619 2620 arg (1) = p; 2621 2622 goto product; 2623 2624 action (46): /* convert */ 2625 arith_size_ck, string_size_ck = "1"b; 2626 2627 if def_save_context.aggregate then 2628 goto err124; 2629 if arg (1) -> node.type ^= reference_node then 2630 goto err124; 2631 2632 tree = convert$to_target_fb (arg (2), arg (1)); 2633 2634 goto ret; 2635 2636 action (47): /* size */ 2637 action (64): /* currentsize */ 2638 if arg (1) -> node.type ^= reference_node then 2639 goto err124; 2640 if arg (1) -> reference.symbol -> symbol.father ^= null then 2641 goto err124; 2642 2643 p = arg (1) -> reference.symbol -> symbol.word_size; 2644 2645 if p = null then 2646 tree = 2647 declare_constant (unspec (arg (1) -> reference.symbol -> symbol.c_word_size), integer_type, 2648 max_offset_precision, 0); 2649 else do; 2650 tree = copy_expression ((p)); 2651 if jump_index = 64 then 2652 if arg_symbol (1) -> symbol.refer_extents then 2653 call refer_extent (tree, (arg (1) -> reference.qualifier)); 2654 2655 tree = 2656 expression_semantics ((arg (1) -> reference.symbol -> symbol.block_node), statement_ptr, tree, 2657 this_context); 2658 arg (1) = tree; 2659 2660 goto create_assign; 2661 end; 2662 2663 goto ret; 2664 2665 action (48): /* valid */ 2666 if def_save_context.aggregate then 2667 goto err124; 2668 if arg (1) -> node.type ^= reference_node then 2669 goto err124; 2670 if ^arg_symbol (1) -> symbol.picture then 2671 goto err124; 2672 2673 string (rtype) = bit_mask; 2674 rprecision = 1; 2675 2676 arg_number = 2; 2677 arg (2) = arg_symbol (1) -> symbol.general; 2678 if arg (2) -> node.type ^= reference_node then 2679 call semantic_translator$abort (440, arg_symbol (1)); 2680 2681 goto create_call; 2682 2683 action (49): /* translate */ 2684 goto create_operator_node; 2685 2686 action (50): /* conjg */ 2687 goto create_operator_node; 2688 2689 action (51): /* onchar */ 2690 string (rtype) = char_mask; 2691 rprecision = 1; 2692 2693 goto create_call; 2694 2695 action (52): /* onsource */ 2696 goto action (42); 2697 2698 make_call: /* this code is entered only for onsource & onchar pseudovariables */ 2699 if pl1_stat_$cur_statement -> statement.root -> operand (1) ^= input_tree 2700 & pl1_stat_$cur_statement -> statement.root -> operand (1) 2701 ^= input_tree -> reference.symbol -> symbol.token then 2702 if pl1_stat_$cur_statement -> statement.root -> op_code = assign then 2703 call semantic_translator$abort (187, builtin_symbol); 2704 else 2705 arg (1) = null; /* get list(onchar | onsource); */ 2706 2707 else do; /* onsource | onchar = ...; */ 2708 def_context.return_from_empty = "1"b; 2709 arg (1) = 2710 expression_semantics (cur_block, statement_ptr, 2711 (pl1_stat_$cur_statement -> statement.root -> operand (2)), "0"b); 2712 2713 if arg (1) -> node.type = token_node then 2714 arg (1) = convert (arg (1), char_mask); 2715 2716 if arg (1) -> node.type = operator_node then 2717 ref (1) = arg (1) -> operand (1); 2718 else 2719 ref (1) = arg (1); 2720 end; 2721 2722 if arg (1) = null | jump_index = 52 /* get list(onchar|onsource); | onsource = ...; */ then do; 2723 s = create_symbol (cur_block, null, by_compiler); 2724 s -> symbol.char, s -> symbol.auto, s -> symbol.passed_as_arg, s -> symbol.reference -> reference.shared = 2725 "1"b; 2726 2727 if jump_index = 52 then do; 2728 s -> symbol.varying = "1"b; 2729 s -> symbol.c_dcl_size = 256; 2730 end; 2731 else 2732 s -> symbol.c_dcl_size = 1; 2733 2734 s -> symbol.reference -> reference.c_length = s -> symbol.c_dcl_size; 2735 2736 call declare (s); 2737 2738 if ^def_context.return_from_empty then 2739 arg (1) = s -> symbol.reference; 2740 else do; 2741 p = create_operator (assign, 2); 2742 p -> operand (1) = s -> symbol.reference; 2743 p -> operand (2) = arg (1); 2744 2745 p -> operand (1) -> reference.c_length = t -> operand (1) -> reference.c_length; 2746 p -> operand (1) -> reference.length = share_expression ((t -> operand (1) -> reference.length)); 2747 2748 q = create_statement (assignment_statement, (statement_ptr -> statement.back), null, 2749 (statement_ptr -> statement.prefix)); 2750 q -> statement.root = p; 2751 2752 arg (1) = p -> operand (1); 2753 end; 2754 end; 2755 2756 tree = create_operator (std_call, 3); 2757 tree -> operand (2) = reserve$declare_lib ((reserved_number)); 2758 tree -> operand (3) = create_operator (std_arg_list, 3); 2759 tree -> operand (3) -> operand (1) = declare_temporary (storage_block_type, 4, 0, null); 2760 tree -> operand (3) -> operand (2) = create_list (1); 2761 tree -> operand (3) -> operand (2) -> element (1) = arg (1); 2762 2763 if ^def_context.return_from_empty then do; 2764 p = tree; 2765 tree = create_operator (join, 3); 2766 tree -> operand (1) = create_operator (assign, 2); 2767 tree -> operand (1) -> operand (1) = share_expression (arg (1)); 2768 tree -> operand (1) -> operand (2) = share_expression (t); 2769 /* result of create_call, to get_onchar or to getonsource */ 2770 tree -> operand (2) = share_expression (arg (1)); 2771 tree -> operand (3) = p; 2772 end; 2773 2774 goto exit; 2775 2776 action (53): /* oncode */ 2777 string (rtype) = integer_type; 2778 rprecision = default_fix_bin_p; 2779 2780 goto create_call; 2781 2782 action (54): /* acos 2783* asin 2784* atan 2785* atand 2786* cos 2787* cosd 2788* exp 2789* log 2790* log10 2791* log2 2792* sin 2793* sind 2794* sqrt 2795* tan 2796* tand */ 2797 if arg_number > 1 then 2798 rprecision = max (rprecision, arg_symbol (2) -> symbol.c_dcl_size); 2799 2800 if arg_type (1).complex then 2801 goto action (25); 2802 2803 goto create_operator_node; 2804 2805 action (55): /* after */ 2806 if arg_type (1).bit & arg_type (2).bit then 2807 string (type) = bit_mask; 2808 else 2809 string (type) = char_mask; 2810 2811 do i = 1 to 2; 2812 call convert_arg; 2813 end; 2814 2815 make_add: 2816 offset = create_operator (add, 3); 2817 offset -> operand (2) = create_index_or_verify (); 2818 offset -> operand (3) = declare_constant$integer (1); 2819 2820 tree = make_builtin_reference ("substr", 2, arg (1), offset, null); 2821 go to exit; 2822 2823 action (56): /* before */ 2824 if arg_type (1).bit & arg_type (2).bit then 2825 string (type) = bit_mask; 2826 else 2827 string (type) = char_mask; 2828 2829 do i = 1 to 2; 2830 call convert_arg; 2831 end; 2832 2833 tree = make_builtin_reference ("substr", 3, arg (1), declare_constant$integer (1), create_index_or_verify ()); 2834 go to exit; 2835 2836 action (57): /* ltrim */ 2837 if arg_number = 1 then 2838 arg (2) = declare_constant$char (" "); /* */ 2839 2840 go to make_add; 2841 2842 action (58): /* rtrim */ 2843 if arg_number = 1 then 2844 arg (2) = declare_constant$char (" "); /* */ 2845 2846 if ref (1) -> reference.varying_ref then 2847 p = create_length_fun (arg (1)); 2848 else if ref (1) -> reference.length = null then 2849 p = declare_constant$integer ((ref (1) -> reference.c_length)); 2850 else 2851 p = share_expression ((ref (1) -> reference.length)); 2852 2853 length = create_operator (sub, 3); 2854 length -> operand (2) = p; 2855 length -> operand (3) = create_index_or_verify (); 2856 2857 tree = make_builtin_reference ("substr", 3, arg (1), declare_constant$integer (1), length); 2858 go to exit; 2859 2860 action (59): /* collate9 */ 2861 tree = declare_constant$char (pl1_data$long_collating_sequence); 2862 2863 goto ret; 2864 2865 action (60): /* high9 */ 2866 arg (2) = arg (1); 2867 ref (2) = ref (1); 2868 arg_symbol (2) = arg_symbol (1); 2869 2870 arg (1), ref (1) = declare_constant ("111111111"b, char_type, 1, 0); 2871 arg_symbol (1) = ref (1) -> reference.symbol; 2872 2873 arg_number = 2; 2874 string (rtype) = char_type; 2875 2876 goto repeat; 2877 2878 action (61): /* stackbaseptr */ 2879 /* stackframeptr */ 2880 go to prepare_pointer; 2881 2882 action (62): /* clock */ 2883 /* vclock */ 2884 string (rtype) = integer_type; 2885 rprecision = 71; 2886 go to create_operator_node; 2887 2888 action (63): /* codeptr */ 2889 /* environmentptr */ 2890 go to prepare_pointer; 2891 2892 action (66): /* stacq */ 2893 string (rtype) = bit_mask; 2894 rprecision = 1; 2895 go to create_operator_node; 2896 2897 action (67): /* substraddr */ 2898 go to err359; 2899 2900 action (68): /* byte */ 2901 string (rtype) = char_type; 2902 rprecision = 1; 2903 go to create_operator_node; 2904 2905 action (69): /* rank */ 2906 if ^constant_length (ref (1), 1) then 2907 call semantic_translator$abort (390, arg_symbol (1)); 2908 /* first arg to rank must be char(1) */ 2909 2910 string (rtype) = integer_type; 2911 rprecision = 9; 2912 go to create_operator_node; 2913 2914 prepare_pointer: 2915 rprecision, rscale = 0; 2916 2917 rlength = null; 2918 2919 string (rtype) = pointer_type; 2920 2921 goto create_operator_node; 2922 2923 create_call: 2924 p = create_list (arg_number + 1); 2925 do i = 1 to arg_number; 2926 p -> element (i) = arg (i); 2927 end; 2928 2929 tree = create_operator (std_call, 3); 2930 tree -> operand (2) = reserve$declare_lib ((reserved_number)); 2931 2932 if jump_index = 24 /* decat */ | jump_index = 25 /* math bifs */ | jump_index = 26 /* lbound, hbound, dim */ 2933 then do; 2934 tree -> operand (2) -> reference.symbol -> symbol.irreducible = "0"b; 2935 tree -> operand (2) -> reference.symbol -> symbol.reducible = "1"b; 2936 end; 2937 2938 tree -> operand (3) = create_operator (std_arg_list, 3); 2939 tree -> operand (3) -> operand (2) = p; 2940 2941 if desc_reqd then do; 2942 2943 /* we will have star extents return value */ 2944 2945 tree -> operand (3) -> operand (1) = declare_temporary (storage_block_type, 4 * arg_number + 6, 0, null); 2946 q, tree -> operand (3) -> operand (3) = create_list (arg_number + 1); 2947 2948 s = create_symbol (cur_block, null, by_compiler); 2949 2950 string (s -> symbol.data_type) = string (arg_symbol (1) -> symbol.data_type); 2951 string (s -> symbol.misc_attributes) = string (arg_symbol (1) -> symbol.misc_attributes); 2952 2953 s -> symbol.dimensioned, s -> symbol.initialed, s -> symbol.variable, s -> symbol.position, 2954 s -> symbol.internal, s -> symbol.external, s -> symbol.like, s -> symbol.member = "0"b; 2955 2956 s -> symbol.return_value, s -> symbol.passed_as_arg, s -> symbol.star_extents = "1"b; 2957 2958 s -> symbol.dcl_size = create_token ("*", asterisk); 2959 2960 call declare (s); 2961 2962 q -> element (arg_number + 1) = s -> symbol.descriptor; 2963 2964 do i = 1 to arg_number; 2965 q -> element (i) = 2966 declare_descriptor (cur_block, statement_ptr, arg_symbol (i), (ref (i) -> reference.qualifier), 2967 "0"b); 2968 end; 2969 2970 p -> element (p -> list.number), tree -> operand (1) = s -> symbol.reference; 2971 2972 tree -> operand (1) -> reference.ref_count = 3; 2973 tree -> operand (1) -> reference.shared = "0"b; 2974 tree -> operand (1) -> reference.length -> operand (1) = 2975 declare_temporary (integer_type, max_offset_precision, 0, null); 2976 tree -> operand (1) -> reference.length -> operator.processed = "1"b; 2977 2978 call check_star_extents ((tree -> operand (2) -> reference.symbol), p); 2979 2980 statement_ptr -> statement.force_nonquick = "1"b; 2981 call make_non_quick ((statement_ptr -> statement.root), "001"b); 2982 2983 p = create_statement (call_statement, (statement_ptr -> statement.back), null, 2984 (statement_ptr -> statement.prefix)); 2985 p -> statement.root = tree; 2986 p -> statement.processed = "1"b; 2987 end; 2988 else do; 2989 t = declare_temporary (string (rtype), rprecision, (rscale), rlength); 2990 s = copy_expression (t -> reference.symbol); 2991 s -> symbol.passed_as_arg = "1"b; 2992 q = s -> symbol.reference; 2993 q -> reference.shared = "0"b; 2994 q -> reference.ref_count = 2; 2995 2996 p -> element (p -> list.number), tree -> operand (1) = q; 2997 2998 temp_size = 2 * (arg_number + 1) + 2; 2999 3000 if jump_index = 26 /* hbound, lbound, dim */ then do; 3001 3002 /* this has star_extent args but constant extent return_value */ 3003 3004 temp_size = 4 * (arg_number + 1) + 2; 3005 3006 tree -> operand (3) -> operand (3), q = create_list (arg_number + 1); 3007 3008 ref (5) = q; 3009 arg_symbol (5) = s; 3010 3011 do i = 1 to q -> list.number; 3012 q -> element (i) = 3013 declare_descriptor (cur_block, statement_ptr, arg_symbol (i), 3014 (ref (i) -> reference.qualifier), (ref (i) -> reference.array_ref)); 3015 end; 3016 end; 3017 3018 tree -> operand (3) -> operand (1) = declare_temporary (storage_block_type, temp_size, 0, null); 3019 end; 3020 3021 if def_context.left_side /* only onchar and onsource has this property */ then do; 3022 if jump_index = 51 /* onchar */ then 3023 reserved_number = 11; /* on_data_$set_onchar */ 3024 else 3025 reserved_number = 194; /* on_data_$setonsource */ 3026 3027 tree -> operand (2) -> reference.symbol -> symbol.irreducible = "1"b; 3028 t = tree; 3029 3030 goto make_call; 3031 end; 3032 3033 goto exit; 3034 3035 create_assign: 3036 t = create_operator (assign, 2); 3037 t -> operand (1) = declare_temporary (integer_type, max_offset_precision, 0, null); 3038 t -> operand (2) = arg (1); 3039 3040 tree = t; 3041 3042 goto exit; 3043 3044 convert_to_arith: 3045 arith_size_ck = "1"b; /* This makes us check size-enabled after assign_op is made */ 3046 string (rtype) = string (rtype) | aligned_mask; 3047 3048 if arg_type (1).char then 3049 defined_arg_type (1) = fixed_decimal_real_mask; 3050 else if arg_type (1).bit then 3051 defined_arg_type (1) = fixed_binary_real_mask; 3052 else if arg_type (1).picture then 3053 if arg_symbol (1) -> symbol.complex then 3054 if arg_symbol (1) -> symbol.pix.pic_float then 3055 defined_arg_type (1) = float_decimal_complex_mask; 3056 else 3057 defined_arg_type (1) = fixed_decimal_complex_mask; 3058 else if arg_symbol (1) -> symbol.pix.pic_float then 3059 defined_arg_type (1) = float_decimal_real_mask; 3060 else 3061 defined_arg_type (1) = fixed_decimal_real_mask; 3062 3063 if ^rtype.fixed & ^rtype.float then do; 3064 rtype.fixed = arg_type (1).fixed; 3065 rtype.float = arg_type (1).float; 3066 end; 3067 3068 if ^rtype.decimal & ^rtype.binary then do; 3069 rtype.decimal = arg_type (1).decimal; 3070 rtype.binary = arg_type (1).binary; 3071 end; 3072 3073 if ^rtype.real & ^rtype.complex then do; 3074 rtype.real = arg_type (1).real; 3075 rtype.complex = arg_type (1).complex; 3076 end; 3077 3078 full_attribute_set = arg_number > 1; 3079 3080 check_prec_scale: 3081 rlength = null; 3082 3083 if rscale < min_scale | rscale > max_scale then 3084 goto err146; 3085 3086 if rtype.decimal then 3087 if rprecision > max_p_dec then 3088 goto err146; 3089 else 3090 ; 3091 3092 else if rtype.fixed then 3093 if rprecision > max_p_fix_bin_2 then 3094 goto err146; 3095 else 3096 ; 3097 else if rprecision > max_p_flt_bin_2 then 3098 goto err146; 3099 3100 convert_label: 3101 if rprecision < 0 then 3102 goto err481; 3103 3104 if full_attribute_set then do; 3105 t = declare_temporary (string (rtype), rprecision, (rscale), rlength); 3106 tree = convert$to_target_fb (arg (1), t); 3107 end; 3108 else 3109 tree = convert$from_builtin (arg (1), string (rtype)); 3110 3111 goto ret; 3112 3113 create_operator_node: 3114 if rprecision < 0 then 3115 goto err481; 3116 3117 t = declare_temporary (string (rtype), rprecision, (rscale), rlength); 3118 3119 tree = create_operator (opcode, arg_number + 1); 3120 tree -> operand (1) = t; 3121 3122 do i = 1 to arg_number; 3123 tree -> operand (i + 1) = arg (i); 3124 end; 3125 3126 tree -> operator.processed = "1"b; 3127 3128 goto exit; 3129 3130 return_arg1: 3131 tree = arg (1); 3132 3133 goto ret; 3134 3135 expand_arguments: 3136 proc () returns (ptr); 3137 3138 dcl (p, q, r) ptr, 3139 (lpp, jpp) ptr init (null), 3140 (lp, jp, cp) (128) ptr init ((128) null), 3141 (i, j, k, lll) fixed bin (15), 3142 (jcount, lcount) fixed bin (15) init (0), 3143 ll (128) fixed bin (15) init ((128) 0); 3144 3145 dcl (full_processing, pure_array) bit (1) aligned init ("0"b); 3146 3147 do i = 1 to arg_number; 3148 p = subscripts -> element (i); 3149 3150 if p -> node.type = operator_node then 3151 if p -> op_code = loop then do; 3152 lp (i) = p; 3153 lcount = lcount + 1; 3154 3155 do q = p repeat q -> operand (1) while (q -> op_code = loop); 3156 ll (i) = ll (i) + 1; 3157 end; 3158 3159 p = q; 3160 3161 if lpp = null then do; 3162 lpp = lp (i); 3163 lll = ll (i); 3164 end; 3165 end; 3166 3167 if p -> node.type = operator_node then 3168 if p -> op_code = join then do; 3169 jp (i) = p; 3170 jcount = jcount + 1; 3171 end; 3172 3173 if jp (i) ^= null then 3174 if jpp = null then 3175 jpp = p; 3176 else 3177 ; 3178 else 3179 cp (i) = p; 3180 3181 if lp (i) ^= null & cp (i) ^= null then 3182 pure_array = "1"b; 3183 end; 3184 3185 if lpp ^= null then 3186 do i = 1 to arg_number; 3187 if ll (i) ^= lll & ll (i) ^= 0 then 3188 call semantic_translator$abort (79, null); 3189 end; 3190 3191 if pure_array then 3192 if jpp ^= null then 3193 call semantic_translator$abort (79, null); 3194 else do; 3195 p = create_list ((arg_number)); 3196 do i = 1 to arg_number; 3197 p -> element (i) = cp (i); 3198 end; 3199 3200 p = builtin (cur_block, statement_ptr, tree, p, builtin_symbol, "0"b); 3201 end; 3202 3203 if jpp ^= null then 3204 jpp = merge (jpp, jp); 3205 3206 if lpp = null then 3207 return (jpp); 3208 3209 q = lpp; 3210 3211 do i = 2 to lll; 3212 q = q -> operand (1); 3213 end; 3214 3215 if jpp ^= null then 3216 q -> operand (1) = jpp; 3217 else 3218 q -> operand (1) = p; 3219 3220 if lcount = 1 then 3221 return (lpp); 3222 3223 do i = 1 to arg_number; 3224 3225 p = lpp; 3226 q = lp (i); 3227 3228 if q ^= null & q ^= p then 3229 do j = 1 to lll; 3230 3231 if ^compare_expression ((p -> operand (4)), (q -> operand (4))) then do; 3232 if p -> operand (4) -> node.type = reference_node then 3233 if p -> operand (4) -> reference.symbol -> symbol.constant then 3234 if q -> operand (4) -> node.type = reference_node then 3235 if q -> operand (4) -> reference.symbol -> symbol.constant then 3236 call semantic_translator$abort (79, null); 3237 3238 full_processing = "1"b; 3239 end; 3240 3241 p = p -> operand (1); 3242 q = q -> operand (1); 3243 end; 3244 end; 3245 3246 if ^full_processing then 3247 return (lpp); 3248 3249 if lcount = 2 then do; 3250 p = lpp; 3251 q = null; 3252 3253 do i = arg_number to 1 by -1 while (q = null); 3254 q = lp (i); 3255 end; 3256 3257 do i = 1 to lll; 3258 3259 jpp = create_operator (bound_ck, 4); 3260 jpp -> operand (1) = declare_temporary (integer_type, default_fix_bin_p, 0, null); 3261 jpp -> operand (2) = p -> operand (4); 3262 jpp -> operand (3) = q -> operand (4); 3263 jpp -> operand (4) = share_expression ((q -> operand (4))); 3264 3265 p -> operand (4) = jpp; 3266 p = p -> operand (1); 3267 q = q -> operand (1); 3268 end; 3269 3270 return (lpp); 3271 end; 3272 3273 r = lpp; 3274 3275 do i = 1 to lll; 3276 3277 jpp = create_operator (bound_ck, 4); 3278 p = create_operator (min_fun, lcount + 1); 3279 q = create_operator (max_fun, lcount + 1); 3280 p -> operand (1), q -> operand (1), jpp -> operand (1) = 3281 declare_temporary (integer_type, default_fix_bin_p, 0, null); 3282 jpp -> operand (2) = p; 3283 jpp -> operand (3) = q; 3284 jpp -> operand (4) = share_expression (q); 3285 3286 r -> operand (4) = jpp; 3287 r = r -> operand (1); 3288 3289 k = 2; 3290 3291 do j = 1 to arg_number; 3292 if lp (j) ^= null then do; 3293 p -> operand (k) = share_expression ((lp (j) -> operand (4))); 3294 q -> operand (k) = share_expression ((lp (j) -> operand (4))); 3295 3296 k = k + 1; 3297 lp (j) = lp (j) -> operand (1); 3298 end; 3299 end; 3300 end; 3301 3302 return (lpp); 3303 3304 merge: 3305 proc (p, rp) returns (ptr); 3306 3307 dcl ( 3308 p, 3309 pp, 3310 q, 3311 o1, 3312 o2, 3313 o3, 3314 rp (128), 3315 rpp (128) 3316 ) ptr, 3317 (i, j, k) fixed bin (15), 3318 unmatch_bound bit (1) aligned init ("0"b); 3319 3320 if p -> node.type = operator_node then do; 3321 if p -> op_code = loop then do; 3322 do i = 1 to arg_number; 3323 if cp (i) = null then do; 3324 if rp (i) -> node.type ^= operator_node then 3325 call semantic_translator$abort (79, null); 3326 if rp (i) -> op_code ^= loop then 3327 call semantic_translator$abort (79, null); 3328 3329 if ^compare_expression ((p -> operand (4)), (rp (i) -> operand (4))) then 3330 unmatch_bound = "1"b; 3331 end; 3332 end; 3333 3334 if unmatch_bound then do; 3335 o1 = create_operator (bound_ck, 4); 3336 o2 = create_operator (min_fun, jcount + 1); 3337 o3 = create_operator (max_fun, jcount + 1); 3338 3339 o2 -> operand (1), o3 -> operand (1), o1 -> operand (1) = 3340 declare_temporary (integer_type, default_fix_bin_p, 0, null); 3341 o1 -> operand (2) = o2; 3342 o1 -> operand (3) = o3; 3343 o1 -> operand (4) = share_expression (o3); 3344 3345 k = 2; 3346 3347 do i = 1 to arg_number; 3348 if cp (i) = null then do; 3349 o2 -> operand (k) = share_expression ((rp (i) -> operand (4))); 3350 o3 -> operand (k) = share_expression ((rp (i) -> operand (4))); 3351 k = k + 1; 3352 end; 3353 end; 3354 3355 p -> operand (4) = o1; 3356 end; 3357 3358 pp = p -> operand (1); 3359 3360 do i = 1 to arg_number; 3361 if cp (i) = null then 3362 rpp (i) = rp (i) -> operand (1); 3363 end; 3364 3365 p -> operand (1) = merge (pp, rpp); 3366 3367 return (p); 3368 end; 3369 3370 if p -> op_code = join then do; 3371 do i = 1 to arg_number; 3372 if cp (i) = null then do; 3373 if rp (i) -> node.type ^= operator_node then 3374 call semantic_translator$abort (79, null); 3375 if rp (i) -> op_code ^= join then 3376 call semantic_translator$abort (79, null); 3377 end; 3378 end; 3379 3380 do j = 1 to p -> operator.number; 3381 pp = p -> operand (j); 3382 3383 do i = 1 to arg_number; 3384 if cp (i) = null then 3385 rpp (i) = rp (i) -> operand (j); 3386 else if j > 1 then 3387 cp (i) = share_expression (cp (i)); 3388 end; 3389 3390 p -> operand (j) = merge (pp, rpp); 3391 end; 3392 3393 return (p); 3394 end; 3395 end; 3396 3397 do i = 1 to arg_number; 3398 if cp (i) = null then 3399 if rp (i) -> node.type = operator_node then 3400 if rp (i) -> op_code = loop | rp (i) -> op_code = join then 3401 call semantic_translator$abort (79, null); 3402 end; 3403 3404 q = create_list ((arg_number)); 3405 3406 do i = 1 to arg_number; 3407 if cp (i) = null then 3408 q -> element (i) = rp (i); 3409 else 3410 q -> element (i) = cp (i); 3411 end; 3412 3413 return (builtin (cur_block, statement_ptr, tree, q, builtin_symbol, "0"b)); 3414 3415 end merge; 3416 3417 end expand_arguments; 3418 3419 check_reverse: 3420 proc (p) returns (bit (1) aligned); 3421 3422 /* See if pointer points to a call on reverse operator, unshared */ 3423 dcl p ptr; 3424 3425 if p -> node.type = operator_node then 3426 if p -> operator.op_code = reverse_fun then 3427 if p -> operator.operand (1) -> reference.shared 3428 | p -> operator.operand (1) -> reference.ref_count = 1 then 3429 return ("1"b); 3430 return ("0"b); 3431 3432 end check_reverse; 3433 3434 is_this_constant: 3435 proc (p) returns (bit (1) aligned); 3436 3437 dcl p ptr; 3438 3439 if p -> node.type = reference_node then 3440 if p -> reference.symbol -> symbol.constant then 3441 if ^p -> reference.varying_ref then 3442 if p -> reference.length = null & p -> reference.offset = null & p -> reference.c_offset = 0 then 3443 return ("1"b); 3444 return ("0"b); 3445 3446 end is_this_constant; 3447 3448 check_strings: 3449 proc (pt); 3450 3451 dcl (p, pt) ptr; 3452 3453 p = pt; 3454 3455 do while (p ^= null); 3456 3457 if p -> symbol.structure then 3458 call check_strings ((p -> symbol.son)); 3459 3460 else if units = bit_ & ^p -> symbol.bit | units = character_ & ^p -> symbol.char & ^p -> symbol.picture 3461 then 3462 call semantic_translator$abort (139, arg_symbol (1)); 3463 3464 p = p -> symbol.brother; 3465 end; 3466 3467 end check_strings; 3468 3469 convert_arg: 3470 proc; 3471 3472 dcl suppress_diagnostic bit (1) aligned; 3473 3474 if defined_arg_type (i) & structure_mask then 3475 return; 3476 3477 if string (type) & arithmetic_mask then do; 3478 if defined_arg_type (i) & arithmetic_mask then 3479 ; 3480 else if arg_type (i).bit then do; 3481 type.fixed = ^type.float; 3482 type.binary = ^type.decimal; 3483 type.real = ^type.complex; 3484 end; 3485 3486 else if arg_type (i).char then do; 3487 type.fixed = ^type.float; 3488 type.decimal = ^type.binary; 3489 type.real = ^type.complex; 3490 end; 3491 3492 if ^type.fixed & ^type.float then do; 3493 type.fixed = arg_type (i).fixed; 3494 type.float = arg_type (i).float; 3495 end; 3496 3497 if ^type.decimal & ^type.binary then do; 3498 type.decimal = arg_type (i).decimal; 3499 type.binary = arg_type (i).binary; 3500 end; 3501 3502 if ^type.real & ^type.complex then do; 3503 type.real = arg_type (i).real; 3504 type.complex = arg_type (i).complex; 3505 end; 3506 end; 3507 3508 suppress_diagnostic = i = 1 & (jump_index = 17 | jump_index = 19); 3509 3510 if arg (i) -> node.type = token_node then 3511 if suppress_diagnostic then 3512 arg (i) = convert$from_builtin (arg (i), string (type)); 3513 else 3514 arg (i) = convert (arg (i), string (type)); 3515 3516 else if type.decimal & arg_type (i).decimal & ^arg_symbol (i) -> symbol.char then 3517 ; 3518 else if type.binary & arg_type (i).binary & type.real = arg_type (i).real & type.fixed = arg_type (i).fixed then 3519 ; 3520 else if suppress_diagnostic then 3521 arg (i) = convert$from_builtin (arg (i), string (type)); 3522 else 3523 arg (i) = convert (arg (i), string (type)); 3524 3525 ref (i) = arg (i); 3526 defined_arg_type (i) = string (type); 3527 3528 if ref (i) -> node.type = operator_node then do; 3529 ref (i) -> operator.processed = "1"b; /* to prevent operator_semantics from calling convert$validate */ 3530 ref (i) = ref (i) -> operand (1); 3531 end; 3532 3533 arg_symbol (i) = ref (i) -> reference.symbol; 3534 3535 end convert_arg; 3536 3537 make_assignment: 3538 proc; 3539 3540 p = create_operator (assign, 2); 3541 r = create_symbol (null, null, by_compiler); 3542 r -> symbol.temporary = "1"b; 3543 p -> operand (1) = r -> symbol.reference; 3544 p -> operand (2) = arg (1); 3545 3546 r = create_statement (assignment_statement, (statement_ptr -> statement.back), null, 3547 (statement_ptr -> statement.prefix)); 3548 r -> statement.root = p; 3549 r -> statement.generated = "1"b; 3550 3551 if arg (1) -> node.type = operator_node then 3552 if arg (1) -> operator.op_code = loop | arg (1) -> operator.op_code = join then do; 3553 def_this_context.RHS_aggregate = "1"b; 3554 3555 r -> statement.root = expand_assign (cur_block, r, (r -> statement.root), this_context, agg_ref); 3556 return; 3557 end; 3558 3559 r -> statement.root = operator_semantics (cur_block, r, (r -> statement.root), this_context); 3560 agg_ref = r -> statement.root -> operand (1); 3561 if agg_ref -> reference.shared then do; 3562 agg_ref -> reference.shared = "0"b; 3563 agg_ref -> reference.ref_count = 1; 3564 end; 3565 3566 end make_assignment; 3567 3568 /* */ 3569 declare_defined_overlay: 3570 proc (p_type, p_precision, p_scale, p_length, qual) returns (ptr); 3571 3572 /* pools defined overlays in a similar fashion as declare_temporary 3573* pools temporarys. Used for unspec, string, imag, real */ 3574 3575 dcl p_type bit (36) aligned, 3576 (p_precision, precision) fixed bin (31), 3577 (p_scale, scale) fixed bin (15), 3578 (p_length, length) ptr, 3579 qual ptr; 3580 3581 dcl units fixed bin (3); 3582 dcl c_offset fixed bin (24); 3583 dcl (r, s, t) ptr; 3584 dcl pl1_stat_$defined_list ptr ext; 3585 dcl (addr, null) builtin; 3586 dcl bit36 bit (36) based (addr (s -> symbol.data_type)); 3587 dcl found bit (1) aligned; 3588 3589 /* Assumption: if length is not null, then length must not be an 3590* unshared processed tree, because otherwise ref_count goes too 3591* high */ 3592 3593 precision = p_precision; 3594 scale = p_scale; 3595 length = p_length; 3596 3597 /* the qualifier's units and c_offset are used so that simplify_offset 3598* will correctly handle cases of substr(string(..),...) */ 3599 3600 if qual -> node.type = reference_node then do; 3601 units = qual -> reference.units; 3602 c_offset = qual -> reference.c_offset; 3603 end; 3604 else 3605 units, c_offset = 0; 3606 3607 found = "0"b; 3608 3609 /* search for suitable symbol */ 3610 3611 s = pl1_stat_$defined_list; 3612 3613 do while (s ^= null & ^found); 3614 if bit36 = p_type & s -> symbol.position = "1"b & s -> symbol.c_dcl_size = precision 3615 & s -> symbol.scale = scale & s -> symbol.dcl_size = length 3616 & s -> symbol.reference -> reference.shared & s -> symbol.reference -> reference.c_offset = c_offset 3617 & s -> symbol.reference -> reference.units = units then 3618 found = "1"b; 3619 else 3620 s = s -> symbol.multi_use; 3621 end; 3622 3623 if ^found then do; 3624 3625 /* None found -- make one with declare_temporary's help. 3626* Note that although declare_temporary makes unshared 3627* temporaries if length ^= null, that they are unique. */ 3628 3629 r = copy_expression (declare_temporary (p_type, precision, scale, length)); 3630 3631 s = create_symbol (null, null, by_compiler); 3632 t = r -> reference.symbol; 3633 s -> symbol = t -> symbol; 3634 s -> symbol.next = null; 3635 s -> symbol.reference = r; 3636 r -> reference.symbol = s; 3637 r -> reference.units = units; 3638 r -> reference.c_offset = c_offset; 3639 3640 s -> symbol.packed = s -> symbol.unaligned; 3641 s -> symbol.defined, s -> symbol.overlayed, s -> symbol.position = "1"b; 3642 s -> symbol.temporary = "0"b; 3643 3644 s -> symbol.multi_use = pl1_stat_$defined_list; 3645 pl1_stat_$defined_list = s; 3646 end; 3647 3648 /* we need a unique reference node */ 3649 3650 r = copy_expression (s -> symbol.reference); 3651 r -> reference.shared = "0"b; 3652 r -> reference.ref_count = 1; 3653 r -> reference.units = 0; 3654 r -> reference.c_offset = 0; 3655 3656 return (r); 3657 3658 end; 3659 3660 /* subroutine to create a length_fun operator and return a ptr to it */ 3661 3662 create_length_fun: 3663 proc (op2) returns (ptr); 3664 3665 dcl (op2, p) pointer; 3666 p = create_operator (length_fun, 2); 3667 p -> operand (1) = declare_temporary (integer_type, max_length_precision, 0, null); 3668 p -> operand (2) = share_expression (op2); 3669 p -> operator.processed = "1"b; 3670 return (p); 3671 end create_length_fun; 3672 3673 3674 3675 3676 3677 3678 /* subroutine to increment a reference node's qualifier and offset's reference count */ 3679 3680 reuse_qual_and_offset: 3681 proc (p_param); 3682 3683 dcl (p, p_param) ptr; 3684 3685 p = p_param; 3686 3687 if p -> reference.qualifier ^= null then 3688 p -> reference.qualifier = share_expression ((p -> reference.qualifier)); 3689 if p -> reference.offset ^= null then 3690 p -> reference.offset = share_expression ((p -> reference.offset)); 3691 3692 end reuse_qual_and_offset; 3693 3694 3695 /* function to see if a symbol represents an unpacked real fixed binary integer value */ 3696 3697 fb1_value: 3698 proc (s) returns (bit (1) aligned); 3699 3700 dcl s ptr; 3701 3702 if s -> symbol.fixed & s -> symbol.binary & ^s -> symbol.complex & ^s -> symbol.packed 3703 & s -> symbol.c_dcl_size <= max_p_fix_bin_1 & s -> symbol.scale = 0 then 3704 return ("1"b); 3705 3706 else 3707 return ("0"b); 3708 3709 end fb1_value; 3710 3711 3712 /* function to create an index or verify operator and operands for after, before, ltrim, or rtrim */ 3713 3714 create_index_or_verify: 3715 proc returns (ptr); 3716 3717 dcl p ptr; 3718 3719 p = create_operator (opcode, 3); 3720 p -> operand (1) = declare_temporary (fixed_binary_real_mask, max_length_precision, 0, null); 3721 p -> operand (2) = share_expression (arg (1)); 3722 p -> operand (3) = arg (2); 3723 p -> operator.processed = "1"b; 3724 return (p); 3725 3726 end create_index_or_verify; 3727 3728 /* get the initial value of a fixed binary integer variable with a scale factor of zero */ 3729 3730 constant_value: 3731 procedure (sym_ptr) returns (fixed bin (17)); 3732 3733 /* parameter */ 3734 3735 dcl sym_ptr ptr; 3736 3737 /* based */ 3738 3739 dcl integer_1 based fixed bin (35); 3740 dcl integer_2 based fixed bin (71); 3741 3742 /* constant */ 3743 3744 dcl max_24_bit_integer fixed bin (24) int static options (constant) init (111111111111111111111111b); 3745 3746 /* builtin */ 3747 3748 dcl abs builtin; 3749 3750 /* automatic */ 3751 3752 dcl initial_value fixed bin (71); 3753 3754 dcl convert builtin; 3755 3756 /* Accept the constant's bit pattern. */ 3757 3758 if sym_ptr -> symbol.constant then 3759 if sym_ptr -> symbol.c_dcl_size > max_p_fix_bin_1 then 3760 initial_value = sym_ptr -> symbol.initial -> integer_2; 3761 else 3762 initial_value = sym_ptr -> symbol.initial -> integer_1; 3763 3764 /* Convert the symbol's initializing token string. */ 3765 3766 else if sym_ptr -> symbol.alloc_in_text then 3767 if sym_ptr -> symbol.initial -> list.element (1) -> token.string = "1" then 3768 initial_value = 3769 convert (initial_value, sym_ptr -> symbol.initial -> list.element (2) -> token.string); 3770 3771 else 3772 initial_value = max_24_bit_integer + 1; /* ERROR */ 3773 else 3774 initial_value = max_24_bit_integer + 1; /* ERROR */ 3775 3776 if abs (initial_value) > max_24_bit_integer then 3777 go to err146; 3778 3779 return (initial_value); 3780 3781 end /* constant_value */; 3782 3783 /* Return true if symbol is a constant. */ 3784 3785 symbol_is_constant: 3786 proc (sym_ptr) returns (bit (1)); 3787 3788 dcl sym_ptr ptr; 3789 3790 if sym_ptr -> symbol.constant | (sym_ptr -> symbol.alloc_in_text & sym_ptr -> symbol.array = null ()) then 3791 return ("1"b); 3792 else 3793 return ("0"b); 3794 end symbol_is_constant; /* */ 3795 make_builtin_reference: 3796 proc (builtin_name, nargs, arg1, arg2, arg3) returns (ptr); 3797 3798 /* constructs a builtin reference and processes it. the context given to builtin 3799* is passed through */ 3800 3801 dcl builtin_name char (*), 3802 nargs fixed bin (15), 3803 (arg1, arg2, arg3) ptr; 3804 3805 dcl (p, s, subs) ptr; 3806 dcl (i, n) fixed bin (15); 3807 3808 /* since we don't know if the builtin is declared, we declare 3809* a special symbol in the root block */ 3810 3811 n = nargs; 3812 p = create_token ("cp.bif." || builtin_name, identifier); 3813 3814 if p -> token.declaration = null then do; 3815 3816 /* we must make a symbol */ 3817 3818 do i = number_of_names to 1 by -1 while (pl1_data$builtin_name (i).name ^= builtin_name); 3819 end; 3820 3821 s = create_symbol ((pl1_stat_$root), p, by_compiler); 3822 3823 s -> symbol.builtin = "1"b; 3824 s -> symbol.c_dcl_size = i; 3825 p -> token.declaration = s; 3826 end; 3827 3828 else 3829 s = p -> token.declaration; 3830 3831 subs = create_list (n); 3832 if n > 0 then do; 3833 subs -> element (n) = arg1; 3834 if n > 1 then do; 3835 subs -> element (n - 1) = arg2; 3836 if n > 2 then 3837 subs -> element (n - 2) = arg3; 3838 end; 3839 end; 3840 3841 return (builtin (cur_block, statement_ptr, (s -> symbol.reference), subs, s, context)); 3842 3843 end; 3844 3845 /* */ 3846 err124: 3847 error_number = 124; 3848 goto abort; 3849 3850 err146: 3851 error_number = 146; 3852 goto abort; 3853 3854 err481: 3855 error_number = 481; 3856 goto abort; 3857 3858 err359: 3859 error_number = 359; 3860 goto abort; 3861 3862 err381: 3863 error_number = 381; 3864 goto abort; 3865 3866 abort: 3867 call semantic_translator$abort (error_number, builtin_symbol); 3868 3869 ret: 3870 if def_context.arg_list & tree -> node.type = reference_node & ^pseudo_variable then do; 3871 arg (1) = tree; 3872 string (rtype) = string (tree -> reference.symbol -> symbol.attributes); 3873 if jump_index ^= 46 /* we dont change result type for convert! */ then 3874 rtype.varying = "0"b; 3875 arg_number = 1; 3876 opcode = assign; 3877 goto create_operator_node; 3878 end; 3879 3880 if arith_size_ck then /* since we will mark the operator as processed, we must do the */ 3881 /* work of op_semantics in changeing an assign to an assign_size_ck */ 3882 /* if size or stringrange are enabled and the left hand side of the */ 3883 /* assignment is subject to the condition. */ 3884 if substr (statement_ptr -> statement.prefix, 6, 1) then 3885 if arg_type (1).fixed | arg_type (1).float then 3886 if tree -> node.type = operator_node then 3887 if tree -> operator.op_code = assign then 3888 tree -> operator.op_code = assign_size_ck; 3889 3890 if string_size_ck then 3891 if substr (statement_ptr -> statement.prefix, 9, 1) then 3892 if arg_type (1).char | arg_type (1).bit then 3893 if tree -> node.type = operator_node then 3894 if tree -> operator.op_code = assign then 3895 tree -> operator.op_code = assign_size_ck; 3896 3897 exit: 3898 if decimal_result then do; 3899 targ_type = targ_type & ^dimensioned_mask & ^initialed_mask; 3900 t = declare_temporary (targ_type, targ_prec, 0, null); 3901 tree = convert$to_target_fb (tree, t); 3902 end; 3903 3904 if tree -> node.type = operator_node then 3905 tree -> operator.processed = "1"b; 3906 else 3907 tree -> reference.processed = "1"b; 3908 3909 return (tree); 3910 3911 /* include files */ 3912 1 1 /* BEGIN INCLUDE FILE ... semant.incl.pl1 */ 1 2 1 3 /* Modified: 30 Aug 1979 by PCK to fix 1804 and 1823 */ 1 4 /* Modified: 26 Aug 1979 by PCK to implement by name assignment */ 1 5 1 6 1 7 declare alloc_semantics entry(pointer,pointer,pointer); 1 8 /* parameter 1: (input) block node pointer */ 1 9 /* parameter 2: (input) statement node pointer */ 1 10 /* parameter 3: (in/out) tree pointer */ 1 11 1 12 declare alloc_semantics$init_only entry(pointer,pointer,pointer); 1 13 /* parameter 1: (input) qualifier pointer */ 1 14 /* parameter 2: (input) statement node pointer */ 1 15 /* parameter 3: (input) symbol node pointer */ 1 16 1 17 declare builtin entry(pointer,pointer,pointer,pointer,pointer,bit(36) aligned) 1 18 returns(pointer); 1 19 /* parameter 1: (input) block node pointer */ 1 20 /* parameter 2: (input) statement node pointer */ 1 21 /* parameter 3: (input) tree pointer */ 1 22 /* parameter 4: (input) subscript pointer */ 1 23 /* parameter 5: (input) builtin symbol node pointer */ 1 24 /* parameter 6: (in/out) context */ 1 25 /* return: (output) tree pointer */ 1 26 1 27 declare check_star_extents entry(pointer,pointer); 1 28 /* parameter 1: (input) symbol node of procedure */ 1 29 /* parameter 2: (input) argument list pointer */ 1 30 1 31 declare compare_declaration entry(pointer,pointer,bit(1) aligned) reducible 1 32 returns(bit(1) aligned); 1 33 /* parameter 1: (input) reference or symbol node ptr */ 1 34 /* parameter 2: (input) symbol node ptr */ 1 35 /* parameter 3: (input) "1"b if aligned attribute ignored for string */ 1 36 /* return: (output) compare bit */ 1 37 1 38 declare context_processor entry(pointer,label); 1 39 /* parameter 1: (input) root block node pointer */ 1 40 1 41 declare declare entry(pointer); 1 42 /* parameter 1: (input) symbol node pointer */ 1 43 1 44 declare declare_structure entry(pointer); 1 45 /* parameter 1: (input) symbol node pointer */ 1 46 1 47 declare defined_reference entry(pointer,pointer,pointer,pointer,pointer,bit(36) aligned) 1 48 returns(pointer); 1 49 /* parameter 1: (input) block node pointer */ 1 50 /* parameter 2: (input) statement node pointer */ 1 51 /* parameter 3: (input) tree pointer */ 1 52 /* parameter 4: (input) subscript list pointer or null*/ 1 53 /* parameter 5: (input) symbol node pointer */ 1 54 /* parameter 6: (in/out) context */ 1 55 /* return: (output) tree pointer */ 1 56 1 57 declare do_semantics entry(pointer,pointer,pointer); 1 58 /* parameter 1: (input) block node pointer */ 1 59 /* parameter 2: (input) statement node pointer */ 1 60 /* parameter 3: (input) tree pointer */ 1 61 1 62 declare expand_assign entry(pointer,pointer,pointer,bit(36) aligned,pointer) 1 63 returns(pointer); 1 64 /* parameter 1: (input) block node pointer */ 1 65 /* parameter 2: (input) statement node pointer */ 1 66 /* parameter 3: (input) tree pointer */ 1 67 /* parameter 4: (in/out) context */ 1 68 /* parameter 5: (input) aggregate reference node ptr */ 1 69 /* return: (output) tree pointer */ 1 70 1 71 declare expand_by_name entry(pointer,pointer,pointer); 1 72 /* parameter 1: (input) block node pointer */ 1 73 /* parameter 2: (input) statement node pointer */ 1 74 /* parameter 3: (input/output) tree pointer */ 1 75 1 76 declare expand_infix entry(pointer,pointer,pointer,bit(36) aligned) 1 77 returns(pointer); 1 78 /* parameter 1: (input) block node pointer */ 1 79 /* parameter 2: (input) statement node pointer */ 1 80 /* parameter 3: (input) tree pointer */ 1 81 /* parameter 4: (in/out) context */ 1 82 /* return: (output) tree pointer */ 1 83 1 84 declare expand_initial entry(pointer,pointer,pointer); 1 85 /* parameter 1: (input) symbol node pointer */ 1 86 /* parameter 2: (input) statement node pointer */ 1 87 /* parameter 3: (input) locator */ 1 88 1 89 declare expand_prefix entry(pointer,pointer,pointer,bit(36) aligned) 1 90 returns(pointer); 1 91 /* parameter 1: (input) block node pointer */ 1 92 /* parameter 2: (input) statement node pointer */ 1 93 /* parameter 3: (input) tree pointer */ 1 94 /* parameter 4: (in/out) context */ 1 95 /* return: (output) tree pointer */ 1 96 1 97 declare expand_primitive entry(pointer,pointer,pointer,bit(36) aligned) 1 98 returns(pointer); 1 99 /* parameter 1: (input) block node pointer */ 1 100 /* parameter 2: (input) statement node pointer */ 1 101 /* parameter 3: (input) tree pointer */ 1 102 /* parameter 4: (input) context */ 1 103 /* return: (output) tree pointer */ 1 104 1 105 declare expression_semantics entry(pointer,pointer,pointer,bit(36) aligned) 1 106 returns(pointer); 1 107 /* parameter 1: (input) block node pointer */ 1 108 /* parameter 2: (input) statement node pointer */ 1 109 /* parameter 3: (input) tree pointer */ 1 110 /* parameter 4: (in/out) context */ 1 111 /* return: (output) tree pointer */ 1 112 1 113 declare fill_refer entry(pointer,pointer,bit(1) aligned) 1 114 returns(pointer); 1 115 /* parameter 1: (input) null,ref node,op node ptr */ 1 116 /* parameter 2: (input) null,ref node,op node ptr */ 1 117 /* parameter 3: (input) copy switch for param 2 */ 1 118 /* return: (output) ptr to processed tree */ 1 119 1 120 declare io_data_list_semantics$format_list_semantics entry(pointer,pointer,pointer); 1 121 /* parameter 1: (input) block node pointer */ 1 122 /* parameter 2: (input) statement node pointer */ 1 123 /* parameter 3: (in/out) tree pointer */ 1 124 1 125 declare function entry(pointer,pointer,pointer,pointer,bit(36) aligned) 1 126 returns(pointer); 1 127 /* parameter 1: (input) block node pointer */ 1 128 /* parameter 2: (input) statement node pointer */ 1 129 /* parameter 3: (input) tree pointer */ 1 130 /* parameter 4: (input) symbol node pointer */ 1 131 /* parameter 5: (in/out) context */ 1 132 /* return: (output) tree pointer */ 1 133 1 134 declare generic_selector entry(pointer,pointer,pointer,pointer,bit(36) aligned) 1 135 returns(pointer); 1 136 /* parameter 1: (input) block node pointer */ 1 137 /* parameter 2: (input) statement node pointer */ 1 138 /* parameter 3: (input) tree pointer */ 1 139 /* parameter 4: (input) pointer to argument list */ 1 140 /* parameter 5: (in/out) context */ 1 141 /* return: (output) tree pointer */ 1 142 1 143 declare io_data_list_semantics entry(pointer,pointer,pointer); 1 144 /* parameter 1: (input) block node pointer */ 1 145 /* parameter 2: (input) statement node pointer */ 1 146 /* parameter 3: (input) operator node pointer */ 1 147 1 148 declare io_semantics entry(pointer,pointer,pointer); 1 149 /* parameter 1: (input) block node pointer */ 1 150 /* parameter 2: (input) statement node pointer */ 1 151 /* parameter 3: (input) tree pointer */ 1 152 1 153 declare lookup entry(pointer,pointer,pointer,pointer,bit(36) aligned) 1 154 returns(bit(1) aligned); 1 155 /* parameter 1: (input) block node pointer */ 1 156 /* parameter 2: (input) stmnt|symbol node pointer */ 1 157 /* parameter 3: (input) token or reference node ptr */ 1 158 /* parameter 4: (output) symbol node pointer */ 1 159 /* parameter 5: (in/out) context */ 1 160 /* return: (output) symbol found bit */ 1 161 1 162 declare make_non_quick entry(pointer, bit (36) aligned); 1 163 /* parameter 1: (input) tree pointer */ 1 164 /* parameter 2: (input) reason why being made nonquick */ 1 165 1 166 declare match_arguments entry(pointer,pointer) reducible 1 167 returns(bit(1) aligned); 1 168 /* parameter 1: (input) reference or symbol node ptr */ 1 169 /* parameter 2: (input) reference or symbol node ptr */ 1 170 /* return: (output) compare bit */ 1 171 1 172 declare offset_adder entry(pointer,fixed binary(31),fixed binary(3),bit(1) aligned, 1 173 pointer,fixed binary(31),fixed binary(3),bit(1) aligned,bit(1)); 1 174 /* parameter 1: (in/out) tree pointer */ 1 175 /* parameter 2: (in/out) constant size */ 1 176 /* parameter 3: (in/out) units */ 1 177 /* parameter 4: (in/out) ON if units ^= word_, but tree in words */ 1 178 /* parameter 5: (input) tree pointer */ 1 179 /* parameter 6: (input) constant size */ 1 180 /* parameter 7: (input) units */ 1 181 /* parameter 8: (input) ON if units ^= word_, but tree in words */ 1 182 /* parameter 9: (input) ON if should not improve units */ 1 183 1 184 declare operator_semantics entry(pointer,pointer,pointer,bit(36) aligned) 1 185 returns(pointer); 1 186 /* parameter 1: (input) block node pointer */ 1 187 /* parameter 2: (input) statement node pointer */ 1 188 /* parameter 3: (input) tree pointer */ 1 189 /* parameter 4: (in/out) context */ 1 190 /* return: (output) tree pointer */ 1 191 1 192 declare propagate_bit entry(pointer,fixed binary(15)); 1 193 /* parameter 1: (input) symbol node pointer */ 1 194 /* parameter 2: (input) attribute number */ 1 195 1 196 declare semantic_translator$call_es entry(pointer,pointer,pointer,label,bit(1) aligned) 1 197 returns(pointer); 1 198 /* parameter 1: (input) block ptr */ 1 199 /* parameter 2: (input) statement ptr */ 1 200 /* parameter 3: (input) tree ptr */ 1 201 /* parameter 4: (input) failure label */ 1 202 /* parameter 5: (input) "1"b -- convert to integer */ 1 203 /* return: (output) tree ptr */ 1 204 1 205 declare simplify_expression entry(pointer,fixed bin,bit(1)aligned); 1 206 /* parameter 1: (in/out) tree pointer */ 1 207 /* parameter 2: (output) value of constant, if the entire tree 1 208* is simplified */ 1 209 /* parameter 3: (output) bit indicating if the tree has 1 210* been simplified */ 1 211 1 212 declare simplify_offset entry(pointer,bit(36) aligned); 1 213 /* parameter 1: (input) reference node pointer */ 1 214 /* parameter 2: (input) context */ 1 215 1 216 declare subscripter entry(pointer,pointer,pointer,pointer,pointer) 1 217 returns(pointer); 1 218 /* parameter 1: (input) block node pointer */ 1 219 /* parameter 2: (input) statement node pointer */ 1 220 /* parameter 3: (input) tree pointer */ 1 221 /* parameter 4: (in/out) subscript list pointer */ 1 222 /* parameter 5: (input) symbol node pointer */ 1 223 /* return: (output) reference node pointer */ 1 224 1 225 declare validate entry(pointer); 1 226 /* parameter 1: (input) symbol node pointer */ 1 227 2 1 /****^ ********************************************************* 2 2* * * 2 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 2 4* * * 2 5* ********************************************************* */ 2 6 2 7 /* BEGIN INCLUDE FILE ... language_utility.incl.pl1 */ 2 8 2 9 2 10 /****^ HISTORY COMMENTS: 2 11* 1) change(89-07-10,RWaters), approve(89-07-10,MCR8118), audit(89-07-19,Vu), 2 12* install(89-07-31,MR12.3-1066): 2 13* Removed the obsolete parameter source_line from the dcl of error_(). 2 14* END HISTORY COMMENTS */ 2 15 2 16 /* Modified: 6 Jun 1979 by PG to add rank and byte 2 17* * Modified: 9 Jul 1989 by RW updated the declaration of error_ 2 18* */ 2 19 2 20 declare adjust_count entry(pointer); 2 21 /* parameter 1: (input) any node pointer */ 2 22 2 23 declare bindec entry(fixed bin(31)) reducible 2 24 returns(character(12) aligned); 2 25 /* parameter 1: (input) bin value */ 2 26 /* return: (output) character value with blanks */ 2 27 2 28 declare bindec$vs entry(fixed bin(31)) reducible 2 29 returns(character(12) aligned varying); 2 30 /* parameter 1: (input) binary value */ 2 31 /* return: (output) char value without blanks */ 2 32 2 33 declare binoct entry(fixed bin(31)) reducible 2 34 returns(char(12) aligned); 2 35 /* parameter 1: (input) binary value */ 2 36 /* return: (output) char value with blanks */ 2 37 2 38 declare binary_to_octal_string entry(fixed bin(31)) reducible 2 39 returns(char(12) aligned); 2 40 /* parameter 1: (input) binary value */ 2 41 /* return: (output) right-aligned char value */ 2 42 2 43 declare binary_to_octal_var_string entry(fixed bin(31)) reducible 2 44 returns(char(12) varying aligned); 2 45 /* parameter 1: (input) binary value */ 2 46 /* returns: (output) char value without blanks */ 2 47 2 48 declare compare_expression entry(pointer,pointer) reducible 2 49 returns(bit(1) aligned); 2 50 /* parameter 1: (input) any node pointer */ 2 51 /* parameter 2: (input) any node pointer */ 2 52 /* return: (output) compare bit */ 2 53 2 54 declare constant_length entry (pointer, fixed bin (71)) 2 55 returns (bit (1) aligned); 2 56 /* parameter 1: (input) reference node pointer */ 2 57 /* parameter 2: (input) value of constant length */ 2 58 /* return: (output) "1"b if constant length */ 2 59 2 60 declare convert entry(pointer,bit(36) aligned) 2 61 returns(pointer); 2 62 /* parameter 1: (input) any node pointer */ 2 63 /* parameter 2: (input) target type */ 2 64 /* return: (output) target value tree pointer */ 2 65 2 66 declare convert$to_integer entry(pointer,bit(36)aligned) 2 67 returns(pointer); 2 68 /* parameter 1: (input) any node pointer */ 2 69 /* parameter 2: (input) target type */ 2 70 /* return: (output) target value tree pointer */ 2 71 2 72 declare convert$from_builtin entry(pointer,bit(36) aligned) 2 73 returns(pointer); 2 74 /* parameter 1: (input) any node pointer */ 2 75 /* parameter 2: (input) target type */ 2 76 /* return: (output) target value tree pointer */ 2 77 2 78 declare convert$validate entry(pointer,pointer); 2 79 /* parameter 1: (input) source value tree pointer */ 2 80 /* parameter 2: (input) target reference node pointer */ 2 81 2 82 declare convert$to_target_fb entry(pointer,pointer) 2 83 returns(pointer); 2 84 /* parameter 1: (input) source value tree pointer */ 2 85 /* parameter 2: (input) target reference node pointer */ 2 86 /* return: (output) target value tree pointer */ 2 87 2 88 declare convert$to_target entry(pointer,pointer) 2 89 returns(pointer); 2 90 /* parameter 1: (input) source value tree pointer */ 2 91 /* parameter 2: (input) target reference node pointer */ 2 92 /* return: (output) target value tree pointer */ 2 93 2 94 declare copy_expression entry(pointer unaligned) 2 95 returns(pointer); 2 96 /* parameter 1: (input) any node pointer */ 2 97 /* return: (output) any node pointer */ 2 98 2 99 declare copy_expression$copy_sons entry(pointer,pointer); 2 100 /* parameter 1: (input) father symbol node pointer */ 2 101 /* parameter 2: (input) stepfather symbol node ptr */ 2 102 2 103 declare copy_unique_expression entry(pointer) 2 104 returns(pointer); 2 105 /* parameter 1: (input) any node pointer */ 2 106 /* return: (output) any node pointer */ 2 107 2 108 declare create_array entry() 2 109 returns(pointer); 2 110 /* return: (output) array node pointer */ 2 111 2 112 declare create_block entry(bit(9) aligned,pointer) 2 113 returns(pointer); 2 114 /* parameter 1: (input) block type */ 2 115 /* parameter 2: (input) father block node pointer */ 2 116 /* return: (output) block node pointer */ 2 117 2 118 declare create_bound entry() 2 119 returns(pointer); 2 120 /* return: (output) bound node pointer */ 2 121 2 122 declare create_context entry(pointer,pointer) 2 123 returns(pointer); 2 124 /* parameter 1: (input) block node pointer */ 2 125 /* parameter 2: (input) token pointer */ 2 126 /* return: (output) context node pointer */ 2 127 2 128 declare create_cross_reference entry() 2 129 returns(pointer); 2 130 /* return: (output) cross reference node pointer */ 2 131 2 132 declare create_default entry 2 133 returns(pointer); 2 134 /* return: (output) default node pointer */ 2 135 2 136 declare create_identifier entry() 2 137 returns(pointer); 2 138 /* return: (output) token node pointer */ 2 139 2 140 declare create_label entry(pointer,pointer,bit(3) aligned) 2 141 returns(pointer); 2 142 /* parameter 1: (input) block node pointer */ 2 143 /* parameter 2: (input) token node pointer */ 2 144 /* parameter 3: (input) declare type */ 2 145 /* return: (output) label node pointer */ 2 146 2 147 declare create_list entry(fixed bin(15)) 2 148 returns(pointer); 2 149 /* parameter 1: (input) number of list elements */ 2 150 /* return: (output) list node pointer */ 2 151 2 152 declare create_operator entry(bit(9) aligned,fixed bin(15)) 2 153 returns(pointer); 2 154 /* parameter 1: (input) operator type */ 2 155 /* parameter 2: (input) number of operands */ 2 156 /* return: (output) operator node pointer */ 2 157 2 158 declare create_reference entry(pointer) 2 159 returns(pointer); 2 160 /* parameter 1: (input) symbol node pointer */ 2 161 /* return: (output) reference node pointer */ 2 162 2 163 declare create_statement entry(bit(9) aligned,pointer,pointer,bit(12) aligned) 2 164 returns(pointer); 2 165 /* parameter 1: (input) statement type */ 2 166 /* parameter 2: (input) block node pointer */ 2 167 /* parameter 3: (input) label node pointer */ 2 168 /* parameter 4: (input) conditions */ 2 169 /* return: (output) statement node pointer */ 2 170 2 171 declare create_statement$prologue entry(bit(9) aligned,pointer,pointer,bit(12) aligned) 2 172 returns(pointer); 2 173 /* parameter 1: (input) statement type */ 2 174 /* parameter 2: (input) block node pointer */ 2 175 /* parameter 3: (input) label node pointer */ 2 176 /* parameter 4: (input) conditions */ 2 177 /* return: (output) statement node pointer */ 2 178 2 179 declare create_storage entry(fixed bin(15)) 2 180 returns(pointer); 2 181 /* parameter 1: (input) number of words */ 2 182 /* return: (output) storage block pointer */ 2 183 2 184 declare create_symbol entry(pointer,pointer,bit(3) aligned) 2 185 returns(pointer); 2 186 /* parameter 1: (input) block node pointer */ 2 187 /* parameter 2: (input) token node pointer */ 2 188 /* parameter 3: (input) declare type */ 2 189 /* return: (output) symbol node pointer */ 2 190 2 191 declare create_token entry (character (*), bit (9) aligned) 2 192 returns (ptr); 2 193 /* parameter 1: (input) token string */ 2 194 /* parameter 2: (input) token type */ 2 195 /* return: (output) token node ptr */ 2 196 2 197 declare create_token$init_hash_table entry (); 2 198 2 199 declare create_token$protected entry (char (*), bit (9) aligned, bit (18) aligned) 2 200 returns (ptr); 2 201 /* parameter 1: (input) token string */ 2 202 /* parameter 2: (input) token type */ 2 203 /* parameter 3: (input) protected flag */ 2 204 /* return: (output) token node ptr */ 2 205 2 206 declare decbin entry(character(*) aligned) reducible 2 207 returns(fixed bin(31)); 2 208 /* parameter 1: (input) decimal character string */ 2 209 /* return: (output) binary value */ 2 210 2 211 declare declare_constant entry(bit(*) aligned,bit(36) aligned,fixed bin(31),fixed bin(15)) 2 212 returns(pointer); 2 213 /* parameter 1: (input) value */ 2 214 /* parameter 2: (input) type */ 2 215 /* parameter 3: (input) size */ 2 216 /* parameter 4: (input) scale */ 2 217 /* return: (output) reference node pointer */ 2 218 2 219 declare declare_constant$bit entry(bit(*) aligned) 2 220 returns(pointer); 2 221 /* parameter 1: (input) bit */ 2 222 /* return: (output) reference node pointer */ 2 223 2 224 declare declare_constant$char entry(character(*) aligned) 2 225 returns(pointer); 2 226 /* parameter 1: (input) character */ 2 227 /* return: (output) reference node pointer */ 2 228 2 229 declare declare_constant$desc entry(bit(*) aligned) 2 230 returns(pointer); 2 231 /* parameter 1: (input) descriptor bit value */ 2 232 /* return: (output) reference node pointer */ 2 233 2 234 declare declare_constant$integer entry(fixed bin(31)) /* note...should really be fixed bin(24) */ 2 235 returns(pointer); 2 236 /* parameter 1: (input) integer */ 2 237 /* return: (output) reference node pointer */ 2 238 2 239 declare declare_descriptor entry(pointer,pointer,pointer,pointer,bit(2) aligned) 2 240 returns(pointer); 2 241 /* parameter 1: (input) block node pointer */ 2 242 /* parameter 2: (input) statement node pointer */ 2 243 /* parameter 3: (input) symbol node pointer */ 2 244 /* parameter 4: (input) loc pointer */ 2 245 /* parameter 5: (input) array descriptor bit 2 246* cross_section bit */ 2 247 /* return: (output) reference node pointer */ 2 248 2 249 declare declare_descriptor$ctl entry(pointer,pointer,pointer,pointer,bit(2) aligned) 2 250 returns(pointer); 2 251 /* parameter 1: (input) block node pointer */ 2 252 /* parameter 2: (input) statement node pointer */ 2 253 /* parameter 3: (input) symbol node pointer */ 2 254 /* parameter 4: (input) loc pointer */ 2 255 /* parameter 5: (input) array descriptor bit 2 256* cross_section bit */ 2 257 /* return: (output) reference node pointer */ 2 258 2 259 declare declare_descriptor$param entry(pointer,pointer,pointer,pointer,bit(2) aligned) 2 260 returns(pointer); 2 261 /* parameter 1: (input) block node pointer */ 2 262 /* parameter 2: (input) statement node pointer */ 2 263 /* parameter 3: (input) symbol node pointer */ 2 264 /* parameter 4: (input) loc pointer */ 2 265 /* parameter 5: (input) array descriptor bit 2 266* cross_section bit */ 2 267 /* return: (output) reference node pointer */ 2 268 2 269 declare declare_integer entry(pointer) 2 270 returns(pointer); 2 271 /* parameter 1: (input) block node pointer */ 2 272 /* return: (output) reference node pointer */ 2 273 2 274 declare declare_picture entry(char(*)aligned,pointer,fixed bin(15)); 2 275 /* parameter 1: (input) picture string */ 2 276 /* parameter 2: (input) symbol node pointer */ 2 277 /* parameter 3: (output) error code, if any */ 2 278 2 279 declare declare_picture_temp entry(char(*) aligned,fixed bin(31),bit(1) aligned,bit(1) aligned) 2 280 returns(pointer); 2 281 /* parameter 1: (input) picture string */ 2 282 /* parameter 2: (input) scalefactor of picture */ 2 283 /* parameter 3: (input) ="1"b => complex picture */ 2 284 /* parameter 4: (input) ="1"b => unaligned temp */ 2 285 /* return: (output) reference node pointer */ 2 286 2 287 declare declare_pointer entry(pointer) 2 288 returns(pointer); 2 289 /* parameter 1: (input) block node pointer */ 2 290 /* return: (output) reference node pointer */ 2 291 2 292 declare declare_temporary entry(bit(36) aligned,fixed bin(31),fixed bin(15),pointer) 2 293 returns(pointer); 2 294 /* parameter 1: (input) type */ 2 295 /* parameter 2: (input) precision */ 2 296 /* parameter 3: (input) scale */ 2 297 /* parameter 4: (input) length */ 2 298 /* return: (output) reference node pointer */ 2 299 2 300 declare decode_node_id entry(pointer,bit(1) aligned) 2 301 returns(char(120) varying); 2 302 /* parameter 1: (input) node pointer */ 2 303 /* parameter 2: (input) ="1"b => capitals */ 2 304 /* return: (output) source line id */ 2 305 2 306 declare decode_source_id entry( 3 1 1 structure unaligned, 3 2 2 /* file_number */ bit(8), 3 3 2 /* line_number */ bit(14), 3 4 2 /* stmt_number */ bit(5), 2 307 2 308 bit(1) aligned) 2 309 returns(char(120) varying); 2 310 /* parameter 1: (input) source id */ 2 311 /* parameter 2: (input) ="1"b => capitals */ 2 312 /* return: (output) source line id */ 2 313 2 314 declare error entry(fixed bin(15),pointer,pointer); 2 315 /* parameter 1: (input) error number */ 2 316 /* parameter 2: (input) statement node pointer or null*/ 2 317 /* parameter 3: (input) token node pointer */ 2 318 2 319 declare error$omit_text entry(fixed bin(15),pointer,pointer); 2 320 /* parameter 1: (input) error number */ 2 321 /* parameter 2: (input) statement node pointer or null*/ 2 322 /* parameter 3: (input) token node pointer */ 2 323 2 324 declare error_ entry(fixed bin(15), 4 1 1 structure unaligned, 4 2 2 /* file_number */ bit(8), 4 3 2 /* line_number */ bit(14), 4 4 2 /* stmt_number */ bit(5), 2 325 2 326 pointer,fixed bin(8),fixed bin(23),fixed bin(11)); 2 327 /* parameter 1: (input) error number */ 2 328 /* parameter 2: (input) statement id */ 2 329 /* parameter 3: (input) any node pointer */ 2 330 /* parameter 4: (input) source segment */ 2 331 /* parameter 5: (input) source starting character */ 2 332 /* parameter 6: (input) source length */ 2 333 2 334 declare error_$no_text entry(fixed bin(15), 5 1 1 structure unaligned, 5 2 2 /* file_number */ bit(8), 5 3 2 /* line_number */ bit(14), 5 4 2 /* stmt_number */ bit(5), 2 335 2 336 pointer); 2 337 /* parameter 1: (input) error number */ 2 338 /* parameter 2: (input) statement id */ 2 339 /* parameter 3: (input) any node pointer */ 2 340 2 341 declare error_$initialize_error entry(); 2 342 2 343 declare error_$finish entry(); 2 344 2 345 declare free_node entry(pointer); 2 346 /* parameter 1: any node pointer */ 2 347 2 348 declare get_array_size entry(pointer,fixed bin(3)); 2 349 /* parameter 1: (input) symbol node pointer */ 2 350 /* parameter 2: (input) units */ 2 351 2 352 declare get_size entry(pointer); 2 353 /* parameter 1: (input) symbol node pointer */ 2 354 2 355 declare merge_attributes external entry(pointer,pointer) 2 356 returns(bit(1) aligned); 2 357 /* parameter 1: (input) target symbol node pointer */ 2 358 /* parameter 2: (input) source symbol node pointer */ 2 359 /* return: (output) "1"b if merge was unsuccessful */ 2 360 2 361 declare optimizer entry(pointer); 2 362 /* parameter 1: (input) root pointer */ 2 363 2 364 declare parse_error entry(fixed bin(15),pointer); 2 365 /* parameter 1: (input) error number */ 2 366 /* parameter 2: (input) any node pointer */ 2 367 2 368 declare parse_error$no_text entry(fixed bin(15),pointer); 2 369 /* parameter 1: (input) error number */ 2 370 /* parameter 2: (input) any node pointer */ 2 371 2 372 declare pl1_error_print$write_out 2 373 entry(fixed bin(15), 6 1 1 structure unaligned, 6 2 2 /* file_number */ bit(8), 6 3 2 /* line_number */ bit(14), 6 4 2 /* stmt_number */ bit(5), 2 374 2 375 pointer,fixed bin(11),fixed bin(31),fixed bin(31),fixed bin(15)); 2 376 /* parameter 1: (input) error number */ 2 377 /* parameter 2: (input) statement identification */ 2 378 /* parameter 3: (input) any node pointer */ 2 379 /* parameter 4: (input) source segment */ 2 380 /* parameter 5: (input) source character index */ 2 381 /* parameter 6: (input) source length */ 2 382 /* parameter 7: (input) source line */ 2 383 2 384 declare pl1_error_print$listing_segment 2 385 entry(fixed bin(15), 7 1 1 structure unaligned, 7 2 2 /* file_number */ bit(8), 7 3 2 /* line_number */ bit(14), 7 4 2 /* stmt_number */ bit(5), 2 386 2 387 pointer); 2 388 /* parameter 1: (input) error number */ 2 389 /* parameter 2: (input) statement identification */ 2 390 /* parameter 3: (input) token node pointer */ 2 391 2 392 declare pl1_print$varying entry(character(*) aligned varying); 2 393 /* parameter 1: (input) string */ 2 394 2 395 declare pl1_print$varying_nl entry(character(*) aligned varying); 2 396 /* parameter 1: (input) string */ 2 397 2 398 declare pl1_print$non_varying entry(character(*) aligned,fixed bin(31)); 2 399 /* parameter 1: (input) string */ 2 400 /* parameter 2: (input) string length or 0 */ 2 401 2 402 declare pl1_print$non_varying_nl entry(character(*) aligned,fixed bin(31)); 2 403 /* parameter 1: (input) string */ 2 404 /* parameter 2: (input) string length or 0 */ 2 405 2 406 declare pl1_print$string_pointer entry(pointer,fixed bin(31)); 2 407 /* parameter 1: (input) string pointer */ 2 408 /* parameter 2: (input) string size */ 2 409 2 410 declare pl1_print$string_pointer_nl entry(pointer,fixed bin(31)); 2 411 /* parameter 1: (input) string pointer */ 2 412 /* parameter 2: (input) string length or 0 */ 2 413 2 414 declare pl1_print$unaligned_nl entry(character(*) unaligned,fixed bin(31)); 2 415 /* parameter 1: (input) string */ 2 416 /* parameter 2: (input) length */ 2 417 2 418 declare pl1_print$for_lex entry (ptr, fixed bin (14), fixed bin (21), fixed bin (21), bit (1) aligned, bit (1) aligned); 2 419 /* parameter 1: (input) ptr to base of source segment */ 2 420 /* parameter 2: (input) line number */ 2 421 /* parameter 3: (input) starting offset in source seg */ 2 422 /* parameter 4: (input) number of chars to copy */ 2 423 /* parameter 5: (input) ON iff shd print line number */ 2 424 /* parameter 6: (input) ON iff line begins in comment */ 2 425 2 426 declare refer_extent entry(pointer,pointer); 2 427 /* parameter 1: (input/output) null,ref node,op node pointer */ 2 428 /* parameter 2: (input) null,ref node,op node pointer */ 2 429 2 430 declare reserve$clear entry() 2 431 returns(pointer); 2 432 /* return: (output) pointer */ 2 433 2 434 declare reserve$declare_lib entry(fixed bin(15)) 2 435 returns(pointer); 2 436 /* parameter 1: (input) builtin function number */ 2 437 /* return: (output) pointer */ 2 438 2 439 declare reserve$read_lib entry(fixed bin(15)) 2 440 returns(pointer); 2 441 /* parameter 1: (input) builtin function number */ 2 442 /* return: (output) pointer */ 2 443 2 444 declare semantic_translator entry(); 2 445 2 446 declare semantic_translator$abort entry(fixed bin(15),pointer); 2 447 /* parameter 1: (input) error number */ 2 448 /* parameter 2: (input) any node pointer */ 2 449 2 450 declare semantic_translator$error entry(fixed bin(15),pointer); 2 451 /* parameter 1: (input) error number */ 2 452 /* parameter 2: (input) any node pointer */ 2 453 2 454 declare share_expression entry(ptr) 2 455 returns(ptr); 2 456 /* parameter 1: (input) usually operator node pointer */ 2 457 /* return: (output) tree pointer or null */ 2 458 2 459 declare token_to_binary entry(ptr) reducible 2 460 returns(fixed bin(31)); 2 461 /* parameter 1: (input) token node pointer */ 2 462 /* return: (output) converted binary value */ 2 463 2 464 /* END INCLUDE FILE ... language_utility.incl.pl1 */ 1 228 1 229 /* END INCLUDE FILE ... semant.incl.pl1 */ 3913 8 1 dcl 1 array based aligned, 8 2 2 node_type bit(9) unaligned, 8 3 2 reserved bit(34) unaligned, 8 4 2 number_of_dimensions fixed(7) unaligned, 8 5 2 own_number_of_dimensions fixed(7) unaligned, 8 6 2 element_boundary fixed(3) unaligned, 8 7 2 size_units fixed(3) unaligned, 8 8 2 offset_units fixed(3) unaligned, 8 9 2 interleaved bit(1) unaligned, 8 10 2 c_element_size fixed(24), 8 11 2 c_element_size_bits fixed(24), 8 12 2 c_virtual_origin fixed(24), 8 13 2 element_size ptr unaligned, 8 14 2 element_size_bits ptr unaligned, 8 15 2 virtual_origin ptr unaligned, 8 16 2 symtab_virtual_origin ptr unaligned, 8 17 2 symtab_element_size ptr unaligned, 8 18 2 bounds ptr unaligned, 8 19 2 element_descriptor ptr unaligned; 8 20 8 21 dcl 1 bound based aligned, 8 22 2 node_type bit(9), 8 23 2 c_lower fixed(24), 8 24 2 c_upper fixed(24), 8 25 2 c_multiplier fixed(24), 8 26 2 c_desc_multiplier fixed(24), 8 27 2 lower ptr unaligned, 8 28 2 upper ptr unaligned, 8 29 2 multiplier ptr unaligned, 8 30 2 desc_multiplier ptr unaligned, 8 31 2 symtab_lower ptr unaligned, 8 32 2 symtab_upper ptr unaligned, 8 33 2 symtab_multiplier ptr unaligned, 8 34 2 next ptr unaligned; 3914 9 1 /* BEGIN INCLUDE FILE ... block.incl.pl1 */ 9 2 /* Modified 22 Ocober 1980 by M. N. Davidoff to increase max block.number to 511 */ 9 3 /* format: style3,idind30 */ 9 4 9 5 declare 1 block aligned based, 9 6 2 node_type bit (9) unaligned, 9 7 2 source_id structure unaligned, 9 8 3 file_number bit (8), 9 9 3 line_number bit (14), 9 10 3 statement_number bit (5), 9 11 2 father ptr unaligned, 9 12 2 brother ptr unaligned, 9 13 2 son ptr unaligned, 9 14 2 declaration ptr unaligned, 9 15 2 end_declaration ptr unaligned, 9 16 2 default ptr unaligned, 9 17 2 end_default ptr unaligned, 9 18 2 context ptr unaligned, 9 19 2 prologue ptr unaligned, 9 20 2 end_prologue ptr unaligned, 9 21 2 main ptr unaligned, 9 22 2 end_main ptr unaligned, 9 23 2 return_values ptr unaligned, 9 24 2 return_count ptr unaligned, 9 25 2 plio_ps ptr unaligned, 9 26 2 plio_fa ptr unaligned, 9 27 2 plio_ffsb ptr unaligned, 9 28 2 plio_ssl ptr unaligned, 9 29 2 plio_fab2 ptr unaligned, 9 30 2 block_type bit (9) unaligned, 9 31 2 prefix bit (12) unaligned, 9 32 2 like_attribute bit (1) unaligned, 9 33 2 no_stack bit (1) unaligned, 9 34 2 get_data bit (1) unaligned, 9 35 2 flush_at_call bit (1) unaligned, 9 36 2 processed bit (1) unaligned, 9 37 2 text_displayed bit (1) unaligned, 9 38 2 number fixed bin (9) unsigned unaligned, 9 39 2 free_temps dimension (3) ptr, /* these fields are used by the code generator */ 9 40 2 temp_list ptr, 9 41 2 entry_list ptr, 9 42 2 o_and_s ptr, 9 43 2 why_nonquick aligned, 9 44 3 auto_adjustable_storage bit (1) unaligned, 9 45 3 returns_star_extents bit (1) unaligned, 9 46 3 stack_extended_by_args bit (1) unaligned, 9 47 3 invoked_by_format bit (1) unaligned, 9 48 3 format_statement bit (1) unaligned, 9 49 3 io_statements bit (1) unaligned, 9 50 3 assigned_to_entry_var bit (1) unaligned, 9 51 3 condition_statements bit (1) unaligned, 9 52 3 no_owner bit (1) unaligned, 9 53 3 recursive_call bit (1) unaligned, 9 54 3 options_non_quick bit (1) unaligned, 9 55 3 options_variable bit (1) unaligned, 9 56 3 never_referenced bit (1) unaligned, 9 57 3 pad_nonquick bit (5) unaligned, 9 58 2 prologue_flag bit (1) unaligned, 9 59 2 options_main bit (1) unaligned, 9 60 2 pad bit (16) unaligned, 9 61 2 number_of_entries fixed bin (17), 9 62 2 level fixed bin (17), 9 63 2 last_auto_loc fixed bin (17), 9 64 2 symbol_block fixed bin (17), 9 65 2 entry_info fixed bin (18), 9 66 2 enter structure unaligned, 9 67 3 start fixed bin (17), 9 68 3 end fixed bin (17), 9 69 2 leave structure unaligned, 9 70 3 start fixed bin (17), 9 71 3 end fixed bin (17), 9 72 2 owner ptr; 9 73 9 74 declare max_block_number fixed bin internal static options (constant) initial (511); 9 75 9 76 /* END INCLUDE FILE ... block.incl.pl1 */ 3915 10 1 /* BEGIN INCLUDE FILE ... boundary.incl.pl1 */ 10 2 10 3 /* Modified: 26 Apr 1979 by PCK to implement 4-bit decimal */ 10 4 10 5 dcl ( bit_ init(1), 10 6 digit_ init(2), 10 7 character_ init(3), 10 8 half_ init(4), 10 9 word_ init(5), 10 10 mod2_ init(6), 10 11 mod4_ init(7)) fixed bin(3) int static options(constant); 10 12 10 13 /* END INCLUDE FILE ... boundary.incl.pl1 */ 3916 11 1 /****^ ********************************************************* 11 2* * * 11 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 11 4* * * 11 5* ********************************************************* */ 11 6 11 7 /* BEGIN INCLUDE FILE ... builtin_table.incl.pl1 */ 11 8 11 9 11 10 /****^ HISTORY COMMENTS: 11 11* 1) change(89-07-10,RWaters), approve(89-07-10,MCR8118), audit(89-07-19,Vu), 11 12* install(89-07-31,MR12.3-1066): 11 13* Updated the number of builtin functions from 115 to 127. 11 14* END HISTORY COMMENTS */ 11 15 11 16 /* Modified: 13 Feb 1988 by RW increased "description" from 115 to 127 */ 11 17 11 18 /* format: style2,^indattr,ifthendo,ifthen,^indnoniterdo,^elsestmt,dclind9 */ 11 19 dcl 1 pl1_data$builtin_name ext static, 11 20 2 number_of_names fixed bin (15), 11 21 2 description (127), 11 22 3 name char (14), 11 23 3 aggregate_result bit (1), 11 24 3 nonstandard bit (1), 11 25 3 unused bit (7), 11 26 3 opcode bit (9), 11 27 3 reserve_list_number fixed bin (15), 11 28 3 jump_index fixed bin (15), 11 29 3 check_indicator fixed bin (15), 11 30 3 number1 fixed bin (15), 11 31 3 number2 fixed bin (15), 11 32 3 number_of_descriptions fixed bin (15), 11 33 3 descriptor (4), 11 34 4 check_code fixed bin (15), 11 35 4 type bit (36) aligned; 11 36 11 37 /* check_indicator resulting action: 11 38* 11 39* 1 number1 is required number of arguments 11 40* 2 number1 is minimum number of arguments 11 41* 3 number1 is minimum number of arguments, 11 42* number2 is maximum number of arguments. 11 43* 11 44* check_code resulting action: 11 45* 11 46* 1 argument must be of this type 11 47* 2 argument should be converted to this type 11 48* 3 argument should be converted to float binary 11 49* 4 argument should be converted to arithmetic type 11 50* 5 argument should be converted to integer type 11 51* 6 argument should be real decimal fixed constant 11 52* 7 argument should be converted to string type 11 53* 8 argument must either be a bit string or real fixed binary 11 54* 9 argument must be variable 11 55* 10 argument must be arithmetic or string 11 56* */ 11 57 11 58 /* END INCLUDE FILE ... builtin_table.incl.pl1 */ 3917 12 1 /* BEGIN INCLUDE FILE ... cross_reference.incl.pl1 */ 12 2 12 3 dcl 1 cross_reference based aligned, 12 4 2 node_type bit(9) unaligned, 12 5 2 source_id structure unaligned, 12 6 3 file_number bit(8), 12 7 3 line_number bit(14), 12 8 3 statement_number bit(5), 12 9 2 next ptr unaligned, 12 10 2 ref_type structure unaligned, 12 11 3 set_reference bit(1), 12 12 3 pad bit(35); 12 13 12 14 /* END INCLUDE FILE ... cross_reference.incl.pl1 */ 3918 13 1 /* BEGIN INCLUDE FILE ... decoded_token_types.incl.pl1 */ 13 2 13 3 /* This array maps token types into declaration types suitable 13 4* for passing to convert. */ 13 5 13 6 dcl decoded_type(33:62) bit(36) aligned int static options(constant) init 13 7 ( "000100000000000000000000000000000000"b, /* bit_string */ 13 8 "000010000000000000000000000000000000"b, /* char_string */ 13 9 (13) (36) "0"b, 13 10 "010000000000000000000101000001100000"b, /* fixed_bin */ 13 11 "010000000000000000000101000001100000"b, /* bin_integer */ 13 12 "010000000000000000000101000010100000"b, /* fixed_dec */ 13 13 "010000000000000000000101000001100000"b, /* dec_integer */ 13 14 "001000000000000000000101000001100000"b, /* float_bin */ 13 15 "0"b, 13 16 "001000000000000000000101000010100000"b, /* float_dec */ 13 17 "0"b, 13 18 "010000000000000000000101000001010000"b, /* i_fixed_bin */ 13 19 "010000000000000000000101000001010000"b, /* i_bin_integer */ 13 20 "010000000000000000000101000010010000"b, /* i_fixed_dec */ 13 21 "010000000000000000000101000010010000"b, /* i_dec_integer */ 13 22 "001000000000000000000101000001010000"b, /* i_float_bin */ 13 23 "0"b, 13 24 "001000000000000000000101000010010000"b); /* i_float_dec */ 13 25 13 26 /* END INCLUDE FILE ... decoded_token_types.incl.pl1 */ 3919 14 1 /* BEGIN INCLUDE FILE ... declare_type.incl.pl1 */ 14 2 14 3 /* Modified: 25 Apr 1979 by PCK to implement 4-bit decimal */ 14 4 14 5 dcl ( by_declare initial("001"b), 14 6 by_explicit_context initial("010"b), 14 7 by_context initial("011"b), 14 8 by_implication initial("100"b), 14 9 by_compiler initial("101"b)) int static bit(3) aligned options(constant); 14 10 14 11 /* END INCLUDE FILE ... declare_type.incl.pl1 */ 3920 15 1 dcl 1 label based aligned, 15 2 2 node_type bit(9) unaligned, 15 3 2 source_id structure unaligned, 15 4 3 file_number bit(8), 15 5 3 line_number bit(14), 15 6 3 statement_number bit(5), 15 7 2 location fixed(17) unaligned, 15 8 2 allocated bit(1) unaligned, 15 9 2 dcl_type bit(3) unaligned, 15 10 2 reserved bit(29) unaligned, 15 11 2 array bit(1) unaligned, 15 12 2 used_as_format bit(1) unaligned, 15 13 2 used_in_goto bit(1) unaligned, 15 14 2 symbol_table bit(18) unaligned, 15 15 2 low_bound fixed(17) unaligned, 15 16 2 high_bound fixed(17) unaligned, 15 17 2 block_node ptr unaligned, 15 18 2 token ptr unaligned, 15 19 2 next ptr unaligned, 15 20 2 multi_use ptr unaligned, 15 21 2 cross_reference ptr unaligned, 15 22 2 statement ptr unaligned; 3921 16 1 /* BEGIN INCLUDE FILE ... list.incl.pl1 */ 16 2 16 3 /* Modified 26 June 81 by EBush to add max_list_elements */ 16 4 16 5 16 6 dcl 1 list based aligned, 16 7 2 node_type bit(9) unaligned, 16 8 2 reserved bit(12) unaligned, 16 9 2 number fixed(14) unaligned, 16 10 2 element dimension(n refer(list.number)) ptr unaligned; 16 11 16 12 dcl max_list_elements fixed bin(17) internal static options (constant) 16 13 init(16383); 16 14 16 15 /* END INCLUDE FILE ... list.incl.pl1 */ 3922 17 1 /* BEGIN INCLUDE FILE ... mask.incl.pl1 */ 17 2 17 3 dcl ( structure_mask init("100000000000000000000000000000000000"b), 17 4 fixed_mask init("010000000000000000000000000000000000"b), 17 5 float_mask init("001000000000000000000000000000000000"b), 17 6 bit_mask init("000100000000000000000000000000000000"b), 17 7 char_mask init("000010000000000000000000000000000000"b), 17 8 ptr_mask init("000001000000000000000000000000000000"b), 17 9 offset_mask init("000000100000000000000000000000000000"b), 17 10 area_mask init("000000010000000000000000000000000000"b), 17 11 label_mask init("000000001000000000000000000000000000"b), 17 12 entry_mask init("000000000100000000000000000000000000"b), 17 13 file_mask init("000000000010000000000000000000000000"b), 17 14 arg_descriptor_mask init("000000000001000000000000000000000000"b), 17 15 storage_block_mask init("000000000000100000000000000000000000"b), 17 16 lock_mask init("000000000000010000000000000000000000"b), 17 17 condition_mask init("000000000000001000000000000000000000"b), 17 18 format_mask init("000000000000000100000000000000000000"b), 17 19 builtin_mask init("000000000000000010000000000000000000"b), 17 20 generic_mask init("000000000000000001000000000000000000"b), 17 21 picture_mask init("000000000000000000100000000000000000"b), 17 22 dimensioned_mask init("000000000000000000010000000000000000"b), 17 23 initialed_mask init("000000000000000000001000000000000000"b), 17 24 aligned_mask init("000000000000000000000100000000000000"b), 17 25 unaligned_mask init("000000000000000000000010000000000000"b), 17 26 signed_mask init("000000000000000000000001000000000000"b), 17 27 unsigned_mask init("000000000000000000000000100000000000"b), 17 28 precision_mask init("000000000000000000000000010000000000"b), 17 29 varying_mask init("000000000000000000000000001000000000"b), 17 30 local_mask init("000000000000000000000000000100000000"b), 17 31 decimal_mask init("000000000000000000000000000010000000"b), 17 32 binary_mask init("000000000000000000000000000001000000"b), 17 33 real_mask init("000000000000000000000000000000100000"b), 17 34 complex_mask init("000000000000000000000000000000010000"b), 17 35 variable_mask init("000000000000000000000000000000001000"b), 17 36 reducible_mask init("000000000000000000000000000000000100"b), 17 37 irreducible_mask init("000000000000000000000000000000000010"b), 17 38 returns_mask init("000000000000000000000000000000000001"b)) bit(36) aligned int static 17 39 options(constant); 17 40 17 41 dcl ( arithmetic_mask init("011000000000000000000000000011110000"b), 17 42 computational_mask init("011110000000000000100000000011110000"b), 17 43 fixed_binary_real_mask init("010000000000000000000000000001100000"b), 17 44 fixed_decimal_real_mask init("010000000000000000000000000010100000"b), 17 45 float_decimal_real_mask init("001000000000000000000000000010100000"b), 17 46 fixed_decimal_complex_mask init("010000000000000000000000000010010000"b), 17 47 float_decimal_complex_mask init("001000000000000000000000000010010000"b), 17 48 string_mask init("000110000000000000000000000000000000"b), 17 49 undesirable_mask init("111111111111111111100111110111110111"b), 17 50 convert_mask init("011111111111111111100111110111111110"b), 17 51 declare_constant_mask init("111111111111111111100000000011110000"b) 17 52 ) bit(36) aligned int static 17 53 options(constant); 17 54 17 55 /* END INCLUDE FILE ... mask.incl.pl1 */ 3923 18 1 /* BEGIN INCLUDE FILE ... nodes.incl.pl1 */ 18 2 18 3 /* Modified: 26 Dec 1979 by PCK to implement by name assignment */ 18 4 18 5 dcl ( block_node initial("000000001"b), 18 6 statement_node initial("000000010"b), 18 7 operator_node initial("000000011"b), 18 8 reference_node initial("000000100"b), 18 9 token_node initial("000000101"b), 18 10 symbol_node initial("000000110"b), 18 11 context_node initial("000000111"b), 18 12 array_node initial("000001000"b), 18 13 bound_node initial("000001001"b), 18 14 format_value_node initial("000001010"b), 18 15 list_node initial("000001011"b), 18 16 default_node initial("000001100"b), 18 17 machine_state_node initial("000001101"b), 18 18 source_node initial("000001110"b), 18 19 label_node initial("000001111"b), 18 20 cross_reference_node initial("000010000"b), 18 21 sf_par_node initial("000010001"b), 18 22 temporary_node initial("000010010"b), 18 23 label_array_element_node initial("000010011"b), 18 24 by_name_agg_node initial("000010100"b)) 18 25 bit(9) internal static aligned options(constant); 18 26 18 27 dcl 1 node based aligned, 18 28 2 type unal bit(9), 18 29 2 source_id unal structure, 18 30 3 file_number bit(8), 18 31 3 line_number bit(14), 18 32 3 statement_number bit(5); 18 33 18 34 /* END INCLUDE FILE ... nodes.incl.pl1 */ 3924 19 1 /* BEGIN INCLUDE FILE ... operator.incl.pl1 */ 19 2 19 3 /* Modified: 2 Apr 1980 by PCK to add max_number_of_operands */ 19 4 19 5 /* format: style3 */ 19 6 dcl 1 operator based aligned, 19 7 2 node_type bit (9) unaligned, 19 8 2 op_code bit (9) unaligned, 19 9 2 shared bit (1) unaligned, 19 10 2 processed bit (1) unaligned, 19 11 2 optimized bit (1) unaligned, 19 12 2 number fixed (14) unaligned, 19 13 2 operand dimension (n refer (operator.number)) ptr unaligned; 19 14 19 15 dcl max_number_of_operands 19 16 fixed bin (15) int static options (constant) initial (32767); 19 17 19 18 /* END INCLUDE FILE ... operator.incl.pl1 */ 3925 20 1 /* BEGIN INCLUDE FILE ... op_codes.incl.pl1 */ 20 2 20 3 /* Modified: 25 Apr 1979 by PCK 4-bit decimal */ 20 4 /* Modified: 6 Jun 1979 by PG to add rank and byte */ 20 5 /* Modified: 26 Dec 1979 by PCK to add assign_by_name */ 20 6 /* Modified: 26 July 82 BIM wordno, segno */ 20 7 20 8 dcl ( add initial("000010001"b), /* opnd(1) <- opnd(2)+opnd(3) */ 20 9 sub initial("000010010"b), /* opnd(1) <- opnd(2)-opnd(3) */ 20 10 mult initial("000010011"b), /* opnd(1) <- opnd(2)*opnd(3) */ 20 11 div initial("000010100"b), /* opnd(1) <- opnd(2)/opnd(3) */ 20 12 negate initial("000010101"b), /* opnd(1) <- -opnd(2) */ 20 13 exp initial("000010110"b), /* opnd(1) <- opnd(2) ** opnd(3) */ 20 14 20 15 and_bits initial("000100001"b), /* opnd(1) <- opnd(2) & opnd(3) */ 20 16 or_bits initial("000100010"b), /* opnd(1) <- opnd(2)|opnd(3) */ 20 17 xor_bits initial("000100011"b), /* opnd(1) <- opnd(2) xor opnd(3) */ 20 18 not_bits initial("000100100"b), /* opnd(1) <- ^opnd(2) */ 20 19 cat_string initial("000100101"b), /* opnd(1) <- opnd(2)||opnd(3) */ 20 20 bool_fun initial("000100110"b), /* opnd(1) <- bool(opnd(2),opnd(3),opnd(4)) */ 20 21 20 22 assign initial("000110001"b), /* opnd(1) <- opnd(2) */ 20 23 assign_size_ck initial("000110010"b), /* opnd(1) <- opnd(2) */ 20 24 assign_zero initial("000110011"b), /* opnd(1) <- 0 */ 20 25 copy_words initial("000110100"b), /* move opnd(2) to opnd(1) by opnd(3) words */ 20 26 copy_string initial("000110101"b), /* move opnd(2) to opnd(1) by opnd(3) units */ 20 27 make_desc initial("000110110"b), /* opnd(1) <- descriptor(opnd(2),opnd(3)) */ 20 28 assign_round initial("000110111"b), /* opnd(1) <- opnd(2) rounded */ 20 29 pack initial("000111000"b), /* opnd(1) <- encode to picture opnd(2) */ 20 30 unpack initial("000111001"b), /* opnd(1) <- decode from picture opnd(2) */ 20 31 20 32 less_than initial("001000100"b), /* opnd(1) <- opnd(2) < opnd(3) */ 20 33 greater_than initial("001000101"b), /* opnd(1) <- opnd(2) > opnd(3) */ 20 34 equal initial("001000110"b), /* opnd(1) <- opnd(2) = opnd(3) */ 20 35 not_equal initial("001000111"b), /* opnd(1) <- opnd(2) ^= opnd(3) */ 20 36 less_or_equal initial("001001000"b), /* opnd(1) <- opnd(2) <= opnd(3) */ 20 37 greater_or_equal initial("001001001"b), /* opnd(1) <- opnd(2) >= opnd(3) */ 20 38 20 39 jump initial("001010001"b), /* go to opnd(1) unconditionally */ 20 40 jump_true initial("001010010"b), /* go to opnd(1) if opnd(2) is not 0 */ 20 41 jump_false initial("001010011"b), /* go to opnd(1) if opnd(2) is all 0 */ 20 42 jump_if_lt initial("001010100"b), /* go to opnd(1) if opnd(2) < opnd(3) */ 20 43 jump_if_gt initial("001010101"b), /* go to opnd(1) if opnd(2) > opnd(3) */ 20 44 jump_if_eq initial("001010110"b), /* go to opnd(1) if opnd(2) = opnd(3) */ 20 45 jump_if_ne initial("001010111"b), /* go to opnd(1) if opnd(2) ^= opnd(3) */ 20 46 jump_if_le initial("001011000"b), /* go to opnd(1) if opnd(2) <= opnd(3) */ 20 47 jump_if_ge initial("001011001"b), /* go to opnd(1) if opnd(2) >= opnd(3) */ 20 48 20 49 std_arg_list initial("001100001"b), /* opnd(1) <- arglist(opnd(2) desclist(opnd(3))) */ 20 50 return_words initial("001100010"b), /* return aggregate opnd(1), opnd(2) is length in words */ 20 51 std_call initial("001100011"b), /* opnd(1) <- call opnd(2) with opnd(3) */ 20 52 return_bits initial("001100100"b), /* return aggregate opnd(1), opnd(2) is length in bits */ 20 53 std_entry initial("001100101"b), /* entry(opnd(1)... opnd(n)) */ 20 54 return_string initial("001100110"b), /* return string opnd(1) */ 20 55 ex_prologue initial("001100111"b), /* execute the prologue -no operands- */ 20 56 allot_auto initial("001101000"b), /* opnd(1) <- addrel(stack,opnd(2)) */ 20 57 param_ptr initial("001101001"b), /* opnd(1) <- ptr to opnd(2) in block opnd(3) */ 20 58 param_desc_ptr initial("001101010"b), /* opnd(1) <- ptr to opnd(2) in block opnd(3) */ 20 59 std_return initial("001101011"b), /* return -no arguments- */ 20 60 allot_ctl initial("001101100"b), /* allocate opnd(1) , length in words is opnd(2) */ 20 61 free_ctl initial("001101101"b), /* free opnd(1) */ 20 62 stop initial("001101110"b), /* stop - terminate run unit */ 20 63 20 64 mod_bit initial("001110000"b), /* opnd(1) <- mod(opnd(3),36), 20 65* opnd(2) <- opnd(3) / 36 */ 20 66 mod_byte initial("001110001"b), /* opnd(1) <- mod(opnd(3),4), 20 67* opnd(2) <- opnd(3) / 4 */ 20 68 mod_half initial("001110010"b), /* opnd(1) <- mod(opnd(3),2), 20 69* opnd(2) <- opnd(3) / 2 */ 20 70 mod_word initial("001110011"b), /* TO BE DEFINED BY BLW */ 20 71 20 72 bit_to_char initial("010000000"b), /* opnd(1) <- (opnd(2)+8)/9 */ 20 73 bit_to_word initial("010000001"b), /* opnd(1) <- (opnd(2)+35)/36 */ 20 74 char_to_word initial("010000010"b), /* opnd(1) <- (opnd(2)+3)/4 */ 20 75 half_to_word initial("010000011"b), /* opnd(1) <- (opnd(2)+1)/2 */ 20 76 word_to_mod2 initial("010000100"b), /* opnd(1) <- (opnd(2)+1)/2*2 */ 20 77 word_to_mod4 initial("010000101"b), /* opnd(1) <- (opnd(2)+3)/4*4 */ 20 78 word_to_mod8 initial("010000110"b), /* opnd(1) <- (opnd(2)+7)/8*8 */ 20 79 rel_fun initial("010000111"b), /* opnd(1) <- rel(opnd(2)) */ 20 80 baseno_fun initial("010001000"b), /* opnd(1) <- baseno(opnd(2)) */ 20 81 desc_size initial("010001001"b), /* opnd(1) <- substr(opnd(2),13,24) */ 20 82 bit_pointer initial("010001010"b), /* opnd(1) <- bit offset of opnd(2) */ 20 83 index_before_fun initial("010001011"b), /* opnd(1) <- length of before(opnd(2),opnd(3)) */ 20 84 index_after_fun initial("010001100"b), /* opnd(1) <- offset of after(opnd(2),opnd(3)) in opnd(2) */ 20 85 verify_ltrim_fun initial("010001101"b), /* opnd(1) <- offset of ltrim(opnd(2),opnd(3)) in opnd(2) */ 20 86 verify_rtrim_fun initial("010001110"b), /* opnd(1) <- length(opnd(2))-length(rtrim(opnd(2),opnd(3))) */ 20 87 digit_to_bit initial("010001111"b), /* opnd(1) <- 9*opnd(2)/2 */ 20 88 20 89 ceil_fun initial("010010000"b), /* opnd(1) <- ceil(opnd(2)) */ 20 90 floor_fun initial("010010001"b), /* opnd(1) <- floor(opnd(2)) */ 20 91 round_fun initial("010010010"b), /* opnd(1) <- round(opnd(2)) */ 20 92 sign_fun initial("010010011"b), /* opnd(1) <- sign(opnd(2)) */ 20 93 abs_fun initial("010010100"b), /* opnd(1) <- abs(opnd(2)) */ 20 94 trunc_fun initial("010010101"b), /* opnd(1) <- trunc(opnd(2)) */ 20 95 byte_fun initial("010010110"b), /* opnd(1) <- byte(opnd(2)) */ 20 96 rank_fun initial("010010111"b), /* opnd(1) <- rank(opnd(2)) */ 20 97 index_rev_fun initial("010011000"b), /* opnd(1) <- index(reverse(opnd(2)),reverse(opnd(3))) */ 20 98 search_rev_fun initial("010011001"b), /* opnd(1) <- search(reverse(opnd(2)),opnd(3)) */ 20 99 verify_rev_fun initial("010011010"b), /* opnd(1) <- verify(reverse(opnd(2)),opnd(3)) */ 20 100 wordno_fun initial("010011011"b), /* opnd(1) <- wordno (opnd(2)) */ 20 101 segno_fun initial("010011100"b), /* opnd(1) <- segno (opnd(2)) */ 20 102 bitno_fun initial("010011101"b), /* opnd(1) <- bitno (opnd(2)) */ 20 103 charno_fun initial("010011110"b), /* opnd(1) <- charno (opnd(2)) */ 20 104 20 105 index_fun initial("010100000"b), /* opnd(1) <- index(opnd(2),opnd(3)) */ 20 106 off_fun initial("010100001"b), /* opnd(1) <- offset(opnd(2),opnd(3)) */ 20 107 complex_fun initial("010100010"b), /* opnd(1) <- complex(opnd(2),opnd(3)) */ 20 108 conjg_fun initial("010100011"b), /* opnd(1) <- conjg(opnd(2),opnd(3)) */ 20 109 mod_fun initial("010100100"b), /* opnd(1) <- mod(opnd(2),opnd(3)) */ 20 110 repeat_fun initial("010100101"b), /* opnd(1) <- repeat(opnd(2),opnd(3)) */ 20 111 verify_fun initial("010100110"b), /* opnd(1) <- verify(opnd(2),opnd(3)) */ 20 112 translate_fun initial("010100111"b), /* opnd(1) <- translate(opnd(2),opnd(3))*/ 20 113 real_fun initial("010101001"b), /* opnd(1) <- real(opnd(2)) */ 20 114 imag_fun initial("010101010"b), /* opnd(1) <- imag(opnd(2)) */ 20 115 length_fun initial("010101011"b), /* opnd(1) <- length(opnd(2)) */ 20 116 pl1_mod_fun initial("010101100"b), /* opnd(1) <- mod(opnd(2)) */ 20 117 search_fun initial("010101101"b), /* opnd(1) <- search(opnd(2),opnd(3)) */ 20 118 allocation_fun initial("010101110"b), /* opnd(1) <- allocation(opnd(2)) */ 20 119 reverse_fun initial("010101111"b), /* opnd(1) <- reverse(opnd(2)) */ 20 120 20 121 addr_fun initial("010110000"b), /* opnd(1) <- addr(opnd(2)) */ 20 122 addr_fun_bits initial("010110001"b), /* opnd(1) <- addr(opnd(2)) */ 20 123 ptr_fun initial("010110010"b), /* opnd(1) <- ptr(opnd(2),opnd(3)) */ 20 124 baseptr_fun initial("010110011"b), /* opnd(1) <- baseptr(opnd(2)) */ 20 125 addrel_fun initial("010110100"b), /* opnd(1) <- addrel(opnd(2),opnd(3)) */ 20 126 codeptr_fun initial("010110101"b), /* opnd(1) <- codeptr(opnd(2)) */ 20 127 environmentptr_fun initial("010110110"b), /* opnd(1) <- environmentptr(opnd(2)) */ 20 128 stackbaseptr_fun initial("010110111"b), /* opnd(1) is ptr to base of current stack */ 20 129 stackframeptr_fun initial("010111000"b), /* opnd(1) is ptr to current block's stack frame */ 20 130 setcharno_fun initial("010111001"b), /* opnd(1) <- opnd(2) with charno opnd(3) */ 20 131 addcharno_fun initial("010111010"b), /* opnd(1) <- opnd(2) with charno = charno + opnd(3) */ 20 132 setbitno_fun initial("010111011"b), /* setcharno for bitsno */ 20 133 addbitno_fun initial("010111100"b), /* addcharno for bitno */ 20 134 20 135 min_fun initial("011000000"b), /* opnd(1) <- min(opnd(1),opnd(2),...) */ 20 136 max_fun initial("011000001"b), /* opnd(1) <- max(opnd(1),opnd(2),...) */ 20 137 20 138 stack_ptr initial("011010001"b), /* opnd(1) <- stack frame ptr */ 20 139 empty_area initial("011010010"b), /* empty opnd(1), length in words is opnd(2) */ 20 140 enable_on initial("011010100"b), /* opnd(1) is the cond name 20 141* opnd(2) is the file name 20 142* opnd(3) is the block */ 20 143 revert_on initial("011010101"b), /* opnd(1) is the cond name, 20 144* opnd(2) is the file name */ 20 145 signal_on initial("011010110"b), /* opnd(1) is the cond name 20 146* opnd(2) is the file name */ 20 147 20 148 lock_fun initial("011010111"b), /* opnd(1) <- stac(opnd(2),opnd(3)) */ 20 149 stacq_fun initial("011011000"b), /* opnd(1) is result, opnd(2) is ptr to lock word, 20 150* opnd(3) is old value, (4) is new value. */ 20 151 clock_fun initial("011011001"b), /* opnd(1) is the clock time */ 20 152 vclock_fun initial("011011010"b), /* opnd(1) is the virtual clock time */ 20 153 20 154 bound_ck initial("011100000"b), /* opnd(1) <- opnd(2) if opnd(3) <= opnd(2) <= opnd(4) */ 20 155 range_ck initial("011100001"b), /* opnd(1) <- opnd(2) if opnd(3) <= opnd(2) <= opnd(4) */ 20 156 loop initial("011100010"b), /* do opnd(1) for opnd(2) from opnd(3) to opnd(4) by 1, 20 157* opnd(5) is the list */ 20 158 join initial("011100011"b), /* do opnd(1), opnd(2) ... opnd(n) */ 20 159 allot_based initial("011100100"b), /* allocate opnd(2) words in opnd(3), set opnd(1) */ 20 160 free_based initial("011100101"b), /* free opnd(1) in opnd(3), length is opnd(2) words */ 20 161 20 162 r_parn initial("011110001"b), /* format op code */ 20 163 l_parn initial("011110010"b), 20 164 r_format initial("011110011"b), 20 165 c_format initial("011110100"b), 20 166 f_format initial("011110101"b), 20 167 e_format initial("011110110"b), 20 168 b_format initial("011110111"b), 20 169 a_format initial("011111000"b), 20 170 x_format initial("011111001"b), 20 171 skip_format initial("011111010"b), 20 172 column_format initial("011111011"b), 20 173 page_format initial("011111100"b), 20 174 line_format initial("011111101"b), 20 175 picture_format initial("011111110"b), 20 176 bn_format initial("011111111"b), /* bit format, length(opnd(2)), radix factor(opnd(3)) */ 20 177 20 178 get_list_trans initial("100000000"b), /* getlist(opnd(2) with desc(opnd(1))) */ 20 179 get_edit_trans initial("100000001"b), /* getedit(opnd(2) with desc(opnd(1))) */ 20 180 get_data_trans initial("100000010"b), /* getdata(opnd(1) to opnd(n)) */ 20 181 put_list_trans initial("100000011"b), /* putlist(opnd(2) with desc(opnd(1))) */ 20 182 put_edit_trans initial("100000100"b), /* putedit(opnd(2) with desc(opnd(1))) */ 20 183 put_data_trans initial("100000101"b), /* putdata(opnd(2)) with subscript-list opnd(1) */ 20 184 terminate_trans initial("100000110"b), /* terminate stream transmission */ 20 185 stream_prep initial("100000111"b), /* initiate stream transmission */ 20 186 record_io initial("100001000"b), /* perform record io operation */ 20 187 fortran_read initial("100001001"b), /* A complete read statement */ 20 188 fortran_write initial("100001010"b), /* A complete write statement */ 20 189 ftn_file_manip initial("100001011"b), /* endfile,backspace,rewind,etc. */ 20 190 ftn_trans_loop initial("100001100"b), /* An implied do in i/o list */ 20 191 put_control initial("100001101"b), /* put control opnd(1) opnd(2) times */ 20 192 put_field initial("100001110"b), /* putlist(opnd(2)) of length(opnd(1)) */ 20 193 put_field_chk initial("100001111"b), /* putlist(op(2)) of len(op(1)) check char index(op(3)) */ 20 194 20 195 /* These operators are produced by the parse but are not used as input to the code generator. */ 20 196 /* They are processed by the semantic translator. */ 20 197 20 198 return_value initial("100010010"b), /* return(opnd(1)) */ 20 199 allot_var initial("100010011"b), /* allot opnd(1) in opnd(2) */ 20 200 free_var initial("100010100"b), /* free opnd(1) out of opnd(2) */ 20 201 get_file initial("100010101"b), /* opnd(1) is filename,opnd(2) is copy */ 20 202 /* opnd(3) is skip, opnd(4) is list */ 20 203 get_string initial("100010110"b), /* opnd(1) is string,opnd(2) is list */ 20 204 put_file initial("100010111"b), /* opnd(1) is filename,opnd(2) is page */ 20 205 /* opnd(3) is skip,opnd(4) is line */ 20 206 put_string initial("100011000"b), /* opnd(1) is string,opnd(2) is list */ 20 207 open_file initial("100011001"b), 20 208 close_file initial("100011010"b), 20 209 read_file initial("100011011"b), 20 210 write_file initial("100011100"b), 20 211 locate_file initial("100011101"b), 20 212 do_fun initial("100011110"b), /* opnd(1) is join of a list */ 20 213 /* opnd(2) is control variable ref */ 20 214 /* opnd(3) is specification operator */ 20 215 do_spec initial("100011111"b), /* opnd(1) to opnd(2) by opnd(3) */ 20 216 /* repeat opnd(4) while opnd(5) */ 20 217 /* opnd(6) is next specification */ 20 218 20 219 rewrite_file initial("100100000"b), 20 220 delete_file initial("100100001"b), 20 221 unlock_file initial("100100010"b), 20 222 lock_file initial("100100011"b), 20 223 refer initial("100100101"b), /* opnd(1) refer(opnd(2)) */ 20 224 prefix_plus initial("100100110"b), /* opnd(1) <- +opnd(2) */ 20 225 nop initial("100100111"b), /* no-op */ 20 226 assign_by_name initial("100101000"b), /* opnd(1) <- opnd(2),by name */ 20 227 20 228 /* These operators are produced by the semantic translator in processing the math 20 229* builtin functions and are used as input to the code generator */ 20 230 20 231 sqrt_fun initial("100110000"b), /* opnd(1) <- sqrt(opnd(2)) */ 20 232 sin_fun initial("100110001"b), /* opnd(1) <- sin(opnd(2)) */ 20 233 sind_fun initial("100110010"b), /* opnd(1) <- sind(opnd(2)) */ 20 234 cos_fun initial("100110011"b), /* opnd(1) <- cos(opnd(2)) */ 20 235 cosd_fun initial("100110100"b), /* opnd(1) <- cosd(opnd(2)) */ 20 236 tan_fun initial("100110101"b), /* opnd(1) <- tan(opnd(2)) */ 20 237 tand_fun initial("100110110"b), /* opnd(1) <- tand(opnd(2)) */ 20 238 asin_fun initial("100110111"b), /* opnd(1) <- asin(opnd(2)) */ 20 239 asind_fun initial("100111000"b), /* opnd(1) <- asind(opnd(2)) */ 20 240 acos_fun initial("100111001"b), /* opnd(1) <- acos(opnd(2)) */ 20 241 acosd_fun initial("100111010"b), /* opnd(1) <- acosd(opnd(2)) */ 20 242 atan_fun initial("100111011"b), /* opnd(1) <- atan(opnd(2)[,opnd(3)]) */ 20 243 atand_fun initial("100111100"b), /* opnd(1) <- atand(opnd(2)[,opnd(3)]) */ 20 244 log2_fun initial("100111101"b), /* opnd(1) <- log2(opnd(2)) */ 20 245 log_fun initial("100111110"b), /* opnd(1) <- log(opnd(2)) */ 20 246 log10_fun initial("100111111"b), /* opnd(1) <- log10(opnd(2)) */ 20 247 20 248 exp_fun initial("101000000"b)) /* opnd(1) <- exp(opnd(2)) */ 20 249 20 250 bit(9) aligned internal static options(constant); 20 251 20 252 /* END INCLUDE FILE ... op_codes.incl.pl1 */ 3926 21 1 /* BEGIN INCLUDE FILE ... reference.incl.pl1 */ 21 2 21 3 dcl 1 reference based aligned, 21 4 2 node_type bit(9) unaligned, 21 5 2 array_ref bit(1) unaligned, 21 6 2 varying_ref bit(1) unaligned, 21 7 2 shared bit(1) unaligned, 21 8 2 put_data_sw bit(1) unaligned, 21 9 2 processed bit(1) unaligned, 21 10 2 units fixed(3) unaligned, 21 11 2 ref_count fixed(17) unaligned, 21 12 2 c_offset fixed(24), 21 13 2 c_length fixed(24), 21 14 2 symbol ptr unaligned, 21 15 2 qualifier ptr unaligned, 21 16 2 offset ptr unaligned, 21 17 2 length ptr unaligned, 21 18 2 subscript_list ptr unaligned, 21 19 /* these fields are used by the 645 code generator */ 21 20 2 address structure unaligned, 21 21 3 base bit(3), 21 22 3 offset bit(15), 21 23 3 op bit(9), 21 24 3 no_address bit(1), 21 25 3 inhibit bit(1), 21 26 3 ext_base bit(1), 21 27 3 tag bit(6), 21 28 2 info structure unaligned, 21 29 3 address_in structure, 21 30 4 b dimension(0:7) bit(1), 21 31 4 storage bit(1), 21 32 3 value_in structure, 21 33 4 a bit(1), 21 34 4 q bit(1), 21 35 4 aq bit(1), 21 36 4 string_aq bit(1), 21 37 4 complex_aq bit(1), 21 38 4 decimal_aq bit(1), 21 39 4 b dimension(0:7) bit(1), 21 40 4 storage bit(1), 21 41 4 indicators bit(1), 21 42 4 x dimension(0:7) bit(1), 21 43 3 other structure, 21 44 4 big_offset bit(1), 21 45 4 big_length bit(1), 21 46 4 modword_in_offset bit(1), 21 47 2 data_type fixed(5) unaligned, 21 48 2 bits structure unaligned, 21 49 3 padded_ref bit(1), 21 50 3 aligned_ref bit(1), 21 51 3 long_ref bit(1), 21 52 3 forward_ref bit(1), 21 53 3 ic_ref bit(1), 21 54 3 temp_ref bit(1), 21 55 3 defined_ref bit(1), 21 56 3 evaluated bit(1), 21 57 3 allocate bit(1), 21 58 3 allocated bit(1), 21 59 3 aliasable bit(1), 21 60 3 even bit(1), 21 61 3 perm_address bit(1), 21 62 3 aggregate bit(1), 21 63 3 hit_zero bit(1), 21 64 3 dont_save bit(1), 21 65 3 fo_in_qual bit(1), 21 66 3 hard_to_load bit(1), 21 67 2 relocation bit(12) unaligned, 21 68 2 more_bits structure unaligned, 21 69 3 substr bit(1), 21 70 3 padded_for_store_ref bit(1), 21 71 3 aligned_for_store_ref bit(1), 21 72 3 mbz bit(15), 21 73 2 store_ins bit(18) unaligned; 21 74 21 75 /* END INCLUDE FILE ... reference.incl.pl1 */ 3927 22 1 /* BEGIN INCLUDE FILE ... semantic_bits.incl.pl1 */ 22 2 22 3 /* Modified: 26 Dec 1979 by PCK to implement by name assignment */ 22 4 22 5 dcl context aligned bit(36), 22 6 this_context aligned bit(36); 22 7 22 8 dcl 1 def_context aligned based(addr(context)), 22 9 2 aggregate unaligned bit(1), 22 10 2 arg_list unaligned bit(1), 22 11 2 left_side unaligned bit(1), 22 12 2 return unaligned bit(1), 22 13 2 evaluate_offset unaligned bit(1), 22 14 2 top unaligned bit(1), 22 15 2 RHS_aggregate unaligned bit(1), 22 16 2 return_from_empty unaligned bit(1), 22 17 2 ignore_based unaligned bit(1), 22 18 2 ext_param unaligned bit(1), 22 19 2 cross_section unaligned bit(1), 22 20 2 string_unspec unaligned bit(1), 22 21 2 f_offset_to_be_added unaligned bit(1), 22 22 2 suppress_cross_ref unaligned bit(1), 22 23 2 by_name_assignment unaligned bit(1), 22 24 2 by_name_lookup unaligned bit(1), 22 25 2 pad unaligned bit(20); 22 26 22 27 dcl 1 def_this_context aligned like def_context based(addr(this_context)); 22 28 22 29 /* END INCLUDE FILE ... semantic_bits.incl.pl1 */ 3928 23 1 /* *********************************************************** 23 2* * * 23 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 23 4* * * 23 5* *********************************************************** */ 23 6 /* BEGIN INCLUDE FILE ... statement.incl.pl1 */ 23 7 /* Internal interface of the PL/I compiler */ 23 8 23 9 dcl 1 statement based aligned, 23 10 2 node_type bit(9) unaligned, 23 11 2 source_id structure unaligned, 23 12 3 file_number bit(8), 23 13 3 line_number bit(14), 23 14 3 statement_number bit(5), 23 15 2 next ptr unaligned, 23 16 2 back ptr unaligned, 23 17 2 root ptr unaligned, 23 18 2 labels ptr unaligned, 23 19 2 reference_list ptr unaligned, 23 20 2 state_list ptr unaligned, 23 21 2 reference_count fixed(17) unaligned, 23 22 2 ref_count_copy fixed(17) unaligned, 23 23 2 object structure unaligned, 23 24 3 start fixed(17), 23 25 3 finish fixed(17), 23 26 2 source structure unaligned, 23 27 3 segment fixed(11), 23 28 3 start fixed(23), 23 29 3 length fixed(11), 23 30 2 prefix bit(12) unaligned, 23 31 2 optimized bit(1) unaligned, 23 32 2 free_temps bit(1) unaligned, 23 33 2 LHS_in_RHS bit(1) unaligned, 23 34 2 statement_type bit(9) unaligned, 23 35 2 bits structure unaligned, 23 36 3 processed bit(1) unaligned, 23 37 3 put_in_profile bit(1) unaligned, 23 38 3 generated bit(1) unaligned, 23 39 3 snap bit(1) unaligned, 23 40 3 system bit(1) unaligned, 23 41 3 irreducible bit(1) unaligned, 23 42 3 checked bit(1) unaligned, 23 43 3 save_temps bit(1) unaligned, 23 44 3 suppress_warnings bit(1) unaligned, 23 45 3 force_nonquick bit(1) unaligned, 23 46 3 expanded_by_name bit(1) unaligned, 23 47 3 begins_loop bit(1) unaligned, 23 48 3 pad bit(24) unaligned; 23 49 23 50 /* END INCLUDE FILE ... statement.incl.pl1 */ 3929 24 1 /* statement types */ 24 2 24 3 dcl ( unknown_statement initial("000000000"b), 24 4 allocate_statement initial("000000001"b), 24 5 assignment_statement initial("000000010"b), 24 6 begin_statement initial("000000011"b), 24 7 call_statement initial("000000100"b), 24 8 close_statement initial("000000101"b), 24 9 declare_statement initial("000000110"b), 24 10 lock_statement initial("000000111"b), 24 11 delete_statement initial("000001000"b), 24 12 display_statement initial("000001001"b), 24 13 do_statement initial("000001010"b), 24 14 else_clause initial("000001011"b), 24 15 end_statement initial("000001100"b), 24 16 entry_statement initial("000001101"b), 24 17 exit_statement initial("000001110"b), 24 18 format_statement initial("000001111"b), 24 19 free_statement initial("000010000"b), 24 20 get_statement initial("000010001"b), 24 21 goto_statement initial("000010010"b), 24 22 if_statement initial("000010011"b), 24 23 locate_statement initial("000010100"b), 24 24 null_statement initial("000010101"b), 24 25 on_statement initial("000010110"b), 24 26 open_statement initial("000010111"b), 24 27 procedure_statement initial("000011000"b), 24 28 put_statement initial("000011001"b), 24 29 read_statement initial("000011010"b), 24 30 return_statement initial("000011011"b), 24 31 revert_statement initial("000011100"b), 24 32 rewrite_statement initial("000011101"b), 24 33 signal_statement initial("000011110"b), 24 34 stop_statement initial("000011111"b), 24 35 system_on_unit initial("000100000"b), 24 36 unlock_statement initial("000100001"b), 24 37 wait_statement initial("000100010"b), 24 38 write_statement initial("000100011"b), 24 39 default_statement initial("000100100"b), 24 40 continue_statement initial("000100101"b)) bit(9) internal static aligned options(constant); 3930 25 1 /* BEGIN INCLUDE FILE ... symbol.incl.pl1 */ 25 2 25 3 dcl 1 symbol based aligned, 25 4 2 node_type bit(9) unal, 25 5 2 source_id structure unal, 25 6 3 file_number bit(8), 25 7 3 line_number bit(14), 25 8 3 statement_number bit(5), 25 9 2 location fixed(18) unal unsigned, 25 10 2 allocated bit(1) unal, 25 11 2 dcl_type bit(3) unal, 25 12 2 reserved bit(6) unal, 25 13 2 pix unal, 25 14 3 pic_fixed bit(1) unal, 25 15 3 pic_float bit(1) unal, 25 16 3 pic_char bit(1) unal, 25 17 3 pic_scale fixed(7) unal, 25 18 3 pic_size fixed(7) unal, 25 19 2 level fixed(8) unal, 25 20 2 boundary fixed(3) unal, 25 21 2 size_units fixed(3) unal, 25 22 2 scale fixed(7) unal, 25 23 2 runtime bit(18) unal, 25 24 2 runtime_offset bit(18) unal, 25 25 2 block_node ptr unal, 25 26 2 token ptr unal, 25 27 2 next ptr unal, 25 28 2 multi_use ptr unal, 25 29 2 cross_references ptr unal, 25 30 2 initial ptr unal, 25 31 2 array ptr unal, 25 32 2 descriptor ptr unal, 25 33 2 equivalence ptr unal, 25 34 2 reference ptr unal, 25 35 2 general ptr unal, 25 36 2 father ptr unal, 25 37 2 brother ptr unal, 25 38 2 son ptr unal, 25 39 2 word_size ptr unal, 25 40 2 bit_size ptr unal, 25 41 2 dcl_size ptr unal, 25 42 2 symtab_size ptr unal, 25 43 2 c_word_size fixed(24), 25 44 2 c_bit_size fixed(24), 25 45 2 c_dcl_size fixed(24), 25 46 25 47 2 attributes structure aligned, 25 48 3 data_type structure unal, 25 49 4 structure bit(1) , 25 50 4 fixed bit(1), 25 51 4 float bit(1), 25 52 4 bit bit(1), 25 53 4 char bit(1), 25 54 4 ptr bit(1), 25 55 4 offset bit(1), 25 56 4 area bit(1), 25 57 4 label bit(1), 25 58 4 entry bit(1), 25 59 4 file bit(1), 25 60 4 arg_descriptor bit(1), 25 61 4 storage_block bit(1), 25 62 4 explicit_packed bit(1), /* options(packed) */ 25 63 4 condition bit(1), 25 64 4 format bit(1), 25 65 4 builtin bit(1), 25 66 4 generic bit(1), 25 67 4 picture bit(1), 25 68 25 69 3 misc_attributes structure unal, 25 70 4 dimensioned bit(1), 25 71 4 initialed bit(1), 25 72 4 aligned bit(1), 25 73 4 unaligned bit(1), 25 74 4 signed bit(1), 25 75 4 unsigned bit(1), 25 76 4 precision bit(1), 25 77 4 varying bit(1), 25 78 4 local bit(1), 25 79 4 decimal bit(1), 25 80 4 binary bit(1), 25 81 4 real bit(1), 25 82 4 complex bit(1), 25 83 4 variable bit(1), 25 84 4 reducible bit(1), 25 85 4 irreducible bit(1), 25 86 4 returns bit(1), 25 87 4 position bit(1), 25 88 4 internal bit(1), 25 89 4 external bit(1), 25 90 4 like bit(1), 25 91 4 member bit(1), 25 92 4 non_varying bit(1), 25 93 4 options bit(1), 25 94 4 variable_arg_list bit(1), /* options(variable) */ 25 95 4 alloc_in_text bit(1), /* options(constant) */ 25 96 25 97 3 storage_class structure unal, 25 98 4 auto bit(1), 25 99 4 based bit(1), 25 100 4 static bit(1), 25 101 4 controlled bit(1), 25 102 4 defined bit(1), 25 103 4 parameter bit(1), 25 104 4 param_desc bit(1), 25 105 4 constant bit(1), 25 106 4 temporary bit(1), 25 107 4 return_value bit(1), 25 108 25 109 3 file_attributes structure unal, 25 110 4 print bit(1), 25 111 4 input bit(1), 25 112 4 output bit(1), 25 113 4 update bit(1), 25 114 4 stream bit(1), 25 115 4 reserved_1 bit(1), 25 116 4 record bit(1), 25 117 4 sequential bit(1), 25 118 4 direct bit(1), 25 119 4 interactive bit(1), /* env(interactive) */ 25 120 4 reserved_2 bit(1), 25 121 4 reserved_3 bit(1), 25 122 4 stringvalue bit(1), /* env(stringvalue) */ 25 123 4 keyed bit(1), 25 124 4 reserved_4 bit(1), 25 125 4 environment bit(1), 25 126 25 127 3 compiler_developed structure unal, 25 128 4 aliasable bit(1), 25 129 4 packed bit(1), 25 130 4 passed_as_arg bit(1), 25 131 4 allocate bit(1), 25 132 4 set bit(1), 25 133 4 exp_extents bit(1), 25 134 4 refer_extents bit(1), 25 135 4 star_extents bit(1), 25 136 4 isub bit(1), 25 137 4 put_in_symtab bit(1), 25 138 4 contiguous bit(1), 25 139 4 put_data bit(1), 25 140 4 overlayed bit(1), 25 141 4 error bit(1), 25 142 4 symtab_processed bit(1), 25 143 4 overlayed_by_builtin bit(1), 25 144 4 defaulted bit(1), 25 145 4 connected bit(1); 25 146 25 147 /* END INCLUDE FILE ... symbol.incl.pl1 */ 3931 26 1 /* BEGIN INCLUDE FILE ... pl1_symbol_type.incl.pl1 */ 26 2 26 3 dcl 1 type, 26 4 2 structure bit, 26 5 2 fixed bit, 26 6 2 float bit, 26 7 2 bit bit, 26 8 2 char bit, 26 9 2 ptr bit, 26 10 2 offset bit, 26 11 2 area bit, 26 12 2 label bit, 26 13 2 entry bit, 26 14 2 file bit, 26 15 2 arg_descriptor bit, 26 16 2 storage_block bit, 26 17 2 explicit_packed bit, 26 18 2 condition bit, 26 19 2 format bit, 26 20 2 builtin bit, 26 21 2 generic bit, 26 22 2 picture bit, 26 23 2 dimensioned bit, 26 24 2 initialed bit, 26 25 2 aligned bit, 26 26 2 unaligned bit, 26 27 2 signed bit, 26 28 2 unsigned bit, 26 29 2 precision bit, 26 30 2 varying bit, 26 31 2 local bit, 26 32 2 decimal bit, 26 33 2 binary bit, 26 34 2 real bit, 26 35 2 complex bit, 26 36 2 variable bit, 26 37 2 reducible bit, 26 38 2 irreducible bit, 26 39 2 returns bit; 26 40 26 41 /* END INCLUDE FILE ... pl1_symbol_type.incl.pl1 */ 3932 27 1 /* BEGIN INCLUDE FILE ... symbol_bits.incl.pl1 */ 27 2 27 3 dcl ( aliasable_bit initial (72), 27 4 passed_as_arg_bit initial (74), 27 5 set_bit initial (76), 27 6 overlayed_by_builtin_bit initial (87)) fixed bin (15) internal static options (constant); 27 7 27 8 /* END INCLUDE FILE ... symbol_bits.incl.pl1 */ 3933 28 1 /* BEGIN INCLUDE FILE ... system.incl.pl1 */ 28 2 28 3 /* Modified: 25 Apr 1979 by PCK to implemnt 4-bit decimal */ 28 4 28 5 dcl ( max_p_flt_bin_1 initial(27), 28 6 max_p_flt_bin_2 initial(63), 28 7 max_p_fix_bin_1 initial(35), 28 8 max_p_fix_bin_2 initial(71), 28 9 28 10 max_p_dec initial(59), 28 11 max_p_bin_or_dec initial (71), /* max (max_p_fix_bin_2, max_p_dec) */ 28 12 28 13 min_scale initial(-128), 28 14 max_scale initial(+127), 28 15 max_bit_string initial(9437184), 28 16 max_char_string initial(1048576), 28 17 max_area_size initial(262144), 28 18 min_area_size initial(28), 28 19 28 20 max_bit_string_constant initial (253), /* max length of bit literals */ 28 21 max_char_string_constant initial (254), /* max length of character literals */ 28 22 max_identifier_length initial (256), 28 23 max_number_of_dimensions initial (127), 28 24 28 25 max_length_precision initial(24), 28 26 max_offset_precision initial(24), /* 18 bits for word offset + 6 bits for bit offset */ 28 27 28 28 max_words_per_variable initial (262144), 28 29 28 30 bits_per_word initial(36), 28 31 bits_per_double initial(72), 28 32 packed_digits_per_character initial(2), 28 33 characters_per_half initial(2), 28 34 characters_per_word initial(4), 28 35 characters_per_double initial(8), 28 36 28 37 bits_per_character initial(9), 28 38 bits_per_half initial(18), 28 39 bits_per_decimal_digit initial(9), 28 40 bits_per_binary_exponent initial(8), 28 41 bits_per_packed_ptr initial(36), 28 42 words_per_packed_pointer initial(1), 28 43 28 44 words_per_fix_bin_1 initial(1), 28 45 words_per_fix_bin_2 initial(2), 28 46 words_per_flt_bin_1 initial(1), 28 47 words_per_flt_bin_2 initial(2), 28 48 words_per_varying_string_header initial(1), 28 49 words_per_offset initial(1), 28 50 words_per_pointer initial(2), 28 51 words_per_label_var initial(4), 28 52 words_per_entry_var initial(4), 28 53 words_per_file_var initial(4), 28 54 words_per_format initial(4), 28 55 words_per_condition_var initial(6), 28 56 28 57 max_index_register_value initial(262143), 28 58 max_signed_index_register_value initial(131071), 28 59 28 60 max_signed_xreg_precision initial(17), 28 61 max_uns_xreg_precision initial(18), 28 62 28 63 default_area_size initial(1024), 28 64 default_flt_bin_p initial(27), 28 65 default_fix_bin_p initial(17), 28 66 default_flt_dec_p initial(10), 28 67 default_fix_dec_p initial(7)) fixed bin(31) internal static options(constant); 28 68 28 69 dcl bits_per_digit initial(4.5) fixed bin(31,1) internal static options(constant); 28 70 28 71 dcl ( integer_type initial("010000000000000000000100000001100000"b), 28 72 dec_integer_type initial("010000000000000000000100000010100000"b), 28 73 pointer_type initial("000001000000000000000100000000000000"b), 28 74 real_type initial("001000000000000000000100000001100000"b), 28 75 complex_type initial("001000000000000000000100000001010000"b), 28 76 builtin_type initial("000000000000000010000000000000000000"b), 28 77 storage_block_type initial("000000000000100000000000000000000000"b), 28 78 arg_desc_type initial("000000000001000000000000000000000000"b), 28 79 local_label_var_type initial("000000001000000000000100000100001000"b), 28 80 entry_var_type initial("000000000100000000000000000000001000"b), 28 81 bit_type initial("000100000000000000000000000000000000"b), 28 82 char_type initial("000010000000000000000000000000000000"b)) bit(36) aligned int static 28 83 options(constant); 28 84 28 85 /* END INCLUDE FILE ... system.incl.pl1 */ 3934 29 1 /* BEGIN INCLUDE FILE ... token.incl.pl1 */ 29 2 29 3 dcl 1 token based aligned, 29 4 2 node_type bit(9) unaligned, 29 5 2 type bit(9) unaligned, 29 6 2 loc bit(18) unaligned, /* symtab offset for identifiers, "p" flag for constants */ 29 7 2 declaration ptr unaligned, 29 8 2 next ptr unaligned, 29 9 2 size fixed(9), 29 10 2 string char(n refer(token.size)); 29 11 29 12 /* END INCLUDE FILE ... token.incl.pl1 */ 3935 30 1 /* BEGIN INCLUDE FILE ... token_types.incl.pl1 */ 30 2 30 3 dcl ( no_token initial("000000000"b), /* token types */ 30 4 identifier initial("100000000"b), 30 5 isub initial("010000000"b), 30 6 plus initial("001000001"b), 30 7 minus initial("001000010"b), 30 8 asterisk initial("001000011"b), 30 9 slash initial("001000100"b), 30 10 expon initial("001000101"b), 30 11 not initial("001000110"b), 30 12 and initial("001000111"b), 30 13 or initial("001001000"b), 30 14 cat initial("001001001"b), 30 15 eq initial("001001010"b), 30 16 ne initial("001001011"b), 30 17 lt initial("001001100"b), 30 18 gt initial("001001101"b), 30 19 le initial("001001110"b), 30 20 ge initial("001001111"b), 30 21 ngt initial("001010000"b), 30 22 nlt initial("001010001"b), 30 23 assignment initial("001010010"b), 30 24 colon initial("001010011"b), 30 25 semi_colon initial("001010100"b), 30 26 comma initial("001010101"b), 30 27 period initial("001010110"b), 30 28 arrow initial("001010111"b), 30 29 left_parn initial("001011000"b), 30 30 right_parn initial("001011001"b), 30 31 percent initial("001011100"b), 30 32 bit_string initial("000100001"b), 30 33 char_string initial("000100010"b), 30 34 bin_integer initial("000110001"b), 30 35 dec_integer initial("000110011"b), 30 36 fixed_bin initial("000110000"b), 30 37 fixed_dec initial("000110010"b), 30 38 float_bin initial("000110100"b), 30 39 float_dec initial("000110110"b), 30 40 i_bin_integer initial("000111001"b), 30 41 i_dec_integer initial("000111011"b), 30 42 i_fixed_bin initial("000111000"b), 30 43 i_fixed_dec initial("000111010"b), 30 44 i_float_bin initial("000111100"b), 30 45 i_float_dec initial("000111110"b)) bit (9) aligned internal static options (constant); 30 46 30 47 dcl ( is_identifier initial ("100000000"b), /* token type masks */ 30 48 is_isub initial ("010000000"b), 30 49 is_delimiter initial ("001000000"b), 30 50 is_constant initial ("000100000"b), 30 51 is_arith_constant initial ("000010000"b), /* N.B. not really a mask...s/b "000110000"b */ 30 52 is_arithmetic_constant initial ("000110000"b), 30 53 is_imaginary_constant initial ("000111000"b), 30 54 is_float_constant initial ("000110100"b), 30 55 is_decimal_constant initial ("000110010"b), 30 56 is_integral_constant initial ("000110001"b) 30 57 ) bit(9) internal static aligned options(constant); 30 58 30 59 /* END INCLUDE FILE ... token_types.incl.pl1 */ 3936 3937 3938 end builtin; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 07/31/89 1329.4 builtin.pl1 >spec>install>MR12.3-1066>builtin.pl1 3913 1 07/21/80 1546.3 semant.incl.pl1 >ldd>include>semant.incl.pl1 1-228 2 07/31/89 1332.6 language_utility.incl.pl1 >spec>install>MR12.3-1066>language_utility.incl.pl1 2-307 3 05/06/74 1746.9 source_id_descriptor.incl.pl1 >ldd>include>source_id_descriptor.incl.pl1 2-325 4 05/06/74 1746.9 source_id_descriptor.incl.pl1 >ldd>include>source_id_descriptor.incl.pl1 2-335 5 05/06/74 1746.9 source_id_descriptor.incl.pl1 >ldd>include>source_id_descriptor.incl.pl1 2-374 6 05/06/74 1746.9 source_id_descriptor.incl.pl1 >ldd>include>source_id_descriptor.incl.pl1 2-386 7 05/06/74 1746.9 source_id_descriptor.incl.pl1 >ldd>include>source_id_descriptor.incl.pl1 3914 8 05/06/74 1741.6 array.incl.pl1 >ldd>include>array.incl.pl1 3915 9 08/13/81 2043.5 block.incl.pl1 >ldd>include>block.incl.pl1 3916 10 10/25/79 1645.8 boundary.incl.pl1 >ldd>include>boundary.incl.pl1 3917 11 07/31/89 1334.3 builtin_table.incl.pl1 >spec>install>MR12.3-1066>builtin_table.incl.pl1 3918 12 10/25/79 1645.8 cross_reference.incl.pl1 >ldd>include>cross_reference.incl.pl1 3919 13 11/30/78 1227.5 decoded_token_types.incl.pl1 >ldd>include>decoded_token_types.incl.pl1 3920 14 10/25/79 1645.8 declare_type.incl.pl1 >ldd>include>declare_type.incl.pl1 3921 15 05/06/74 1742.1 label.incl.pl1 >ldd>include>label.incl.pl1 3922 16 08/13/81 2211.5 list.incl.pl1 >ldd>include>list.incl.pl1 3923 17 11/30/78 1227.5 mask.incl.pl1 >ldd>include>mask.incl.pl1 3924 18 07/21/80 1546.3 nodes.incl.pl1 >ldd>include>nodes.incl.pl1 3925 19 07/21/80 1546.3 operator.incl.pl1 >ldd>include>operator.incl.pl1 3926 20 04/07/83 1635.0 op_codes.incl.pl1 >ldd>include>op_codes.incl.pl1 3927 21 07/21/80 1546.3 reference.incl.pl1 >ldd>include>reference.incl.pl1 3928 22 07/21/80 1546.3 semantic_bits.incl.pl1 >ldd>include>semantic_bits.incl.pl1 3929 23 04/07/83 1635.0 statement.incl.pl1 >ldd>include>statement.incl.pl1 3930 24 05/03/76 1320.4 statement_types.incl.pl1 >ldd>include>statement_types.incl.pl1 3931 25 12/07/83 1701.7 symbol.incl.pl1 >ldd>include>symbol.incl.pl1 3932 26 12/07/83 1700.1 pl1_symbol_type.incl.pl1 >ldd>include>pl1_symbol_type.incl.pl1 3933 27 07/21/80 1546.3 symbol_bits.incl.pl1 >ldd>include>symbol_bits.incl.pl1 3934 28 12/07/83 1701.7 system.incl.pl1 >ldd>include>system.incl.pl1 3935 29 09/14/77 1705.7 token.incl.pl1 >ldd>include>token.incl.pl1 3936 30 11/30/78 1227.4 token_types.incl.pl1 >ldd>include>token_types.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. RHS_aggregate 0(06) based bit(1) level 2 packed packed unaligned dcl 22-27 set ref 3553* abs builtin function dcl 3748 ref 3776 add 000142 constant bit(9) initial dcl 20-8 set ref 969 2581 2815* addr builtin function dcl 108 in procedure "builtin" ref 285 321 338 340 344 347 347 356 361 407 410 834 845 861 905 929 934 990 1214 1236 1326 1420 1620 1629 2264 2278 2289 2708 2738 2763 3021 3553 3869 addr builtin function dcl 3585 in procedure "declare_defined_overlay" ref 3614 addr_fun_bits constant bit(9) initial dcl 20-8 ref 2336 address 10 based structure level 2 packed packed unaligned dcl 21-3 agg_ref 001532 automatic pointer initial dcl 62 set ref 62* 1311 1314 1315 1316 1317 3555* 3560* 3561 3562 3563 aggregate based bit(1) level 2 in structure "def_this_context" packed packed unaligned dcl 22-27 in procedure "builtin" ref 356 aggregate based bit(1) level 2 in structure "def_context" packed packed unaligned dcl 22-8 in procedure "builtin" set ref 410* aggregate defined bit(1) level 2 in structure "def_save_context" packed packed unaligned dcl 268 in procedure "builtin" ref 402 2274 2341 2382 2431 2455 2467 2479 2627 2665 aggregate_result 4(18) 000206 external static bit(1) array level 3 packed packed unaligned dcl 11-19 ref 361 402 aliasable_bit 000124 constant fixed bin(15,0) initial dcl 27-3 set ref 2322* aligned 0(21) 001607 automatic bit(1) array level 2 packed packed unaligned dcl 257 set ref 2357 aligned_mask constant bit(36) initial dcl 17-3 ref 588 672 676 1429 1498 1586 1621 1743 3046 aligned_ref 12(07) based bit(1) level 3 packed packed unaligned dcl 21-3 set ref 1064* alloc_in_text 32(08) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 3766 3790 allocate 33(02) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 2565* and_bits constant bit(9) initial dcl 20-8 ref 1878 1886 area 31(07) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 25-3 in procedure "builtin" set ref 2156* 2160 area 0(07) 001607 automatic bit(1) array level 2 in structure "arg_type" packed packed unaligned dcl 257 in procedure "builtin" set ref 2345 arg 000102 automatic pointer array dcl 62 set ref 352* 363* 363* 372 380 382 445 490* 490* 507 507* 516 520 543* 543* 576 599* 649 649 691* 691 696* 697 714* 717* 717 719* 719* 719 722* 722* 731 731 737* 775* 775 780* 781 804* 804* 805 811 824 840 840 840* 848 849 849 912 928 932 944* 950 969 969 969 969 969 969 975 980 986 996 999 1008 1018 1061 1062* 1064 1064 1064 1066 1067 1068 1069 1069 1071 1072 1073 1074 1076 1076 1079 1081 1089 1091 1096 1105 1106 1121 1122 1125 1126 1126 1129 1140 1143 1147 1148 1148 1149 1157 1190 1195 1197 1200 1200 1202 1202 1202 1205 1205 1207 1207 1207 1210 1212* 1215 1222 1230 1230 1230* 1236 1251* 1275 1303* 1303* 1307 1311* 1314* 1331 1344* 1355 1357 1358 1359 1360 1599 1604 1605* 1605* 1606 1624* 1656 1659* 1662 1664 1664 1664* 1682 1825* 1851* 1851* 1870 1874 1895 1901* 1905 1906 1938* 1942 1944* 1993* 1993* 1999* 2000 2002* 2003 2050* 2064* 2075* 2076 2076* 2079* 2079* 2081 2081* 2081* 2084 2084 2088 2089* 2093* 2094 2094* 2097* 2097* 2099 2099* 2099* 2102 2102 2106 2107* 2112 2115* 2119* 2119* 2128* 2130 2133* 2134 2142 2152* 2153 2160* 2171 2172* 2177* 2184 2190 2201 2206 2206 2209 2210* 2224 2229* 2229* 2232 2233 2235 2237 2238 2284 2311 2314 2328 2330* 2330* 2331 2331 2331 2336 2336 2336 2345* 2351* 2360 2361* 2379* 2396 2396 2406* 2409* 2409 2485* 2490 2539 2539* 2539* 2542 2545 2590* 2604 2605 2620* 2629 2632* 2632* 2636 2640 2643 2645 2645 2651 2655 2658* 2668 2677* 2678 2704* 2709* 2713 2713* 2713* 2716 2716 2718 2722 2738* 2743 2752* 2761 2767* 2770* 2820* 2833* 2836* 2842* 2846* 2857* 2865* 2865 2870* 2926 3038 3106* 3108* 3123 3130 3510 3510* 3510* 3513* 3513* 3520* 3520* 3522* 3522* 3525 3544 3551 3551 3551 3721* 3722 3871* arg1 parameter pointer dcl 3801 ref 3795 3833 arg2 parameter pointer dcl 3801 ref 3795 3835 arg3 parameter pointer dcl 3801 ref 3795 3836 arg_descriptor 31(11) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 2084 2102 arg_list 0(01) based bit(1) level 2 packed packed unaligned dcl 22-8 ref 990 1214 1326 1420 1620 3869 arg_number 001542 automatic fixed bin(31,0) dcl 62 set ref 289* 291* 306 311 316 316 334 352 363 416 507 593 605 639 657 662 679 682 699* 783* 942 955 1096 1480 1483 1494* 1504 1509 1592 1602 1609* 1703 1720 1735 1936 2006* 2617 2676* 2782 2836 2842 2873* 2923 2925 2945 2946 2962 2964 2998 3004 3006 3078 3119 3122 3147 3185 3195 3196 3223 3253 3291 3322 3347 3360 3371 3383 3397 3404 3406 3875* arg_symbol 001102 automatic pointer array dcl 62 set ref 379* 386* 391* 392 407* 468 468 474 497* 507* 550* 605 605 607 614 639* 657* 662* 682* 685* 694* 694 697* 754 754 757 758 760 778* 778 781* 788* 788* 797* 840 845* 868 880 902 912* 935* 936 962* 964* 999 1022 1120* 1121* 1129* 1134* 1230 1240* 1241 1259 1262 1262 1279 1280 1281 1284 1285 1303 1303 1303* 1339 1341 1341* 1447 1447 1453 1483* 1486* 1504* 1509* 1542 1569 1570 1571 1572 1592* 1594* 1621 1627 1629* 1632 1664 1710 1737 1738 1754 1780 1781 1782 1783 1796* 1800 1800 1804 1804 1849 1858 1945* 1967 1973 1976 1978 1980 1982 1982 1990 1993 1993* 1996 1998* 2000* 2003* 2014* 2020 2135 2135 2137 2137 2153* 2155 2156 2157 2157 2160 2162 2162 2168 2168* 2188 2190 2205 2222 2224 2318 2318 2322* 2323* 2324 2324 2328 2328 2330* 2389 2389 2490* 2496 2512 2513 2514 2519 2616* 2617* 2651 2670 2677 2678* 2782 2868* 2868 2871* 2905* 2950 2951 2965* 3009* 3012* 3052 3052 3058 3460* 3516 3533* arg_type 001607 automatic structure array level 1 packed packed unaligned dcl 257 set ref 380* 380 382* 382 388* 388 392* 392 424 424 439 439 478 478 478 478 498* 498 529 529 551* 551 569 569 588 588 827 827 843 843 854 854 1226 1226 1315* 1315 1429 1429 1441 1441 1536 1536 1704 1704 1748 1748 2372 2372 3048* 3048 3050* 3050 3052* 3052 3056* 3056 3058* 3058 3060* 3060 3474 3474 3478 3478 3526* 3526 arith_size_ck 001573 automatic bit(1) initial dcl 62 set ref 62* 2624* 3044* 3880 arithmetic_mask 000151 constant bit(36) initial dcl 17-41 ref 478 2372 3477 3478 array 2(15) based bit(1) level 2 in structure "label" packed packed unaligned dcl 15-1 in procedure "builtin" ref 1976 array based structure level 1 dcl 8-1 in procedure "builtin" array 12 based pointer level 2 in structure "symbol" packed packed unaligned dcl 25-3 in procedure "builtin" set ref 1279 1280 1281 1990 1996 2020 3790 array_ref 0(09) based bit(1) level 2 packed packed unaligned dcl 21-3 set ref 849 886 912 1244 1279 1303 2171 2328 3012 as_if_type 002007 automatic structure array level 1 packed packed unaligned dcl 261 set ref 1441* 1441 1443* 1443 1445* 1445 1447* 1447 1451* 1451 1453* 1453 1455* 1455 1536* 1536 1538* 1538 1540* 1540 1542* 1542 1545* 1545 1704* 1704 1706* 1706 1708* 1708 1710* 1710 1713* 1713 1748* 1748 1750* 1750 1752* 1752 1754* 1754 1757* 1757 assign 000217 constant bit(9) initial dcl 20-8 set ref 992* 1327* 1608 1865* 1869* 1873* 1893* 1940* 2086* 2104* 2220* 2358* 2558* 2579* 2698 2741* 2766* 3035* 3540* 3876 3880 3890 assign_size_ck constant bit(9) initial dcl 20-8 ref 3880 3890 assignment_statement 000125 constant bit(9) initial dcl 24-3 set ref 1657* 2575* 2588* 2748* 3546* asterisk 000115 constant bit(9) initial dcl 30-3 set ref 2958* attributes 31 based structure level 2 dcl 25-3 set ref 392 1315 2562 2615 3872 auto 32(09) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 2244* 2565* 2724* back 2 based pointer level 2 packed packed unaligned dcl 23-9 ref 735 1657 2575 2748 2983 3546 based_type based bit(36) packed unaligned dcl 62 ref 1858 binary 0(29) 001607 automatic bit(1) array level 2 in structure "arg_type" packed packed unaligned dcl 257 in procedure "builtin" set ref 507 531 1522 3070 3499 3518 binary 0(29) 002213 automatic bit(1) level 2 in structure "type" packed packed unaligned dcl 26-3 in procedure "builtin" set ref 3482* 3488 3497 3499* 3518 binary 0(29) 002007 automatic bit(1) array level 2 in structure "as_if_type" packed packed unaligned dcl 261 in procedure "builtin" set ref 1722 binary 0(29) 001606 automatic bit(1) level 2 in structure "rtype" packed packed unaligned dcl 255 in procedure "builtin" set ref 1576 1722* 1722 1728 1789 2527 2534 3068 3070* binary 31(29) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 25-3 in procedure "builtin" set ref 3702 binary_mask constant bit(36) initial dcl 17-3 ref 459 1466 1559 1771 bit 0(03) 001607 automatic bit(1) array level 2 in structure "arg_type" packed packed unaligned dcl 257 in procedure "builtin" set ref 464 529 540 608 676 704 704 827 854 885 897 1320 1921 1921 2135 2364 2501 2805 2805 2823 2823 3050 3480 3890 bit 0(03) 001606 automatic bit(1) level 2 in structure "rtype" packed packed unaligned dcl 255 in procedure "builtin" set ref 922 bit 31(03) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 25-3 in procedure "builtin" set ref 873 1259 3460 bit 0(03) 002007 automatic bit(1) array level 2 in structure "as_if_type" packed packed unaligned dcl 261 in procedure "builtin" set ref 1443 1538 1706 1750 bit builtin function dcl 108 in procedure "builtin" ref 2202 bit36 based bit(36) packed unaligned dcl 3586 ref 3614 bit4 001600 automatic bit(4) dcl 62 set ref 1858* 1859 1861* 1861 1864 1868 1872 1878 1880 1882 1888 bit_ constant fixed bin(3,0) initial dcl 10-5 ref 873 897 922 1079 1234 1320 1365 1380 1399 1647 3460 bit_mask 000155 constant bit(36) initial dcl 17-3 set ref 540 704 1233 1336 1850* 1894* 1898* 1909* 1913* 1921 1933 2366 2438 2473 2673 2805 2823 2892 bit_size 23 based pointer level 2 packed packed unaligned dcl 25-3 set ref 1285* 1317* bit_to_char 000225 constant bit(9) initial dcl 20-8 set ref 1294* bits 12(06) based structure level 2 in structure "reference" packed packed unaligned dcl 21-3 in procedure "builtin" bits 13 based structure level 2 in structure "statement" packed packed unaligned dcl 23-9 in procedure "builtin" bits_per_character 000250 constant fixed bin(31,0) initial dcl 28-5 set ref 1266* 1269 1299 1382 1390* 1642 bits_per_digit 000250 constant fixed bin(31,1) initial dcl 28-69 ref 1638 bits_per_double constant fixed bin(31,0) initial dcl 28-5 ref 1855 block_node 4 based pointer level 2 packed packed unaligned dcl 25-3 set ref 760 2655 bound based structure level 1 dcl 8-21 bound_ck 000227 constant bit(9) initial dcl 20-8 set ref 3259* 3277* 3335* boundary 2(20) based fixed bin(3,0) level 2 packed packed unaligned dcl 25-3 set ref 1627* 1627 bounds 12 based pointer level 2 packed packed unaligned dcl 8-1 ref 2019 brother 20 based pointer level 2 packed packed unaligned dcl 25-3 set ref 3464 builtin 31(16) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 25-3 in procedure "builtin" set ref 3823* builtin 000064 constant entry external dcl 1-17 in procedure "builtin" ref 3200 3413 3841 builtin_name parameter char packed unaligned dcl 3801 ref 3795 3812 3818 builtin_number 001543 automatic fixed bin(31,0) dcl 62 set ref 294* 295 296 297 299 304 306 311 316 316 357 361 402 416 418 419 1498 1586 builtin_string 001604 automatic char(8) dcl 62 set ref 322* 324 324 324 324 324 324 324 324 builtin_symbol parameter pointer dcl 60 set ref 31 285* 294 299* 306* 311* 316* 322 324* 404* 627* 643* 666* 679* 834* 849* 861* 905* 907* 929* 1136* 1143* 1175* 1196* 1236* 1245* 1275* 1480* 1812* 1967* 1976* 1990* 2016* 2147* 2311* 2314* 2318* 2354* 2389* 2496* 2542* 2609* 2611* 2698* 3200* 3413* 3866* by_compiler 000154 constant bit(3) initial dcl 14-5 set ref 993* 1000* 1328* 2561* 2723* 2948* 3541* 3631* 3821* by_name_assignment 0(14) based bit(1) level 2 packed packed unaligned dcl 22-8 ref 361 c_bit_size 27 based fixed bin(24,0) level 2 dcl 25-3 set ref 1284 1316 1638 1642 1648 c_dcl_size 30 based fixed bin(24,0) level 2 dcl 25-3 set ref 294 452 456 607 754 1569 1570 1737 1780 1781 1800 1804 2157* 2162 2563* 2729* 2731* 2734 2782 3614 3702 3758 3824* c_element_size_bits 3 based fixed bin(24,0) level 2 dcl 8-1 ref 1280 c_length 2 based fixed bin(24,0) level 2 in structure "reference" dcl 21-3 in procedure "builtin" set ref 608 768 797 805 816 891 949 1096* 1106* 1121* 1125* 1140 1143 1148 1149* 1195 1197* 1256 1606 1833 1833 1842 1845 2134 2141 2734* 2745* 2745 2848 c_length 001555 automatic fixed bin(31,0) dcl 62 in procedure "builtin" set ref 891* 945* 949* 1096 1108* 1140* 1143 1165* 1175 1252* 1256* 1269* 1269 1280* 1284* 1299* 1299 1316* 1344* c_lower 1 based fixed bin(24,0) level 2 dcl 8-21 set ref 2027* 2042 2042 2069 2094 c_offset 001556 automatic fixed bin(31,0) dcl 62 in procedure "builtin" set ref 964* 967* 1069 1096 1111* 1170* 1175 1175 c_offset 004165 automatic fixed bin(24,0) dcl 3582 in procedure "declare_defined_overlay" set ref 3602* 3604* 3614 3638 c_offset 1 based fixed bin(24,0) level 2 in structure "reference" dcl 21-3 in procedure "builtin" set ref 1033* 1033 1037* 1067 1072* 1358* 1358 1382* 1382 1384* 1384 1403* 1638* 1642* 1648* 1652* 1668 1671 1676* 1679* 2206 2233* 2233 2238* 3439 3602 3614 3638* 3654* c_upper 2 based fixed bin(24,0) level 2 dcl 8-21 set ref 2035* 2056 2056 2069 2076 c_word_size 26 based fixed bin(24,0) level 2 dcl 25-3 set ref 1652 2157* 2645 2645 call_statement 000152 constant bit(9) initial dcl 24-3 set ref 285 735* 2983* char 0(04) 002213 automatic bit(1) level 2 in structure "type" packed packed unaligned dcl 26-3 in procedure "builtin" set ref 714 char 0(04) 001607 automatic bit(1) array level 2 in structure "arg_type" packed packed unaligned dcl 257 in procedure "builtin" set ref 438 466 529 608 672 885 2372 2506 3048 3486 3890 char 31(04) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 25-3 in procedure "builtin" set ref 875 1014* 1262 2724* 3460 3516 char 0(04) 002007 automatic bit(1) array level 2 in structure "as_if_type" packed packed unaligned dcl 261 in procedure "builtin" set ref 1445 1540 1708 1752 char_mask 000153 constant bit(36) initial dcl 17-3 set ref 531 707 829 856 916 1334 1925 2299 2305 2485* 2689 2713* 2808 2826 char_type 000153 constant bit(36) initial dcl 28-71 set ref 696* 700 780* 784 2870* 2874 2900 character_ constant fixed bin(3,0) initial dcl 10-5 ref 875 890 899 925 1081 1292 1322 1334 1367 1380 1387 1641 3460 check_code 13 000206 external static fixed bin(15,0) array level 4 dcl 11-19 ref 357 418 check_indicator 7 000206 external static fixed bin(15,0) array level 3 dcl 11-19 ref 304 check_star_extents 000066 constant entry external dcl 1-27 ref 2978 code 001544 automatic fixed bin(31,0) dcl 62 set ref 418* 421 424 430 433 433 434 463 486 506 528 539 562 568 575 coff 001557 automatic fixed bin(31,0) dcl 62 set ref 1067* 1069* 1072 1668* 1671* 1676 collating_sequence 000010 internal static char(128) initial dcl 62 set ref 631* compare_expression 000122 constant entry external dcl 2-48 ref 3231 3329 compiler_developed 32(35) based structure level 3 packed packed unaligned dcl 25-3 complex 0(31) 002007 automatic bit(1) array level 2 in structure "as_if_type" packed packed unaligned dcl 261 in procedure "builtin" set ref 1469 1469 1548 1716 1760 complex 0(31) 001607 automatic bit(1) array level 2 in structure "arg_type" packed packed unaligned dcl 257 in procedure "builtin" set ref 434 441 1516 1953 2514 2800 3075 3504 complex 31(31) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 25-3 in procedure "builtin" set ref 468 1447 3052 3702 complex 0(31) 001606 automatic bit(1) level 2 in structure "rtype" packed packed unaligned dcl 255 in procedure "builtin" set ref 2421 3073 3075* complex 0(31) 002213 automatic bit(1) level 2 in structure "type" packed packed unaligned dcl 26-3 in procedure "builtin" set ref 3483 3489 3502 3504* complex_mask constant bit(36) initial dcl 17-3 ref 1429 1471 1563 1616 computational_mask 000150 constant bit(36) initial dcl 17-41 ref 569 constant 001541 automatic fixed bin(17,0) dcl 62 in procedure "builtin" set ref 2025* 2027 2033* 2035 constant 32(16) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 25-3 in procedure "builtin" set ref 1849 2318 3232 3232 3439 3758 3790 constant_bit_string based bit packed unaligned dcl 62 ref 2135 2135 constant_char_string based char packed unaligned dcl 62 ref 2137 2137 constant_length 000124 constant entry external dcl 2-54 ref 2905 constant_string_length 001603 automatic fixed bin(21,0) dcl 62 set ref 2134* 2135 2135 2137 2137 context parameter bit(36) dcl 22-5 set ref 31 285 321 347 361 407 410 834 845 861 905 929 934 990 1212* 1214 1236 1326 1418* 1420 1620 1629 2264 2278 2289 2708 2738 2763 3021 3841* 3869 controlled 32(12) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 2389 convert 000126 constant entry external dcl 2-60 in procedure "builtin" ref 2713 3513 3522 convert builtin function dcl 3754 in procedure "constant_value" ref 3766 convert$from_builtin 000132 constant entry external dcl 2-72 ref 445 1605 3108 3510 3520 convert$to_integer 000130 constant entry external dcl 2-66 ref 490 543 761 1202 1207 1411 1415 2286 convert$to_target 000136 constant entry external dcl 2-88 ref 1851 convert$to_target_fb 000134 constant entry external dcl 2-82 ref 2632 3106 3901 copy_expression 000140 constant entry external dcl 2-94 ref 757 840 1022 1172 1185 1230 1281 1285 1317 1599 1664 2046 2060 2075 2093 2188 2213 2215 2222 2235 2650 2990 3629 3650 copy_words 000136 constant bit(9) initial dcl 20-8 set ref 2200* cp 003266 automatic pointer initial array dcl 3138 set ref 3138* 3178* 3181 3197 3323 3348 3361 3372 3384 3386* 3386* 3398 3407 3409 create_list 000142 constant entry external dcl 2-147 ref 2283 2760 2923 2946 3006 3195 3404 3831 create_operator 000144 constant entry external dcl 2-152 ref 808 985 992 1086 1100 1155 1160 1181 1264 1294 1327 1372 1389 1395 1837 1865 1869 1873 1893 1897 1904 1912 1940 2086 2104 2110 2183 2200 2220 2248 2279 2281 2358 2554 2558 2579 2602 2741 2756 2758 2765 2766 2815 2853 2929 2938 3035 3119 3259 3277 3278 3279 3335 3336 3337 3540 3666 3719 create_reference 000146 constant entry external dcl 2-158 ref 1026 1046 2208 create_statement 000150 constant entry external dcl 2-163 ref 735 1657 2575 2588 2748 2983 3546 create_symbol 000152 constant entry external dcl 2-184 ref 993 1000 1328 2561 2723 2948 3541 3631 3821 create_token 000154 constant entry external dcl 2-191 ref 2581 2583 2958 3812 cross_reference based structure level 1 dcl 12-3 cross_references 10 based pointer level 2 packed packed unaligned dcl 25-3 set ref 2324 2324 cunits 001537 automatic fixed bin(3,0) dcl 62 set ref 1068* 1069* 1073 1669* 1671* 1677 cur_block parameter pointer dcl 60 set ref 31 352* 363* 1114* 1200* 1205* 1216* 1303* 1410* 1414* 1422* 1686* 1993* 2048* 2062* 2081* 2099* 2119* 2172* 2193* 2221* 2227* 2229* 2330* 2331* 2539* 2561* 2573* 2586* 2590* 2607* 2709* 2723* 2948* 2965* 3012* 3200* 3413* 3555* 3559* 3841* cur_length 001526 automatic pointer array dcl 62 set ref 1825* 1827* 1829* 1833 1833 1839 1840 1842 1845 data_type 31 based structure level 3 packed packed unaligned dcl 25-3 set ref 2155 2950* 2950 3614 dcl_length 001534 automatic pointer initial dcl 62 set ref 62* dcl_size 24 based pointer level 2 packed packed unaligned dcl 25-3 set ref 754 757* 2162 2188* 2205 2222* 2958* 3614 dec_integer 000114 constant bit(9) initial dcl 30-3 set ref 380 520 649 2581* 2583* dec_integer_type 000120 constant bit(36) initial dcl 28-71 ref 380 decimal 31(28) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 25-3 in procedure "builtin" set ref 1634 decimal 0(28) 002213 automatic bit(1) level 2 in structure "type" packed packed unaligned dcl 26-3 in procedure "builtin" set ref 3482 3488* 3497 3498* 3516 decimal 0(28) 001606 automatic bit(1) level 2 in structure "rtype" packed packed unaligned dcl 255 in procedure "builtin" set ref 1488 1581 1728* 1800 1815 3068 3069* 3086 decimal 0(28) 002007 automatic bit(1) array level 2 in structure "as_if_type" packed packed unaligned dcl 261 in procedure "builtin" set ref 1464 1464 1557 1557 1769 1769 decimal 0(28) 001607 automatic bit(1) array level 2 in structure "arg_type" packed packed unaligned dcl 257 in procedure "builtin" set ref 438 439 531 3069 3498 3516 decimal_mask constant bit(36) initial dcl 17-3 ref 1464 1466 1557 1559 1769 1771 decimal_result 001572 automatic bit(1) initial dcl 62 set ref 62* 452 455* 3897 declaration 1 based pointer level 2 packed packed unaligned dcl 29-3 set ref 3814 3825* 3828 declare 000070 constant entry external dcl 1-41 ref 2567 2736 2960 declare_constant 000156 constant entry external dcl 2-211 ref 696 780 1985 2042 2056 2070 2270 2598 2645 2870 declare_constant$bit 000160 constant entry external dcl 2-219 ref 1866 2135 2202 declare_constant$char 000162 constant entry external dcl 2-224 ref 631 2137 2836 2842 2860 declare_constant$integer 000164 constant entry external dcl 2-234 ref 754 768 797 987 1108 1111 1148 1158 1165 1170 1184 1266 1390 1842 1845 1999 2002 2076 2094 2113 2185 2203 2818 2833 2833 2848 2857 2857 declare_descriptor 000166 constant entry external dcl 2-239 ref 2965 3012 declare_integer 000170 constant entry external dcl 2-269 ref 2221 declare_temporary 000172 constant entry external dcl 2-292 ref 809 1087 1101 1156 1161 1182 1373 1838 1850 1894 1898 1909 1913 1941 2087 2105 2111 2282 2359 2485 2759 2945 2974 2989 3018 3037 3105 3117 3260 3280 3339 3629 3629 3667 3720 3900 decoded_type 000155 constant bit(36) initial array dcl 13-6 ref 382 def_context based structure level 1 dcl 22-8 def_save_context defined structure level 1 packed packed unaligned dcl 268 def_this_context based structure level 1 dcl 22-27 default_fix_bin_p 000214 constant fixed bin(31,0) initial dcl 28-5 set ref 1087* 1101* 1156* 1161* 1182* 1373* 1838* 2105* 2400 2426 2778 3260* 3280* 3339* defined 32(13) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 1006* 1303 1993 2240* 2328 3641* defined_arg_type defined bit(36) array packed unaligned dcl 259 set ref 380* 382* 388* 392* 424 439 478 478 498* 529 551* 569 588 827 843 854 1226 1315* 1429 1441 1536 1704 1748 2372 3048* 3050* 3052* 3056* 3058* 3060* 3474 3478 3526* defined_as_if_type defined bit(36) array packed unaligned dcl 263 set ref 1441* 1443* 1445* 1447* 1451* 1453* 1455* 1536* 1538* 1540* 1542* 1545* 1704* 1706* 1708* 1710* 1713* 1748* 1750* 1752* 1754* 1757* defined_reference 000072 constant entry external dcl 1-47 ref 1303 1993 2330 desc_reqd 001571 automatic bit(1) initial dcl 62 set ref 62* 1949* 2492* 2941 description 1 000206 external static structure array level 2 unaligned dcl 11-19 descriptor 13 000206 external static structure array level 3 in structure "pl1_data$builtin_name" unaligned dcl 11-19 in procedure "builtin" descriptor 13 based pointer level 2 in structure "symbol" packed packed unaligned dcl 25-3 in procedure "builtin" set ref 2962 digit_ constant fixed bin(3,0) initial dcl 10-5 ref 1380 1384 1637 digit_to_bit 000133 constant bit(9) initial dcl 20-8 set ref 1395* dimensioned 31(19) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 2953* dimensioned_mask constant bit(36) initial dcl 17-3 ref 392 3899 divide builtin function dcl 108 ref 1299 1384 1638 1642 element 1 based pointer array level 2 packed packed unaligned dcl 16-6 set ref 352 363* 507 2284* 2286* 2761* 2926* 2962* 2965* 2970* 2996* 3012* 3148 3197* 3407* 3409* 3766 3766 3833* 3835* 3836* element_size_bits 6 based pointer level 2 packed packed unaligned dcl 8-1 set ref 1281* empty_area 000130 constant bit(9) initial dcl 20-8 set ref 2183* entry 0(09) 001607 automatic bit(1) array level 2 packed packed unaligned dcl 257 set ref 576 error_number 001540 automatic fixed bin(15,0) dcl 62 set ref 3846* 3850* 3854* 3858* 3862* 3866* evaluate_offset 0(04) based bit(1) level 2 packed packed unaligned dcl 22-27 set ref 338* expand_assign 000074 constant entry external dcl 1-62 ref 3555 expand_infix 000076 constant entry external dcl 1-76 ref 2607 expand_primitive 000100 constant entry external dcl 1-97 ref 363 2172 2539 expression_semantics 000102 constant entry external dcl 1-105 ref 352 760 1114 1200 1205 1410 1414 1686 2048 2062 2081 2099 2119 2193 2227 2229 2331 2573 2655 2709 external 32(02) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 2953* f_offset_to_be_added 0(12) based bit(1) level 2 in structure "def_context" packed packed unaligned dcl 22-8 in procedure "builtin" ref 347 f_offset_to_be_added 0(12) based bit(1) level 2 in structure "def_this_context" packed packed unaligned dcl 22-27 in procedure "builtin" set ref 347* father 17 based pointer level 2 packed packed unaligned dcl 25-3 set ref 2389 2640 fill_refer 000104 constant entry external dcl 1-113 ref 1409 2047 2061 2079 2097 2190 2224 fixed 0(01) 002213 automatic bit(1) level 2 in structure "type" packed packed unaligned dcl 26-3 in procedure "builtin" set ref 3481* 3487* 3492 3493* 3518 fixed 0(01) 002007 automatic bit(1) array level 2 in structure "as_if_type" packed packed unaligned dcl 261 in procedure "builtin" set ref 1459 1459 1552 1552 1764 1764 fixed 0(01) 001606 automatic bit(1) level 2 in structure "rtype" packed packed unaligned dcl 255 in procedure "builtin" set ref 1491 1576 1725* 1799 2525 3063 3064* 3092 fixed 31(01) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 25-3 in procedure "builtin" set ref 3702 fixed builtin function dcl 108 in procedure "builtin" ref 382 614 1571 1572 1738 1782 1783 fixed 0(01) 001607 automatic bit(1) array level 2 in structure "arg_type" packed packed unaligned dcl 257 in procedure "builtin" set ref 489 507 542 1522 3064 3493 3518 3880 fixed_binary_real_mask 000147 constant bit(36) initial dcl 17-41 set ref 464 487 523 555 676 726 1101* 1443 1538 1706 1750 2007 2111* 2122 2374 2416 2425 2461 2502 3050 3720* fixed_decimal_complex_mask 000144 constant bit(36) initial dcl 17-41 ref 472 1451 2517 3056 fixed_decimal_real_mask 000146 constant bit(36) initial dcl 17-41 ref 466 476 672 1445 1455 1540 1545 1708 1713 1752 1757 2507 2521 3048 3060 fixed_mask constant bit(36) initial dcl 17-3 ref 439 655 1459 1461 1552 1554 1764 1766 2532 float 0(02) 001606 automatic bit(1) level 2 in structure "rtype" packed packed unaligned dcl 255 in procedure "builtin" set ref 1480 1491 1721* 1721 1725 1787 1811 3063 3065* float 0(02) 001607 automatic bit(1) array level 2 in structure "arg_type" packed packed unaligned dcl 257 in procedure "builtin" set ref 489 542 679 3065 3494 3880 float 0(02) 002213 automatic bit(1) level 2 in structure "type" packed packed unaligned dcl 26-3 in procedure "builtin" set ref 3481 3487 3492 3494* float 0(02) 002007 automatic bit(1) array level 2 in structure "as_if_type" packed packed unaligned dcl 261 in procedure "builtin" set ref 1721 float_decimal_complex_mask 000143 constant bit(36) initial dcl 17-41 ref 441 468 1447 2514 3052 float_decimal_real_mask 000145 constant bit(36) initial dcl 17-41 ref 443 474 1453 1542 1710 1754 2519 3058 float_mask constant bit(36) initial dcl 17-3 ref 439 459 636 1461 1554 1766 2532 fo_in_qual 12(22) based bit(1) level 3 packed packed unaligned dcl 21-3 set ref 1069* 1356* 1356 1671* 1683* 1683 2336 force_nonquick 13(09) based bit(1) level 3 packed packed unaligned dcl 23-9 set ref 2980* format 0(15) 001607 automatic bit(1) array level 2 packed packed unaligned dcl 257 set ref 576 found 004174 automatic bit(1) dcl 3587 set ref 3607* 3613 3614* 3623 full_attribute_set 001576 automatic bit(1) dcl 62 set ref 687* 1602* 1606 3078* 3104 full_processing 004074 automatic bit(1) initial dcl 3145 set ref 3145* 3238* 3246 general 16 based pointer level 2 packed packed unaligned dcl 25-3 set ref 1015* 2677 generated 13(02) based bit(1) level 3 packed packed unaligned dcl 23-9 set ref 1660* 2577* 2589* 3549* half_ constant fixed bin(3,0) initial dcl 10-5 ref 1076 1362 high_bound 3(18) based fixed bin(17,0) level 2 packed packed unaligned dcl 15-1 ref 1980 1982 i 001545 automatic fixed bin(31,0) dcl 62 in procedure "builtin" set ref 334* 337 344 347 352 352 357 363 363 363 372 372 374 375 375 378 379 379 380 380 382 382 385 386 386 387 388 390 391 391 392 392* 416* 418 419 424 434 438 438 438 439 439 441 445 454 464 466 468 468 468 474 478 478 489 489 490 490 490 492 493 494 494 497 497 498 507 507 507 507 507 507 507 516 520 529 529 529 531 531 531 540 542 542 543 543 543 545 546 547 547 550 550 551 562 569 576 576 576 576* 593* 594 594 596* 710* 826* 853* 915* 1225* 1440* 1441 1441 1443 1443 1445 1445 1447 1447 1447 1447 1451 1453 1453 1455* 1476* 1535* 1536 1536 1538 1538 1540 1540 1542 1542 1542 1545 1548* 1565* 1703* 1704 1704 1706 1706 1708 1708 1710 1710 1710 1713 1716* 1720* 1721 1722* 1735* 1737 1738* 1747* 1748 1748 1750 1750 1752 1752 1754 1754 1754 1757 1760* 1776* 1796* 1800 1804 1809 1812 1815 1817 1823* 1825 1825 1825 1827 1827 1827 1829* 1929* 1936* 1937 1938 1941 1942 1944 1945 1945* 2020* 2118* 2119 2119* 2365* 2373* 2596* 2598 2598 2811* 2829* 2925* 2926 2926* 2964* 2965 2965 2965* 3011* 3012 3012 3012 3012* 3122* 3123 3123* 3474 3478 3480 3486 3493 3494 3498 3499 3503 3504 3508 3510 3510 3510 3513 3513 3516 3516 3518 3518 3518 3520 3520 3522 3522 3525 3525 3526 3528 3529 3530 3530 3533 3533 i 003666 automatic fixed bin(15,0) dcl 3138 in procedure "expand_arguments" set ref 3147* 3148 3152 3156 3156 3162 3163 3169 3173 3178 3181 3181* 3185* 3187 3187* 3196* 3197 3197* 3211* 3223* 3226* 3253* 3254* 3257* 3275* i 000512 automatic fixed bin(15,0) dcl 3307 in procedure "merge" set ref 3322* 3323 3324 3326 3329* 3347* 3348 3349 3350* 3360* 3361 3361 3361* 3371* 3372 3373 3375* 3383* 3384 3384 3384 3386 3386* 3397* 3398 3398 3398 3398* 3406* 3407 3407 3407 3409 3409* i 004266 automatic fixed bin(15,0) dcl 3806 in procedure "make_builtin_reference" set ref 3818* 3818* 3824 identifier 000235 constant bit(9) initial dcl 30-3 set ref 3812* ignore_based 0(08) based bit(1) level 2 packed packed unaligned dcl 22-27 set ref 344* imag_fun constant bit(9) initial dcl 20-8 ref 1634 index_rev_fun constant bit(9) initial dcl 20-8 ref 716 indicator 001546 automatic fixed bin(31,0) dcl 62 set ref 304* 306 311 316 info 11 based structure level 2 packed packed unaligned dcl 21-3 inhibit 10(28) based bit(1) level 3 packed packed unaligned dcl 21-3 set ref 1042* 1406* 1681* initial 11 based pointer level 2 packed packed unaligned dcl 25-3 set ref 1858 2135 2135 2137 2137 2318 3758 3761 3766 3766 initial_value 004242 automatic fixed bin(71,0) dcl 3752 set ref 3758* 3761* 3766* 3766 3771* 3773* 3776 3779 initialed 31(20) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 2953* initialed_mask constant bit(36) initial dcl 17-3 ref 392 3899 input_tree parameter pointer dcl 60 ref 31 283 2698 2698 integer 001560 automatic fixed bin(31,0) dcl 62 set ref 2014* 2016 2016 2020 integer_1 based fixed bin(35,0) dcl 3739 ref 3761 integer_2 based fixed bin(71,0) dcl 3740 ref 3758 integer_24 001570 automatic fixed bin(24,0) dcl 62 set ref 2158* 2162* 2164* 2185 2185 2202 integer_type 000121 constant bit(36) initial dcl 28-71 set ref 490* 498 543* 551 745 761* 809* 1087* 1156* 1161* 1182* 1202* 1207* 1373* 1411* 1415* 1838* 1985* 2042* 2056* 2070* 2087* 2105* 2286* 2295 2399 2645* 2776 2882 2910 2974* 3037* 3260* 3280* 3339* 3667* internal 32(01) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 2953* irreducible 31(34) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 2934* 3027* j 003667 automatic fixed bin(15,0) dcl 3138 in procedure "expand_arguments" set ref 3228* 3291* 3292 3293 3294 3297 3297* j 000513 automatic fixed bin(15,0) dcl 3307 in procedure "merge" set ref 3380* 3381 3384 3386 3390* jcount 003672 automatic fixed bin(15,0) initial dcl 3138 set ref 3138* 3170* 3170 3336 3337 join 000126 constant bit(9) initial dcl 20-8 set ref 849 2248* 2765* 3167 3370 3375 3398 3551 jp 002666 automatic pointer initial array dcl 3138 set ref 3138* 3169* 3173 3203* jpp 002264 automatic pointer initial dcl 3138 set ref 3138* 3173 3173* 3191 3203 3203* 3203* 3206 3215 3215 3259* 3260 3261 3262 3263 3265 3277* 3280 3282 3283 3284 3286 jump_index 6 000206 external static fixed bin(15,0) array level 3 in structure "pl1_data$builtin_name" dcl 11-19 in procedure "builtin" ref 296 jump_index 001547 automatic fixed bin(31,0) dcl 62 in procedure "builtin" set ref 296* 337 337 337 340 344 344 347 347 347 357 404 596 596 596 596 616 616 616 616 625 741 817 1320 2651 2722 2727 2932 2932 2932 3000 3022 3508 3508 3873 k 003670 automatic fixed bin(15,0) dcl 3138 in procedure "expand_arguments" set ref 3289* 3293 3294 3296* 3296 k 000514 automatic fixed bin(15,0) dcl 3307 in procedure "merge" set ref 3345* 3349 3350 3351* 3351 label 0(08) 001607 automatic bit(1) array level 2 in structure "arg_type" packed packed unaligned dcl 257 in procedure "builtin" set ref 576 label based structure level 1 dcl 15-1 in procedure "builtin" label_node constant bit(9) initial dcl 18-5 ref 385 576 1973 lcount 003673 automatic fixed bin(15,0) initial dcl 3138 set ref 3138* 3153* 3153 3220 3249 3278 3279 left_side 0(02) based bit(1) level 2 packed packed unaligned dcl 22-8 ref 321 407 834 845 861 905 929 934 1236 1629 2278 3021 length 001502 automatic pointer dcl 62 in procedure "builtin" set ref 793* 795* 797* 799* 802 810 892* 944* 948* 950 950* 950* 955 955* 955* 1096 1102 1108 1129 1165 1167 1175 1251* 1255* 1263 1265 1267* 1281* 1285* 1292 1295 1297* 1317* 1344* 1938* 1941* 2853* 2854 2855 2857* length 004162 automatic pointer dcl 3575 in procedure "declare_defined_overlay" set ref 3595* 3614 3629* 3629* length 6 based pointer level 2 in structure "reference" packed packed unaligned dcl 21-3 in procedure "builtin" set ref 619 768 770 795 795 948 1105* 1122* 1126* 1129 1147 1148* 1157 1190* 1200* 1200 1202 1202* 1202 1255 1348* 1409* 1409 1410* 1410 1411 1411* 1411 1827 1827 2396* 2746* 2746 2848 2850 2974 2976 3439 length_fun 000132 constant bit(9) initial dcl 20-8 set ref 3666* like 32(03) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 2953* list based structure level 1 dcl 16-6 list_node constant bit(9) initial dcl 18-5 ref 1287 ll 003674 automatic fixed bin(15,0) initial array dcl 3138 set ref 3138* 3156* 3156 3163 3187 3187 lll 003671 automatic fixed bin(15,0) dcl 3138 set ref 3163* 3187 3211 3228 3257 3275 loop constant bit(9) initial dcl 20-8 ref 849 2542 2548 2609 3150 3155 3321 3326 3398 3551 low_bound 3 based fixed bin(17,0) level 2 packed packed unaligned dcl 15-1 ref 1978 1982 lower 5 based pointer level 2 packed packed unaligned dcl 8-21 set ref 2024 2025 2028* 2040 2046* 2068 2093* lp 002266 automatic pointer initial array dcl 3138 set ref 3138* 3152* 3162 3181 3226 3254 3292 3293 3294 3297* 3297 lpp 002262 automatic pointer initial dcl 3138 set ref 3138* 3161 3162* 3185 3206 3209 3220 3225 3246 3250 3270 3273 3302 m 001550 automatic fixed bin(31,0) dcl 62 set ref 788* 816 817 1888* 1890* 1895 1901 make_non_quick 000106 constant entry external dcl 1-162 ref 2981 max builtin function dcl 108 ref 452 816 1522 1525 1574 1576 1578 1581 1737 1738 1785 1787 1800 1804 1833 2782 max_24_bit_integer 000113 constant fixed bin(24,0) initial dcl 3744 ref 3771 3773 3776 max_fun 000131 constant bit(9) initial dcl 20-8 set ref 1837* 3279* 3337* max_length_precision 000234 constant fixed bin(31,0) initial dcl 28-5 set ref 727 746 809* 2417 3667* 3720* max_offset_precision 000234 constant fixed bin(31,0) initial dcl 28-5 set ref 1985* 2008 2042* 2056* 2070* 2087* 2111* 2123 2645* 2974* 3037* max_p_dec constant fixed bin(31,0) initial dcl 28-5 ref 1488 1525 1581 1791 1800 1815 2508 2529 2536 3086 max_p_fix_bin_1 constant fixed bin(31,0) initial dcl 28-5 ref 2294 3702 3758 max_p_fix_bin_2 constant fixed bin(31,0) initial dcl 28-5 ref 1491 1522 1576 1789 1804 2503 2534 3092 max_p_flt_bin_1 constant fixed bin(31,0) initial dcl 28-5 ref 1962 max_p_flt_bin_2 constant fixed bin(31,0) initial dcl 28-5 ref 1491 1578 1817 2527 3097 max_scale constant fixed bin(31,0) initial dcl 28-5 ref 3083 member 32(04) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 2953* min builtin function dcl 108 ref 416 1522 1525 1576 1578 1581 1789 1791 1800 1804 1815 1817 min_area_size constant fixed bin(31,0) initial dcl 28-5 ref 2157 2158 min_fun 000226 constant bit(9) initial dcl 20-8 set ref 3278* 3336* min_scale 027755 constant fixed bin(31,0) initial dcl 28-5 ref 3083 misc_attributes 31(19) based structure level 3 packed packed unaligned dcl 25-3 set ref 2951* 2951 mod_bit constant bit(9) initial dcl 20-8 ref 1079 1365 mod_byte constant bit(9) initial dcl 20-8 ref 1081 1367 mod_half constant bit(9) initial dcl 20-8 ref 1083 1369 modified 001601 automatic bit(1) dcl 62 set ref 2025* 2026 2033* 2034 modword_in_offset 11(35) based bit(1) level 4 packed packed unaligned dcl 21-3 set ref 1035* 1035 1038* 1069 1074* 1360* 1360 1387 1405* 1671 1680* more_bits 13 based structure level 2 packed packed unaligned dcl 21-3 mult 000140 constant bit(9) initial dcl 20-8 set ref 808* 1264* 1389* 2525 2602* 2611 multi_use 7 based pointer level 2 packed packed unaligned dcl 25-3 set ref 3619 3644* n 004267 automatic fixed bin(15,0) dcl 3806 set ref 3811* 3831* 3832 3833 3834 3835 3836 3836 name 1 000206 external static char(14) array level 3 packed packed unaligned dcl 11-19 ref 3818 nargs parameter fixed bin(15,0) dcl 3801 ref 3795 3811 next 14 based pointer level 2 in structure "bound" packed packed unaligned dcl 8-21 in procedure "builtin" ref 2021 next 6 based pointer level 2 in structure "symbol" packed packed unaligned dcl 25-3 in procedure "builtin" set ref 1004* 3634* node based structure level 1 dcl 18-27 nonstandard 4(19) 000206 external static bit(1) array level 3 packed packed unaligned dcl 11-19 ref 299 not_bits 000137 constant bit(9) initial dcl 20-8 set ref 1897* 1912* not_flag 001577 automatic bit(1) dcl 62 set ref 1859* 1861 1911 null builtin function dcl 3585 in procedure "declare_defined_overlay" ref 3613 3631 3631 3631 3631 3634 null builtin function dcl 108 in procedure "builtin" ref 62 62 289 379 387 562 591 594 605 608 616 616 649 649 722 722 722 722 735 735 754 768 795 799 802 809 809 892 950 955 963 993 993 993 993 1000 1000 1000 1000 1004 1015 1026 1026 1036 1076 1087 1087 1096 1096 1101 1101 1108 1111 1122 1129 1129 1147 1156 1156 1161 1161 1165 1170 1175 1175 1182 1182 1202 1207 1224 1224 1263 1279 1287 1292 1303 1303 1311 1328 1328 1328 1328 1348 1362 1373 1373 1387 1404 1411 1415 1595 1657 1657 1678 1685 1827 1829 1833 1833 1838 1838 1842 1845 1850 1850 1855 1967 1990 1993 1993 2024 2028 2032 2036 2040 2054 2068 2068 2076 2087 2087 2094 2105 2105 2111 2111 2162 2179 2205 2206 2208 2208 2213 2215 2237 2256 2268 2282 2282 2318 2324 2330 2330 2331 2359 2359 2389 2396 2402 2463 2485 2485 2496 2561 2561 2575 2575 2588 2588 2640 2645 2704 2722 2723 2723 2748 2748 2759 2759 2820 2820 2848 2917 2945 2945 2948 2948 2974 2974 2983 2983 3018 3018 3037 3037 3080 3138 3138 3138 3138 3138 3161 3173 3173 3181 3181 3185 3187 3187 3191 3191 3191 3203 3206 3215 3228 3232 3232 3251 3253 3260 3260 3280 3280 3292 3323 3324 3324 3326 3326 3339 3339 3348 3361 3372 3373 3373 3375 3375 3384 3398 3398 3398 3407 3439 3439 3455 3541 3541 3541 3541 3546 3546 3667 3667 3687 3689 3720 3720 3790 3814 3900 3900 number 0(21) based fixed bin(14,0) level 2 in structure "operator" packed packed unaligned dcl 19-6 in procedure "builtin" ref 3380 number 0(21) based fixed bin(14,0) level 2 in structure "list" packed packed unaligned dcl 16-6 in procedure "builtin" ref 291 2970 2996 3011 number 001561 automatic fixed bin(31,0) dcl 62 in procedure "builtin" set ref 1978* 1980* 1982* 1985 1985 2069* 2070 2070 number1 10 000206 external static fixed bin(15,0) array level 3 dcl 11-19 ref 306 311 316 number2 11 000206 external static fixed bin(15,0) array level 3 dcl 11-19 ref 316 number_of_descriptions 12 000206 external static fixed bin(15,0) array level 3 dcl 11-19 ref 416 number_of_dimensions 1(07) based fixed bin(7,0) level 2 packed packed unaligned dcl 8-1 ref 1999 2016 2020 number_of_names 000206 external static fixed bin(15,0) level 2 dcl 11-19 ref 3818 o1 000104 automatic pointer dcl 3307 set ref 3335* 3339 3341 3342 3343 3355 o2 000106 automatic pointer dcl 3307 set ref 3336* 3339 3341 3349 o3 000110 automatic pointer dcl 3307 set ref 3337* 3339 3342 3343* 3350 off 001522 automatic pointer dcl 62 set ref 1066* 1069* 1071 1667* 1671* 1675 offset 5 based pointer level 2 in structure "reference" packed packed unaligned dcl 21-3 in procedure "builtin" set ref 1032* 1032 1036* 1066 1071* 1076 1089 1091* 1205* 1205 1207 1207* 1207 1287 1287 1357* 1357 1362 1375 1377* 1387 1391 1392* 1396 1397* 1404* 1414* 1414 1415 1415* 1415 1667 1671 1675* 1678* 1685 1686* 1686 2206 2213 2213* 2213* 2232* 2232 2237* 2331 2331* 2331 3439 3689 3689* 3689 offset 0(06) 001607 automatic bit(1) array level 2 in structure "arg_type" packed packed unaligned dcl 257 in procedure "builtin" set ref 2345 offset 001504 automatic pointer dcl 62 in procedure "builtin" set ref 963* 980* 985* 986 987 1069 1096 1103 1111 1114 1114* 1114* 1117* 1117* 1170 1172 1175 1372* 1373 1373 1375 1377 1389* 1390 1391 1392 1395* 1396 1397 2815* 2817 2818 2820* offset_adder 000110 constant entry external dcl 1-172 ref 1069 1671 offset_mask 000152 constant bit(36) initial dcl 17-3 set ref 2385 2598* op2 parameter pointer dcl 3665 set ref 3662 3668* op_code 0(09) based bit(9) level 2 packed packed unaligned dcl 19-6 set ref 731 849 849 969 2542 2548 2609 2611 2698 3150 3155 3167 3321 3326 3370 3375 3398 3398 3425 3551 3551 3880 3880* 3890 3890* opcode 001602 automatic bit(9) dcl 62 in procedure "builtin" set ref 295* 716* 1079* 1081* 1083* 1086* 1365* 1367* 1369* 1372* 1608* 1634 1878* 1880* 1882* 1886* 1904* 2336* 2410 2410* 2412* 2525 2554* 2581 3119* 3719* 3876* opcode 4(27) 000206 external static bit(9) array level 3 in structure "pl1_data$builtin_name" packed packed unaligned dcl 11-19 in procedure "builtin" ref 295 operand 1 based pointer array level 2 packed packed unaligned dcl 19-6 set ref 375 447 494 547 717 719 809* 810* 811* 932 969 969 969 969 975 976 980 986* 987* 995* 996* 1087* 1087* 1089* 1101* 1102* 1103* 1108* 1111* 1156* 1157* 1158* 1160* 1161* 1161 1165* 1165 1167* 1167 1170* 1170 1172* 1172 1182* 1183* 1183 1183 1184* 1185* 1185 1185 1187* 1187 1215* 1265* 1266* 1295* 1311 1330* 1331* 1373* 1373* 1375* 1390* 1391* 1396* 1421* 1662 1838* 1839* 1840* 1842* 1845* 1866* 1870* 1874* 1894* 1895* 1898* 1899* 1905* 1906* 1909* 1913* 1914* 1941* 1942* 2087* 2088* 2105* 2106* 2111* 2112* 2113* 2130 2147 2147 2152 2174 2175 2177 2184* 2185* 2194* 2201* 2202* 2203* 2221* 2222* 2224* 2224 2227* 2227 2231 2232 2233 2235 2240 2240 2240 2244 2244 2245 2249* 2250* 2257* 2280* 2281* 2282* 2282 2283* 2283 2284 2284 2286 2286 2286 2359* 2360* 2409 2547 2548 2548 2556* 2556 2559* 2571* 2571* 2573* 2580* 2581* 2583* 2604* 2605* 2611 2614 2614 2698 2698 2709 2716 2742* 2743* 2745 2745 2746 2746 2752 2757* 2758* 2759* 2759 2760* 2760 2761 2761 2766* 2767* 2767 2768* 2768 2770* 2771* 2817* 2818* 2854* 2855* 2930* 2934 2935 2938* 2939* 2939 2945* 2945 2946* 2946 2970* 2972 2973 2974* 2974 2976 2978 2996* 3006* 3006 3018* 3018 3027 3037* 3038* 3120* 3123* 3157 3212 3215* 3217* 3231 3231 3232 3232 3232 3232 3241 3242 3260* 3261* 3261 3262* 3262 3263* 3263 3265* 3266 3267 3280* 3280* 3280* 3282* 3283* 3284* 3286* 3287 3293* 3293 3294* 3294 3297 3329 3329 3339* 3339* 3339* 3341* 3342* 3343* 3349* 3349 3350* 3350 3355* 3358 3361 3365* 3381 3384 3390* 3425 3425 3530 3543* 3544* 3560 3667* 3668* 3720* 3721* 3722* operator based structure level 1 dcl 19-6 operator_node constant bit(9) initial dcl 18-5 ref 374 447 492 545 731 848 928 950 969 976 999 1018 1114 1236 1275 1307 1656 2174 2539 2547 2716 3150 3167 3320 3324 3373 3398 3425 3528 3551 3880 3890 3904 operator_semantics 000112 constant entry external dcl 1-184 ref 1216 1422 2586 2590 3559 or_bits constant bit(9) initial dcl 20-8 ref 1880 other 11(33) based structure level 3 packed packed unaligned dcl 21-3 overlayed 33(11) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 1006* 2240* 3641* overlayed_by_builtin 33(14) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 1341 1632* overlayed_by_builtin_bit 000122 constant fixed bin(15,0) initial dcl 27-3 set ref 1341* p 004232 automatic pointer dcl 3717 in procedure "create_index_or_verify" set ref 3719* 3720 3721 3722 3723 3724 p parameter pointer dcl 3307 in procedure "merge" ref 3304 3320 3321 3329 3355 3358 3365 3367 3370 3380 3381 3390 3393 p parameter pointer dcl 3423 in procedure "check_reverse" ref 3419 3425 3425 3425 3425 p parameter pointer dcl 3437 in procedure "is_this_constant" ref 3434 3439 3439 3439 3439 3439 3439 p 001506 automatic pointer dcl 62 in procedure "builtin" set ref 868* 869 870* 870 873 875 875 992* 995 996 1001* 1005 1008 1009 1010 1022 1030 1032 1033 1034 1035 1046* 1047 1048 1049 1052* 1062 1086* 1087 1087 1089 1091 1100* 1101 1102 1103 1105 1108 1111 1155* 1156 1157 1158 1160 1161 1165 1167 1170 1172 1183 1185 1187 1190 1264* 1265 1266 1267 1294* 1295 1297 1311 1327* 1330 1331 1344* 1350 1355 1356 1357 1358 1359 1360 1362 1362 1365 1367 1375 1377 1380 1380 1382 1382 1384 1384 1384 1387 1387 1387 1391 1392 1396 1397 1399 1402 1403 1404 1405 1406 1409 1409 1410 1410 1411 1411 1411 1414 1414 1415 1415 1415 1418* 1421 1424 1897* 1898 1899 1901 1912* 1913 1914 1916 1940* 1941 1942 1944 1996* 1999 2016 2019* 2019 2021* 2021 2024 2025 2027 2028 2032 2033 2035 2036 2040 2042 2042 2046 2054 2056 2056 2060 2068 2068 2069 2069 2075 2076 2093 2094 2110* 2111 2112 2113 2115 2183* 2184 2185 2194 2200* 2201 2202 2203 2227* 2249 2252* 2257 2260 2268* 2270 2270 2358* 2359 2360 2361 2545* 2547 2548 2548* 2548 2556 2573 2579* 2580 2581 2583 2586* 2602* 2604 2605 2607* 2607* 2609 2611 2614 2620 2643* 2645 2650 2741* 2742 2743 2745 2746 2750 2752 2764* 2771 2846* 2848* 2850* 2854 2923* 2926 2939 2970 2970 2978* 2983* 2985 2986 2996 2996 3540* 3543 3544 3548 p 004214 automatic pointer dcl 3683 in procedure "reuse_qual_and_offset" set ref 3685* 3687 3687 3687 3689 3689 3689 p 004260 automatic pointer dcl 3805 in procedure "make_builtin_reference" set ref 3812* 3814 3821* 3825 3828 p 004204 automatic pointer dcl 3665 in procedure "create_length_fun" set ref 3666* 3667 3668 3669 3670 p 000100 automatic pointer dcl 3451 in procedure "check_strings" set ref 3453* 3455 3457 3457 3460 3460 3460 3464* 3464 p 002254 automatic pointer dcl 3138 in procedure "expand_arguments" set ref 3148* 3150 3150 3152 3155 3159* 3167 3167 3169 3173 3178 3195* 3197 3200* 3200* 3217 3225* 3228 3231 3232 3232 3241* 3241 3250* 3261 3265 3266* 3266 3278* 3280 3282 3293 p1 001563 automatic fixed bin(31,0) dcl 62 set ref 1569* 1576 1578 1581 1780* 1787 p2 001564 automatic fixed bin(31,0) dcl 62 set ref 1570* 1576 1578 1581 1781* 1787 1789 1791 p_length parameter pointer dcl 3575 ref 3569 3595 p_param parameter pointer dcl 3683 ref 3680 3685 p_precision parameter fixed bin(31,0) dcl 3575 ref 3569 3593 p_scale parameter fixed bin(15,0) dcl 3575 ref 3569 3594 p_type parameter bit(36) dcl 3575 set ref 3569 3614 3629* 3629* packed 33 based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 902 1339 1621 1646 3640* 3702 packed_digits_per_character constant fixed bin(31,0) initial dcl 28-5 ref 1384 padded_ref 12(06) based bit(1) level 3 packed packed unaligned dcl 21-3 set ref 1064* 1350* passed_as_arg 33(01) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 936* 1241* 2724* 2956* 2991* pic_float 1(29) based bit(1) level 3 packed packed unaligned dcl 25-3 set ref 468 474 1447 1453 1542 1710 1754 2514 2519 3052 3058 pic_scale 1(31) based fixed bin(7,0) level 3 packed packed unaligned dcl 25-3 set ref 2513 pic_size 2(03) based fixed bin(7,0) level 3 packed packed unaligned dcl 25-3 set ref 2512 picture 31(18) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 25-3 in procedure "builtin" set ref 875 999 1012 1013* 1262 2670 3460 picture 0(18) 002007 automatic bit(1) array level 2 in structure "as_if_type" packed packed unaligned dcl 261 in procedure "builtin" set ref 1447 1542 1710 1754 picture 0(18) 001607 automatic bit(1) array level 2 in structure "arg_type" packed packed unaligned dcl 257 in procedure "builtin" set ref 438 468 531 885 887 2511 3052 pix 1(28) based structure level 2 packed packed unaligned dcl 25-3 pl1_data$builtin_name 000206 external static structure level 1 unaligned dcl 11-19 pl1_data$long_collating_sequence 000050 external static char(512) dcl 100 set ref 2860* pl1_stat_$check_ansi 000054 external static bit(1) dcl 102 ref 299 643 666 1245 2311 2354 pl1_stat_$cur_statement 000062 external static pointer dcl 102 ref 2147 2147 2152 2286 2698 2698 2698 2709 pl1_stat_$defined_list 000210 external static pointer dcl 3584 set ref 3611 3644 3645* pl1_stat_$eis_mode 000056 external static bit(1) dcl 102 ref 1076 1362 1380 pl1_stat_$root 000060 external static pointer dcl 102 ref 3821 pl1_stat_$use_old_area 000052 external static bit(1) dcl 102 ref 2182 pointer_type 000117 constant bit(36) initial dcl 28-71 set ref 2270* 2359* 2919 position 32 based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 1006* 2240* 2953* 3614 3641* pp 000100 automatic pointer dcl 3307 set ref 3358* 3365* 3381* 3390* precision 31(25) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 25-3 in procedure "builtin" set ref 2565* precision 004160 automatic fixed bin(31,0) dcl 3575 in procedure "declare_defined_overlay" set ref 3593* 3614 3629* 3629* prefix 12(12) based bit(12) level 2 packed packed unaligned dcl 23-9 ref 735 942 955 1129 1657 2575 2588 2748 2983 3546 3880 3890 processed 13 based bit(1) level 3 in structure "statement" packed packed unaligned dcl 23-9 in procedure "builtin" set ref 2986* processed 0(13) based bit(1) level 2 in structure "reference" packed packed unaligned dcl 21-3 in procedure "builtin" set ref 3906* processed 0(19) based bit(1) level 2 in structure "operator" packed packed unaligned dcl 19-6 in procedure "builtin" set ref 493* 546* 812* 2240* 2976* 3126* 3529* 3669* 3723* 3904* propagate_bit 000114 constant entry external dcl 1-192 ref 407 845 935 1240 1341 1629 2322 2323 pseudo_variable 001575 automatic bit(1) initial dcl 62 set ref 62* 328* 3869 pt parameter pointer dcl 3451 ref 3448 3453 ptr 0(05) 001607 automatic bit(1) array level 2 packed packed unaligned dcl 257 set ref 2351 2435 2458 pure_array 004075 automatic bit(1) initial dcl 3145 set ref 3145* 3181* 3191 q 002256 automatic pointer dcl 3138 in procedure "expand_arguments" set ref 3155* 3155* 3157 3159 3209* 3212* 3212 3215 3217 3226* 3228 3228 3231 3232 3232 3242* 3242 3251* 3253 3254* 3262 3263 3267* 3267 3279* 3280 3283 3284* 3294 q 001510 automatic pointer dcl 62 in procedure "builtin" set ref 2188* 2190* 2190* 2193* 2193* 2194 2208* 2209 2210 2211 2212 2213 2213 2213 2215 2215 2215 2220* 2221 2222 2224 2224 2227 2227 2231 2232 2233 2235 2240 2240 2240 2240 2244 2244 2245 2250 2558* 2559 2571 2573* 2748* 2750 2946* 2962 2965 2992* 2993 2994 2996 3006* 3008 3011 3012 q 000102 automatic pointer dcl 3307 in procedure "merge" set ref 3404* 3407 3409 3413* q1 001565 automatic fixed bin(31,0) dcl 62 set ref 1571* 1574 1576 1578 1581 1782* 1785 q2 001566 automatic fixed bin(31,0) dcl 62 set ref 1572* 1574 1576 1578 1581 1783* 1785 1789 1791 qual parameter pointer dcl 3575 ref 3569 3600 3601 3602 qualifier 4 based pointer level 2 packed packed unaligned dcl 21-3 set ref 758 1008* 1022* 1030* 1355* 1402 1403 1404 1405 1406 1409 1682* 2047 2061 2079 2097 2190 2215 2215* 2215* 2224 2235* 2651 2965 3012 3687 3687* 3687 r 002260 automatic pointer dcl 3138 in procedure "expand_arguments" set ref 3273* 3286 3287* 3287 r 001512 automatic pointer dcl 62 in procedure "builtin" set ref 975* 976 976* 976 979 993* 994 995 1026* 1027 1028 1029* 1030 1181* 1182 1183 1184 1185 1187 1328* 1329 1330 1657* 1659 1660 1893* 1894 1895 1899 2174* 2174* 2177 2179* 2256 2257 2554* 2556 2559 2571 2575* 2577 2586 2586* 2588* 2588* 2588 2589 2590 2590* 2614* 2615 3541* 3542 3543 3546* 3548 3549 3555 3555* 3555 3559 3559* 3559 3560 r 004166 automatic pointer dcl 3583 in procedure "declare_defined_overlay" set ref 3629* 3632 3635 3636 3637 3638 3650* 3651 3652 3653 3654 3656 range_ck 000127 constant bit(9) initial dcl 20-8 set ref 1155* 1181* rcount 001567 automatic fixed bin(31,0) dcl 62 set ref 1051* 1052 real 0(30) 001607 automatic bit(1) array level 2 in structure "arg_type" packed packed unaligned dcl 257 in procedure "builtin" set ref 507 3074 3503 3518 real 0(30) 001606 automatic bit(1) level 2 in structure "rtype" packed packed unaligned dcl 255 in procedure "builtin" set ref 1731* 3073 3074* real 0(30) 002213 automatic bit(1) level 2 in structure "type" packed packed unaligned dcl 26-3 in procedure "builtin" set ref 3483* 3489* 3502 3503* 3518 real_mask constant bit(36) initial dcl 17-3 ref 1429 1469 1471 1563 1616 1743 reducible 31(33) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 2935* ref 000502 automatic pointer array dcl 62 set ref 372* 374 375* 375 378 379* 385 386 387* 390 391 490* 492 493 494* 494 497 543* 545 546 547* 547 550 562 594 594 608 616 619 693* 693 696* 740 758 768 768 770 777* 777 780* 793 795 795 797 805 816 840 840* 849 886 891 932* 943 948 949 950 1002 1022 1022 1022* 1024 1025 1025 1027 1030* 1032 1033 1034 1035 1036 1037 1038 1042 1046 1047 1050 1051 1051 1230 1230* 1244 1250 1255 1256 1279 1287 1287 1287* 1303 1348 1356 1409 1662* 1664* 1671 1671 1671 1671 1671 1678 1679 1680 1681 1683 1825 1827 1827 1833 1833 1842 1845 1937 1941* 1945 1999* 2002* 2047 2061 2079 2097 2141 2716* 2718* 2846 2848 2848 2850 2867* 2867 2870* 2871 2905* 2965 3008* 3012 3012 3525* 3528 3529 3530* 3530 3533 ref_count 0(18) based fixed bin(17,0) level 2 packed packed unaligned dcl 21-3 set ref 950 1010* 1024 1025* 1025 1028* 1049* 1051 1051* 2212* 2245* 2972* 2994* 3425 3563* 3652* ref_type 2 based structure level 2 packed packed unaligned dcl 12-3 refer_extent 000174 constant entry external dcl 2-426 ref 758 2651 refer_extents 33(05) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 758 2190 2224 2651 reference based structure level 1 dcl 21-3 in procedure "builtin" set ref 1027* 1027 1047* 1047 2209* 2209 reference 15 based pointer level 2 in structure "symbol" packed packed unaligned dcl 25-3 in procedure "builtin" set ref 840 995 1001 1005* 1022 1230 1330 1664 2569 2724 2734 2738 2742 2970 2992 3543 3614 3614 3614 3635* 3650* 3841 reference_node constant bit(9) initial dcl 18-5 ref 390 507 840 969 1230 1402 2084 2102 2311 2629 2636 2668 2678 3232 3232 3439 3600 3869 reserve$declare_lib 000176 constant entry external dcl 2-434 ref 2280 2757 2930 reserve_list_number 5 000206 external static fixed bin(15,0) array level 3 dcl 11-19 ref 297 reserved_number 001551 automatic fixed bin(31,0) dcl 62 set ref 297* 1926* 1926 1953* 1953 1962* 1962 1978 1980 2002* 2005* 2040 2054 2280 2757 2930 3022* 3024* return_from_empty 0(07) based bit(1) level 2 packed packed unaligned dcl 22-8 set ref 2264* 2289* 2708* 2738 2763 return_value 32(18) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 1007* 2956* reverse builtin function dcl 108 ref 2135 2135 2137 2137 reverse_fun constant bit(9) initial dcl 20-8 ref 3425 rlength 001514 automatic pointer dcl 62 set ref 591* 599* 608 616 619* 793 805* 808* 809 810 811 812 1595* 1599* 1624* 1837* 1838 1839 1840 1842 1845 1855 1894* 1898* 1909* 1913* 2402* 2463* 2917* 2989* 3080* 3105* 3117* root 3 based pointer level 2 packed packed unaligned dcl 23-9 set ref 737* 1659* 2147 2147 2152 2286 2586* 2590* 2698 2698 2698 2709 2750* 2981 2985* 3548* 3555* 3555 3559* 3559 3560 rp parameter pointer array dcl 3307 ref 3304 3324 3326 3329 3349 3350 3361 3373 3375 3384 3398 3398 3398 3407 rpp 000112 automatic pointer array dcl 3307 set ref 3361* 3365* 3384* 3390* rprecision 001552 automatic fixed bin(31,0) dcl 62 set ref 590* 607* 608* 611* 639* 642* 662* 665* 685* 727* 746* 803* 816* 1486* 1488 1491 1491 1509* 1511* 1522* 1522 1525* 1525 1576* 1578* 1581* 1594* 1598* 1606* 1624* 1701* 1737* 1737 1745* 1787* 1789* 1791* 1800* 1804* 1815* 1817* 1833* 1836* 1855 1894* 1898* 1909* 1913* 1962 2008* 2123* 2294* 2301* 2307* 2400* 2417* 2426* 2439* 2443* 2446* 2449* 2452* 2475* 2503* 2508* 2512* 2527* 2529* 2534* 2536* 2563 2616* 2674* 2691* 2778* 2782* 2782 2885* 2894* 2902* 2911* 2914* 2989* 3086 3092 3097 3100 3105* 3113 3117* rscale 001553 automatic fixed bin(31,0) dcl 62 set ref 590* 614* 657* 659* 682* 1483* 1504* 1506* 1522 1525 1527* 1574* 1576 1578 1581 1624 1701* 1738* 1738 1745* 1785* 1789 1791 1809* 2009* 2124* 2401* 2427* 2462* 2504* 2509* 2513* 2525 2531* 2564 2617* 2914* 2989 3083 3083 3105 3117 rtype 001606 automatic structure level 1 packed packed unaligned dcl 255 set ref 588* 600* 600 620* 620 636* 655* 672* 676* 700* 726* 745* 784* 843* 1233* 1334* 1336* 1344 1344 1429* 1434* 1459* 1459 1461* 1461 1464* 1464 1466* 1466 1469* 1469 1471* 1471 1474 1498* 1531* 1552* 1552 1554* 1554 1557* 1557 1559* 1559 1562 1563* 1563 1586* 1605 1605 1616* 1616 1621* 1621 1624 1624 1698* 1733 1743* 1764* 1764 1766* 1766 1769* 1769 1771* 1771 1774 1941 2007* 2122* 2295* 2299* 2305* 2385* 2399* 2416* 2425* 2438* 2461* 2473* 2502* 2507* 2514* 2517* 2519* 2521* 2532 2532* 2562 2615* 2673* 2689* 2776* 2874* 2882* 2892* 2900* 2910* 2919* 2989 2989 3046* 3046 3105 3105 3108 3108 3117 3117 3872* s parameter pointer dcl 3700 in procedure "fb1_value" ref 3697 3702 3702 3702 3702 3702 3702 s 004170 automatic pointer dcl 3583 in procedure "declare_defined_overlay" set ref 3611* 3613 3614 3614 3614 3614 3614 3614 3614 3614 3619* 3619 3631* 3633 3634 3635 3636 3640 3640 3641 3641 3641 3642 3644 3645 3650 s 001516 automatic pointer dcl 62 in procedure "builtin" set ref 735* 737 1000* 1001 1003 1004 1005 1006 1006 1006 1007 1007 1012 1013 1014 1015 1625* 1627 1634 1636 1638 1642 1646 1648 1652 2723* 2724 2724 2724 2724 2728 2729 2731 2734 2734 2736* 2738 2742 2948* 2950 2951 2953 2953 2953 2953 2953 2953 2953 2953 2956 2956 2956 2958 2960* 2962 2970 2990* 2991 2992 3009 s 004262 automatic pointer dcl 3805 in procedure "make_builtin_reference" set ref 3821* 3823 3824 3825 3828* 3841 3841* save_arg_one 001524 automatic pointer dcl 62 set ref 1061* save_context 002211 automatic bit(36) packed unaligned dcl 268 set ref 332* 370* 370 402 402 2274 2274 2341 2341 2382 2382 2431 2431 2455 2455 2467 2467 2479 2479 2627 2627 2665 2665 scale 2(28) based fixed bin(7,0) level 2 in structure "symbol" packed packed unaligned dcl 25-3 in procedure "builtin" set ref 614 1571 1572 1738 1782 1783 1800 1804 2564* 3614 3702 scale 004161 automatic fixed bin(15,0) dcl 3575 in procedure "declare_defined_overlay" set ref 3594* 3614 3629* 3629* search_fun constant bit(9) initial dcl 20-8 ref 2410 search_rev_fun constant bit(9) initial dcl 20-8 ref 2410 semantic_translator$abort 000200 constant entry external dcl 2-446 ref 285 306 311 316 324 404 627 679 834 849 861 905 907 912 929 1175 1236 1275 1287 1480 1812 1967 1976 1990 2016 2147 2160 2168 2311 2318 2345 2351 2379 2389 2496 2542 2609 2611 2678 2698 2905 3187 3191 3232 3324 3326 3373 3375 3398 3460 3866 semantic_translator$error 000202 constant entry external dcl 2-450 ref 299 643 649 666 1136 1143 1196 1224 1245 2314 2354 set_bit 000123 constant fixed bin(15,0) initial dcl 27-3 set ref 407* 845* 935* 1240* 1629* 2323* set_reference 2 based bit(1) level 3 packed packed unaligned dcl 12-3 set ref 2324* share_expression 000204 constant entry external dcl 2-454 ref 619 737 804 950 955 1117 1659 1827 2746 2767 2768 2770 2850 3263 3284 3293 3294 3343 3349 3350 3386 3668 3687 3689 3721 shared 0(11) based bit(1) level 2 packed packed unaligned dcl 21-3 set ref 1009* 1048* 1050 2211 2244* 2396 2724* 2973* 2993* 3425 3561 3562* 3614 3651* simplify_expression 000116 constant entry external dcl 1-205 ref 2025 2033 simplify_offset 000120 constant entry external dcl 1-212 ref 1212 1418 1688 size 3 based fixed bin(9,0) level 2 dcl 29-3 ref 322 3766 3766 son 21 based pointer level 2 packed packed unaligned dcl 25-3 set ref 870 880 3457 star_extents 33(06) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 2956* statement based structure level 1 dcl 23-9 statement_ptr parameter pointer dcl 60 set ref 31 285 352* 363* 735 735 760* 942 955 1114* 1129 1200* 1205* 1216* 1303* 1410* 1414* 1422* 1657 1657 1686* 1993* 2048* 2062* 2081* 2099* 2119* 2172* 2193* 2229* 2330* 2331* 2539* 2573* 2575 2575 2607* 2655* 2709* 2748 2748 2965* 2980 2981 2983 2983 3012* 3200* 3413* 3546 3546 3841* 3880 3890 statement_type 12(27) based bit(9) level 2 packed packed unaligned dcl 23-9 ref 285 std_arg_list 000135 constant bit(9) initial dcl 20-8 set ref 2281* 2758* 2938* std_call 000134 constant bit(9) initial dcl 20-8 set ref 731 2279* 2756* 2929* storage_block_type 000116 constant bit(36) initial dcl 28-71 set ref 2282* 2759* 2945* 3018* storage_class 32(09) based structure level 3 packed packed unaligned dcl 25-3 string builtin function dcl 108 in procedure "builtin" set ref 392 419* 424 439* 441* 443* 445 445 451 459* 464* 466* 468* 472* 474* 476* 478* 487* 523* 529* 531* 540* 555* 588* 600* 600 620* 620 636* 655* 672* 676* 700* 704* 707* 726* 745* 784* 827* 829* 843* 854* 856* 916* 1226* 1233* 1315 1334* 1336* 1344 1344 1429* 1434* 1459* 1459 1461* 1461 1464* 1464 1466* 1466 1469* 1469 1471* 1471 1474* 1474 1498* 1531* 1552* 1552 1554* 1554 1557* 1557 1559* 1559 1562* 1562 1563* 1563 1586* 1605 1605 1616* 1616 1621* 1621 1624 1624 1698* 1733* 1733 1743* 1764* 1764 1766* 1766 1769* 1769 1771* 1771 1774* 1774 1921* 1925* 1933* 1941 2007* 2122* 2155 2295* 2299* 2305* 2366* 2374* 2385* 2399* 2416* 2425* 2438* 2461* 2473* 2502* 2507* 2514* 2517* 2519* 2521* 2532 2532* 2532* 2562 2562 2615* 2615 2673* 2689* 2776* 2805* 2808* 2823* 2826* 2874* 2882* 2892* 2900* 2910* 2919* 2950* 2950 2951* 2951 2989 2989 3046* 3046 3105 3105 3108 3108 3117 3117 3477 3510 3510 3513 3513 3520 3520 3522 3522 3526 3872* 3872 string 4 based char level 2 in structure "token" dcl 29-3 in procedure "builtin" ref 322 3766 3766 string_size_ck 001574 automatic bit(1) initial dcl 62 set ref 62* 1590* 2624* 3890 string_unspec 0(11) based bit(1) level 2 packed packed unaligned dcl 22-27 set ref 340* structure 001607 automatic bit(1) array level 2 in structure "arg_type" packed packed unaligned dcl 257 in procedure "builtin" set ref 849 867 1244 structure 31 based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 25-3 in procedure "builtin" set ref 869 1303 2168 2328 3457 structure_mask constant bit(36) initial dcl 17-3 ref 3474 sub 000141 constant bit(9) initial dcl 20-8 set ref 985* 1100* 1160* 2110* 2853* subs 004264 automatic pointer dcl 3805 set ref 3831* 3833 3835 3836 3841* subscripts parameter pointer dcl 60 ref 31 289 291 352 363 507 3148 substr builtin function dcl 108 in procedure "builtin" set ref 392 942 955 1129 1858 1859 2562* 3880 3890 substr 13 based bit(1) level 3 in structure "reference" packed packed unaligned dcl 21-3 in procedure "builtin" set ref 1210* substr_index 001562 automatic fixed bin(31,0) dcl 62 set ref 1134* 1136 1140 1143 suppress_diagnostic 004142 automatic bit(1) dcl 3472 set ref 3508* 3510 3520 sym_ptr parameter pointer dcl 3788 in procedure "symbol_is_constant" ref 3785 3790 3790 3790 sym_ptr parameter pointer dcl 3735 in procedure "constant_value" ref 3730 3758 3758 3758 3761 3766 3766 3766 symbol based structure level 1 dcl 25-3 in procedure "builtin" set ref 1003* 1003 3633* 3633 symbol 3 based pointer level 2 in structure "reference" packed packed unaligned dcl 21-3 in procedure "builtin" set ref 391 447 449 497 550 697 781 969 969 969 979 1002 1046 1315 1316 1317 1625 1945 2000 2003 2084 2102 2147 2153 2240 2240 2240 2244 2490 2615 2640 2643 2645 2645 2655 2698 2871 2934 2935 2978 2990* 3027 3232 3232 3439 3533 3632 3636* 3872 symbol_node constant bit(9) initial dcl 18-5 ref 605 t 004172 automatic pointer dcl 3583 in procedure "declare_defined_overlay" set ref 3632* 3633 t 001520 automatic pointer dcl 62 in procedure "builtin" set ref 445* 447 447* 447 449* 449 452 456 1002* 1003 1624* 1625 1637 1638 1641 1642 1647 1648 1651 1652 1667 1668 1669 1675 1676 1677 1682 1683 1685 1686 1686 1688* 1692 1850* 1851* 2086* 2087 2088 2089 2104* 2105 2106 2107 2172* 2174 2175 2258 2561* 2562 2563 2564 2565 2565 2565 2567* 2569* 2569 2571 2580 2592 2745 2746 2768* 2989* 2990 3028* 3035* 3037 3038 3040 3105* 3106* 3117* 3120 3900* 3901* targ_prec 002210 automatic fixed bin(31,0) dcl 266 set ref 452* 452 456* 3900* targ_type 002207 automatic bit(36) dcl 265 set ref 451* 3899* 3899 3900* temp_ref 12(11) based bit(1) level 3 packed packed unaligned dcl 21-3 set ref 2314 temp_size 001554 automatic fixed bin(31,0) dcl 62 set ref 2998* 3004* 3018* temporary 32(17) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 994* 1007* 1329* 3542* 3642* this_context 002212 automatic bit(36) dcl 22-5 set ref 336* 338 340 344 347 352* 356 363* 370 398* 1216* 1422* 2048* 2062* 2573* 2586* 2590* 2655* 3553 3555* 3559* token 5 based pointer level 2 in structure "symbol" packed packed unaligned dcl 25-3 in procedure "builtin" set ref 322 2147 2698 token based structure level 1 dcl 29-3 in procedure "builtin" token_node constant bit(9) initial dcl 18-5 ref 378 516 649 824 1222 1604 2081 2099 2713 3510 top 0(05) based bit(1) level 2 packed packed unaligned dcl 22-8 ref 285 tree 000100 automatic pointer dcl 60 set ref 283* 411* 631* 754* 757* 758* 760* 760* 761* 761* 768* 770* 992* 1215 1216* 1216* 1327* 1421 1422* 1422* 1424* 1692* 1865* 1866 1869* 1870 1873* 1874 1904* 1905 1906 1909 1914 1916* 1985* 2042* 2046* 2047* 2047* 2048* 2048* 2050 2056* 2060* 2061* 2061* 2062* 2062* 2064 2070* 2130* 2135* 2137* 2142* 2147 2147 2248* 2249 2250 2252 2258* 2260* 2270* 2279* 2280 2281 2282 2283 2284 2286 2592* 2598* 2632* 2645* 2650* 2651* 2655* 2655* 2658 2756* 2757 2758 2759 2760 2761 2764 2765* 2766 2767 2768 2770 2771 2820* 2833* 2857* 2860* 2929* 2930 2934 2935 2938 2939 2945 2946 2970 2972 2973 2974 2976 2978 2985 2996 3006 3018 3027 3028 3040* 3106* 3108* 3119* 3120 3123 3126 3130* 3200* 3413* 3869 3871 3872 3880 3880 3880 3890 3890 3890 3901* 3901* 3904 3904 3906 3909 type based bit(9) level 2 in structure "node" packed packed unaligned dcl 18-27 in procedure "builtin" ref 374 378 385 390 447 492 507 516 545 576 605 649 731 824 840 848 928 950 969 969 976 999 1018 1114 1222 1230 1236 1275 1287 1307 1402 1604 1656 1973 2081 2084 2099 2102 2174 2311 2539 2547 2629 2636 2668 2678 2713 2716 3150 3167 3232 3232 3320 3324 3373 3398 3425 3439 3510 3528 3551 3600 3869 3880 3890 3904 type 14 000206 external static bit(36) array level 4 in structure "pl1_data$builtin_name" dcl 11-19 in procedure "builtin" ref 419 1498 1586 type 0(09) based bit(9) level 2 in structure "token" packed packed unaligned dcl 29-3 in procedure "builtin" ref 380 382 520 649 type 002213 automatic structure level 1 packed packed unaligned dcl 26-3 in procedure "builtin" set ref 419* 424 439* 441* 443* 445 445 451 459* 464* 466* 468* 472* 474* 476* 478* 487* 523* 529* 531* 540* 555* 704* 707* 827* 829* 854* 856* 916* 1226* 1474* 1562* 1733* 1774* 1921* 1925* 1933* 2366* 2374* 2532* 2805* 2808* 2823* 2826* 3477 3510 3510 3513 3513 3520 3520 3522 3522 3526 unaligned 31(22) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 25-3 in procedure "builtin" set ref 1636 3640 unaligned 0(22) 001606 automatic bit(1) level 2 in structure "rtype" packed packed unaligned dcl 255 in procedure "builtin" set ref 1339* unaligned_mask constant bit(36) initial dcl 17-3 ref 588 1429 1621 2562 undesirable_mask 027756 constant bit(36) initial dcl 17-41 ref 2562 units 004164 automatic fixed bin(3,0) dcl 3581 in procedure "declare_defined_overlay" set ref 3601* 3604* 3614 3637 units 001536 automatic fixed bin(3,0) dcl 62 in procedure "builtin" set ref 873* 875* 890* 897* 899* 922* 925* 1069* 1234* 1292 1320* 1322* 1334 1380 3460 3460 units 0(14) based fixed bin(3,0) level 2 in structure "reference" packed packed unaligned dcl 21-3 in procedure "builtin" set ref 1034* 1034 1068 1073* 1076 1079 1081 1359* 1359 1362 1365 1367 1380 1380 1384 1387 1399* 1637* 1641* 1647* 1651* 1669 1671 1677* 2231* 2336 2336 3601 3614 3637* 3653* unmatch_bound 000515 automatic bit(1) initial dcl 3307 set ref 3307* 3329* 3334 unspec builtin function dcl 108 ref 1985 1985 2042 2042 2056 2056 2070 2070 2270 2270 2598 2598 2645 2645 upper 6 based pointer level 2 packed packed unaligned dcl 8-21 set ref 2032 2033 2036* 2054 2060* 2068 2075* variable 31(32) based bit(1) level 4 packed packed unaligned dcl 25-3 set ref 2953* varying 0(26) 001606 automatic bit(1) level 2 in structure "rtype" packed packed unaligned dcl 255 in procedure "builtin" set ref 3873* varying 31(26) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 25-3 in procedure "builtin" set ref 2728* varying_mask constant bit(36) initial dcl 17-3 ref 600 620 1941 varying_ref 0(10) based bit(1) level 2 packed packed unaligned dcl 21-3 set ref 594 740 793 943 1064* 1250 1825 1937 2846 3439 verify_rev_fun constant bit(9) initial dcl 20-8 ref 2412 word_ constant fixed bin(3,0) initial dcl 10-5 ref 1651 2231 2336 word_size 22 based pointer level 2 packed packed unaligned dcl 25-3 set ref 2643 xor_bits constant bit(9) initial dcl 20-8 ref 1882 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. a_format internal static bit(9) initial dcl 20-8 abs_fun internal static bit(9) initial dcl 20-8 acos_fun internal static bit(9) initial dcl 20-8 acosd_fun internal static bit(9) initial dcl 20-8 addbitno_fun internal static bit(9) initial dcl 20-8 addcharno_fun internal static bit(9) initial dcl 20-8 addr_fun internal static bit(9) initial dcl 20-8 addrel_fun internal static bit(9) initial dcl 20-8 adjust_count 000000 constant entry external dcl 2-20 alloc_semantics 000000 constant entry external dcl 1-7 alloc_semantics$init_only 000000 constant entry external dcl 1-12 allocate_statement internal static bit(9) initial dcl 24-3 allocation_fun internal static bit(9) initial dcl 20-8 allot_auto internal static bit(9) initial dcl 20-8 allot_based internal static bit(9) initial dcl 20-8 allot_ctl internal static bit(9) initial dcl 20-8 allot_var internal static bit(9) initial dcl 20-8 and internal static bit(9) initial dcl 30-3 area_mask internal static bit(36) initial dcl 17-3 arg_desc_type internal static bit(36) initial dcl 28-71 arg_descriptor_mask internal static bit(36) initial dcl 17-3 array_node internal static bit(9) initial dcl 18-5 arrow internal static bit(9) initial dcl 30-3 asin_fun internal static bit(9) initial dcl 20-8 asind_fun internal static bit(9) initial dcl 20-8 assign_by_name internal static bit(9) initial dcl 20-8 assign_round internal static bit(9) initial dcl 20-8 assign_zero internal static bit(9) initial dcl 20-8 assignment internal static bit(9) initial dcl 30-3 atan_fun internal static bit(9) initial dcl 20-8 atand_fun internal static bit(9) initial dcl 20-8 b_format internal static bit(9) initial dcl 20-8 baseno_fun internal static bit(9) initial dcl 20-8 baseptr_fun internal static bit(9) initial dcl 20-8 begin_statement internal static bit(9) initial dcl 24-3 bin_integer internal static bit(9) initial dcl 30-3 binary_to_octal_string 000000 constant entry external dcl 2-38 binary_to_octal_var_string 000000 constant entry external dcl 2-43 bindec 000000 constant entry external dcl 2-23 bindec$vs 000000 constant entry external dcl 2-28 binoct 000000 constant entry external dcl 2-33 bit_pointer internal static bit(9) initial dcl 20-8 bit_string internal static bit(9) initial dcl 30-3 bit_to_word internal static bit(9) initial dcl 20-8 bit_type internal static bit(36) initial dcl 28-71 bitno_fun internal static bit(9) initial dcl 20-8 bits_per_binary_exponent internal static fixed bin(31,0) initial dcl 28-5 bits_per_decimal_digit internal static fixed bin(31,0) initial dcl 28-5 bits_per_half internal static fixed bin(31,0) initial dcl 28-5 bits_per_packed_ptr internal static fixed bin(31,0) initial dcl 28-5 bits_per_word internal static fixed bin(31,0) initial dcl 28-5 block based structure level 1 dcl 9-5 block_node internal static bit(9) initial dcl 18-5 bn_format internal static bit(9) initial dcl 20-8 bool_fun internal static bit(9) initial dcl 20-8 bound_node internal static bit(9) initial dcl 18-5 builtin_mask internal static bit(36) initial dcl 17-3 builtin_type internal static bit(36) initial dcl 28-71 by_context internal static bit(3) initial dcl 14-5 by_declare internal static bit(3) initial dcl 14-5 by_explicit_context internal static bit(3) initial dcl 14-5 by_implication internal static bit(3) initial dcl 14-5 by_name_agg_node internal static bit(9) initial dcl 18-5 byte_fun internal static bit(9) initial dcl 20-8 c_format internal static bit(9) initial dcl 20-8 cat internal static bit(9) initial dcl 30-3 cat_string internal static bit(9) initial dcl 20-8 ceil_fun internal static bit(9) initial dcl 20-8 char_string internal static bit(9) initial dcl 30-3 char_to_word internal static bit(9) initial dcl 20-8 characters_per_double internal static fixed bin(31,0) initial dcl 28-5 characters_per_half internal static fixed bin(31,0) initial dcl 28-5 characters_per_word internal static fixed bin(31,0) initial dcl 28-5 charno_fun internal static bit(9) initial dcl 20-8 clock_fun internal static bit(9) initial dcl 20-8 close_file internal static bit(9) initial dcl 20-8 close_statement internal static bit(9) initial dcl 24-3 codeptr_fun internal static bit(9) initial dcl 20-8 colon internal static bit(9) initial dcl 30-3 column_format internal static bit(9) initial dcl 20-8 comma internal static bit(9) initial dcl 30-3 compare_declaration 000000 constant entry external dcl 1-31 complex_fun internal static bit(9) initial dcl 20-8 complex_type internal static bit(36) initial dcl 28-71 condition_mask internal static bit(36) initial dcl 17-3 conjg_fun internal static bit(9) initial dcl 20-8 context_node internal static bit(9) initial dcl 18-5 context_processor 000000 constant entry external dcl 1-38 continue_statement internal static bit(9) initial dcl 24-3 convert$validate 000000 constant entry external dcl 2-78 convert_mask internal static bit(36) initial dcl 17-41 copy_expression$copy_sons 000000 constant entry external dcl 2-99 copy_string internal static bit(9) initial dcl 20-8 copy_unique_expression 000000 constant entry external dcl 2-103 cos_fun internal static bit(9) initial dcl 20-8 cosd_fun internal static bit(9) initial dcl 20-8 create_array 000000 constant entry external dcl 2-108 create_block 000000 constant entry external dcl 2-112 create_bound 000000 constant entry external dcl 2-118 create_context 000000 constant entry external dcl 2-122 create_cross_reference 000000 constant entry external dcl 2-128 create_default 000000 constant entry external dcl 2-132 create_identifier 000000 constant entry external dcl 2-136 create_label 000000 constant entry external dcl 2-140 create_statement$prologue 000000 constant entry external dcl 2-171 create_storage 000000 constant entry external dcl 2-179 create_token$init_hash_table 000000 constant entry external dcl 2-197 create_token$protected 000000 constant entry external dcl 2-199 cross_reference_node internal static bit(9) initial dcl 18-5 decbin 000000 constant entry external dcl 2-206 declare_constant$desc 000000 constant entry external dcl 2-229 declare_constant_mask internal static bit(36) initial dcl 17-41 declare_descriptor$ctl 000000 constant entry external dcl 2-249 declare_descriptor$param 000000 constant entry external dcl 2-259 declare_picture 000000 constant entry external dcl 2-274 declare_picture_temp 000000 constant entry external dcl 2-279 declare_pointer 000000 constant entry external dcl 2-287 declare_statement internal static bit(9) initial dcl 24-3 declare_structure 000000 constant entry external dcl 1-44 decode_node_id 000000 constant entry external dcl 2-300 decode_source_id 000000 constant entry external dcl 2-306 default_area_size internal static fixed bin(31,0) initial dcl 28-5 default_fix_dec_p internal static fixed bin(31,0) initial dcl 28-5 default_flt_bin_p internal static fixed bin(31,0) initial dcl 28-5 default_flt_dec_p internal static fixed bin(31,0) initial dcl 28-5 default_node internal static bit(9) initial dcl 18-5 default_statement internal static bit(9) initial dcl 24-3 delete_file internal static bit(9) initial dcl 20-8 delete_statement internal static bit(9) initial dcl 24-3 desc_size internal static bit(9) initial dcl 20-8 display_statement internal static bit(9) initial dcl 24-3 div internal static bit(9) initial dcl 20-8 do_fun internal static bit(9) initial dcl 20-8 do_semantics 000000 constant entry external dcl 1-57 do_spec internal static bit(9) initial dcl 20-8 do_statement internal static bit(9) initial dcl 24-3 e_format internal static bit(9) initial dcl 20-8 else_clause internal static bit(9) initial dcl 24-3 enable_on internal static bit(9) initial dcl 20-8 end_statement internal static bit(9) initial dcl 24-3 entry_mask internal static bit(36) initial dcl 17-3 entry_statement internal static bit(9) initial dcl 24-3 entry_var_type internal static bit(36) initial dcl 28-71 environmentptr_fun internal static bit(9) initial dcl 20-8 eq internal static bit(9) initial dcl 30-3 equal internal static bit(9) initial dcl 20-8 error 000000 constant entry external dcl 2-314 error$omit_text 000000 constant entry external dcl 2-319 error_ 000000 constant entry external dcl 2-324 error_$finish 000000 constant entry external dcl 2-343 error_$initialize_error 000000 constant entry external dcl 2-341 error_$no_text 000000 constant entry external dcl 2-334 ex_prologue internal static bit(9) initial dcl 20-8 exit_statement internal static bit(9) initial dcl 24-3 exp internal static bit(9) initial dcl 20-8 exp_fun internal static bit(9) initial dcl 20-8 expand_by_name 000000 constant entry external dcl 1-71 expand_initial 000000 constant entry external dcl 1-84 expand_prefix 000000 constant entry external dcl 1-89 expon internal static bit(9) initial dcl 30-3 f_format internal static bit(9) initial dcl 20-8 file_mask internal static bit(36) initial dcl 17-3 fixed_bin internal static bit(9) initial dcl 30-3 fixed_dec internal static bit(9) initial dcl 30-3 float_bin internal static bit(9) initial dcl 30-3 float_dec internal static bit(9) initial dcl 30-3 floor_fun internal static bit(9) initial dcl 20-8 format_mask internal static bit(36) initial dcl 17-3 format_statement internal static bit(9) initial dcl 24-3 format_value_node internal static bit(9) initial dcl 18-5 fortran_read internal static bit(9) initial dcl 20-8 fortran_write internal static bit(9) initial dcl 20-8 free_based internal static bit(9) initial dcl 20-8 free_ctl internal static bit(9) initial dcl 20-8 free_node 000000 constant entry external dcl 2-345 free_statement internal static bit(9) initial dcl 24-3 free_var internal static bit(9) initial dcl 20-8 ftn_file_manip internal static bit(9) initial dcl 20-8 ftn_trans_loop internal static bit(9) initial dcl 20-8 function 000000 constant entry external dcl 1-125 ge internal static bit(9) initial dcl 30-3 generic_mask internal static bit(36) initial dcl 17-3 generic_selector 000000 constant entry external dcl 1-134 get_array_size 000000 constant entry external dcl 2-348 get_data_trans internal static bit(9) initial dcl 20-8 get_edit_trans internal static bit(9) initial dcl 20-8 get_file internal static bit(9) initial dcl 20-8 get_list_trans internal static bit(9) initial dcl 20-8 get_size 000000 constant entry external dcl 2-352 get_statement internal static bit(9) initial dcl 24-3 get_string internal static bit(9) initial dcl 20-8 goto_statement internal static bit(9) initial dcl 24-3 greater_or_equal internal static bit(9) initial dcl 20-8 greater_than internal static bit(9) initial dcl 20-8 gt internal static bit(9) initial dcl 30-3 half_to_word internal static bit(9) initial dcl 20-8 i_bin_integer internal static bit(9) initial dcl 30-3 i_dec_integer internal static bit(9) initial dcl 30-3 i_fixed_bin internal static bit(9) initial dcl 30-3 i_fixed_dec internal static bit(9) initial dcl 30-3 i_float_bin internal static bit(9) initial dcl 30-3 i_float_dec internal static bit(9) initial dcl 30-3 if_statement internal static bit(9) initial dcl 24-3 index_after_fun internal static bit(9) initial dcl 20-8 index_before_fun internal static bit(9) initial dcl 20-8 index_fun internal static bit(9) initial dcl 20-8 io_data_list_semantics 000000 constant entry external dcl 1-143 io_data_list_semantics$format_list_semantics 000000 constant entry external dcl 1-120 io_semantics 000000 constant entry external dcl 1-148 irreducible_mask internal static bit(36) initial dcl 17-3 is_arith_constant internal static bit(9) initial dcl 30-47 is_arithmetic_constant internal static bit(9) initial dcl 30-47 is_constant internal static bit(9) initial dcl 30-47 is_decimal_constant internal static bit(9) initial dcl 30-47 is_delimiter internal static bit(9) initial dcl 30-47 is_float_constant internal static bit(9) initial dcl 30-47 is_identifier internal static bit(9) initial dcl 30-47 is_imaginary_constant internal static bit(9) initial dcl 30-47 is_integral_constant internal static bit(9) initial dcl 30-47 is_isub internal static bit(9) initial dcl 30-47 isub internal static bit(9) initial dcl 30-3 jump internal static bit(9) initial dcl 20-8 jump_false internal static bit(9) initial dcl 20-8 jump_if_eq internal static bit(9) initial dcl 20-8 jump_if_ge internal static bit(9) initial dcl 20-8 jump_if_gt internal static bit(9) initial dcl 20-8 jump_if_le internal static bit(9) initial dcl 20-8 jump_if_lt internal static bit(9) initial dcl 20-8 jump_if_ne internal static bit(9) initial dcl 20-8 jump_true internal static bit(9) initial dcl 20-8 l_parn internal static bit(9) initial dcl 20-8 label_array_element_node internal static bit(9) initial dcl 18-5 label_mask internal static bit(36) initial dcl 17-3 le internal static bit(9) initial dcl 30-3 left_parn internal static bit(9) initial dcl 30-3 less_or_equal internal static bit(9) initial dcl 20-8 less_than internal static bit(9) initial dcl 20-8 line_format internal static bit(9) initial dcl 20-8 local_label_var_type internal static bit(36) initial dcl 28-71 local_mask internal static bit(36) initial dcl 17-3 locate_file internal static bit(9) initial dcl 20-8 locate_statement internal static bit(9) initial dcl 24-3 lock_file internal static bit(9) initial dcl 20-8 lock_fun internal static bit(9) initial dcl 20-8 lock_mask internal static bit(36) initial dcl 17-3 lock_statement internal static bit(9) initial dcl 24-3 log10_fun internal static bit(9) initial dcl 20-8 log2_fun internal static bit(9) initial dcl 20-8 log_fun internal static bit(9) initial dcl 20-8 lookup 000000 constant entry external dcl 1-153 lt internal static bit(9) initial dcl 30-3 machine_state_node internal static bit(9) initial dcl 18-5 make_desc internal static bit(9) initial dcl 20-8 match_arguments 000000 constant entry external dcl 1-166 max_area_size internal static fixed bin(31,0) initial dcl 28-5 max_bit_string internal static fixed bin(31,0) initial dcl 28-5 max_bit_string_constant internal static fixed bin(31,0) initial dcl 28-5 max_block_number internal static fixed bin(17,0) initial dcl 9-74 max_char_string internal static fixed bin(31,0) initial dcl 28-5 max_char_string_constant internal static fixed bin(31,0) initial dcl 28-5 max_identifier_length internal static fixed bin(31,0) initial dcl 28-5 max_index_register_value internal static fixed bin(31,0) initial dcl 28-5 max_list_elements internal static fixed bin(17,0) initial dcl 16-12 max_number_of_dimensions internal static fixed bin(31,0) initial dcl 28-5 max_number_of_operands internal static fixed bin(15,0) initial dcl 19-15 max_p_bin_or_dec internal static fixed bin(31,0) initial dcl 28-5 max_signed_index_register_value internal static fixed bin(31,0) initial dcl 28-5 max_signed_xreg_precision internal static fixed bin(31,0) initial dcl 28-5 max_uns_xreg_precision internal static fixed bin(31,0) initial dcl 28-5 max_words_per_variable internal static fixed bin(31,0) initial dcl 28-5 merge_attributes 000000 constant entry external dcl 2-355 minus internal static bit(9) initial dcl 30-3 mod2_ internal static fixed bin(3,0) initial dcl 10-5 mod4_ internal static fixed bin(3,0) initial dcl 10-5 mod_fun internal static bit(9) initial dcl 20-8 mod_word internal static bit(9) initial dcl 20-8 ne internal static bit(9) initial dcl 30-3 negate internal static bit(9) initial dcl 20-8 ngt internal static bit(9) initial dcl 30-3 nlt internal static bit(9) initial dcl 30-3 no_token internal static bit(9) initial dcl 30-3 nop internal static bit(9) initial dcl 20-8 not internal static bit(9) initial dcl 30-3 not_equal internal static bit(9) initial dcl 20-8 null_statement internal static bit(9) initial dcl 24-3 off_fun internal static bit(9) initial dcl 20-8 on_statement internal static bit(9) initial dcl 24-3 open_file internal static bit(9) initial dcl 20-8 open_statement internal static bit(9) initial dcl 24-3 optimizer 000000 constant entry external dcl 2-361 or internal static bit(9) initial dcl 30-3 pack internal static bit(9) initial dcl 20-8 page_format internal static bit(9) initial dcl 20-8 param_desc_ptr internal static bit(9) initial dcl 20-8 param_ptr internal static bit(9) initial dcl 20-8 parse_error 000000 constant entry external dcl 2-364 parse_error$no_text 000000 constant entry external dcl 2-368 passed_as_arg_bit internal static fixed bin(15,0) initial dcl 27-3 percent internal static bit(9) initial dcl 30-3 period internal static bit(9) initial dcl 30-3 picture_format internal static bit(9) initial dcl 20-8 picture_mask internal static bit(36) initial dcl 17-3 pl1_error_print$listing_segment 000000 constant entry external dcl 2-384 pl1_error_print$write_out 000000 constant entry external dcl 2-372 pl1_mod_fun internal static bit(9) initial dcl 20-8 pl1_print$for_lex 000000 constant entry external dcl 2-418 pl1_print$non_varying 000000 constant entry external dcl 2-398 pl1_print$non_varying_nl 000000 constant entry external dcl 2-402 pl1_print$string_pointer 000000 constant entry external dcl 2-406 pl1_print$string_pointer_nl 000000 constant entry external dcl 2-410 pl1_print$unaligned_nl 000000 constant entry external dcl 2-414 pl1_print$varying 000000 constant entry external dcl 2-392 pl1_print$varying_nl 000000 constant entry external dcl 2-395 plus internal static bit(9) initial dcl 30-3 precision_mask internal static bit(36) initial dcl 17-3 prefix_plus internal static bit(9) initial dcl 20-8 procedure_statement internal static bit(9) initial dcl 24-3 ptr_fun internal static bit(9) initial dcl 20-8 ptr_mask internal static bit(36) initial dcl 17-3 put_control internal static bit(9) initial dcl 20-8 put_data_trans internal static bit(9) initial dcl 20-8 put_edit_trans internal static bit(9) initial dcl 20-8 put_field internal static bit(9) initial dcl 20-8 put_field_chk internal static bit(9) initial dcl 20-8 put_file internal static bit(9) initial dcl 20-8 put_list_trans internal static bit(9) initial dcl 20-8 put_statement internal static bit(9) initial dcl 24-3 put_string internal static bit(9) initial dcl 20-8 r_format internal static bit(9) initial dcl 20-8 r_parn internal static bit(9) initial dcl 20-8 rank_fun internal static bit(9) initial dcl 20-8 read_file internal static bit(9) initial dcl 20-8 read_statement internal static bit(9) initial dcl 24-3 real_fun internal static bit(9) initial dcl 20-8 real_type internal static bit(36) initial dcl 28-71 record_io internal static bit(9) initial dcl 20-8 reducible_mask internal static bit(36) initial dcl 17-3 refer internal static bit(9) initial dcl 20-8 rel_fun internal static bit(9) initial dcl 20-8 repeat_fun internal static bit(9) initial dcl 20-8 reserve$clear 000000 constant entry external dcl 2-430 reserve$read_lib 000000 constant entry external dcl 2-439 return_bits internal static bit(9) initial dcl 20-8 return_statement internal static bit(9) initial dcl 24-3 return_string internal static bit(9) initial dcl 20-8 return_value internal static bit(9) initial dcl 20-8 return_words internal static bit(9) initial dcl 20-8 returns_mask internal static bit(36) initial dcl 17-3 revert_on internal static bit(9) initial dcl 20-8 revert_statement internal static bit(9) initial dcl 24-3 rewrite_file internal static bit(9) initial dcl 20-8 rewrite_statement internal static bit(9) initial dcl 24-3 right_parn internal static bit(9) initial dcl 30-3 round_fun internal static bit(9) initial dcl 20-8 segno_fun internal static bit(9) initial dcl 20-8 semantic_translator 000000 constant entry external dcl 2-444 semantic_translator$call_es 000000 constant entry external dcl 1-196 semi_colon internal static bit(9) initial dcl 30-3 setbitno_fun internal static bit(9) initial dcl 20-8 setcharno_fun internal static bit(9) initial dcl 20-8 sf_par_node internal static bit(9) initial dcl 18-5 sign_fun internal static bit(9) initial dcl 20-8 signal_on internal static bit(9) initial dcl 20-8 signal_statement internal static bit(9) initial dcl 24-3 signed_mask internal static bit(36) initial dcl 17-3 sin_fun internal static bit(9) initial dcl 20-8 sind_fun internal static bit(9) initial dcl 20-8 skip_format internal static bit(9) initial dcl 20-8 slash internal static bit(9) initial dcl 30-3 source_node internal static bit(9) initial dcl 18-5 sqrt_fun internal static bit(9) initial dcl 20-8 stack_ptr internal static bit(9) initial dcl 20-8 stackbaseptr_fun internal static bit(9) initial dcl 20-8 stackframeptr_fun internal static bit(9) initial dcl 20-8 stacq_fun internal static bit(9) initial dcl 20-8 statement_node internal static bit(9) initial dcl 18-5 std_entry internal static bit(9) initial dcl 20-8 std_return internal static bit(9) initial dcl 20-8 stop internal static bit(9) initial dcl 20-8 stop_statement internal static bit(9) initial dcl 24-3 storage_block_mask internal static bit(36) initial dcl 17-3 stream_prep internal static bit(9) initial dcl 20-8 string_mask internal static bit(36) initial dcl 17-41 subscripter 000000 constant entry external dcl 1-216 system_on_unit internal static bit(9) initial dcl 24-3 tan_fun internal static bit(9) initial dcl 20-8 tand_fun internal static bit(9) initial dcl 20-8 temporary_node internal static bit(9) initial dcl 18-5 terminate_trans internal static bit(9) initial dcl 20-8 token_to_binary 000000 constant entry external dcl 2-459 translate_fun internal static bit(9) initial dcl 20-8 trunc_fun internal static bit(9) initial dcl 20-8 unknown_statement internal static bit(9) initial dcl 24-3 unlock_file internal static bit(9) initial dcl 20-8 unlock_statement internal static bit(9) initial dcl 24-3 unpack internal static bit(9) initial dcl 20-8 unsigned_mask internal static bit(36) initial dcl 17-3 validate 000000 constant entry external dcl 1-225 variable_mask internal static bit(36) initial dcl 17-3 vclock_fun internal static bit(9) initial dcl 20-8 verify_fun internal static bit(9) initial dcl 20-8 verify_ltrim_fun internal static bit(9) initial dcl 20-8 verify_rtrim_fun internal static bit(9) initial dcl 20-8 wait_statement internal static bit(9) initial dcl 24-3 word_to_mod2 internal static bit(9) initial dcl 20-8 word_to_mod4 internal static bit(9) initial dcl 20-8 word_to_mod8 internal static bit(9) initial dcl 20-8 wordno_fun internal static bit(9) initial dcl 20-8 words_per_condition_var internal static fixed bin(31,0) initial dcl 28-5 words_per_entry_var internal static fixed bin(31,0) initial dcl 28-5 words_per_file_var internal static fixed bin(31,0) initial dcl 28-5 words_per_fix_bin_1 internal static fixed bin(31,0) initial dcl 28-5 words_per_fix_bin_2 internal static fixed bin(31,0) initial dcl 28-5 words_per_flt_bin_1 internal static fixed bin(31,0) initial dcl 28-5 words_per_flt_bin_2 internal static fixed bin(31,0) initial dcl 28-5 words_per_format internal static fixed bin(31,0) initial dcl 28-5 words_per_label_var internal static fixed bin(31,0) initial dcl 28-5 words_per_offset internal static fixed bin(31,0) initial dcl 28-5 words_per_packed_pointer internal static fixed bin(31,0) initial dcl 28-5 words_per_pointer internal static fixed bin(31,0) initial dcl 28-5 words_per_varying_string_header internal static fixed bin(31,0) initial dcl 28-5 write_file internal static bit(9) initial dcl 20-8 write_statement internal static bit(9) initial dcl 24-3 x_format internal static bit(9) initial dcl 20-8 NAMES DECLARED BY EXPLICIT CONTEXT. abort 022543 constant label dcl 3866 ref 3848 3852 3856 3860 3864 action 000000 constant label array(0:74) dcl 627 ref 625 2695 2800 aggregate 006236 constant label dcl 1275 ref 882 902 1247 builtin 000310 constant entry external dcl 31 check_prec_scale 022321 constant label dcl 3080 ref 689 check_reverse 025236 constant entry internal dcl 3419 ref 714 719 2128 2406 check_strings 025327 constant entry internal dcl 3448 ref 880 3457 chk_context 004115 constant label dcl 990 ref 981 constant_value 026757 constant entry internal dcl 3730 ref 639 657 662 682 685 788 964 969 1121 1134 1483 1486 1504 1509 1594 1796 2014 2616 2617 conv_arg 001723 constant label dcl 582 ref 424 430 460 483 503 525 536 558 convert_arg 025416 constant entry internal dcl 3469 ref 582 711 832 859 917 1227 1477 1566 1736 1777 1930 1934 2367 2375 2812 2830 convert_label 022351 constant label dcl 3100 ref 1614 convert_to_arith 022204 constant label dcl 3044 ref 647 670 1514 create_assign 022136 constant label dcl 3035 ref 2051 2065 2660 create_call 021123 constant label dcl 2923 ref 1951 1965 2011 2297 2303 2309 2494 2681 2693 2780 create_index_or_verify 026670 constant entry internal dcl 3714 ref 2817 2833 2833 2855 create_length_fun 026477 constant entry internal dcl 3662 ref 599 944 1251 1825 1938 2846 create_operator_node 022432 constant label dcl 3113 ref 729 747 822 1432 1496 1529 1584 1611 1696 1741 1794 1821 1852 1855 2126 2145 2387 2404 2419 2429 2441 2465 2477 2683 2686 2803 2886 2895 2903 2912 2921 3877 declare_defined_overlay 026207 constant entry internal dcl 3569 ref 1344 1624 err124 022524 constant label dcl 3846 ref 357 427 434 478 507 516 520 531 562 569 576 875 1516 1548 1716 1760 2274 2341 2382 2421 2431 2435 2455 2458 2467 2479 2627 2629 2636 2640 2665 2668 2670 err146 022527 constant label dcl 3850 ref 1488 1491 3083 3086 3092 3097 3776 err359 022535 constant label dcl 3858 ref 2897 err381 022540 constant label dcl 3862 ref 361 err481 022532 constant label dcl 3854 ref 3100 3113 exit 022663 constant label dcl 3897 ref 413 2139 2272 2600 2774 2821 2834 2858 3033 3042 3128 expand_arguments 022747 constant entry internal dcl 3135 ref 411 fb1_value 026636 constant entry internal dcl 3697 ref 969 979 is_this_constant 025272 constant entry internal dcl 3434 ref 2133 leave 016526 constant label dcl 2554 ref 2548 make_add 020434 constant label dcl 2815 ref 2840 make_assignment 025774 constant entry internal dcl 3537 ref 1309 make_builtin_reference 027106 constant entry internal dcl 3795 ref 722 2820 2833 2857 make_call 017571 constant label dcl 2698 ref 3030 make_reference 006437 constant label dcl 1307 ref 893 1259 1272 merge 024175 constant entry internal dcl 3304 ref 3203 3365 3390 next_descriptor 001724 constant label dcl 585 ref 421 500 507 553 565 572 579 pointer_decomp_common 016206 constant label dcl 2455 ref 2445 2448 2451 prepare_pointer 021114 constant label dcl 2914 ref 2339 2345 2369 2377 2471 2483 2878 2888 product 016504 constant label dcl 2545 ref 2622 repeat 003013 constant label dcl 788 ref 702 786 2876 ret 022555 constant label dcl 3869 ref 629 634 764 773 909 1217 1427 1693 1919 1987 2043 2057 2072 2131 2143 2266 2291 2594 2634 2663 2863 3111 3133 return_arg1 022521 constant label dcl 3130 ref 817 837 864 887 919 1220 reuse_qual_and_offset 026565 constant entry internal dcl 3680 ref 1029 1052 symbol_is_constant 027057 constant entry internal dcl 3785 ref 507 788 797 962 969 1120 1129 1592 1998 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 30552 30764 27763 30562 Length 32364 27763 212 1363 567 40 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME builtin 2870 external procedure is an external procedure. expand_arguments internal procedure shares stack frame of external procedure builtin. merge 416 internal procedure calls itself recursively. check_reverse internal procedure shares stack frame of external procedure builtin. is_this_constant internal procedure shares stack frame of external procedure builtin. check_strings 75 internal procedure calls itself recursively. convert_arg internal procedure shares stack frame of external procedure builtin. make_assignment internal procedure shares stack frame of external procedure builtin. declare_defined_overlay internal procedure shares stack frame of external procedure builtin. create_length_fun internal procedure shares stack frame of external procedure builtin. reuse_qual_and_offset internal procedure shares stack frame of external procedure builtin. fb1_value internal procedure shares stack frame of external procedure builtin. create_index_or_verify internal procedure shares stack frame of external procedure builtin. constant_value internal procedure shares stack frame of external procedure builtin. symbol_is_constant internal procedure shares stack frame of external procedure builtin. make_builtin_reference internal procedure shares stack frame of external procedure builtin. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 collating_sequence builtin STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME builtin 000100 tree builtin 000102 arg builtin 000502 ref builtin 001102 arg_symbol builtin 001502 length builtin 001504 offset builtin 001506 p builtin 001510 q builtin 001512 r builtin 001514 rlength builtin 001516 s builtin 001520 t builtin 001522 off builtin 001524 save_arg_one builtin 001526 cur_length builtin 001532 agg_ref builtin 001534 dcl_length builtin 001536 units builtin 001537 cunits builtin 001540 error_number builtin 001541 constant builtin 001542 arg_number builtin 001543 builtin_number builtin 001544 code builtin 001545 i builtin 001546 indicator builtin 001547 jump_index builtin 001550 m builtin 001551 reserved_number builtin 001552 rprecision builtin 001553 rscale builtin 001554 temp_size builtin 001555 c_length builtin 001556 c_offset builtin 001557 coff builtin 001560 integer builtin 001561 number builtin 001562 substr_index builtin 001563 p1 builtin 001564 p2 builtin 001565 q1 builtin 001566 q2 builtin 001567 rcount builtin 001570 integer_24 builtin 001571 desc_reqd builtin 001572 decimal_result builtin 001573 arith_size_ck builtin 001574 string_size_ck builtin 001575 pseudo_variable builtin 001576 full_attribute_set builtin 001577 not_flag builtin 001600 bit4 builtin 001601 modified builtin 001602 opcode builtin 001603 constant_string_length builtin 001604 builtin_string builtin 001606 rtype builtin 001607 arg_type builtin 002007 as_if_type builtin 002207 targ_type builtin 002210 targ_prec builtin 002211 save_context builtin 002212 this_context builtin 002213 type builtin 002254 p expand_arguments 002256 q expand_arguments 002260 r expand_arguments 002262 lpp expand_arguments 002264 jpp expand_arguments 002266 lp expand_arguments 002666 jp expand_arguments 003266 cp expand_arguments 003666 i expand_arguments 003667 j expand_arguments 003670 k expand_arguments 003671 lll expand_arguments 003672 jcount expand_arguments 003673 lcount expand_arguments 003674 ll expand_arguments 004074 full_processing expand_arguments 004075 pure_array expand_arguments 004142 suppress_diagnostic convert_arg 004160 precision declare_defined_overlay 004161 scale declare_defined_overlay 004162 length declare_defined_overlay 004164 units declare_defined_overlay 004165 c_offset declare_defined_overlay 004166 r declare_defined_overlay 004170 s declare_defined_overlay 004172 t declare_defined_overlay 004174 found declare_defined_overlay 004204 p create_length_fun 004214 p reuse_qual_and_offset 004232 p create_index_or_verify 004242 initial_value constant_value 004260 p make_builtin_reference 004262 s make_builtin_reference 004264 subs make_builtin_reference 004266 i make_builtin_reference 004267 n make_builtin_reference check_strings 000100 p check_strings merge 000100 pp merge 000102 q merge 000104 o1 merge 000106 o2 merge 000110 o3 merge 000112 rpp merge 000512 i merge 000513 j merge 000514 k merge 000515 unmatch_bound merge THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_g_a r_e_as alloc_char_temp alloc_bit_temp unpk_to_pk call_ext_out_desc call_ext_out call_int_this call_int_other return_mac shorten_stack ext_entry int_entry reverse_cs reverse_bs set_chars_eis set_bits_eis any_to_any_truncate_ divide_fx1 THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. builtin check_star_extents compare_expression constant_length convert convert$from_builtin convert$to_integer convert$to_target convert$to_target_fb copy_expression create_list create_operator create_reference create_statement create_symbol create_token declare declare_constant declare_constant$bit declare_constant$char declare_constant$integer declare_descriptor declare_integer declare_temporary defined_reference expand_assign expand_infix expand_primitive expression_semantics fill_refer make_non_quick offset_adder operator_semantics propagate_bit refer_extent reserve$declare_lib semantic_translator$abort semantic_translator$error share_expression simplify_expression simplify_offset THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. pl1_data$builtin_name pl1_data$long_collating_sequence pl1_stat_$check_ansi pl1_stat_$cur_statement pl1_stat_$defined_list pl1_stat_$eis_mode pl1_stat_$root pl1_stat_$use_old_area LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 31 000302 62 000315 283 000325 285 000331 289 000354 291 000363 294 000370 295 000374 296 000402 297 000405 299 000407 304 000427 306 000434 309 000454 311 000455 314 000475 316 000476 321 000522 322 000526 324 000535 328 000612 332 000614 334 000615 336 000625 337 000626 338 000641 340 000643 344 000647 347 000660 352 000676 356 000730 357 000733 361 000747 363 000757 370 001005 372 001007 374 001012 375 001022 376 001026 378 001027 379 001031 380 001035 382 001047 384 001053 385 001054 386 001056 387 001061 388 001063 389 001065 390 001066 391 001070 392 001074 396 001105 398 001107 402 001110 404 001122 407 001140 410 001155 411 001160 413 001166 416 001167 418 001207 419 001223 421 001225 424 001227 427 001234 430 001235 433 001237 434 001243 438 001251 439 001262 441 001272 443 001300 445 001302 447 001321 449 001332 451 001335 452 001337 454 001350 455 001353 456 001355 459 001360 460 001363 463 001364 464 001366 466 001375 468 001403 472 001421 474 001424 476 001432 478 001435 483 001441 486 001442 487 001444 489 001446 490 001452 492 001471 493 001475 494 001477 497 001502 498 001505 500 001510 503 001511 506 001512 507 001514 516 001553 520 001562 523 001570 525 001572 528 001573 529 001575 531 001604 536 001611 539 001612 540 001614 542 001623 543 001626 545 001645 546 001651 547 001653 550 001656 551 001661 553 001664 555 001665 558 001667 562 001670 565 001677 568 001700 569 001702 572 001706 575 001707 576 001711 579 001722 582 001723 585 001724 588 001726 590 001733 591 001735 593 001737 594 001747 596 001761 599 001775 600 001777 603 002002 605 002004 607 002016 608 002021 611 002034 614 002035 616 002041 619 002062 620 002076 625 002101 627 002103 629 002117 631 002120 634 002135 636 002136 639 002140 642 002150 643 002151 647 002167 649 002170 655 002216 657 002220 659 002230 662 002231 665 002241 666 002242 670 002260 672 002261 676 002270 679 002276 682 002320 685 002327 687 002333 689 002335 691 002336 693 002340 694 002342 696 002344 697 002405 699 002410 700 002412 702 002414 704 002415 707 002426 710 002430 711 002435 712 002436 714 002440 716 002450 717 002452 719 002455 722 002466 726 002500 727 002502 729 002504 731 002505 735 002516 737 002550 740 002564 741 002567 745 002572 746 002574 747 002576 754 002577 757 002617 758 002630 760 002650 761 002675 764 002710 768 002711 770 002731 773 002733 775 002734 777 002736 778 002740 780 002742 781 003003 783 003006 784 003010 786 003012 788 003013 793 003024 795 003032 797 003041 799 003063 802 003065 803 003071 804 003072 805 003103 808 003112 809 003127 810 003154 811 003156 812 003160 814 003162 816 003163 817 003172 822 003200 824 003201 826 003206 827 003210 829 003216 832 003220 834 003221 837 003240 840 003241 843 003266 845 003270 848 003305 849 003311 853 003343 854 003345 856 003353 859 003355 861 003356 864 003375 867 003376 868 003401 869 003403 870 003410 871 003412 873 003413 875 003421 880 003426 882 003437 885 003440 886 003456 887 003461 890 003463 891 003465 892 003470 893 003472 897 003473 899 003500 902 003502 905 003506 907 003526 909 003541 912 003542 915 003560 916 003562 917 003564 919 003565 922 003566 925 003574 928 003576 929 003602 932 003621 933 003624 934 003625 935 003631 936 003642 942 003645 943 003656 944 003661 945 003663 946 003664 948 003665 949 003670 950 003672 955 003717 962 003744 963 003751 964 003753 965 003760 967 003761 969 003762 975 004032 976 004035 979 004043 980 004053 981 004056 985 004057 986 004074 987 004077 990 004115 992 004121 993 004141 994 004161 995 004164 996 004167 999 004171 1000 004201 1001 004221 1002 004224 1003 004227 1004 004233 1005 004235 1006 004236 1007 004244 1008 004250 1009 004252 1010 004254 1012 004256 1013 004261 1014 004263 1015 004265 1018 004266 1022 004272 1024 004316 1025 004323 1026 004325 1027 004340 1028 004345 1029 004347 1030 004351 1032 004355 1033 004361 1034 004363 1035 004367 1036 004373 1037 004375 1038 004376 1042 004400 1044 004402 1046 004403 1047 004417 1048 004424 1049 004426 1050 004430 1051 004433 1052 004441 1061 004444 1062 004446 1064 004450 1066 004457 1067 004461 1068 004463 1069 004467 1071 004531 1072 004534 1073 004536 1074 004543 1076 004545 1079 004560 1081 004566 1083 004573 1086 004575 1087 004611 1089 004637 1091 004642 1096 004643 1100 004663 1101 004700 1102 004725 1103 004727 1105 004731 1106 004733 1108 004734 1111 004754 1114 004775 1117 005023 1119 005033 1120 005034 1121 005041 1122 005046 1123 005050 1125 005051 1126 005053 1129 005055 1134 005104 1136 005110 1140 005126 1143 005134 1145 005155 1147 005156 1148 005161 1149 005177 1155 005200 1156 005215 1157 005242 1158 005245 1160 005262 1161 005302 1165 005331 1167 005355 1170 005361 1172 005405 1175 005426 1178 005454 1181 005455 1182 005472 1183 005517 1184 005523 1185 005540 1187 005560 1190 005563 1195 005566 1196 005571 1197 005605 1200 005607 1202 005636 1205 005661 1207 005710 1210 005733 1212 005735 1214 005747 1215 005753 1216 005756 1217 005775 1220 005776 1222 005777 1224 006003 1225 006020 1226 006022 1227 006024 1230 006025 1233 006054 1234 006056 1236 006060 1240 006104 1241 006115 1244 006120 1245 006126 1247 006144 1250 006145 1251 006150 1252 006152 1253 006153 1255 006154 1256 006157 1259 006161 1262 006165 1263 006170 1264 006174 1265 006211 1266 006214 1267 006230 1268 006231 1269 006232 1272 006235 1275 006236 1279 006256 1280 006265 1281 006270 1282 006301 1284 006302 1285 006304 1287 006315 1292 006341 1294 006350 1295 006365 1297 006370 1298 006371 1299 006372 1303 006375 1307 006437 1309 006443 1311 006444 1314 006454 1315 006456 1316 006461 1317 006463 1320 006474 1322 006505 1326 006507 1327 006513 1328 006533 1329 006553 1330 006556 1331 006561 1334 006563 1336 006571 1339 006573 1341 006601 1344 006615 1348 006622 1350 006625 1355 006630 1356 006632 1357 006636 1358 006640 1359 006642 1360 006646 1362 006652 1365 006665 1367 006673 1369 006700 1372 006702 1373 006716 1375 006744 1377 006747 1380 006750 1382 006766 1384 006772 1387 007000 1389 007011 1390 007025 1391 007041 1392 007044 1393 007045 1395 007046 1396 007062 1397 007066 1399 007067 1402 007073 1403 007101 1404 007102 1405 007104 1406 007110 1409 007112 1410 007142 1411 007171 1414 007214 1415 007243 1418 007266 1420 007300 1421 007304 1422 007307 1423 007326 1424 007327 1427 007331 1429 007332 1432 007344 1434 007345 1440 007346 1441 007353 1443 007355 1445 007363 1447 007371 1451 007411 1453 007415 1455 007424 1457 007427 1459 007431 1461 007442 1464 007447 1466 007460 1469 007465 1471 007476 1474 007503 1476 007505 1477 007513 1478 007514 1480 007516 1483 007540 1486 007547 1488 007553 1491 007560 1494 007572 1496 007574 1498 007575 1504 007604 1506 007614 1509 007615 1511 007625 1514 007626 1516 007627 1522 007632 1525 007653 1527 007665 1529 007666 1531 007667 1535 007670 1536 007675 1538 007677 1540 007705 1542 007713 1545 007727 1548 007732 1550 007736 1552 007740 1554 007751 1557 007756 1559 007767 1562 007774 1563 007776 1565 010003 1566 010011 1567 010012 1569 010014 1570 010017 1571 010022 1572 010026 1574 010032 1576 010036 1578 010060 1581 010075 1584 010115 1586 010116 1590 010125 1592 010127 1594 010137 1595 010143 1596 010145 1598 010146 1599 010147 1602 010162 1604 010166 1605 010172 1606 010207 1608 010214 1609 010216 1611 010220 1614 010221 1616 010222 1620 010227 1621 010233 1624 010244 1625 010252 1627 010255 1629 010262 1632 010277 1634 010302 1636 010312 1637 010315 1638 010321 1639 010327 1641 010330 1642 010334 1644 010340 1646 010341 1647 010344 1648 010350 1649 010353 1651 010354 1652 010360 1656 010363 1657 010367 1659 010421 1660 010435 1662 010437 1663 010442 1664 010443 1667 010465 1668 010470 1669 010473 1671 010477 1675 010546 1676 010551 1677 010553 1678 010560 1679 010563 1680 010564 1681 010566 1682 010570 1683 010572 1685 010576 1686 010600 1688 010627 1692 010642 1693 010644 1696 010645 1698 010646 1701 010647 1703 010651 1704 010661 1706 010663 1708 010671 1710 010677 1713 010713 1716 010716 1718 010722 1720 010724 1721 010733 1722 010740 1723 010746 1725 010750 1728 010755 1731 010762 1733 010764 1735 010766 1736 010775 1737 010776 1738 011007 1739 011016 1741 011020 1743 011021 1745 011024 1747 011026 1748 011033 1750 011035 1752 011043 1754 011051 1757 011065 1760 011070 1762 011074 1764 011076 1766 011107 1769 011114 1771 011125 1774 011132 1776 011134 1777 011141 1778 011142 1780 011144 1781 011147 1782 011152 1783 011156 1785 011162 1787 011166 1789 011177 1791 011212 1794 011221 1796 011222 1799 011226 1800 011231 1804 011255 1809 011275 1811 011277 1812 011302 1815 011320 1817 011331 1821 011336 1823 011337 1825 011345 1827 011363 1829 011404 1831 011407 1833 011411 1836 011431 1837 011432 1838 011447 1839 011474 1840 011476 1842 011500 1845 011523 1849 011546 1850 011552 1851 011576 1852 011611 1855 011612 1858 011621 1859 011626 1861 011631 1864 011635 1865 011637 1866 011654 1867 011676 1868 011677 1869 011701 1870 011716 1871 011721 1872 011722 1873 011724 1874 011741 1875 011744 1878 011745 1880 011752 1882 011757 1886 011764 1888 011766 1890 011774 1893 011776 1894 012013 1895 012036 1897 012042 1898 012060 1899 012103 1901 012105 1904 012107 1905 012124 1906 012127 1909 012131 1911 012154 1912 012156 1913 012173 1914 012216 1916 012220 1919 012221 1921 012222 1925 012233 1926 012235 1929 012236 1930 012243 1931 012244 1933 012246 1934 012250 1936 012251 1937 012261 1938 012265 1940 012275 1941 012312 1942 012345 1944 012347 1945 012350 1947 012353 1949 012355 1951 012357 1953 012360 1962 012365 1965 012371 1967 012372 1973 012412 1976 012416 1978 012436 1980 012446 1982 012456 1985 012470 1987 012523 1990 012524 1993 012544 1996 012600 1998 012603 1999 012610 2000 012631 2002 012634 2003 012650 2005 012653 2006 012655 2007 012657 2008 012661 2009 012663 2011 012664 2014 012665 2016 012671 2019 012716 2020 012721 2021 012735 2022 012740 2024 012742 2025 012746 2026 012763 2027 012766 2028 012771 2032 012773 2033 012777 2034 013014 2035 013017 2036 013022 2040 013024 2042 013033 2043 013066 2046 013067 2047 013100 2048 013122 2050 013142 2051 013144 2054 013145 2056 013153 2057 013206 2060 013207 2061 013220 2062 013242 2064 013262 2065 013264 2068 013265 2069 013274 2070 013300 2072 013333 2075 013334 2076 013345 2079 013366 2081 013410 2084 013436 2086 013447 2087 013464 2088 013511 2089 013513 2093 013514 2094 013526 2097 013550 2099 013572 2102 013620 2104 013631 2105 013646 2106 013673 2107 013675 2110 013676 2111 013713 2112 013740 2113 013742 2115 013760 2118 013761 2119 013767 2120 014012 2122 014014 2123 014016 2124 014020 2126 014021 2128 014022 2130 014027 2131 014032 2133 014033 2134 014040 2135 014043 2137 014073 2139 014120 2141 014122 2142 014126 2143 014130 2145 014131 2147 014132 2152 014162 2153 014170 2155 014172 2156 014175 2157 014177 2158 014202 2159 014203 2160 014204 2162 014222 2164 014230 2168 014231 2171 014250 2172 014253 2174 014275 2175 014306 2177 014312 2178 014315 2179 014316 2182 014320 2183 014323 2184 014337 2185 014342 2188 014362 2190 014374 2193 014422 2194 014444 2196 014447 2200 014450 2201 014464 2202 014467 2203 014532 2205 014551 2206 014555 2208 014563 2209 014576 2210 014603 2211 014604 2212 014607 2213 014611 2215 014630 2220 014650 2221 014665 2222 014702 2224 014717 2227 014752 2229 015001 2231 015023 2232 015031 2233 015034 2235 015041 2237 015061 2238 015064 2240 015065 2244 015100 2245 015104 2248 015106 2249 015123 2250 015126 2252 015130 2256 015131 2257 015135 2258 015140 2259 015142 2260 015143 2264 015145 2266 015150 2268 015151 2270 015153 2272 015210 2274 015211 2278 015214 2279 015220 2280 015235 2281 015254 2282 015274 2283 015325 2284 015346 2286 015353 2289 015402 2291 015405 2294 015406 2295 015410 2297 015412 2299 015413 2301 015415 2303 015417 2305 015420 2307 015422 2309 015424 2311 015425 2314 015450 2318 015470 2322 015513 2323 015524 2324 015535 2328 015544 2330 015555 2331 015605 2336 015640 2339 015656 2341 015657 2345 015662 2351 015703 2354 015721 2357 015737 2358 015742 2359 015757 2360 016005 2361 016007 2364 016010 2365 016013 2366 016015 2367 016017 2369 016020 2372 016021 2373 016031 2374 016033 2375 016035 2377 016036 2379 016037 2382 016052 2385 016055 2387 016057 2389 016060 2396 016103 2399 016111 2400 016113 2401 016115 2402 016116 2404 016120 2406 016121 2409 016126 2410 016131 2412 016140 2416 016142 2417 016144 2419 016146 2421 016147 2425 016152 2426 016154 2427 016156 2429 016157 2431 016160 2435 016163 2438 016166 2439 016170 2441 016172 2443 016173 2445 016175 2446 016176 2448 016200 2449 016201 2451 016203 2452 016204 2455 016206 2458 016211 2461 016214 2462 016216 2463 016217 2465 016221 2467 016222 2471 016225 2473 016226 2475 016230 2477 016232 2479 016233 2483 016236 2485 016237 2490 016263 2492 016266 2494 016270 2496 016271 2501 016311 2502 016314 2503 016316 2504 016320 2505 016321 2506 016322 2507 016325 2508 016327 2509 016331 2510 016332 2511 016333 2512 016336 2513 016343 2514 016350 2517 016361 2519 016364 2521 016372 2525 016374 2527 016405 2529 016413 2531 016415 2532 016416 2533 016424 2534 016425 2536 016433 2539 016435 2542 016463 2545 016504 2547 016506 2548 016515 2552 016525 2554 016526 2556 016543 2558 016547 2559 016564 2561 016567 2562 016607 2563 016617 2564 016621 2565 016625 2567 016633 2569 016642 2571 016645 2573 016651 2575 016674 2577 016726 2579 016731 2580 016746 2581 016751 2583 017004 2586 017032 2588 017055 2589 017102 2590 017105 2592 017130 2594 017132 2596 017133 2598 017135 2600 017171 2602 017172 2604 017207 2605 017212 2607 017214 2609 017236 2611 017257 2614 017302 2615 017306 2616 017311 2617 017315 2620 017324 2622 017326 2624 017327 2627 017332 2629 017335 2632 017341 2634 017354 2636 017355 2640 017361 2643 017366 2645 017370 2650 017431 2651 017443 2655 017466 2658 017512 2660 017514 2663 017515 2665 017516 2668 017521 2670 017525 2673 017531 2674 017533 2676 017535 2677 017537 2678 017541 2681 017560 2683 017561 2686 017562 2689 017563 2691 017565 2693 017567 2695 017570 2698 017571 2704 017631 2708 017634 2709 017636 2713 017660 2716 017677 2718 017707 2722 017711 2723 017720 2724 017740 2727 017752 2728 017756 2729 017760 2730 017762 2731 017763 2734 017765 2736 017767 2738 017776 2741 020006 2742 020023 2743 020027 2745 020031 2746 020036 2748 020056 2750 020110 2752 020113 2756 020115 2757 020132 2758 020150 2759 020170 2760 020221 2761 020242 2763 020247 2764 020253 2765 020255 2766 020272 2767 020312 2768 020330 2770 020347 2771 020363 2774 020365 2776 020366 2778 020370 2780 020372 2782 020373 2800 020404 2803 020407 2805 020410 2808 020421 2811 020423 2812 020431 2813 020432 2815 020434 2817 020451 2818 020456 2820 020474 2821 020505 2823 020506 2826 020517 2829 020521 2830 020527 2831 020530 2833 020532 2834 020556 2836 020557 2840 020601 2842 020602 2846 020624 2848 020632 2850 020652 2853 020665 2854 020702 2855 020705 2857 020712 2858 020734 2860 020735 2863 020752 2865 020753 2867 020755 2868 020757 2870 020761 2871 021022 2873 021025 2874 021027 2876 021031 2878 021032 2882 021033 2885 021035 2886 021037 2888 021040 2892 021041 2894 021043 2895 021045 2897 021046 2900 021047 2902 021051 2903 021053 2905 021054 2910 021107 2911 021111 2912 021113 2914 021114 2917 021116 2919 021120 2921 021122 2923 021123 2925 021137 2926 021147 2927 021153 2929 021155 2930 021172 2932 021210 2934 021217 2935 021223 2938 021225 2939 021245 2941 021250 2945 021252 2946 021305 2948 021326 2950 021346 2951 021354 2953 021363 2956 021403 2958 021411 2960 021437 2962 021446 2964 021453 2965 021463 2968 021516 2970 021520 2972 021530 2973 021533 2974 021535 2976 021565 2978 021572 2980 021607 2981 021614 2983 021631 2985 021663 2986 021666 2987 021670 2989 021671 2990 021714 2991 021726 2992 021731 2993 021733 2994 021735 2996 021737 2998 021745 3000 021753 3004 021756 3006 021762 3008 022003 3009 022005 3011 022007 3012 022021 3015 022057 3018 022061 3021 022111 3022 022115 3024 022123 3027 022125 3028 022132 3030 022134 3033 022135 3035 022136 3037 022153 3038 022200 3040 022202 3042 022203 3044 022204 3046 022206 3048 022210 3050 022216 3052 022224 3056 022241 3058 022244 3060 022252 3063 022254 3064 022257 3065 022263 3068 022267 3069 022272 3070 022276 3073 022302 3074 022305 3075 022311 3078 022315 3080 022321 3083 022323 3086 022330 3089 022336 3092 022337 3095 022345 3097 022346 3100 022351 3104 022353 3105 022355 3106 022400 3107 022413 3108 022414 3111 022431 3113 022432 3117 022434 3119 022457 3120 022475 3122 022500 3123 022507 3124 022514 3126 022516 3128 022520 3130 022521 3133 022523 3846 022524 3848 022526 3850 022527 3852 022531 3854 022532 3856 022534 3858 022535 3860 022537 3862 022540 3864 022542 3866 022543 3869 022555 3871 022571 3872 022573 3873 022576 3875 022603 3876 022605 3877 022607 3880 022610 3890 022635 3897 022663 3899 022665 3900 022675 3901 022717 3904 022732 3906 022741 3909 022743 3135 022747 3138 022751 3145 023043 3147 023045 3148 023055 3150 023061 3152 023072 3153 023075 3155 023076 3156 023105 3157 023107 3159 023113 3161 023115 3162 023121 3163 023125 3167 023130 3169 023141 3170 023145 3173 023146 3176 023163 3178 023164 3181 023167 3183 023202 3185 023204 3187 023217 3189 023242 3191 023244 3195 023270 3196 023303 3197 023313 3198 023317 3200 023321 3203 023347 3206 023365 3209 023375 3211 023377 3212 023407 3213 023412 3215 023414 3217 023424 3220 023427 3223 023436 3225 023445 3226 023447 3228 023452 3231 023471 3232 023515 3238 023556 3241 023560 3242 023563 3243 023566 3244 023570 3246 023572 3249 023600 3250 023603 3251 023605 3253 023607 3254 023621 3255 023625 3257 023630 3259 023637 3260 023654 3261 023701 3262 023704 3263 023707 3265 023725 3266 023727 3267 023731 3268 023734 3270 023736 3273 023742 3275 023744 3277 023753 3278 023770 3279 024006 3280 024024 3282 024055 3283 024056 3284 024057 3286 024073 3287 024075 3289 024077 3291 024101 3292 024111 3293 024117 3294 024137 3296 024157 3297 024160 3299 024164 3300 024166 3302 024170 3304 024174 3307 024202 3320 024203 3321 024211 3322 024217 3323 024227 3324 024236 3326 024262 3329 024307 3332 024341 3334 024343 3335 024345 3336 024362 3337 024401 3339 024420 3341 024451 3342 024452 3343 024453 3345 024467 3347 024471 3348 024501 3349 024510 3350 024532 3351 024554 3353 024555 3355 024557 3358 024564 3360 024571 3361 024601 3363 024616 3365 024620 3367 024640 3370 024642 3371 024644 3372 024655 3373 024664 3375 024710 3378 024735 3380 024737 3381 024753 3383 024757 3384 024767 3386 025006 3388 025023 3390 025025 3391 025045 3393 025047 3397 025054 3398 025065 3402 025130 3404 025132 3406 025146 3407 025157 3409 025175 3411 025201 3413 025203 3419 025236 3425 025240 3430 025270 3434 025272 3439 025274 3444 025324 3448 025326 3453 025334 3455 025340 3457 025344 3460 025362 3464 025411 3465 025414 3467 025415 3469 025416 3474 025417 3477 025424 3478 025427 3480 025433 3481 025436 3482 025446 3483 025456 3484 025466 3486 025467 3487 025472 3488 025502 3489 025512 3492 025522 3493 025525 3494 025531 3497 025535 3498 025540 3499 025544 3502 025550 3503 025553 3504 025557 3508 025563 3510 025600 3513 025627 3516 025646 3518 025662 3520 025713 3522 025734 3525 025752 3526 025755 3528 025760 3529 025764 3530 025766 3533 025770 3535 025773 3537 025774 3540 025775 3541 026012 3542 026032 3543 026035 3544 026040 3546 026042 3548 026074 3549 026077 3551 026101 3553 026115 3555 026117 3556 026146 3559 026147 3560 026174 3561 026177 3562 026202 3563 026204 3566 026206 3569 026207 3593 026211 3594 026213 3595 026215 3600 026220 3601 026225 3602 026231 3603 026234 3604 026235 3607 026237 3611 026240 3613 026244 3614 026254 3619 026322 3621 026324 3623 026325 3629 026327 3631 026362 3632 026402 3633 026405 3634 026411 3635 026413 3636 026415 3637 026416 3638 026423 3640 026425 3641 026432 3642 026440 3644 026442 3645 026446 3650 026447 3651 026461 3652 026463 3653 026466 3654 026472 3656 026474 3662 026477 3666 026501 3667 026516 3668 026543 3669 026560 3670 026562 3680 026565 3685 026567 3687 026572 3689 026613 3692 026635 3697 026636 3702 026640 3706 026666 3714 026670 3719 026672 3720 026707 3721 026734 3722 026750 3723 026752 3724 026754 3730 026757 3758 026761 3761 026775 3766 027002 3771 027030 3773 027036 3776 027043 3779 027053 3785 027057 3790 027061 3792 027101 3795 027106 3811 027117 3812 027122 3814 027161 3818 027166 3819 027210 3821 027213 3823 027233 3824 027236 3825 027240 3826 027242 3828 027243 3831 027245 3832 027256 3833 027260 3834 027264 3835 027266 3836 027272 3841 027277 ----------------------------------------------------------- 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