THIS FILE IS DAMAGED COMPILATION LISTING OF SEGMENT operator_semantics Compiled by: Multics PL/I Compiler, Release 32d, of September 19, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 09/22/89 1359.6 mst Fri Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 15 /****^ HISTORY COMMENTS: 16* 1) change(89-07-10,RWaters), approve(89-07-10,MCR8121), audit(89-08-09,Vu), 17* install(89-09-22,MR12.3-1073): 18* Changed references to error msg 134 to msg 135. 19* END HISTORY COMMENTS */ 20 21 22 /* Modified: 15 Feb 1978 by PCK to implement options(main) and the stop statement 23* Modified: 9 August 1978 by PCK to fix bug 1753 24* Modified: 15 August 1978 by PCK to fix bug 1708 25* Modified: 25 August 1978 by PCK to fix bugs 1779 and 1730 26* Modified: 23 April 1979 by PCK to implement 4-bit decimal 27* Modified 790606 by PG to add byte and rank builtins 28* Modified 800103 by RAB to fix 1860 in which passing a label constant 29* as arg somtimes fails. 30* Modified: 1 July 1980 by PCK to fix 1975 (substr of an aligned string 31* is passed by reference when it is the target of an assignment 32* whose LHS is a function returning an aligned string 33* of the same length 34* Modified: 2 June 1981 by EBush to fix bug 1851 (faulting on multiply 35* declared entries) 36* Modified: 06 June 89 by RWaters changed references to error 37* message 134 to 135 38**/ 39 40 /* format: style2,^indattr,ifthendo,ifthen,^indnoniterdo,^elsestmt,dclind9 */ 41 operator_semantics: 42 proc (blk, stmnt, input_tree, context) returns (ptr); 43 44 /* parameters */ 45 dcl blk ptr parameter; 46 dcl stmnt ptr parameter; 47 dcl input_tree ptr parameter; 48 49 /* automatic */ 50 51 dcl (a, after_ret) ptr; 52 dcl (b, bb, c) ptr; 53 dcl desc ptr; 54 dcl e ptr; 55 dcl es ptr; 56 dcl expr ptr; 57 dcl (first, last) ptr; 58 dcl jump_stmnt ptr; 59 dcl last_jump ptr; 60 dcl length (2:3) ptr; 61 dcl next ptr; 62 dcl old_rand (2:3) ptr; 63 dcl orig_stmnt_ptr ptr; 64 dcl qq ptr; 65 dcl ref ptr; 66 dcl rv ptr; 67 dcl size ptr; 68 dcl sym ptr; 69 dcl signal_stmnt_ptr ptr; 70 dcl tree ptr; 71 dcl target ptr; 72 73 dcl (n, k, q, s, math_libe_no) fixed bin (15); 74 dcl (i, m, p, r) fixed bin (31); 75 dcl (rprec, rscale) fixed bin (31); 76 dcl c_length (2:3) fixed bin (31); 77 dcl prec (3) fixed bin (31); 78 dcl value_of_y fixed bin (71); 79 80 dcl decimal_result bit (1) aligned; 81 dcl first_time bit (1) aligned; 82 dcl m_set bit (1) aligned; 83 dcl end_statement_flag bit (1) aligned; 84 dcl label_attached bit (1) aligned; 85 dcl make_operator bit (1) aligned; 86 87 dcl (opcode, s_opcode) bit (9) aligned; 88 dcl result_type bit (36) aligned; 89 dcl integer fixed bin (15) based; 90 dcl cond_name char (16); 91 dcl based_char char (16) based; 92 dcl float_dec_target ptr; 93 dcl hold_abort_label label variable; 94 95 /* external static */ 96 dcl pl1_stat_$abort_label label ext static; 97 dcl pl1_stat_$cur_statement ptr ext static; 98 dcl pl1_stat_$error_flag bit (1) ext static; 99 dcl pl1_stat_$multi_type bit (1) ext static; 100 dcl pl1_stat_$root ptr ext static; 101 dcl pl1_stat_$stmnt_unreachable bit (1) ext static; 102 103 /* structures */ 104 105 dcl 1 atype like type; 106 dcl 1 btype like type; 107 dcl 1 ctype like type; 108 dcl 1 rtype like type; 109 110 /* builtins */ 111 112 dcl (abs, addr, bin, bool, divide, fixed, index, max, min, null, sign, string, substr, unspec) builtin; 113 114 /* internal static */ 115 116 dcl TRUE bit (1) int static options (constant) init ("1"b); 117 dcl FALSE bit (1) int static options (constant) init ("0"b); 118 119 dcl action_index (20, 0:15) fixed bin (15) int static init (0, 1, 1, 1, 1, 2, 3, (9) - 1, 120 /* class 1 */ 121 0, (5) 4, (10) - 1, 0, 5, (2) - 1, 0, -1, 13, -1, 0, -1, (6) - 1, (4) - 1, (6) 6, (6) - 1, 0, 122 (9) 7, (6) - 1, /* class 5 */ 123 0, 0, -1, 9, -1, 10, -1, 0, 13, 15, 15, 11, -1, -1, 0, -1, (4) 19, (12) - 1, (7) 12, -1, -1, 14, 124 14, (4) - 1, 12, (16) - 1, (11) - 1, 8, (4) - 1, 125 /* class 10 */ 126 15, (4) 0, (11) - 1, (2) 0, (14) - 1, (4) - 1, (3) 21, (9) - 1, 12, 12, 20, 0, (11) - 1, 0, 0, 127 (14) 16, -1, /* class 15 */ 128 (7) 16, (5) - 1, (4) 0, (2) 0, 11, 18, 18, (9) 16, 17, 0, (4) 16, (2) - 1, 2, 0, (7) - 1, 0, 129 (16) - 1, (16) - 1); /* class 20 */ 130 131 /* begin */ 132 tree = input_tree; 133 134 if tree = null then 135 goto ret; 136 if tree -> node.type ^= operator_node then 137 goto ret; 138 if tree -> operator.processed then 139 goto ret; 140 141 this_context = "0"b; 142 n, m = 0; 143 a, b, c, e, next, qq, ref, size, sym, length (2), length (3) = null; 144 /* safety first */ 145 146 k = tree -> operator.number; 147 148 opcode = tree -> operator.op_code; 149 150 if opcode < std_arg_list then 151 call extract; 152 153 goto action (action_index (fixed (substr (opcode, 1, 5), 5), fixed (substr (opcode, 6, 4), 4))); 154 155 156 /* 157* * This operator should not be seen by this procedure. 158* */ 159 action (-1): 160 call semantic_translator$abort (52, null); 161 162 /* 163* * This operator requires no action by this procedure. 164* */ 165 action (0): 166 goto ret; 167 168 /* 169* * This code is executed for the arithmetic operators + - / * 170* */ 171 action (1): 172 if b -> node.type = label_node | c -> node.type = label_node then 173 call semantic_translator$abort (78, null); 174 175 if btype.bit then 176 string (btype) = integer_type; 177 if ctype.bit then 178 string (ctype) = integer_type; 179 if btype.char then 180 string (btype) = dec_integer_type; 181 if ctype.char then 182 string (ctype) = dec_integer_type; 183 if btype.picture then 184 if b -> symbol.complex then 185 if b -> symbol.pic_float then 186 string (btype) = float_decimal_complex_mask; 187 else 188 string (btype) = fixed_decimal_complex_mask; 189 else if b -> symbol.pic_float then 190 string (btype) = float_decimal_real_mask; 191 else 192 string (btype) = fixed_decimal_real_mask; 193 if ctype.picture then 194 if c -> symbol.complex then 195 if c -> symbol.pic_float then 196 string (ctype) = float_decimal_complex_mask; 197 else 198 string (ctype) = fixed_decimal_complex_mask; 199 else if c -> symbol.pic_float then 200 string (ctype) = float_decimal_real_mask; 201 else 202 string (ctype) = fixed_decimal_real_mask; 203 204 if ^(btype.fixed | btype.float) then 205 call semantic_translator$abort (227, null); 206 if ^(ctype.fixed | ctype.float) then 207 call semantic_translator$abort (227, null); 208 209 if btype.binary & ctype.decimal then 210 string (ctype) = string (ctype) & ^decimal_mask | binary_mask; 211 if btype.decimal & ctype.binary then 212 string (btype) = string (btype) & ^decimal_mask | binary_mask; 213 if btype.complex | ctype.complex then 214 result_type = complex_mask; 215 else 216 result_type = real_mask; 217 218 if btype.binary then do; 219 if btype.fixed & ctype.float then 220 string (btype) = string (btype) & ^fixed_mask | float_mask; 221 if btype.float & ctype.fixed then 222 string (ctype) = string (ctype) & ^fixed_mask | float_mask; 223 224 call converter; 225 226 p = b -> symbol.c_dcl_size; 227 q = b -> symbol.scale; 228 r = c -> symbol.c_dcl_size; 229 s = c -> symbol.scale; 230 if b -> symbol.fixed then do; 231 result_type = result_type | binary_mask | fixed_mask | aligned_mask; 232 if opcode = add | opcode = sub then do; 233 m = min (max_p_fix_bin_2, max (p - q, r - s) + max (q, s) + 1); 234 n = max (q, s); 235 goto create_temp; 236 end; 237 if opcode = mult then do; 238 m = min (max_p_fix_bin_2, p + r + 1); 239 n = q + s; 240 goto create_temp; 241 end; 242 if opcode = div then do; 243 m = max_p_fix_bin_2; 244 n = m - p + q - s; 245 goto create_temp; 246 end; 247 end; 248 else do; 249 result_type = result_type | binary_mask | float_mask | aligned_mask; 250 m = max (p, r); 251 goto create_temp; 252 end; 253 end; 254 else do; 255 call converter; 256 257 p = b -> symbol.c_dcl_size; 258 q = b -> symbol.scale; 259 r = c -> symbol.c_dcl_size; 260 s = c -> symbol.scale; 261 if b -> symbol.fixed & c -> symbol.fixed then do; 262 result_type = result_type | decimal_mask | fixed_mask | aligned_mask; 263 if opcode = add | opcode = sub then do; 264 m = min (max_p_dec, max (p - q, r - s) + max (q, s) + 1); 265 n = max (q, s); 266 goto create_temp; 267 end; 268 if opcode = mult then do; 269 m = min (max_p_dec, p + r + 1); 270 n = q + s; 271 goto create_temp; 272 end; 273 if opcode = div then do; 274 m = max_p_dec; 275 n = m - p + q - s; 276 goto create_temp; 277 end; 278 end; 279 else do; 280 result_type = result_type | decimal_mask | float_mask | aligned_mask; 281 m = max (p, r); 282 goto create_temp; 283 end; 284 end; 285 286 /* 287* * This code is executed for the negate and the prefix_plus operator. 288* */ 289 action (2): 290 if opcode = prefix_plus then 291 call extract; 292 if b -> node.type = label_node then 293 call semantic_translator$abort (78, null); 294 295 if btype.bit then 296 string (btype) = integer_type; 297 if btype.char then 298 string (btype) = dec_integer_type; 299 if btype.picture then 300 if b -> symbol.complex then 301 if b -> symbol.pic_float then 302 string (btype) = float_decimal_complex_mask; 303 else 304 string (btype) = fixed_decimal_complex_mask; 305 else if b -> symbol.pic_float then 306 string (btype) = float_decimal_real_mask; 307 else 308 string (btype) = fixed_decimal_real_mask; 309 310 if ^(btype.fixed | btype.float) then 311 call semantic_translator$abort (227, null); 312 313 call converter; 314 315 if opcode = prefix_plus then do; 316 tree = tree -> operand (2); 317 goto ret; 318 end; 319 320 m = b -> symbol.c_dcl_size; 321 n = b -> symbol.scale; 322 result_type = string (btype) & ^unaligned_mask | aligned_mask; 323 goto create_temp; 324 325 /* 326* * This code is executed for the ** operator. 327* */ 328 action (3): 329 if b -> node.type = label_node | c -> node.type = label_node then 330 call semantic_translator$abort (78, null); 331 332 old_rand (2) = tree -> operand (2); 333 old_rand (3) = tree -> operand (3); 334 335 if btype.bit | btype.char then 336 string (btype) = integer_type; 337 if ctype.bit | ctype.char then 338 string (ctype) = integer_type; 339 340 if btype.picture then 341 if b -> symbol.complex then 342 if b -> symbol.pic_float then 343 string (btype) = float_decimal_complex_mask; 344 else 345 string (btype) = fixed_decimal_complex_mask; 346 else if b -> symbol.pic_float then 347 string (btype) = float_decimal_real_mask; 348 else 349 string (btype) = fixed_decimal_real_mask; 350 351 if ctype.picture then 352 if c -> symbol.complex then 353 if c -> symbol.pic_float then 354 string (ctype) = float_decimal_complex_mask; 355 else 356 string (ctype) = fixed_decimal_complex_mask; 357 else if c -> symbol.pic_float then 358 string (ctype) = float_decimal_real_mask; 359 else 360 string (ctype) = fixed_decimal_real_mask; 361 362 if ^(btype.fixed | btype.float) then 363 call semantic_translator$abort (227, null); 364 if ^(ctype.fixed | ctype.float) then 365 call semantic_translator$abort (227, null); 366 367 decimal_result = btype.decimal & ctype.decimal; 368 m_set = FALSE; 369 370 string (ctype) = string (ctype) & ^decimal_mask | binary_mask; 371 372 if ctype.fixed & ctype.real & c -> node.type = token_node then do; 373 m_set = TRUE; 374 c, e = convert ((old_rand (3)), string (ctype)); 375 c = c -> reference.symbol; 376 377 value_of_y = constant_value (c); 378 379 if value_of_y > 0 & c -> symbol.scale = 0 then do; 380 tree -> operand (3) = e; 381 382 if btype.complex then 383 string (btype) = string (btype) & ^fixed_mask & ^decimal_mask | float_mask | binary_mask; 384 385 tree -> operand (2), b = convert ((old_rand (2)), string (btype)); 386 if b -> node.type = operator_node then 387 b = b -> operand (1); 388 b = b -> reference.symbol; 389 390 p = b -> symbol.c_dcl_size; 391 q = b -> symbol.scale; 392 r = c -> symbol.c_dcl_size; 393 s = c -> symbol.scale; 394 395 m = max (p, r); 396 n = 0; 397 398 if btype.fixed & btype.real then do; 399 m = (p + 1) * value_of_y - 1; 400 n = q * value_of_y; 401 402 if m > max_p_fix_bin_2 | m > max_p_dec & btype.decimal then do; 403 b, tree -> operand (2) = convert ((old_rand (2)), real_type); 404 if b -> node.type = operator_node then 405 b = b -> operand (1); 406 b = b -> reference.symbol; 407 string (btype) = string (b -> symbol.attributes) & ^dimensioned_mask; 408 p = b -> symbol.c_dcl_size; 409 m = max (p, r); 410 end; 411 end; 412 end; 413 414 else do; 415 if value_of_y = 0 then do; 416 tree -> operand (3) = declare_constant$integer (0); 417 c = tree -> operand (3) -> reference.symbol; 418 end; 419 else do; 420 string (btype) = string (btype) & ^fixed_mask | float_mask; 421 string (ctype) = string (ctype) & ^fixed_mask | float_mask; 422 423 if btype.complex then 424 string (ctype) = string (ctype) & ^real_mask | complex_mask; 425 426 c, tree -> operand (3) = convert ((old_rand (3)), string (ctype)); 427 if c -> node.type = operator_node then 428 c = c -> operand (1); 429 c = c -> reference.symbol; 430 end; 431 432 b, tree -> operand (2) = convert ((old_rand (2)), string (btype)); 433 if b -> node.type = operator_node then 434 b = b -> operand (1); 435 b = b -> reference.symbol; 436 437 p = b -> symbol.c_dcl_size; 438 q = c -> symbol.c_dcl_size; 439 m = max (p, q); 440 n = 0; 441 end; 442 443 if ^btype.decimal then 444 goto create_exp_call; 445 end; 446 447 rtype = btype; 448 string (btype) = string (btype) & ^fixed_mask | float_mask; 449 450 if ctype.float | c -> symbol.scale ^= 0 then do; 451 string (btype) = string (btype) & ^decimal_mask | binary_mask; 452 string (ctype) = string (ctype) & ^fixed_mask | float_mask; 453 end; 454 455 if btype.complex then do; 456 string (btype) = string (btype) & ^decimal_mask | binary_mask; 457 458 if ctype.float | ctype.decimal | ctype.complex then 459 string (ctype) = string (ctype) & ^real_mask & ^fixed_mask | complex_mask | float_mask; 460 end; 461 else if ctype.complex then do; 462 string (btype) = string (btype) & ^decimal_mask & ^real_mask | binary_mask | complex_mask; 463 string (ctype) = string (ctype) & ^fixed_mask | float_mask; 464 end; 465 466 if btype.decimal then do; 467 float_dec_target = create_symbol (blk, null, by_compiler); 468 float_dec_target -> symbol.float, float_dec_target -> symbol.decimal, float_dec_target -> symbol.real, 469 float_dec_target -> symbol.temporary = TRUE; 470 float_dec_target -> symbol.c_dcl_size = max_p_dec; 471 472 call declare (float_dec_target); 473 474 float_dec_target = float_dec_target -> symbol.reference; 475 476 tree -> operand (3) = convert ((old_rand (3)), string (ctype)); 477 /* c can only be integer_type by now */ 478 479 if tree -> operand (3) -> node.type = operator_node then 480 c = tree -> operand (3) -> operand (1) -> reference.symbol; 481 else 482 c = tree -> operand (3) -> reference.symbol; 483 484 if ^m_set then do; 485 b = convert ((old_rand (2)), string (btype)); 486 if b -> node.type = operator_node then 487 b = b -> operand (1); 488 b = b -> reference.symbol; 489 m = max (b -> symbol.c_dcl_size, c -> symbol.c_dcl_size); 490 end; 491 492 tree -> operand (2) = convert$to_target ((old_rand (2)), float_dec_target); 493 if tree -> operand (2) -> node.type = reference_node then 494 if tree -> operand (2) -> reference.symbol -> symbol.c_dcl_size ^= max_p_dec then do; 495 b = create_operator (assign, 2); 496 b -> operand (1) = float_dec_target; 497 b -> operand (2) = tree -> operand (2); 498 tree -> operand (2) = b; 499 end; 500 501 if tree -> operand (2) -> node.type = operator_node then 502 b = tree -> operand (2) -> operand (1) -> reference.symbol; 503 else 504 b = tree -> operand (2) -> reference.symbol; 505 506 end; 507 else 508 call converter; 509 510 p = b -> symbol.c_dcl_size; 511 q = c -> symbol.c_dcl_size; 512 rprec = m; 513 rscale = n; 514 m = max (p, q); 515 n = 0; 516 517 if btype.decimal then do; 518 math_libe_no = 195; /* decimal_exp_ */ 519 520 if q > max_p_fix_bin_1 then do; 521 math_libe_no = math_libe_no + 1; /* decimal_exp2_ */ 522 m = max_p_dec; 523 end; 524 525 goto make_call; 526 end; 527 528 if ctype.fixed then 529 m = p; 530 else if m > max_p_flt_bin_1 then do; 531 if p <= max_p_flt_bin_1 then 532 tree -> operand (2) = convert$to_target ((old_rand (2)), (c -> symbol.reference)); 533 534 if q <= max_p_flt_bin_1 then 535 tree -> operand (3) = convert$to_target ((old_rand (3)), (b -> symbol.reference)); 536 end; 537 538 create_exp_call: 539 if ctype.fixed then 540 if q <= max_p_fix_bin_1 then 541 math_libe_no = 17; /* xp2_ */ 542 else 543 math_libe_no = 197; /* xp22_ */ 544 else 545 math_libe_no = 21; /* xp3_ */ 546 547 if btype.float then 548 if m > max_p_flt_bin_1 then 549 math_libe_no = math_libe_no + 1; 550 else 551 ; 552 else if m > max_p_fix_bin_1 then 553 math_libe_no = math_libe_no + 1; 554 555 if btype.complex then 556 math_libe_no = math_libe_no + 2; 557 558 if btype.fixed & btype.real then 559 if m > max_p_fix_bin_1 then 560 math_libe_no = 171; /* diexp_*/ 561 else 562 math_libe_no = 147; /* iexp_ */ 563 564 if math_libe_no = 17 | math_libe_no = 18 | math_libe_no = 21 | math_libe_no = 22 | math_libe_no = 147 565 | math_libe_no = 171 then do; 566 if c -> symbol.constant then 567 if constant_value (c) = 0 then do; 568 string (btype) = string (btype) & ^fixed_mask | float_mask; 569 m = min (b -> symbol.c_dcl_size, max_p_flt_bin_2); 570 tree = declare_constant ("000000010100"b || (60)"0"b, string (btype), m, 0); 571 /* representation of 1.0e0 */ 572 573 goto ret; 574 end; 575 576 tree -> operand (1) = declare_temporary (string (btype), m, n, null); 577 goto check_decimal; 578 end; 579 580 make_call: 581 qq = create_operator ((std_call), 3); 582 qq -> operand (1) = declare_temporary (string (btype), m, n, null); 583 qq -> operand (2) = reserve$declare_lib (math_libe_no); 584 qq -> operand (2) -> reference.symbol -> symbol.irreducible = FALSE; 585 qq -> operand (2) -> reference.symbol -> symbol.reducible = TRUE; 586 qq -> operand (3) = create_operator (std_arg_list, 3); 587 588 qq -> operand (3) -> operand (1) = declare_temporary (storage_block_type, 8, 0, null); 589 qq -> operand (3) -> operand (2), e = create_list (3); 590 591 e -> element (1) = tree -> operand (2); 592 e -> element (2) = tree -> operand (3); 593 594 tree = qq; 595 596 qq -> operand (1), e -> element (3) = copy_expression (qq -> operand (1)); 597 e -> element (3) -> reference.shared = FALSE; 598 e -> element (3) -> reference.ref_count = 2; 599 600 check_decimal: 601 if decimal_result then do; 602 if math_libe_no = 195 | math_libe_no = 196 /* decimal_exp_ | decimal_exp2_ */ then do; 603 m = rprec; 604 n = rscale; 605 btype = rtype; 606 end; 607 else if btype.fixed then do; 608 m = divide (bin (m, 15, 0) * 100 + 331, 332, 15, 0) + 1; 609 n = divide (abs (n) * 100 + 331, 332, 15, 0) * sign (n); 610 end; 611 else do; 612 m = divide (bin (m, 15, 0) * 100 + 331, 332, 15, 0); 613 n = 0; 614 end; 615 616 qq = create_operator (assign, 2); 617 qq -> operand (1) = declare_temporary (string (btype) & ^binary_mask | decimal_mask, m, n, null); 618 qq -> operand (2) = tree; 619 620 tree = qq; 621 end; 622 623 goto ret; 624 625 /* 626* * This code is executed for the string operators ^ | & || 627* */ 628 action (4): 629 if b -> node.type = label_node then 630 call semantic_translator$abort (78, null); 631 632 if k > 2 then 633 if c -> node.type = label_node then 634 call semantic_translator$abort (78, null); 635 636 if opcode = cat_string & ^(btype.bit & ctype.bit) then 637 result_type, string (btype), string (ctype) = char_type; 638 else 639 result_type, string (btype), string (ctype) = bit_type; 640 641 call converter; 642 643 do i = 2 to k; 644 if tree -> operand (i) -> node.type = operator_node then 645 ref = tree -> operand (i) -> operand (1); 646 else 647 ref = tree -> operand (i); 648 649 if ref -> reference.varying_ref then do; 650 c_length (i) = 0; 651 length (i) = create_length_fun ((tree -> operand (i))); 652 length (i) -> operand (1) = copy_expression (length (i) -> operand (1)); 653 length (i) -> operand (1) -> reference.shared = FALSE; 654 end; 655 else do; 656 c_length (i) = ref -> reference.c_length; 657 length (i) = ref -> reference.length; 658 end; 659 660 if length (i) = null then 661 prec (i) = max_length_precision; 662 else if length (i) -> node.type = operator_node then 663 prec (i) = length (i) -> operand (1) -> reference.symbol -> symbol.c_dcl_size; 664 else 665 prec (i) = length (i) -> reference.symbol -> symbol.c_dcl_size; 666 end; 667 668 if opcode = not_bits then do; 669 m = c_length (2); 670 size = share_expression (length (2)); 671 goto create_temp; 672 end; 673 674 if length (2) = null & length (3) ^= null then 675 length (2) = declare_constant$integer (c_length (2)); 676 677 if length (3) = null & length (2) ^= null then 678 length (3) = declare_constant$integer (c_length (3)); 679 680 if length (2) = null then 681 if opcode = cat_string then 682 m = c_length (2) + c_length (3); 683 else 684 m = max (c_length (2), c_length (3)); 685 else do; 686 make_operator = TRUE; 687 688 if opcode = cat_string then do; 689 s_opcode = add; 690 prec (1) = min (max_p_fix_bin_1, max (prec (2), prec (3)) + 1); 691 end; 692 else do; 693 if length (2) = length (3) | compare_expression (length (2), length (3)) then 694 make_operator = FALSE; 695 else do; 696 s_opcode = max_fun; 697 prec (1) = min (max_p_fix_bin_1, max (prec (2), prec (3))); 698 end; 699 end; 700 701 if make_operator then do; 702 size = create_operator (s_opcode, 3); 703 size -> operand (1) = declare_temporary (integer_type, prec (1), 0, null); 704 size -> operand (2) = share_expression (length (2)); 705 size -> operand (3) = share_expression (length (3)); 706 size -> operator.processed = TRUE; 707 end; 708 else 709 size = share_expression (length (2)); 710 end; 711 712 goto create_temp; 713 714 /* 715* * This code is executed for the assignment operator. 716* */ 717 action (5): 718 if a -> node.type = label_node then 719 call semantic_translator$abort (135, null); 720 721 /* check for assignments to file or entry constants, but allow assignments 722* * of addr to a file constant. These are produced by the declaration 723* * processor to initialize the file constant. 724* */ 725 726 if a -> symbol.constant then 727 if ^(a -> symbol.file & blk -> block.prologue_flag) | tree -> operand (2) -> node.type ^= operator_node 728 then 729 call semantic_translator$abort (135, null); 730 else if tree -> operand (2) -> op_code ^= addr_fun then 731 call semantic_translator$abort (135, null); 732 733 /* If the right side is a token, convert it to the type of the left side, 734* * unless the left side has no type 735* */ 736 737 if b -> node.type = token_node then 738 if string (atype) ^= "0"b then do; 739 if tree -> operand (1) -> reference.varying_ref | a -> symbol.dcl_size ^= null 740 | tree -> operand (1) -> reference.length ^= null then 741 tree -> operand (2) = convert (b, string (atype)); 742 else 743 tree -> operand (2) = convert$to_target (b, (tree -> operand (1))); 744 745 if tree -> operand (2) -> node.type = operator_node then 746 b = tree -> operand (2) -> operand (1) -> reference.symbol; 747 else 748 b = tree -> operand (2) -> reference.symbol; 749 750 string (btype) = string (b -> symbol.attributes); 751 end; 752 else do; 753 b, tree -> operand (2) = convert ((tree -> operand (2)), string (btype)); 754 if b -> node.type = operator_node then 755 b = b -> operand (1); 756 b = b -> reference.symbol; 757 end; 758 759 /* If the left side is a temporary with no data type, it is to acquire 760* * the data type of the right side. 761* */ 762 763 if a -> symbol.temporary & string (a -> symbol.data_type) = "0"b then do; 764 if b -> node.type = label_node then do; 765 string (atype), substr (string (a -> symbol.attributes), 1, 36) = label_mask; 766 767 call declare (a); 768 end; 769 else do; 770 string (atype), substr (string (a -> symbol.attributes), 1, 36) = 771 substr (string (b -> symbol.attributes), 1, 36); 772 a -> symbol.scale = b -> symbol.scale; 773 774 a -> symbol.initialed, a -> symbol.overlayed, a -> symbol.position = FALSE; 775 776 if b -> symbol.array = null then do; 777 a -> symbol.c_word_size = b -> symbol.c_word_size; 778 a -> symbol.c_bit_size = b -> symbol.c_bit_size; 779 a -> symbol.word_size = b -> symbol.word_size; 780 a -> symbol.bit_size = b -> symbol.bit_size; 781 end; 782 else do; 783 a -> symbol.c_word_size = b -> symbol.array -> array.c_element_size; 784 a -> symbol.c_bit_size = b -> symbol.array -> array.c_element_size_bits; 785 a -> symbol.word_size = b -> symbol.array -> array.element_size; 786 a -> symbol.bit_size = b -> symbol.array -> array.element_size_bits; 787 end; 788 789 if atype.char | atype.bit then do; 790 ref = tree -> operand (2); 791 if ref -> node.type = operator_node then 792 ref = ref -> operand (1); 793 a -> symbol.c_dcl_size = ref -> reference.c_length; 794 a -> symbol.dcl_size = ref -> reference.length; 795 a -> symbol.exp_extents = ref -> reference.length ^= null; 796 797 if ^ref -> reference.varying_ref then do; 798 a -> symbol.reference -> reference.c_length = ref -> reference.c_length; 799 a -> symbol.reference -> reference.length = share_expression ((ref -> reference.length)); 800 a -> symbol.varying = FALSE; 801 802 call get_size (a); 803 end; 804 else 805 a -> symbol.reference -> reference.length, a -> symbol.dcl_size = 806 create_length_fun ((tree -> operand (2))); 807 808 a -> symbol.exp_extents = a -> symbol.reference -> reference.length ^= null; 809 end; 810 else do; 811 a -> symbol.pix = b -> symbol.pix; 812 a -> symbol.c_dcl_size = b -> symbol.c_dcl_size; 813 a -> symbol.general = b -> symbol.general; 814 /* for offsets and picture */ 815 816 if tree -> operand (2) -> node.type = reference_node then 817 a -> symbol.reference -> reference.c_length = tree -> operand (2) -> reference.c_length; 818 else 819 a -> symbol.reference -> reference.c_length = 820 tree -> operand (2) -> operand (1) -> reference.c_length; 821 end; 822 end; 823 824 a -> symbol.dimensioned = FALSE; 825 string (a -> symbol.storage_class) = "0"b; 826 a -> symbol.temporary = TRUE; 827 end; 828 829 /* If this assignment is to a char(*) or bit(*) return parameter, 830* * then generate code to fill in the descriptor and then replace the 831* * assignment with the expression converted to conform to the type 832* * etc of the return parameter. 833* */ 834 835 if def_context.return & a -> symbol.star_extents & a -> symbol.dcl_size ^= null & (atype.bit | atype.char) 836 then do; 837 ref, tree = convert ((tree -> operand (2)), string (atype)); 838 839 if ref -> node.type = operator_node then 840 ref = ref -> operand (1); 841 842 if ref -> reference.varying_ref then 843 c = create_length_fun (tree); 844 845 else if ref -> reference.length = null then 846 c = declare_constant$integer ((ref -> reference.c_length)); 847 else 848 c = share_expression ((ref -> reference.length)); 849 850 e = copy_expression (input_tree -> operand (1) -> reference.symbol -> symbol.descriptor); 851 e -> reference.shared = FALSE; 852 e -> reference.ref_count = 1; 853 desc = 854 declare_constant$desc ( 855 string (e -> reference.symbol -> symbol.descriptor -> symbol.initial -> descriptor (0).bit_type)); 856 call make (3, make_desc, e, desc, c); 857 stmnt -> statement.processed = TRUE; 858 859 goto ret; 860 end; 861 862 /* If this assignment is a by_value argument, the left side is to 863* * be replaced by a temporary whose data type is derived from the argument 864* * descriptor. The extents are given by the descriptor unless the 865* * descriptor has star_extents, in the latter case the extents are 866* * derived from the right side. 867* */ 868 869 if def_context.arg_list & a -> symbol.param_desc then do; 870 n = a -> symbol.scale; 871 872 if atype.area then 873 size = a -> symbol.dcl_size; 874 875 result_type = string (atype); 876 877 if atype.fixed | atype.float | atype.area then 878 m = a -> symbol.c_dcl_size; 879 else if atype.bit | atype.char | atype.picture then 880 if a -> symbol.star_extents & a -> symbol.dcl_size ^= null then do; 881 expr, ref = tree -> operand (2); 882 883 if ref -> node.type = operator_node then 884 ref = ref -> operand (1); 885 886 if ref -> node.type ^= reference_node then 887 call semantic_translator$abort (78, null); 888 889 if ^(ref -> reference.symbol -> symbol.bit | ref -> reference.symbol -> symbol.char) then 890 expr, ref = convert ((tree -> operand (2)), string (atype)); 891 892 if ref -> node.type = operator_node then 893 ref = ref -> operand (1); 894 895 if ref -> reference.varying_ref then 896 size = create_length_fun (expr); 897 898 else if ref -> reference.length ^= null then 899 size = share_expression ((ref -> reference.length)); 900 else 901 m = ref -> reference.c_length; 902 end; 903 else 904 m = a -> symbol.c_dcl_size; 905 906 tree -> operand (1) = declare_temporary (result_type, m, n, size); 907 908 if a -> symbol.picture then do; 909 tree -> operand (1) -> reference.symbol -> symbol.general = a -> symbol.general; 910 tree -> operand (1) -> reference.symbol -> symbol.pix = a -> symbol.pix; 911 end; 912 913 a = tree -> operand (1) -> reference.symbol; 914 end; 915 916 /* transform x = 0 into assign_zero(x) */ 917 918 if b -> symbol.constant & btype.fixed & btype.binary & btype.real & b -> symbol.c_dcl_size <= max_p_fix_bin_1 919 then 920 if b -> symbol.initial -> integer = 0 & atype.fixed & atype.binary & atype.real 921 & a -> symbol.c_dcl_size <= max_p_fix_bin_1 & a -> symbol.scale = 0 & ^a -> symbol.packed 922 & ^a -> symbol.unaligned then do; 923 tree -> operator.op_code = assign_zero; 924 tree -> operator.number = 1; 925 goto force_store; 926 end; 927 928 929 /* If the size condition is enabled, assignments to arithmetic values must 930* * be done using a size_ck operator. If the stringsize condition is enabled, 931* * assignments to bit or character data must be done with the size_ck 932* * operator. No additional optimizations can be performed. 933* */ 934 935 if substr (stmnt -> statement.prefix, 6, 1) & (atype.fixed | atype.float) 936 | substr (stmnt -> statement.prefix, 9, 1) & (atype.bit | atype.char | atype.picture) then 937 tree -> operator.op_code = assign_size_ck; 938 939 /* If the left side is a varying_ref then fill in the length fields with 940* * the max length. 941* */ 942 943 if tree -> operand (1) -> reference.varying_ref then do; 944 if a -> symbol.reference = tree -> operand (1) then do; 945 tree -> operand (1), e = copy_expression (a -> symbol.reference); 946 e -> reference.shared = FALSE; 947 e -> reference.ref_count = 1; 948 end; 949 950 tree -> operand (1) -> reference.c_length = a -> symbol.c_dcl_size; 951 952 if a -> symbol.dcl_size ^= null then do; 953 e = copy_expression (a -> symbol.dcl_size); 954 if a -> symbol.refer_extents then 955 call refer_extent (e, (tree -> operand (1) -> reference.qualifier)); 956 e = expression_semantics ((a -> symbol.block_node), stmnt, (e), this_context); 957 tree -> operand (1) -> reference.length = convert$to_integer (e, integer_type); 958 end; 959 end; 960 961 if b -> node.type = symbol_node then 962 if a -> symbol.picture | b -> symbol.picture & ^a -> symbol.char then 963 tree -> operand (2) = convert$to_target ((tree -> operand (2)), (tree -> operand (1))); 964 965 /* If the right side is an operator whose output temporary has the 966* * same attributes as the left side then replace the temp with a 967* * reference to the left side. 968* */ 969 970 if tree -> operand (2) -> node.type = operator_node & tree -> op_code = assign & ^def_context.return then do; 971 e = tree -> operand (2); 972 973 if e -> op_code = add | e -> op_code = sub then do; 974 sym = e -> operand (1) -> reference.symbol; 975 976 if sym -> symbol.fixed & sym -> symbol.binary & sym -> symbol.real & sym -> symbol.scale = 0 977 & atype.fixed & atype.binary & atype.real & a -> symbol.scale = 0 978 & 979 bool (sym -> symbol.c_dcl_size <= max_p_fix_bin_1, a -> symbol.c_dcl_size <= max_p_fix_bin_1, 980 "1001"b) then 981 goto replace; 982 end; 983 984 /* If the operator is a call then 985* * the return temp is replaced with the left side reference. 986* */ 987 988 if compare_declaration ((tree -> operand (1)), (e -> operand (1)), e -> op_code ^= std_call) then do; 989 if e -> op_code = std_call then do; 990 if tree -> operand (1) -> reference.substr 991 & tree -> operand (1) -> reference.symbol -> symbol.aligned then 992 goto force_store; 993 994 e = e -> operand (3) -> operand (2); 995 996 rv = e -> list.element (e -> list.number) -> reference.symbol; 997 if rv -> symbol.return_value then 998 goto force_store; 999 if rv -> symbol.dimensioned then 1000 goto force_store; 1001 if rv -> symbol.structure then 1002 goto force_store; 1003 1004 if tree -> operand (1) -> reference.symbol -> symbol.temporary then 1005 if tree -> operand (1) -> reference.shared then do; 1006 tree -> operand (1) = copy_expression (tree -> operand (1)); 1007 tree -> operand (1) -> reference.shared = FALSE; 1008 tree -> operand (1) -> reference.ref_count = 1; 1009 end; 1010 1011 e -> list.element (e -> list.number) = share_expression ((tree -> operand (1))); 1012 tree -> operand (1) -> reference.symbol -> symbol.passed_as_arg = TRUE; 1013 end; 1014 replace: 1015 e = tree -> operand (2); 1016 if e -> operand (1) -> reference.length ^= null then 1017 call adjust_count ((e -> operand (1) -> reference.length)); 1018 e -> operand (1) = tree -> operand (1); 1019 tree = e; 1020 end; 1021 end; 1022 1023 /* If this is an assignment done because of by_value argument passing 1024* * insure that the output temporary has a ref_count of at least one. 1025* * This insures that the code generator will store the result into it. 1026* */ 1027 1028 force_store: 1029 if def_context.arg_list then 1030 if tree -> operand (1) -> reference.symbol -> symbol.temporary then 1031 if tree -> operand (1) -> reference.shared then do; 1032 e = create_reference ((tree -> operand (1))); 1033 e -> reference = tree -> operand (1) -> reference; 1034 e -> reference.shared = FALSE; 1035 e -> reference.ref_count = 1; 1036 tree -> operand (1) = e; 1037 end; 1038 1039 if tree -> op_code ^= assign & tree -> op_code ^= assign_size_ck then 1040 goto ret; 1041 1042 if a -> symbol.constant then 1043 goto ret; 1044 1045 /* Pointer <--> Offset two-way conversion */ 1046 1047 if a -> symbol.offset & b -> symbol.ptr | b -> symbol.offset & a -> symbol.ptr then do; 1048 if a -> symbol.offset then do; 1049 if b -> symbol.constant then do; 1050 1051 /* operand(2) is "null", turn it into "nullo" */ 1052 1053 n = -1; 1054 tree -> operand (2) = declare_constant (unspec (n), offset_mask, 0, 0); 1055 goto ret; 1056 end; 1057 1058 opcode = off_fun; 1059 c = copy_expression (a -> symbol.general); 1060 if c = null then 1061 call semantic_translator$abort (435, a); 1062 end; 1063 else do; 1064 opcode = ptr_fun; 1065 c = copy_expression (b -> symbol.general); 1066 if c = null then 1067 if ^b -> symbol.constant then do; 1068 if pl1_stat_$cur_statement -> statement.root -> op_code ^= allot_var then 1069 call semantic_translator$abort (435, b); 1070 else if pl1_stat_$cur_statement -> statement.root -> operand (1) -> reference.qualifier 1071 ^= tree then 1072 call semantic_translator$abort (435, b); 1073 end; 1074 else do; 1075 tree -> operand (2) = declare_constant (unspec (c), pointer_type, 0, 0); 1076 goto ret; 1077 end; 1078 end; 1079 1080 c = expression_semantics (blk, stmnt, c, "0"b); 1081 1082 e = create_operator ((opcode), 3); /* by value for efficiency */ 1083 e -> operand (1) = tree -> operand (1); 1084 e -> operand (2) = tree -> operand (2); 1085 e -> operand (3) = c; 1086 1087 tree = e; 1088 1089 goto ret; 1090 end; 1091 1092 /* If this is an assignment of an entry constant to an entry variable the 1093* * procedure identified by the entry constant cannot share its containing 1094* * block's stack frame. 1095* */ 1096 if b -> node.type = symbol_node then 1097 if btype.entry & b -> symbol.constant & b -> symbol.equivalence ^= null then do; 1098 b -> symbol.equivalence -> block.why_nonquick.assigned_to_entry_var = TRUE; 1099 b -> symbol.equivalence -> block.no_stack = FALSE; 1100 end; 1101 1102 /* check the validity of the conversion implied by this assignment. */ 1103 1104 if ^tree -> operator.processed then 1105 call convert$validate ((tree -> operand (2)), (tree -> operand (1))); 1106 1107 if a -> symbol.entry then 1108 if b -> symbol.constant then 1109 if b -> symbol.internal then 1110 do e = b -> symbol.block_node repeat e -> block.father while (e ^= null); 1111 e -> block.flush_at_call = TRUE; 1112 end; 1113 1114 /* Area assignment is converted into a call to area_$assign(addr(a1),addr(a2)) */ 1115 1116 if atype.area then do; 1117 e = create_list (2); 1118 1119 do i = 1 to 2; 1120 e -> element (i) = create_operator (addr_fun, 2); 1121 e -> element (i) -> operand (1) = declare_temporary (pointer_type, 0, 0, null); 1122 e -> element (i) -> operand (2) = tree -> operand (i); 1123 end; 1124 1125 tree, pl1_stat_$cur_statement -> statement.root = create_operator ((std_call), 3); 1126 tree -> operand (2) = reserve$declare_lib (161); 1127 /* area_assign_ */ 1128 tree -> operand (3) = create_operator (std_arg_list, 3); 1129 tree -> operand (3) -> operand (1) = declare_temporary (storage_block_type, 8, 0, null); 1130 tree -> operand (3) -> operand (2) = e; 1131 end; 1132 1133 goto ret; 1134 1135 /* 1136* * This code is executed for the relational operators. 1137* */ 1138 action (6): 1139 call convert_relationals; 1140 result_type = bit_type; 1141 m = 1; 1142 goto create_temp; 1143 1144 /* 1145* * This code is executed for the transfer operators. 1146* */ 1147 action (7): 1148 if a -> node.type = label_node then do; 1149 if a -> label.used_as_format then 1150 call semantic_translator$abort (196, null); 1151 a -> label.used_in_goto = TRUE; 1152 end; 1153 else if ^atype.label then 1154 call semantic_translator$abort (229, null); 1155 1156 if opcode ^= jump then do; 1157 if opcode > jump_false then do; 1158 call convert_relationals; 1159 end; 1160 1161 else if opcode = jump_true | opcode = jump_false then do; 1162 string (btype) = bit_type; 1163 call converter; 1164 1165 /* warn about ^ where is not bit(1) */ 1166 1167 if tree -> operand (2) -> node.type = operator_node then 1168 if tree -> operand (2) -> operator.op_code = not_bits then 1169 if ^constant_length ((tree -> operand (2) -> operand (1)), 1) then 1170 call semantic_translator$error (156, null); 1171 end; 1172 1173 target = tree -> operand (1); 1174 1175 /* following block of code added by R. Barnes to fix 1542 & 1546 11/05/76 */ 1176 1177 if target -> node.type ^= label_node then do; 1178 if target -> node.type = reference_node then 1179 if target -> reference.qualifier = null & target -> reference.offset = null then 1180 goto ret; 1181 1182 /* exprs in the label ref must not be evaluated unless jump taken */ 1183 1184 next = create_list (2); 1185 tree -> operand (1), next -> element (2) = create_label (blk, null, by_compiler); 1186 1187 tree -> operator.op_code = jump_complement (fixed (substr (opcode, 6, 4), 4)); 1188 1189 call make (1, jump, target, null, null); 1190 call make (0, null_statement, next, null, null); 1191 1192 pl1_stat_$cur_statement = stmnt; 1193 end; 1194 end; 1195 goto ret; 1196 1197 /* 1198* * This code :-) is executed for the length_fun 1199* */ 1200 action (8): 1201 goto ret; 1202 1203 /* 1204* * This code is executed for the std_call_operator. 1205* */ 1206 action (9): 1207 k = 2; 1208 call extract; 1209 if ^btype.entry then 1210 call semantic_translator$abort (223, null); 1211 tree = function (blk, stmnt, tree, b, context); 1212 goto ret; 1213 1214 /* 1215* * This code is executed for the std_entry_operator. 1216* */ 1217 action (10): 1218 orig_stmnt_ptr = stmnt; 1219 1220 if stmnt -> statement.statement_type = entry_statement then do; 1221 qq = create_statement (goto_statement, (stmnt -> statement.back), null, (stmnt -> statement.prefix)); 1222 qq -> statement.root = create_operator (jump, 1); 1223 1224 next = create_list (2); 1225 next -> list.element (2), qq -> statement.root -> operand (1) = create_label (blk, null, by_compiler); 1226 1227 qq = create_statement (null_statement, stmnt, next, (stmnt -> statement.prefix)); 1228 next -> list.element (2) -> label.statement = qq; 1229 qq -> statement.reference_count = 1; 1230 end; 1231 1232 /* create assignment statements to all automatic pointers used to 1233* * qualify parameters or return values which appear in more than one position. 1234* */ 1235 1236 do i = 1 to k; 1237 if tree -> operand (i) -> node.type ^= reference_node then 1238 goto ret; 1239 a = tree -> operand (i) -> reference.symbol; 1240 1241 if tree -> operand (i) -> reference.varying_ref then do; 1242 tree -> operand (i) -> reference.c_length = a -> symbol.c_dcl_size; 1243 if a -> symbol.dcl_size ^= null then do; 1244 tree -> operand (i) -> reference.length = copy_expression (a -> symbol.dcl_size); 1245 tree -> operand (i) -> reference.length = 1246 expression_semantics (blk, stmnt, (tree -> operand (i) -> reference.length), "0"b); 1247 end; 1248 end; 1249 1250 if a -> symbol.allocated then do; /* if parameters appear in different positions */ 1251 call make (3, param_ptr, (tree -> operand (i) -> reference.qualifier), declare_constant$integer (i), 1252 blk); 1253 if a -> symbol.star_extents then 1254 call make (3, param_desc_ptr, 1255 (tree -> operand (i) -> reference.symbol -> symbol.descriptor -> reference.qualifier), 1256 declare_constant$integer (i), blk); 1257 end; 1258 end; 1259 1260 /* If the block has multiple return types create an assignment to the 1261* * automatic integer to identify which type is required when returning 1262* * from an invocation of the this entry. Entries which do not return 1263* * values set the variable to zero. 1264* */ 1265 1266 if blk -> block.return_count ^= null then do; 1267 if orig_stmnt_ptr -> statement.labels -> list.element (2) -> reference.symbol -> symbol.dcl_size = null 1268 then 1269 a = null; /* from here on we want a to be the return value; if none, a = null */ 1270 1271 i = 0; 1272 b = blk -> block.return_values; 1273 1274 do while (b ^= null); 1275 if b -> list.element (2) = a then 1276 goto hit; 1277 b = b -> list.element (1); 1278 i = i + 1; 1279 end; 1280 hit: 1281 call make (2, assign, (blk -> block.return_count), declare_constant$integer (i), null); 1282 1283 /* The following call is because operator_semantics is the only person in 1284* * the compiler who makes an assign of zero into a store zero, for better code 1285* */ 1286 1287 if i = 0 then 1288 stmnt -> statement.root = operator_semantics (blk, stmnt, (stmnt -> statement.root), this_context); 1289 end; 1290 1291 /* create an execute prologue operator. */ 1292 1293 call make (0, ex_prologue, null, null, null); 1294 1295 pl1_stat_$cur_statement = stmnt; 1296 1297 goto ret; 1298 1299 /* 1300* * This code is executed for the return_value operator 1301* * and also the std_return operator. 1302* */ 1303 action (11): 1304 signal_stmnt_ptr = null; 1305 1306 if stmnt -> statement.statement_type = end_statement then do; 1307 if blk -> block.block_type = begin_block | blk -> block.block_type = on_unit then 1308 goto ret; 1309 end_statement_flag = TRUE; 1310 end; 1311 else 1312 end_statement_flag = FALSE; 1313 1314 /* The following test checks for the case of an unreachable end 1315* * statement. We do not want to produce any checks for return value 1316* * compatablility; indeed we want to do as little as possible because the 1317* * optimizer and code generator will make it produce NO code, anyway. 1318* */ 1319 1320 if pl1_stat_$stmnt_unreachable then 1321 if stmnt -> statement.labels = null then 1322 if end_statement_flag then 1323 goto ret; 1324 1325 if tree -> operator.op_code = return_value then 1326 e = tree -> operand (1); 1327 else 1328 e = null; 1329 1330 do bb = blk repeat bb -> block.father while (bb -> block.block_type = begin_block); 1331 end; 1332 1333 a = bb -> block.return_values; 1334 if a ^= null then /* will be null if block entry was multiply declared */ 1335 if bb -> block.return_count = null & a -> list.element (2) = null then 1336 if e = null then 1337 goto ret; 1338 else 1339 call semantic_translator$abort (53, null); 1340 1341 stmnt -> statement.statement_type = null_statement; 1342 stmnt -> statement.generated = TRUE; 1343 1344 tree = null; 1345 1346 i = 0; 1347 jump_stmnt, next = null; 1348 1349 if bb -> block.return_count ^= null then 1350 if e ^= null then 1351 call prepare (e); 1352 1353 first_time = TRUE; 1354 after_ret = stmnt -> statement.next; 1355 pl1_stat_$multi_type = bb -> block.return_count ^= null; 1356 if pl1_stat_$multi_type then do; 1357 hold_abort_label = pl1_stat_$abort_label; /* pl1_stat_$abort_label is used in other */ 1358 pl1_stat_$abort_label = continue; /* programs and must be saved & restored. */ 1359 end; 1360 1361 do a = a repeat a -> element (1) while (a ^= null); 1362 pl1_stat_$error_flag = FALSE; 1363 if pl1_stat_$multi_type then 1364 if a -> element (1) ^= null then do; 1365 next = create_list (2); 1366 next -> list.element (2) = create_label (blk, null, by_compiler); 1367 call make (3, jump_if_ne, (next -> list.element (2)), (bb -> block.return_count), 1368 declare_constant$integer (i)); 1369 last_jump = jump_stmnt; 1370 jump_stmnt = stmnt; 1371 end; 1372 else 1373 next = null; /* if no next element, there is no need for a */ 1374 /* compare because the indeces MUST be equal, since */ 1375 /* all the previous tests must have failed and */ 1376 /* there are no more possibilities. */ 1377 first = stmnt; 1378 last = stmnt -> statement.next; 1379 1380 /* 1381* * The following code handles the case of "return;", where there is no 1382* * return value. 1383* */ 1384 1385 if e = null then 1386 if a -> list.element (2) = null then do; 1387 call make (0, std_return, null, null, null); 1388 goto end_of_ret_assignment_loop; 1389 end; 1390 else do; 1391 if pl1_stat_$multi_type | end_statement_flag then 1392 goto make_signal_statement; 1393 else 1394 call semantic_translator$abort (356, null); 1395 end; 1396 1397 /* the following handles the case of "return(value);" where the 1398* * entry entered through expected NO return_value, but just a 1399* * simple "return;" 1400* */ 1401 1402 if a -> list.element (2) = null then 1403 goto make_signal_statement; 1404 1405 /* The rest of the loop handles the case of "return(value);" where 1406* * the entry did expect a return_value. 1407* */ 1408 1409 ref = a -> list.element (2); 1410 b = create_operator (assign, 2); 1411 b -> operand (1) = copy_expression (ref -> symbol.reference); 1412 b -> operand (1) = expression_semantics (blk, stmnt, (b -> operand (1)), this_context); 1413 1414 if first_time then 1415 b -> operand (2) = e; 1416 else 1417 b -> operand (2) = copy_ref (e); 1418 1419 first_time = FALSE; 1420 1421 def_this_context.return = TRUE; 1422 def_this_context.RHS_aggregate = ref -> symbol.structure | ref -> symbol.reference -> reference.array_ref; 1423 1424 if ref -> symbol.structure | ref -> symbol.dimensioned then do; 1425 stmnt = stmnt -> statement.next; 1426 b = expand_assign (blk, stmnt, b, this_context, null); 1427 stmnt = stmnt -> statement.back; 1428 1429 if ref -> symbol.star_extents then do; 1430 if b -> node.type = operator_node then do; 1431 es = b -> operand (1) -> reference.symbol; 1432 qq = b -> operand (1) -> reference.qualifier; 1433 end; 1434 else 1435 es = b -> reference.symbol; 1436 1437 if es -> symbol.packed then do; 1438 opcode = return_bits; 1439 if es -> symbol.bit_size = null then 1440 size = declare_constant$integer ((es -> symbol.c_bit_size)); 1441 else 1442 size = es -> symbol.bit_size; 1443 end; 1444 else do; 1445 opcode = return_words; 1446 if es -> symbol.word_size = null then 1447 size = declare_constant$integer ((es -> symbol.c_word_size)); 1448 else 1449 size = es -> symbol.word_size; DeWitte ~8process_overseer_ >user_dir_dir>Multics>DeWitte  ^SW٘T$none`Tf^9&+T> kXɦ @ @Samanani ~8process_overseer_ >user_dir_dir>Multics>Samanani  PTm none`T!7&@o(?T>Xɦ @ @Lyttle ~8process_overseer_ >user_dir_dir>Multics>Lyttle  VQLǐSTbnone`TDb V4 xWv>6 T> Xɦ @ @Goutier ~8process_overseer_ >user_dir_dir>Multics>Goutier  PTV'Lnone`TV(T>U!Xɦ @ @549 1550 signal_stmnt_ptr = qq -> list.element (2); 1551 label_attached = TRUE; 1552 end; 1553 1554 /* We would like to do some optimizations which are 1555* * only valid if we previously generated a jump_if_ne and if 1556* * we are the last entry point conversion being processed. 1557* */ 1558 1559 if jump_stmnt = null | a -> element (1) ^= null then do; 1560 stmnt = create_statement (goto_statement, first, null, (first -> statement.prefix)); 1561 stmnt -> statement.root = create_operator (jump, 1); 1562 stmnt -> statement.root -> operator.operand (1) = signal_stmnt_ptr; 1563 signal_stmnt_ptr -> label.statement -> statement.reference_count = 1564 signal_stmnt_ptr -> label.statement -> statement.reference_count + 1; 1565 end; 1566 else if jump_stmnt -> statement.root -> operand (1) -> label.statement = stmnt then do; 1567 if jump_stmnt -> statement.next -> statement.statement_type = goto_statement then 1568 if jump_stmnt -> statement.next -> statement.root -> operand (1) -> label.statement 1569 -> statement.statement_type = signal_statement then do; 1570 1571 /* This block of code is for the sole purpose of optimizing 1572* * the case where the end of the statement looks like: 1573* * jump to l1 if ^= 2 1574* * do conversion 1575* * l1: jump to l2 if ^= 1 1576* * goto 1577* * l2: goto 1578* * 1579* * and changing it to look like: 1580* * jump to if ^= 2 1581* * do conversion 1582* * 1583* * which is of course vastly preferable code. 1584* */ 1585 1586 last_jump -> statement.root -> operand (1) = signal_stmnt_ptr; 1587 if after_ret ^= null then 1588 after_ret -> statement.back = jump_stmnt -> statement.back; 1589 jump_stmnt -> statement.back -> statement.next = after_ret; 1590 1591 /* we needn't reset ptrs cause we can never reenter loop */ 1592 1593 stmnt = jump_stmnt -> statement.back; 1594 end; 1595 else 1596 goto normal_sig; 1597 else 1598 goto normal_sig; 1599 end; 1600 else do; 1601 normal_sig: 1602 jump_stmnt -> statement.root -> operator.operand (1) = signal_stmnt_ptr; 1603 signal_stmnt_ptr -> label.statement -> statement.reference_count = 1604 signal_stmnt_ptr -> label.statement -> statement.reference_count + 1; 1605 jump_stmnt, next = null; 1606 end; 1607 end; 1608 end; 1609 1610 end_of_ret_assignment_loop: 1611 i = i + 1; 1612 1613 if next ^= null then do; 1614 call make (0, null_statement, next, null, null); 1615 stmnt -> statement.save_temps = TRUE; 1616 end; 1617 end; 1618 1619 if pl1_stat_$multi_type then 1620 pl1_stat_$abort_label = hold_abort_label; 1621 1622 pl1_stat_$multi_type = FALSE; 1623 pl1_stat_$cur_statement = stmnt; 1624 1625 goto ret; 1626 1627 /* 1628* * This code is executed for operators whose operands must be binary integers 1629* * and whose output is a binary integer. 1630* */ 1631 action (12): 1632 do i = 2 to k; 1633 tree -> operand (i) = convert$to_integer ((tree -> operand (i)), integer_type); 1634 end; 1635 1636 result_type = integer_type; 1637 m = default_fix_bin_p; 1638 goto create_temp; 1639 1640 /* 1641* * This code is executed for operators whose operands must be integers 1642* * but whose output can be anything. 1643* */ 1644 action (13): 1645 do i = 2 to k; 1646 tree -> operand (i) = convert$to_integer ((tree -> operand (i)), integer_type); 1647 end; 1648 goto ret; 1649 1650 /* 1651* * This code is executed for operators whose operands can be anything 1652* * but whose result is a binary integer. 1653* */ 1654 action (14): 1655 result_type = integer_type; 1656 m = max_offset_precision; 1657 goto create_temp; 1658 1659 /* 1660* * This code is executed for operators whose operands can be anything 1661* * but whose result is a pointer. 1662* */ 1663 action (15): 1664 result_type = pointer_type; 1665 goto create_temp; 1666 1667 /* 1668* * This code is executed for I/O operators. 1669* */ 1670 action (16): 1671 call io_semantics (blk, stmnt, tree); 1672 1673 goto ret; 1674 1675 /* 1676* * This code is executed for DO operators. 1677* */ 1678 action (17): 1679 call do_semantics (blk, stmnt, tree); 1680 tree = null; 1681 1682 goto ret; 1683 1684 /* 1685* * This code is executed for allocate and free operators. 1686* */ 1687 action (18): 1688 call alloc_semantics (blk, stmnt, tree); 1689 goto ret; 1690 1691 /* 1692* * This code is executed for mod_bit, mod_byte, mod_half, and 1693* * for mod_word operators. 1694* */ 1695 action (19): 1696 do i = 1 to 2; 1697 tree -> operand (i) = declare_temporary (integer_type, default_fix_bin_p, 0, null); 1698 end; 1699 goto ret; 1700 1701 /* 1702* * This code is executed for the loop operator 1703* */ 1704 action (20): 1705 if tree -> operand (1) -> node.type = token_node then do; 1706 string (atype) = decoded_type (fixed (tree -> operand (1) -> token.type)); 1707 tree -> operand (1) = convert ((tree -> operand (1)), string (atype)); 1708 end; 1709 1710 do i = 3 to 4; 1711 tree -> operand (i) = convert$to_integer ((tree -> operand (i)), integer_type); 1712 end; 1713 1714 goto ret; 1715 1716 /* 1717* * This code is required for on-, revert-, and signal-statements 1718* */ 1719 action (21): 1720 if tree -> operand (1) -> node.type = label_node then 1721 call semantic_translator$abort (78, null); 1722 1723 if ^tree -> operand (1) -> reference.symbol -> symbol.condition then 1724 call semantic_translator$abort (268, (tree -> operand (1))); 1725 1726 if tree -> operand (2) ^= null then 1727 if tree -> operand (2) -> node.type = label_node then 1728 call semantic_translator$abort (78, null); 1729 else if ^tree -> operand (2) -> reference.symbol -> symbol.file then 1730 call semantic_translator$abort (477, (tree -> operand (2))); 1731 1732 if opcode = enable_on then 1733 do e = blk repeat e -> block.father while (e ^= null); 1734 e -> block.flush_at_call = TRUE; 1735 end; 1736 1737 if opcode = signal_on then do; 1738 qq = tree -> operand (1) -> reference.symbol -> symbol.general -> reference.symbol; 1739 cond_name = substr (qq -> symbol.initial -> based_char, 1, qq -> symbol.c_dcl_size); 1740 1741 do i = 1 to 19; 1742 if condition_name (i) = cond_name then do; 1743 if i > 10 then 1744 i = i - 10; 1745 if substr (stmnt -> statement.prefix, i, 1) = "0"b then do; 1746 tree = create_operator (nop, 0); 1747 stmnt -> statement.statement_type = null_statement; 1748 goto ret; 1749 end; 1750 end; 1751 end; 1752 end; 1753 1754 else do; 1755 blk -> block.why_nonquick.condition_statements = TRUE; 1756 blk -> block.no_stack = FALSE; 1757 end; 1758 1759 goto ret; 1760 1761 /* 1762* * This code is executed by almost everybody. 1763* */ 1764 create_temp: 1765 tree -> operand (1) = declare_temporary (result_type, m, n, size); 1766 goto ret; 1767 1768 /* 1769* * subroutine to make an operator and a statement. 1770* */ 1771 make: 1772 procedure (n, code, a, b, c); 1773 1774 dcl n fixed bin (15) parameter; 1775 dcl code bit (9) aligned parameter; 1776 dcl (a, b, c) ptr parameter; 1777 1778 dcl (labels, p, q) ptr; 1779 dcl stype bit (9) aligned; 1780 1781 p, labels = null; 1782 stype = assignment_statement; 1783 if code = jump_if_ne then 1784 stype = if_statement; 1785 else if code = jump then 1786 stype = goto_statement; 1787 else if code = return_string | code = return_bits | code = return_words | code = std_return then 1788 stype = return_statement; 1789 1790 if code = null_statement then do; 1791 stype = code; 1792 labels = a; 1793 end; 1794 else do; 1795 p = create_operator (code, n); 1796 if n > 0 then 1797 p -> operand (1) = a; 1798 if n > 1 then 1799 p -> operand (2) = b; 1800 if n > 2 then 1801 p -> operand (3) = c; 1802 end; 1803 1804 q = create_statement (stype, stmnt, labels, (stmnt -> statement.prefix)); 1805 1806 q -> statement.generated = TRUE; 1807 1808 if code = null_statement then 1809 if labels ^= null then do; 1810 labels -> list.element (2) -> label.statement = q; 1811 q -> statement.reference_count = 2; 1812 end; 1813 else if pl1_stat_$multi_type then 1814 q -> statement.suppress_warnings = TRUE; 1815 1816 q -> statement.root = p; 1817 stmnt = stmnt -> statement.next; 1818 1819 end make; 1820 1821 /* 1822* * subroutine to force the proper conversions of relational operators. 1823* */ 1824 convert_relationals: 1825 procedure (); 1826 1827 dcl i fixed bin (15); 1828 1829 if b -> node.type = label_node then 1830 if c -> node.type = label_node then 1831 return; 1832 else if ctype.label then 1833 return; 1834 else 1835 call semantic_translator$abort (229, null); 1836 if c -> node.type = label_node then 1837 if b -> node.type = label_node then 1838 return; 1839 else if btype.label then 1840 return; 1841 else 1842 call semantic_translator$abort (229, null); 1843 if btype.area | ctype.area then 1844 call semantic_translator$abort (51, null); 1845 if btype.ptr & ctype.offset then do; 1846 tree -> operand (3) = convert ((tree -> operand (3)), pointer_type); 1847 tree -> operand (3) -> operator.processed = FALSE; 1848 tree -> operand (3) = operator_semantics (blk, stmnt, (tree -> operand (3)), "0"b); 1849 tree -> operand (3) -> operator.processed = TRUE; 1850 return; 1851 end; 1852 if btype.offset & ctype.ptr then do; 1853 if c -> symbol.constant then do; 1854 1855 /* convert "null" to "nullo" */ 1856 1857 i = -1; 1858 tree -> operand (3) = declare_constant (unspec (i), offset_mask, 0, 0); 1859 end; 1860 else do; 1861 tree -> operand (2) = convert ((tree -> operand (2)), pointer_type); 1862 tree -> operand (2) -> operator.processed = FALSE; 1863 tree -> operand (2) = operator_semantics (blk, stmnt, (tree -> operand (2)), "0"b); 1864 tree -> operand (2) -> operator.processed = TRUE; 1865 end; 1866 return; 1867 end; 1868 1869 picture_redo: 1870 if btype.bit & ctype.bit then 1871 goto conv; 1872 if btype.char & ctype.char then 1873 goto conv; 1874 if btype.bit & ctype.char then do; 1875 string (btype) = string (btype) & ^bit_mask | char_mask; 1876 goto conv; 1877 end; 1878 if btype.char & ctype.bit then do; 1879 string (ctype) = string (ctype) & ^bit_mask | char_mask; 1880 goto conv; 1881 end; 1882 if (btype.bit | btype.char) & (ctype.fixed | ctype.float) then do; 1883 string (btype) = string (ctype); 1884 goto conv; 1885 end; 1886 if (ctype.bit | ctype.char) & (btype.fixed | btype.float) then do; 1887 string (ctype) = string (btype); 1888 goto conv; 1889 end; 1890 1891 if btype.picture then do; 1892 if b -> symbol.pic_char then 1893 string (btype) = char_mask; 1894 else if b -> symbol.complex then 1895 if b -> symbol.pic_float then 1896 string (btype) = float_decimal_complex_mask; 1897 else 1898 string (btype) = fixed_decimal_complex_mask; 1899 else if b -> symbol.pic_float then 1900 string (btype) = float_decimal_real_mask; 1901 else 1902 string (btype) = fixed_decimal_real_mask; 1903 1904 goto picture_redo; 1905 end; 1906 1907 if ctype.picture then do; 1908 if c -> symbol.pic_char then 1909 string (ctype) = char_mask; 1910 else if c -> symbol.complex then 1911 if c -> symbol.pic_float then 1912 string (ctype) = float_decimal_complex_mask; 1913 else 1914 string (ctype) = fixed_decimal_complex_mask; 1915 else if c -> symbol.pic_float then 1916 string (ctype) = float_decimal_real_mask; 1917 else 1918 string (ctype) = fixed_decimal_real_mask; 1919 1920 goto picture_redo; 1921 end; 1922 1923 if btype.binary & ctype.decimal then 1924 string (ctype) = string (ctype) & ^decimal_mask | binary_mask | aligned_mask; 1925 if btype.decimal & ctype.binary then 1926 string (btype) = string (btype) & ^decimal_mask | binary_mask | aligned_mask; 1927 if btype.binary then do; 1928 if btype.fixed & ctype.float then 1929 string (btype) = string (btype) & ^fixed_mask | float_mask | aligned_mask; 1930 if btype.float & ctype.fixed then 1931 string (ctype) = string (ctype) & ^fixed_mask | float_mask | aligned_mask; 1932 end; 1933 if btype.complex then 1934 string (ctype) = string (ctype) & ^real_mask | complex_mask; 1935 if ctype.complex & ^btype.complex then 1936 string (btype) = string (btype) & ^real_mask | complex_mask; 1937 1938 if index (string (btype), "1"b) ^= index (string (ctype), "1"b) & ^(btype.decimal & ctype.decimal) then 1939 call semantic_translator$abort (186, null); 1940 1941 conv: 1942 if index (string (btype), "1"b) > 5 | btype.complex then 1943 if opcode ^= equal & opcode ^= not_equal & opcode ^= jump_if_eq & opcode ^= jump_if_ne then 1944 call semantic_translator$abort (198, null); 1945 1946 call converter; 1947 1948 end convert_relationals; 1949 1950 /* 1951* * subroutine to force a conversion. 1952* * and set the strings "btype" and "ctype" accordingly 1953* */ 1954 converter: 1955 procedure (); 1956 1957 dcl r ptr; 1958 1959 if k > 1 then do; 1960 if tree -> operand (2) -> node.type = token_node then 1961 tree -> operand (2) = convert ((tree -> operand (2)), string (btype)); 1962 else if btype.decimal & b -> symbol.decimal then 1963 ; 1964 else if btype.binary & b -> symbol.binary & btype.real = b -> symbol.real & btype.fixed = b -> symbol.fixed 1965 then 1966 ; 1967 else do; 1968 if (string (btype) & arithmetic_mask) ^= "0"b then 1969 string (btype) = string (btype) & ^unaligned_mask | aligned_mask; 1970 tree -> operand (2) = convert ((tree -> operand (2)), string (btype)); 1971 end; 1972 1973 r = tree -> operand (2); 1974 if r -> node.type = operator_node then 1975 r = r -> operand (1); 1976 1977 b = r -> reference.symbol; 1978 end; 1979 1980 if k > 2 then do; 1981 if tree -> operand (3) -> node.type = token_node then 1982 tree -> operand (3) = convert ((tree -> operand (3)), string (ctype)); 1983 else if ctype.decimal & c -> symbol.decimal then 1984 ; 1985 else if ctype.binary & c -> symbol.binary & ctype.real = c -> symbol.real & ctype.fixed = c -> symbol.fixed 1986 then 1987 ; 1988 else do; 1989 if (string (ctype) & arithmetic_mask) ^= "0"b then 1990 string (ctype) = string (ctype) & ^unaligned_mask | aligned_mask; 1991 tree -> operand (3) = convert ((tree -> operand (3)), string (ctype)); 1992 end; 1993 1994 r = tree -> operand (3); 1995 if r -> node.type = operator_node then 1996 r = r -> operand (1); 1997 1998 c = r -> reference.symbol; 1999 end; 2000 2001 end converter; 2002 2003 /* 2004* * subroutine to extract pointers to the first 1 2 or 3 operand's symbol nodes 2005* */ 2006 extract: 2007 procedure (); 2008 2009 if k > 0 then do; 2010 a = tree -> operand (1); 2011 2012 if a ^= null then do; 2013 if a -> node.type = operator_node then 2014 a = a -> operand (1); 2015 2016 if a -> node.type = token_node then 2017 string (atype) = decoded_type (fixed (a -> token.type)); 2018 2019 if a -> node.type = label_node then 2020 string (atype) = "0"b; 2021 2022 if a -> node.type = reference_node then do; 2023 a = a -> reference.symbol; 2024 if a -> node.type = symbol_node then 2025 string (atype) = string (a -> symbol.attributes) & ^dimensioned_mask; 2026 else 2027 string (atype) = "0"b; 2028 end; 2029 2030 if a -> node.type = symbol_node then 2031 if atype.arg_descriptor & opcode ^= assign & opcode ^= make_desc then do; 2032 qq = create_operator (assign, 2); 2033 qq -> operand (1) = declare_temporary (integer_type, default_fix_bin_p, 0, null); 2034 qq -> operand (2) = tree -> operand (1); 2035 qq -> operator.processed = TRUE; 2036 2037 a = qq -> operand (1) -> reference.symbol; 2038 string (atype) = integer_type; 2039 tree -> operand (1) = qq; 2040 end; 2041 end; 2042 end; 2043 2044 if k > 1 then do; 2045 b = tree -> operand (2); 2046 2047 if b ^= null then do; 2048 if b -> node.type = operator_node then 2049 b = b -> operand (1); 2050 2051 if b -> node.type = token_node then 2052 if b -> token.type = dec_integer & k > 2 then 2053 string (btype) = dec_integer_type; 2054 else 2055 string (btype) = decoded_type (fixed (b -> token.type)); 2056 2057 if b -> node.type = label_node then 2058 string (btype) = "0"b; 2059 2060 if b -> node.type = reference_node then do; 2061 b = b -> reference.symbol; 2062 string (btype) = string (b -> symbol.attributes) & ^dimensioned_mask; 2063 end; 2064 2065 if b -> node.type = symbol_node then 2066 if btype.arg_descriptor & opcode ^= assign & opcode ^= make_desc then do; 2067 qq = create_operator (assign, 2); 2068 qq -> operand (1) = declare_temporary (integer_type, default_fix_bin_p, 0, null); 2069 qq -> operand (2) = tree -> operand (2); 2070 qq -> operator.processed = TRUE; 2071 2072 b = qq -> operand (1) -> reference.symbol; 2073 string (btype) = integer_type; 2074 tree -> operand (2) = qq; 2075 end; 2076 end; 2077 end; 2078 2079 if k > 2 then do; 2080 c = tree -> operand (3); 2081 2082 if c ^= null then do; 2083 if c -> node.type = operator_node then 2084 c = c -> operand (1); 2085 2086 if c -> node.type = token_node then 2087 if c -> token.type = dec_integer then 2088 string (ctype) = dec_integer_type; 2089 else 2090 string (ctype) = decoded_type (fixed (c -> token.type)); 2091 2092 if c -> node.type = label_node then 2093 string (ctype) = "0"b; 2094 2095 if c -> node.type = reference_node then do; 2096 c = c -> reference.symbol; 2097 string (ctype) = string (c -> symbol.attributes) & ^dimensioned_mask; 2098 end; 2099 2100 if c -> node.type = symbol_node then 2101 if ctype.arg_descriptor & opcode ^= assign & opcode ^= make_desc then do; 2102 qq = create_operator (assign, 2); 2103 qq -> operand (1) = declare_temporary (integer_type, default_fix_bin_p, 0, null); 2104 qq -> operand (2) = tree -> operand (3); 2105 qq -> operator.processed = TRUE; 2106 2107 c = qq -> operand (1) -> reference.symbol; 2108 string (ctype) = integer_type; 2109 tree -> operand (3) = qq; 2110 end; 2111 end; 2112 end; 2113 2114 end extract; 2115 2116 /* 2117* * This procedure creates a separate assignment statement for an operator, 2118* * if it finds one, in the expression to be returned, because that is 2119* * the only way to force the order of evaluation so that the expression 2120* * will be eval'ed before the tests which determine which assignment, 2121* * in the case of multiple return statements and entry points are made. 2122* */ 2123 prepare: 2124 procedure (pt); 2125 2126 dcl pt ptr parameter; 2127 dcl p ptr; 2128 2129 p = pt; 2130 2131 if p -> node.type = operator_node then do; 2132 if p -> op_code = param_ptr | p -> op_code = param_desc_ptr then 2133 return; 2134 2135 stmnt = create_statement (assignment_statement, stmnt, null, (stmnt -> statement.prefix)); 2136 stmnt -> statement.root = share_expression (p); 2137 end; 2138 else do; 2139 if p -> node.type ^= reference_node then 2140 return; 2141 2142 if p -> reference.qualifier ^= null then 2143 call prepare ((p -> reference.qualifier)); 2144 2145 if p -> reference.offset ^= null then 2146 call prepare ((p -> reference.offset)); 2147 2148 if p -> reference.length ^= null then 2149 call prepare ((p -> reference.length)); 2150 end; 2151 2152 end prepare; 2153 2154 copy_ref: 2155 procedure (pt) returns (ptr); 2156 2157 dcl pt ptr parameter; 2158 dcl (p, q) ptr; 2159 2160 2161 /* If the input is an unshared reference, get a unique value, 2162* * otherwise, use share_expression 2163* */ 2164 2165 p = pt; 2166 2167 if p -> node.type = reference_node then do; 2168 if p -> reference.shared then 2169 return (p); 2170 2171 q = create_reference (null); 2172 q -> reference = p -> reference; 2173 q -> reference.ref_count = 1; 2174 2175 if q -> reference.qualifier ^= null then 2176 q -> reference.qualifier = share_expression ((q -> reference.qualifier)); 2177 if q -> reference.offset ^= null then 2178 q -> reference.offset = share_expression ((q -> reference.offset)); 2179 if q -> reference.length ^= null then 2180 q -> reference.length = share_expression ((q -> reference.length)); 2181 2182 return (q); 2183 end; 2184 2185 else 2186 return (share_expression (p)); 2187 2188 end copy_ref; 2189 2190 /* 2191* * subroutine to create a length_fun operator and return a ptr to it 2192* */ 2193 create_length_fun: 2194 procedure (op2) returns (ptr); 2195 2196 dcl op2 pointer parameter; 2197 dcl p pointer; 2198 2199 p = create_operator (length_fun, 2); 2200 p -> operand (1) = declare_temporary (integer_type, max_length_precision, 0, null); 2201 p -> operand (2) = share_expression (op2); 2202 return (p); 2203 end create_length_fun; 2204 2205 2206 ret: 2207 if tree ^= null then 2208 if tree -> node.type = operator_node then 2209 tree -> operator.processed = TRUE; 2210 2211 return (tree); 2212 2213 /* 2214* * get the initial value of a fixed binary variable with a scale 2215* * factor of zero 2216* */ 2217 constant_value: 2218 procedure (sym_ptr) returns (fixed bin (71)); 2219 2220 dcl sym_ptr ptr parameter; 2221 2222 dcl integer_1 based fixed bin (35); 2223 dcl integer_2 based fixed bin (71); 2224 dcl initial_value fixed bin (71); 2225 2226 if sym_ptr -> symbol.c_dcl_size > max_p_fix_bin_1 then 2227 initial_value = sym_ptr -> symbol.initial -> integer_2; 2228 else 2229 initial_value = sym_ptr -> symbol.initial -> integer_1; 2230 2231 return (initial_value); 2232 2233 end constant_value; 2234 1 1 /* BEGIN INCLUDE FILE ... condition_name.incl.pl1 */ 1 2 /* The long names and short names of the conditions are stored in the same 1 3* array. The indices of the long name and the short name differ by 10. The 1 4* size condition has the same long name and short name. */ 1 5 /* format: style3,^delnl */ 1 6 1 7 declare condition_name (19) char (16) internal static options (constant) initial 1 8 ("underflow", "overflow", "zerodivide", "fixedoverflow", "conversion", 1 9 "size", "subscriptrange", "stringrange", "stringsize", "size", 1 10 "ufl", "ofl", "zdiv", "fofl", "conv", 1 11 "size", "subrg", "strg", "strz"); 1 12 1 13 /* END INCLUDE FILE ... condition_name.incl.pl1 */ 2235 2236 2 1 /* BEGIN INCLUDE FILE ... semant.incl.pl1 */ 2 2 2 3 /* Modified: 30 Aug 1979 by PCK to fix 1804 and 1823 */ 2 4 /* Modified: 26 Aug 1979 by PCK to implement by name assignment */ 2 5 2 6 2 7 declare alloc_semantics entry(pointer,pointer,pointer); 2 8 /* parameter 1: (input) block node pointer */ 2 9 /* parameter 2: (input) statement node pointer */ 2 10 /* parameter 3: (in/out) tree pointer */ 2 11 2 12 declare alloc_semantics$init_only entry(pointer,pointer,pointer); 2 13 /* parameter 1: (input) qualifier pointer */ 2 14 /* parameter 2: (input) statement node pointer */ 2 15 /* parameter 3: (input) symbol node pointer */ 2 16 2 17 declare builtin entry(pointer,pointer,pointer,pointer,pointer,bit(36) aligned) 2 18 returns(pointer); 2 19 /* parameter 1: (input) block node pointer */ 2 20 /* parameter 2: (input) statement node pointer */ 2 21 /* parameter 3: (input) tree pointer */ 2 22 /* parameter 4: (input) subscript pointer */ 2 23 /* parameter 5: (input) builtin symbol node pointer */ 2 24 /* parameter 6: (in/out) context */ 2 25 /* return: (output) tree pointer */ 2 26 2 27 declare check_star_extents entry(pointer,pointer); 2 28 /* parameter 1: (input) symbol node of procedure */ 2 29 /* parameter 2: (input) argument list pointer */ 2 30 2 31 declare compare_declaration entry(pointer,pointer,bit(1) aligned) reducible 2 32 returns(bit(1) aligned); 2 33 /* parameter 1: (input) reference or symbol node ptr */ 2 34 /* parameter 2: (input) symbol node ptr */ 2 35 /* parameter 3: (input) "1"b if aligned attribute ignored for string */ 2 36 /* return: (output) compare bit */ 2 37 2 38 declare context_processor entry(pointer,label); 2 39 /* parameter 1: (input) root block node pointer */ 2 40 2 41 declare declare entry(pointer); 2 42 /* parameter 1: (input) symbol node pointer */ 2 43 2 44 declare declare_structure entry(pointer); 2 45 /* parameter 1: (input) symbol node pointer */ 2 46 2 47 declare defined_reference entry(pointer,pointer,pointer,pointer,pointer,bit(36) aligned) 2 48 returns(pointer); 2 49 /* parameter 1: (input) block node pointer */ 2 50 /* parameter 2: (input) statement node pointer */ 2 51 /* parameter 3: (input) tree pointer */ 2 52 /* parameter 4: (input) subscript list pointer or null*/ 2 53 /* parameter 5: (input) symbol node pointer */ 2 54 /* parameter 6: (in/out) context */ 2 55 /* return: (output) tree pointer */ 2 56 2 57 declare do_semantics entry(pointer,pointer,pointer); 2 58 /* parameter 1: (input) block node pointer */ 2 59 /* parameter 2: (input) statement node pointer */ 2 60 /* parameter 3: (input) tree pointer */ 2 61 2 62 declare expand_assign entry(pointer,pointer,pointer,bit(36) aligned,pointer) 2 63 returns(pointer); 2 64 /* parameter 1: (input) block node pointer */ 2 65 /* parameter 2: (input) statement node pointer */ 2 66 /* parameter 3: (input) tree pointer */ 2 67 /* parameter 4: (in/out) context */ 2 68 /* parameter 5: (input) aggregate reference node ptr */ 2 69 /* return: (output) tree pointer */ 2 70 2 71 declare expand_by_name entry(pointer,pointer,pointer); 2 72 /* parameter 1: (input) block node pointer */ 2 73 /* parameter 2: (input) statement node pointer */ 2 74 /* parameter 3: (input/output) tree pointer */ 2 75 2 76 declare expand_infix entry(pointer,pointer,pointer,bit(36) aligned) 2 77 returns(pointer); 2 78 /* parameter 1: (input) block node pointer */ 2 79 /* parameter 2: (input) statement node pointer */ 2 80 /* parameter 3: (input) tree pointer */ 2 81 /* parameter 4: (in/out) context */ 2 82 /* return: (output) tree pointer */ 2 83 2 84 declare expand_initial entry(pointer,pointer,pointer); 2 85 /* parameter 1: (input) symbol node pointer */ 2 86 /* parameter 2: (input) statement node pointer */ 2 87 /* parameter 3: (input) locator */ 2 88 2 89 declare expand_prefix entry(pointer,pointer,pointer,bit(36) aligned) 2 90 returns(pointer); 2 91 /* parameter 1: (input) block node pointer */ 2 92 /* parameter 2: (input) statement node pointer */ 2 93 /* parameter 3: (input) tree pointer */ 2 94 /* parameter 4: (in/out) context */ 2 95 /* return: (output) tree pointer */ 2 96 2 97 declare expand_primitive entry(pointer,pointer,pointer,bit(36) aligned) 2 98 returns(pointer); 2 99 /* parameter 1: (input) block node pointer */ 2 100 /* parameter 2: (input) statement node pointer */ 2 101 /* parameter 3: (input) tree pointer */ 2 102 /* parameter 4: (input) context */ 2 103 /* return: (output) tree pointer */ 2 104 2 105 declare expression_semantics entry(pointer,pointer,pointer,bit(36) aligned) 2 106 returns(pointer); 2 107 /* parameter 1: (input) block node pointer */ 2 108 /* parameter 2: (input) statement node pointer */ 2 109 /* parameter 3: (input) tree pointer */ 2 110 /* parameter 4: (in/out) context */ 2 111 /* return: (output) tree pointer */ 2 112 2 113 declare fill_refer entry(pointer,pointer,bit(1) aligned) 2 114 returns(pointer); 2 115 /* parameter 1: (input) null,ref node,op node ptr */ 2 116 /* parameter 2: (input) null,ref node,op node ptr */ 2 117 /* parameter 3: (input) copy switch for param 2 */ 2 118 /* return: (output) ptr to processed tree */ 2 119 2 120 declare io_data_list_semantics$format_list_semantics entry(pointer,pointer,pointer); 2 121 /* parameter 1: (input) block node pointer */ 2 122 /* parameter 2: (input) statement node pointer */ 2 123 /* parameter 3: (in/out) tree pointer */ 2 124 2 125 declare function entry(pointer,pointer,pointer,pointer,bit(36) aligned) 2 126 returns(pointer); 2 127 /* parameter 1: (input) block node pointer */ 2 128 /* parameter 2: (input) statement node pointer */ 2 129 /* parameter 3: (input) tree pointer */ 2 130 /* parameter 4: (input) symbol node pointer */ 2 131 /* parameter 5: (in/out) context */ 2 132 /* return: (output) tree pointer */ 2 133 2 134 declare generic_selector entry(pointer,pointer,pointer,pointer,bit(36) aligned) 2 135 returns(pointer); 2 136 /* parameter 1: (input) block node pointer */ 2 137 /* parameter 2: (input) statement node pointer */ 2 138 /* parameter 3: (input) tree pointer */ 2 139 /* parameter 4: (input) pointer to argument list */ 2 140 /* parameter 5: (in/out) context */ 2 141 /* return: (output) tree pointer */ 2 142 2 143 declare io_data_list_semantics entry(pointer,pointer,pointer); 2 144 /* parameter 1: (input) block node pointer */ 2 145 /* parameter 2: (input) statement node pointer */ 2 146 /* parameter 3: (input) operator node pointer */ 2 147 2 148 declare io_semantics entry(pointer,pointer,pointer); 2 149 /* parameter 1: (input) block node pointer */ 2 150 /* parameter 2: (input) statement node pointer */ 2 151 /* parameter 3: (input) tree pointer */ 2 152 2 153 declare lookup entry(pointer,pointer,pointer,pointer,bit(36) aligned) 2 154 returns(bit(1) aligned); 2 155 /* parameter 1: (input) block node pointer */ 2 156 /* parameter 2: (input) stmnt|symbol node pointer */ 2 157 /* parameter 3: (input) token or reference node ptr */ 2 158 /* parameter 4: (output) symbol node pointer */ 2 159 /* parameter 5: (in/out) context */ 2 160 /* return: (output) symbol found bit */ 2 161 2 162 declare make_non_quick entry(pointer, bit (36) aligned); 2 163 /* parameter 1: (input) tree pointer */ 2 164 /* parameter 2: (input) reason why being made nonquick */ 2 165 2 166 declare match_arguments entry(pointer,pointer) reducible 2 167 returns(bit(1) aligned); 2 168 /* parameter 1: (input) reference or symbol node ptr */ 2 169 /* parameter 2: (input) reference or symbol node ptr */ 2 170 /* return: (output) compare bit */ 2 171 2 172 declare offset_adder entry(pointer,fixed binary(31),fixed binary(3),bit(1) aligned, 2 173 pointer,fixed binary(31),fixed binary(3),bit(1) aligned,bit(1)); 2 174 /* parameter 1: (in/out) tree pointer */ 2 175 /* parameter 2: (in/out) constant size */ 2 176 /* parameter 3: (in/out) units */ 2 177 /* parameter 4: (in/out) ON if units ^= word_, but tree in words */ 2 178 /* parameter 5: (input) tree pointer */ 2 179 /* parameter 6: (input) constant size */ 2 180 /* parameter 7: (input) units */ 2 181 /* parameter 8: (input) ON if units ^= word_, but tree in words */ 2 182 /* parameter 9: (input) ON if should not improve units */ 2 183 2 184 declare operator_semantics entry(pointer,pointer,pointer,bit(36) aligned) 2 185 returns(pointer); 2 186 /* parameter 1: (input) block node pointer */ 2 187 /* parameter 2: (input) statement node pointer */ 2 188 /* parameter 3: (input) tree pointer */ 2 189 /* parameter 4: (in/out) context */ 2 190 /* return: (output) tree pointer */ 2 191 2 192 declare propagate_bit entry(pointer,fixed binary(15))Maryniuk ~8process_overseer_ >user_dir_dir>Multics>Maryniuk  PTɀQnone`Tʐ6n;whT>Xɦ @ @Farley ~8process_overseer_ >user_dir_dir>Multics>Farley  PSnone`SOEOT> hDXɦ @ @Schroth ~xprocess_overseer_ >user_dir_dir>Multics>Schroth  PS>none`S?T>ӜXɦSysProg @ @Roe ~8process_overseer_ >user_dir_dir>Multics>Roe  QSǖCnone`SӍ"T>Xɦ @ @$Itani ~8process_overseer_ >user_dir_dir>Multics>Itani  7PTnone`Ty7= 9a}|QXjT>Xɦ @ @McGirr ~8process_overseer_ >user_dir_dir>Multics>McGirr  w8QE&_5TŒnoneTƼw8dQzo-яX]I<XT>giXɦ @ @Palmer ~8process_overseer_ >user_dir_dir>Multics>Palmer  6HQyTnone`T6H`A BT>T6Xɦ @ @Kramer ~8process_overseer_ >user_dir_dir>Multics>Kramer  0BRmT%/noneT*w](0BFavTT>WXɦ @ @pointer,pointer,bit(3) aligned) 3 141 returns(pointer); 3 142 /* parameter 1: (input) block node pointer */ 3 143 /* parameter 2: (input) token node pointer */ 3 144 /* parameter 3: (input) declare type */ 3 145 /* return: (output) label node pointer */ 3 146 3 147 declare create_list entry(fixed bin(15)) 3 148 returns(pointer); 3 149 /* parameter 1: (input) number of list elements */ 3 150 /* return: (output) list node pointer */ 3 151 3 152 declare create_operator entry(bit(9) aligned,fixed bin(15)) 3 153 returns(pointer); 3 154 /* parameter 1: (input) operator type */ 3 155 /* parameter 2: (input) number of operands */ 3 156 /* return: (output) operator node pointer */ 3 157 3 158 declare create_reference entry(pointer) 3 159 returns(pointer); 3 160 /* parameter 1: (input) symbol node pointer */ 3 161 /* return: (output) reference node pointer */ 3 162 3 163 declare create_statement entry(bit(9) aligned,pointer,pointer,bit(12) aligned) 3 164 returns(pointer); 3 165 /* parameter 1: (input) statement type */ 3 166 /* parameter 2: (input) block node pointer */ 3 167 /* parameter 3: (input) label node pointer */ 3 168 /* parameter 4: (input) conditions */ 3 169 /* return: (output) statement node pointer */ 3 170 3 171 declare create_statement$prologue entry(bit(9) aligned,pointer,pointer,bit(12) aligned) 3 172 returns(pointer); 3 173 /* parameter 1: (input) statement type */ 3 174 /* parameter 2: (input) block node pointer */ 3 175 /* parameter 3: (input) label node pointer */ 3 176 /* parameter 4: (input) conditions */ 3 177 /* return: (output) statement node pointer */ 3 178 3 179 declare create_storage entry(fixed bin(15)) 3 180 returns(pointer); 3 181 /* parameter 1: (input) number of words */ 3 182 /* return: (output) storage block pointer */ 3 183 3 184 declare create_symbol entry(pointer,pointer,bit(3) aligned) 3 185 returns(pointer); 3 186 /* parameter 1: (input) block node pointer */ 3 187 /* parameter 2: (input) token node pointer */ 3 188 /* parameter 3: (input) declare type */ 3 189 /* return: (output) symbol node pointer */ 3 190 3 191 declare create_token entry (character (*), bit (9) aligned) 3 192 returns (ptr); 3 193 /* parameter 1: (input) token string */ 3 194 /* parameter 2: (input) token type */ 3 195 /* return: (output) token node ptr */ 3 196 3 197 declare create_token$init_hash_table entry (); 3 198 3 199 declare create_token$protected entry (char (*), bit (9) aligned, bit (18) aligned) 3 200 returns (ptr); 3 201 /* parameter 1: (input) token string */ 3 202 /* parameter 2: (input) token type */ 3 203 /* parameter 3: (input) protected flag */ 3 204 /* return: (output) token node ptr */ 3 205 3 206 declare decbin entry(character(*) aligned) reducible 3 207 returns(fixed bin(31)); 3 208 /* parameter 1: (input) decimal character string */ 3 209 /* return: (output) binary value */ 3 210 3 211 declare declare_constant entry(bit(*) aligned,bit(36) aligned,fixed bin(31),fixed bin(15)) 3 212 returns(pointer); 3 213 /* parameter 1: (input) value */ 3 214 /* parameter 2: (input) type */ 3 215 /* parameter 3: (input) size */ 3 216 /* parameter 4: (input) scale */ 3 217 /* return: (output) reference node pointer */ 3 218 3 219 declare declare_constant$bit entry(bit(*) aligned) 3 220 returns(pointer); 3 221 /* parameter 1: (input) bit */ 3 222 /* return: (output) reference node pointer */ 3 223 3 224 declare declare_constant$char entry(character(*) aligned) 3 225 returns(pointer); 3 226 /* parameter 1: (input) character */ 3 227 /* return: (output) reference node pointer */ 3 228 3 229 declare declare_constant$desc entry(bit(*) aligned) 3 230 returns(pointer); 3 231 /* parameter 1: (input) descriptor bit value */ 3 232 /* return: (output) reference node pointer */ 3 233 3 234 declare declare_constant$integer entry(fixed bin(31)) /* note...should really be fixed bin(24) */ 3 235 returns(pointer); 3 236 /* parameter 1: (input) integer */ 3 237 /* return: (output) reference node pointer */ 3 238 3 239 declare declare_descriptor entry(pointer,pointer,pointer,pointer,bit(2) aligned) 3 240 returns(pointer); 3 241 /* parameter 1: (input) block node pointer */ 3 242 /* parameter 2: (input) statement node pointer */ 3 243 /* parameter 3: (input) symbol node pointer */ 3 244 /* parameter 4: (input) loc pointer */ 3 245 /* parameter 5: (input) array descriptor bit 3 246* cross_section bit */ 3 247 /* return: (output) reference node pointer */ 3 248 3 249 declare declare_descriptor$ctl entry(pointer,pointer,pointer,pointer,bit(2) aligned) 3 250 returns(pointer); 3 251 /* parameter 1: (input) block node pointer */ 3 252 /* parameter 2: (input) statement node pointer */ 3 253 /* parameter 3: (input) symbol node pointer */ 3 254 /* parameter 4: (input) loc pointer */ 3 255 /* parameter 5: (input) array descriptor bit 3 256* cross_section bit */ 3 257 /* return: (output) reference node pointer */ 3 258 3 259 declare declare_descriptor$param entry(pointer,pointer,pointer,pointer,bit(2) aligned) 3 260 returns(pointer); 3 261 /* parameter 1: (input) block node pointer */ 3 262 /* parameter 2: (input) statement node pointer */ 3 263 /* parameter 3: (input) symbol node pointer */ 3 264 /* parameter 4: (input) loc pointer */ 3 265 /* parameter 5: (input) array descriptor bit 3 266* cross_section bit */ 3 267 /* return: (output) reference node pointer */ 3 268 3 269 declare declare_integer entry(pointer) 3 270 returns(pointer); 3 271 /* parameter 1: (input) block node pointer */ 3 272 /* return: (output) reference node pointer */ 3 273 3 274 declare declare_picture entry(char(*)aligned,pointer,fixed bin(15)); 3 275 /* parameter 1: (input) picture string */ 3 276 /* parameter 2: (input) symbol node pointer */ 3 277 /* parameter 3: (output) error code, if any */ 3 278 3 279 declare declare_picture_temp entry(char(*) aligned,fixed bin(31),bit(1) aligned,bit(1) aligned) 3 280 returns(pointer); 3 281 /* parameter 1: (input) picture string */ 3 282 /* parameter 2: (input) scalefactor of picture */ 3 283 /* parameter 3: (input) ="1"b => complex picture */ 3 284 /* parameter 4: (input) ="1"b => unaligned temp */ 3 285 /* return: (output) reference node pointer */ 3 286 3 287 declare declare_pointer entry(pointer) 3 288 returns(pointer); 3 289 /* parameter 1: (input) block node pointer */ 3 290 /* return: (output) reference node pointer */ 3 291 3 292 declare declare_temporary entry(bit(36) aligned,fixed bin(31),fixed bin(15),pointer) 3 293 returns(pointer); 3 294 /* parameter 1: (input) type */ 3 295 /* parameter 2: (input) precision */ 3 296 /* parameter 3: (input) scale */ 3 297 /* parameter 4: (input) length */ 3 298 /* return: (output) reference node pointer */ 3 299 3 300 declare decode_node_id entry(pointer,bit(1) aligned) 3 301 returns(char(120) varying); 3 302 /* parameter 1: (input) node pointer */ 3 303 /* parameter 2: (input) ="1"b => capitals */ 3 304 /* return: (output) source line id */ 3 305 3 306 declare decode_source_id entry( 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), 3 307 3 308 bit(1) aligned) 3 309 returns(char(120) varying); 3 310 /* parameter 1: (input) source id */ 3 311 /* parameter 2: (input) ="1"b => capitals */ 3 312 /* return: (output) source line id */ 3 313 3 314 declare error entry(fixed bin(15),pointer,pointer); 3 315 /* parameter 1: (input) error number */ 3 316 /* parameter 2: (input) statement node pointer or null*/ 3 317 /* parameter 3: (input) token node pointer */ 3 318 3 319 declare error$omit_text entry(fixed bin(15),pointer,pointer); 3 320 /* parameter 1: (input) error number */ 3 321 /* parameter 2: (input) statement node pointer or null*/ 3 322 /* parameter 3: (input) token node pointer */ 3 323 3 324 declare error_ 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), 3 325 3 326 pointer,fixed bin(8),fixed bin(23),fixed bin(11)); 3 327 /* parameter 1: (input) error number */ 3 328 /* parameter 2: (input) statement id */ 3 329 /* parameter 3: (input) any node pointer */ 3 330 /* parameter 4: (input) source segment */ 3 331 /* parameter 5: (input) source starting character */ 3 332 /* parameter 6: (input) source length */ 3 333 3 334 declare error_$no_text 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), 3 335 3 336 pointer); 3 337 /* parameter 1: (input) error number */ 3 338 /* parameter 2: (input) statement id */ 3 339 /* parameter 3: (input) any node pointer */ 3 340 3 341 declare error_$initialize_error entry(); 3 342 3 343 declare error_$finish entry(); 3 344 3 345 declare free_node entry(pointer); 3 346 /* parameter 1: any node pointer */ 3 347 3 348 declare get_array_size entry(pointer,fixed bin(3)); 3 349 /* parameter 1: (input) symbol node pointer */ 3 350 /* parameter 2: (input) units */ 3 351 3 352 declare get_size entry(pointer); 3 353 /* parameter 1: (input) symbol node pointer */ 3 354 3 355 declare merge_attributes external entry(pointer,pointer) 3 356 returns(bit(1) aligned); 3 357 /* parameter 1: (input) target symbol node pointer */ 3 358 /* parameter 2: (input) source symbol node pointer */ 3 359 /* return: (output) "1"b if merge was unsuccessful */ 3 360 3 361 declare optimizer entry(pointer); 3 362 /* parameter 1: (input) root pointer */ 3 363 3 364 declare parse_error entry(fixed bin(15),pointer); 3 365 /* parameter 1: (input) error number */ 3 366 /* parameter 2: (input) any node pointer */ 3 367 3 368 declare parse_error$no_text entry(fixed bin(15),pointer); 3 369 /* parameter 1: (input) error number */ 3 370 /* parameter 2: (input) any node pointer */ 3 371 3 372 declare pl1_error_print$write_out 3 373 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), 3 374 3 375 pointer,fixed bin(11),fixed bin(31),fixed bin(31),fixed bin(15)); 3 376 /* parameter 1: (input) error number */ 3 377 /* parameter 2: (input) statement identification */ 3 378 /* parameter 3: (input) any node pointer */ 3 379 /* parameter 4: (input) source segment */ 3 380 /* parameter 5: (input) source character index */ 3 381 /* parameter 6: (input) source length */ 3 382 /* parameter 7: (input) source line */ 3 383 3 384 declare pl1_error_print$listing_segment 3 385 entry(fixed bin(15), 8 1 1 structure unaligned, 8 2 2 /* file_number */ bit(8), 8 3 2 /* line_number */ bit(14), 8 4 2 /* stmt_number */ bit(5), 3 386 3 387 pointer); 3 388 /* parameter 1: (input) error number */ 3 389 /* parameter 2: (input) statement identification */ 3 390 /* parameter 3: (input) token node pointer */ 3 391 3 392 declare pl1_print$varying entry(character(*) aligned varying); 3 393 /* parameter 1: (input) string */ 3 394 3 395 declare pl1_print$varying_nl entry(character(*) aligned varying); 3 396 /* parameter 1: (input) string */ 3 397 3 398 declare pl1_print$non_varying entry(character(*) aligned,fixed bin(31)); 3 399 /* parameter 1: (input) string */ 3 400 /* parameter 2: (input) string length or 0 */ 3 401 3 402 declare pl1_print$non_varying_nl entry(character(*) aligned,fixed bin(31)); 3 403 /* parameter 1: (input) string */ 3 404 /* parameter 2: (input) string length or 0 */ 3 405 3 406 declare pl1_print$string_pointer entry(pointer,fixed bin(31)); 3 407 /* parameter 1: (input) string pointer */ 3 408 /* parameter 2: (input) string size */ 3 409 3 410 declare pl1_print$string_pointer_nl entry(pointer,fixed bin(31)); 3 411 /* parameter 1: (input) string pointer */ 3 412 /* parameter 2: (input) string length or 0 */ 3 413 3 414 declare pl1_print$unaligned_nl entry(character(*) unaligned,fixed bin(31)); 3 415 /* parameter 1: (input) string */ 3 416 /* parameter 2: (input) length */ 3 417 3 418 declare pl1_print$for_lex entry (ptr, fixed bin (14), fixed bin (21), fixed bin (21), bit (1) aligned, bit (1) aligned); 3 419 /* parameter 1: (input) ptr to base of source segment */ 3 420 /* parameter 2: (input) line number */ 3 421 /* parameter 3: (input) starting offset in source seg */ 3 422 /* parameter 4: (input) number of chars to copy */ 3 423 /* parameter 5: (input) ON iff shd print line number */ 3 424 /* parameter 6: (input) ON iff line begins in comment */ 3 425 3 426 declare refer_extent entry(pointer,pointer); 3 427 /* parameter 1: (input/output) null,ref node,op node pointer */ 3 428 /* parameter 2: (input) null,ref node,op node pointer */ 3 429 3 430 declare reserve$clear entry() 3 431 returns(pointer); 3 432 /* return: (output) pointer */ 3 433 3 434 declare reserve$declare_lib entry(fixed bin(15)) 3 435 returns(pointer); 3 436 /* parameter 1: (input) builtin function number */ 3 437 /* return: (output) pointer */ 3 438 3 439 declare reserve$read_lib entry(fixed bin(15)) 3 440 returns(pointer); 3 441 /* parameter 1: (input) builtin function number */ 3 442 /* return: (output) pointer */ 3 443 3 444 declare semantic_translator entry(); 3 445 3 446 declare semantic_translator$abort entry(fixed bin(15),pointer); 3 447 /* parameter 1: (input) error number */ 3 448 /* parameter 2: (input) any node pointer */ 3 449 3 450 declare semantic_translator$error entry(fixed bin(15),pointer); 3 451 /* parameter 1: (input) error number */ 3 452 /* parameter 2: (input) any node pointer */ 3 453 3 454 declare share_expression entry(ptr) 3 455 returns(ptr); 3 456 /* parameter 1: (input) usually operator node pointer */ 3 457 /* return: (output) tree pointer or null */ 3 458 3 459 declare token_to_binary entry(ptr) reducible 3 460 returns(fixed bin(31)); 3 461 /* parameter 1: (input) token node pointer */ 3 462 /* return: (output) converted binary value */ 3 463 3 464 /* END INCLUDE FILE ... language_utility.incl.pl1 */ 2 228 2 229 /* END INCLUDE FILE ... semant.incl.pl1 */ 2237 2238 9 1 dcl 1 array based aligned, 9 2 2 node_type bit(9) unaligned, 9 3 2 reserved bit(34) unaligned, 9 4 2 number_of_dimensions fixed(7) unaligned, 9 5 2 own_number_of_dimensions fixed(7) unaligned, 9 6 2 element_boundary fixed(3) unaligned, 9 7 2 size_units fixed(3) unaligned, 9 8 2 offset_units fixed(3) unaligned, 9 9 2 interleaved bit(1) unaligned, 9 10 2 c_element_size fixed(24), 9 11 2 c_element_size_bits fixed(24), 9 12 2 c_virtual_origin fixed(24), 9 13 2 element_size ptr unaligned, 9 14 2 element_size_bits ptr unaligned, 9 15 2 virtual_origin ptr unaligned, 9 16 2 symtab_virtual_origin ptr unaligned, 9 17 2 symtab_element_size ptr unaligned, 9 18 2 bounds ptr unaligned, 9 19 2 element_descriptor ptr unaligned; 9 20 9 21 dcl 1 bound based aligned, 9 22 2 node_type bit(9), 9 23 2 c_lower fixed(24), 9 24 2 c_upper fixed(24), 9 25 2 c_multiplier fixed(24), 9 26 2 c_desc_multiplier fixed(24), 9 27 2 lower ptr unaligned, 9 28 2 upper ptr unaligned, 9 29 2 multiplier ptr unaligned, 9 30 2 desc_multiplier ptr unaligned, 9 31 2 symtab_lower ptr unaligned, 9 32 2 symtab_upper ptr unaligned, 9 33 2 symtab_multiplier ptr unaligned, 9 34 2 next ptr unaligned; 2239 2240 10 1 /* BEGIN INCLUDE FILE ... symbol.incl.pl1 */ 10 2 10 3 dcl 1 symbol based aligned, 10 4 2 node_type bit(9) unal, 10 5 2 source_id structure unal, 10 6 3 file_number bit(8), 10 7 3 line_number bit(14), 10 8 3 statement_number bit(5), 10 9 2 location fixed(18) unal unsigned, 10 10 2 allocated bit(1) unal, 10 11 2 dcl_type bit(3) unal, 10 12 2 reserved bit(6) unal, 10 13 2 pix unal, 10 14 3 pic_fixed bit(1) unal, 10 15 3 pic_float bit(1) unal, 10 16 3 pic_char bit(1) unal, 10 17 3 pic_scale fixed(7) unal, 10 18 3 pic_size fixed(7) unal, 10 19 2 level fixed(8) unal, 10 20 2 boundary fixed(3) unal, 10 21 2 size_units fixed(3) unal, 10 22 2 scale fixed(7) unal, 10 23 2 runtime bit(18) unal, 10 24 2 runtime_offset bit(18) unal, 10 25 2 block_node ptr unal, 10 26 2 token ptr unal, 10 27 2 next ptr unal, 10 28 2 multi_use ptr unal, 10 29 2 cross_references ptr unal, 10 30 2 initial ptr unal, 10 31 2 array ptr unal, 10 32 2 descriptor ptr unal, 10 33 2 equivalence ptr unal, 10 34 2 reference ptr unal, 10 35 2 general ptr unal, 10 36 2 father ptr unal, 10 37 2 brother ptr unal, 10 38 2 son ptr unal, 10 39 2 word_size ptr unal, 10 40 2 bit_size ptr unal, 10 41 2 dcl_size ptr unal, 10 42 2 symtab_size ptr unal, 10 43 2 c_word_size fixed(24), 10 44 2 c_bit_size fixed(24), 10 45 2 c_dcl_size fixed(24), 10 46 10 47 2 attributes structure aligned, 10 48 3 data_type structure unal, 10 49 4 structure bit(1) , 10 50 4 fixed bit(1), 10 51 4 float bit(1), 10 52 4 bit bit(1), 10 53 4 char bit(1), 10 54 4 ptr bit(1), 10 55 4 offset bit(1), 10 56 4 area bit(1), 10 57 4 label bit(1), 10 58 4 entry bit(1), 10 59 4 file bit(1), 10 60 4 arg_descriptor bit(1), 10 61 4 storage_block bit(1), 10 62 4 explicit_packed bit(1), /* options(packed) */ 10 63 4 condition bit(1), 10 64 4 format bit(1), 10 65 4 builtin bit(1), 10 66 4 generic bit(1), 10 67 4 picture bit(1), 10 68 10 69 3 misc_attributes structure unal, 10 70 4 dimensioned bit(1), 10 71 4 initialed bit(1), 10 72 4 aligned bit(1), 10 73 4 unaligned bit(1), 10 74 4 signed bit(1), 10 75 4 unsigned bit(1), 10 76 4 precision bit(1), 10 77 4 varying bit(1), 10 78 4 local bit(1), 10 79 4 decimal bit(1), 10 80 4 binary bit(1), 10 81 4 real bit(1), 10 82 4 complex bit(1), 10 83 4 variable bit(1), 10 84 4 reducible bit(1), 10 85 4 irreducible bit(1), 10 86 4 returns bit(1), 10 87 4 position bit(1), 10 88 4 internal bit(1), 10 89 4 external bit(1), 10 90 4 like bit(1), 10 91 4 member bit(1), 10 92 4 non_varying bit(1), 10 93 4 options bit(1), 10 94 4 variable_arg_list bit(1), /* options(variable) */ 10 95 4 alloc_in_text bit(1), /* options(constant) */ 10 96 10 97 3 storage_class structure unal, 10 98 4 auto bit(1), 10 99 4 based bit(1), 10 100 4 static bit(1), 10 101 4 controlled bit(1), 10 102 4 defined bit(1), 10 103 4 parameter bit(1), 10 104 4 param_desc bit(1), 10 105 4 constant bit(1), 10 106 4 temporary bit(1), 10 107 4 return_value bit(1), 10 108 10 109 3 file_attributes structure unal, 10 110 4 print bit(1), 10 111 4 input bit(1), 10 112 4 output bit(1), 10 113 4 update bit(1), 10 114 4 stream bit(1), 10 115 4 reserved_1 bit(1), 10 116 4 record bit(1), 10 117 4 sequential bit(1), 10 118 4 direct bit(1), 10 119 4 interactive bit(1), /* env(interactive) */ 10 120 4 reserved_2 bit(1), 10 121 4 reserved_3 bit(1), 10 122 4 stringvalue bit(1), /* env(stringvalue) */ 10 123 4 keyed bit(1), 10 124 4 reserved_4 bit(1), 10 125 4 environment bit(1), 10 126 10 127 3 compiler_developed structure unal, 10 128 4 aliasable bit(1), 10 129 4 packed bit(1), 10 130 4 passed_as_arg bit(1), 10 131 4 allocate bit(1), 10 132 4 set bit(1), 10 133 4 exp_extents bit(1), 10 134 4 refer_extents bit(1), 10 135 4 star_extents bit(1), 10 136 4 isub bit(1), 10 137 4 put_in_symtab bit(1), 10 138 4 contiguous bit(1), 10 139 4 put_data bit(1), 10 140 4 overlayed bit(1), 10 141 4 error bit(1), 10 142 4 symtab_processed bit(1), 10 143 4 overlayed_by_builtin bit(1), 10 144 4 defaulted bit(1), 10 145 4 connected bit(1); 10 146 10 147 /* END INCLUDE FILE ... symbol.incl.pl1 */ 2241 2242 11 1 /* BEGIN INCLUDE FILE ... pl1_symbol_type.incl.pl1 */ 11 2 11 3 dcl 1 type, 11 4 2 structure bit, 11 5 2 fixed bit, 11 6 2 float bit, 11 7 2 bit bit, 11 8 2 char bit, 11 9 2 ptr bit, 11 10 2 offset bit, 11 11 2 area bit, 11 12 2 label bit, 11 13 2 entry bit, 11 14 2 file bit, 11 15 2 arg_descriptor bit, 11 16 2 storage_block bit, 11 17 2 explicit_packed bit, 11 18 2 condition bit, 11 19 2 format bit, 11 20 2 builtin bit, 11 21 2 generic bit, 11 22 2 picture bit, 11 23 2 dimensioned bit, 11 24 2 initialed bit, 11 25 2 aligned bit, 11 26 2 unaligned bit, 11 27 2 signed bit, 11 28 2 unsigned bit, 11 29 2 precision bit, 11 30 2 varying bit, 11 31 2 local bit, 11 32 2 decimal bit, 11 33 2 binary bit, 11 34 2 real bit, 11 35 2 complex bit, 11 36 2 variable bit, 11 37 2 reducible bit, 11 38 2 irreducible bit, 11 39 2 returns bit; 11 40 11 41 /* END INCLUDE FILE ... pl1_symbol_type.incl.pl1 */ 2243 2244 12 1 /* BEGIN INCLUDE FILE ... symbol_bits.incl.pl1 */ 12 2 12 3 dcl ( aliasable_bit initial (72), 12 4 passed_as_arg_bit initial (74), 12 5 set_bit initial (76), 12 6 overlayed_by_builtin_bit initial (87)) fixed bin (15) internal static options (constant); 12 7 12 8 /* END INCLUDE FILE ... symbol_bits.incl.pl1 */ 2245 2246 13 1 /* BEGIN INCLUDE FILE ... operator.incl.pl1 */ 13 2 13 3 /* Modified: 2 Apr 1980 by PCK to add max_number_of_operands */ 13 4 13 5 /* format: style3 */ 13 6 dcl 1 operator based aligned, 13 7 2 node_type bit (9) unaligned, 13 8 2 op_code bit (9) unaligned, 13 9 2 shared bit (1) unaligned, 13 10 2 processed bit (1) unaligned, 13 11 2 optimized bit (1) unaligned, 13 12 2 number fixed (14) unaligned, 13 13 2 operand dimension (n refer (operator.number)) ptr unaligned; 13 14 13 15 dcl max_number_of_operands 13 16 fixed bin (15) int static options (constant) initial (32767); 13 17 13 18 /* END INCLUDE FILE ... operator.incl.pl1 */ 2247 2248 14 1 /* BEGIN INCLUDE FILE ... mask.incl.pl1 */ 14 2 14 3 dcl ( structure_mask init("100000000000000000000000000000000000"b), 14 4 fixed_mask init("010000000000000000000000000000000000"b), 14 5 float_mask init("001000000000000000000000000000000000"b), 14 6 bit_mask init("000100000000000000000000000000000000"b), 14 7 char_mask init("000010000000000000000000000000000000"b), 14 8 ptr_mask init("000001000000000000000000000000000000"b), 14 9 offset_mask init("000000100000000000000000000000000000"b), 14 10 area_mask init("000000010000000000000000000000000000"b), 14 11 label_mask init("000000001000000000000000000000000000"b), 14 12 entry_mask init("000000000100000000000000000000000000"b), 14 13 file_mask init("000000000010000000000000000000000000"b), 14 14 arg_descriptor_mask init("000000000001000000000000000000000000"b), 14 15 storage_block_mask init("000000000000100000000000000000000000"b), 14 16 lock_mask init("000000000000010000000000000000000000"b), 14 17 condition_mask init("000000000000001000000000000000000000"b), 14 18 format_mask init("000000000000000100000000000000000000"b), 14 19 builtin_mask init("000000000000000010000000000000000000"b), 14 20 generic_mask init("000000000000000001000000000000000000"b), 14 21 picture_mask init("000000000000000000100000000000000000"b), 14 22 dimensioned_mask init("000000000000000000010000000000000000"b), 14 23 initialed_mask init("000000000000000000001000000000000000"b), 14 24 aligned_mask init("000000000000000000000100000000000000"b), 14 25 unaligned_mask init("000000000000000000000010000000000000"b), 14 26 signed_mask init("000000000000000000000001000000000000"b), 14 27 unsigned_mask init("000000000000000000000000100000000000"b), 14 28 precision_mask init("000000000000000000000000010000000000"b), 14 29 varying_mask init("000000000000000000000000001000000000"b), 14 30 local_mask init("000000000000000000000000000100000000"b), 14 31 decimal_mask init("000000000000000000000000000010000000"b), 14 32 binary_mask init("000000000000000000000000000001000000"b), 14 33 real_mask init("000000000000000000000000000000100000"b), 14 34 complex_mask init("000000000000000000000000000000010000"b), 14 35 variable_mask init("000000000000000000000000000000001000"b), 14 36 reducible_mask init("000000000000000000000000000000000100"b), 14 37 irreducible_mask init("000000000000000000000000000000000010"b), 14 38 returns_mask init("000000000000000000000000000000000001"b)) bit(36) aligned int static 14 39 options(constant); 14 40 14 41 dcl ( arithmetic_mask init("011000000000000000000000000011110000"b), 14 42 computational_mask init("011110000000000000100000000011110000"b), 14 43 fixed_binary_real_mask init("010000000000000000000000000001100000"b), 14 44 fixed_decimal_real_mask init("010000000000000000000000000010100000"b), 14 45 float_decimal_real_mask init("001000000000000000000000000010100000"b), 14 46 fixed_decimal_complex_mask init("010000000000000000000000000010010000"b), 14 47 float_decimal_complex_mask init("001000000000000000000000000010010000"b), 14 48 string_mask init("000110000000000000000000000000000000"b), 14 49 undesirable_mask init("111111111111111111100111110111110111"b), 14 50 convert_mask init("011111111111111111100111110111111110"b), 14 51 declare_constant_mask init("111111111111111111100000000011110000"b) 14 52 ) bit(36) aligned int static 14 53 options(constant); 14 54 14 55 /* END INCLUDE FILE ... mask.incl.pl1 */ 2249 2250 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; 2251 2252 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 */ 2253 2254 17 1 /* BEGIN INCLUDE FILE ... block.incl.pl1 */ 17 2 /* Modified 22 Ocober 1980 by M. N. Davidoff to increase max block.number to 511 */ 17 3 /* format: style3,idind30 */ 17 4 17 5 declare 1 block aligned based, 17 6 2 node_type bit (9) unaligned, 17 7 2 source_id structure unaligned, 17 8 3 file_number bit (8), 17 9 3 line_number bit (14), 17 10 3 statement_number bit (5), 17 11 2 father ptr unaligned, 17 12 2 brother ptr unaligned, 17 13 2 son ptr unaligned, 17 14 2 declaration ptr unaligned, 17 15 2 end_declaration ptr unaligned, 17 16 2 default ptr unaligned, 17 17 2 end_default ptr unaligned, 17 18 2 context ptr unaligned, 17 19 2 prologue ptr unaligned, 17 20 2 end_prologue ptr unaligned, 17 21 2 main ptr unaligned, 17 22 2 end_main ptr unaligned, 17 23 2 return_values ptr unaligned, 17 24 2 return_count ptr unaligned, 17 25 2 plio_ps ptr unaligned, 17 26 2 plio_fa ptr unaligned, 17 27 2 plio_ffsb ptr unaligned, 17 28 2 plio_ssl ptr unaligned, 17 29 2 plio_fab2 ptr unaligned, 17 30 2 block_type bit (9) unaligned, 17 31 2 prefix bit (12) unaligned, 17 32 2 like_attribute bit (1) unaligned, 17 33 2 no_stack bit (1) unaligned, 17 34 2 get_data bit (1) unaligned, 17 35 2 flush_at_call bit (1) unaligned, 17 36 2 processed bit (1) unaligned, 17 37 2 text_displayed bit (1) unaligned, 17 38 2 number fixed bin (9) unsigned unaligned, 17 39 2 free_temps dimension (3) ptr, /* these fields are used by the code generator */ 17 40 2 temp_list ptr, 17 41 2 entry_list ptr, 17 42 2 o_and_s ptr, 17 43 2 why_nonquick aligned, 17 44 3 auto_adjustable_storage bit (1) unaligned, 17 45 3 returns_star_extents bit (1) unaligned, 17 46 3 stack_extended_by_args bit (1) unaligned, 17 47 3 invoked_by_format bit (1) unaligned, 17 48 3 format_statement bit (1) unaligned, 17 49 3 io_statements bit (1) unaligned, 17 50 3 assigned_to_entry_var bit (1) unaligned, 17 51 3 condition_statements bit (1) unaligned, 17 52 3 no_owner bit (1) unaligned, 17 53 3 recursive_call bit (1) unaligned, 17 54 3 options_non_quick bit (1) unaligned, 17 55 3 options_variable bit (1) unaligned, 17 56 3 never_referenced bit (1) unaligned, 17 57 3 pad_nonquick bit (5) unaligned, 17 58 2 prologue_flag bit (1) unaligned, 17 59 2 options_main bit (1) unaligned, 17 60 2 pad bit (16) unaligned, 17 61 2 number_of_entries fixed bin (17), 17 62 2 level fixed bin (17), 17 63 2 last_auto_loc fixed bin (17), 17 64 2 symbol_block fixed bin (17), 17 65 2 entry_info fixed bin (18), 17 66 2 enter structure unaligned, 17 67 3 start fixed bin (17), 17 68 3 end fixed bin (17), 17 69 2 leave structure unaligned, 17 70 3 start fixed bin (17), 17 71 3 end fixed bin (17), 17 72 2 owner ptr; 17 73 17 74 declare max_block_number fixed bin internal static options (constant) initial (511); 17 75 17 76 /* END INCLUDE FILE ... block.incl.pl1 */ 2255 2256 18 1 dcl ( root_block initial("000000001"b), 18 2 external_procedure initial("000000010"b), 18 3 internal_procedure initial("000000011"b), 18 4 begin_block initial("000000100"b), 18 5 on_unit initial("000000101"b)) internal static bit(9) aligned options(constant); 2257 2258 19 1 /* *********************************************************** 19 2* * * 19 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 19 4* * * 19 5* *********************************************************** */ 19 6 /* BEGIN INCLUDE FILE ... statement.incl.pl1 */ 19 7 /* Internal interface of the PL/I compiler */ 19 8 19 9 dcl 1 statement based aligned, 19 10 2 node_type bit(9) unaligned, 19 11 2 source_id structure unaligned, 19 12 3 file_number bit(8), 19 13 3 line_number bit(14), 19 14 3 statement_number bit(5), 19 15 2 next ptr unaligned, 19 16 2 back ptr unaligned, 19 17 2 root ptr unaligned, 19 18 2 labels ptr unaligned, 19 19 2 reference_list ptr unaligned, 19 20 2 state_list ptr unaligned, 19 21 2 reference_count fixed(17) unaligned, 19 22 2 ref_count_copy fixed(17) unaligned, 19 23 2 object structure unaligned, 19 24 3 start fixed(17), 19 25 3 finish fixed(17), 19 26 2 source structure unaligned, 19 27 3 segment fixed(11), 19 28 3 start fixed(23), 19 29 3 length fixed(11), 19 30 2 prefix bit(12) unaligned, 19 31 2 optimized bit(1) unaligned, 19 32 2 free_temps bit(1) unaligned, 19 33 2 LHS_in_RHS bit(1) unaligned, 19 34 2 statement_type bit(9) unaligned, 19 35 2 bits structure unaligned, 19 36 3 processed bit(1) unaligned, 19 37 3 put_in_profile bit(1) unaligned, 19 38 3 generated bit(1) unaligned, 19 39 3 snap bit(1) unaligned, 19 40 3 system bit(1) unaligned, 19 41 3 irreducible bit(1) unaligned, 19 42 3 checked bit(1) unaligned, 19 43 3 save_temps bit(1) unaligned, 19 44 3 suppress_warnings bit(1) unaligned, 19 45 3 force_nonquick bit(1) unaligned, 19 46 3 expanded_by_name bit(1) unaligned, 19 47 3 begins_loop bit(1) unaligned, 19 48 3 pad bit(24) unaligned; 19 49 19 50 /* END INCLUDE FILE ... statement.incl.pl1 */ 2259 2260 20 1 /* BEGIN INCLUDE FILE ... reference.incl.pl1 */ 20 2 20 3 dcl 1 reference based aligned, 20 4 2 node_type bit(9) unaligned, 20 5 2 array_ref bit(1) unaligned, 20 6 2 varying_ref bit(1) unaligned, 20 7 2 shared bit(1) unaligned, 20 8 2 put_data_sw bit(1) unaligned, 20 9 2 processed bit(1) unaligned, 20 10 2 units fixed(3) unaligned, 20 11 2 ref_count fixed(17) unaligned, 20 12 2 c_offset fixed(24), 20 13 2 c_length fixed(24), 20 14 2 symbol ptr unaligned, 20 15 2 qualifier ptr unaligned, 20 16 2 offset ptr unaligned, 20 17 2 length ptr unaligned, 20 18 2 subscript_list ptr unaligned, 20 19 /* these fields are used by the 645 code generator */ 20 20 2 address structure unaligned, 20 21 3 base bit(3), 20 22 3 offset bit(15), 20 23 3 op bit(9), 20 24 3 no_address bit(1), 20 25 3 inhibit bit(1), 20 26 3 ext_base bit(1), 20 27 3 tag bit(6), 20 28 2 info structure unaligned, 20 29 3 address_in structure, 20 30 4 b dimension(0:7) bit(1), 20 31 4 storage bit(1), 20 32 3 value_in structure, 20 33 4 a bit(1), 20 34 4 q bit(1), 20 35 4 aq bit(1), 20 36 4 string_aq bit(1), 20 37 4 complex_aq bit(1), 20 38 4 decimal_aq bit(1), 20 39 4 b dimension(0:7) bit(1), 20 40 4 storage bit(1), 20 41 4 indicators bit(1), 20 42 4 x dimension(0:7) bit(1), 20 43 3 other structure, 20 44 4 big_offset bit(1), 20 45 4 big_length bit(1), 20 46 4 modword_in_offset bit(1), 20 47 2 data_type fixed(5) unaligned, 20 48 2 bits structure unaligned, 20 49 3 padded_ref bit(1), 20 50 3 aligned_ref bit(1), 20 51 3 long_ref bit(1), 20 52 3 forward_ref bit(1), 20 53 3 ic_ref bit(1), 20 54 3 temp_ref bit(1), 20 55 3 defined_ref bit(1), 20 56 3 evaluated bit(1), 20 57 3 allocate bit(1), 20 58 3 allocated bit(1), 20 59 3 aliasable bit(1), 20 60 3 even bit(1), 20 61 3 perm_address bit(1), 20 62 3 aggregate bit(1), 20 63 3 hit_zero bit(1), 20 64 3 dont_save bit(1), 20 65 3 fo_in_qual bit(1), 20 66 3 hard_to_load bit(1), 20 67 2 relocation bit(12) unaligned, 20 68 2 more_bits structure unaligned, 20 69 3 substr bit(1), 20 70 3 padded_for_store_ref bit(1), 20 71 3 aligned_for_store_ref bit(1), 20 72 3 mbz bit(15), 20 73 2 store_ins bit(18) unaligned; 20 74 20 75 /* END INCLUDE FILE ... reference.incl.pl1 */ 2261 2262 21 1 /* BEGIN INCLUDE FILE ... semantic_bits.incl.pl1 */ 21 2 21 3 /* Modified: 26 Dec 1979 by PCK to implement by name assignment */ 21 4 21 5 dcl context aligned bit(36), 21 6 this_context aligned bit(36); 21 7 21 8 dcl 1 def_context aligned based(addr(context)), 21 9 2 aggregate unaligned bit(1), 21 10 2 arg_list unaligned bit(1), 21 11 2 left_side unaligned bit(1), 21 12 2 return unaligned bit(1), 21 13 2 evaluate_offset unaligned bit(1), 21 14 2 top unaligned bit(1), 21 15 2 RHS_aggregate unaligned bit(1), 21 16 2 return_from_empty unaligned bit(1), 21 17 2 ignore_based unaligned bit(1), 21 18 2 ext_param unaligned bit(1), 21 19 2 cross_section unaligned bit(1), 21 20 2 string_unspec unaligned bit(1), 21 21 2 f_offset_to_be_added unaligned bit(1), 21 22 2 suppress_cross_ref unaligned bit(1), 21 23 2 by_name_assignment unaligned bit(1), 21 24 2 by_name_lookup unaligned bit(1), 21 25 2 pad unaligned bit(20); 21 26 21 27 dcl 1 def_this_context aligned like def_context based(addr(this_context)); 21 28 21 29 /* END INCLUDE FILE ... semantic_bits.incl.pl1 */ 2263 2264 22 1 /* BEGIN INCLUDE FILE ... op_codes.incl.pl1 */ 22 2 22 3 /* Modified: 25 Apr 1979 by PCK 4-bit decimal */ 22 4 /* Modified: 6 Jun 1979 by PG to add rank and byte */ 22 5 /* Modified: 26 Dec 1979 by PCK to add assign_by_name */ 22 6 /* Modified: 26 July 82 BIM wordno, segno */ 22 7 22 8 dcl ( add initial("000010001"b), /* opnd(1) <- opnd(2)+opnd(3) */ 22 9 sub initial("000010010"b), /* opnd(1) <- opnd(2)-opnd(3) */ 22 10 mult initial("000010011"b), /* opnd(1) <- opnd(2)*opnd(3) */ 22 11 div initial("000010100"b), /* opnd(1) <- opnd(2)/opnd(3) */ 22 12 negate initial("000010101"b), /* opnd(1) <- -opnd(2) */ 22 13 exp initial("000010110"b), /* opnd(1) <- opnd(2) ** opnd(3) */ 22 14 22 15 and_bits initial("000100001"b), /* opnd(1) <- opnd(2) & opnd(3) */ 22 16 or_bits initial("000100010"b), /* opnd(1) <- opnd(2)|opnd(3) */ 22 17 xor_bits initial("000100011"b), /* opnd(1) <- opnd(2) xor opnd(3) */ 22 18 not_bits initial("000100100"b), /* opnd(1) <- ^opnd(2) */ 22 19 cat_string initial("000100101"b), /* opnd(1) <- opnd(2)||opnd(3) */ 22 20 bool_fun initial("000100110"b), /* opnd(1) <- bool(opnd(2),opnd(3),opnd(4)) */ 22 21 22 22 assign initial("000110001"b), /* opnd(1) <- opnd(2) */ 22 23 assign_size_ck initial("000110010"b), /* opnd(1) <- opnd(2) */ 22 24 assign_zero initial("000110011"b), /* opnd(1) <- 0 */ 22 25 copy_words initial("000110100"b), /* move opnd(2) to opnd(1) by opnd(3) words */ 22 26 copy_string initial("000110101"b), /* move opnd(2) to opnd(1) by opnd(3) units */ 22 27 make_desc initial("000110110"b), /* opnd(1) <- descriptor(opnd(2),opnd(3)) */ 22 28 assign_round initial("000110111"b), /* opnd(1) <- opnd(2) rounded */ 22 29 pack initial("000111000"b), /* opnd(1) <- encode to picture opnd(2) */ 22 30 unpack initial("000111001"b), /* opnd(1) <- decode from picture opnd(2) */ 22 31 22 32 less_than initial("001000100"b), /* opnd(1) <- opnd(2) < opnd(3) */ 22 33 greater_than initial("001000101"b), /* opnd(1) <- opnd(2) > opnd(3) */ 22 34 equal initial("001000110"b), /* opnd(1) <- opnd(2) = opnd(3) */ 22 35 not_equal initial("001000111"b), /* opnd(1) <- opnd(2) ^= opnd(3) */ 22 36 less_or_equal initial("001001000"b), /* opnd(1) <- opnd(2) <= opnd(3) */ 22 37 greater_or_equal initial("001001001"b), /* opnd(1) <- opnd(2) >= opnd(3) */ 22 38 22 39 jump initial("001010001"b), /* go to opnd(1) unconditionally */ 22 40 jump_true initial("001010010"b), /* go to opnd(1) if opnd(2) is not 0 */ 22 41 jump_false initial("001010011"b), /* go to opnd(1) if opnd(2) is all 0 */ 22 42 jump_if_lt initial("001010100"b), /* go to opnd(1) if opnd(2) < opnd(3) */ 22 43 jump_if_gt initial("001010101"b), /* go to opnd(1) if opnd(2) > opnd(3) */ 22 44 jump_if_eq initial("001010110"b), /* go to opnd(1) if opnd(2) = opnd(3) */ 22 45 jump_if_ne initial("001010111"b), /* go to opnd(1) if opnd(2) ^= opnd(3) */ 22 46 jump_if_le initial("001011000"b), /* go to opnd(1) if opnd(2) <= opnd(3) */ 22 47 jump_if_ge initial("001011001"b), /* go to opnd(1) if opnd(2) >= opnd(3) */ 22 48 22 49 std_arg_list initial("001100001"b), /* opnd(1) <- arglist(opnd(2) desclist(opnd(3))) */ 22 50 return_words initial("001100010"b), /* return aggregate opnd(1), opnd(2) is length in words */ 22 51 std_call initial("001100011"b), /* opnd(1) <- call opnd(2) with opnd(3) */ 22 52 return_bits initial("001100100"b), /* return aggregate opnd(1), opnd(2) is length in bits */ 22 53 std_entry initial("001100101"b), /* entry(opnd(1)... opnd(n)) */ 22 54 return_string initial("001100110"b), /* return string opnd(1) */ 22 55 ex_prologue initial("001100111"b), /* execute the prologue -no operands- */ 22 56 allot_auto initial("001101000"b), /* opnd(1) <- addrel(stack,opnd(2)) */ 22 57 param_ptr initial("001101001"b), /* opnd(1) <- ptr to opnd(2) in block opnd(3) */ 22 58 param_desc_ptr initial("001101010"b), /* opnd(1) <- ptr to opnd(2) in block opnd(3) */ 22 59 std_return initial("001101011"b), /* return -no arguments- */ 22 60 allot_ctl initial("001101100"b), /* allocate opnd(1) , length in words is opnd(2) */ 22 61 free_ctl initial("001101101"b), /* free opnd(1) */ 22 62 stop initial("001101110"b), /* stop - terminate run unit */ 22 63 22 64 mod_bit initial("001110000"b), /* opnd(1) <- mod(opnd(3),36), 22 65* opnd(2) <- opnd(3) / 36 */ 22 66 mod_byte initial("001110001"b), /* opnd(1) <- mod(opnd(3),4), 22 67* opnd(2) <- opnd(3) / 4 */ 22 68 mod_half initial("001110010"b), /* opnd(1) <- mod(opnd(3),2), 22 69* opnd(2) <- opnd(3) / 2 */ 22 70 mod_word initial("001110011"b), /* TO BE DEFINED BY BLW */ 22 71 22 72 bit_to_char initial("010000000"b), /* opnd(1) <- (opnd(2)+8)/9 */ 22 73 bit_to_word initial("010000001"b), /* opnd(1) <- (opnd(2)+35)/36 */ 22 74 char_to_word initial("010000010"b), /* opnd(1) <- (opnd(2)+3)/4 */ 22 75 half_to_word initial("010000011"b), /* opnd(1) <- (opnd(2)+1)/2 */ 22 76 word_to_mod2 initial("010000100"b), /* opnd(1) <- (opnd(2)+1)/2*2 */ 22 77 word_to_mod4 initial("010000101"b), /* opnd(1) <- (opnd(2)+3)/4*4 */ 22 78 word_to_mod8 initial("010000110"b), /* opnd(1) <- (opnd(2)+7)/8*8 */ 22 79 rel_fun initial("010000111"b), /* opnd(1) <- rel(opnd(2)) */ 22 80 baseno_fun initial("010001000"b), /* opnd(1) <- baseno(opnd(2)) */ 22 81 desc_size initial("010001001"b), /* opnd(1) <- substr(opnd(2),13,24) */ 22 82 bit_pointer initial("010001010"b), /* opnd(1) <- bit offset of opnd(2) */ 22 83 index_before_fun initial("010001011"b), /* opnd(1) <- length of before(opnd(2),opnd(3)) */ 22 84 index_after_fun initial("010001100"b), /* opnd(1) <- offset of after(opnd(2),opnd(3)) in opnd(2) */ 22 85 verify_ltrim_fun initial("010001101"b), /* opnd(1) <- offset of ltrim(opnd(2),opnd(3)) in opnd(2) */ 22 86 verify_rtrim_fun initial("010001110"b), /* opnd(1) <- length(opnd(2))-length(rtrim(opnd(2),opnd(3))) */ 22 87 digit_to_bit initial("010001111"b), /* opnd(1) <- 9*opnd(2)/2 */ 22 88 22 89 ceil_fun initial("010010000"b), /* opnd(1) <- ceil(opnd(2)) */ 22 90 floor_fun initial("010010001"b), /* opnd(1) <- floor(opnd(2)) */ 22 91 round_fun initial("010010010"b), /* opnd(1) <- round(opnd(2)) */ 22 92 sign_fun initial("010010011"b), /* opnd(1) <- sign(opnd(2)) */ 22 93 abs_fun initial("010010100"b), /* opnd(1) <- abs(opnd(2)) */ 22 94 trunc_fun initial("010010101"b), /* opnd(1) <- trunc(opnd(2)) */ 22 95 byte_fun initial("010010110"b), /* opnd(1) <- byte(opnd(2)) */ 22 96 rank_fun initial("010010111"b), /* opnd(1) <- rank(opnd(2)) */ 22 97 index_rev_fun initial("010011000"b), /* opnd(1) <- index(reverse(opnd(2)),reverse(opnd(3))) */ 22 98 search_rev_fun initial("010011001"b), /* opnd(1) <- search(reverse(opnd(2)),opnd(3)) */ 22 99 verify_rev_fun initial("010011010"b), /* opnd(1) <- verify(reverse(opnd(2)),opnd(3)) */ 22 100 wordno_fun initial("010011011"b), /* opnd(1) <- wordno (opnd(2)) */ 22 101 segno_fun initial("010011100"b), /* opnd(1) <- segno (opnd(2)) */ 22 102 bitno_fun initial("010011101"b), /* opnd(1) <- bitno (opnd(2)) */ 22 103 charno_fun initial("010011110"b), /* opnd(1) <- charno (opnd(2)) */ 22 104 22 105 index_fun initial("010100000"b), /* opnd(1) <- index(opnd(2),opnd(3)) */ 22 106 off_fun initial("010100001"b), /* opnd(1) <- offset(opnd(2),opnd(3)) */ 22 107 complex_fun initial("010100010"b), /* opnd(1) <- complex(opnd(2),opnd(3)) */ 22 108 conjg_fun initial("010100011"b), /* opnd(1) <- conjg(opnd(2),opnd(3)) */ 22 109 mod_fun initial("010100100"b), /* opnd(1) <- mod(opnd(2),opnd(3)) */ 22 110 repeat_fun initial("010100101"b), /* opnd(1) <- repeat(opnd(2),opnd(3)) */ 22 111 verify_fun initial("010100110"b), /* opnd(1) <- verify(opnd(2),opnd(3)) */ 22 112 translate_fun initial("010100111"b), /* opnd(1) <- translate(opnd(2),opnd(3))*/ 22 113 real_fun initial("010101001"b), /* opnd(1) <- real(opnd(2)) */ 22 114 imag_fun initial("010101010"b), /* opnd(1) <- imag(opnd(2)) */ 22 115 length_fun initial("010101011"b), /* opnd(1) <- length(opnd(2)) */ 22 116 pl1_mod_fun initial("010101100"b), /* opnd(1) <- mod(opnd(2)) */ 22 117 search_fun initial("010101101"b), /* opnd(1) <- search(opnd(2),opnd(3)) */ 22 118 allocation_fun initial("010101110"b), /* opnd(1) <- allocation(opnd(2)) */ 22 119 reverse_fun initial("010101111"b), /* opnd(1) <- reverse(opnd(2)) */ 22 120 22 121 addr_fun initial("010110000"b), /* opnd(1) <- addr(opnd(2)) */ 22 122 addr_fun_bits initial("010110001"b), /* opnd(1) <- addr(opnd(2)) */ 22 123 ptr_fun initial("010110010"b), /* opnd(1) <- ptr(opnd(2),opnd(3)) */ 22 124 baseptr_fun initial("010110011"b), /* opnd(1) <- baseptr(opnd(2)) */ 22 125 addrel_fun initial("010110100"b), /* opnd(1) <- addrel(opnd(2),opnd(3)) */ 22 126 codeptr_fun initial("010110101"b), /* opnd(1) <- codeptr(opnd(2)) */ 22 127 environmentptr_fun initial("010110110"b), /* opnd(1) <- environmentptr(opnd(2)) */ 22 128 stackbaseptr_fun initial("010110111"b), /* opnd(1) is ptr to base of current stack */ 22 129 stackframeptr_fun initial("010111000"b), /* opnd(1) is ptr to current block's stack frame */ 22 130 setcharno_fun initial("010111001"b), /* opnd(1) <- opnd(2) with charno opnd(3) */ 22 131 addcharno_fun initial("010111010"b), /* opnd(1) <- opnd(2) with charno = charno + opnd(3) */ 22 132 setbitno_fun initial("010111011"b), /* setcharno for bitsno */ 22 133 addbitno_fun initial("010111100"b), /* addcharno for bitno */ 22 134 22 135 min_fun initial("011000000"b), /* opnd(1) <- min(opnd(1),opnd(2),...) */ 22 136 max_fun initial("011000001"b), /* opnd(1) <- max(opnd(1),opnd(2),...) */ 22 137 22 138 stack_ptr initial("011010001"b), /* opnd(1) <- stack frame ptr */ 22 139 empty_area initial("011010010"b), /* empty opnd(1), length in words is opnd(2) */ 22 140 enable_on initial("011010100"b), /* opnd(1) is the cond name 22 141* opnd(2) is the file name 22 142* opnd(3) is the block */ 22 143 revert_on initial("011010101"b), /* opnd(1) is the cond name, 22 144* opnd(2) is the file name */ 22 145 signal_on initial("011010110"b), /* opnd(1) is the cond name 22 146* opnd(2) is the file name */ 22 147 22 148 lock_fun initial("011010111"b), /* opnd(1) <- stac(opnd(2),opnd(3)) */ 22 149 stacq_fun initial("011011000"b), /* opnd(1) is result, opnd(2) is ptr to lock word, 22 150* opnd(3) is old value, (4) is new value. */ 22 151 clock_fun initial("011011001"b), /* opnd(1) is the clock time */ 22 152 vclock_fun initial("011011010"b), /* opnd(1) is the virtual clock time */ 22 153 22 154 bound_ck initial("011100000"b), /* opnd(1) <- opnd(2) if opnd(3) <= opnd(2) <= opnd(4) */ 22 155 range_ck initial("011100001"b), /* opnd(1) <- opnd(2) if opnd(3) <= opnd(2) <= opnd(4) */ 22 156 loop initial("011100010"b), /* do opnd(1) for opnd(2) from opnd(3) to opnd(4) by 1, 22 157* opnd(5) is the list */ 22 158 join initial("011100011"b), /* do opnd(1), opnd(2) ... opnd(n) */ 22 159 allot_based initial("011100100"b), /* allocate opnd(2) words in opnd(3), set opnd(1) */ 22 160 free_based initial("011100101"b), /* free opnd(1) in opnd(3), length is opnd(2) words */ 22 161 22 162 r_parn initial("011110001"b), /* format op code */ 22 163 l_parn initial("011110010"b), 22 164 r_format initial("011110011"b), 22 165 c_format initial("011110100"b), 22 166 f_format initial("011110101"b), 22 167 e_format initial("011110110"b), 22 168 b_format initial("011110111"b), 22 169 a_format initial("011111000"b), 22 170 x_format initial("011111001"b), 22 171 skip_format initial("011111010"b), 22 172 column_format initial("011111011"b), 22 173 page_format initial("011111100"b), 22 174 line_format initial("011111101"b), 22 175 picture_format initial("011111110"b), 22 176 bn_format initial("011111111"b), /* bit format, length(opnd(2)), radix factor(opnd(3)) */ 22 177 22 178 get_list_trans initial("100000000"b), /* getlist(opnd(2) with desc(opnd(1))) */ 22 179 get_edit_trans initial("100000001"b), /* getedit(opnd(2) with desc(opnd(1))) */ 22 180 get_data_trans initial("100000010"b), /* getdata(opnd(1) to opnd(n)) */ 22 181 put_list_trans initial("100000011"b), /* putlist(opnd(2) with desc(opnd(1))) */ 22 182 put_edit_trans initial("100000100"b), /* putedit(opnd(2) with desc(opnd(1))) */ 22 183 put_data_trans initial("100000101"b), /* putdata(opnd(2)) with subscript-list opnd(1) */ 22 184 terminate_trans initial("100000110"b), /* terminate stream transmission */ 22 185 stream_prep initial("100000111"b), /* initiate stream transmission */ 22 186 record_io initial("100001000"b), /* perform record io operation */ 22 187 fortran_read initial("100001001"b), /* A complete read statement */ 22 188 fortran_write initial("100001010"b), /* A complete write statement */ 22 189 ftn_file_manip initial("100001011"b), /* endfile,backspace,rewind,etc. */ 22 190 ftn_trans_loop initial("100001100"b), /* An implied do in i/o list */ 22 191 put_control initial("100001101"b), /* put control opnd(1) opnd(2) times */ 22 192 put_field initial("100001110"b), /* putlist(opnd(2)) of length(opnd(1)) */ 22 193 put_field_chk initial("100001111"b), /* putlist(op(2)) of len(op(1)) check char index(op(3)) */ 22 194 22 195 /* These operators are produced by the parse but are not used as input to the code generator. */ 22 196 /* They are processed by the semantic translator. */ 22 197 22 198 return_value initial("100010010"b), /* return(opnd(1)) */ 22 199 allot_var initial("100010011"b), /* allot opnd(1) in opnd(2) */ 22 200 free_var initial("100010100"b), /* free opnd(1) out of opnd(2) */ 22 201 get_file initial("100010101"b), /* opnd(1) is filename,opnd(2) is copy */ 22 202 /* opnd(3) is skip, opnd(4) is list */ 22 203 get_string initial("100010110"b), /* opnd(1) is string,opnd(2) is list */ 22 204 put_file initial("100010111"b), /* opnd(1) is filename,opnd(2) is page */ 22 205 /* opnd(3) is skip,opnd(4) is line */ 22 206 put_string initial("100011000"b), /* opnd(1) is string,opnd(2) is list */ 22 207 open_file initial("100011001"b), 22 208 close_file initial("100011010"b), 22 209 read_file initial("100011011"b), 22 210 write_file initial("100011100"b), 22 211 locate_file initial("100011101"b), 22 212 do_fun initial("100011110"b), /* opnd(1) is join of a list */ 22 213 /* opnd(2) is control variable ref */ 22 214 /* opnd(3) is specification operator */ 22 215 do_spec initial("100011111"b), /* opnd(1) to opnd(2) by opnd(3) */ 22 216 /* repeat opnd(4) while opnd(5) */ 22 217 /* opnd(6) is next specification */ 22 218 22 219 rewrite_file initial("100100000"b), 22 220 delete_file initial("100100001"b), 22 221 unlock_file initial("100100010"b), 22 222 lock_file initial("100100011"b), 22 223 refer initial("100100101"b), /* opnd(1) refer(opnd(2)) */ 22 224 prefix_plus initial("100100110"b), /* opnd(1) <- +opnd(2) */ 22 225 nop initial("100100111"b), /* no-op */ 22 226 assign_by_name initial("100101000"b), /* opnd(1) <- opnd(2),by name */ 22 227 22 228 /* These operators are produced by the semantic translator in processing the math 22 229* builtin functions and are used as input to the code generator */ 22 230 22 231 sqrt_fun initial("100110000"b), /* opnd(1) <- sqrt(opnd(2)) */ 22 232 sin_fun initial("100110001"b), /* opnd(1) <- sin(opnd(2)) */ 22 233 sind_fun initial("100110010"b), /* opnd(1) <- sind(opnd(2)) */ 22 234 cos_fun initial("100110011"b), /* opnd(1) <- cos(opnd(2)) */ 22 235 cosd_fun initial("100110100"b), /* opnd(1) <- cosd(opnd(2)) */ 22 236 tan_fun initial("100110101"b), /* opnd(1) <- tan(opnd(2)) */ 22 237 tand_fun initial("100110110"b), /* opnd(1) <- tand(opnd(2)) */ 22 238 asin_fun initial("100110111"b), /* opnd(1) <- asin(opnd(2)) */ 22 239 asind_fun initial("100111000"b), /* opnd(1) <- asind(opnd(2)) */ 22 240 acos_fun initial("100111001"b), /* opnd(1) <- acos(opnd(2)) */ 22 241 acosd_fun initial("100111010"b), /* opnd(1) <- acosd(opnd(2)) */ 22 242 atan_fun initial("100111011"b), /* opnd(1) <- atan(opnd(2)[,opnd(3)]) */ 22 243 atand_fun initial("100111100"b), /* opnd(1) <- atand(opnd(2)[,opnd(3)]) */ 22 244 log2_fun initial("100111101"b), /* opnd(1) <- log2(opnd(2)) */ 22 245 log_fun initial("100111110"b), /* opnd(1) <- log(opnd(2)) */ 22 246 log10_fun initial("100111111"b), /* opnd(1) <- log10(opnd(2)) */ 22 247 22 248 exp_fun initial("101000000"b)) /* opnd(1) <- exp(opnd(2)) */ 22 249 22 250 bit(9) aligned internal static options(constant); 22 251 22 252 /* END INCLUDE FILE ... op_codes.incl.pl1 */ 2265 2266 23 1 /* statement types */ 23 2 23 3 dcl ( unknown_statement initial("000000000"b), 23 4 allocate_statement initial("000000001"b), 23 5 assignment_statement initial("000000010"b), 23 6 begin_statement initial("000000011"b), 23 7 call_statement initial("000000100"b), 23 8 close_statement initial("000000101"b), 23 9 declare_statement initial("000000110"b), 23 10 lock_statement initial("000000111"b), 23 11 delete_statement initial("000001000"b), 23 12 display_statement initial("000001001"b), 23 13 do_statement initial("000001010"b), 23 14 else_clause initial("000001011"b), 23 15 end_statement initial("000001100"b), 23 16 entry_statement initial("000001101"b), 23 17 exit_statement initial("000001110"b), 23 18 format_statement initial("000001111"b), 23 19 free_statement initial("000010000"b), 23 20 get_statement initial("000010001"b), 23 21 goto_statement initial("000010010"b), 23 22 if_statement initial("000010011"b), 23 23 locate_statement initial("000010100"b), 23 24 null_statement initial("000010101"b), 23 25 on_statement initial("000010110"b), 23 26 open_statement initial("000010111"b), 23 27 procedure_statement initial("000011000"b), 23 28 put_statement initial("000011001"b), 23 29 read_statement initial("000011010"b), 23 30 return_statement initial("000011011"b), 23 31 revert_statement initial("000011100"b), 23 32 rewrite_statement initial("000011101"b), 23 33 signal_statement initial("000011110"b), 23 34 stop_statement initial("000011111"b), 23 35 system_on_unit initial("000100000"b), 23 36 unlock_statement initial("000100001"b), 23 37 wait_statement initial("000100010"b), 23 38 write_statement initial("000100011"b), 23 39 default_statement initial("000100100"b), 23 40 continue_statement initial("000100101"b)) bit(9) internal static aligned options(constant); 2267 2268 24 1 /* BEGIN INCLUDE FILE ... nodes.incl.pl1 */ 24 2 24 3 /* Modified: 26 Dec 1979 by PCK to implement by name assignment */ 24 4 24 5 dcl ( block_node initial("000000001"b), 24 6 statement_node initial("000000010"b), 24 7 operator_node initial("000000011"b), 24 8 reference_node initial("000000100"b), 24 9 token_node initial("000000101"b), 24 10 symbol_node initial("000000110"b), 24 11 context_node initial("000000111"b), 24 12 array_node initial("000001000"b), 24 13 bound_node initial("000001001"b), 24 14 format_value_node initial("000001010"b), 24 15 list_node initial("000001011"b), 24 16 default_node initial("000001100"b), 24 17 machine_state_node initial("000001101"b), 24 18 source_node initial("000001110"b), 24 19 label_node initial("000001111"b), 24 20 cross_reference_node initial("000010000"b), 24 21 sf_par_node initial("000010001"b), 24 22 temporary_node initial("000010010"b), 24 23 label_array_element_node initial("000010011"b), 24 24 by_name_agg_node initial("000010100"b)) 24 25 bit(9) internal static aligned options(constant); 24 26 24 27 dcl 1 node based aligned, 24 28 2 type unal bit(9), 24 29 2 source_id unal structure, 24 30 3 file_number bit(8), 24 31 3 line_number bit(14), 24 32 3 statement_number bit(5); 24 33 24 34 /* END INCLUDE FILE ... nodes.incl.pl1 */ 2269 2270 25 1 /* BEGIN INCLUDE FILE ... system.incl.pl1 */ 25 2 25 3 /* Modified: 25 Apr 1979 by PCK to implemnt 4-bit decimal */ 25 4 25 5 dcl ( max_p_flt_bin_1 initial(27), 25 6 max_p_flt_bin_2 initial(63), 25 7 max_p_fix_bin_1 initial(35), 25 8 max_p_fix_bin_2 initial(71), 25 9 25 10 max_p_dec initial(59), 25 11 max_p_bin_or_dec initial (71), /* max (max_p_fix_bin_2, max_p_dec) */ 25 12 25 13 min_scale initial(-128), 25 14 max_scale initial(+127), 25 15 max_bit_string initial(9437184), 25 16 max_char_string initial(1048576), 25 17 max_area_size initial(262144), 25 18 min_area_size initial(28), 25 19 25 20 max_bit_string_constant initial (253), /* max length of bit literals */ 25 21 max_char_string_constant initial (254), /* max length of character literals */ 25 22 max_identifier_length initial (256), 25 23 max_number_of_dimensions initial (127), 25 24 25 25 max_length_precision initial(24), 25 26 max_offset_precision initial(24), /* 18 bits for word offset + 6 bits for bit offset */ 25 27 25 28 max_words_per_variable initial (262144), 25 29 25 30 bits_per_word initial(36), 25 31 bits_per_double initial(72), 25 32 packed_digits_per_character initial(2), 25 33 characters_per_half initial(2), 25 34 characters_per_word initial(4), 25 35 characters_per_double initial(8), 25 36 25 37 bits_per_character initial(9), 25 38 bits_per_half initial(18), 25 39 bits_per_decimal_digit initial(9), 25 40 bits_per_binary_exponent initial(8), 25 41 bits_per_packed_ptr initial(36), 25 42 words_per_packed_pointer initial(1), 25 43 25 44 words_per_fix_bin_1 initial(1), 25 45 words_per_fix_bin_2 initial(2), 25 46 words_per_flt_bin_1 initial(1), 25 47 words_per_flt_bin_2 initial(2), 25 48 words_per_varying_string_header initial(1), 25 49 words_per_offset initial(1), 25 50 words_per_pointer initial(2), 25 51 words_per_label_var initial(4), 25 52 words_per_entry_var initial(4), 25 53 words_per_file_var initial(4), 25 54 words_per_format initial(4), 25 55 words_per_condition_var initial(6), 25 56 25 57 max_index_register_value initial(262143), 25 58 max_signed_index_register_value initial(131071), 25 59 25 60 max_signed_xreg_precision initial(17), 25 61 max_uns_xreg_precision initial(18), 25 62 25 63 default_area_size initial(1024), 25 64 default_flt_bin_p initial(27), 25 65 default_fix_bin_p initial(17), 25 66 default_flt_dec_p initial(10), 25 67 default_fix_dec_p initial(7)) fixed bin(31) internal static options(constant); 25 68 25 69 dcl bits_per_digit initial(4.5) fixed bin(31,1) internal static options(constant); 25 70 25 71 dcl ( integer_type initial("010000000000000000000100000001100000"b), 25 72 dec_integer_type initial("010000000000000000000100000010100000"b), 25 73 pointer_type initial("000001000000000000000100000000000000"b), 25 74 real_type initial("001000000000000000000100000001100000"b), 25 75 complex_type initial("001000000000000000000100000001010000"b), 25 76 builtin_type initial("000000000000000010000000000000000000"b), 25 77 storage_block_type initial("000000000000100000000000000000000000"b), 25 78 arg_desc_type initial("000000000001000000000000000000000000"b), 25 79 local_label_var_type initial("000000001000000000000100000100001000"b), 25 80 entry_var_type initial("000000000100000000000000000000001000"b), 25 81 bit_type initial("000100000000000000000000000000000000"b), 25 82 char_type initial("000010000000000000000000000000000000"b)) bit(36) aligned int static 25 83 options(constant); 25 84 25 85 /* END INCLUDE FILE ... system.incl.pl1 */ 2271 2272 26 1 /* BEGIN INCLUDE FILE ... token.incl.pl1 */ 26 2 26 3 dcl 1 token based aligned, 26 4 2 node_type bit(9) unaligned, 26 5 2 type bit(9) unaligned, 26 6 2 loc bit(18) unaligned, /* symtab offset for identifiers, "p" flag for constants */ 26 7 2 declaration ptr unaligned, 26 8 2 next ptr unaligned, 26 9 2 size fixed(9), 26 10 2 string char(n refer(token.size)); 26 11 26 12 /* END INCLUDE FILE ... token.incl.pl1 */ 2273 2274 27 1 /* BEGIN INCLUDE FILE ... token_types.incl.pl1 */ 27 2 27 3 dcl ( no_token initial("000000000"b), /* token types */ 27 4 identifier initial("100000000"b), 27 5 isub initial("010000000"b), 27 6 plus initial("001000001"b), 27 7 minus initial("001000010"b), 27 8 asterisk initial("001000011"b), 27 9 slash initial("001000100"b), 27 10 expon initial("001000101"b), 27 11 not initial("001000110"b), 27 12 and initial("001000111"b), 27 13 or initial("001001000"b), 27 14 cat initial("001001001"b), 27 15 eq initial("001001010"b), 27 16 ne initial("001001011"b), 27 17 lt initial("001001100"b), 27 18 gt initial("001001101"b), 27 19 le initial("001001110"b), 27 20 ge initial("001001111"b), 27 21 ngt initial("001010000"b), 27 22 nlt initial("001010001"b), 27 23 assignment initial("001010010"b), 27 24 colon initial("001010011"b), 27 25 semi_colon initial("001010100"b), 27 26 comma initial("001010101"b), 27 27 period initial("001010110"b), 27 28 arrow initial("001010111"b), 27 29 left_parn initial("001011000"b), 27 30 right_parn initial("001011001"b), 27 31 percent initial("001011100"b), 27 32 bit_string initial("000100001"b), 27 33 char_string initial("000100010"b), 27 34 bin_integer initial("000110001"b), 27 35 dec_integer initial("000110011"b), 27 36 fixed_bin initial("000110000"b), 27 37 fixed_dec initial("000110010"b), 27 38 float_bin initial("000110100"b), 27 39 float_dec initial("000110110"b), 27 40 i_bin_integer initial("000111001"b), 27 41 i_dec_integer initial("000111011"b), 27 42 i_fixed_bin initial("000111000"b), 27 43 i_fixed_dec initial("000111010"b), 27 44 i_float_bin initial("000111100"b), 27 45 i_float_dec initial("000111110"b)) bit (9) aligned internal static options (constant); 27 46 27 47 dcl ( is_identifier initial ("100000000"b), /* token type masks */ 27 48 is_isub initial ("010000000"b), 27 49 is_delimiter initial ("001000000"b), 27 50 is_constant initial ("000100000"b), 27 51 is_arith_constant initial ("000010000"b), /* N.B. not really a mask...s/b "000110000"b */ 27 52 is_arithmetic_constant initial ("000110000"b), 27 53 is_imaginary_constant initial ("000111000"b), 27 54 is_float_constant initial ("000110100"b), 27 55 is_decimal_constant initial ("000110010"b), 27 56 is_integral_constant initial ("000110001"b) 27 57 ) bit(9) internal static aligned options(constant); 27 58 27 59 /* END INCLUDE FILE ... token_types.incl.pl1 */ 2275 2276 28 1 /* BEGIN INCLUDE FILE ... declare_type.incl.pl1 */ 28 2 28 3 /* Modified: 25 Apr 1979 by PCK to implement 4-bit decimal */ 28 4 28 5 dcl ( by_declare initial("001"b), 28 6 by_explicit_context initial("010"b), 28 7 by_context initial("011"b), 28 8 by_implication initial("100"b), 28 9 by_compiler initial("101"b)) int static bit(3) aligned options(constant); 28 10 28 11 /* END INCLUDE FILE ... declare_type.incl.pl1 */ 2277 2278 29 1 /* BEGIN INCLUDE FILE ... decoded_token_types.incl.pl1 */ 29 2 29 3 /* This array maps token types into declaration types suitable 29 4* for passing to convert. */ 29 5 29 6 dcl decoded_type(33:62) bit(36) aligned int static options(constant) init 29 7 ( "000100000000000000000000000000000000"b, /* bit_string */ 29 8 "000010000000000000000000000000000000"b, /* char_string */ 29 9 (13) (36) "0"b, 29 10 "010000000000000000000101000001100000"b, /* fixed_bin */ 29 11 "010000000000000000000101000001100000"b, /* bin_integer */ 29 12 "010000000000000000000101000010100000"b, /* fixed_dec */ 29 13 "010000000000000000000101000001100000"b, /* dec_integer */ 29 14 "001000000000000000000101000001100000"b, /* float_bin */ 29 15 "0"b, 29 16 "001000000000000000000101000010100000"b, /* float_dec */ 29 17 "0"b, 29 18 "010000000000000000000101000001010000"b, /* i_fixed_bin */ 29 19 "010000000000000000000101000001010000"b, /* i_bin_integer */ 29 20 "010000000000000000000101000010010000"b, /* i_fixed_dec */ 29 21 "010000000000000000000101000010010000"b, /* i_dec_integer */ 29 22 "001000000000000000000101000001010000"b, /* i_float_bin */ 29 23 "0"b, 29 24 "001000000000000000000101000010010000"b); /* i_float_dec */ 29 25 29 26 /* END INCLUDE FILE ... decoded_token_types.incl.pl1 */ 2279 2280 30 1 dcl jump_complement(2:9) bit(9) aligned static options(constant) 30 2 init("001010011"b, /* jump_true -> jump_false */ 30 3 "001010010"b, /* jump_false -> jump_true */ 30 4 "001011001"b, /* jump_if_lt -> jump_if_ge */ 30 5 "001011000"b, /* jump_if_gt -> jump_if_le */ 30 6 "001010111"b, /* jump_if_eq -> jump_if_ne */ 30 7 "001010110"b, /* jump_if_ne -> jump_if_eq */ 30 8 "001010101"b, /* jump_if_le -> jump_if_gt */ 30 9 "001010100"b); /* jump_if_ge -> jump_if_lt */ 2281 2282 31 1 /* BEGIN INCLUDE FILE ... pl1_descriptor.incl.pl1 */ 31 2 31 3 /* Declaration of PL/I arg descriptor seen as an array of structures of bits */ 31 4 31 5 dcl 1 descriptor(0:k) based aligned, 31 6 2 bit_type unaligned, 31 7 3 flag bit(1) unaligned, 31 8 3 type bit(6) unaligned, 31 9 3 packed bit(1) unaligned, 31 10 3 number_dims bit(4) unaligned, 31 11 2 size bit(24) unaligned; 31 12 31 13 /* END INCLUDE FILE ... pl1_descriptor.incl.pl1 */ 2283 2284 2285 end operator_semantics; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 09/22/89 1359.7 operator_semantics.pl1 >spec>install>1073>operator_semantics.pl1 2235 1 08/13/81 2043.5 condition_name.incl.pl1 >ldd>include>condition_name.incl.pl1 2237 2 07/21/80 1546.3 semant.incl.pl1 >ldd>include>semant.incl.pl1 2-228 3 08/01/89 1239.9 language_utility.incl.pl1 >ldd>include>language_utility.incl.pl1 3-307 4 05/06/74 1746.9 source_id_descriptor.incl.pl1 >ldd>include>source_id_descriptor.incl.pl1 3-325 5 05/06/74 1746.9 source_id_descriptor.incl.pl1 >ldd>include>source_id_descriptor.incl.pl1 3-335 6 05/06/74 1746.9 source_id_descriptor.incl.pl1 >ldd>include>source_id_descriptor.incl.pl1 3-374 7 05/06/74 1746.9 source_id_descriptor.incl.pl1 >ldd>include>source_id_descriptor.incl.pl1 3-386 8 05/06/74 1746.9 source_id_descriptor.incl.pl1 >ldd>include>source_id_descriptor.incl.pl1 2239 9 05/06/74 1741.6 array.incl.pl1 >ldd>include>array.incl.pl1 2241 10 12/07/83 1701.7 symbol.incl.pl1 >ldd>include>symbol.incl.pl1 2243 11 12/07/83 1700.1 pl1_symbol_type.incl.pl1 >ldd>include>pl1_symbol_type.incl.pl1 2245 12 07/21/80 1546.3 symbol_bits.incl.pl1 >ldd>include>symbol_bits.incl.pl1 2247 13 07/21/80 1546.3 operator.incl.pl1 >ldd>include>operator.incl.pl1 2249 14 11/30/78 1227.5 mask.incl.pl1 >ldd>include>mask.incl.pl1 2251 15 05/06/74 1742.1 label.incl.pl1 >ldd>include>label.incl.pl1 2253 16 08/13/81 2211.5 list.incl.pl1 >ldd>include>list.incl.pl1 2255 17 08/13/81 2043.5 block.incl.pl1 >ldd>include>block.incl.pl1 2257 18 05/03/76 1320.8 block_types.incl.pl1 >ldd>include>block_types.incl.pl1 2259 19 04/07/83 1635.0 statement.incl.pl1 >ldd>include>statement.incl.pl1 2261 20 07/21/80 1546.3 reference.incl.pl1 >ldd>include>reference.incl.pl1 2263 21 07/21/80 1546.3 semantic_bits.incl.pl1 >ldd>include>semantic_bits.incl.pl1 2265 22 04/07/83 1635.0 op_codes.incl.pl1 >ldd>include>op_codes.incl.pl1 2267 23 05/03/76 1320.4 statement_types.incl.pl1 >ldd>include>statement_types.incl.pl1 2269 24 07/21/80 1546.3 nodes.incl.pl1 >ldd>include>nodes.incl.pl1 2271 25 12/07/83 1701.7 system.incl.pl1 >ldd>include>system.incl.pl1 2273 26 09/14/77 1705.7 token.incl.pl1 >ldd>include>token.incl.pl1 2275 27 11/30/78 1227.4 token_types.incl.pl1 >ldd>include>token_types.incl.pl1 2277 28 10/25/79 1645.8 declare_type.incl.pl1 >ldd>include>declare_type.incl.pl1 2279 29 11/30/78 1227.5 decoded_token_types.incl.pl1 >ldd>include>decoded_token_types.incl.pl1 2281 30 05/03/76 1320.4 jump_complement.incl.pl1 >ldd>include>jump_complement.incl.pl1 2283 31 09/14/77 1705.7 pl1_descriptor.incl.pl1 >ldd>include>pl1_descriptor.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. FALSE constant bit(1) initial packed unaligned dcl 117 ref 368 584 597 653 693 774 800 824 851 946 1007 1034 1099 1311 1362 1419 1528 1622 1756 1847 1862 RHS_aggregate 0(06) based bit(1) level 2 packed packed unaligned dcl 21-27 set ref 1422* TRUE constant bit(1) initial packed unaligned dcl 116 ref 373 468 585 686 706 826 857 1012 1098 1111 1151 1309 1342 1353 1421 1492 1494 1519 1551 1615 1734 1755 1806 1813 1849 1864 2035 2070 2105 2206 a 000100 automatic pointer dcl 51 in procedure "operator_semantics" set ref 143* 717 726 726 739 763 763 765 767* 770 772 774 774 774 777 778 779 780 783 784 785 786 793 794 795 798 799 800 802* 804 804 808 808 811 812 813 816 818 824 825 826 835 835 869 870 872 877 879 879 903 908 909 910 913* 918 918 918 918 944 945 950 952 953 954 956 961 961 976 976 1042 1047 1047 1048 1059 1060* 1107 1147 1149 1151 1239* 1242 1243 1244 1250 1253 1267* 1275 1333* 1334 1334 1361* 1361 1361* 1363 1385 1402 1409 1559* 1617 2010* 2012 2013 2013* 2013 2016 2016 2019 2022 2023* 2023 2024 2024 2030 2037* a parameter pointer dcl 1776 in procedure "make" ref 1771 1792 1796 abs builtin function dcl 112 ref 609 action_index 000250 constant fixed bin(15,0) initial array dcl 119 ref 153 add constant bit(9) initial dcl 22-8 ref 232 263 689 973 addr builtin function dcl 112 ref 835 869 970 1028 1421 1422 1468 addr_fun 000111 constant bit(9) initial dcl 22-8 set ref 730 1120* adjust_count 000046 constant entry external dcl 3-20 ref 1016 after_ret 000102 automatic pointer dcl 51 set ref 1354* 1587 1587 1589 aggregate based bit(1) level 2 packed packed unaligned dcl 21-8 ref 1468 aligned 31(21) based bit(1) level 4 packed packed unaligned dcl 10-3 ref 990 aligned_mask constant bit(36) initial dcl 14-3 ref 231 249 262 280 322 1923 1925 1928 1930 1968 1989 alloc_semantics 000024 constant entry external dcl 2-7 ref 1687 allocated 1(18) based bit(1) level 2 packed packed unaligned dcl 10-3 ref 1250 allot_var constant bit(9) initial dcl 22-8 ref 1068 area 0(07) 000237 automatic bit(1) level 2 in structure "btype" packed packed unaligned dcl 106 in procedure "operator_semantics" set ref 1843 area 0(07) 000236 automatic bit(1) level 2 in structure "atype" packed packed unaligned dcl 105 in procedure "operator_semantics" set ref 872 877 1116 area 0(07) 000240 automatic bit(1) level 2 in structure "ctype" packed packed unaligned dcl 107 in procedure "operator_semantics" set ref 1843 arg_descriptor 0(11) 000237 automatic bit(1) level 2 in structure "btype" packed packed unaligned dcl 106 in procedure "operator_semantics" set ref 2065 arg_descriptor 0(11) 000236 automatic bit(1) level 2 in structure "atype" packed packed unaligned dcl 105 in procedure "operator_semantics" set ref 2030 arg_descriptor 0(11) 000240 automatic bit(1) level 2 in structure "ctype" packed packed unaligned dcl 107 in procedure "operator_semantics" set ref 2100 arg_list 0(01) based bit(1) level 2 packed packed unaligned dcl 21-8 ref 869 1028 arithmetic_mask 000132 constant bit(36) initial dcl 14-41 ref 1968 1989 array based structure level 1 dcl 9-1 in procedure "operator_semantics" array 12 based pointer level 2 in structure "symbol" packed packed unaligned dcl 10-3 in procedure "operator_semantics" ref 776 783 784 785 786 array_ref 0(09) based bit(1) level 2 packed packed unaligned dcl 20-3 set ref 1422 assign 000124 constant bit(9) initial dcl 22-8 set ref 495* 616* 970 1039 1280* 1410* 1474 2030 2032* 2065 2067* 2100 2102* assign_size_ck constant bit(9) initial dcl 22-8 ref 935 1039 assign_zero constant bit(9) initial dcl 22-8 ref 923 assigned_to_entry_var 42(06) based bit(1) level 3 packed packed unaligned dcl 17-5 set ref 1098* assignment_statement 000106 constant bit(9) initial dcl 23-3 set ref 1491* 1782 2135* attributes 31 based structure level 2 dcl 10-3 set ref 407 750 765 770 770 2024 2062 2097 atype 000236 automatic structure level 1 packed packed unaligned dcl 105 set ref 737 739 739 765* 770* 837 837 875 889 889 1706* 1707 1707 2016* 2019* 2024* 2026* 2038* b 000104 automatic pointer dcl 52 in procedure "operator_semantics" set ref 143* 171 183 183 189 226 227 230 257 258 261 292 299 299 305 320 321 328 340 340 346 385* 386 386* 386 388* 388 390 391 403* 404 404* 404 406* 406 407 408 432* 433 433* 433 435* 435 437 485* 486 486* 486 488* 488 489 495* 496 497 498 501* 503* 510 534 569 628 737 739* 742* 745* 747* 750 753* Sieber ~8process_overseer_ >user_dir_dir>Multics>Sieber  R*_LS̝noneSƔ,T>BXɦ @ @Neil ~8process_overseer_ >user_dir_dir>Multics>Neil  SNT]none`T";~T>ypXɦ @ @Mikulecky ~8process_overseer_ >user_dir_dir>Multics>Mikulecky  |GRL~TcCnone`Tוּ|G1"bRLØT> Xɦ @ @Tesan ~8process_overseer_ >user_dir_dir>Multics>Tesan  RM;5 _TnoneTTz_T>Xɦ @ @Fournier ~8process_overseer_ >user_dir_dir>Multics>Fournier   RTG(noneTˮ قA!|%8T>Xɦ @ @Fraser ~8process_overseer_ >user_dir_dir>Multics>Fraser  T{R{W&TVgnone`THT{?Q N`T>ÂXɦ @ @MacDonald ~xprocess_overseer_ >user_dir_dir>Multics>MacDonald  SJxS#noneS|nT>|XɦSysProg @ @Skeet ~8process_overseer_ >user_dir_dir>Multics>Skeet  'SJTٴT.Cınone`T/;'xp[`.LF h 03T>DkXɦ @ @Mayes ~8process_overseer_ >user_dir_dir>Multics>Mayes  lS]0Tp+none`TlڳFS[gT>Xɦ @ @Seaward ~8process_overseer_ >user_dir_dir>Multics>Seaward  xNSfWTnone`T xNdd-șzFO"]@T>ơXɦ @ @Haynes ~8process_overseer_ >user_dir_dir>Multics>Haynes  Sh[TkәnoneTmVT>cXɦ @ @Kam ~8process_overseer_ >user_dir_dir>Multics>Kam  VVS!Td65none`TeVVؒJ0HKZT>jXɦ @ @Radlowsky ~8process_overseer_ >user_dir_dir>Multics>Radlowsky  SsYLT3bnoneT#IvhT>Xɦ @ @Bhatia ~8process_overseer_ >user_dir_dir>Multics>Bhatia  7TT̪TBPrnoneTC* 7NfQx:D84HT> %+Xɦ @ @Bird ~8process_overseer_ >user_dir_dir>Multics>Bird  T%&`TtnoneTzMT>~Xɦ @ @Galea ~8process_overseer_ >user_dir_dir>Multics>Galea  T|6TFnoneT T>PXɦ @ @Lofthouse ~8process_overseer_ >user_dir_dir>Multics>Lofthouse  T|6T}%noneT}=aT>)[SXɦ @ @Phan ~8process_overseer_ >user_dir_dir>Multics>Phan  T|6T}X?noneT~"CT>,GXɦ @ @Y ht02 MacGregor 9Henry :Mikulecky BNLeung SKam OHale Q Elhard Oke WAAnderson Roe 3Maryniuk 0Bhatia ULeung HLofthouse XSMcDonald ;Voth Mallmes Li I Mulhaupt &Post 8Goutier /PANakaska Kittlitz +Koether ?Banijamali KMayes LHaynes NBird VFrere < Gee Polischuk Collin Skeet G Elliott @da rj@=LS&H &zda&daLgzzar,Attendees daRybada*@daEngAdmin da*@daHussein da(Multics dar&daBaTransactions daBc "ada*@da6LT*@da&daBa.Proceedings.1 daBa2Z..ada*@da>*@daTWestcott dabj*@da>jOke daLx*@daTOKE dab*@daCollin dax*@daANeal da*@dajMallmes da>Wright daDickson da*@da(Guest da*@daTTolts da *@da *@daTSiteSA da 6(*@daMSGD da L>*@daPLASTICS da6bT*@daTOBSWE daLxj*@daDEVM dab*@da>NMLPROD dax*@da>STDSPPT da6*@dajDPS-E da*@da|start_up.emacs.lisp S.6P.G2 K$L^a S5$^*S.,P*S.4$*S.<,*S.D4*S.L<z*@S.D^*S.&T6OZ\\^aT@sow_1984 T6P.Ge$z^aRS5^*@Tz*T*T*Tz*@T^*TT&T~?O+^astart_up.ec T~?O.G`H$^a S5^*@T~?*T~?z*@T~?>&T6O\^aXestimating_guidelines T6P- G$6^aHS5^*@T*T&*T.*T6&z*@T.^*T&T6O]FF^a>proj_plan_outline T6P.G`H $d^aWwS5l^*@Ttd*T|l*Tt*T|z*@T^*T>&TwA"^^aisiec_tape.list TwA; GL-$^aYS5^*@Tw*Twz*@Tw&TA"`^ae002697.ta TA;GQ$^a3`S5^*@T*Tz*@TV&UEA"c^akermit.old UEA;iG $6N^a\S5>^*@UEF6*UEN>*UEFz*@UE&U Hzr^^^aVWestcott.mlsys U H  |^a~2rS5*@U |z*@U V&Ut6Ol^aistatus_report_template Ut6P.Gw$^aS5srt Ut^*@Ut*Ut*Ut*Utz*@Ut^*Ut*Ut6&UwA"h^amr11_team_minutes.fw414 UwA;Gw$.^a|XS5&^*@Uw.*Uw&z*@Uw&U%6Os>>^a6kermit U%6P-wGL$\^aS5d^*U%l\*U%td*U%|l*U%tz*U%|^*U%6&U?6Ou^avbk.project_plan.fdocout U?6P.G $^aZS5^*@U?*U?*U?*U?z*@U?^*U? &V6A"q^a\ACTC.mls V6A;G`HC$$ ^aS5^*@Yo *Yoz*@Yob&YWA"ݡ,,^a$nasa.mail YWA;G`H T$JZ^aS5R^*@YWZJ*YWRz*@YW$&Ya6Ojj^abmr11_summary Ya6P.hGQ w$^a&AS5^*@Ya*Ya*Ya*Yaz*@Ya^*Yab&YA"ݢ^aeducation.mail YA; Gw $^aS5^*@Y*Yz*@Y4&Z"A"ݥ^awindow.h Z"A;qGQ$,^afS5$^*@Z",*Z"$z*@Z"r&Z"7A"ݪ<<^a4status_reports.fw448 Z"7A;<G $Zj^a S5b^*@Z"7jZ*Z"7bz*@Z"74&ZbA"ݰzz^arKjan_bad_boys.mls ZbA;YG $^azS5^*Zb*Zbz*@Zbr&[C6O^a/fiscal_week [C6P-%GQ$^aPS5^*[C*[C*[C*[Cz*@[C^*[C*[CL&[kA"ݷ^a01/30/85.audit [kA;G$4D^aטS5<^*@[kD4*[k<z*@[k&[6OTT^aLenter [6P-G=$r^a_S5z^*@[r*[z*[*[z*@[^*[L&[A"ݺ^aenter.ds [A;G$^a S5^*@[*[z*@[&[A"ݼ^a/enter.ds1 [A;G 7$^a6S5^*@[*[z*@[\&[)LA"ݿ&&^artincl.h [)LA;G2 $DT^a*S5L^*@[)LTD*[)LLz*@[)L&[)A"dd^a\ field_trial1.mail [)A;*GQ $^aD7S5^*@[)*[)z*@[)\&[8_6O^astuff [8_6P.G2 @$^adS5^*@[8_*[8_*[8_*[8_z*@[8_^*[8_.&[8A"^afeb_bp.mls 206 219 364 450 458 1882 1928 float 31(02) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 10-3 in procedure "operator_semantics" set ref 468* float 0(02) 000237 automatic bit(1) level 2 in structure "btype" packed packed unaligned dcl 106 in procedure "operator_semantics" set ref 204 221 310 362 547 1886 1930 float_dec_target 000230 automatic pointer dcl 92 set ref 467* 468 468 468 468 470 472* 474* 474 492* 496 float_decimal_complex_mask 000126 constant bit(36) initial dcl 14-41 ref 183 193 299 340 351 1894 1910 float_decimal_real_mask 000130 constant bit(36) initial dcl 14-41 ref 189 199 305 346 357 1899 1915 float_mask constant bit(36) initial dcl 14-3 ref 219 221 249 280 382 420 421 448 452 458 463 568 1928 1930 flush_at_call 24(24) based bit(1) level 2 packed packed unaligned dcl 17-5 set ref 1111* 1734* free_node 000114 constant entry external dcl 3-345 ref 1507 function 000040 constant entry external dcl 2-125 ref 1211 general 16 based pointer level 2 packed packed unaligned dcl 10-3 set ref 813* 813 909* 909 1059* 1065* 1738 generated 13(02) based bit(1) level 3 packed packed unaligned dcl 19-9 set ref 1342* 1492* 1806* get_size 000116 constant entry external dcl 3-352 ref 802 goto_statement 000125 constant bit(9) initial dcl 23-3 set ref 1221* 1560* 1567 1785 hold_abort_label 000232 automatic label variable dcl 93 set ref 1357* 1619 i 000274 automatic fixed bin(15,0) dcl 1827 in procedure "convert_relationals" set ref 1857* 1858 1858 i 000173 automatic fixed bin(31,0) dcl 74 in procedure "operator_semantics" set ref 643* 644 644 646 650 651 651 652 652 653 656 657 660 660 662 662 662 664 664* 1119* 1120 1121 1122 1122* 1236* 1237 1239 1241 1242 1244 1245 1245 1251 1251* 1251* 1253 1253* 1253* 1271* 1278* 1278 1280* 1280* 1287 1346* 1367* 1367* 1610* 1610 1631* 1633 1633* 1644* 1646 1646* 1695* 1697* 1710* 1711 1711* 1741* 1742 1743 1743* 1743 1745* identifier 000750 constant bit(9) initial dcl 27-3 set ref 1515* if_statement constant bit(9) initial dcl 23-3 ref 1783 index builtin function dcl 112 ref 1938 1938 1941 initial 11 based pointer level 2 packed packed unaligned dcl 10-3 ref 853 853 918 1739 2226 2228 initial_value 000344 automatic fixed bin(71,0) dcl 2224 set ref 2226* 2228* 2231 initialed 31(20) based bit(1) level 4 packed packed unaligned dcl 10-3 set ref 774* input_tree parameter pointer dcl 47 ref 41 132 850 integer based fixed bin(15,0) dcl 89 ref 918 integer_1 based fixed bin(35,0) dcl 2222 ref 2228 integer_2 based fixed bin(71,0) dcl 2223 ref 2226 integer_type 000102 constant bit(36) initial dcl 25-71 set ref 175 177 295 335 337 703* 957* 1633* 1636 1646* 1654 1697* 1711* 2033* 2038 2068* 2073 2103* 2108 2200* internal 32(01) based bit(1) level 4 packed packed unaligned dcl 10-3 ref 1107 io_semantics 000042 constant entry external dcl 2-148 ref 1670 irreducible 31(34) based bit(1) level 4 packed packed unaligned dcl 10-3 set ref 584* jump 000122 constant bit(9) initial dcl 22-8 set ref 1156 1189* 1222* 1561* 1785 jump_complement 000027 constant bit(9) initial array dcl 30-1 ref 1187 jump_false constant bit(9) initial dcl 22-8 ref 1157 1161 jump_if_eq constant bit(9) initial dcl 22-8 ref 1941 jump_if_ne 000121 constant bit(9) initial dcl 22-8 set ref 1367* 1783 1941 jump_stmnt 000126 automatic pointer dcl 58 set ref 1347* 1369 1370* 1559 1566 1567 1567 1587 1589 1593 1601 1605* jump_true constant bit(9) initial dcl 22-8 ref 1161 k 000167 automatic fixed bin(15,0) dcl 73 set ref 146* 632 643 1206* 1236 1631 1644 1959 1980 2009 2044 2051 2079 label 0(08) 000240 automatic bit(1) level 2 in structure "ctype" packed packed unaligned dcl 107 in procedure "operator_semantics" set ref 1832 label based structure level 1 dcl 15-1 in procedure "operator_semantics" label 0(08) 000236 automatic bit(1) level 2 in structure "atype" packed packed unaligned dcl 105 in procedure "operator_semantics" set ref 1153 label 0(08) 000237 automatic bit(1) level 2 in structure "btype" packed packed unaligned dcl 106 in procedure "operator_semantics" set ref 1839 label_attached 000216 automatic bit(1) dcl 84 set ref 1528* 1539 1551* label_mask constant bit(36) initial dcl 14-3 ref 765 label_node constant bit(9) initial dcl 24-5 ref 171 171 292 328 328 628 632 717 764 1147 1177 1719 1726 1829 1829 1836 1836 2019 2057 2092 labels 4 based pointer level 2 in structure "statement" packed packed unaligned dcl 19-9 in procedure "operator_semantics" set ref 1267 1320 1544* labels 000256 automatic pointer dcl 1778 in procedure "make" set ref 1781* 1792* 1804* 1808 1810 last 000124 automatic pointer dcl 57 set ref 1378* 1505 1510 1511 1511 last_jump 000130 automatic pointer dcl 59 set ref 1369* 1586 length 6 based pointer level 2 in structure "reference" packed packed unaligned dcl 20-3 in procedure "operator_semantics" set ref 657 739 794 795 799* 799 804* 808 845 847 898 898 957* 1016 1016 1244* 1245* 1245 2148 2148 2179 2179* 2179 length 000132 automatic pointer array dcl 60 in procedure "operator_semantics" set ref 143* 143* 651* 652 652 653 657* 660 662 662 664 670* 674 674 674* 677 677 677* 680 693 693 693* 693* 704* 705* 708* length_fun 000112 constant bit(9) initial dcl 22-8 set ref 2199* list based structure level 1 dcl 16-6 m 000174 automatic fixed bin(31,0) dcl 74 set ref 142* 233* 238* 243* 244 250* 264* 269* 274* 275 281* 320* 395* 399* 402 402 409* 439* 489* 512 514* 522* 528* 530 547 552 558 569* 570* 576* 582* 603* 608* 608 612* 612 617* 669* 680* 683* 877* 900* 903* 906* 1141* 1637* 1656* 1764* m_set 000214 automatic bit(1) dcl 82 set ref 368* 373* 484 make_desc 000123 constant bit(9) initial dcl 22-8 set ref 856* 2030 2065 2100 make_operator 000217 au [8A;'GLf$&^aS5^*[8&*[8z*@[8&[6O66^a.termcap [6P.GL$T|^aOWS5\^*@[dT*[l\*[td*[|lz*@[t^*[.&\A"^a2mar_bp.mls \A;GL$^aS5^*\*\z*@\&\6O^a example \6P- Gw ~$^afS5^*@\*\*\*\z*@\^*\V&\A"  ^aAexample2.hitout \A;GL$>N^aS5F^*@\N>*\Fz*@\&\6O^^^aVexample3 \6P-G`H$|^aS5^*@\|*\*\*\z*@\^*\V&\A"^axseries.mail \A;G$^aS5^*@\*\z*@\ (&\A"^apacket_sup.hitmile \A;>Gw$  ^aaS5 ^*@\ *\ z*@\ n&]!/A" 0 0^a (sched.ncc ]!/A;GLo$ N f^a>LS5 V^*@]!/ ^ N*]!/ f Vz*@]!/ ^*]!/ (&]"(6O v v^a nworkstation ]"(6P.G$ ^aSS5 ^*@]"( *]"( *]"( *]"( z*@]"( ^*]"(  n&]/A" ^a Vpcmilestones.foo ]/A;pG$ ^amS5 ^*@]/ *]/ z*@]/ @ &]uA" ^a &may_bp.mls ]uA;G`H$ ( 8^aS5 0^*]u 8 (*]u 0z*@]u ~ &]A" H H^a @'READ.ME ]A;Gw $ f v^a3S5 n^*@] v f*] nz*@] @&])A" ^a ~xfer.info ])A;GL$ ^a%S5 ^*@]) *]) z*@]) *])  ~&]H"A" ^a ptms.mail ]H"A;G $ ^a>S5 ^*@]H" *]H" z*@ 000107 constant bit(9) initial dcl 22-8 set ref 1746* not_bits constant bit(9) initial dcl 22-8 ref 668 1167 not_equal constant bit(9) initial dcl 22-8 ref 1941 null builtin function dcl 112 ref 134 143 159 159 171 171 204 204 206 206 292 292 310 310 328 328 362 362 364 364 467 467 576 576 582 582 588 588 617 617 628 628 632 632 660 674 674 677 677 680 703 703 717 717 726 726 730 730 739 739 776 795 808 835 845 879 886 886 898 952 1016 1060 1066 1096 1107 1121 1121 1129 1129 1149 1149 1153 1153 1167 1167 1178 1178 1185 1185 1189 1189 1189 1189 1190 1190 1190 1190 1209 1209 1221 1221 1225 1225 1243 1266 1267 1267 1274 1280 1280 1293 1293 1293 1293 1293 1293 1303 1320 1327 1334 1334 1334 1334 1338 1338 1344 1347 1349 1349 1355 1361 1363 1366 1366 1372 1385 1385 1387 1387 1387 1387 1387 1387 1393 1393 1402 1426 1426 1439 1446 1459 1459 1462 1462 1462 1462 1462 1462 1468 1468 1482 1482 1482 1482 1491 1491 1497 1497 1497 1497 1497 1497 1511 1514 1517 1525 1525 1536 1536 1536 1536 1536 1536 1541 1541 1559 1559 1560 1560 1587 1605 1613 1614 1614 1614 1614 1680 1697 1697 1719 1719 1726 1726 1726 1732 1781 1808 1834 1834 1841 1841 1843 1843 1938 1938 1941 1941 2012 2033 2033 2047 2068 2068 2082 2103 2103 2135 2135 2142 2145 2148 2171 2171 2175 2177 2179 2200 2200 2206 null_statement 000105 constant bit(9) initial dcl 23-3 set ref 1190* 1227* 1341 1614* 1747 1790 1808 number 0(21) based fixed bin(14,0) level 2 in structure "list" packed packed unaligned dcl 16-6 in procedure "operator_semantics" ref 996 1011 number 0(21) based fixed bin(14,0) level 2 in structure "operator" packed packed unaligned dcl 13-6 in procedure "operator_semantics" set ref 146 924* off_fun constant bit(9) initial dcl 22-8 ref 1058 offset 5 based pointer level 2 in structure "reference" packed packed unaligned dcl 20-3 in procedure "operator_semantics" set ref 1178 2145 2145 2177 2177* 2177 offset 0(06) 000237 automatic bit(1) level 2 in structure "btype" packed packed unaligned dcl 106 in procedure "operator_semantics" set ref 1852 offset 31(06) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 10-3 in procedure "operator_semantics" ref 1047 1047 1048 offset 0(06) 000240 automatic bit(1) level 2 in structure "ctype" packed packed unaligned dcl 107 in procedure "operator_semantics" set ref 1845 offset_mask 000133 constant bit(36) initial dcl 14-3 set ref 1054* 1858* old_rand 000140 automatic pointer array dcl 62 set ref 332* 333* 374 385 403 426 432 476 485 492 531 534 on_unit constant bit(9) initial dcl 18-1 ref 1307 op2 parameter pointer dcl 2196 set ref 2193 2201* op_code 0(09) based bit(9) level 2 packed packed unaligned dcl 13-6 set ref 148 730 923* 935* 970 973 973 988 989 1039 1039 1068 1167 1187* 1325 1474 2132 2132 opcode 000220 automatic bit(9) dcl 87 set ref 148* 150 153 153 232 232 237 242 263 263 268 273 289 315 636 668 680 688 1058* 1064* 1082 1156 1157 1161 1161 1187 1438* 1445* 1459 1732 1737 1941 1941 1941 1941 2030 2030 2065 2065 2100 2100 operand 1 based pointer array level 2 packed packed unaligned dcl 13-6 set ref 316 332 333 380* 385* 386 403* 404 416* 417 426* 427 432* 433 476* 479 479 479 481 486 492* 493 493 496* 497* 497 498* 501 501 501 503 531* 534* 576* 582* 583* 584 585 586* 588* 588 589* 589 591 592 596* 596* 617* 618* 644 644 644 646 651 652* 652* 653 662 703* 704* 705* 726 730 739 739 739* 742* 742 745 745 745 747 753 753* 754 790 791 804 816 816 818 818 837 839 850 881 883 889 892 906* 909 910 913 943 944 945* 950 954 957 961* 961 961 970 971 974 988 988 990 990 994 994 1004 1004 1006* 1006* 1007 1008 1011 1012 1014 1016 1016 1018* 1018 1028 1028 1032 1033 1036* 1054* 1070 1075* 1083* 1083 1084* 1084 1085* 1104 1104 1121* 1122* 1122 1126* 1128* 1129* 1129 1130* 1130 1167 1167 1167 1167 1173 1185* 1225* 1237 1239 1241 1242 1244 1245 1245 1251 1253 1325 1411* 1412* 1412 1414* 1416* 1431 1432 1475 1476 1478 1527* 1562* 1566 1567 1586* 1601* 1633* 1633 1646* 1646 1697* 1704 1706 1707* 1707 1711* 1711 1719 1723 1723 1726 1726 1729 1729 1738 1764* 1796* 1798* 1800* 1846* 1846 1847 1848* 1848 1849 1858* 1861* 1861 1862 1863* 1863 1864 1960 1960* 1960 1970* 1970 1973 1974 1981 1981* 1981 1991* 1991 1994 1995 2010 2013 2033* 2034* 2034 2037 2039* 2045 2048 2068* 2069* 2069 2072 2074* 2080 2083 2103* 2104* 2104 2107 2109* 2200* 2201* operator based structure level 1 dcl 13-6 operator_node constant bit(9) initial dcl 24-5 ref 136 386 404 427 433 479 486 501 644 662 726 745 754 791 839 883 892 970 1167 1430 1474 1475 1974 1995 2013 2048 2083 2131 2206 operator_semantics 000044 constant entry external dcl 2-184 ref 1287 1471 1848 1863 orig_stmnt_ptr 000144 automatic pointer dcl 63 set ref 1217* 1267 overlayed 33(11) based bit(1) level 4 packed packed unaligned dcl 10-3 set ref 774* p 000334 automatic pointer dcl 2197 in procedure "create_length_fun" set ref 2199* 2200 2201 2202 p 000322 automatic pointer dcl 2158 in procedure "copy_ref" set ref 2165* 2167 2168 2168 2172 2185* p 000175 automatic fixed bin(31,0) dcl 74 in procedure "operator_semantics" set ref 226* 233 238 244 250 257* 264 269 275 281 390* 395 399 408* 409 437* 439 510* 514 528 531 p 000260 automatic pointer dcl 1778 in procedure "make" set ref 1781* 1795* 1796 1798 1800 1816 p 000100 automatic pointer dcl 2127 in procedure "prepare" set ref 2129* 2131 2132 2132 2136* 2139 2142 2142 2145 2145 2148 2148 packed 33 based bit(1) level 4 packed packed unaligned dcl 10-3 ref 918 1437 param_desc 32(15) based bit(1) level 4 packed packed unaligned dcl 10-3 set ref 869 param_desc_ptr 000114 constant bit(9) initial dcl 22-8 set ref 1253* 2132 param_ptr 000115 constant bit(9) initial dcl 22-8 set ref 1251* 2132 passed_as_arg 33(01) based bit(1) level 4 packed packed unaligned dcl 10-3 set ref 1012* pic_char 1(30) based bit(1) level 3 packed packed unaligned dcl 10-3 set ref 1892 1908 pic_float 1(29) based bit(1) level 3 packed packed unaligned dcl 10-3 set ref 183 189 193 199 299 305 340 346 351 357 1894 1899 1910 1915 picture 0(18) 000237 automatic bit(1) level 2 in structure "btype" packed packed unaligned dcl 106 in procedure "operator_semantics" set ref 183 299 340 1891 picture 0(18) 000236 automatic bit(1) level 2 in structure "atype" packed packed unaligned dcl 105 in procedure "operator_semantics" set ref 879 935 picture 31(18) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 10-3 in procedure "operator_semantics" ref 908 961 961 picture 0(18) 000240 automatic bit(1) level 2 in structure "ctype" packed packed unaligned dcl 107 in procedure "operator_semantics" set ref 193 351 1907 pix 1(28) based structure level 2 packed packed unaligned dcl 10-3 set ref 811* 811 910* 910 pl1_stat_$abort_label 000010 external static label variable dcl 96 set ref 1357 1358* 1619* pl1_stat_$cur_statement 000012 external static pointer dcl 97 set ref 1068 1070 1125 1192* 1295* 1623* pl1_stat_$error_flag 000014 external static bit(1) packed unaligned dcl 98 set ref 1362* 1500 pl1_stat_$multi_type 000016 external static bit(1) packed unaligned dcl 99 set ref 1355* 1356 1363 1391 1494 1619 1622* 1813 pl1_stat_$root 000020 external static pointer dcl 100 set ref 1518* pl1_stat_$stmnt_unreachable 000022 external static bit(1) packed unaligned dcl 101 ref 1320 pointer_type 000100 constant bit(36) initial dcl 25-71 set ref 1075* 1121* 1663 1846* 1861* position 32 based bit(1) level 4 packed packed unaligned dcl 10-3 set ref 774* prec 000204 automatic fixed bin(31,0) array dcl 77 set ref 660* 662* 664* 690* 690 690 697* 697 697 703* prefix 12(12) based bit(12) level 2 packed packed unaligned dcl 19-9 ref 935 935 1221 1227 1491 1525 1560 1745 1804 2135 prefix_plus constant bit(9) initial dcl 22-8 ref 289 315 processed 0(19) based bit(1) level 2 in structure "operator" packed packed unaligned dcl 13-6 in procedure "operator_semantics" set ref 138 706* 1104 1847* 1849* 1862* 1864* 2035* 2070* 2105* 2206* processed 13 based bit(1) level 3 in structure "statement" packed packed unaligned dcl 19-9 in procedure "operator_semantics" set ref 857* prologue_flag 43 based bit(1) level 2 packed packed unaligned dcl 17-5 ref 726 pt parameter pointer dcl 2126 in procedure "prepare" ref 2123 2129 pt parameter pointer dcl 2157 in procedure "copy_ref" ref 2154 2165 ptr 0(05) 000240 automatic bit(1) level 2 in structure "ctype" packed packed unaligned dcl 107 in procedure "operator_semantics" set ref 1852 ptr 0(05) 000237 automatic bit(1) level 2 in structure "btype" packed packed unaligned dcl 106 in procedure "operator_semantics" set ref 1845 ptr 31(05) based bit(1) level 4 in structure "symbol" packed packed unaligned dcl 10-3 in procedure "operator_semantics" ref 1047 1047 ptr_fun constant bit(9) initiaapEA;GQ$  "^a/S5 ^*@apE " *apE z*@apE h &aA" 2 2^a *rpc_status.text aA;mG`H>$ P `^aP>S5 X^*@a ` P*a Xz*@a *&auser_dir_dir>Multics>Zwick>mail>Zwick.memoTH}dz.mbx q*Qsa @actc_logo.pict Qr($a0>TH}*@$ *@ `*@$&q0*+0&aRrstart_up.ec q0@ߓ,>user_dir_dir>Multics>Zwick>mail>start_up.ecTH}dz.sr q!6Hq1>aZZaRstart_up.kermit q1@ߓ0>user_dir_dir>Multics>Zwick>mail>start_up.kermitTH}*@TH}*@TH} xH&5H4 Na 2Zwick.activities &57>user_dir_dir>Multics>Zwick>activities>Zwick.activitiesTH}D5Zwick.sr q!&q8.7!a8dz.mail_alias q8@ߓ#>udd>Multics>Zwick>mail>Zwick.aliasTH}|\p*@d^~*@d^ *@ Lsa>Aug.93.sum _I$aTH}t*@d^ X*@d*@d^&b*@d^t&־BXhadial_out.profile ־>udd>m>dz>mail>dial_out.profileTH}.*@d^b*@1t0&d^LaCP6 d^Ll  ta~2rTH}d*@d^ @*@d*@F*@t*p*@1K5arumake.db.pl6 8K҂3$aBTH}F*@106&L>>a6oport Ll  pla~2rTH}&*@d^ hp*@ (VT*@~xn&ÕnGo ||atxps_lib.lib ÕnLl  a~2rTH}*@Õn*@Õn6.*@~SysMaint TH}Qcp6 d^Z>Hinatsu TH}Lt THLLuk TH}LhLee entry internal dcl 2123 ref 1349 2142 2145 2148 replace 006600 constant label dcl 1014 ref 976 ret 013232 constant label dcl 2206 ref 134 136 138 165 317 573 623 859 1039 1042 1055 1076 1089 1133 1178 1195 1200 1212 1237 1297 1307 1320 1334 1625 1648 1673 1682 1689 1699 1714 1748 1759 1766 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 17062 17214 16400 17072 Length 20444 16400 132 1213 461 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME operator_semantics 584 external procedure is an external procedure. make internal procedure shares stack frame of external procedure operator_semantics. convert_relationals internal procedure shares stack frame of external procedure operator_semantics. converter internal procedure shares stack frame of external procedure operator_semantics. extract internal procedure shares stack frame of external procedure operator_semantics. prepare 84 internal procedure calls itself recursively. copy_ref internal procedure shares stack frame of external procedure operator_semantics. create_length_fun internal procedure shares stack frame of external procedure operator_semantics. constant_value internal procedure shares stack frame of external procedure operator_semantics. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME operator_semantics 000100 a operator_semantics 000102 after_ret operator_semantics 000104 b operator_semantics 000106 bb operator_semantics 000110 c operator_semantics 000112 desc operator_semantics 000114 e operator_semantics 000116 es operator_semantics 000120 expr operator_semantics 000122 first operator_semantics 000124 last operator_semantics 000126 jump_stmnt operator_semantics 000130 last_jump operator_semantics 000132 length operator_semantics 000136 next operator_semantics 000140 old_rand operator_semantics 000144 orig_stmnt_ptr operator_semantics 000146 qq operator_semantics 000150 ref operator_semantics 000152 rv operator_semantics 000154 size operator_semantics 000156 sym operator_semantics 000160 signal_stmnt_ptr operator_semantics 000162 tree operator_semantics 000164 target  *@WH 0*@WH 0 (*@WH *@WH *@WH 0m@WH  ~*@WHF @~*@Udv 8 H*@Udv @ h*@Udv^ XT*@Udv P `F*@Udv XVb*@Udv H0m@Udv x~*@UU p *@UU *@UU T*@UU F*@UU x *@UU 0m@UU^ ~*@T *@TF *@T T*@T fF*@T *@T h*@Td *@Tw *@Tw  *@Tw *@Tw T*@Tw *@Tw ~*@TwP *@TH  H*@TH H @*@TH 8*@TH 0h*@TH (*@TH (~*@TH X*@TH P *@TH x*@TH p*@TH h*@TH `*@TH X `~*@TH ~*@TH *@TH *@TH T*@TH F*@TH *@TH 0m@TH *@TH1 *@TH1 *@TH1 0m@TH1 *@TH1 T*@TH1 ~*@TH1 H*@x*@  (~*x *@O2 8 p*x @ *@O2  H*x h*@  b*x *@O2 ( *x *@*@x*@$ *@  *@ **@8 *@ɓ *@ɓ *@ɓ *ɓ P*@ x*@8 x&{L a mac {MuK2 a~2rTH} *@{ *@{ *@{ *@{ :Krumake.pl1 >La cAug.93.rpt _$aWTH} *@8 **@8. *&MZ B Ba :Vrev.trans MusGL$ d pasTH}  *@ 0 *@ \*@ & Nv a xL|activities Rop h 0a~2rTH} ` L*@ hv*@ p*@Kwa *x9macs ɑKx~T$asTH} *@ɑ *@ɑ*@ɑ :&$Pie a 0 create_statement create_symbol create_token declare declare_constant declare_constant$desc declare_constant$integer declare_temporary do_semantics expand_assign expression_semantics free_node function get_size io_semantics operator_semantics refer_extent reserve$declare_lib semantic_translator$abort semantic_translator$error share_expression THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. pl1_stat_$abort_label pl1_stat_$cur_statement pl1_stat_$error_flag pl1_stat_$multi_type pl1_stat_$root pl1_stat_$stmnt_unreachable LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 41 001004 132 001016 134 001022 136 001026 138 001032 141 001035 142 001036 143 001040 146 001054 148 001060 150 001064 153 001067 159 001101 165 001116 171 001117 175 001144 177 001151 179 001156 181 001163 183 001170 187 001205 189 001210 191 001216 193 001220 197 001235 199 001240 201 001246 204 001250 206 001270 209 001310 211 001323 213 001336 215 001347 218 001351 219 001354 221 001367 224 001402 226 001403 227 001406 228 001412 229 001415 230 001421 231 001424 232 001431 233 001436 234 001460 235 001462 237 001463 238 001465 239 001474 240 001477 242 001500 243 001502 244 001504 245 001510 247 001511 249 001512 250 001517 251 001524 253 001525 255 001526 257 001527 258 001532 259 001536 260 001541 261 001545 262 001553 263 001560 264 001565 265 001607 266 001611 268 001612 269 001614 270 001623 271 001626 273 001627 274 001631 275 001633 276 001637 278 001640 280 001641 281 001646 282 001653 289 001654 292 001660 295 001701 297 001706 299 001713 303 001730 305 001733 307 001741 310 001743 313 001763 315 001764 316 001767 317 001772 320 001773 321 001776 322 002002 323 002007 328 002010 332 002035 333 002040 335 002043 337 002050 340 002055 344 002072 346 002075 348 002103 351 002105 355 002122 357 002125 359 002133 362 002135 364 002155 367 002175 368 002206 370 002207 372 002214 373 002224 374 002226 375 002250 377 002253 379 002255 380 002264 382 002267 385 002304 386 002327 388 002336 390 002341 391 002343 392 002347 393 002352 395 002356 396 002363 398 002364 399 002370 400 002400 402 002403 403 002413 404 002434 406 002443 407 002446 408 002460 409 002463 412 002467 415 002470 416 002472 417 002507 418 002512 420 002513 421 002521 423 002525 426 002535 427 002560 429 002567 432 002572 433 002615 435 002624 437 002627 438 002631 439 002634 440 002640 443 002641 447 002644 448 002646 450 002654 451 002664 452 002671 455 002675 456 002700 458 002705 460 002717 461 002720 462 002723 463 002735 466 002741 467 002744 468 002764 470 003017 472 003021 474 003030 476 003033 479 003055 481 003067 484 003071 485 003073 486 003112 488 003121 489 003124 492 003132 493 003152 495 003163 496 003200 497 003203 498 003206 501 003207 503 003222 506 003224 507 003225 510 003226 511 003231 512 003234 513 003236 514 003240 515 003245 517 003246 518 003251 520 003253 521 003256 522 003257 525 003261 528 003262 530 003270 531 003272 534 003317 538 003345 542 003356 544 003361 547 003363 550 003372 552 003373 555 003377 558 003404 561 003416 564 003420 566 003435 568 003445 569 003452 570 003460 573 003516 576 003517 577 003545 580 003546 582 003565 583 003613 584 003627 585 003633 586 003635 588 003655 589 003706 591 003726 592 003732 594 003734 596 003736 597 003754 598 003757 600 003761 602 003763 603 003770 604 003772 605 003774 606 003776 607 003777 608 004002 609 004010 610 004024 612 004025 613 004032 616 004033 617 004050 618 004101 620 004103 623 004104 628 004105 632 004126 636 004152 638 004170 641 004174 643 004175 644 004205 646 004216 649 004221 650 004224 651 004226 652 004243 653 004262 654 004265 656 004266 657 004271 660 004275 662 004310 664 004324 666 004331 668 004333 669 004336 670 004340 671 004351 674 004352 677 004373 680 004414 683 004427 686 004435 688 004437 689 004442 690 004444 691 004455 693 004456 696 004502 697 004504 701 004514 702 004516 703 004533 704 004560 705 004574 706 004610 707 004612 708 004613 712 004624 717 004625 726 004646 730 004710 737 004732 739 004740 742 004776 745 005017 747 005031 750 005033 751 005036 753 005037 754 005063 756 005072 763 005075 764 005104 765 005110 767 005113 768 005122 770 005123 772 005127 774 005133 776 005155 777 005160 778 005162 779 005164 780 005166 781 005170 783 005171 784 005174 785 005176 786 005200 789 005203 790 005206 791 005211 793 005217 794 005222 795 005224 797 005233 798 005236 799 005241 800 005261 802 005264 803 005273 804 005274 808 005307 809 005321 811 005322 812 005326 813 005330 816 005332 818 005345 824 005351 825 005354 826 005356 835 005360 837 005414 839 005437 842 005446 845 005454 847 005474 850 005507 851 005525 852 005527 853 005532 856 005556 857 005562 859 005567 869 005570 870 005576 872 005602 875 005611 877 005613 879 005623 881 005634 883 005640 886 005646 889 005667 892 005717 895 005726 898 005734 900 005754 902 005756 903 005757 906 005761 908 006003 909 006007 910 006014 913 006023 918 006026 923 006066 924 006071 925 006075 935 006076 943 006126 944 006133 945 006140 946 006155 947 006157 950 006162 952 006167 953 006172 954 006203 956 006224 957 006251 961 006272 970 006335 971 006354 973 006357 974 006367 976 006372 988 006426 989 006457 990 006462 994 006475 996 006501 997 006507 999 006512 1001 006515 1004 006520 1006 006526 1007 006543 1008 006546 1011 006550 1012 006573 1014 006600 1016 006603 1018 006620 1019 006624 1028 006625 1032 006642 1033 006656 1034 006664 1035 006666 1036 006670 1039 006672 1042 006702 1047 006706 1048 006726 1049 006730 1053 006733 1054 006735 1055 006774 1058 006775 1059 006777 1060 007010 1062 007027 1064 007030 1065 007032 1066 007043 1068 007053 1070 007100 1073 007117 1075 007120 1076 007160 1080 007161 1082 007203 1083 007222 1084 007226 1085 007230 1087 007232 1089 007233 1096 007234 1098 007251 1099 007254 1104 007256 1107 007300 1111 007322 1112 007325 1116 007330 1117 007333 1119 007346 1120 007353 1121 007373 1122 007423 1123 007427 1125 007431 1126 007456 1128 007473 1129 007513 1130 007544 1133 007550 1138 007551 1140 007552 1141 007554 1142 007556 1147 007557 1149 007563 1151 007604 1152 007607 1153 007610 1156 007630 1157 007633 1158 007636 1159 007637 1161 007640 1162 007644 1163 007646 1167 007647 1173 007721 1177 007724 1178 007730 1184 007740 1185 007753 1187 010000 1189 010006 1190 010015 1192 010023 1195 010030 1200 010031 1206 010032 1208 010034 1209 010035 1211 010055 1212 010077 1217 010100 1220 010104 1221 010110 1222 010137 1224 010157 1225 010172 1227 010220 1228 010246 1229 010252 1236 010254 1237 010263 1239 010270 1241 010272 1242 010275 1243 010277 1244 010302 1245 010321 1250 010354 1251 010360 1253 010416 1258 010462 1266 010464 1267 010472 1271 010503 1272 010504 1274 010506 1275 010512 1277 010517 1278 010521 1279 010522 1280 010523 1287 010547 1293 010602 1295 010611 1297 010616 1303 010617 1306 010621 1307 010630 1309 010640 1310 010642 1311 010643 1320 010644 1325 010654 1327 010665 1330 010667 1331 010677 1333 010702 1334 010704 1338 010722 1341 010737 1342 010744 1344 010746 1346 010750 1347 010751 1349 010754 1353 010772 1354 010774 1355 011001 1356 011007 1357 011010 1358 011015 1361 011020 1362 011026 1363 011030 1365 011036 1366 011050 1367 011073 1369 011115 1370 011117 1371 011123 1372 011124 1377 011126 1378 011132 1385 011134 1387 011144 1388 011153 1391 011154 1393 011161 1402 011175 1409 011201 1410 011203 1411 011220 1412 011235 1414 011262 1416 011267 1419 011274 1421 011275 1422 011277 1424 011315 1425 011320 1426 011325 1427 011350 1429 011355 1430 011361 1431 011365 1432 011371 1433 011373 1434 011374 1437 011377 1438 011403 1439 011405 1441 011424 1443 011426 1445 011427 1446 011431 1448 011450 1452 011452 1454 011465 1457 011502 1459 011522 1461 011532 1462 011533 1465 011542 1468 011543 1471 011564 1473 011604 1474 011610 1475 011621 1476 011630 1478 011634 1482 011644 1483 011653 1491 011654 1492 011704 1493 011707 1494 011711 1496 011716 1497 011723 1500 011732 1502 011735 1505 011740 1506 011744 1507 011747 1508 011760 1510 011761 1511 011764 1514 011771 1515 011775 1517 012024 1518 012030 1519 012045 1520 012050 1521 012057 1522 012060 1525 012062 1526 012111 1527 012133 1528 012137 1529 012140 1536 012141 1537 012150 1539 012151 1540 012153 1541 012166 1542 012211 1543 012214 1544 012216 1550 012217 1551 012221 1559 012223 1560 012233 1561 012262 1562 012304 1563 012307 1565 012315 1566 012316 1567 012327 1586 012344 1587 012350 1589 012360 1593 012364 1599 012367 1601 012370 1603 012372 1605 012400 1610 012403 1613 012404 1614 012410 1615 012416 1617 012423 1619 012427 1622 012437 1623 012440 1625 012444 1631 012445 1633 012455 1634 012475 1636 012477 1637 012501 1638 012503 1644 012504 1646 012513 1647 012533 1648 012535 1654 012536 1656 012540 1657 012542 1663 012543 1665 012545 1670 012546 1673 012562 1678 012563 1680 012577 1682 012601 1687 012602 1689 012616 1695 012617 1697 012625 1698 012652 1699 012654 1704 012655 1706 012663 1707 012670 1710 012712 1711 012717 1712 012737 1714 012741 1719 012742 1723 012765 1726 013011 1729 013041 1732 013062 1734 013076 1735 013101 1737 013104 1738 013107 1739 013115 1741 013122 1742 013127 1743 013135 1745 013142 1746 013152 1747 013166 1748 013173 1751 013174 1752 013176 1755 013177 1756 013204 1759 013206 1764 013207 1766 013231 2206 013232 2211 013244 1771 013250 1781 013252 1782 013255 1783 013257 1785 013267 1787 013274 1790 013306 1791 013311 1792 013312 1793 013315 1795 013316 1796 013332 1798 013341 1800 013347 1804 013355 1806 013403 1808 013406 1810 013417 1811 013422 1812 013424 1813 013425 1816 013432 1817 013434 1819 013441 1824 013442 1829 013443 1832 013454 1834 013460 1836 013475 1839 013506 1841 013512 1843 013527 1845 013552 1846 013560 1847 013601 1848 013604 1849 013633 1850 013636 1852 013637 1853 013645 1857 013651 1858 013653 1859 013712 1861 013713 1862 013734 1863 013737 1864 013766 1866 013771 1869 013772 1872 014005 1874 014020 1875 014024 1876 014031 1878 014032 1879 014036 1880 014043 1882 014044 1883 014053 1884 014055 1886 014056 1887 014065 1888 014067 1891 014070 1892 014073 1894 014102 1897 014113 1899 014116 1901 014124 1904 014126 1907 014127 1908 014132 1910 014141 1913 014152 1915 014155 1917 014163 1920 014165 1923 014166 1925 014202 1927 014216 1928 014221 1930 014235 1933 014251 1935 014263 1938 014275 1941 014333 1946 014372 1948 014373 1954 014374 1959 014375 1960 014400 1962 014432 1964 014442 1968 014474 1970 014504 1973 014527 1974 014532 1977 014540 1980 014543 1981 014546 1983 014600 1985 014610 1989 014642 1991 014652 1994 014675 1995 014700 1998 014706 2001 014711 2006 014712 2009 014713 2010 014715 2012 014720 2013 014724 2016 014732 2019 014744 2022 014750 2023 014752 2024 014755 2026 014774 2030 014776 2032 015012 2033 015027 2034 015054 2035 015057 2037 015061 2038 015064 2039 015066 2044 015071 2045 015074 2047 015077 2048 015103 2051 015111 2054 015132 2057 015136 2060 015142 2061 015144 2062 015147 2063 015161 2065 015162 2067 015176 2068 015213 2069 015240 2070 015243 2072 015245 2073 015250 2074 015252 2079 015255 2080 015260 2082 015263 2083 015267 2086 015275 2089 015313 2092 015316 2095 015322 2096 015324 2097 015327 2098 015341 2100 015342 2102 015356 2103 015373 2104 01PNT K6TPNT P72t ----------------------------------------------------------- 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