COMPILATION LISTING OF SEGMENT cobol_ci_phase Compiled by: Multics PL/I Compiler, Release 31b, of April 24, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 05/24/89 1005.3 mst Wed 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-04-23,Zimmerman), approve(89-04-23,MCR8060), 17* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 18* MCR8060 cobol_ci_phase.pl1 Reformatted code to new Cobol standard. 19* END HISTORY COMMENTS */ 20 21 22 /* Modified on 05/06/81 by FCH, [4.4-2], cobol_ciphase_data.incl.pl1 changed, BUG482(TR9781) */ 23 /* Modified on 05/15/79 by FCH, [4.0-1], table size decreased */ 24 /* Modified on 05/26/78 by FCH, [3.0-1], table size increased */ 25 /* Modified since Version 3.0 */ 26 27 /*{*/ 28 29 /* format: style3 */ 30 cobol_ci_phase: 31 proc; 32 33 /* This procedure scans rmin2 looking for initialize statements and statements 34* containing the corresponding option. These statements are expanded and written 35* into corrout */ 36 37 /*}*/ 38 /*[4.0-2]*/ 39 dcl size builtin; /*[4.0-2]*/ 40 dcl cobol$alloc entry (fixed bin (35)) returns (ptr) ext; 41 /*[4.0-2]*/ 42 /*[4.0-2]*/ 43 dir_ptr = cobol$alloc (size (dir_struct)); 44 45 infp = cobol_rmin2fp; 46 outfp = cobol_x3fp; 47 table1_2_size = 22000; /*[4.0-1]*/ 48 on = "1"b; 49 off = "0"b; 50 eof = "0"b; 51 dir_ptr1 = addr (dir1); 52 dir_ptr2 = addr (dir2); 53 initlz_tbl_ptr = addr (table1); 54 input_ptr = null (); 55 output_ptr = null (); 56 gen_item_allocated = "0"b; 57 initlz_items_allocated = "0"b; 58 new_seg_bit = "0"b; 59 poss_prior_err = "1"b; 60 without_on_bit = "0"b; /* syntax ON SIZE ERROR witout ON */ 61 fixed_common.phase_name = "CORRES"; 62 err_num = 0; 63 substr (err_image, 1, 1) = "*"; 64 65 find_bos: 66 if err_num ^= 0 67 then do; 68 go to err (err_num); 69 70 err (1): 71 poss_prior_err = "0"b; 72 go to err_end; 73 74 err (2): 75 err_image = "identifier*"; 76 go to err_end; 77 78 err (3): 79 err_image = "(*"; 80 go to err_end; 81 82 err (4): 83 poss_prior_err = "0"b; 84 go to err_end; 85 86 err (5): 87 go to err_end; 88 89 err (6): 90 go to err_end; 91 92 err (7): 93 go to err_end; 94 95 err (8): 96 go to err_end; 97 98 err (9): 99 go to err_end; 100 101 err (10): 102 err_image = "illegal level number*"; 103 poss_prior_err = "0"b; 104 go to err_end; 105 106 err (11): 107 go to err_end; 108 109 err (12): 110 go to err_end; 111 112 err (13): 113 poss_prior_err = "0"b; 114 go to err_end; 115 116 err (14): 117 go to err_end; 118 119 err (15): 120 call err_pro; 121 return; 122 123 err (16): 124 poss_prior_err = "0"b; 125 go to err_end; 126 127 err (17): 128 poss_prior_err = "0"b; 129 go to err_end; 130 131 err (18): 132 poss_prior_err = "0"b; 133 go to err_end; 134 135 err (19): 136 poss_prior_err = "0"b; 137 go to err_end; 138 139 err (20): 140 poss_prior_err = "0"b; 141 go to err_end; 142 143 err (21): 144 poss_prior_err = "0"b; 145 go to err_end; 146 147 err (22): 148 err_image = "occurs depending on*"; 149 poss_prior_err = "0"b; 150 go to err_end; 151 152 err (23): 153 go to err_end; 154 155 err (24): 156 go to err_end; 157 158 err (25): 159 poss_prior_err = "0"b; 160 go to err_end; 161 162 err (26): 163 poss_prior_err = "0"b; 164 go to err_end; 165 166 err (27): 167 poss_prior_err = "0"b; 168 go to err_end; 169 170 err (28): 171 poss_prior_err = "0"b; 172 go to err_end; 173 174 err (29): 175 err_image = "numeric literal or identifier*"; 176 err_num = 2; 177 poss_prior_err = "0"b; 178 go to err_end; 179 180 err (30): 181 err_image = "proper index name*"; 182 err_num = 2; 183 poss_prior_err = "0"b; 184 go to err_end; 185 186 err (31): 187 err_image = """+"",""-"", numeric literal or indexname*"; 188 err_num = 2; 189 go to err_end; 190 191 err (32): 192 err_image = "numeric_literal*"; 193 err_num = 2; 194 go to err_end; 195 196 err (33): 197 err_image = "proper subscript*"; 198 err_num = 2; 199 go to err_end; 200 201 err (34): 202 err_image = "identifier, literal or proper figurative constant*"; 203 err_num = 2; 204 go to err_end; 205 206 err (35): 207 err_image = "from*"; 208 err_num = 3; 209 go to err_end; 210 211 err (36): 212 err_image = "to*"; 213 err_num = 3; 214 go to err_end; 215 216 err (37): 217 err_image = ")*"; 218 err_num = 3; 219 go to err_end; 220 221 err (38): 222 err_image = "data or by*"; 223 err_num = 3; 224 go to err_end; 225 226 err (39): 227 err_image = "by*"; 228 err_num = 3; 229 go to err_end; 230 231 err (40): 232 err_image = "usage is index*"; 233 err_num = 22; 234 poss_prior_err = "0"b; 235 go to err_end; 236 err (41): 237 err_image = "usage is index*"; 238 err_num = 10; 239 poss_prior_err = "0"b; 240 go to err_end; 241 err (42): 242 poss_prior_err = "0"b; 243 err_num = 29; 244 go to err_end; 245 err (43): 246 poss_prior_err = "0"b; 247 err_num = 30; 248 go to err_end; 249 err_end: 250 recov = "1"b; 251 call err_pro; 252 253 if eof 254 then return; 255 256 err_num = 0; 257 258 end; 259 260 else do; 261 262 curr_dim = 1; 263 fixbin15 = 0; 264 265 fixbin_diff = "0"b; /** initialize for statement **/ 266 lk_ahd_index = 0; 267 ose_exists = "0"b; 268 recovering = "0"b; 269 begin_i = 1; 270 top_token_stack = 1; 271 sending_op = "1"b; 272 code = 1; 273 next_free_column = 8; 274 275 call corr_in; /*read until beginning of a statment is recognized -- 276* corr_in looks for add, subtract, or move verb */ 277 278 if eof 279 then return; 280 281 if initlz_swt 282 then call initialize_statement; 283 else do; 284 285 call add_token; 286 287 gen_ptr (1) = token_stack_ptr; 288 end_i = 2; /*skip 1 to store sending operand */ 289 code = 0; 290 291 call corr_in; 292 293 294 if eof 295 then return; 296 297 if reserved_word.type = 1 & reserved_word.key = 524 298 /* corresponding */ 299 then do; 300 if fixed_common.comp_level ^= "5" & fixed_common.comp_level < "3" 301 then do; 302 message.number = 19; 303 message.line = reserved_word.line; 304 message.column = reserved_word.column; 305 message.size = 32; 306 message.run = 9; 307 308 call cobol_c_list (addr (message)); 309 310 message.run = 8; 311 end; 312 recursive_bit = "0"b; 313 call corres_option (0); 314 end; 315 316 else do; 317 318 output_ptr = token_stack_ptr; 319 320 call cobol_swf_put (outfp, fst, output_ptr, output_ptr -> reserved_word.size); 321 322 323 call remove_token; 324 325 output_ptr = input_ptr; 326 327 call cobol_swf_put (outfp, fst, output_ptr, output_ptr -> reserved_word.size); 328 329 330 call corr_in; 331 332 if eof 333 then return; 334 335 end; 336 337 end; 338 339 end; 340 341 go to find_bos; 342 343 344 345 corres_option: 346 proc (mode); 347 348 declare mode fixed bin; 349 350 more: 351 if mode = 0 352 then do; 353 354 nu_line = reserved_word.line; /* add for numerot.line in output */ 355 first_pair = "1"b; 356 357 call corr_in; 358 359 if eof 360 then do; 361 err_num = 15; 362 return; 363 end; 364 365 end; 366 367 if data_name.type ^= 9 /* user word */ 368 then do; 369 370 err_num = 2; 371 return; 372 end; 373 374 if data_name.elementary 375 then do; 376 err_num = 16; /*MUST BE GROUP NAME*/ 377 return; 378 end; 379 380 if data_name.level > 49 & data_name.level ^= 66 /* illegal level number */ 381 then do; 382 err_num = 10; 383 return; 384 end; 385 386 if data_name.usage_index /*USAGE IS INDEX*/ 387 then do; 388 err_num = 41; 389 return; 390 end; 391 392 if data_name.subscripted /*OCCURS*/ 393 then do; 394 ptr1 = addr (any_item (data_name.occurs_ptr)); 395 orig_dimen = ptr1 -> occurs.dimensions; 396 end; 397 else orig_dimen = 0; 398 399 if sending_op 400 then do; 401 curr_tbl_ptr = addr (table1); /* sending operand */ 402 curr_dir_ptr = addr (dir1); 403 dir_num = 0; 404 end; 405 else do; 406 curr_tbl_ptr = addr (table2); /* receiving operand */ 407 curr_dir_ptr = addr (dir2); 408 dir_num = 1; 409 end; 410 411 main_item_ptr = input_ptr; 412 413 curr_dir_index = 0; 414 curr_tbl_index = 1; 415 curr_stk_index = 1; 416 417 rdf_illegal = ^data_name.s_of_rdf; 418 419 get_next_group_member: 420 call corr_in; 421 422 if eof 423 then do; 424 err_num = 15; 425 return; 426 end; 427 428 if data_name.type = 9 429 then /* user word */ 430 do; 431 432 if data_name.filler_item | (rdf_illegal & data_name.s_of_rdf) 433 | (^move_swt & data_name.elementary & ^data_name.numeric) | data_name.usage_index 434 then go to get_next_group_member; 435 436 if data_name.subscripted 437 then do; 438 ptr1 = addr (any_item (data_name.occurs_ptr)); 439 440 if ptr1 -> occurs.dimensions > orig_dimen 441 then go to get_next_group_member; 442 end; 443 444 if curr_dir_index = 512 /*[4.0-2]*/ 445 then do; 446 err_num = 21; 447 return; 448 end; 449 450 curr_dir_index = curr_dir_index + 1; 451 452 tbl_item_ptr = addr (curr_table (curr_tbl_index)); 453 substr (tbl_item_ptr -> record, 1, recsize) = substr (input_ptr -> record, 1, recsize); 454 curr_dir.tbl (curr_dir_index) = curr_tbl_index; 455 curr_dir.dir (curr_dir_index) = 0; 456 curr_level = data_name.level; 457 458 /*[4.0-2]*/ 459 if curr_tbl_index + recsize + mod (-recsize, 4) > 100000 460 /* */ 461 then do; 462 err_num = 19; 463 return; 464 end; 465 466 curr_tbl_index = curr_tbl_index + recsize + mod (-recsize, 4); 467 468 if curr_dir_index = 1 469 then do; 470 stack.level (1) = curr_level; 471 stack.stk_to_dir (1) = 1; 472 473 end; 474 475 else if curr_level > stack.level (curr_stk_index) 476 then do; 477 478 if curr_stk_index = 10 479 then do; 480 err_num = 20; 481 return; 482 end; 483 curr_stk_index = curr_stk_index + 1; 484 stack.stk_to_dir (curr_stk_index) = curr_dir_index; 485 stack.level (curr_stk_index) = curr_level; 486 487 end; 488 489 else do; 490 call set_links; 491 492 if err_num ^= 0 493 then return; 494 495 end; 496 497 498 go to get_next_group_member; 499 500 end; 501 502 503 504 if curr_stk_index > 1 505 then do; 506 curr_level = stack.level (1); 507 curr_dir_index = curr_dir_index + 1; 508 509 curr_dir.tbl (curr_dir_index) = 0; 510 curr_dir.dir (curr_dir_index) = 0; 511 512 call set_links; 513 514 if err_num ^= 0 515 then return; 516 517 518 if dir_num = 0 519 then curr_dir.dir (stack_loc) = 0; 520 521 end; 522 523 if orig_dimen > 0 524 then do; /* subscripting required */ 525 526 call res_test (187, 3); 527 if err_num ^= 0 528 then return; 529 530 call begin_subscripts; 531 532 if err_num ^= 0 533 then return; 534 535 call corr_in; 536 537 if eof 538 then do; 539 err_num = 15; 540 return; 541 end; 542 543 end; 544 if reserved_word.type ^= 26 545 then do; 546 err_num = 11; 547 return; 548 end; 549 550 if ^sending_op 551 then do; 552 call check_for_further; 553 554 if err_num ^= 0 555 then return; 556 557 if check_res = 0 558 then return; 559 560 go to get_next_group_member; 561 562 end; 563 564 end_dir1_index = curr_dir_index; 565 566 call corr_in; 567 568 if eof 569 then do; 570 err_num = 15; 571 return; 572 end; 573 574 if subtract_swt 575 then do; 576 call res_test (111, 35); 577 if err_num ^= 0 578 then return; 579 end; 580 581 else do; 582 call res_test (170, 36); 583 if err_num ^= 0 584 then return; 585 end; 586 587 588 589 call add_token; 590 591 end_i = end_i + 1; 592 gen_ptr (end_i) = token_stack_ptr; 593 end_i = end_i + 1; 594 recv_i = end_i; 595 sending_op = "0"b; 596 mode = 0; 597 598 go to more; 599 600 end; 601 602 res_test: 603 proc (resnum, errnum); 604 605 declare (resnum, errnum) fixed bin; 606 607 if reserved_word.type ^= 1 608 then do; 609 err_num = errnum; 610 return; 611 end; 612 613 if reserved_word.key ^= resnum 614 then do; 615 err_num = errnum; 616 return; 617 end; 618 619 err_num = 0; 620 end; 621 622 set_links: 623 proc; 624 625 do while (curr_level < stack.level (curr_stk_index)); 626 627 curr_dir.dir (stack.stk_to_dir (curr_stk_index)) = stack.stk_to_dir (curr_stk_index - 1); 628 curr_stk_index = curr_stk_index - 1; 629 630 end; 631 632 if curr_level = stack.level (curr_stk_index) 633 then do; 634 stack_loc = stack.stk_to_dir (curr_stk_index); 635 curr_dir.dir (stack_loc) = curr_dir_index; 636 stack.stk_to_dir (curr_stk_index) = curr_dir_index; 637 stack.level (curr_stk_index) = curr_level; 638 end; 639 else do; 640 err_num = 13; 641 err_image = "sending*"; 642 return; 643 end; 644 end; 645 646 begin_subscripts: 647 proc; 648 649 indexname_subscr_sw = "0"b; 650 dataname_subscr_sw = "0"b; 651 652 call add_token; /*leftparen*/ 653 654 if ^initlz_swt 655 then do; 656 end_i = end_i + 1; 657 gen_ptr (end_i) = token_stack_ptr; 658 end; 659 else subscr_directory.tokn_ptr (subscr_dir_index) = token_stack_ptr; 660 661 call corr_in; 662 663 if eof 664 then do; 665 err_num = 15; 666 return; 667 end; 668 669 subscr_cnt = 0; 670 671 pick_up_subscr: 672 if numeric_lit.type = 2 673 then do; 674 675 if numeric_lit.sign = "-" 676 then do; 677 err_num = 17; 678 return; 679 end; 680 681 subscr_cnt = subscr_cnt + 1; 682 683 add_subscript: 684 call add_token; 685 686 if ^initlz_swt 687 then do; 688 end_i = end_i + 1; 689 gen_ptr (end_i) = token_stack_ptr; 690 end; 691 692 call corr_in; 693 694 if eof 695 then do; 696 err_num = 15; 697 return; 698 end; 699 700 test_subscr_cnt: 701 if reserved_word.type = 1 & reserved_word.key = 188 702 then rparen = "1"b; 703 else rparen = "0"b; 704 705 if subscr_cnt = ptr1 -> occurs.dimensions 706 then do; 707 708 test_rparen: 709 if rparen 710 then do; 711 712 call add_token; 713 714 if ^initlz_swt 715 then do; 716 end_i = end_i + 1; 717 gen_ptr (end_i) = token_stack_ptr; 718 end; 719 else do; 720 721 call corr_in; 722 723 if eof 724 then err_num = 15; 725 end; 726 return; 727 end; 728 729 err_num = 37; 730 return; 731 end; 732 733 else do; 734 if rparen 735 then do; 736 err_num = 42; 737 return; 738 end; 739 go to pick_up_subscr; 740 end; 741 742 end; 743 744 745 746 747 if data_name.type = 9 748 then do; 749 750 if indexname_subscr_sw 751 then do; 752 err_num = 4; 753 return; 754 end; 755 else dataname_subscr_sw = "1"b; 756 end; 757 758 else if index_name.type = 10 759 then do; 760 761 if ^(main_item_ptr -> data_name.indexed_by) 762 /*INDEXING NOT ALLOWED*/ 763 then do; 764 err_num = 2; 765 return; 766 end; /*test is this the right index name for this dimension*/ 767 768 if ptr1 -> occurs.level.indexedno (subscr_cnt + 1) ^= index_name.index_no 769 then do; 770 err_num = 28; 771 return; 772 end; 773 774 if dataname_subscr_sw 775 then do; 776 err_num = 4; 777 return; 778 end; 779 780 indexname_subscr_sw = "1"b; 781 782 if initlz_swt 783 then subscr_directory.index_ct (subscr_dir_index) = subscr_directory.index_ct (subscr_dir_index) + 1; 784 785 end; 786 787 else do; 788 err_num = 33; 789 return; 790 end; 791 792 subscr_cnt = subscr_cnt + 1; 793 794 call add_token; 795 796 if ^initlz_swt 797 then do; 798 token_stack_ptr -> index_name.searched = "0"b; 799 token_stack_ptr -> index_name.duplicate = "0"b; 800 end_i = end_i + 1; 801 gen_ptr (end_i) = token_stack_ptr; 802 end; 803 804 /* if ^initlz_swt then if ^sending_op then 805* 806* do while(reserved_word.type ^= 26); 807* 808* call corr_in; 809* 810* if eof then do; err_num = 15; 811* return; 812* end; 813* 814* end; */ 815 816 call corr_in; 817 818 if eof 819 then do; 820 err_num = 15; 821 return; 822 end; 823 824 if dataname_subscr_sw 825 then go to test_subscr_cnt; 826 827 if reserved_word.type ^= 1 828 then do; 829 830 if subscr_cnt = ptr1 -> occurs.dimensions 831 then do; 832 err_num = 37; 833 return; 834 end; 835 go to pick_up_subscr; 836 end; 837 838 if reserved_word.key ^= 182 /*+*/ & reserved_word.key ^= 183 839 /*-*/ 840 then do; 841 842 if subscr_cnt = ptr1 -> occurs.dimensions 843 then do; 844 if reserved_word.key = 188 845 then rparen = "1"b; 846 else rparen = "0"b; 847 go to test_rparen; 848 end; 849 850 err_num = 30; 851 return; 852 end; 853 854 if ^initlz_swt 855 then do; 856 857 call add_token; 858 859 end_i = end_i + 1; 860 gen_ptr (end_i) = token_stack_ptr; 861 end; 862 863 call corr_in; 864 865 if eof 866 then do; 867 err_num = 15; 868 return; 869 end; 870 871 if numeric_lit.type ^= 2 872 then do; 873 err_num = 32; 874 return; 875 end; 876 877 if input_ptr -> numeric_lit.sign ^= " " 878 then do; 879 err_num = 18; 880 return; 881 end; 882 go to add_subscript; 883 884 end; 885 886 check_for_further: 887 proc; 888 889 check_res = 0; 890 891 /* look for rounded, on size error */ 892 893 if move_swt 894 then do; 895 call commence_search; 896 return; 897 end; 898 899 call corr_in; 900 901 if eof 902 then do; 903 call commence_search; 904 return; 905 end; 906 907 if data_name.type = 9 908 then do; 909 recursive_bit = "1"b; 910 check_res = 1; 911 return; 912 end; /* on ADD or SUBTRACT */ 913 914 if reserved_word.type ^= 1 915 then do; 916 call commence_search; 917 return; 918 end; 919 920 921 if reserved_word.key = 156 922 then do; /*rounded*/ 923 924 call add_token; 925 926 end_i = end_i + 1; 927 gen_ptr (end_i) = token_stack_ptr; 928 929 call corr_in; 930 931 if eof 932 then do; 933 call commence_search; 934 return; 935 end; 936 937 if reserved_word.type ^= 1 938 then do; 939 call commence_search; 940 return; 941 end; 942 943 end; 944 945 if reserved_word.key ^= 134 946 then do; /*on*/ 947 without_on_bit = "1"b; 948 xst = 1; 949 end; 950 951 else do; 952 953 call add_token; 954 955 lk_ahd_index = 1; 956 lk_ahd_ptr (1) = token_stack_ptr; 957 958 call corr_in; 959 960 if eof 961 then do; 962 call commence_search; 963 return; 964 end; 965 966 xst = 2; 967 968 if reserved_word.type ^= 1 969 then do; 970 call commence_search; 971 return; 972 end; 973 974 end; 975 976 if reserved_word.key ^= 161 977 then do; /*size*/ 978 979 without_on_bit = "0"b; 980 981 call commence_search; 982 return; 983 984 end; 985 986 call add_token; 987 988 lk_ahd_index = xst; 989 lk_ahd_ptr (xst) = token_stack_ptr; 990 991 call corr_in; 992 993 if eof | reserved_word.type ^= 1 994 then do; 995 call commence_search; 996 return; 997 end; 998 999 1000 if reserved_word.key ^= 3 1001 then do; 1002 call commence_search; 1003 return; 1004 end; 1005 1006 1007 if without_on_bit 1008 then without_on_bit = "0"b; 1009 else call remove_token; 1010 1011 1012 call remove_token; 1013 1014 lk_ahd_index = 0; 1015 1016 call corr_in; 1017 1018 if eof 1019 then do; 1020 err_num = 15; 1021 return; 1022 end; 1023 1024 ose_exists = "1"b; /* APPEND gen_item TO NAME TABLE FILE */ 1025 1026 if ^gen_item_allocated & ^initlz_items_allocated 1027 then do; 1028 fixbin24 = gen_item_t1.size; 1029 1030 call allocate_item (fixbin24, 0, 0, off, off, off, on, off, off, alloc_seg, alloc_offset); 1031 1032 gen_item_t1.seg_num = alloc_seg; 1033 gen_item_t1.offset = alloc_offset; 1034 gen_item_allocated = "1"b; 1035 end; 1036 1037 if initlz_items_allocated 1038 then do; 1039 gen_item_t1.length = 1; 1040 gen_item_t1.places_left = 1; 1041 end; 1042 1043 call commence_search; 1044 1045 end; 1046 1047 1048 1049 commence_search: 1050 proc; 1051 1052 if end_dir1_index = 0 | curr_dir_index = 0 1053 then do; 1054 call error1; 1055 call emit; 1056 return; 1057 end; 1058 1059 loc1 = 1; 1060 loc2 = 1; 1061 null_match = "1"b; 1062 1063 after_initialization: 1064 tbl_item_ptr1 = addr (table1 (dir1.tbl (loc1))); 1065 1066 name1 = blank_name; 1067 1068 substr (name1, 1, tbl_item_ptr1 -> data_name.name_size) = 1069 substr (tbl_item_ptr1 -> data_name.name, 1, tbl_item_ptr1 -> data_name.name_size); 1070 1071 trial = 0; 1072 1073 set_name2: 1074 tbl_item_ptr2 = addr (table2 (dir2.tbl (loc2))); 1075 1076 name2 = blank_name; 1077 1078 substr (name2, 1, tbl_item_ptr2 -> data_name.name_size) = 1079 substr (tbl_item_ptr2 -> data_name.name, 1, tbl_item_ptr2 -> data_name.name_size); 1080 1081 if name1 = name2 1082 then do; 1083 1084 if (tbl_item_ptr1 -> data_name.elementary & tbl_item_ptr2 -> data_name.elementary) 1085 | ((tbl_item_ptr1 -> data_name.elementary | tbl_item_ptr2 -> data_name.elementary) 1086 & move_swt = "1"b) 1087 then do; 1088 1089 if first_pair 1090 then do; 1091 fixbin15 = tbl_item_ptr1 -> data_name.column; 1092 cv_string = bin_to_char (fixbin15, cvindex); 1093 cvbd_1 = substr (cv_string, 7, 4); 1094 dcl_col (loc1) = substr (cvbd_1, 2, 3); 1095 fixbin15 = tbl_item_ptr1 -> data_name.line; 1096 cv_string = bin_to_char (fixbin15, cvindex); 1097 cvbd_1 = substr (cv_string, 7, 4); 1098 dcl_line (loc1) = cvbd_1; 1099 end; 1100 1101 gen_ptr (2) = tbl_item_ptr1; 1102 gen_ptr (recv_i) = tbl_item_ptr2; 1103 /*... CORROUTPUT ALGORITHM...*/ 1104 1105 /* GENERATE MINPRAL TOKEN STREAM */ 1106 1107 if ose_exists 1108 then do; 1109 1110 if null_match 1111 then do; /*first time through */ 1112 1113 /*GENERATE STREAM: move zero to generated field*/ 1114 1115 end_i = end_i + 1; 1116 begin_i = end_i; 1117 ose_gen_begin_i = begin_i; 1118 gen_ptr (end_i) = addr (res_wd_move); 1119 end_i = end_i + 1; 1120 gen_ptr (end_i) = addr (num_lit_zero); 1121 end_i = end_i + 1; 1122 gen_ptr (end_i) = addr (res_wd_to); 1123 end_i = end_i + 1; 1124 gen_ptr (end_i) = addr (gen_item_t1); 1125 1126 call stream_gen; 1127 1128 end; 1129 1130 end_i = ose_gen_begin_i - 1; 1131 begin_i = 1; 1132 1133 end; 1134 1135 /* GENERATE SOURCE LINE IMAGE */ 1136 set_new_col = "1"b; 1137 1138 call stream_gen; 1139 1140 if ose_exists 1141 then do; /*GENERATE STREAM: on size error move 1 to generated_field*/ 1142 1143 if null_match 1144 then do; /*set up gen_ptrs*/ 1145 begin_i = end_i + 1; 1146 ose_gen_begin_i = begin_i; 1147 end_i = begin_i; 1148 1149 gen_ptr (end_i) = addr (res_wd_on); 1150 end_i = end_i + 1; 1151 gen_ptr (end_i) = addr (res_wd_size); 1152 end_i = end_i + 1; 1153 gen_ptr (end_i) = addr (res_wd_error); 1154 end_i = end_i + 1; 1155 gen_ptr (end_i) = addr (res_wd_move); 1156 end_i = end_i + 1; 1157 gen_ptr (end_i) = addr (num_lit_one); 1158 end_i = end_i + 1; 1159 gen_ptr (end_i) = addr (res_wd_to); 1160 end_i = end_i + 1; 1161 gen_ptr (end_i) = addr (gen_item_t1); 1162 end_i = end_i + 1; 1163 gen_ptr (end_i) = addr (res_wd_dot); 1164 end; 1165 else do; 1166 begin_i = ose_gen_begin_i; 1167 end_i = begin_i + 7; 1168 end; 1169 1170 call stream_gen; 1171 1172 end_i = begin_i - 1; 1173 end; 1174 1175 null_match = "0"b; 1176 1177 if ^recursive_bit 1178 then do; 1179 1180 if tbl_item_ptr1 -> data_name.searched 1181 then do; 1182 err_num = 13; 1183 err_image = "sending*"; 1184 return; 1185 1186 end; 1187 else tbl_item_ptr1 -> data_name.searched = "1"b; 1188 1189 if tbl_item_ptr2 -> data_name.searched 1190 then do; 1191 err_num = 13; 1192 err_image = "receiving*"; 1193 return; 1194 1195 end; 1196 else tbl_item_ptr2 -> data_name.searched = "1"b; 1197 1198 end; 1199 1200 trial = 1; 1201 1202 go to find_new_match; 1203 1204 end; 1205 1206 if tbl_item_ptr1 -> data_name.elementary | tbl_item_ptr2 -> data_name.elementary 1207 then go to find_new_match; 1208 1209 /* if here, then neither was elementary */ 1210 loc1 = loc1 + 1; 1211 loc2 = loc2 + 1; 1212 1213 go to after_initialization; 1214 1215 end; /* end of matching names */ 1216 1217 find_new_match: 1218 link2 = dir2.dir (loc2); 1219 1220 if link2 > loc2 1221 then do; 1222 loc2 = link2; 1223 1224 if dir2.tbl (loc2) ^= 0 1225 then go to set_name2; 1226 else link2 = dir2.dir (loc2); 1227 end; 1228 1229 if trial = 0 1230 then do; 1231 trial = 1; 1232 loc2 = link2 + 1; 1233 go to set_name2; 1234 end; 1235 1236 link1 = dir1.dir (loc1); 1237 ln = link1 - loc1; 1238 declare ln fixed bin (24); 1239 1240 if ln > 0 1241 then do; 1242 loc1 = link1; 1243 loc2 = link2 + 1; 1244 go to after_initialization; 1245 end; 1246 else do while (link1 < loc1); 1247 1248 if link1 ^= 0 1249 then do; 1250 loc1 = link1; 1251 link1 = dir1.dir (loc1); 1252 end; 1253 1254 if link1 = 0 1255 then do; 1256 1257 if null_match 1258 then call error1; 1259 1260 call emit; 1261 1262 return; 1263 1264 end; 1265 end; 1266 1267 loc1 = link1; 1268 1269 do while (link2 < loc2); 1270 1271 loc2 = link2; 1272 link2 = dir2.dir (loc2); 1273 1274 end; 1275 1276 loc2 = link2; 1277 1278 go to after_initialization; 1279 1280 end; 1281 1282 1283 error1: 1284 proc; 1285 1286 err_num = 1; 1287 poss_prior_err = "0"b; 1288 recov = "0"b; 1289 1290 call err_pro; 1291 1292 end; 1293 1294 emit: 1295 proc; 1296 1297 if move_swt 1298 then do; 1299 1300 call corr_in; 1301 1302 if eof 1303 then return; 1304 1305 if data_name.type = 9 1306 then do; 1307 null_match = "1"b; 1308 first_pair = "0"b; 1309 1310 do n = 1 to end_dir1_index; 1311 tbl_item_ptr1 = addr (table1 (dir1.tbl (n))); 1312 tbl_item_ptr1 -> data_name.searched = "0"b; 1313 end; 1314 1315 end_i = recv_i; 1316 call corres_option (1); 1317 end; 1318 1319 end; 1320 1321 else do; 1322 1323 if ose_exists & ^null_match = "1"b 1324 then do; 1325 1326 /*GENERATE STREAM: if gen_item = 1 then*/ 1327 1328 begin_i = 1; 1329 end_i = 4; 1330 1331 gen_ptr (1) = addr (res_wd_if); 1332 gen_ptr (2) = addr (gen_item_t1); 1333 res_wd_greater.key = 102; 1334 gen_ptr (3) = addr (res_wd_greater); 1335 gen_ptr (4) = addr (num_lit_one); 1336 1337 call stream_gen; 1338 1339 end; 1340 1341 end; 1342 end; 1343 1344 1345 1346 initialize_statement: 1347 proc; 1348 1349 err_num = 0; 1350 1351 nu_line = reserved_word.line; 1352 n_array = 1; 1353 gen_label_def.def_line = nu_line; 1354 gen_label_ref.def_line = nu_line; 1355 gen_label_def.name = "NONAME0000"; 1356 gen_label_ref.name = "NONAME0000"; 1357 gen_label_def.section_num = section_number; 1358 gen_label_ref.section_num = section_number; 1359 second_time = "0"b; 1360 array_init_bit = "0"b; 1361 relecture = "0"b; 1362 sending_op = "0"b; 1363 end_initlz_tbl_index = 1; 1364 subscr_dir_index = 0; 1365 code = 0; 1366 1367 call corr_in; 1368 1369 if eof 1370 then do; 1371 err_num = 15; 1372 return; 1373 end; 1374 1375 if data_name.type ^= 9 1376 then do; 1377 err_num = 2; 1378 return; 1379 end; 1380 1381 check_main_initlz_traits: 1382 if data_name.usage_index 1383 then do; /* USAGE IS INDEX */ 1384 err_num = 40; 1385 return; 1386 end; 1387 1388 if data_name.subscripted 1389 then do; /* OCCURS */ 1390 main_item_subscripted = "1"b; 1391 1392 if data_name.occurs_do 1393 then do; /* OCCURS DEPENDING ON */ 1394 err_num = 22; 1395 return; 1396 end; 1397 1398 /* add item to subscript directory */ 1399 1400 if subscr_dir_index = 100 1401 then do; 1402 err_num = 28; 1403 return; 1404 end; 1405 1406 subscr_dir_index = subscr_dir_index + 1; 1407 subscr_directory.index_ct (subscr_dir_index) = 0; 1408 subscr_directory.tokn_ptr (subscr_dir_index) = null (); 1409 subscr_directory.sufx_ptr (subscr_dir_index) = null (); 1410 end; 1411 1412 else main_item_subscripted = "0"b; 1413 1414 /*add item to initlz_item_tbl*/ 1415 1416 main_item_ptr = addr (initlz_item_tbl (end_initlz_tbl_index)); 1417 recsize2 = recsize + mod (-recsize, 4); 1418 1419 if end_initlz_tbl_index + recsize2 >= table1_2_size 1420 then do; 1421 err_num = 27; 1422 return; 1423 end; 1424 1425 main_item_index = end_initlz_tbl_index; 1426 end_initlz_tbl_index = end_initlz_tbl_index + recsize2; 1427 substr (main_item_ptr -> record, 1, recsize) = substr (input_ptr -> record, 1, recsize); 1428 1429 if main_item_subscripted 1430 then do; 1431 req_sub = main_item_ptr -> occurs.dimensions; 1432 ptr1 = addr (main_item_ptr -> any_item (main_item_ptr -> data_name.occurs_ptr)); 1433 subscr_directory.sufx_ptr (subscr_dir_index) = ptr1; 1434 end; 1435 else req_sub = 0; 1436 1437 if data_name.elementary 1438 then do; 1439 main_item_ptr -> data_name.searched = "1"b; 1440 1441 call corr_in; 1442 1443 if eof 1444 then do; 1445 err_num = 15; 1446 return; 1447 end; 1448 if reserved_word.type = 1 1449 then go to sub_ref; 1450 1451 if reserved_word.type ^= 26 1452 then do; 1453 1454 if data_name.type = 9 1455 then do; 1456 1457 if data_name.subscripted 1458 then n_array = n_array + 1; 1459 go to get1; 1460 1461 end; 1462 1463 err_num = 23; 1464 return; 1465 end; 1466 go to got_end_initlz_opnd; 1467 1468 end; 1469 1470 main_item_ptr -> data_name.searched = "0"b; 1471 1472 get_nxt_initlz_member: 1473 call corr_in; 1474 1475 if eof 1476 then do; 1477 err_num = 15; 1478 return; 1479 end; 1480 1481 if data_name.type ^= 9 1482 then do; 1483 if reserved_word.type = 1 1484 then go to sub_ref; 1485 1486 if reserved_word.type ^= 26 1487 then go to get_nxt_initlz_member; 1488 else go to got_end_initlz_opnd; 1489 end; 1490 1491 get1: 1492 if data_name.occurs_do 1493 then do; /*OCCURS DEPENDING ON*/ 1494 1495 if main_item_subscripted 1496 then subscr_dir_index = subscr_dir_index - 1; 1497 1498 end_initlz_tbl_index = main_item_index; 1499 go to get_nxt_initlz_member; 1500 1501 1502 end; 1503 1504 if ^data_name.usage_index & ^data_name.filler_item & ^data_name.s_of_rdf 1505 then do; 1506 1507 ptr2 = addr (initlz_item_tbl (end_initlz_tbl_index)); 1508 recsize2 = recsize + mod (-recsize, 4); 1509 end_initlz_tbl_index = end_initlz_tbl_index + recsize2; 1510 1511 if end_initlz_tbl_index >= table1_2_size 1512 then do; 1513 err_num = 27; 1514 return; 1515 end; 1516 1517 substr (ptr2 -> record, 1, recsize) = substr (input_ptr -> record, 1, recsize); 1518 1519 end; 1520 1521 go to get_nxt_initlz_member; 1522 1523 sub_ref: 1524 if reserved_word.key ^= 187 /* ( */ 1525 then do; 1526 err_num = 28; 1527 return; 1528 end; 1529 1530 sub_ref_1: 1531 call begin_subscripts; 1532 1533 if err_num ^= 0 1534 then return; 1535 1536 got_end_initlz_opnd: 1537 ptr2 = addr (initlz_item_tbl (end_initlz_tbl_index)); 1538 recsize2 = recsize + mod (-recsize, 4); 1539 end_initlz_tbl_index = end_initlz_tbl_index + recsize2; 1540 1541 if end_initlz_tbl_index >= table1_2_size 1542 then do; 1543 err_num = 27; 1544 return; 1545 end; /* type 26 token delimits group */ 1546 1547 substr (ptr2 -> record, 1, recsize) = substr (input_ptr -> record, 1, recsize); 1548 1549 call corr_in; 1550 1551 if eof 1552 then do; 1553 err_num = 15; 1554 return; 1555 end; 1556 1557 if data_name.type = 9 1558 then do; 1559 n_array = n_array + 1; 1560 array_init_bit = "1"b; 1561 go to check_main_initlz_traits; 1562 end; 1563 1564 second_half_initlz: /* assumes token already retrieved */ 1565 /* this type_26 token, immediately following the last group terminator token 1566* which was also a type_26 token, signals the end of the table */ 1567 /* if no items were entered in table, it contains only this type_26 token 1568* signalling an empty table */ 1569 ptr2 = addr (initlz_item_tbl (end_initlz_tbl_index)); 1570 recsize2 = type_26_token.size; 1571 ptr1 = addr (type_26_token); 1572 recsize2 = recsize2 + mod (-recsize2, 4); 1573 end_initlz_tbl_index = end_initlz_tbl_index + recsize2; 1574 1575 if end_initlz_tbl_index >= table1_2_size 1576 then do; 1577 err_num = 27; 1578 return; 1579 end; 1580 1581 substr (ptr2 -> record2, 1, recsize2) = substr (ptr1 -> record2, 1, recsize2); 1582 ptr2 = addr (initlz_item_tbl (1)); 1583 1584 call corr_in; 1585 1586 if eof 1587 then do; 1588 err_num = 15; 1589 return; 1590 end; 1591 1592 if reserved_word.type ^= 1 | reserved_word.key ^= 152 1593 /*REPLACING*/ 1594 then do; 1595 defaults = "1"b; 1596 1597 /* want not to retrieve another token for bos */ 1598 1599 subscr_dir_index = 0; 1600 go to gen_initlz_code; 1601 end; 1602 1603 defaults = "0"b; 1604 sending_op = "1"b; 1605 1606 call corr_in; 1607 1608 if eof 1609 then do; 1610 err_num = 15; 1611 return; 1612 end; 1613 1614 if reserved_word.type ^= 1 1615 then do; 1616 err_num = 23; 1617 return; 1618 end; 1619 1620 if reserved_word.key = 131 /*NUMERIC*/ 1621 then category = 18; 1622 1623 else if reserved_word.key = 132 /*NUMERIC-EDITED*/ 1624 then category = 19; 1625 1626 else if reserved_word.key = 75 /*ALPHANUMERIC*/ 1627 then category = 20; 1628 1629 else if reserved_word.key = 76 /*ALPHANUMERIC-EDITED*/ 1630 then category = 21; 1631 1632 else if reserved_word.key = 74 /*ALPHABETIC*/ 1633 then category = 22; 1634 1635 else do; 1636 err_num = 23; 1637 return; 1638 end; 1639 1640 1641 call corr_in; 1642 1643 if eof 1644 then do; 1645 err_num = 15; 1646 return; 1647 end; 1648 1649 if reserved_word.type ^= 1 1650 then do; 1651 err_num = 38; 1652 return; 1653 end; 1654 1655 if reserved_word.key = 196 1656 then do; /*DATA*/ 1657 1658 call corr_in; 1659 1660 if eof 1661 then do; 1662 err_num = 15; 1663 return; 1664 end; 1665 1666 if reserved_word.type ^= 1 1667 then do; 1668 err_num = 39; 1669 return; 1670 end; 1671 end; 1672 1673 if reserved_word.key ^= 82 /*BY*/ 1674 then do; 1675 err_num = 39; 1676 return; 1677 end; 1678 1679 call corr_in; 1680 1681 if eof 1682 then do; 1683 err_num = 15; 1684 return; 1685 end; 1686 1687 if reserved_word.type = 1 1688 then do; 1689 1690 if reserved_word.key = 73 1691 then do; /* lit. preceded by ALL key word */ 1692 1693 call corr_in; 1694 1695 if eof 1696 then do; 1697 err_num = 15; 1698 return; 1699 end; 1700 1701 if reserved_word.type = 3 1702 then do; 1703 input_ptr -> alphanum_lit.all_lit = "1"b; 1704 go to tst_alph_cat; 1705 end; 1706 end; 1707 end; 1708 1709 if numeric_lit.type = 2 1710 then do; 1711 1712 tst_num_cat: 1713 if category ^= 18 & category ^= 19 1714 then do; 1715 err_num = 26; 1716 return; 1717 end; 1718 store_send_op: 1719 call add_token; 1720 1721 send_op_ptr = token_stack_ptr; 1722 1723 call corr_in; 1724 1725 if eof 1726 then do; 1727 err_num = 15; 1728 return; 1729 end; 1730 1731 if reserved_word.key = 189 1732 then do; 1733 call corr_in; 1734 if eof 1735 then do; 1736 err_num = 15; 1737 return; 1738 end; 1739 end; 1740 1741 subscr_dir_index = 0; 1742 1743 go to gen_initlz_code; 1744 1745 end; 1746 1747 if reserved_word.type = 3 1748 then do; /*alphanumeric literal*/ 1749 1750 tst_alph_cat: 1751 if category = 18 | category = 19 1752 then do; 1753 err_num = 26; 1754 return; 1755 end; 1756 go to store_send_op; 1757 end; 1758 1759 if data_name.type = 9 1760 then do; 1761 descr_ptr = addr (data_name.file_section); 1762 1763 if ^(description (category)) 1764 then do; 1765 err_num = 26; 1766 return; 1767 end; 1768 1769 if ^(data_name.subscripted) /*occurs*/ 1770 then go to store_send_op; 1771 1772 subscr_dir_index = subscr_dir_index + 1; 1773 1774 /*not used, but prevents overlaying of prev area by subscript processing*/ 1775 1776 call add_token; 1777 1778 send_op_ptr = token_stack_ptr; 1779 1780 call corr_in; 1781 1782 if eof 1783 then do; 1784 err_num = 15; 1785 return; 1786 end; 1787 1788 if reserved_word.type = 1 1789 then if reserved_word.key = 187 /* ( */ 1790 then go to sub_ref_1; 1791 1792 else do; 1793 err_num = 3; 1794 return; 1795 end; 1796 end; 1797 1798 if reserved_word.type = 1 1799 then do; 1800 1801 if reserved_word.key = 180 /*zeroes*/ 1802 then go to tst_num_cat; 1803 if reserved_word.key = 192 /*spaces*/ 1804 then go to tst_alph_cat; 1805 end; 1806 1807 err_num = 34; 1808 1809 return; 1810 1811 gen_initlz_code: 1812 if subscr_cnt ^= req_sub 1813 then do; 1814 err_num = 43; 1815 return; 1816 end; 1817 1818 array_init_bit = "0"b; 1819 1820 more_code: 1821 if ptr2 -> reserved_word.type = 26 1822 then return; /* was end_of_initlz_tbl_fnd */ 1823 1824 null_match = "1"b; 1825 1826 if ptr2 -> data_name.subscripted 1827 then do; /* OCCURS */ 1828 subscr_dir_index = subscr_dir_index + 1; 1829 main_item_subscripted = "1"b; 1830 end; 1831 else main_item_subscripted = "0"b; 1832 1833 test_item_elementary: 1834 if (ptr2 -> data_name.elementary) 1835 then do; 1836 1837 if defaults 1838 then do; 1839 1840 if match_cat () 1841 then call gen_assign; 1842 1843 end; 1844 else do; 1845 descr_ptr = addr (ptr2 -> data_name.file_section); 1846 if description (category) 1847 then call gen_assign; 1848 else n_array = n_array - 1; 1849 end; 1850 1851 1852 end; 1853 1854 n = ptr2 -> reserved_word.size; 1855 n = n + mod (-n, 4); 1856 ptr2 = addr (ptr2 -> any_item (n + 1)); 1857 1858 if ptr2 -> reserved_word.type = 26 1859 then do; /* group terminator */ 1860 1861 if null_match 1862 then do; 1863 err_num = 25; 1864 poss_prior_err = "0"b; 1865 1866 call err_pro; 1867 1868 end; 1869 1870 n = ptr2 -> reserved_word.size; 1871 n = n + mod (-n, 4); 1872 ptr2 = addr (ptr2 -> any_item (n + 1)); 1873 1874 go to more_code; 1875 1876 end; 1877 1878 go to test_item_elementary; 1879 1880 end; 1881 1882 1883 1884 setup_gen_lit: 1885 proc; 1886 1887 declare fixbin15 fixed bin; /* fills in fields in generated numeric literal tokens for perform control values */ 1888 1889 gen_num_lit_mindim.size = 36; 1890 fixbin15 = ptr1 -> occurs.level.max (curr_dim); 1891 cv_string = bin_to_char (fixbin15, cvindex); 1892 gen_num_lit_mindim.places = 10 - cvindex; 1893 1894 substr (gen_num_lit_mindim.literal, 1, gen_num_lit_mindim.places) = 1895 substr (cv_string, cvindex + 1, gen_num_lit_mindim.places); 1896 1897 gen_num_lit_mindim.size = gen_num_lit_mindim.size + gen_num_lit_mindim.places; 1898 gen_num_lit_mindim.places_left = gen_num_lit_mindim.places; 1899 1900 end; 1901 1902 1903 1904 1905 1906 1907 1908 1909 dcl 1 message internal static, 1910 2 size fixed bin init (0), 1911 2 line fixed bin init (0), 1912 2 column fixed bin init (0), 1913 2 type fixed bin init (5), 1914 2 run fixed bin init (8), 1915 2 number fixed bin init (0), 1916 2 infobits, 1917 3 info1 bit (1) init ("0"b), 1918 3 info2 bit (1) init ("0"b), 1919 3 info3 bit (6) init ("0"b), 1920 2 length fixed bin init (0), 1921 2 image char (200); 1922 1923 1924 1925 err_pro: 1926 proc; 1927 if poss_prior_err & ^eof 1928 then do; 1929 1930 if reserved_word.type = 5 /*message from earlier phase caused error*/ 1931 then call cobol_swf_put (outfp, fst, input_ptr, reserved_word.size); 1932 1933 end; 1934 1935 message.number = err_num; 1936 message.length = index (err_image, "*"); 1937 1938 if message.length > 0 1939 then message.length = message.length - 1; 1940 1941 output_ptr = addr (message); 1942 1943 if message.length = 0 1944 then do; 1945 message.info1 = "0"b; 1946 end; 1947 else do; 1948 substr (message.image, 1, message.length) = substr (err_image, 1, message.length); 1949 substr (err_image, 1, 1) = "*"; 1950 message.info1 = "1"b; 1951 end; 1952 1953 message.infobits.info2 = "0"b; 1954 message.line = reserved_word.line; 1955 message.column = reserved_word.column; 1956 message.size = 32 + message.length; 1957 1958 call cobol_swf_put (outfp, fst, output_ptr, message.size); 1959 1960 poss_prior_err = "1"b; 1961 1962 if ^recov 1963 then return; 1964 1965 if reserved_word.terminator /*period or verb*/ | reserved_word.end_cobol = "1"b 1966 /*special generated end-cobol token*/ 1967 then do; 1968 recov = "0"b; 1969 return; 1970 end; 1971 1972 message.number = 7; /* syntax checking discontinued message */ 1973 message.size = 28; 1974 message.info1 = "0"b; 1975 message.infobits.info2 = "1"b; 1976 recovering = "1"b; 1977 1978 call cobol_swf_put (outfp, fst, output_ptr, output_ptr -> reserved_word.size); 1979 1980 code = 2; 1981 1982 call corr_in; 1983 1984 recovering = "0"b; 1985 1986 if eof 1987 then return; 1988 1989 if reserved_word.key = 98 & reserved_word.terminator & reserved_word.end_cobol 1990 then do; /* special end_cobol token */ 1991 1992 call cobol_swf_put (outfp, fst, input_ptr, recsize); 1993 1994 eof = "1"b; 1995 recov = "0"b; 1996 return; 1997 1998 end; 1999 2000 message.number = 8; /*syntax checking resumed message */ 2001 message.line = reserved_word.line; 2002 message.column = reserved_word.column; 2003 2004 call cobol_swf_put (outfp, fst, output_ptr, output_ptr -> reserved_word.size); 2005 2006 recov = "0"b; 2007 end; 2008 2009 2010 2011 corr_in: 2012 proc; 2013 2014 2015 dcl first_time_in_get_1 bit (1); 2016 2017 2018 2019 dcl 1 message based (input_ptr), 2020 2 size fixed bin, 2021 2 line fixed bin, 2022 2 column fixed bin, 2023 2 type fixed bin, 2024 2 run fixed bin, 2025 2 number fixed bin, 2026 2 infobits, 2027 3 info1 bit (1), 2028 3 info2 bit (1), 2029 3 info3 bit (6); 2030 2031 2032 dcl 1 debug_token based (input_ptr), 2033 2 size fixed bin, 2034 2 line fixed bin, 2035 2 column fixed bin, 2036 2 type fixed bin, 2037 2 index fixed bin, 2038 2 switch bit (1); 2039 2040 2041 2042 first_time_in_get_1 = "1"b; 2043 2044 go to get (code); 2045 2046 get (0): /*any token except type 6 */ 2047 /*or type 5 with info(2) off */ 2048 call cobol_swf_get (infp, fst, input_ptr, recsize); 2049 2050 2051 if substr (fst, 17, 16) = "0000000000100111"b 2052 then do; 2053 eof = "1"b; 2054 recovering = "0"b; 2055 return; 2056 end; 2057 2058 if message.type = 5 2059 then do; 2060 2061 if code = 0 2062 then do; 2063 2064 if message.infobits.info2 2065 then return; 2066 go to get (0); 2067 end; 2068 2069 else go to write_tok; 2070 end; 2071 2072 if debug_token.type = 24 2073 then go to write_tok; 2074 2075 if data_name.type = 9 2076 then do; 2077 inf_ptr = addr (data_name.searched); 2078 inf = "0"b; 2079 end; 2080 2081 return; 2082 2083 get (1): /* add, subtract, or move */ 2084 if first_time_in_get_1 2085 then do; 2086 2087 if lk_ahd_index > 0 2088 then do n = 1 to lk_ahd_index; 2089 output_ptr = lk_ahd_ptr (n); 2090 recsize = output_ptr -> reserved_word.size; 2091 2092 call cobol_swf_put (outfp, fst, output_ptr, recsize); 2093 2094 end; 2095 2096 add_swt = "0"b; 2097 subtract_swt = "0"b; 2098 move_swt = "0"b; 2099 initlz_swt = "0"b; 2100 first_time_in_get_1 = "0"b; 2101 if input_ptr ^= null () 2102 then go to test_token_get1; 2103 2104 call cobol_swf_get (infp, fst, input_ptr, recsize); 2105 2106 if substr (fst, 17, 16) = "0000000000100111"b 2107 then do; 2108 eof = "1"b; 2109 return; 2110 end; 2111 2112 if reserved_word.type = 1 & reserved_word.key = 189 2113 /* . */ 2114 then do; 2115 call cobol_swf_get (infp, fst, input_ptr, recsize); 2116 if substr (fst, 17, 16) = "0000000000100111"b 2117 then do; 2118 eof = "1"b; 2119 return; 2120 end; 2121 end; 2122 end; 2123 else call cobol_swf_get (infp, fst, input_ptr, recsize); 2124 2125 if substr (fst, 17, 16) = "0000000000100111"b 2126 then do; 2127 eof = "1"b; 2128 return; 2129 end; 2130 2131 test_token_get1: 2132 if proc_def.type = 7 2133 then do; 2134 section_number = proc_def.section_num; 2135 end; 2136 2137 if debug_token.type = 24 2138 then go to write_tok; 2139 2140 if reserved_word.type = 1 2141 then do; 2142 2143 if reserved_word.key = 2 2144 then do; 2145 add_swt = "1"b; 2146 return; 2147 end; 2148 2149 if reserved_word.key = 11 2150 then do; 2151 subtract_swt = "1"b; 2152 return; 2153 end; 2154 2155 if reserved_word.key = 18 2156 then do; 2157 move_swt = "1"b; 2158 return; 2159 end; 2160 2161 if reserved_word.key = 13 2162 then do; 2163 initlz_swt = "1"b; 2164 return; 2165 end; 2166 end; 2167 2168 go to passover; 2169 2170 get (2): /* statement terminator */ 2171 call cobol_swf_get (infp, fst, input_ptr, recsize); 2172 2173 if substr (fst, 17, 16) = "0000000000100111"b 2174 then eof = "1"b; 2175 2176 if eof 2177 then return; 2178 2179 if reserved_word.type = 1 2180 then if reserved_word.terminator 2181 then return; 2182 2183 passover: 2184 if message.type = 5 2185 then if code = 0 2186 then do; 2187 2188 if message.infobits.info2 2189 then return; 2190 go to get (0); 2191 end; 2192 2193 if ^recovering 2194 then go to write_tok; 2195 2196 if message.type = 5 2197 then go to write_tok; 2198 2199 if debug_token.type = 24 2200 then go to write_tok; 2201 go to get (code); 2202 2203 write_tok: 2204 if data_name.type ^= 26 2205 then call cobol_swf_put (outfp, fst, input_ptr, recsize); 2206 2207 go to get (code); 2208 2209 end; 2210 2211 2212 2213 add_token: 2214 proc; 2215 2216 /*** adds token to token_stack -- for later output order ***/ 2217 2218 token_stack_ptr = addr (token_stack (top_token_stack)); 2219 substr (token_stack_ptr -> record, 1, recsize) = substr (input_ptr -> record, 1, recsize); 2220 n = token_stack_ptr -> reserved_word.size; 2221 top_token_stack = top_token_stack + n + mod (-n, 4); 2222 end; 2223 2224 2225 2226 remove_token: 2227 proc; 2228 2229 /***pops token stack -- when token added prematurely ***/ 2230 2231 2232 recsize2 = token_stack_ptr -> reserved_word.size; 2233 recsize2 = recsize2 + mod (-recsize2, 4); 2234 top_token_stack = top_token_stack - recsize2; 2235 end; 2236 2237 2238 2239 stream_gen: 2240 proc; 2241 2242 /***generates stream of minpral tokens from gen_ptr(begin_i) to gen_ptr(end_i) ***/ 2243 2244 do i = begin_i to end_i; 2245 2246 output_ptr = gen_ptr (i); 2247 2248 if output_ptr -> reserved_word.line = 0 2249 then output_ptr -> reserved_word.line = nu_line; 2250 2251 call cobol_swf_put (outfp, fst, output_ptr, output_ptr -> reserved_word.size); 2252 2253 output_ptr -> reserved_word.line = 0; 2254 end; 2255 2256 end; 2257 2258 2259 2260 2261 2262 bin_to_char: 2263 proc (value_sent, cv_index) returns (char (10)); 2264 2265 2266 2267 dcl dec_digits char (10) internal static init ("0123456789"); 2268 dcl bin_val fixed bin; 2269 dcl value_sent fixed bin; 2270 dcl cv_index fixed bin; 2271 dcl cv_string char (10); 2272 dcl remainder fixed bin; 2273 2274 2275 2276 bin_val = value_sent; 2277 cv_string = (10)" "; 2278 cv_index = 10; 2279 2280 2281 if bin_val = 0 2282 then do; 2283 substr (cv_string, 10, 1) = "0"; 2284 cv_index = 9; 2285 end; 2286 else do while (bin_val > 0); 2287 remainder = mod (bin_val, 10); 2288 substr (cv_string, cv_index, 1) = substr (dec_digits, remainder + 1, 1); 2289 bin_val = divide (bin_val, 10, 15, 0); 2290 cv_index = cv_index - 1; 2291 end; 2292 2293 return (cv_string); 2294 2295 end; 2296 2297 2298 2299 2300 2301 gen_assign: 2302 proc; 2303 2304 2305 /*** sets up gen_ptr stack values for an INITIALIZE pair ***/ 2306 2307 dcl sub_level fixed bin; 2308 dcl ind_level fixed bin; 2309 dcl perform_bit bit (1); 2310 2311 2312 2313 2314 null_match = "0"b; 2315 perform_bit = "0"b; 2316 fixbin_diff = "0"b; 2317 2318 if ptr2 -> data_name.subscripted 2319 then do; /* this item is array */ 2320 ptr1 = addr (ptr2 -> any_item (ptr2 -> data_name.occurs_ptr)); 2321 2322 if main_item_subscripted 2323 then do; 2324 ptr4 = subscr_directory.sufx_ptr (subscr_dir_index); 2325 2326 if ptr4 -> occurs.dimensions < ptr1 -> occurs.dimensions 2327 then do; 2328 2329 /* this item has more dimensions than main item */ 2330 2331 sub_level = ptr4 -> occurs.dimensions + 1; 2332 go to perform_reqd; 2333 end; 2334 2335 if array_init_bit 2336 then do; 2337 sub_level = 1; 2338 2339 end; 2340 end; 2341 2342 /* array within non-array */ 2343 2344 else do; 2345 sub_level = 1; 2346 go to perform_reqd; 2347 end; 2348 end; 2349 2350 /* no additional dimensions in this item over main item's */ 2351 2352 gen_ptr (1) = addr (res_wd_move); 2353 2354 if defaults 2355 then do; 2356 2357 if category < 20 2358 then gen_ptr (2) = addr (res_wd_zeroes); 2359 else gen_ptr (2) = addr (res_wd_spaces); 2360 end; 2361 2362 else gen_ptr (2) = send_op_ptr; 2363 2364 gen_ptr (3) = addr (res_wd_to); 2365 gen_ptr (4) = ptr2; 2366 end_i = 4; 2367 2368 if main_item_subscripted 2369 then do; 2370 gen_ptr (5) = addr (res_wd_lparen); 2371 ptr3 = subscr_directory.tokn_ptr (subscr_dir_index); 2372 2373 stk_subscr_tokns: 2374 end_i = end_i + 1; 2375 gen_ptr (end_i) = ptr3; 2376 2377 2378 if ptr3 -> reserved_word.type = 1 2379 then if ptr3 -> reserved_word.key = 188 2380 then /* ) */ 2381 do; 2382 call stream_gen; 2383 n_array = n_array - 1; 2384 array_init_bit = "1"b; 2385 return; 2386 end; 2387 2388 n = ptr3 -> reserved_word.size; 2389 n = n + mod (-n, 4); 2390 ptr3 = addr (ptr3 -> any_item (n + 1)); 2391 2392 go to stk_subscr_tokns; 2393 2394 end; 2395 2396 call stream_gen; 2397 second_time = "0"b; 2398 array_init_bit = "0"b; 2399 n_array = n_array - 1; 2400 return; 2401 2402 perform_reqd: 2403 perform_bit = "1"b; 2404 2405 if fixbin15 ^= 0 2406 then if (fixbin15 - 1) ^= ptr1 -> occurs.level.min (curr_dim) 2407 then do; 2408 second_time = "0"b; 2409 fixbin_diff = "1"b; 2410 end; 2411 2412 if second_time 2413 then do; 2414 i = 1; 2415 go to several_time; 2416 end; 2417 2418 if ^initlz_items_allocated 2419 then do; 2420 2421 save_the_key = "1"b; 2422 2423 if gen_item_allocated 2424 then go to allocate_t2; 2425 2426 fixbin24 = gen_item_t1.size; 2427 2428 call allocate_item (fixbin24, 0, 0, off, off, off, on, off, off, alloc_seg, alloc_offset); 2429 2430 gen_item_t1.seg_num = alloc_seg; 2431 gen_item_t1.offset = alloc_offset; 2432 2433 allocate_t2: /* allocation du deuxieme article */ 2434 fixbin24 = gen_item_t2.size; 2435 2436 call allocate_item (fixbin24, 0, 0, off, off, off, on, off, off, alloc_seg, alloc_offset); 2437 2438 gen_item_t2.seg_num = alloc_seg; 2439 gen_item_t2.offset = alloc_offset; 2440 fixbin24 = gen_item_t3.size; 2441 2442 call allocate_item (fixbin24, 0, 0, off, off, off, on, off, off, alloc_seg, alloc_offset); 2443 2444 gen_item_t3.seg_num = alloc_seg; 2445 gen_item_t3.offset = alloc_offset; 2446 initlz_items_allocated = "1"b; 2447 end; 2448 2449 else save_the_key = "0"b; 2450 2451 /* either main item had no dimensions or main item had 1 or 2 dimensions; 2452* in either case, this item has more dimensions than main item */ 2453 2454 fixed_common.spec_tag_counter = fixed_common.spec_tag_counter + 1; 2455 gen_label_ref.proc_num = fixed_common.spec_tag_counter; 2456 gen_label_def.proc_num = fixed_common.spec_tag_counter; 2457 2458 gen_ptr (1) = addr (gen_label_def); 2459 2460 call write_gen_label (gen_ptr (1)); /* added to give a name to label */ 2461 2462 if main_item_subscripted 2463 then do; 2464 2465 ptr3 = subscr_directory.tokn_ptr (subscr_dir_index); 2466 2467 if subscr_directory.index_ct (subscr_dir_index) > 0 2468 then do; 2469 2470 /* main item's subscript string includes indices */ 2471 /** generate code to SET index value(s) to non-index variables for loop **/ 2472 2473 ind_level = 1; 2474 2475 set_main_indices: 2476 if ptr3 -> index_name.type = 10 2477 then do; 2478 2479 if ^(ptr3 -> index_name.searched) 2480 then do; 2481 gen_ptr (2) = addr (gen_item_t1); 2482 ptr3 -> index_name.searched = "1"b; 2483 end; 2484 else do; 2485 gen_ptr (2) = addr (gen_item_t2); 2486 ptr3 -> index_name.duplicate = "1"b; 2487 end; 2488 2489 gen_ptr (1) = addr (res_wd_set); 2490 gen_ptr (3) = addr (res_wd_to); 2491 gen_ptr (4) = ptr3; 2492 end_i = 4; 2493 2494 call stream_gen; 2495 2496 n = ptr3 -> reserved_word.size; 2497 n = n + mod (-n, 4); 2498 ptr3 = addr (ptr3 -> any_item (n + 1)); 2499 2500 if ptr3 -> reserved_word.type = 1 2501 then do; 2502 2503 if ptr3 -> reserved_word.key = 182 2504 then /* + */ 2505 do; 2506 gen_ptr (1) = addr (res_wd_add); 2507 2508 gen_rest: 2509 gen_ptr (4) = gen_ptr (2); 2510 n = ptr3 -> reserved_word.size; 2511 n = n + mod (-n, 4); 2512 gen_ptr (2) = addr (ptr3 -> any_item (n + 1)); 2513 2514 call stream_gen; 2515 2516 ptr3 -> reserved_word.type = 0; 2517 gen_ptr (2) -> reserved_word.type = 0; 2518 n = gen_ptr (2) -> reserved_word.size; 2519 n = n + mod (-n, 4); 2520 ptr3 = addr (gen_ptr (2) -> any_item (n + 1)); 2521 end; 2522 2523 else if ptr3 -> reserved_word.key = 183 2524 then /* - */ 2525 do; 2526 gen_ptr (1) = addr (res_wd_subtract); 2527 gen_ptr (3) = addr (res_wd_from); 2528 go to gen_rest; 2529 end; 2530 end; 2531 end; 2532 2533 else do; 2534 n = ptr3 -> reserved_word.size; 2535 n = n + mod (-n, 4); 2536 ptr3 = addr (ptr3 -> any_item (n + 1)); 2537 go to set_main_indices; 2538 end; 2539 2540 if ind_level ^= subscr_directory.index_ct (subscr_dir_index) 2541 then do; 2542 ind_level = ind_level + 1; 2543 go to set_main_indices; 2544 end; 2545 2546 end; 2547 end; 2548 2549 /** generate PERFORM **/ 2550 2551 if fixbin_diff 2552 then do; 2553 gen_label_def.proc_num = gen_label_def.proc_num - 1; 2554 gen_ptr (1) = addr (res_wd_dot); 2555 gen_ptr (2) = addr (gen_label_def); 2556 2557 call write_gen_label (gen_ptr (2)); 2558 2559 gen_ptr (3) = addr (res_wd_dot); 2560 end_i = 3; 2561 2562 call stream_gen; 2563 2564 fixbin_diff = "0"b; 2565 end; 2566 2567 gen_ptr (1) = addr (res_wd_perform); 2568 gen_ptr (2) = addr (gen_label_ref); 2569 2570 call write_gen_label (gen_ptr (2)); 2571 2572 gen_ptr (3) = addr (res_wd_varying); 2573 end_i = 3; 2574 res_wd_greater.key = 113; 2575 2576 if sub_level = 3 2577 then go to level3_gen; 2578 2579 if sub_level = 2 2580 then go to level2_gen; 2581 2582 curr_dim = 1; 2583 2584 call setup_gen_lit; 2585 2586 gen_item_t1.length = gen_num_lit_mindim.places; 2587 gen_item_t1.places_left = gen_num_lit_mindim.places; 2588 2589 gen_ptr (4) = addr (gen_item_t1); 2590 gen_ptr (5) = addr (res_wd_from); 2591 gen_ptr (6) = addr (num_lit_one); 2592 gen_ptr (7) = addr (res_wd_by); 2593 gen_ptr (8) = addr (num_lit_one); 2594 gen_ptr (9) = addr (res_wd_until); 2595 gen_ptr (10) = addr (gen_item_t1); 2596 gen_ptr (11) = addr (res_wd_greater); 2597 gen_ptr (12) = addr (gen_num_lit_mindim); 2598 end_i = 12; 2599 2600 call stream_gen; 2601 2602 if ptr1 -> occurs.dimensions = 1 2603 then go to gen_move_label; 2604 2605 gen_ptr (1) = addr (res_wd_after); 2606 end_i = 1; 2607 2608 level2_gen: 2609 curr_dim = 2; 2610 2611 call setup_gen_lit; 2612 2613 end_i = end_i + 1; 2614 gen_item_t2.length = gen_num_lit_mindim.places; 2615 gen_item_t2.places_left = gen_num_lit_mindim.places; 2616 2617 gen_ptr (end_i) = addr (gen_item_t2); 2618 end_i = end_i + 1; 2619 gen_ptr (end_i) = addr (res_wd_from); 2620 end_i = end_i + 1; 2621 gen_ptr (end_i) = addr (num_lit_one); 2622 end_i = end_i + 1; 2623 gen_ptr (end_i) = addr (res_wd_by); 2624 end_i = end_i + 1; 2625 gen_ptr (end_i) = addr (num_lit_one); 2626 end_i = end_i + 1; 2627 gen_ptr (end_i) = addr (res_wd_until); 2628 end_i = end_i + 1; 2629 gen_ptr (end_i) = addr (gen_item_t2); 2630 end_i = end_i + 1; 2631 gen_ptr (end_i) = addr (res_wd_greater); 2632 end_i = end_i + 1; 2633 gen_ptr (end_i) = addr (gen_num_lit_mindim); 2634 2635 call stream_gen; 2636 2637 if ptr1 -> occurs.dimensions = 2 2638 then go to gen_move_label; 2639 2640 gen_ptr (1) = addr (res_wd_after); 2641 end_i = 1; 2642 2643 level3_gen: 2644 curr_dim = 3; 2645 2646 call setup_gen_lit; 2647 2648 end_i = end_i + 1; 2649 gen_item_t3.length = gen_num_lit_mindim.places; 2650 gen_item_t3.places_left = gen_num_lit_mindim.places; 2651 2652 gen_ptr (end_i) = addr (gen_item_t3); 2653 end_i = end_i + 1; 2654 gen_ptr (end_i) = addr (res_wd_from); 2655 end_i = end_i + 1; 2656 gen_ptr (end_i) = addr (num_lit_one); 2657 end_i = end_i + 1; 2658 gen_ptr (end_i) = addr (res_wd_by); 2659 end_i = end_i + 1; 2660 gen_ptr (end_i) = addr (num_lit_one); 2661 end_i = end_i + 1; 2662 gen_ptr (end_i) = addr (res_wd_until); 2663 end_i = end_i + 1; 2664 gen_ptr (end_i) = addr (gen_item_t3); 2665 end_i = end_i + 1; 2666 gen_ptr (end_i) = addr (res_wd_greater); 2667 end_i = end_i + 1; 2668 gen_ptr (end_i) = addr (gen_num_lit_mindim); 2669 2670 call stream_gen; 2671 2672 gen_move_label: 2673 fixed_common.spec_tag_counter = fixed_common.spec_tag_counter + 1; 2674 gen_label_ref.proc_num = fixed_common.spec_tag_counter; 2675 gen_label_def.proc_num = fixed_common.spec_tag_counter; 2676 gen_ptr (1) = addr (res_wd_go); 2677 gen_ptr (2) = addr (res_wd_to); 2678 gen_ptr (3) = addr (gen_label_ref); 2679 2680 call write_gen_label (gen_ptr (3)); 2681 2682 gen_ptr (4) = addr (res_wd_dot); 2683 gen_label_def.proc_num = gen_label_def.proc_num - 1; 2684 2685 gen_ptr (5) = addr (gen_label_def); 2686 2687 call write_gen_label (gen_ptr (5)); 2688 2689 gen_ptr (6) = addr (res_wd_dot); 2690 gen_ptr (7) = addr (res_wd_move); 2691 2692 i = 8; 2693 2694 if defaults 2695 then do; 2696 if category < 20 2697 then gen_ptr (i) = addr (res_wd_zeroes); 2698 else gen_ptr (i) = addr (res_wd_spaces); 2699 end; 2700 2701 else do; 2702 2703 gen_ptr (i) = send_op_ptr; 2704 2705 if send_op_ptr -> data_name.type = 9 2706 then do; 2707 2708 if send_op_ptr -> data_name.subscripted 2709 /*OCCURS*/ 2710 then do; 2711 nxt_send_op_subscr: 2712 n = gen_ptr (i) -> data_name.size; 2713 n = n + mod (-n, 4); 2714 i = i + 1; 2715 gen_ptr (i) = addr (gen_ptr (i - 1) -> any_item (n + 1)); 2716 2717 if gen_ptr (i) -> reserved_word.type = 1 2718 then do; 2719 if gen_ptr (i) -> reserved_word.key = 188 2720 then go to end_send_op_gen; 2721 end; 2722 go to nxt_send_op_subscr; 2723 end; 2724 end_send_op_gen: 2725 end; 2726 2727 end; 2728 2729 i = i + 1; 2730 gen_ptr (i) = addr (res_wd_to); 2731 i = i + 1; 2732 2733 several_time: 2734 gen_ptr (i) = ptr2; 2735 end_i = i; 2736 2737 call stream_gen; 2738 2739 /* if array_init_bit 2740* then do; 2741* array_init_bit = "0"b; 2742* go to gen_lpar; 2743* end; */ 2744 2745 if main_item_subscripted 2746 then do; 2747 2748 /* give subscripts from subscript area */ 2749 2750 ptr3 = subscr_directory.tokn_ptr (subscr_dir_index); 2751 end_i = 0; 2752 2753 test_subscr_type: 2754 if ptr3 -> reserved_word.type = 0 2755 then go to get_nxt_subscript; /* 2756* /* this was from index +_ literal for main item -- replaced by SET and ADD or SUBTRACT */ 2757 2758 if ptr3 -> index_name.type = 10 2759 then do; 2760 end_i = end_i + 1; 2761 2762 if ptr3 -> index_name.searched 2763 then gen_ptr (end_i) = addr (gen_item_t1); 2764 else gen_ptr (end_i) = addr (gen_item_t2); 2765 2766 ptr3 -> index_name.searched = "0"b; 2767 ptr3 -> index_name.duplicate = "0"b; 2768 end; 2769 else do; 2770 if ptr3 -> reserved_word.type = 1 2771 then if ptr3 -> reserved_word.key = 188 2772 then go to test_extra_subscr; 2773 end_i = end_i + 1; 2774 gen_ptr (end_i) = ptr3; 2775 end; 2776 2777 get_nxt_subscript: 2778 n = ptr3 -> reserved_word.size; 2779 n = n + mod (-n, 4); 2780 ptr3 = addr (ptr3 -> any_item (n + 1)); 2781 2782 go to test_subscr_type; 2783 2784 end; 2785 2786 test_extra_subscr: /* there is always at least one */ 2787 if ^main_item_subscripted 2788 then do; 2789 gen_lpar: 2790 end_i = 1; 2791 gen_ptr (1) = addr (res_wd_lparen); 2792 end; 2793 2794 if sub_level = 3 2795 then go to gen_level3; 2796 2797 if sub_level = 2 2798 then go to gen_level2; 2799 2800 end_i = end_i + 1; 2801 gen_ptr (end_i) = addr (gen_item_t1); 2802 2803 if ptr1 -> occurs.dimensions = 1 2804 then go to gen_rparen; 2805 2806 gen_level2: 2807 end_i = end_i + 1; 2808 gen_ptr (end_i) = addr (gen_item_t2); 2809 2810 if ptr1 -> occurs.dimensions = 2 2811 then go to gen_rparen; 2812 2813 gen_level3: 2814 end_i = end_i + 1; 2815 gen_ptr (end_i) = addr (gen_item_t3); 2816 2817 gen_rparen: 2818 end_i = end_i + 1; 2819 gen_ptr (end_i) = addr (res_wd_rparen); 2820 2821 end_i = end_i + 1; 2822 gen_ptr (end_i) = addr (res_wd_dot); 2823 2824 call stream_gen; 2825 2826 call genlabel; 2827 2828 if n_array > 1 2829 then do; 2830 2831 second_time = "0"b; 2832 n_array = n_array - 1; 2833 array_init_bit = "1"b; 2834 2835 end; 2836 2837 return; 2838 2839 2840 2841 genlabel: 2842 proc; 2843 2844 if perform_bit 2845 then do; 2846 perform_bit = "0"b; 2847 gen_label_def.proc_num = gen_label_def.proc_num + 1; 2848 gen_ptr (1) = addr (gen_label_def); 2849 2850 call write_gen_label (gen_ptr (1)); 2851 2852 gen_ptr (2) = addr (res_wd_dot); 2853 end_i = 2; 2854 2855 call stream_gen; 2856 2857 end; 2858 2859 end; 2860 2861 end; 2862 2863 write_gen_label: 2864 proc (label_ptr); 2865 2866 dcl label_ptr ptr; 2867 2868 dcl 1 general_label based (label_ptr), 2869 2 size fixed bin, 2870 2 line fixed bin, 2871 2 column fixed bin, 2872 2 type fixed bin, 2873 2 string_ptr ptr, 2874 2 prev_rec ptr, 2875 2 info bit (8), 2876 2 priority char (2), /* 1 multics char(1), */ 2877 2 repl_bit bit (8), 2878 2 section_num fixed bin, 2879 2 proc_num fixed bin, 2880 2 def_line fixed bin, 2881 2 length fixed bin, 2882 2 name char (10); 2883 dcl string_ctr char (10); 2884 dcl scale fixed bin; 2885 2886 2887 2888 string_ctr = bin_to_char (label_ptr -> general_label.proc_num, scale); 2889 substr (general_label.name, scale + 1, 10 - scale) = substr (string_ctr, scale + 1, 10 - scale); 2890 2891 end; 2892 2893 2894 2895 match_cat: 2896 proc returns (bit (1)); 2897 2898 do category = 18 to 22 by 1; 2899 descr_ptr = addr (ptr2 -> data_name.file_section); 2900 if description (category) 2901 then return ("1"b); 2902 end; 2903 2904 return ("0"b); 2905 2906 end; 2907 2908 2909 2910 /* merge allocate_item in internal */ 2911 2912 allocate_item: 2913 proc (al_size, al_elem_offset, al_occ_offset, al_read_only, al_bitt, al_byte, al_half_word, al_word, al_double_word, 2914 al_rec_seg, al_rec_off); 2915 2916 /* pointers */ 2917 /* suppress cobol_com_ptr declared in begining cobol_ci_phase 2918* dcl cobol_com_ptr ptr ext; */ 2919 /* pointer to fixed common, set by driver */ 2920 dcl ft_ptr ptr; /* pointer to current file table record in common */ 2921 dcl seg_ptr ptr; /* pointer to segment-information entry in common */ 2922 dcl prev_seg_ptr ptr; /* previous value of seg_ptr saved here by allocate_item */ 2923 /* cobol_cmfp external pointer must be declared in cobol_ci_phase 2924* dcl cobol_cmfp ptr ext; 2925* */ 2926 /* cobol_vdwf_dput and dget are declared in cobol_ci_phase 2927* dcl cobol_vdwf_dget ext entry(ptr,bit(32),ptr,fixed bin,char(5)); 2928* dcl cobol_vdwf_dput ext entry(ptr,bit(32),ptr,fixed bin,char(5)); 2929* */ 2930 /* description of data division segment information table in common */ 2931 dcl 1 dd_segment based (seg_ptr), 2932 2 next char (5), /* record number in common of next segment information record */ 2933 2 seg_no fixed bin (7), 2934 2 next_avail_loc fixed bin (24), 2935 2 duplicate_next_loc 2936 fixed bin (24), 2937 2 read_only bit (1); /* character string work fields */ 2938 dcl work_area char (25), 2939 seg_size fixed bin; /* fixed binary work fields */ 2940 dcl common_recsize fixed bin; /* size of record just read from common file */ 2941 dcl common_key char (5); /* record number of common record just read or to be read */ 2942 dcl elem_offset_limit fixed bin (24); 2943 dcl occ_offset_limit fixed bin (24); 2944 dcl second_occ_limit fixed bin (24); /* 2**15 + 2**12 - 1 */ 2945 dcl next_loc_used fixed bin (24); /* work area used by allocate_item */ 2946 dcl work31 fixed bin (24); 2947 dcl double_word_slack fixed bin (7); 2948 dcl word_slack fixed bin (7); 2949 dcl half_word_slack fixed bin (7); /* bit strings */ 2950 2951 dcl common_eof bit (1); /* set on if end-of-file encountered on read of common file */ 2952 dcl al_size fixed bin (24); /* size of item to be allocated */ 2953 dcl al_elem_offset fixed bin (24); /* largest offset of any contained elementary item not in a table */ 2954 dcl al_occ_offset fixed bin (24); /* largest offset of any contained table item */ 2955 dcl al_rec_seg fixed bin; /* segment number assigned to item */ 2956 dcl al_rec_off fixed bin (24); /* offset assigned to item */ 2957 dcl al_read_only bit (1); /* read only requirement of the item */ 2958 dcl al_bitt bit (1); /* boundary requirement of the item */ 2959 dcl al_byte bit (1); 2960 dcl al_half_word bit (1); 2961 dcl al_word bit (1); 2962 dcl al_double_word bit (1); 2963 2964 2965 2966 seg_size = 21; 2967 elem_offset_limit = 262144; 2968 occ_offset_limit = 262144; 2969 second_occ_limit = 262144; 2970 2971 if new_seg_bit = off 2972 then do; /* have any segments been started yet? */ 2973 2974 if fixed_common.seg_info = "00000" | al_size ^< fixed_common.dd_seg_size 2975 then go to new_segment_needed; 2976 end; 2977 2978 common_key = fixed_common.seg_info; 2979 2980 call cobol_vdwf_dget (cobol_cmfp, status, seg_ptr, common_recsize, fixed_common.seg_info); 2981 2982 /* can the item be allocated in this segment? */ 2983 2984 check_this_segment: 2985 if dd_segment.read_only ^= al_read_only 2986 then go to check_next_segment; 2987 2988 next_loc_used = dd_segment.next_avail_loc; 2989 2990 if al_bitt 2991 then go to boundary_ok; 2992 2993 if al_byte 2994 then go to boundary_ok; 2995 2996 if al_half_word 2997 then go to incr_to_half_word; 2998 2999 if al_word 3000 then go to incr_to_word; /* double-word boundary required for this item */ 3001 double_word_slack = mod (next_loc_used, 8); 3002 3003 if double_word_slack ^= 0 3004 then next_loc_used = next_loc_used + 8 - double_word_slack; 3005 3006 go to boundary_ok; /* word boundary required for this item */ 3007 3008 incr_to_word: 3009 word_slack = mod (next_loc_used, 4); 3010 3011 if word_slack ^= 0 3012 then next_loc_used = next_loc_used + 4 - word_slack; 3013 3014 go to boundary_ok; /* half-word boundary required for this item */ 3015 3016 incr_to_half_word: 3017 half_word_slack = mod (next_loc_used, 2); 3018 next_loc_used = next_loc_used + half_word_slack; 3019 3020 boundary_ok: 3021 work31 = next_loc_used + al_size - 1; 3022 3023 if work31 > fixed_common.dd_seg_size 3024 then go to check_next_segment; 3025 3026 if al_elem_offset ^< elem_offset_limit 3027 then go to first_occ_check; 3028 3029 work31 = next_loc_used + al_elem_offset - 1; 3030 3031 if work31 ^< elem_offset_limit 3032 then go to check_next_segment; 3033 3034 first_occ_check: 3035 work31 = next_loc_used + al_occ_offset - 1; 3036 3037 if al_occ_offset > (occ_offset_limit - 1) 3038 then go to second_occ_check; 3039 3040 if work31 ^< occ_offset_limit 3041 then go to check_next_segment; 3042 3043 go to this_seg_ok; 3044 3045 second_occ_check: 3046 if work31 ^< second_occ_limit 3047 then go to check_next_segment; /* yes, item can be allocated in this segment */ 3048 3049 this_seg_ok: 3050 al_rec_seg = dd_segment.seg_no; 3051 al_rec_off = next_loc_used; 3052 dd_segment.next_avail_loc = next_loc_used + al_size; 3053 dd_segment.duplicate_next_loc = dd_segment.next_avail_loc; 3054 3055 call cobol_vdwf_dput (cobol_cmfp, status, seg_ptr, common_recsize, common_key); 3056 3057 return; 3058 3059 check_next_segment: 3060 if new_seg_bit 3061 then go to this_seg_ok; 3062 3063 common_key = dd_segment.next; 3064 3065 call cobol_vdwf_dget (cobol_cmfp, status, seg_ptr, common_recsize, dd_segment.next); 3066 3067 if dd_segment.next ^= "00000" 3068 then go to check_this_segment; /* build new segment entry in work area, then write it out to common */ 3069 3070 new_segment_needed: 3071 seg_ptr = addr (work_area); 3072 dd_segment.next = "00000"; 3073 3074 if ^new_seg_bit 3075 then fixed_common.number_of_dd_segs = fixed_common.number_of_dd_segs + 2; 3076 3077 new_seg_bit = "1"b; 3078 dd_segment.seg_no = fixed_common.number_of_dd_segs; 3079 /* start with segment number 2 */ 3080 dd_segment.next_avail_loc = 0; 3081 dd_segment.duplicate_next_loc = 0; 3082 dd_segment.read_only = al_read_only; 3083 3084 call cobol_vdwf_dput (cobol_cmfp, status, seg_ptr, seg_size, common_key); 3085 3086 3087 /* save old value of seg_ptr to fill next field if another segment is created */ 3088 3089 if fixed_common.seg_info ^= "00000" 3090 then fixed_common.seg_info = common_key; 3091 3092 next_loc_used = 0; 3093 3094 go to this_seg_ok; 3095 3096 end; 3097 3098 declare (mod, divide, substr, index, addr) 3099 builtin; 3100 3101 declare cobol_c_list entry (ptr); 3102 3103 declare (descr_ptr, inf_ptr) 3104 ptr; 3105 declare description (64) bit (1) based (descr_ptr); 3106 declare inf bit (8) based (inf_ptr); 3107 declare 1 indicators, 3108 2 rdf_illegal bit (1), 3109 2 rparen bit (1); 3110 declare (trial, req_sub) fixed bin (24); 3111 declare (dir_num, stack_loc) 3112 fixed bin (24); 3113 declare (link1, link2) fixed bin (24); 3114 3115 declare (section_number, check_res) 3116 fixed bin; 3117 1 1 1 2 /* BEGIN INCLUDE FILE ... cobol_ext_.incl.pl1 */ 1 3 /* Last modified on 06/17/76 by ORN */ 1 4 /* Last modified on 12/28/76 by FCH */ 1 5 /* Last modified on 12/01/80 by FCH */ 1 6 1 7 /* <<< SHARED EXTERNALS INCLUDE FILE >>> */ 1 8 1 9 1 10 dcl cobol_ext_$cobol_afp ptr ext; 1 11 dcl cobol_afp ptr defined ( cobol_ext_$cobol_afp); 1 12 dcl cobol_ext_$cobol_analin_fileno ptr ext; 1 13 dcl cobol_analin_fileno ptr defined ( cobol_ext_$cobol_analin_fileno); 1 14 dcl cobol_ext_$report_first_token ptr ext; 1 15 dcl report_first_token ptr defined( cobol_ext_$report_first_token); 1 16 dcl cobol_ext_$report_last_token ptr ext; 1 17 dcl report_last_token ptr defined ( cobol_ext_$report_last_token); 1 18 dcl cobol_ext_$cobol_eltp ptr ext; 1 19 dcl cobol_eltp ptr defined ( cobol_ext_$cobol_eltp); 1 20 dcl cobol_ext_$cobol_cmfp ptr ext; 1 21 dcl cobol_cmfp ptr defined ( cobol_ext_$cobol_cmfp); 1 22 dcl cobol_ext_$cobol_com_fileno ptr ext; 1 23 dcl cobol_com_fileno ptr defined ( cobol_ext_$cobol_com_fileno); 1 24 dcl cobol_ext_$cobol_com_ptr ptr ext; 1 25 dcl cobol_com_ptr ptr defined ( cobol_ext_$cobol_com_ptr); 1 26 dcl cobol_ext_$cobol_dfp ptr ext; 1 27 dcl cobol_dfp ptr defined ( cobol_ext_$cobol_dfp); 1 28 dcl cobol_ext_$cobol_hfp ptr ext; 1 29 dcl cobol_hfp ptr defined ( cobol_ext_$cobol_hfp); 1 30 dcl cobol_ext_$cobol_m1fp ptr ext; 1 31 dcl cobol_m1fp ptr defined ( cobol_ext_$cobol_m1fp); 1 32 dcl cobol_ext_$cobol_m2fp ptr ext; 1 33 dcl cobol_m2fp ptr defined ( cobol_ext_$cobol_m2fp); 1 34 dcl cobol_ext_$cobol_min1_fileno ptr ext; 1 35 dcl cobol_min1_fileno ptr defined ( cobol_ext_$cobol_min1_fileno); 1 36 dcl cobol_ext_$cobol_min2_fileno_ptr ptr ext; 1 37 dcl cobol_min2_fileno_ptr ptr defined ( cobol_ext_$cobol_min2_fileno_ptr); 1 38 dcl cobol_ext_$cobol_name_fileno ptr ext; 1 39 dcl cobol_name_fileno ptr defined ( cobol_ext_$cobol_name_fileno); 1 40 dcl cobol_ext_$cobol_name_fileno_ptr ptr ext; 1 41 dcl cobol_name_fileno_ptr ptr defined ( cobol_ext_$cobol_name_fileno_ptr); 1 42 dcl cobol_ext_$cobol_ntfp ptr ext; 1 43 dcl cobol_ntfp ptr defined ( cobol_ext_$cobol_ntfp); 1 44 dcl cobol_ext_$cobol_pdofp ptr ext; 1 45 dcl cobol_pdofp ptr defined ( cobol_ext_$cobol_pdofp); 1 46 dcl cobol_ext_$cobol_pfp ptr ext; 1 47 dcl cobol_pfp ptr defined ( cobol_ext_$cobol_pfp); 1 48 dcl cobol_ext_$cobol_rm2fp ptr ext; 1 49 dcl cobol_rm2fp ptr defined ( cobol_ext_$cobol_rm2fp); 1 50 dcl cobol_ext_$cobol_rmin2fp ptr ext; 1 51 dcl cobol_rmin2fp ptr defined ( cobol_ext_$cobol_rmin2fp); 1 52 dcl cobol_ext_$cobol_curr_in ptr ext; 1 53 dcl cobol_curr_in ptr defined ( cobol_ext_$cobol_curr_in); 1 54 dcl cobol_ext_$cobol_curr_out ptr ext; 1 55 dcl cobol_curr_out ptr defined ( cobol_ext_$cobol_curr_out); 1 56 dcl cobol_ext_$cobol_sfp ptr ext; 1 57 dcl cobol_sfp ptr defined ( cobol_ext_$cobol_sfp); 1 58 dcl cobol_ext_$cobol_w1p ptr ext; 1 59 dcl cobol_w1p ptr defined ( cobol_ext_$cobol_w1p); 1 60 dcl cobol_ext_$cobol_w2p ptr ext; 1 61 dcl cobol_w2p ptr defined ( cobol_ext_$cobol_w2p); 1 62 dcl cobol_ext_$cobol_w3p ptr ext; 1 63 dcl cobol_w3p ptr defined ( cobol_ext_$cobol_w3p); 1 64 dcl cobol_ext_$cobol_w5p ptr ext; 1 65 dcl cobol_w5p ptr defined ( cobol_ext_$cobol_w5p); 1 66 dcl cobol_ext_$cobol_w6p ptr ext; 1 67 dcl cobol_w6p ptr defined ( cobol_ext_$cobol_w6p); 1 68 dcl cobol_ext_$cobol_w7p ptr ext; 1 69 dcl cobol_w7p ptr defined ( cobol_ext_$cobol_w7p); 1 70 dcl cobol_ext_$cobol_x3fp ptr ext; 1 71 dcl cobol_x3fp ptr defined ( cobol_ext_$cobol_x3fp); 1 72 dcl cobol_ext_$cobol_rwdd ptr ext; 1 73 dcl cobol_rwdd ptr defined(cobol_ext_$cobol_rwdd); 1 74 dcl cobol_ext_$cobol_rwpd ptr ext; 1 75 dcl cobol_rwpd ptr defined(cobol_ext_$cobol_rwpd); 1 76 1 77 1 78 dcl cobol_ext_$cobol_fileno1 fixed bin(24)ext; 1 79 dcl cobol_fileno1 fixed bin(24)defined ( cobol_ext_$cobol_fileno1); 1 80 dcl cobol_ext_$cobol_options_len fixed bin(24)ext; 1 81 dcl cobol_options_len fixed bin(24)defined ( cobol_ext_$cobol_options_len); 1 82 dcl cobol_ext_$cobol_pdout_fileno fixed bin(24)ext; 1 83 dcl cobol_pdout_fileno fixed bin(24)defined ( cobol_ext_$cobol_pdout_fileno); 1 84 dcl cobol_ext_$cobol_print_fileno fixed bin(24)ext; 1 85 dcl cobol_print_fileno fixed bin(24)defined ( cobol_ext_$cobol_print_fileno); 1 86 dcl cobol_ext_$cobol_rmin2_fileno fixed bin(24)ext; 1 87 dcl cobol_rmin2_fileno fixed bin(24)defined ( cobol_ext_$cobol_rmin2_fileno); 1 88 dcl cobol_ext_$cobol_x1_fileno fixed bin(24)ext; 1 89 dcl cobol_x1_fileno fixed bin(24)defined ( cobol_ext_$cobol_x1_fileno); 1 90 dcl cobol_ext_$cobol_x2_fileno fixed bin(24)ext; 1 91 dcl cobol_x2_fileno fixed bin(24)defined ( cobol_ext_$cobol_x2_fileno); 1 92 dcl cobol_ext_$cobol_x3_fileno fixed bin(24)ext; 1 93 dcl cobol_x3_fileno fixed bin(24)defined ( cobol_ext_$cobol_x3_fileno); 1 94 1 95 dcl cobol_ext_$cobol_lpr char (5) ext; 1 96 dcl cobol_lpr char (5) defined ( cobol_ext_$cobol_lpr); /* -2- */ 1 97 dcl cobol_ext_$cobol_options char (120) ext; 1 98 dcl cobol_options char (120) defined ( cobol_ext_$cobol_options); /* -30- */ 1 99 1 100 dcl cobol_ext_$cobol_xlast8 bit (1) ext; 1 101 dcl cobol_xlast8 bit (1) defined ( cobol_ext_$cobol_xlast8); /* -1- */ 1 102 dcl cobol_ext_$report_exists bit (1) ext; 1 103 dcl report_exists bit (1) defined ( cobol_ext_$report_exists); 1 104 1 105 1 106 /* <<< END OF SHARED EXTERNALS INCLUDE FILE >>> */ 1 107 /* END INCLUDE FILE ... cobol_ext_.incl.pl1 */ 1 108 3118 2 1 2 2 /* BEGIN INCLUDE FILE ... cobol_io_info.incl.pl1 */ 2 3 2 4 /* EXTERNAL COBOL I/O ENTRIES */ 2 5 2 6 dcl cobol_vdwf_open ext entry (ptr, bit(32)); 2 7 dcl cobol_swf_open ext entry (ptr,bit(32),ptr,fixed bin,char(2)); 2 8 2 9 dcl cobol_swf_get ext entry(ptr,bit(32),ptr,fixed bin); 2 10 2 11 dcl cobol_swf_put ext entry(ptr,bit(32),ptr,fixed bin); 2 12 2 13 dcl cobol_swf_close ext entry(ptr,bit(32),ptr,fixed bin); 2 14 2 15 dcl cobol_vdwf_sget ext entry(ptr,bit(32),ptr,fixed bin,char(5)); 2 16 2 17 dcl cobol_vdwf_sput ext entry (ptr,bit(32),ptr,fixed bin,char(5)); 2 18 2 19 dcl cobol_vdwf_dget ext entry(ptr,bit(32),ptr,fixed bin,char(5)); 2 20 2 21 dcl cobol_vdwf_dput ext entry(ptr,bit(32),ptr,fixed bin,char(5)); 2 22 2 23 dcl cobol_vdwf_close ext entry(ptr,bit(32),ptr,fixed bin); 2 24 2 25 2 26 /* DECLARATION OF SOME VARIABLES USED IN COMPILER I/O CALLS */ 2 27 2 28 dcl keyno char(5); 2 29 dcl key1 char(5); 2 30 dcl curr_input ptr; 2 31 dcl curr_output ptr; 2 32 dcl recsize fixed bin; 2 33 dcl recsize2 fixed bin; 2 34 dcl status bit(32); 2 35 2 36 2 37 2 38 dcl 1 status_word based(st_ptr), 2 39 2 status_left bit(16), 2 40 2 status_right bit(16); 2 41 2 42 dcl st_ptr ptr; 2 43 2 44 2 45 /* END INCLUDE FILE ... cobol_io_info.incl.pl1 */ 2 46 3119 3120 declare 1 reserved_word based (input_ptr), 3 1 3 2 /* begin include file ... cobol_TYPE1.incl.pl1 */ 3 3 /* Last modified on 11/17/76 by ORN */ 3 4 /* Last modified on 12/28/76 by FCH */ 3 5 /* Last modified on 12/16/80 by FCH */ 3 6 3 7 /* header */ 3 8 2 size fixed bin, 3 9 2 line fixed bin, 3 10 2 column fixed bin, 3 11 2 type fixed bin, 3 12 /* body */ 3 13 2 key fixed bin, 3 14 /* procedure division class bits */ 3 15 2 verb bit (1), 3 16 2 arith_op bit (1), 3 17 2 figcon bit (1), 3 18 2 terminator bit (1), 3 19 2 end_dec bit (1), 3 20 2 rel_op bit (1), 3 21 2 imper_verb bit (1), 3 22 2 end_cobol bit (1), 3 23 /* data division class bits */ 3 24 2 section_header bit (1), 3 25 2 fs_ind bit (1), 3 26 2 fd_clause bit (1), 3 27 2 dd_clause bit (1), 3 28 2 cd_input bit (1), 3 29 2 cd_output bit (1), 3 30 2 cset_name bit (1), 3 31 2 ss_division bit (1), 3 32 2 repl_jump_ind bit (4), 3 33 2 ided_recovery bit (1), 3 34 2 report_writer bit (5), 3 35 2 ss_desc_entry bit (1), 3 36 2 jump_index fixed bin, 3 37 2 length fixed bin, 3 38 2 name char(0 refer(reserved_word.length)); 3 39 3 40 3 41 3 42 /* end include file ... cobol_TYPE1.incl.pl1 */ 3 43 3121 3122 3123 declare 1 numeric_lit based (input_ptr), 4 1 4 2 /* begin include file ... cobol_TYPE2.incl.pl1 */ 4 3 /* Last modified on 12/28/76 by FCH */ 4 4 4 5 /* header */ 4 6 2 size fixed bin, 4 7 2 line fixed bin, 4 8 2 column fixed bin, 4 9 2 type fixed bin, 4 10 /* body */ 4 11 2 integral bit(1), 4 12 2 floating bit(1), 4 13 2 seg_range bit(1), 4 14 2 filler1 bit(4), 4 15 2 subscript bit(1), 4 16 2 sign char(1), 4 17 2 exp_sign char(1), 4 18 2 exp_places fixed bin, 4 19 2 places_left fixed bin, 4 20 2 places_right fixed bin, 4 21 2 places fixed bin, 4 22 2 literal char(0 refer(numeric_lit.places)); 4 23 4 24 4 25 4 26 /* end include file ... cobol_TYPE2.incl.pl1 */ 4 27 3124 3125 3126 declare 1 data_name based (input_ptr), 5 1 5 2 /* begin include file ... cobol_TYPE9.incl.pl1 */ 5 3 /* Last modified on 06/19/77 by ORN */ 5 4 /* Last modified on 12/28/76 by FCH */ 5 5 5 6 /* header */ 5 7 2 size fixed bin, 5 8 2 line fixed bin, 5 9 2 column fixed bin, 5 10 2 type fixed bin, 5 11 /* body */ 5 12 2 string_ptr ptr, 5 13 2 prev_rec ptr, 5 14 2 searched bit (1), 5 15 2 duplicate bit (1), 5 16 2 saved bit (1), 5 17 2 debug_ind bit (1), 5 18 2 filler2 bit (3), 5 19 2 used_as_sub bit (1), 5 20 2 def_line fixed bin, 5 21 2 level fixed bin, 5 22 2 linkage fixed bin, 5 23 2 file_num fixed bin, 5 24 2 size_rtn fixed bin, 5 25 2 item_length fixed bin(24), 5 26 2 places_left fixed bin, 5 27 2 places_right fixed bin, 5 28 /* description */ 5 29 2 file_section bit (1), 5 30 2 working_storage bit (1), 5 31 2 constant_section bit (1), 5 32 2 linkage_section bit (1), 5 33 2 communication_section bit (1), 5 34 2 report_section bit (1), 5 35 2 level_77 bit (1), 5 36 2 level_01 bit (1), 5 37 2 non_elementary bit (1), 5 38 2 elementary bit (1), 5 39 2 filler_item bit (1), 5 40 2 s_of_rdf bit (1), 5 41 2 o_of_rdf bit (1), 5 42 2 bin_18 bit (1), 5 43 2 bin_36 bit (1), 5 44 2 pic_has_l bit (1), 5 45 2 pic_is_do bit (1), 5 46 2 numeric bit (1), 5 47 2 numeric_edited bit (1), 5 48 2 alphanum bit (1), 5 49 2 alphanum_edited bit (1), 5 50 2 alphabetic bit (1), 5 51 2 alphabetic_edited bit (1), 5 52 2 pic_has_p bit (1), 5 53 2 pic_has_ast bit (1), 5 54 2 item_signed bit(1), 5 55 2 sign_separate bit (1), 5 56 2 display bit (1), 5 57 2 comp bit (1), 5 58 2 ascii_packed_dec_h bit (1), /* as of 8/16/76 this field used for comp8. */ 5 59 2 ascii_packed_dec bit (1), 5 60 2 ebcdic_packed_dec bit (1), 5 61 2 bin_16 bit (1), 5 62 2 bin_32 bit (1), 5 63 2 usage_index bit (1), 5 64 2 just_right bit (1), 5 65 2 compare_argument bit (1), 5 66 2 sync bit (1), 5 67 2 temporary bit (1), 5 68 2 bwz bit (1), 5 69 2 variable_length bit (1), 5 70 2 subscripted bit (1), 5 71 2 occurs_do bit (1), 5 72 2 key_a bit (1), 5 73 2 key_d bit (1), 5 74 2 indexed_by bit (1), 5 75 2 value_numeric bit (1), 5 76 2 value_non_numeric bit (1), 5 77 2 value_signed bit (1), 5 78 2 sign_type bit (3), 5 79 2 pic_integer bit (1), 5 80 2 ast_when_zero bit (1), 5 81 2 label_record bit (1), 5 82 2 sign_clause_occurred bit (1), 5 83 2 okey_dn bit (1), 5 84 2 subject_of_keyis bit (1), 5 85 2 exp_redefining bit (1), 5 86 2 sync_in_rec bit (1), 5 87 2 rounded bit (1), 5 88 2 ad_bit bit (1), 5 89 2 debug_all bit (1), 5 90 2 overlap bit (1), 5 91 2 sum_counter bit (1), 5 92 2 exp_occurs bit (1), 5 93 2 linage_counter bit (1), 5 94 2 rnm_01 bit (1), 5 95 2 aligned bit (1), 5 96 2 not_user_writable bit (1), 5 97 2 database_key bit (1), 5 98 2 database_data_item bit (1), 5 99 2 seg_num fixed bin, 5 100 2 offset fixed bin(24), 5 101 2 initial_ptr fixed bin, 5 102 2 edit_ptr fixed bin, 5 103 2 occurs_ptr fixed bin, 5 104 2 do_rec char(5), 5 105 2 bitt bit (1), 5 106 2 byte bit (1), 5 107 2 half_word bit (1), 5 108 2 word bit (1), 5 109 2 double_word bit (1), 5 110 2 half_byte bit (1), 5 111 2 filler5 bit (1), 5 112 2 bit_offset bit (4), 5 113 2 son_cnt bit (16), 5 114 2 max_red_size fixed bin(24), 5 115 2 name_size fixed bin, 5 116 2 name char(0 refer(data_name.name_size)); 5 117 5 118 5 119 5 120 /* end include file ... cobol_TYPE9.incl.pl1 */ 5 121 3127 3128 6 1 6 2 /* BEGIN INCLUDE FILE ... cobol_occurs.incl.pl1 */ 6 3 /* Last Modified on 01/19/77 by ORN */ 6 4 6 5 dcl 1 occurs based (ptr1), 7 1 7 2 /* begin include file ... cobol_OCCURS.incl.pl1 */ 7 3 /* Last modified on 12/28/76 by FCH */ 7 4 7 5 2 keyed fixed bin, 7 6 2 key_number fixed bin, 7 7 2 dimensions fixed bin, 7 8 2 level (3), 7 9 3 indexedno fixed bin, 7 10 3 min fixed bin, 7 11 3 max fixed bin, 7 12 3 struclength fixed bin, 7 13 3 cswdx fixed bin, 7 14 3 cswd fixed bin(24); 7 15 7 16 /* end include file ... cobol_OCCURS.incl.pl1 */ 7 17 6 6 6 7 6 8 /* END INCLUDE FILE ... cobol_occurs.incl.pl1 */ 6 9 3129 3130 3131 declare 1 index_name based (input_ptr), 8 1 8 2 /* begin include file ... cobol_TYPE10.incl.pl1 8 3*/* Last modified on 01/25/77 by ORN */ 8 4 8 5 /* header */ 8 6 2 size fixed bin, 8 7 2 line fixed bin, 8 8 2 column fixed bin, 8 9 2 type fixed bin, 8 10 /* body */ 8 11 2 string_ptr ptr, 8 12 2 prev_rec ptr, 8 13 2 searched bit(1), 8 14 2 duplicate bit(1), 8 15 2 saved bit(1), 8 16 2 debug_ind bit(1), 8 17 2 filler1 bit(3), 8 18 2 subscript bit(1), 8 19 2 def_line fixed bin, 8 20 2 level fixed bin, 8 21 2 seg_num fixed bin, 8 22 2 offset fixed bin(24), 8 23 2 index_no fixed bin, 8 24 2 min fixed bin, 8 25 2 max fixed bin, 8 26 2 struc_length fixed bin, 8 27 2 cswd_seg fixed bin, 8 28 2 cswd_offset fixed bin(24), 8 29 2 name_size fixed bin, 8 30 2 name char(0 refer(index_name.name_size)); 8 31 8 32 8 33 8 34 /* end include file ... cobol_TYPE10.incl.pl1 */ 8 35 3132 3133 3134 declare 1 proc_def based (input_ptr), 9 1 9 2 /* begin include file ... cobol_TYPE7.incl.pl1 */ 9 3 /* Last modified on 11/17/76 by ORN */ 9 4 /* Last modified on 12/28/76 by FCH */ 9 5 9 6 /* header */ 9 7 2 size fixed bin, 9 8 2 line fixed bin, 9 9 2 column fixed bin, 9 10 2 type fixed bin, 9 11 /* body */ 9 12 2 string_ptr ptr, 9 13 2 prev_rec ptr, 9 14 2 searched bit (1), 9 15 2 duplicate bit (1), 9 16 2 filler1 bit (1), 9 17 2 debug_ind bit (1), 9 18 2 section_name bit (1), 9 19 2 declarative_proc bit (1), 9 20 2 filler2 bit (1), 9 21 2 alterable bit (1), 9 22 2 priority char (2), 9 23 2 sort_range bit (1), 9 24 2 input_range bit (1), 9 25 2 output_range bit (1), 9 26 2 merge_range bit(1), 9 27 2 filler3 bit (5), 9 28 2 section_num fixed bin, 9 29 2 proc_num fixed bin, 9 30 2 def_line fixed bin, 9 31 2 name_size fixed bin, 9 32 2 name char(0 refer(proc_def.name_size)); 9 33 9 34 9 35 9 36 /* end include file ... cobol_TYPE7.incl.pl1 */ 9 37 3135 3136 3137 declare 1 alphanum_lit based (input_ptr), 10 1 10 2 /* begin include file ... cobol_TYPE3.incl.pl1 */ 10 3 /* Last modified on 11/17/76 by ORN */ 10 4 /* Last modified on 12/28/76 by FCH */ 10 5 10 6 /* header */ 10 7 2 size fixed bin, 10 8 2 line fixed bin, 10 9 2 column fixed bin, 10 10 2 type fixed bin, 10 11 /* body */ 10 12 2 lit_type bit (1), 10 13 2 all_lit bit (1), 10 14 2 filler1 bit (6), 10 15 2 lit_size fixed bin, 10 16 2 string char(0 refer(alphanum_lit.lit_size)); 10 17 10 18 10 19 10 20 /* end include file ... cobol_TYPE3.incl.pl1 */ 10 21 3138 3139 11 1 11 2 /* BEGIN INCLUDE FILE ... cobol_ciphase_data.incl.pl1 */ 11 3 /* <<< DRASTICALLY REVISED ON 12/27/76 by fch >>> */ 11 4 /* Modified on 05/06/81 by FCH, BUG482(TR9781) */ 11 5 11 6 dcl new_seg_bit bit(1) ; /*new segment allocated */ 11 7 11 8 11 9 11 10 dcl nu_line fixed bin ; /* introduce for line numerotation */ 11 11 dcl fst bit(32) ; 11 12 dcl infp ptr ; 11 13 dcl outfp ptr ; /*newioversr*/ 11 14 dcl on bit(1) internal static init("1"b); 11 15 dcl off bit(1) internal static init("0"b); 11 16 dcl ose_exists bit(1) ; 11 17 dcl ( ptr1 ptr, 11 18 input_ptr ptr,output_ptr ptr ) ; 11 19 dcl next_free_column fixed bin ; 11 20 dcl eof bit(1) ; 11 21 11 22 dcl curr_tbl_ptr ptr ; 11 23 dcl curr_table( 200000 ) char(1) based(curr_tbl_ptr); /*[4.4-1]*/ 11 24 dcl curr_tbl_index fixed bin ; 11 25 dcl tbl_item_ptr ptr ; 11 26 dcl (tbl_item_ptr1,tbl_item_ptr2) ptr ; 11 27 11 28 dcl dir_ptr ptr; 11 29 dcl 1 dir_struct based (dir_ptr), 11 30 2 dir1 (512) , 11 31 3 tbl fixed bin, 11 32 3 dir fixed bin , 11 33 2 dir2 (512) , 11 34 3 tbl fixed bin, 11 35 3 dir fixed bin , 11 36 2 table1 (200000) char(1), /*[4.4-1]*/ 11 37 2 table2 (200000) char(1); /*[4.4-1*/ 11 38 dcl curr_dir_ptr ptr ; 11 39 dcl 1 curr_dir(512) based(curr_dir_ptr), 11 40 2 tbl fixed bin, 11 41 2 dir fixed bin ; 11 42 dcl curr_dir_index fixed bin ; 11 43 dcl end_dir1_index fixed bin ; 11 44 declare (loc1 , loc2) fixed bin; 11 45 dcl (dir_ptr1,dir_ptr2) ptr ; 11 46 11 47 dcl 1 stack(50) , 11 48 2 stk_to_dir fixed bin, 11 49 2 level fixed bin; 11 50 dcl curr_stk_index fixed bin ; 11 51 11 52 dcl gen_ptr (30) ptr ; 11 53 11 54 dcl 1 lc_stack(300) , /*[4.4-1]*/ 11 55 2 dcl_line char(4), 11 56 2 dcl_col char(3) ; 11 57 11 58 dcl ( i, 11 59 end_i , 11 60 recv_i , 11 61 begin_i , 11 62 ose_gen_begin_i ) fixed bin ; 11 63 11 64 11 65 11 66 11 67 dcl 1 key_tbl(10) internal static, 11 68 2 key fixed bin init(2,18,170,187,188,182,183,156,11,111), 11 69 2 word char(9) init("add ","move ","to ","( ",") ","+ ", 11 70 "- ","rounded ","subtract ","from "), 11 71 2 word_length fixed bin init(4,5,3,2,2,2,2,8,9,5); 11 72 /* suppress 3 lines 11 73*dcl key_index fixed bin ; 11 74*dcl max_key_index fixed bin internal static init(10); 11 75*dcl this_key fixed bin ; 11 76* */ 11 77 dcl blank_name char(32) internal static init((32)" "); 11 78 dcl (name1,name2) char(32) ; 11 79 11 80 dcl curr_level fixed bin ; 11 81 dcl move_swt bit(1) ; 11 82 dcl add_swt bit(1) ; 11 83 dcl subtract_swt bit(1) ; 11 84 11 85 dcl sending_op bit(1) ; 11 86 dcl no_of_subscr fixed bin ; 11 87 dcl subscr_cnt fixed bin ; 11 88 dcl dataname_subscr_sw bit(1) ; 11 89 dcl indexname_subscr_sw bit(1) ; 11 90 dcl orig_dimen fixed bin ; 11 91 dcl cvbd_1 char(4) ; 11 92 dcl cvindex fixed bin ; 11 93 dcl cv_string char(10) ; 11 94 dcl fixbin15 fixed bin ; 11 95 dcl fixbin24 fixed bin(24) ; 11 96 11 97 dcl null_match bit(1) ; 11 98 dcl record char(4095) based; 11 99 dcl record2 char(4095) based; 11 100 dcl any_item (300) char(1) based(input_ptr); 11 101 /*used to set ptr1 to array extension*/ 11 102 11 103 dcl 1 token_stack_tbl , 11 104 2 token_stack (20000) char(1); /*[4.4-1]*/ 11 105 dcl top_token_stack fixed bin ; 11 106 dcl token_stack_ptr ptr ; 11 107 dcl n fixed bin ; 11 108 dcl first_pair bit(1) ; 11 109 dcl (ptr2,ptr3,ptr4) ptr ; 11 110 dcl main_item_subscripted bit(1) ; 11 111 dcl subscr_dir_index fixed bin ; 11 112 dcl 1 subscr_directory(300) , /*[4.4-1]*/ 11 113 2 sufx_ptr ptr, 11 114 2 tokn_ptr ptr, 11 115 2 index_ct fixed bin ; 11 116 dcl defaults bit(1) ; 11 117 dcl category fixed bin ; 11 118 dcl send_op_ptr ptr ; 11 119 dcl initlz_tbl_ptr ptr ; 11 120 dcl initlz_item_tbl ( 200000 ) char(1) based(initlz_tbl_ptr); /*[4.4-1]*/ 11 121 dcl table1_2_size fixed bin ; 11 122 /* give max. size to stack items on table initlz_item_tbl */ 11 123 dcl end_initlz_tbl_index fixed bin ; 11 124 dcl main_item_index fixed bin ; 11 125 dcl main_item_ptr ptr ; 11 126 dcl curr_dim fixed bin ; 11 127 dcl initlz_swt bit(1) ; 11 128 dcl initlz_items_allocated bit(1) ; 11 129 dcl save_the_key bit(1) ; 11 130 dcl nt_key char(5); 11 131 dcl save_key char(5); 11 132 dcl gen_item_allocated bit(1) ; 11 133 dcl alloc_seg fixed bin ; 11 134 dcl alloc_offset fixed bin(24) ; 11 135 11 136 11 137 11 138 dcl code fixed bin ; 11 139 dcl nxt fixed bin internal static init(0), 11 140 bos fixed bin internal static init(1), 11 141 eos fixed bin internal static init(2); 11 142 11 143 dcl lk_ahd_ptr(2) ptr ; /* used to store ON,ON SIZE if not ON SIZE ERROR */ 11 144 dcl lk_ahd_index fixed bin ; 11 145 11 146 /* used to initialize label array in corr_in */ 11 147 11 148 /* interface between err_pro and callers */ 11 149 dcl recov bit(1) ; 11 150 dcl err_num fixed bin ; 11 151 dcl err_image char(60) ; 11 152 dcl poss_prior_err bit(1) ; 11 153 dcl err_image_length fixed bin ; 11 154 11 155 /* interface between corr and source_gen */ 11 156 dcl set_new_col bit(1) ; 11 157 /* suppress 2 lines 11 158*dcl this_word char(32) ; 11 159*dcl this_word_length fixed bin ; 11 160* */ 11 161 11 162 /*interface between err_pro and corr_in*/ 11 163 dcl recovering bit(1) ; 11 164 11 165 dcl without_on_bit bit(1) ; /* bit add for syntax ON SIZE ERROR without ON */ 11 166 dcl xst fixed bin ; /* add for same above */ 11 167 11 168 dcl recursive_bit bit(1) ; /* bit added for recursive syntax on ADD or SUBTRACT */ 11 169 dcl relecture bit(1) ; /* add for recursive array in INITIALIZE */ 11 170 11 171 dcl array_init_bit bit(1) ; /* add for INITIALIZE all array */ 11 172 dcl n_array fixed bin ; 11 173 dcl second_time bit(1) ; 11 174 dcl fixbin_diff bit(1) ; 11 175 11 176 /* END INCLUDE FILE ... cobol_ciphase_data.incl.pl1 */ 11 177 3140 3141 12 1 12 2 /* BEGIN INCLUDE FILE ... cobol_fixed_common.incl.pl1 */ 12 3 /* Modified on 10/27/82 by FCH, [5.1-1], cobol_cln added to save last line num, BUG543(phx13643) */ 12 4 /* Modified on 07/31/80 by FCH, [4.3-1], use_reporting field added for Report Writer */ 12 5 /* Modified on 03/30/79 by FCH, [4.1-1], -card option added */ 12 6 /* Modified on 03/30/79 by FCH, [4.0-2], -svNM option added */ 12 7 /* Modified on 03/02/79 by FCH, [4.0-1], -levNM option added */ 12 8 /* Modified by RAL on 10/13/78, [4.0-0], Added option exp from fil2. */ 12 9 /* Modified by BC on 06/20/77, descriptor added. */ 12 10 /* Modified by BC on 06/02/77, init_cd_seg, init_cd_offset added. */ 12 11 /* Modified by BC on 1/21/77, options.profile added. */ 12 12 /* Modified by FCH on 7/6/76, sysin_fno & sysout_fno deleted, accept_device & display_device added */ 12 13 /* Modified by FCH on 5/20/77, comp_level added */ 12 14 12 15 12 16 /* THE SIZE OF THIS STRUCTURE IN BYTES, (EXCLUDING VARIABLE 12 17* LENGTH ENTITIES), FOR EACH HARDWARE IMPLEMENTATION IS: 12 18* 12 19* HARDWARE | SIZE (BYTES) 12 20* --------------------------------- 12 21* 645/6180 | 464 12 22* P7 | 396 12 23* --------------------------------- 12 24* */ 12 25 12 26 dcl 1 fixed_common based ( cobol_com_ptr), 12 27 2 prog_name char (30), 12 28 2 compiler_rev_no char (25), 12 29 2 phase_name char (6), 12 30 2 currency char (1), 12 31 2 fatal_no fixed bin, 12 32 2 warn_no fixed bin, 12 33 2 proc_counter fixed bin, 12 34 2 spec_tag_counter fixed bin, 12 35 2 file_count fixed bin, 12 36 2 filedescr_offsets (20) char (5), 12 37 2 perf_alter_info char (5), 12 38 2 another_perform_info char (5), 12 39 2 sort_in_info char (5), 12 40 2 odo_info char (5), 12 41 2 size_seg fixed bin, 12 42 2 size_offset fixed bin(24), 12 43 2 size_perform_info char (5), 12 44 2 rename_info char (5), 12 45 2 report_names char (5), 12 46 2 rw_buf_seg fixed bin, 12 47 2 rw_buf_offset fixed bin(24), 12 48 2 rw_buf_length fixed bin(24), 12 49 2 file_keys char (5), 12 50 2 search_keys char (5), 12 51 2 dd_seg_size fixed bin(24), 12 52 2 pd_seg_size fixed bin(24), 12 53 2 seg_limit fixed bin , 12 54 2 number_of_dd_segs fixed bin, 12 55 2 seg_info char (5), 12 56 2 number_of_ls_pointers fixed bin, 12 57 2 link_sec_seg fixed bin, 12 58 2 link_sec_offset fixed bin(24), 12 59 2 sra_clauses fixed bin, 12 60 2 fix_up_info char (5), 12 61 2 linage_info char (5), 12 62 2 first_dd_item char (5), 12 63 2 sort_out_info char (5), 12 64 2 db_info char (5), 12 65 2 realm_info char (5), 12 66 2 rc_realm_info char (5), 12 67 2 last_file_key char (5), 12 68 2 prog_coll_seq fixed bin, 12 69 2 init_cd_seg fixed bin, 12 70 2 init_cd_offset fixed bin(24), 12 71 2 input_error_exit fixed bin, 12 72 2 output_error_exit fixed bin, 12 73 2 i_o_error_exit fixed bin, 12 74 2 extend_error_exit fixed bin, 12 75 2 dummy15 fixed bin, 12 76 2 options, 12 77 3 cu bit (1), 12 78 3 st bit (1), 12 79 3 wn bit (1), 12 80 3 obs bit (1), 12 81 3 dm bit (1), 12 82 3 xrl bit (1), 12 83 3 xrn bit (1), 12 84 3 src bit (1), 12 85 3 obj bit (1), 12 86 3 exs bit (1), 12 87 3 sck bit (1), 12 88 3 rno bit (1), 12 89 3 u_l bit (1), 12 90 3 cnv bit (1), 12 91 3 cos bit (1), 12 92 3 fmt bit (1), 12 93 3 profile bit(1), 12 94 3 nw bit (1), 12 95 3 exp bit (1), /* [4.0-0] */ 12 96 3 card bit (1), /*[4.1-1]*/ 12 97 3 fil2 bit (5), 12 98 3 m_map bit (1), 12 99 3 m_bf bit (1), 12 100 3 m_fat bit (1), 12 101 3 m_wn bit (1), 12 102 3 m_obs bit(1), 12 103 3 pd bit(1), 12 104 3 oc bit(1), 12 105 2 supervisor bit (1), 12 106 2 dec_comma bit (1), 12 107 2 init_cd bit (1), 12 108 2 corr bit (1), 12 109 2 initl bit (1), 12 110 2 debug bit (1), 12 111 2 report bit (1), 12 112 2 sync_in_prog bit (1), 12 113 2 pd_section bit (1), 12 114 2 list_switch bit (1), 12 115 2 alpha_cond bit (1), 12 116 2 num_cond bit (1), 12 117 2 spec_sysin bit (1), 12 118 2 spec_sysout bit (1), 12 119 2 cpl_files bit (1), 12 120 2 obj_dec_comma bit (1), 12 121 2 default_sign_type bit (3), 12 122 2 use_debug bit(1), 12 123 2 syntax_trace bit(1), 12 124 2 comp_defaults, 12 125 3 comp bit(1), 12 126 3 comp_1 bit(1), 12 127 3 comp_2 bit(1), 12 128 3 comp_3 bit(1), 12 129 3 comp_4 bit(1), 12 130 3 comp_5 bit(1), 12 131 3 comp_6 bit(1), 12 132 3 comp_7 bit(1), 12 133 3 comp_8 bit(1), 12 134 2 disp_defaults, 12 135 3 disp bit(1), 12 136 3 disp_1 bit(1), 12 137 3 disp_2 bit(1), 12 138 3 disp_3 bit(1), 12 139 3 disp_4 bit(1), 12 140 3 disp_5 bit(1), 12 141 3 disp_6 bit(1), 12 142 3 disp_7 bit(1), 12 143 2 descriptor bit(2), 12 144 2 levsv bit(3), /*[4.0-1]*/ 12 145 2 use_reporting bit(1), /*[4.3-1]*/ 12 146 2 cd bit(1), /*[4.4-1]*/ 12 147 2 dummy17 bit(3), 12 148 2 lvl_rstr bit(32), 12 149 2 inst_rstr bit(32), 12 150 2 comp_level char(1), 12 151 2 dummy18 char(30), 12 152 2 object_sign char (1), 12 153 2 last_print_rec char (5), 12 154 2 coll_seq_info char (5), 12 155 2 sys_status_seg fixed bin, 12 156 2 sys_status_offset fixed bin(24), 12 157 2 compiler_id fixed bin, 12 158 2 date_comp_ln fixed bin, 12 159 2 compile_mode bit(36), 12 160 2 default_temp fixed bin, 12 161 2 accept_device fixed bin, 12 162 2 display_device fixed bin, 12 163 2 cobol_cln fixed bin, /*[5.1-1]*/ 12 164 2 alphabet_offset fixed bin; 12 165 12 166 12 167 12 168 /* END INCLUDE FILE ... cobol_fixed_common.incl.pl1 */ 12 169 3142 13 1 13 2 /* BEGIN INCLUDE FILE ... cobol_common_data.incl.pl1 */ 13 3 /* <<< MODIFIED ON 5 FEB 76 BY fch >>> */ 13 4 /* Modified on 12/28/76 by FCH */ 13 5 13 6 dcl 1 res_wd_dot internal static, 13 7 2 size fixed bin init( 28 ), 13 8 2 line fixed bin, 13 9 2 column fixed bin init(0), 13 10 2 type fixed bin init(1), 13 11 2 key fixed bin init(189), 13 12 2 class1 bit(16) init("0001100000000000"b), 13 13 2 class2 bit(4) init("0000"b), 13 14 2 class3 bit(1) init("0"b), 13 15 2 class4 bit(5) init("00000"b), 13 16 2 jump_index fixed bin init(0); 13 17 13 18 dcl 1 type_26_token internal static, 13 19 2 size fixed bin init( 16 ), 13 20 2 line fixed bin, 13 21 2 column fixed bin init(0), 13 22 2 type fixed bin init(26); 13 23 dcl 1 res_wd_to internal static, 13 24 2 size fixed bin init( 28 ), 13 25 2 line fixed bin, 13 26 2 column fixed bin init(0), 13 27 2 type fixed bin init(1), 13 28 2 key fixed bin init(170), 13 29 2 class1 bit(16) init((16)"0"b), 13 30 2 class2 bit(4) init("0001"b), 13 31 2 class3 bit(1) init("0"b), 13 32 2 class4 bit(5) init("00000"b), 13 33 2 jump_index fixed bin init(0); 13 34 13 35 dcl 1 res_wd_move internal static, 13 36 2 size fixed bin init( 28 ), 13 37 2 line fixed bin, 13 38 2 column fixed bin init(0), 13 39 2 type fixed bin init(1), 13 40 2 key fixed bin init(18), 13 41 2 class1 bit(16) init("1001001000000000"b), 13 42 2 class2 bit(4) init("0011"b), 13 43 2 class3 bit(1) init("0"b), 13 44 2 class4 bit(5) init("00000"b), 13 45 2 jump_index fixed bin init(0); 13 46 13 47 dcl 1 res_wd_greater internal static, 13 48 2 size fixed bin init( 28 ), 13 49 2 line fixed bin, 13 50 2 column fixed bin init(0), 13 51 2 type fixed bin init(1), 13 52 2 key fixed bin init(113), 13 53 2 class1 bit(16) init("0000010000000000"b), 13 54 2 class2 bit(4) init("0000"b), 13 55 2 class3 bit(1) init("0"b), 13 56 2 class4 bit(5) init("00000"b), 13 57 2 jump_index fixed bin init(0); 13 58 13 59 dcl 1 num_lit_zero internal static, 13 60 2 size fixed bin init( 37 ), 13 61 2 line fixed bin, 13 62 2 column fixed bin init(0), 13 63 2 type fixed bin init(2), 13 64 2 info bit(8) init("10000000"b), 13 65 2 sign char(1) init(" "), 13 66 2 exp_sign char(1) init(" "), 13 67 2 exp_places fixed bin init(0), 13 68 2 places_left fixed bin init(1), 13 69 2 places_right fixed bin init(0), 13 70 2 places fixed bin init(1), 13 71 2 literal char(1) init("0"); 13 72 13 73 dcl 1 num_lit_one internal static, 13 74 2 size fixed bin init( 37 ), 13 75 2 line fixed bin, 13 76 2 column fixed bin init(0), 13 77 2 type fixed bin init(2), 13 78 2 info bit(8) init("10000000"b), 13 79 2 sign char(1) init(" "), 13 80 2 exp_sign char(1) init(" "), 13 81 2 exp_places fixed bin init(0), 13 82 2 places_left fixed bin init(1), 13 83 2 places_right fixed bin init(0), 13 84 2 places fixed bin init(1), 13 85 2 literal char(1) init("1"); 13 86 13 87 13 88 dcl 1 res_wd_add internal static, 13 89 2 size fixed bin init( 28 ), 13 90 2 line fixed bin, 13 91 2 column fixed bin init(0), 13 92 2 type fixed bin init(1), 13 93 2 key fixed bin init(2), 13 94 2 class1 bit(16) init("1001001000000000"b), 13 95 2 class2 bit(4) init("0011"b), 13 96 2 class3 bit(1) init("0"b), 13 97 2 class4 bit(5) init("00000"b), 13 98 2 jump_index fixed bin init(0); 13 99 13 100 dcl 1 res_wd_subtract internal static, 13 101 2 size fixed bin init( 28 ), 13 102 2 line fixed bin, 13 103 2 column fixed bin init(0), 13 104 2 type fixed bin init(1), 13 105 2 key fixed bin init(11), 13 106 2 class1 bit(16) init("1001001000000000"b), 13 107 2 class2 bit(4) init("0011"b), 13 108 2 class3 bit(1) init("0"b), 13 109 2 class4 bit(5) init("00000"b), 13 110 2 jump_index fixed bin init(0); 13 111 13 112 dcl 1 res_wd_from internal static, 13 113 2 size fixed bin init( 28 ), 13 114 2 line fixed bin, 13 115 2 column fixed bin init(0), 13 116 2 type fixed bin init(1), 13 117 2 key fixed bin init(111), 13 118 2 class1 bit(16) init((16)"0"b), 13 119 2 class2 bit(4) init("0011"b), 13 120 2 class3 bit(1) init("0"b), 13 121 2 class4 bit(5) init("00000"b), 13 122 2 jump_index fixed bin init(0); 13 123 13 124 dcl 1 res_wd_set internal static, 13 125 2 size fixed bin init( 28 ), 13 126 2 line fixed bin, 13 127 2 column fixed bin init(0), 13 128 2 type fixed bin init(1), 13 129 2 key fixed bin init(31), 13 130 2 class1 bit(16) init("1001001000000000"b), 13 131 2 class2 bit(4) init("0011"b), 13 132 2 class3 bit(1) init("0"b), 13 133 2 class4 bit(5) init("00000"b), 13 134 2 jump_index fixed bin init(0); 13 135 13 136 dcl 1 res_wd_lparen internal static, 13 137 2 size fixed bin init( 28 ), 13 138 2 line fixed bin, 13 139 2 column fixed bin init(0), 13 140 2 type fixed bin init(1), 13 141 2 key fixed bin init(187), 13 142 2 class1 bit(16) init((16)"0"b), 13 143 2 class2 bit(4) init((4)"0"b), 13 144 2 class3 bit(1) init("0"b), 13 145 2 class4 bit(5) init((5)"0"b), 13 146 2 jump_index fixed bin init(0); 13 147 13 148 dcl 1 res_wd_rparen internal static, 13 149 2 size fixed bin init( 28 ), 13 150 2 line fixed bin, 13 151 2 column fixed bin init(0), 13 152 2 type fixed bin init(1), 13 153 2 key fixed bin init(188), 13 154 2 class1 bit(16) init((16)"0"b), 13 155 2 class2 bit(4) init((4)"0"b), 13 156 2 class3 bit(1) init("0"b), 13 157 2 class4 bit(5) init((5)"0"b), 13 158 2 jump_index fixed bin init(0); 13 159 13 160 13 161 dcl 1 res_wd_spaces internal static, 13 162 2 size fixed bin init( 28 ), 13 163 2 line fixed bin, 13 164 2 column fixed bin init(0), 13 165 2 type fixed bin init(1), 13 166 2 key fixed bin init(192), 13 167 2 class1 bit(16) init("0010000000000000"b), 13 168 2 class2 bit(4) init("0001"b), 13 169 2 class3 bit(1) init("0"b), 13 170 2 class4 bit(5) init("00000"b), 13 171 2 jump_index fixed bin init(2); 13 172 13 173 dcl 1 res_wd_zeroes internal static, 13 174 2 size fixed bin init( 28 ), 13 175 2 line fixed bin, 13 176 2 column fixed bin init(0), 13 177 2 type fixed bin init(1), 13 178 2 key fixed bin init(180), 13 179 2 class1 bit(16) init("0010000000000000"b), 13 180 2 class2 bit(4) init("0001"b), 13 181 2 class3 bit(1) init("0"b), 13 182 2 class4 bit(5) init("00000"b), 13 183 2 jump_index fixed bin init(1); 13 184 13 185 13 186 dcl 1 gen_item_t1 internal static, 13 187 2 size fixed bin init( 117 ), 13 188 2 line fixed bin, 13 189 2 column fixed bin init(0), 13 190 2 type fixed bin init(9), 13 191 2 string_pointer ptr, 13 192 2 prev_rec ptr, 13 193 2 info8 bit(8) init((8)"0"b), 13 194 2 def_line fixed bin init(0), 13 195 2 level fixed bin init(77), 13 196 2 linkage fixed bin init(0), 13 197 2 file_num fixed bin init(0), 13 198 2 size_rtn fixed bin init(0), 13 199 2 length fixed bin(24) init(1), 13 200 2 places_left fixed bin init(1), 13 201 2 places_right fixed bin init(0), 13 202 2 descr_bit bit(72) init("010000100100000001000000000100000000000000000000000010000000000000000000"b), 13 203 13 204 2 seg_num fixed bin init(0), 13 205 2 offset fixed bin(24) init(-1), /*to tell fix-up this is generated item*/ 13 206 2 init_ptr fixed bin init(0), 13 207 2 edit_ptr fixed bin init(0), 13 208 2 occurs_ptr fixed bin init(0), 13 209 2 do_rec char(5) init("00000"), 13 210 2 do_bit bit(8) init((8)"0"b), 13 211 2 max_red_size fixed bin(24) init(0), 13 212 2 name_size fixed bin init(5), 13 213 2 name char(5) init("INT_1"); 13 214 13 215 dcl 1 gen_num_lit_mindim internal static, 13 216 2 size fixed bin, 13 217 2 line fixed bin, 13 218 2 column fixed bin init(0), 13 219 2 type fixed bin init(2), 13 220 2 info bit(8) init("10000000"b), /*integer was 11000000 second bit is floating */ 13 221 2 sign char(1) init(" "), 13 222 2 exp_sign char(1) init(" "), 13 223 2 exp_places fixed bin init(0), 13 224 2 places_left fixed bin init(1), 13 225 2 places_right fixed bin init(0), 13 226 2 places fixed bin init(0), 13 227 2 literal char(10); 13 228 13 229 dcl 1 res_wd_perform internal static, 13 230 2 size fixed bin init( 28 ), 13 231 2 line fixed bin, 13 232 2 column fixed bin init(0), 13 233 2 type fixed bin init(1), 13 234 2 key fixed bin init(20), 13 235 2 class1 bit(16) init("1001001000000000"b), 13 236 2 class2 bit(4) init("1000"b), 13 237 2 class3 bit(1) init("0"b), 13 238 2 class4 bit(5) init("00000"b), 13 239 2 jump_index fixed bin init(0); 13 240 13 241 dcl 1 res_wd_varying internal static, 13 242 2 size fixed bin init( 28 ), 13 243 2 line fixed bin, 13 244 2 column fixed bin init(0), 13 245 2 type fixed bin init(1), 13 246 2 key fixed bin init(177), 13 247 2 class1 bit(16) init((16)"0"b), 13 248 2 class2 bit(4) init("0011"b), 13 249 2 class3 bit(1) init("0"b), 13 250 2 class4 bit(5) init("00000"b), 13 251 2 jump_index fixed bin init(0); 13 252 13 253 dcl 1 res_wd_by internal static, 13 254 2 size fixed bin init( 28 ), 13 255 2 line fixed bin, 13 256 2 column fixed bin init(0), 13 257 2 type fixed bin init(1), 13 258 2 key fixed bin init(82), 13 259 2 class1 bit(16) init((16)"0"b), 13 260 2 class2 bit(4) init("0001"b), 13 261 2 class3 bit(1) init("0"b), 13 262 2 class4 bit(5) init("00000"b), 13 263 2 jump_index fixed bin init(0); 13 264 13 265 dcl 1 res_wd_until internal static, 13 266 2 size fixed bin init( 28 ), 13 267 2 line fixed bin, 13 268 2 column fixed bin init(0), 13 269 2 type fixed bin init(1), 13 270 2 key fixed bin init(173), 13 271 2 class1 bit(16) init((16)"0"b), 13 272 2 class2 bit(4) init("0011"b), 13 273 2 class3 bit(1) init("0"b), 13 274 2 class4 bit(5) init("00000"b), 13 275 2 jump_index fixed bin init(0); 13 276 13 277 dcl 1 res_wd_go internal static, 13 278 2 size fixed bin init( 28 ), 13 279 2 line fixed bin, 13 280 2 column fixed bin init(0), 13 281 2 type fixed bin init(1), 13 282 2 key fixed bin init(14), 13 283 2 class1 bit(16) init("1001001000000000"b), 13 284 2 class2 bit(4) init("0010"b), 13 285 2 class3 bit(1) init("0"b), 13 286 2 class4 bit(5) init("00000"b), 13 287 2 jump_index fixed bin init(0); 13 288 13 289 dcl 1 res_wd_after internal static, 13 290 2 size fixed bin init( 28 ), 13 291 2 line fixed bin, 13 292 2 column fixed bin init(0), 13 293 2 type fixed bin init(1), 13 294 2 key fixed bin init(72), 13 295 2 class1 bit(16) init((16)"0"b), 13 296 2 class2 bit(4) init("0000"b), 13 297 2 class3 bit(1) init("0"b), 13 298 2 class4 bit(5) init("00000"b), 13 299 2 jump_index fixed bin init(0); 13 300 13 301 dcl 1 gen_item_t2 internal static, 13 302 2 size fixed bin init( 117 ), 13 303 2 line fixed bin, 13 304 2 column fixed bin init(0), 13 305 2 type fixed bin init(9), 13 306 2 string_pointer ptr, 13 307 2 prev_rec ptr, 13 308 2 info8 bit(8) init((8)"0"b), 13 309 2 def_line fixed bin init(0), 13 310 2 level fixed bin init(77), 13 311 2 linkage fixed bin init(0), 13 312 2 file_num fixed bin init(0), 13 313 2 size_rtn fixed bin init(0), 13 314 2 length fixed bin(24) init(1), 13 315 2 places_left fixed bin init(1), 13 316 2 places_right fixed bin init(0), 13 317 2 descr_bit bit(72) init("010000100100000001000000000100000000000000000000000010000000000000000000"b), 13 318 13 319 2 seg_num fixed bin init(0), 13 320 2 offset fixed bin(24) init(-1), /*to tell fix-up this is generated item*/ 13 321 2 init_ptr fixed bin init(0), 13 322 2 edit_ptr fixed bin init(0), 13 323 2 occurs_ptr fixed bin init(0), 13 324 2 do_rec char(5) init("00000"), 13 325 2 do_bit bit(8) init((8)"0"b), 13 326 2 max_red_size fixed bin(24) init(0), 13 327 2 name_size fixed bin init(5), 13 328 2 name char(5) init("INT_2"); 13 329 13 330 dcl 1 gen_item_t3 internal static, 13 331 2 size fixed bin init( 117 ), 13 332 2 line fixed bin, 13 333 2 column fixed bin init(0), 13 334 2 type fixed bin init(9), 13 335 2 string_pointer ptr, 13 336 2 prev_rec ptr, 13 337 2 info8 bit(8) init((8)"0"b), 13 338 2 def_line fixed bin init(0), 13 339 2 level fixed bin init(77), 13 340 2 linkage fixed bin init(0), 13 341 2 file_num fixed bin init(0), 13 342 2 size_rtn fixed bin init(0), 13 343 2 length fixed bin(24) init(1), 13 344 2 places_left fixed bin init(1), 13 345 2 places_right fixed bin init(0), 13 346 2 descr_bit bit(72) init("010000100100000001000000000100000000000000000000000010000000000000000000"b), 13 347 13 348 2 seg_num fixed bin init(0), 13 349 2 offset fixed bin(24) init(-1), /*to tell fix-up this is generated item*/ 13 350 2 init_ptr fixed bin init(0), 13 351 2 edit_ptr fixed bin init(0), 13 352 2 occurs_ptr fixed bin init(0), 13 353 2 do_rec char(5) init("00000"), 13 354 2 do_bit bit(8) init((8)"0"b), 13 355 2 max_red_size fixed bin(24) init(0), 13 356 2 name_size fixed bin init(5), 13 357 2 name char(5) init("INT_3"); 13 358 13 359 dcl 1 gen_label_def internal static, 13 360 2 size fixed bin init( 62 ), 13 361 2 line fixed bin, 13 362 2 column fixed bin init(0), 13 363 2 type fixed bin init(7), 13 364 2 string_ptr ptr, 13 365 2 prev_rec ptr, 13 366 2 info bit(8) init("00000000"b), 13 367 2 priority char(2), 13 368 2 repl_bit bit(8) init("00000000"b), 13 369 2 section_num fixed bin, 13 370 2 proc_num fixed bin, 13 371 2 def_line fixed bin init(0), 13 372 2 length fixed bin init(10), 13 373 2 name char(10) ; 13 374 13 375 dcl 1 gen_label_ref internal static, 13 376 2 size fixed bin init( 62 ), 13 377 2 line fixed bin init(0), 13 378 2 column fixed bin init(0), 13 379 2 type fixed bin init(18), 13 380 2 string_ptr ptr, 13 381 2 prev_rec ptr, 13 382 2 info bit(8) init("10000000"b), 13 383 2 priority char(2), 13 384 2 repl_bit bit(8) init("00000000"b), 13 385 2 section_num fixed bin, 13 386 2 proc_num fixed bin, 13 387 2 def_line fixed bin init(0), 13 388 2 length fixed bin init(10), 13 389 2 name char(10) ; 13 390 13 391 13 392 13 393 dcl 1 res_wd_if internal static, 13 394 2 size fixed bin init( 28 ), 13 395 2 line fixed bin init(0), 13 396 2 column fixed bin init(0), 13 397 2 type fixed bin init(1), 13 398 2 key fixed bin init(47), 13 399 2 class1 bit(16) init("1001000000000000"b), 13 400 2 class2 bit(4) init("0011"b), 13 401 2 class3 bit(1) init("0"b), 13 402 2 class4 bit(5) init("00000"b), 13 403 2 jump_index fixed bin init(0); 13 404 13 405 dcl 1 res_wd_on internal static, 13 406 2 size fixed bin init( 28 ), 13 407 2 line fixed bin init(0), 13 408 2 column fixed bin init(0), 13 409 2 type fixed bin init(1), 13 410 2 key fixed bin init(134), 13 411 2 class1 bit(16) init((16)"0"b), 13 412 2 class2 bit(4) init("0001"b), 13 413 2 class3 bit(1) init("0"b), 13 414 2 class4 bit(5) init("00000"b), 13 415 2 jump_index fixed bin init(0); 13 416 13 417 dcl 1 res_wd_size internal static, 13 418 2 size fixed bin init( 28 ), 13 419 2 line fixed bin, 13 420 2 column fixed bin init(0), 13 421 2 type fixed bin init(1), 13 422 2 key fixed bin init(161), 13 423 2 class1 bit(16) init((16)"0"b), 13 424 2 class2 bit(4) init("0001"b), 13 425 2 class3 bit(1) init("0"b), 13 426 2 class4 bit(5) init("00000"b), 13 427 2 jump_index fixed bin init(0); 13 428 13 429 dcl 1 res_wd_error internal static, 13 430 2 size fixed bin init( 28 ), 13 431 2 line fixed bin, 13 432 2 column fixed bin init(0), 13 433 2 type fixed bin init(1), 13 434 2 key fixed bin init(3), 13 435 2 class1 bit(16) init("0000000000000100"b), 13 436 2 class2 bit(4) init("0001"b), 13 437 2 class3 bit(1) init("0"b), 13 438 2 class4 bit(5) init("00000"b), 13 439 2 jump_index fixed bin init(0); 13 440 13 441 /****************************************** END DATA *********************************************/ 13 442 /* END INCLUDE FILE ... cobol_common_data.incl.pl1 */ 13 443 3143 3144 end cobol_ci_phase; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0833.1 cobol_ci_phase.pl1 >spec>install>MR12.3-1048>cobol_ci_phase.pl1 3118 1 03/27/82 0431.3 cobol_ext_.incl.pl1 >ldd>include>cobol_ext_.incl.pl1 3119 2 03/27/82 0439.7 cobol_io_info.incl.pl1 >ldd>include>cobol_io_info.incl.pl1 3121 3 11/11/82 1712.8 cobol_TYPE1.incl.pl1 >ldd>include>cobol_TYPE1.incl.pl1 3124 4 11/11/82 1712.8 cobol_TYPE2.incl.pl1 >ldd>include>cobol_TYPE2.incl.pl1 3127 5 11/11/82 1712.7 cobol_TYPE9.incl.pl1 >ldd>include>cobol_TYPE9.incl.pl1 3129 6 03/27/82 0439.7 cobol_occurs.incl.pl1 >ldd>include>cobol_occurs.incl.pl1 6-6 7 03/27/82 0439.6 cobol_OCCURS.incl.pl1 >ldd>include>cobol_OCCURS.incl.pl1 3132 8 11/11/82 1712.7 cobol_TYPE10.incl.pl1 >ldd>include>cobol_TYPE10.incl.pl1 3135 9 11/11/82 1712.7 cobol_TYPE7.incl.pl1 >ldd>include>cobol_TYPE7.incl.pl1 3138 10 11/11/82 1712.8 cobol_TYPE3.incl.pl1 >ldd>include>cobol_TYPE3.incl.pl1 3140 11 03/27/82 0431.5 cobol_ciphase_data.incl.pl1 >ldd>include>cobol_ciphase_data.incl.pl1 3142 12 11/11/82 1712.8 cobol_fixed_common.incl.pl1 >ldd>include>cobol_fixed_common.incl.pl1 3143 13 03/27/82 0439.6 cobol_common_data.incl.pl1 >ldd>include>cobol_common_data.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. add_swt 001476 automatic bit(1) packed unaligned dcl 11-82 set ref 2096* 2145* addr builtin function dcl 3098 ref 51 52 53 308 308 394 401 402 406 407 438 452 1063 1073 1118 1120 1122 1124 1149 1151 1153 1155 1157 1159 1161 1163 1311 1331 1332 1334 1335 1416 1432 1507 1536 1564 1571 1582 1761 1845 1856 1872 1941 2077 2218 2320 2352 2357 2359 2364 2370 2390 2458 2481 2485 2489 2490 2498 2506 2512 2520 2526 2527 2536 2554 2555 2559 2567 2568 2572 2589 2590 2591 2592 2593 2594 2595 2596 2597 2605 2617 2619 2621 2623 2625 2627 2629 2631 2633 2640 2652 2654 2656 2658 2660 2662 2664 2666 2668 2676 2677 2678 2682 2685 2689 2690 2696 2698 2715 2730 2762 2764 2780 2791 2801 2808 2815 2819 2822 2848 2852 2899 3070 al_bitt parameter bit(1) packed unaligned dcl 2958 ref 2912 2990 al_byte parameter bit(1) packed unaligned dcl 2959 ref 2912 2993 al_double_word parameter bit(1) packed unaligned dcl 2962 ref 2912 al_elem_offset parameter fixed bin(24,0) dcl 2953 ref 2912 3026 3029 al_half_word parameter bit(1) packed unaligned dcl 2960 ref 2912 2996 al_occ_offset parameter fixed bin(24,0) dcl 2954 ref 2912 3034 3037 al_read_only parameter bit(1) packed unaligned dcl 2957 ref 2912 2984 3082 al_rec_off parameter fixed bin(24,0) dcl 2956 set ref 2912 3051* al_rec_seg parameter fixed bin(17,0) dcl 2955 set ref 2912 3049* al_size parameter fixed bin(24,0) dcl 2952 ref 2912 2974 3020 3052 al_word parameter bit(1) packed unaligned dcl 2961 ref 2912 2999 all_lit 4(01) based bit(1) level 2 packed packed unaligned dcl 3137 set ref 1703* alloc_offset 016774 automatic fixed bin(24,0) dcl 11-134 set ref 1030* 1033 2428* 2431 2436* 2439 2442* 2445 alloc_seg 016773 automatic fixed bin(17,0) dcl 11-133 set ref 1030* 1032 2428* 2430 2436* 2438 2442* 2444 alphanum_lit based structure level 1 unaligned dcl 3137 any_item based char(1) array packed unaligned dcl 11-100 set ref 394 438 1432 1856 1872 2320 2390 2498 2512 2520 2536 2715 2780 array_init_bit 017033 automatic bit(1) packed unaligned dcl 11-171 set ref 1360* 1560* 1818* 2335 2384* 2398* 2833* begin_i 001452 automatic fixed bin(17,0) dcl 11-58 set ref 269* 1116* 1117 1131* 1145* 1146 1147 1166* 1167 1172 1328* 2244 bin_val 000100 automatic fixed bin(17,0) dcl 2268 set ref 2276* 2281 2286 2287 2289* 2289 blank_name constant char(32) initial packed unaligned dcl 11-77 ref 1066 1076 category 016753 automatic fixed bin(17,0) dcl 11-117 set ref 1620* 1623* 1626* 1629* 1632* 1712 1712 1750 1750 1763 1846 2357 2696 2898* 2900* check_res 000114 automatic fixed bin(17,0) dcl 3115 set ref 557 889* 910* cobol$alloc 000574 constant entry external dcl 40 ref 43 cobol_c_list 000576 constant entry external dcl 3101 ref 308 cobol_cmfp defined pointer dcl 1-21 set ref 2980* 3055* 3065* 3084* cobol_com_ptr defined pointer dcl 1-25 ref 61 300 300 2454 2454 2455 2456 2672 2672 2674 2675 2974 2974 2978 2980 3023 3074 3074 3078 3089 3089 cobol_ext_$cobol_cmfp 000600 external static pointer dcl 1-20 ref 2980 2980 3055 3055 3065 3065 3084 3084 cobol_ext_$cobol_com_ptr 000602 external static pointer dcl 1-24 ref 61 61 300 300 300 300 2454 2454 2454 2454 2455 2455 2456 2456 2672 2672 2672 2672 2674 2674 2675 2675 2974 2974 2974 2974 2978 2978 2980 2980 3023 3023 3074 3074 3074 3074 3078 3078 3089 3089 3089 3089 cobol_ext_$cobol_rmin2fp 000604 external static pointer dcl 1-50 ref 45 45 cobol_ext_$cobol_x3fp 000606 external static pointer dcl 1-70 ref 46 46 cobol_rmin2fp defined pointer dcl 1-51 ref 45 cobol_swf_get 000610 constant entry external dcl 2-9 ref 2046 2104 2115 2123 2170 cobol_swf_put 000612 constant entry external dcl 2-11 ref 320 327 1930 1958 1978 1992 2004 2092 2203 2251 cobol_vdwf_dget 000614 constant entry external dcl 2-19 ref 2980 3065 cobol_vdwf_dput 000616 constant entry external dcl 2-21 ref 3055 3084 cobol_x3fp defined pointer dcl 1-71 ref 46 code 016775 automatic fixed bin(17,0) dcl 11-138 set ref 272* 289* 1365* 1980* 2044 2061 2183 2201 2207 column 2 000010 internal static fixed bin(17,0) initial level 2 in structure "message" dcl 1909 in procedure "cobol_ci_phase" set ref 304* 1955* 2002* column 2 based fixed bin(17,0) level 2 in structure "reserved_word" dcl 3120 in procedure "cobol_ci_phase" ref 304 1955 2002 column 2 based fixed bin(17,0) level 2 in structure "data_name" dcl 3126 in procedure "cobol_ci_phase" ref 1091 common_key 000114 automatic char(5) packed unaligned dcl 2941 set ref 2978* 3055* 3063* 3084* 3089 common_recsize 000112 automatic fixed bin(17,0) dcl 2940 set ref 2980* 3055* 3065* comp_level 137 based char(1) level 2 packed packed unaligned dcl 12-26 ref 300 300 curr_dim 016766 automatic fixed bin(17,0) dcl 11-126 set ref 262* 1890 2405 2582* 2608* 2643* curr_dir based structure array level 1 unaligned dcl 11-39 curr_dir_index 000160 automatic fixed bin(17,0) dcl 11-42 set ref 413* 444 450* 450 454 455 468 484 507* 507 509 510 564 635 636 1052 curr_dir_ptr 000156 automatic pointer dcl 11-38 set ref 402* 407* 454 455 509 510 518 627 635 curr_level 001474 automatic fixed bin(17,0) dcl 11-80 set ref 456* 470 475 485 506* 625 632 637 curr_stk_index 000334 automatic fixed bin(17,0) dcl 11-50 set ref 415* 475 478 483* 483 484 485 504 625 627 627 628* 628 632 634 636 637 curr_table based char(1) array packed unaligned dcl 11-23 set ref 452 curr_tbl_index 000144 automatic fixed bin(17,0) dcl 11-24 set ref 414* 452 454 459 466* 466 curr_tbl_ptr 000142 automatic pointer dcl 11-22 set ref 401* 406* 452 cv_index parameter fixed bin(17,0) dcl 2270 set ref 2262 2278* 2284* 2288 2290* 2290 cv_string 000101 automatic char(10) packed unaligned dcl 2271 in procedure "bin_to_char" set ref 2277* 2283* 2288* 2293 cv_string 001507 automatic char(10) packed unaligned dcl 11-93 in procedure "cobol_ci_phase" set ref 1092* 1093 1096* 1097 1891* 1894 cvbd_1 001505 automatic char(4) packed unaligned dcl 11-91 set ref 1093* 1094 1097* 1098 cvindex 001506 automatic fixed bin(17,0) dcl 11-92 set ref 1092* 1096* 1891* 1892 1894 data_name based structure level 1 unaligned dcl 3126 dataname_subscr_sw 001502 automatic bit(1) packed unaligned dcl 11-88 set ref 650* 755* 774 824 dcl_col 1 000432 automatic char(3) array level 2 packed packed unaligned dcl 11-54 set ref 1094* dcl_line 000432 automatic char(4) array level 2 packed packed unaligned dcl 11-54 set ref 1098* dd_seg_size 77 based fixed bin(24,0) level 2 dcl 12-26 ref 2974 3023 dd_segment based structure level 1 unaligned dcl 2931 debug_token based structure level 1 unaligned dcl 2032 dec_digits 000056 constant char(10) initial packed unaligned dcl 2267 ref 2288 def_line 13 000520 internal static fixed bin(17,0) initial level 2 in structure "gen_label_ref" dcl 13-375 in procedure "cobol_ci_phase" set ref 1354* def_line 13 000500 internal static fixed bin(17,0) initial level 2 in structure "gen_label_def" dcl 13-359 in procedure "cobol_ci_phase" set ref 1353* defaults 016752 automatic bit(1) packed unaligned dcl 11-116 set ref 1595* 1603* 1837 2354 2694 descr_ptr 000100 automatic pointer dcl 3103 set ref 1761* 1763 1845* 1846 2899* 2900 description based bit(1) array packed unaligned dcl 3105 ref 1763 1846 2900 dimensions 2 based fixed bin(17,0) level 2 dcl 6-5 ref 395 440 705 830 842 1431 2326 2326 2331 2602 2637 2803 2810 dir 1 based fixed bin(17,0) array level 3 in structure "dir_struct" dcl 11-29 in procedure "cobol_ci_phase" set ref 1236 1251 dir 1 based fixed bin(17,0) array level 2 in structure "curr_dir" dcl 11-39 in procedure "cobol_ci_phase" set ref 455* 510* 518* 627* 635* dir 2001 based fixed bin(17,0) array level 3 in structure "dir_struct" dcl 11-29 in procedure "cobol_ci_phase" set ref 1217 1226 1272 dir1 based structure array level 2 unaligned dcl 11-29 set ref 51 402 dir2 2000 based structure array level 2 unaligned dcl 11-29 set ref 52 407 dir_num 000107 automatic fixed bin(24,0) dcl 3111 set ref 403* 408* 518 dir_ptr 000154 automatic pointer dcl 11-28 set ref 43* 43 43 51 52 53 401 402 406 407 1063 1063 1073 1073 1217 1224 1226 1236 1251 1272 1311 1311 dir_ptr1 000164 automatic pointer dcl 11-45 set ref 51* dir_ptr2 000166 automatic pointer dcl 11-45 set ref 52* dir_struct based structure level 1 unaligned dcl 11-29 set ref 43 43 divide builtin function dcl 3098 ref 2289 double_word_slack 000123 automatic fixed bin(7,0) dcl 2947 set ref 3001* 3003 3003 duplicate 10(01) based bit(1) level 2 packed packed unaligned dcl 3131 set ref 799* 2486* 2767* duplicate_next_loc 4 based fixed bin(24,0) level 2 dcl 2931 set ref 3053* 3081* elem_offset_limit 000116 automatic fixed bin(24,0) dcl 2942 set ref 2967* 3026 3031 elementary 21(09) based bit(1) level 2 packed packed unaligned dcl 3126 ref 374 432 1084 1084 1084 1084 1206 1206 1437 1833 end_cobol 5(07) based bit(1) level 2 packed packed unaligned dcl 3120 ref 1965 1989 end_dir1_index 000161 automatic fixed bin(17,0) dcl 11-43 set ref 564* 1052 1310 end_i 001450 automatic fixed bin(17,0) dcl 11-58 set ref 288* 591* 591 592 593* 593 594 656* 656 657 688* 688 689 716* 716 717 800* 800 801 859* 859 860 926* 926 927 1115* 1115 1116 1118 1119* 1119 1120 1121* 1121 1122 1123* 1123 1124 1130* 1145 1147* 1149 1150* 1150 1151 1152* 1152 1153 1154* 1154 1155 1156* 1156 1157 1158* 1158 1159 1160* 1160 1161 1162* 1162 1163 1167* 1172* 1315* 1329* 2244 2366* 2373* 2373 2375 2492* 2560* 2573* 2598* 2606* 2613* 2613 2617 2618* 2618 2619 2620* 2620 2621 2622* 2622 2623 2624* 2624 2625 2626* 2626 2627 2628* 2628 2629 2630* 2630 2631 2632* 2632 2633 2641* 2648* 2648 2652 2653* 2653 2654 2655* 2655 2656 2657* 2657 2658 2659* 2659 2660 2661* 2661 2662 2663* 2663 2664 2665* 2665 2666 2667* 2667 2668 2735* 2751* 2760* 2760 2762 2764 2773* 2773 2774 2789* 2800* 2800 2801 2806* 2806 2808 2813* 2813 2815 2817* 2817 2819 2821* 2821 2822 2853* end_initlz_tbl_index 016761 automatic fixed bin(17,0) dcl 11-123 set ref 1363* 1416 1419 1425 1426* 1426 1498* 1507 1509* 1509 1511 1536 1539* 1539 1541 1564 1573* 1573 1575 eof 000141 automatic bit(1) packed unaligned dcl 11-20 set ref 50* 253 278 294 332 359 422 537 568 663 694 723 818 865 901 931 960 993 1018 1302 1369 1443 1475 1551 1586 1608 1643 1660 1681 1695 1725 1734 1782 1927 1986 1994* 2053* 2108* 2118* 2127* 2173* 2176 err_image 017005 automatic char(60) packed unaligned dcl 11-151 set ref 63* 74* 78* 101* 147* 174* 180* 186* 191* 196* 201* 206* 211* 216* 221* 226* 231* 236* 641* 1183* 1192* 1936 1948 1949* err_num 017004 automatic fixed bin(17,0) dcl 11-150 set ref 62* 65 68 176* 182* 188* 193* 198* 203* 208* 213* 218* 223* 228* 233* 238* 243* 247* 256* 361* 370* 376* 382* 388* 424* 446* 462* 480* 492 514 527 532 539* 546* 554 570* 577 583 609* 615* 619* 640* 665* 677* 696* 723* 729* 736* 752* 764* 770* 776* 788* 820* 832* 850* 867* 873* 879* 1020* 1182* 1191* 1286* 1349* 1371* 1377* 1384* 1394* 1402* 1421* 1445* 1463* 1477* 1513* 1526* 1533 1543* 1553* 1577* 1588* 1610* 1616* 1636* 1645* 1651* 1662* 1668* 1675* 1683* 1697* 1715* 1727* 1736* 1753* 1765* 1784* 1793* 1807* 1814* 1863* 1935 errnum parameter fixed bin(17,0) dcl 605 ref 602 609 615 file_section 21 based bit(1) level 2 packed packed unaligned dcl 3126 set ref 1761 1845 2899 filler_item 21(10) based bit(1) level 2 packed packed unaligned dcl 3126 ref 432 1504 first_pair 013331 automatic bit(1) packed unaligned dcl 11-108 set ref 355* 1089 1308* first_time_in_get_1 000100 automatic bit(1) packed unaligned dcl 2015 set ref 2042* 2083 2100* fixbin15 001512 automatic fixed bin(17,0) dcl 11-94 in procedure "cobol_ci_phase" set ref 263* 1091* 1092* 1095* 1096* 2405 2405 fixbin15 017054 automatic fixed bin(17,0) dcl 1887 in procedure "setup_gen_lit" set ref 1890* 1891* fixbin24 001513 automatic fixed bin(24,0) dcl 11-95 set ref 1028* 1030* 2426* 2428* 2433* 2436* 2440* 2442* fixbin_diff 017036 automatic bit(1) packed unaligned dcl 11-174 set ref 265* 2316* 2409* 2551 2564* fixed_common based structure level 1 unaligned dcl 12-26 fst 000122 automatic bit(32) packed unaligned dcl 11-11 set ref 320* 327* 1930* 1958* 1978* 1992* 2004* 2046* 2051 2092* 2104* 2106 2115* 2116 2123* 2125 2170* 2173 2203* 2251* gen_item_allocated 016772 automatic bit(1) packed unaligned dcl 11-132 set ref 56* 1026 1034* 2423 gen_item_t1 000260 internal static structure level 1 unaligned dcl 13-186 set ref 1124 1161 1332 2481 2589 2595 2762 2801 gen_item_t2 000404 internal static structure level 1 unaligned dcl 13-301 set ref 2485 2617 2629 2764 2808 gen_item_t3 000442 internal static structure level 1 unaligned dcl 13-330 set ref 2652 2664 2815 gen_label_def 000500 internal static structure level 1 unaligned dcl 13-359 set ref 2458 2555 2685 2848 gen_label_ref 000520 internal static structure level 1 unaligned dcl 13-375 set ref 2568 2678 gen_num_lit_mindim 000316 internal static structure level 1 unaligned dcl 13-215 set ref 2597 2633 2668 gen_ptr 000336 automatic pointer array dcl 11-52 set ref 287* 592* 657* 689* 717* 801* 860* 927* 1101* 1102* 1118* 1120* 1122* 1124* 1149* 1151* 1153* 1155* 1157* 1159* 1161* 1163* 1331* 1332* 1334* 1335* 2246 2352* 2357* 2359* 2362* 2364* 2365* 2370* 2375* 2458* 2460* 2481* 2485* 2489* 2490* 2491* 2506* 2508* 2508 2512* 2517 2518 2520 2526* 2527* 2554* 2555* 2557* 2559* 2567* 2568* 2570* 2572* 2589* 2590* 2591* 2592* 2593* 2594* 2595* 2596* 2597* 2605* 2617* 2619* 2621* 2623* 2625* 2627* 2629* 2631* 2633* 2640* 2652* 2654* 2656* 2658* 2660* 2662* 2664* 2666* 2668* 2676* 2677* 2678* 2680* 2682* 2685* 2687* 2689* 2690* 2696* 2698* 2703* 2711 2715* 2715 2717 2719 2730* 2733* 2762* 2764* 2774* 2791* 2801* 2808* 2815* 2819* 2822* 2848* 2850* 2852* general_label based structure level 1 unaligned dcl 2868 half_word_slack 000125 automatic fixed bin(7,0) dcl 2949 set ref 3016* 3018 i 001447 automatic fixed bin(17,0) dcl 11-58 set ref 2244* 2246* 2414* 2692* 2696 2698 2703 2711 2714* 2714 2715 2715 2717 2719 2729* 2729 2730 2731* 2731 2733 2735 image 10 000010 internal static char(200) level 2 packed packed unaligned dcl 1909 set ref 1948* ind_level 017065 automatic fixed bin(17,0) dcl 2308 set ref 2473* 2540 2542* 2542 index builtin function dcl 3098 ref 1936 index_ct 4 013342 automatic fixed bin(17,0) array level 2 dcl 11-112 set ref 782* 782 1407* 2467 2540 index_name based structure level 1 unaligned dcl 3131 index_no 15 based fixed bin(17,0) level 2 dcl 3131 ref 768 indexed_by 22(09) based bit(1) level 2 packed packed unaligned dcl 3126 ref 761 indexedno 3 based fixed bin(17,0) array level 3 dcl 6-5 ref 768 indexname_subscr_sw 001503 automatic bit(1) packed unaligned dcl 11-89 set ref 649* 750 780* indicators 000104 automatic structure level 1 packed packed unaligned dcl 3107 inf based bit(8) packed unaligned dcl 3106 set ref 2078* inf_ptr 000102 automatic pointer dcl 3103 set ref 2077* 2078 info1 6 000010 internal static bit(1) initial level 3 packed packed unaligned dcl 1909 set ref 1945* 1950* 1974* info2 6(01) 000010 internal static bit(1) initial level 3 in structure "message" packed packed unaligned dcl 1909 in procedure "cobol_ci_phase" set ref 1953* 1975* info2 6(01) based bit(1) level 3 in structure "message" packed packed unaligned dcl 2019 in procedure "corr_in" ref 2064 2188 infobits 6 000010 internal static structure level 2 in structure "message" packed packed unaligned dcl 1909 in procedure "cobol_ci_phase" infobits 6 based structure level 2 in structure "message" packed packed unaligned dcl 2019 in procedure "corr_in" infp 000124 automatic pointer dcl 11-12 set ref 45* 2046* 2104* 2115* 2123* 2170* initlz_item_tbl based char(1) array packed unaligned dcl 11-120 set ref 1416 1507 1536 1564 1582 initlz_items_allocated 016770 automatic bit(1) packed unaligned dcl 11-128 set ref 57* 1026 1037 2418 2446* initlz_swt 016767 automatic bit(1) packed unaligned dcl 11-127 set ref 281 654 686 714 782 796 854 2099* 2163* initlz_tbl_ptr 016756 automatic pointer dcl 11-119 set ref 53* 1416 1507 1536 1564 1582 input_ptr 000134 automatic pointer dcl 11-17 set ref 54* 297 297 303 304 325 354 367 374 380 380 386 392 394 394 411 417 428 432 432 432 432 432 436 438 438 453 456 544 607 613 671 675 700 700 747 758 768 827 838 838 844 871 877 907 914 921 937 945 968 976 993 1000 1305 1351 1375 1381 1388 1392 1427 1437 1448 1451 1454 1457 1481 1483 1486 1491 1504 1504 1504 1517 1523 1547 1557 1592 1592 1614 1620 1623 1626 1629 1632 1649 1655 1666 1673 1687 1690 1701 1703 1709 1731 1747 1759 1761 1769 1788 1788 1798 1801 1803 1930 1930* 1930 1954 1955 1965 1965 1989 1989 1989 1992* 2001 2002 2046* 2058 2064 2072 2075 2077 2101 2104* 2112 2112 2115* 2123* 2131 2134 2137 2140 2143 2149 2155 2161 2170* 2179 2179 2183 2188 2196 2199 2203 2203* 2219 key 4 based fixed bin(17,0) level 2 in structure "reserved_word" dcl 3120 in procedure "cobol_ci_phase" ref 297 613 700 838 838 844 921 945 976 1000 1523 1592 1620 1623 1626 1629 1632 1655 1673 1690 1731 1788 1801 1803 1989 2112 2143 2149 2155 2161 2378 2503 2523 2719 2770 key 4 000135 internal static fixed bin(17,0) initial level 2 in structure "res_wd_greater" dcl 13-47 in procedure "cobol_ci_phase" set ref 1333* 2574* label_ptr parameter pointer dcl 2866 ref 2863 2888 2889 lc_stack 000432 automatic structure array level 1 packed packed unaligned dcl 11-54 length 16 000260 internal static fixed bin(24,0) initial level 2 in structure "gen_item_t1" dcl 13-186 in procedure "cobol_ci_phase" set ref 1039* 2586* length 16 000442 internal static fixed bin(24,0) initial level 2 in structure "gen_item_t3" dcl 13-330 in procedure "cobol_ci_phase" set ref 2649* length 7 000010 internal static fixed bin(17,0) initial level 2 in structure "message" dcl 1909 in procedure "cobol_ci_phase" set ref 1936* 1938 1938* 1938 1943 1948 1948 1956 length 16 000404 internal static fixed bin(24,0) initial level 2 in structure "gen_item_t2" dcl 13-301 in procedure "cobol_ci_phase" set ref 2614* level 12 based fixed bin(17,0) level 2 in structure "data_name" dcl 3126 in procedure "cobol_ci_phase" ref 380 380 456 level 3 based structure array level 2 in structure "occurs" unaligned dcl 6-5 in procedure "cobol_ci_phase" level 1 000170 automatic fixed bin(17,0) array level 2 in structure "stack" dcl 11-47 in procedure "cobol_ci_phase" set ref 470* 475 485* 506 625 632 637* line 1 000010 internal static fixed bin(17,0) initial level 2 in structure "message" dcl 1909 in procedure "cobol_ci_phase" set ref 303* 1954* 2001* line 1 based fixed bin(17,0) level 2 in structure "reserved_word" dcl 3120 in procedure "cobol_ci_phase" set ref 303 354 1351 1954 2001 2248 2248* 2253* line 1 based fixed bin(17,0) level 2 in structure "data_name" dcl 3126 in procedure "cobol_ci_phase" ref 1095 link1 000111 automatic fixed bin(24,0) dcl 3113 set ref 1236* 1237 1242 1246 1248 1250 1251* 1254 1267 link2 000112 automatic fixed bin(24,0) dcl 3113 set ref 1217* 1220 1222 1226* 1232 1243 1269 1271 1272* 1276 literal 11 000316 internal static char(10) level 2 packed packed unaligned dcl 13-215 set ref 1894* lk_ahd_index 017002 automatic fixed bin(17,0) dcl 11-144 set ref 266* 955* 988* 1014* 2087 2087 lk_ahd_ptr 016776 automatic pointer array dcl 11-143 set ref 956* 989* 2089 ln 000130 automatic fixed bin(24,0) dcl 1238 set ref 1237* 1240 loc1 000162 automatic fixed bin(17,0) dcl 11-44 set ref 1059* 1063 1094 1098 1210* 1210 1236 1237 1242* 1246 1250* 1251 1267* loc2 000163 automatic fixed bin(17,0) dcl 11-44 set ref 1060* 1073 1211* 1211 1217 1220 1222* 1224 1226 1232* 1243* 1269 1271* 1272 1276* main_item_index 016762 automatic fixed bin(17,0) dcl 11-124 set ref 1425* 1498 main_item_ptr 016764 automatic pointer dcl 11-125 set ref 411* 761 1416* 1427 1431 1432 1432 1439 1470 main_item_subscripted 013340 automatic bit(1) packed unaligned dcl 11-110 set ref 1390* 1412* 1429 1495 1829* 1831* 2322 2368 2462 2745 2786 max 5 based fixed bin(17,0) array level 3 dcl 6-5 ref 1890 message based structure level 1 unaligned dcl 2019 in procedure "corr_in" message 000010 internal static structure level 1 unaligned dcl 1909 in procedure "cobol_ci_phase" set ref 308 308 1941 min 4 based fixed bin(17,0) array level 3 dcl 6-5 ref 2405 mod builtin function dcl 3098 ref 459 466 1417 1508 1538 1572 1855 1871 2221 2233 2287 2389 2497 2511 2519 2535 2713 2779 3001 3008 3016 mode parameter fixed bin(17,0) dcl 348 set ref 345 350 596* move_swt 001475 automatic bit(1) packed unaligned dcl 11-81 set ref 432 893 1084 1297 2098* 2157* n 013330 automatic fixed bin(17,0) dcl 11-107 set ref 1310* 1311* 1854* 1855* 1855 1855 1856 1870* 1871* 1871 1871 1872 2087* 2089* 2220* 2221 2221 2388* 2389* 2389 2389 2390 2496* 2497* 2497 2497 2498 2510* 2511* 2511 2511 2512 2518* 2519* 2519 2519 2520 2534* 2535* 2535 2535 2536 2711* 2713* 2713 2713 2715 2777* 2779* 2779 2779 2780 n_array 017034 automatic fixed bin(17,0) dcl 11-172 set ref 1352* 1457* 1457 1559* 1559 1848* 1848 2383* 2383 2399* 2399 2828 2832* 2832 name 15 000520 internal static char(10) level 2 in structure "gen_label_ref" packed packed unaligned dcl 13-375 in procedure "cobol_ci_phase" set ref 1356* name 34 based char level 2 in structure "data_name" packed packed unaligned dcl 3126 in procedure "cobol_ci_phase" ref 1068 1078 name 15 000500 internal static char(10) level 2 in structure "gen_label_def" packed packed unaligned dcl 13-359 in procedure "cobol_ci_phase" set ref 1355* name 15 based char(10) level 2 in structure "general_label" packed packed unaligned dcl 2868 in procedure "write_gen_label" set ref 2889* name1 001454 automatic char(32) packed unaligned dcl 11-78 set ref 1066* 1068* 1081 name2 001464 automatic char(32) packed unaligned dcl 11-78 set ref 1076* 1078* 1081 name_size 33 based fixed bin(17,0) level 2 dcl 3126 ref 1068 1068 1068 1078 1078 1078 new_seg_bit 000120 automatic bit(1) packed unaligned dcl 11-6 set ref 58* 2971 3059 3074 3077* next based char(5) level 2 packed packed unaligned dcl 2931 set ref 3063 3065* 3067 3072* next_avail_loc 3 based fixed bin(24,0) level 2 dcl 2931 set ref 2988 3052* 3053 3080* next_free_column 000140 automatic fixed bin(17,0) dcl 11-19 set ref 273* next_loc_used 000121 automatic fixed bin(24,0) dcl 2945 set ref 2988* 3001 3003* 3003 3008 3011* 3011 3016 3018* 3018 3020 3029 3034 3051 3052 3092* nu_line 000121 automatic fixed bin(17,0) dcl 11-10 set ref 354* 1351* 1353 1354 2248 null_match 001514 automatic bit(1) packed unaligned dcl 11-97 set ref 1061* 1110 1143 1175* 1257 1307* 1323 1824* 1861 2314* num_lit_one 000156 internal static structure level 1 unaligned dcl 13-73 set ref 1157 1335 2591 2593 2621 2625 2656 2660 num_lit_zero 000144 internal static structure level 1 unaligned dcl 13-59 set ref 1120 number 5 000010 internal static fixed bin(17,0) initial level 2 dcl 1909 set ref 302* 1935* 1972* 2000* number_of_dd_segs 102 based fixed bin(17,0) level 2 dcl 12-26 set ref 3074* 3074 3078 numeric 21(17) based bit(1) level 2 packed packed unaligned dcl 3126 ref 432 numeric_lit based structure level 1 unaligned dcl 3123 occ_offset_limit 000117 automatic fixed bin(24,0) dcl 2943 set ref 2968* 3037 3040 occurs based structure level 1 unaligned dcl 6-5 occurs_do 22(06) based bit(1) level 2 packed packed unaligned dcl 3126 ref 1392 1491 occurs_ptr 27 based fixed bin(17,0) level 2 dcl 3126 ref 394 438 1432 2320 off 000103 internal static bit(1) initial packed unaligned dcl 11-15 set ref 49* 1030* 1030* 1030* 1030* 1030* 2428* 2428* 2428* 2428* 2428* 2436* 2436* 2436* 2436* 2436* 2442* 2442* 2442* 2442* 2442* 2971 offset 24 000442 internal static fixed bin(24,0) initial level 2 in structure "gen_item_t3" dcl 13-330 in procedure "cobol_ci_phase" set ref 2445* offset 24 000260 internal static fixed bin(24,0) initial level 2 in structure "gen_item_t1" dcl 13-186 in procedure "cobol_ci_phase" set ref 1033* 2431* offset 24 000404 internal static fixed bin(24,0) initial level 2 in structure "gen_item_t2" dcl 13-301 in procedure "cobol_ci_phase" set ref 2439* on 000102 internal static bit(1) initial packed unaligned dcl 11-14 set ref 48* 1030* 2428* 2436* 2442* orig_dimen 001504 automatic fixed bin(17,0) dcl 11-90 set ref 395* 397* 440 523 ose_exists 000130 automatic bit(1) packed unaligned dcl 11-16 set ref 267* 1024* 1107 1140 1323 ose_gen_begin_i 001453 automatic fixed bin(17,0) dcl 11-58 set ref 1117* 1130 1146* 1166 outfp 000126 automatic pointer dcl 11-13 set ref 46* 320* 327* 1930* 1958* 1978* 1992* 2004* 2092* 2203* 2251* output_ptr 000136 automatic pointer dcl 11-17 set ref 55* 318* 320* 320 325* 327* 327 1941* 1958* 1978* 1978 2004* 2004 2089* 2090 2092* 2246* 2248 2248 2251* 2251 2253 perform_bit 017066 automatic bit(1) packed unaligned dcl 2309 set ref 2315* 2402* 2844 2846* phase_name 15(27) based char(6) level 2 packed packed unaligned dcl 12-26 set ref 61* places 10 000316 internal static fixed bin(17,0) initial level 2 dcl 13-215 set ref 1892* 1894 1894 1897 1898 2586 2587 2614 2615 2649 2650 places_left 6 000316 internal static fixed bin(17,0) initial level 2 in structure "gen_num_lit_mindim" dcl 13-215 in procedure "cobol_ci_phase" set ref 1898* places_left 17 000442 internal static fixed bin(17,0) initial level 2 in structure "gen_item_t3" dcl 13-330 in procedure "cobol_ci_phase" set ref 2650* places_left 17 000404 internal static fixed bin(17,0) initial level 2 in structure "gen_item_t2" dcl 13-301 in procedure "cobol_ci_phase" set ref 2615* places_left 17 000260 internal static fixed bin(17,0) initial level 2 in structure "gen_item_t1" dcl 13-186 in procedure "cobol_ci_phase" set ref 1040* 2587* poss_prior_err 017024 automatic bit(1) packed unaligned dcl 11-152 set ref 59* 70* 82* 103* 112* 123* 127* 131* 135* 139* 143* 149* 158* 162* 166* 170* 177* 183* 234* 239* 241* 245* 1287* 1864* 1927 1960* proc_def based structure level 1 unaligned dcl 3134 proc_num 12 000500 internal static fixed bin(17,0) level 2 in structure "gen_label_def" dcl 13-359 in procedure "cobol_ci_phase" set ref 2456* 2553* 2553 2675* 2683* 2683 2847* 2847 proc_num 12 000520 internal static fixed bin(17,0) level 2 in structure "gen_label_ref" dcl 13-375 in procedure "cobol_ci_phase" set ref 2455* 2674* proc_num 12 based fixed bin(17,0) level 2 in structure "general_label" dcl 2868 in procedure "write_gen_label" set ref 2888* ptr1 000132 automatic pointer dcl 11-17 set ref 394* 395 438* 440 705 768 830 842 1432* 1433 1571* 1581 1890 2320* 2326 2405 2602 2637 2803 2810 ptr2 013332 automatic pointer dcl 11-109 set ref 1507* 1517 1536* 1547 1564* 1581 1582* 1820 1826 1833 1845 1854 1856* 1856 1858 1870 1872* 1872 2318 2320 2320 2365 2733 2899 ptr3 013334 automatic pointer dcl 11-109 set ref 2371* 2375 2378 2378 2388 2390* 2390 2465* 2475 2479 2482 2486 2491 2496 2498* 2498 2500 2503 2510 2512 2516 2520* 2523 2534 2536* 2536 2750* 2753 2758 2762 2766 2767 2770 2770 2774 2777 2780* 2780 ptr4 013336 automatic pointer dcl 11-109 set ref 2324* 2326 2331 rdf_illegal 000104 automatic bit(1) level 2 packed packed unaligned dcl 3107 set ref 417* 432 read_only 5 based bit(1) level 2 packed packed unaligned dcl 2931 set ref 2984 3082* record based char(4095) packed unaligned dcl 11-98 set ref 453* 453 1427* 1427 1517* 1517 1547* 1547 2219* 2219 record2 based char(4095) packed unaligned dcl 11-99 set ref 1581* 1581 recov 017003 automatic bit(1) packed unaligned dcl 11-149 set ref 249* 1288* 1962 1968* 1995* 2006* recovering 017026 automatic bit(1) packed unaligned dcl 11-163 set ref 268* 1976* 1984* 2054* 2193 recsize 000115 automatic fixed bin(17,0) dcl 2-32 set ref 453 453 459 459 466 466 1417 1417 1427 1427 1508 1508 1517 1517 1538 1538 1547 1547 1992* 2046* 2090* 2092* 2104* 2115* 2123* 2170* 2203* 2219 2219 recsize2 000116 automatic fixed bin(17,0) dcl 2-33 set ref 1417* 1419 1426 1508* 1509 1538* 1539 1570* 1572* 1572 1572 1573 1581 1581 2232* 2233* 2233 2233 2234 recursive_bit 017031 automatic bit(1) packed unaligned dcl 11-168 set ref 312* 909* 1177 recv_i 001451 automatic fixed bin(17,0) dcl 11-58 set ref 594* 1102 1315 relecture 017032 automatic bit(1) packed unaligned dcl 11-169 set ref 1361* remainder 000104 automatic fixed bin(17,0) dcl 2272 set ref 2287* 2288 req_sub 000106 automatic fixed bin(24,0) dcl 3110 set ref 1431* 1435* 1811 res_wd_add 000170 internal static structure level 1 unaligned dcl 13-88 set ref 2506 res_wd_after 000375 internal static structure level 1 unaligned dcl 13-289 set ref 2605 2640 res_wd_by 000350 internal static structure level 1 unaligned dcl 13-253 set ref 2592 2623 2658 res_wd_dot 000104 internal static structure level 1 unaligned dcl 13-6 set ref 1163 2554 2559 2682 2689 2822 2852 res_wd_error 000565 internal static structure level 1 unaligned dcl 13-429 set ref 1153 res_wd_from 000206 internal static structure level 1 unaligned dcl 13-112 set ref 2527 2590 2619 2654 res_wd_go 000366 internal static structure level 1 unaligned dcl 13-277 set ref 2676 res_wd_greater 000135 internal static structure level 1 unaligned dcl 13-47 set ref 1334 2596 2631 2666 res_wd_if 000540 internal static structure level 1 unaligned dcl 13-393 set ref 1331 res_wd_lparen 000224 internal static structure level 1 unaligned dcl 13-136 set ref 2370 2791 res_wd_move 000126 internal static structure level 1 unaligned dcl 13-35 set ref 1118 1155 2352 2690 res_wd_on 000547 internal static structure level 1 unaligned dcl 13-405 set ref 1149 res_wd_perform 000332 internal static structure level 1 unaligned dcl 13-229 set ref 2567 res_wd_rparen 000233 internal static structure level 1 unaligned dcl 13-148 set ref 2819 res_wd_set 000215 internal static structure level 1 unaligned dcl 13-124 set ref 2489 res_wd_size 000556 internal static structure level 1 unaligned dcl 13-417 set ref 1151 res_wd_spaces 000242 internal static structure level 1 unaligned dcl 13-161 set ref 2359 2698 res_wd_subtract 000177 internal static structure level 1 unaligned dcl 13-100 set ref 2526 res_wd_to 000117 internal static structure level 1 unaligned dcl 13-23 set ref 1122 1159 2364 2490 2677 2730 res_wd_until 000357 internal static structure level 1 unaligned dcl 13-265 set ref 2594 2627 2662 res_wd_varying 000341 internal static structure level 1 unaligned dcl 13-241 set ref 2572 res_wd_zeroes 000251 internal static structure level 1 unaligned dcl 13-173 set ref 2357 2696 reserved_word based structure level 1 unaligned dcl 3120 resnum parameter fixed bin(17,0) dcl 605 ref 602 613 rparen 0(01) 000104 automatic bit(1) level 2 packed packed unaligned dcl 3107 set ref 700* 703* 708 734 844* 846* run 4 000010 internal static fixed bin(17,0) initial level 2 dcl 1909 set ref 306* 310* s_of_rdf 21(11) based bit(1) level 2 packed packed unaligned dcl 3126 ref 417 432 1504 save_the_key 016771 automatic bit(1) packed unaligned dcl 11-129 set ref 2421* 2449* scale 017107 automatic fixed bin(17,0) dcl 2884 set ref 2888* 2889 2889 2889 2889 searched 10 based bit(1) level 2 in structure "index_name" packed packed unaligned dcl 3131 in procedure "cobol_ci_phase" set ref 798* 2479 2482* 2762 2766* searched 10 based bit(1) level 2 in structure "data_name" packed packed unaligned dcl 3126 in procedure "cobol_ci_phase" set ref 1180 1187* 1189 1196* 1312* 1439* 1470* 2077 second_occ_limit 000120 automatic fixed bin(24,0) dcl 2944 set ref 2969* 3045 second_time 017035 automatic bit(1) packed unaligned dcl 11-173 set ref 1359* 2397* 2408* 2412 2831* section_num 11 000520 internal static fixed bin(17,0) level 2 in structure "gen_label_ref" dcl 13-375 in procedure "cobol_ci_phase" set ref 1358* section_num 11 000500 internal static fixed bin(17,0) level 2 in structure "gen_label_def" dcl 13-359 in procedure "cobol_ci_phase" set ref 1357* section_num 11 based fixed bin(17,0) level 2 in structure "proc_def" dcl 3134 in procedure "cobol_ci_phase" ref 2134 section_number 000113 automatic fixed bin(17,0) dcl 3115 set ref 1357 1358 2134* seg_info 103 based char(5) level 2 packed packed unaligned dcl 12-26 set ref 2974 2978 2980* 3089 3089* seg_no 2 based fixed bin(7,0) level 2 dcl 2931 set ref 3049 3078* seg_num 23 000404 internal static fixed bin(17,0) initial level 2 in structure "gen_item_t2" dcl 13-301 in procedure "cobol_ci_phase" set ref 2438* seg_num 23 000442 internal static fixed bin(17,0) initial level 2 in structure "gen_item_t3" dcl 13-330 in procedure "cobol_ci_phase" set ref 2444* seg_num 23 000260 internal static fixed bin(17,0) initial level 2 in structure "gen_item_t1" dcl 13-186 in procedure "cobol_ci_phase" set ref 1032* 2430* seg_ptr 000100 automatic pointer dcl 2921 set ref 2980* 2984 2988 3049 3052 3053 3053 3055* 3063 3065* 3065 3067 3070* 3072 3078 3080 3081 3082 3084* seg_size 000111 automatic fixed bin(17,0) dcl 2938 set ref 2966* 3084* send_op_ptr 016754 automatic pointer dcl 11-118 set ref 1721* 1778* 2362 2703 2705 2708 sending_op 001500 automatic bit(1) packed unaligned dcl 11-85 set ref 271* 399 550 595* 1362* 1604* set_new_col 017025 automatic bit(1) packed unaligned dcl 11-156 set ref 1136* sign 4(09) based char(1) level 2 packed packed unaligned dcl 3123 ref 675 877 size 000404 internal static fixed bin(17,0) initial level 2 in structure "gen_item_t2" dcl 13-301 in procedure "cobol_ci_phase" set ref 2433 size 000010 internal static fixed bin(17,0) initial level 2 in structure "message" dcl 1909 in procedure "cobol_ci_phase" set ref 305* 1956* 1958* 1973* size 000442 internal static fixed bin(17,0) initial level 2 in structure "gen_item_t3" dcl 13-330 in procedure "cobol_ci_phase" set ref 2440 size based fixed bin(17,0) level 2 in structure "data_name" dcl 3126 in procedure "cobol_ci_phase" ref 2711 size 000260 internal static fixed bin(17,0) initial level 2 in structure "gen_item_t1" dcl 13-186 in procedure "cobol_ci_phase" set ref 1028 2426 size builtin function dcl 39 in procedure "cobol_ci_phase" ref 43 43 size 000316 internal static fixed bin(17,0) level 2 in structure "gen_num_lit_mindim" dcl 13-215 in procedure "cobol_ci_phase" set ref 1889* 1897* 1897 size 000113 internal static fixed bin(17,0) initial level 2 in structure "type_26_token" dcl 13-18 in procedure "cobol_ci_phase" set ref 1570 size based fixed bin(17,0) level 2 in structure "reserved_word" dcl 3120 in procedure "cobol_ci_phase" set ref 320* 327* 1854 1870 1930* 1978* 2004* 2090 2220 2232 2251* 2388 2496 2510 2518 2534 2777 spec_tag_counter 23 based fixed bin(17,0) level 2 dcl 12-26 set ref 2454* 2454 2455 2456 2672* 2672 2674 2675 stack 000170 automatic structure array level 1 unaligned dcl 11-47 stack_loc 000110 automatic fixed bin(24,0) dcl 3111 set ref 518 634* 635 status 000117 automatic bit(32) packed unaligned dcl 2-34 set ref 2980* 3055* 3065* 3084* stk_to_dir 000170 automatic fixed bin(17,0) array level 2 dcl 11-47 set ref 471* 484* 627 627 634 636* string_ctr 017104 automatic char(10) packed unaligned dcl 2883 set ref 2888* 2889 sub_level 017064 automatic fixed bin(17,0) dcl 2307 set ref 2331* 2337* 2345* 2576 2579 2794 2797 subscr_cnt 001501 automatic fixed bin(17,0) dcl 11-87 set ref 669* 681* 681 705 768 792* 792 830 842 1811 subscr_dir_index 013341 automatic fixed bin(17,0) dcl 11-111 set ref 659 782 782 1364* 1400 1406* 1406 1407 1408 1409 1433 1495* 1495 1599* 1741* 1772* 1772 1828* 1828 2324 2371 2465 2467 2540 2750 subscr_directory 013342 automatic structure array level 1 unaligned dcl 11-112 subscripted 22(05) based bit(1) level 2 packed packed unaligned dcl 3126 ref 392 436 1388 1457 1769 1826 2318 2708 substr builtin function dcl 3098 set ref 63* 453* 453 1068* 1068 1078* 1078 1093 1094 1097 1427* 1427 1517* 1517 1547* 1547 1581* 1581 1894* 1894 1948* 1948 1949* 2051 2106 2116 2125 2173 2219* 2219 2283* 2288* 2288 2889* 2889 subtract_swt 001477 automatic bit(1) packed unaligned dcl 11-83 set ref 574 2097* 2151* sufx_ptr 013342 automatic pointer array level 2 dcl 11-112 set ref 1409* 1433* 2324 table1 4000 based char(1) array level 2 packed packed unaligned dcl 11-29 set ref 53 401 1063 1311 table1_2_size 016760 automatic fixed bin(17,0) dcl 11-121 set ref 47* 1419 1511 1541 1575 table2 145520 based char(1) array level 2 packed packed unaligned dcl 11-29 set ref 406 1073 tbl based fixed bin(17,0) array level 3 in structure "dir_struct" dcl 11-29 in procedure "cobol_ci_phase" set ref 1063 1311 tbl 2000 based fixed bin(17,0) array level 3 in structure "dir_struct" dcl 11-29 in procedure "cobol_ci_phase" set ref 1073 1224 tbl based fixed bin(17,0) array level 2 in structure "curr_dir" dcl 11-39 in procedure "cobol_ci_phase" set ref 454* 509* tbl_item_ptr 000146 automatic pointer dcl 11-25 set ref 452* 453 tbl_item_ptr1 000150 automatic pointer dcl 11-26 set ref 1063* 1068 1068 1068 1084 1084 1091 1095 1101 1180 1187 1206 1311* 1312 tbl_item_ptr2 000152 automatic pointer dcl 11-26 set ref 1073* 1078 1078 1078 1084 1084 1102 1189 1196 1206 terminator 5(03) based bit(1) level 2 packed packed unaligned dcl 3120 ref 1965 1989 2179 token_stack 001515 automatic char(1) array level 2 packed packed unaligned dcl 11-103 set ref 2218 token_stack_ptr 013326 automatic pointer dcl 11-106 set ref 287 318 592 657 659 689 717 798 799 801 860 927 956 989 1721 1778 2218* 2219 2220 2232 token_stack_tbl 001515 automatic structure level 1 packed packed unaligned dcl 11-103 tokn_ptr 2 013342 automatic pointer array level 2 dcl 11-112 set ref 659* 1408* 2371 2465 2750 top_token_stack 013325 automatic fixed bin(17,0) dcl 11-105 set ref 270* 2218 2221* 2221 2234* 2234 trial 000105 automatic fixed bin(24,0) dcl 3110 set ref 1071* 1200* 1229 1231* type 3 based fixed bin(17,0) level 2 in structure "debug_token" dcl 2032 in procedure "corr_in" ref 2072 2137 2199 type 3 based fixed bin(17,0) level 2 in structure "numeric_lit" dcl 3123 in procedure "cobol_ci_phase" ref 671 871 1709 type 3 based fixed bin(17,0) level 2 in structure "data_name" dcl 3126 in procedure "cobol_ci_phase" ref 367 428 747 907 1305 1375 1454 1481 1557 1759 2075 2203 2705 type 3 based fixed bin(17,0) level 2 in structure "reserved_word" dcl 3120 in procedure "cobol_ci_phase" set ref 297 544 607 700 827 914 937 968 993 1448 1451 1483 1486 1592 1614 1649 1666 1687 1701 1747 1788 1798 1820 1858 1930 2112 2140 2179 2378 2500 2516* 2517* 2717 2753 2770 type 3 based fixed bin(17,0) level 2 in structure "message" dcl 2019 in procedure "corr_in" ref 2058 2183 2196 type 3 based fixed bin(17,0) level 2 in structure "index_name" dcl 3131 in procedure "cobol_ci_phase" ref 758 2475 2758 type 3 based fixed bin(17,0) level 2 in structure "proc_def" dcl 3134 in procedure "cobol_ci_phase" ref 2131 type_26_token 000113 internal static structure level 1 unaligned dcl 13-18 set ref 1571 usage_index 21(34) based bit(1) level 2 packed packed unaligned dcl 3126 ref 386 432 1381 1504 value_sent parameter fixed bin(17,0) dcl 2269 ref 2262 2276 without_on_bit 017027 automatic bit(1) packed unaligned dcl 11-165 set ref 60* 947* 979* 1007 1007* word_slack 000124 automatic fixed bin(7,0) dcl 2948 set ref 3008* 3011 3011 work31 000122 automatic fixed bin(24,0) dcl 2946 set ref 3020* 3023 3029* 3031 3034* 3040 3045 work_area 000102 automatic char(25) packed unaligned dcl 2938 set ref 3070 xst 017030 automatic fixed bin(17,0) dcl 11-166 set ref 948* 966* 988 989 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. bos internal static fixed bin(17,0) initial dcl 11-139 cobol_afp defined pointer dcl 1-11 cobol_analin_fileno defined pointer dcl 1-13 cobol_com_fileno defined pointer dcl 1-23 cobol_curr_in defined pointer dcl 1-53 cobol_curr_out defined pointer dcl 1-55 cobol_dfp defined pointer dcl 1-27 cobol_eltp defined pointer dcl 1-19 cobol_ext_$cobol_afp external static pointer dcl 1-10 cobol_ext_$cobol_analin_fileno external static pointer dcl 1-12 cobol_ext_$cobol_com_fileno external static pointer dcl 1-22 cobol_ext_$cobol_curr_in external static pointer dcl 1-52 cobol_ext_$cobol_curr_out external static pointer dcl 1-54 cobol_ext_$cobol_dfp external static pointer dcl 1-26 cobol_ext_$cobol_eltp external static pointer dcl 1-18 cobol_ext_$cobol_fileno1 external static fixed bin(24,0) dcl 1-78 cobol_ext_$cobol_hfp external static pointer dcl 1-28 cobol_ext_$cobol_lpr external static char(5) packed unaligned dcl 1-95 cobol_ext_$cobol_m1fp external static pointer dcl 1-30 cobol_ext_$cobol_m2fp external static pointer dcl 1-32 cobol_ext_$cobol_min1_fileno external static pointer dcl 1-34 cobol_ext_$cobol_min2_fileno_ptr external static pointer dcl 1-36 cobol_ext_$cobol_name_fileno external static pointer dcl 1-38 cobol_ext_$cobol_name_fileno_ptr external static pointer dcl 1-40 cobol_ext_$cobol_ntfp external static pointer dcl 1-42 cobol_ext_$cobol_options external static char(120) packed unaligned dcl 1-97 cobol_ext_$cobol_options_len external static fixed bin(24,0) dcl 1-80 cobol_ext_$cobol_pdofp external static pointer dcl 1-44 cobol_ext_$cobol_pdout_fileno external static fixed bin(24,0) dcl 1-82 cobol_ext_$cobol_pfp external static pointer dcl 1-46 cobol_ext_$cobol_print_fileno external static fixed bin(24,0) dcl 1-84 cobol_ext_$cobol_rm2fp external static pointer dcl 1-48 cobol_ext_$cobol_rmin2_fileno external static fixed bin(24,0) dcl 1-86 cobol_ext_$cobol_rwdd external static pointer dcl 1-72 cobol_ext_$cobol_rwpd external static pointer dcl 1-74 cobol_ext_$cobol_sfp external static pointer dcl 1-56 cobol_ext_$cobol_w1p external static pointer dcl 1-58 cobol_ext_$cobol_w2p external static pointer dcl 1-60 cobol_ext_$cobol_w3p external static pointer dcl 1-62 cobol_ext_$cobol_w5p external static pointer dcl 1-64 cobol_ext_$cobol_w6p external static pointer dcl 1-66 cobol_ext_$cobol_w7p external static pointer dcl 1-68 cobol_ext_$cobol_x1_fileno external static fixed bin(24,0) dcl 1-88 cobol_ext_$cobol_x2_fileno external static fixed bin(24,0) dcl 1-90 cobol_ext_$cobol_x3_fileno external static fixed bin(24,0) dcl 1-92 cobol_ext_$cobol_xlast8 external static bit(1) packed unaligned dcl 1-100 cobol_ext_$report_exists external static bit(1) packed unaligned dcl 1-102 cobol_ext_$report_first_token external static pointer dcl 1-14 cobol_ext_$report_last_token external static pointer dcl 1-16 cobol_fileno1 defined fixed bin(24,0) dcl 1-79 cobol_hfp defined pointer dcl 1-29 cobol_lpr defined char(5) packed unaligned dcl 1-96 cobol_m1fp defined pointer dcl 1-31 cobol_m2fp defined pointer dcl 1-33 cobol_min1_fileno defined pointer dcl 1-35 cobol_min2_fileno_ptr defined pointer dcl 1-37 cobol_name_fileno defined pointer dcl 1-39 cobol_name_fileno_ptr defined pointer dcl 1-41 cobol_ntfp defined pointer dcl 1-43 cobol_options defined char(120) packed unaligned dcl 1-98 cobol_options_len defined fixed bin(24,0) dcl 1-81 cobol_pdofp defined pointer dcl 1-45 cobol_pdout_fileno defined fixed bin(24,0) dcl 1-83 cobol_pfp defined pointer dcl 1-47 cobol_print_fileno defined fixed bin(24,0) dcl 1-85 cobol_rm2fp defined pointer dcl 1-49 cobol_rmin2_fileno defined fixed bin(24,0) dcl 1-87 cobol_rwdd defined pointer dcl 1-73 cobol_rwpd defined pointer dcl 1-75 cobol_sfp defined pointer dcl 1-57 cobol_swf_close 000000 constant entry external dcl 2-13 cobol_swf_open 000000 constant entry external dcl 2-7 cobol_vdwf_close 000000 constant entry external dcl 2-23 cobol_vdwf_open 000000 constant entry external dcl 2-6 cobol_vdwf_sget 000000 constant entry external dcl 2-15 cobol_vdwf_sput 000000 constant entry external dcl 2-17 cobol_w1p defined pointer dcl 1-59 cobol_w2p defined pointer dcl 1-61 cobol_w3p defined pointer dcl 1-63 cobol_w5p defined pointer dcl 1-65 cobol_w6p defined pointer dcl 1-67 cobol_w7p defined pointer dcl 1-69 cobol_x1_fileno defined fixed bin(24,0) dcl 1-89 cobol_x2_fileno defined fixed bin(24,0) dcl 1-91 cobol_x3_fileno defined fixed bin(24,0) dcl 1-93 cobol_xlast8 defined bit(1) packed unaligned dcl 1-101 common_eof automatic bit(1) packed unaligned dcl 2951 curr_input automatic pointer dcl 2-30 curr_output automatic pointer dcl 2-31 eos internal static fixed bin(17,0) initial dcl 11-139 err_image_length automatic fixed bin(17,0) dcl 11-153 ft_ptr automatic pointer dcl 2920 key1 automatic char(5) packed unaligned dcl 2-29 key_tbl internal static structure array level 1 unaligned dcl 11-67 keyno automatic char(5) packed unaligned dcl 2-28 no_of_subscr automatic fixed bin(17,0) dcl 11-86 nt_key automatic char(5) packed unaligned dcl 11-130 nxt internal static fixed bin(17,0) initial dcl 11-139 prev_seg_ptr automatic pointer dcl 2922 report_exists defined bit(1) packed unaligned dcl 1-103 report_first_token defined pointer dcl 1-15 report_last_token defined pointer dcl 1-17 save_key automatic char(5) packed unaligned dcl 11-131 st_ptr automatic pointer dcl 2-42 status_word based structure level 1 packed packed unaligned dcl 2-38 NAMES DECLARED BY EXPLICIT CONTEXT. add_subscript 001635 constant label dcl 683 ref 882 add_token 005531 constant entry internal dcl 2213 ref 285 589 652 683 712 794 857 924 953 986 1718 1776 after_initialization 002545 constant label dcl 1063 ref 1213 1244 1278 allocate_item 007451 constant entry internal dcl 2912 ref 1030 2428 2436 2442 allocate_t2 006174 constant label dcl 2433 ref 2423 begin_subscripts 001551 constant entry internal dcl 646 ref 530 1530 bin_to_char 005657 constant entry internal dcl 2262 ref 1092 1096 1891 2888 boundary_ok 007613 constant label dcl 3020 ref 2990 2993 3006 3014 check_for_further 002203 constant entry internal dcl 886 ref 552 check_main_initlz_traits 003460 constant label dcl 1381 ref 1561 check_next_segment 007705 constant label dcl 3059 ref 2984 3023 3031 3040 3045 check_this_segment 007530 constant label dcl 2984 ref 3067 cobol_ci_phase 000213 constant entry external dcl 30 commence_search 002527 constant entry internal dcl 1049 ref 895 903 916 933 939 962 970 981 995 1002 1043 corr_in 005101 constant entry internal dcl 2011 ref 275 291 330 357 419 535 566 661 692 721 816 863 899 929 958 991 1016 1300 1367 1441 1472 1549 1584 1606 1641 1658 1679 1693 1723 1733 1780 1982 corres_option 000741 constant entry internal dcl 345 ref 313 1316 emit 003262 constant entry internal dcl 1294 ref 1055 1260 end_send_op_gen 007133 constant label dcl 2724 ref 2719 err 000000 constant label array(43) dcl 70 set ref 68 err_end 000530 constant label dcl 249 ref 72 76 80 84 86 89 92 95 98 104 106 109 114 116 125 129 133 137 141 145 150 152 155 160 164 168 172 178 184 189 194 199 204 209 214 219 224 229 235 240 244 248 err_pro 004617 constant entry internal dcl 1925 ref 119 251 1290 1866 error1 003246 constant entry internal dcl 1283 ref 1054 1257 find_bos 000300 constant label dcl 65 ref 341 find_new_match 003142 constant label dcl 1217 ref 1202 1206 first_occ_check 007634 constant label dcl 3034 ref 3026 gen_assign 005734 constant entry internal dcl 2301 ref 1840 1846 gen_initlz_code 004437 constant label dcl 1811 ref 1600 1743 gen_level2 007270 constant label dcl 2806 ref 2797 gen_level3 007302 constant label dcl 2813 set ref 2794 gen_lpar 007244 constant label dcl 2789 gen_move_label 007013 constant label dcl 2672 ref 2602 2637 gen_rest 006407 constant label dcl 2508 ref 2528 gen_rparen 007310 constant label dcl 2817 ref 2803 2810 genlabel 007340 constant entry internal dcl 2841 ref 2826 get 000053 constant label array(0:2) dcl 2046 ref 2044 2066 2190 2201 2207 get1 003657 constant label dcl 1491 ref 1459 get_next_group_member 001100 constant label dcl 419 ref 432 440 498 560 get_nxt_initlz_member 003634 constant label dcl 1472 ref 1486 1499 1521 get_nxt_subscript 007227 constant label dcl 2777 ref 2753 got_end_initlz_opnd 003741 constant label dcl 1536 ref 1466 1488 incr_to_half_word 007607 constant label dcl 3016 ref 2996 incr_to_word 007576 constant label dcl 3008 ref 2999 initialize_statement 003400 constant entry internal dcl 1346 ref 281 level2_gen 006622 constant label dcl 2608 ref 2579 level3_gen 006723 constant label dcl 2643 ref 2576 match_cat 007414 constant entry internal dcl 2895 ref 1840 more 000746 constant label dcl 350 ref 598 more_code 004446 constant label dcl 1820 ref 1874 new_segment_needed 007742 constant label dcl 3070 ref 2974 nxt_send_op_subscr 007103 constant label dcl 2711 ref 2722 passover 005460 constant label dcl 2183 ref 2168 perform_reqd 006102 constant label dcl 2402 ref 2332 2346 pick_up_subscr 001617 constant label dcl 671 ref 739 835 remove_token 005565 constant entry internal dcl 2226 ref 323 1009 1012 res_test 001461 constant entry internal dcl 602 ref 526 576 582 second_half_initlz 004012 constant label dcl 1564 second_occ_check 007650 constant label dcl 3045 ref 3037 set_links 001503 constant entry internal dcl 622 ref 490 512 set_main_indices 006327 constant label dcl 2475 ref 2537 2543 set_name2 002566 constant label dcl 1073 ref 1224 1233 setup_gen_lit 004557 constant entry internal dcl 1884 ref 2584 2611 2646 several_time 007142 constant label dcl 2733 ref 2415 stk_subscr_tokns 006032 constant label dcl 2373 ref 2392 store_send_op 004300 constant label dcl 1718 ref 1756 1769 stream_gen 005605 constant entry internal dcl 2239 ref 1126 1138 1170 1337 2382 2396 2494 2514 2562 2600 2635 2670 2737 2824 2855 sub_ref 003724 constant label dcl 1523 ref 1448 1483 sub_ref_1 003732 constant label dcl 1530 ref 1788 test_extra_subscr 007242 constant label dcl 2786 ref 2770 test_item_elementary 004465 constant label dcl 1833 ref 1878 test_rparen 001706 constant label dcl 708 ref 847 test_subscr_cnt 001665 constant label dcl 700 ref 824 test_subscr_type 007163 constant label dcl 2753 ref 2782 test_token_get1 005357 constant label dcl 2131 ref 2101 this_seg_ok 007653 constant label dcl 3049 ref 3043 3059 3094 tst_alph_cat 004341 constant label dcl 1750 ref 1704 1803 tst_num_cat 004270 constant label dcl 1712 ref 1801 write_gen_label 007364 constant entry internal dcl 2863 ref 2460 2557 2570 2680 2687 2850 write_tok 005505 constant label dcl 2203 ref 2061 2072 2137 2193 2196 2199 NAME DECLARED BY CONTEXT OR IMPLICATION. null builtin function ref 54 55 1408 1409 2101 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 10334 11154 10107 10344 Length 11742 10107 620 552 225 564 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_ci_phase 7828 external procedure is an external procedure. corres_option 158 internal procedure calls itself recursively. res_test internal procedure shares stack frame of internal procedure corres_option. set_links internal procedure shares stack frame of internal procedure corres_option. begin_subscripts 64 internal procedure is called by several nonquick procedures. check_for_further internal procedure shares stack frame of internal procedure corres_option. commence_search internal procedure shares stack frame of internal procedure corres_option. error1 internal procedure shares stack frame of internal procedure corres_option. emit internal procedure shares stack frame of internal procedure corres_option. initialize_statement internal procedure shares stack frame of external procedure cobol_ci_phase. setup_gen_lit internal procedure shares stack frame of external procedure cobol_ci_phase. err_pro 74 internal procedure is called by several nonquick procedures. corr_in 76 internal procedure is called by several nonquick procedures. add_token 65 internal procedure is called by several nonquick procedures. remove_token 64 internal procedure is called by several nonquick procedures. stream_gen 76 internal procedure is called by several nonquick procedures. bin_to_char 69 internal procedure is called by several nonquick procedures. gen_assign internal procedure shares stack frame of external procedure cobol_ci_phase. genlabel internal procedure shares stack frame of external procedure cobol_ci_phase. write_gen_label internal procedure shares stack frame of external procedure cobol_ci_phase. match_cat internal procedure shares stack frame of external procedure cobol_ci_phase. allocate_item 98 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 message cobol_ci_phase 000102 on cobol_ci_phase 000103 off cobol_ci_phase 000104 res_wd_dot cobol_ci_phase 000113 type_26_token cobol_ci_phase 000117 res_wd_to cobol_ci_phase 000126 res_wd_move cobol_ci_phase 000135 res_wd_greater cobol_ci_phase 000144 num_lit_zero cobol_ci_phase 000156 num_lit_one cobol_ci_phase 000170 res_wd_add cobol_ci_phase 000177 res_wd_subtract cobol_ci_phase 000206 res_wd_from cobol_ci_phase 000215 res_wd_set cobol_ci_phase 000224 res_wd_lparen cobol_ci_phase 000233 res_wd_rparen cobol_ci_phase 000242 res_wd_spaces cobol_ci_phase 000251 res_wd_zeroes cobol_ci_phase 000260 gen_item_t1 cobol_ci_phase 000316 gen_num_lit_mindim cobol_ci_phase 000332 res_wd_perform cobol_ci_phase 000341 res_wd_varying cobol_ci_phase 000350 res_wd_by cobol_ci_phase 000357 res_wd_until cobol_ci_phase 000366 res_wd_go cobol_ci_phase 000375 res_wd_after cobol_ci_phase 000404 gen_item_t2 cobol_ci_phase 000442 gen_item_t3 cobol_ci_phase 000500 gen_label_def cobol_ci_phase 000520 gen_label_ref cobol_ci_phase 000540 res_wd_if cobol_ci_phase 000547 res_wd_on cobol_ci_phase 000556 res_wd_size cobol_ci_phase 000565 res_wd_error cobol_ci_phase STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME allocate_item 000100 seg_ptr allocate_item 000102 work_area allocate_item 000111 seg_size allocate_item 000112 common_recsize allocate_item 000114 common_key allocate_item 000116 elem_offset_limit allocate_item 000117 occ_offset_limit allocate_item 000120 second_occ_limit allocate_item 000121 next_loc_used allocate_item 000122 work31 allocate_item 000123 double_word_slack allocate_item 000124 word_slack allocate_item 000125 half_word_slack allocate_item bin_to_char 000100 bin_val bin_to_char 000101 cv_string bin_to_char 000104 remainder bin_to_char cobol_ci_phase 000100 descr_ptr cobol_ci_phase 000102 inf_ptr cobol_ci_phase 000104 indicators cobol_ci_phase 000105 trial cobol_ci_phase 000106 req_sub cobol_ci_phase 000107 dir_num cobol_ci_phase 000110 stack_loc cobol_ci_phase 000111 link1 cobol_ci_phase 000112 link2 cobol_ci_phase 000113 section_number cobol_ci_phase 000114 check_res cobol_ci_phase 000115 recsize cobol_ci_phase 000116 recsize2 cobol_ci_phase 000117 status cobol_ci_phase 000120 new_seg_bit cobol_ci_phase 000121 nu_line cobol_ci_phase 000122 fst cobol_ci_phase 000124 infp cobol_ci_phase 000126 outfp cobol_ci_phase 000130 ose_exists cobol_ci_phase 000132 ptr1 cobol_ci_phase 000134 input_ptr cobol_ci_phase 000136 output_ptr cobol_ci_phase 000140 next_free_column cobol_ci_phase 000141 eof cobol_ci_phase 000142 curr_tbl_ptr cobol_ci_phase 000144 curr_tbl_index cobol_ci_phase 000146 tbl_item_ptr cobol_ci_phase 000150 tbl_item_ptr1 cobol_ci_phase 000152 tbl_item_ptr2 cobol_ci_phase 000154 dir_ptr cobol_ci_phase 000156 curr_dir_ptr cobol_ci_phase 000160 curr_dir_index cobol_ci_phase 000161 end_dir1_index cobol_ci_phase 000162 loc1 cobol_ci_phase 000163 loc2 cobol_ci_phase 000164 dir_ptr1 cobol_ci_phase 000166 dir_ptr2 cobol_ci_phase 000170 stack cobol_ci_phase 000334 curr_stk_index cobol_ci_phase 000336 gen_ptr cobol_ci_phase 000432 lc_stack cobol_ci_phase 001447 i cobol_ci_phase 001450 end_i cobol_ci_phase 001451 recv_i cobol_ci_phase 001452 begin_i cobol_ci_phase 001453 ose_gen_begin_i cobol_ci_phase 001454 name1 cobol_ci_phase 001464 name2 cobol_ci_phase 001474 curr_level cobol_ci_phase 001475 move_swt cobol_ci_phase 001476 add_swt cobol_ci_phase 001477 subtract_swt cobol_ci_phase 001500 sending_op cobol_ci_phase 001501 subscr_cnt cobol_ci_phase 001502 dataname_subscr_sw cobol_ci_phase 001503 indexname_subscr_sw cobol_ci_phase 001504 orig_dimen cobol_ci_phase 001505 cvbd_1 cobol_ci_phase 001506 cvindex cobol_ci_phase 001507 cv_string cobol_ci_phase 001512 fixbin15 cobol_ci_phase 001513 fixbin24 cobol_ci_phase 001514 null_match cobol_ci_phase 001515 token_stack_tbl cobol_ci_phase 013325 top_token_stack cobol_ci_phase 013326 token_stack_ptr cobol_ci_phase 013330 n cobol_ci_phase 013331 first_pair cobol_ci_phase 013332 ptr2 cobol_ci_phase 013334 ptr3 cobol_ci_phase 013336 ptr4 cobol_ci_phase 013340 main_item_subscripted cobol_ci_phase 013341 subscr_dir_index cobol_ci_phase 013342 subscr_directory cobol_ci_phase 016752 defaults cobol_ci_phase 016753 category cobol_ci_phase 016754 send_op_ptr cobol_ci_phase 016756 initlz_tbl_ptr cobol_ci_phase 016760 table1_2_size cobol_ci_phase 016761 end_initlz_tbl_index cobol_ci_phase 016762 main_item_index cobol_ci_phase 016764 main_item_ptr cobol_ci_phase 016766 curr_dim cobol_ci_phase 016767 initlz_swt cobol_ci_phase 016770 initlz_items_allocated cobol_ci_phase 016771 save_the_key cobol_ci_phase 016772 gen_item_allocated cobol_ci_phase 016773 alloc_seg cobol_ci_phase 016774 alloc_offset cobol_ci_phase 016775 code cobol_ci_phase 016776 lk_ahd_ptr cobol_ci_phase 017002 lk_ahd_index cobol_ci_phase 017003 recov cobol_ci_phase 017004 err_num cobol_ci_phase 017005 err_image cobol_ci_phase 017024 poss_prior_err cobol_ci_phase 017025 set_new_col cobol_ci_phase 017026 recovering cobol_ci_phase 017027 without_on_bit cobol_ci_phase 017030 xst cobol_ci_phase 017031 recursive_bit cobol_ci_phase 017032 relecture cobol_ci_phase 017033 array_init_bit cobol_ci_phase 017034 n_array cobol_ci_phase 017035 second_time cobol_ci_phase 017036 fixbin_diff cobol_ci_phase 017054 fixbin15 setup_gen_lit 017064 sub_level gen_assign 017065 ind_level gen_assign 017066 perform_bit gen_assign 017104 string_ctr write_gen_label 017107 scale write_gen_label corr_in 000100 first_time_in_get_1 corr_in corres_option 000130 ln commence_search THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out call_int_this call_int_other return_mac mdfx1 ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cobol$alloc cobol_c_list cobol_swf_get cobol_swf_put cobol_vdwf_dget cobol_vdwf_dput THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cobol_ext_$cobol_cmfp cobol_ext_$cobol_com_ptr cobol_ext_$cobol_rmin2fp cobol_ext_$cobol_x3fp LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 30 000212 43 000220 45 000232 46 000236 47 000241 48 000243 49 000245 50 000246 51 000247 52 000251 53 000254 54 000257 55 000261 56 000262 57 000263 58 000264 59 000265 60 000267 61 000270 62 000275 63 000276 65 000300 68 000302 70 000303 72 000304 74 000305 76 000310 78 000311 80 000314 82 000315 84 000316 86 000317 89 000320 92 000321 95 000322 98 000323 101 000324 103 000327 104 000330 106 000331 109 000332 112 000333 114 000334 116 000335 119 000336 121 000342 123 000343 125 000344 127 000345 129 000346 131 000347 133 000350 135 000351 137 000352 139 000353 141 000354 143 000355 145 000356 147 000357 149 000362 150 000363 152 000364 155 000365 158 000366 160 000367 162 000370 164 000371 166 000372 168 000373 170 000374 172 000375 174 000376 176 000401 177 000403 178 000404 180 000405 182 000410 183 000412 184 000413 186 000414 188 000417 189 000421 191 000422 193 000425 194 000427 196 000430 198 000433 199 000435 201 000436 203 000441 204 000443 206 000444 208 000447 209 000451 211 000452 213 000455 214 000457 216 000460 218 000463 219 000465 221 000466 223 000471 224 000473 226 000474 228 000477 229 000501 231 000502 233 000505 234 000507 235 000510 236 000511 238 000514 239 000516 240 000517 241 000520 243 000521 244 000523 245 000524 247 000525 248 000527 249 000530 251 000532 253 000536 256 000540 258 000541 262 000542 263 000544 265 000545 266 000546 267 000547 268 000550 269 000551 270 000552 271 000553 272 000555 273 000556 275 000560 278 000564 281 000566 285 000572 287 000576 288 000600 289 000602 291 000603 294 000607 297 000611 300 000620 302 000631 303 000633 304 000635 305 000637 306 000641 308 000643 310 000653 312 000656 313 000657 314 000666 318 000667 320 000671 323 000706 325 000712 327 000714 330 000731 332 000735 341 000737 345 000740 350 000746 354 000751 355 000755 357 000757 359 000764 361 000767 362 000771 367 000772 370 000777 371 001001 374 001002 376 001005 377 001007 380 001010 382 001015 383 001017 386 001020 388 001023 389 001025 392 001026 394 001031 395 001036 396 001040 397 001041 399 001042 401 001044 402 001047 403 001051 404 001052 406 001053 407 001057 408 001062 411 001064 413 001065 414 001066 415 001070 417 001071 419 001100 422 001105 424 001110 425 001112 428 001113 432 001117 436 001143 438 001146 440 001153 444 001156 446 001161 447 001163 450 001164 452 001165 453 001173 454 001177 455 001205 456 001206 459 001210 462 001222 463 001224 466 001225 468 001230 470 001233 471 001235 473 001237 475 001240 478 001246 480 001251 481 001253 483 001254 484 001255 485 001262 487 001264 490 001265 492 001266 498 001271 504 001272 506 001275 507 001277 509 001300 510 001304 512 001305 514 001306 518 001311 523 001317 526 001321 527 001327 530 001332 532 001337 535 001342 537 001347 539 001352 540 001354 544 001355 546 001361 547 001363 550 001364 552 001366 554 001367 557 001372 560 001374 564 001375 566 001377 568 001404 570 001407 571 001411 574 001412 576 001414 577 001422 579 001425 582 001426 583 001434 589 001437 591 001444 592 001446 593 001452 594 001453 595 001455 596 001456 598 001460 602 001461 607 001463 609 001470 610 001472 613 001473 615 001476 616 001500 619 001501 620 001502 622 001503 625 001504 627 001514 628 001522 630 001524 632 001525 634 001526 635 001530 636 001535 637 001536 638 001540 640 001541 641 001543 642 001546 644 001547 646 001550 649 001556 650 001560 652 001561 654 001566 656 001571 657 001572 658 001576 659 001577 661 001603 663 001610 665 001613 666 001615 669 001616 671 001617 675 001624 677 001631 678 001633 681 001634 683 001635 686 001642 688 001645 689 001646 692 001652 694 001657 696 001662 697 001664 700 001665 703 001700 705 001702 708 001706 712 001712 714 001717 716 001722 717 001723 718 001727 721 001730 723 001735 726 001742 729 001743 730 001745 734 001746 736 001751 737 001753 739 001754 747 001755 750 001760 752 001762 753 001764 755 001765 756 001767 758 001770 761 001773 764 001777 765 002001 768 002002 770 002010 771 002012 774 002013 776 002015 777 002017 780 002020 782 002022 785 002027 788 002030 789 002032 792 002033 794 002034 796 002041 798 002044 799 002047 800 002051 801 002052 816 002055 818 002062 820 002065 821 002067 824 002070 827 002072 830 002076 832 002102 833 002104 835 002105 838 002106 842 002113 844 002117 846 002125 847 002127 850 002130 851 002132 854 002133 857 002135 859 002142 860 002144 863 002150 865 002155 867 002160 868 002162 871 002163 873 002167 874 002171 877 002172 879 002177 880 002201 882 002202 886 002203 889 002204 893 002206 895 002210 896 002211 899 002212 901 002217 903 002222 904 002223 907 002224 909 002230 910 002232 911 002234 914 002235 916 002240 917 002241 921 002242 924 002245 926 002252 927 002254 929 002260 931 002265 933 002270 934 002271 937 002272 939 002276 940 002277 945 002300 947 002303 948 002305 949 002307 953 002310 955 002315 956 002320 958 002322 960 002327 962 002332 963 002333 966 002334 968 002336 970 002342 971 002343 976 002344 979 002347 981 002350 982 002351 986 002352 988 002357 989 002362 991 002365 993 002372 995 002401 996 002402 1000 002403 1002 002406 1003 002407 1007 002410 1009 002414 1012 002421 1014 002426 1016 002430 1018 002435 1020 002440 1021 002442 1024 002443 1026 002445 1028 002451 1030 002454 1032 002506 1033 002512 1034 002514 1037 002516 1039 002520 1040 002523 1043 002525 1045 002526 1049 002527 1052 002530 1054 002535 1055 002536 1056 002537 1059 002540 1060 002542 1061 002543 1063 002545 1066 002556 1068 002561 1071 002565 1073 002566 1076 002577 1078 002602 1081 002606 1084 002612 1089 002636 1091 002640 1092 002642 1093 002655 1094 002661 1095 002666 1096 002671 1097 002704 1098 002710 1101 002715 1102 002717 1107 002723 1110 002725 1115 002727 1116 002730 1117 002732 1118 002733 1119 002737 1120 002740 1121 002744 1122 002745 1123 002751 1124 002752 1126 002756 1130 002763 1131 002767 1136 002771 1138 002773 1140 003000 1143 003003 1145 003005 1146 003010 1147 003011 1149 003012 1150 003016 1151 003017 1152 003023 1153 003024 1154 003030 1155 003031 1156 003035 1157 003036 1158 003042 1159 003043 1160 003047 1161 003050 1162 003054 1163 003055 1164 003061 1166 003062 1167 003064 1170 003066 1172 003073 1175 003077 1177 003100 1180 003102 1182 003106 1183 003110 1184 003113 1187 003114 1189 003116 1191 003122 1192 003124 1193 003127 1196 003130 1200 003132 1202 003134 1206 003135 1210 003137 1211 003140 1213 003141 1217 003142 1220 003147 1222 003151 1224 003152 1226 003156 1229 003160 1231 003162 1232 003164 1233 003167 1236 003170 1237 003174 1240 003176 1242 003177 1243 003201 1244 003204 1246 003205 1248 003212 1250 003214 1251 003215 1254 003221 1257 003222 1260 003225 1262 003226 1265 003227 1267 003230 1269 003231 1271 003236 1272 003237 1274 003243 1276 003244 1278 003245 1283 003246 1286 003247 1287 003252 1288 003253 1290 003254 1292 003261 1294 003262 1297 003263 1300 003266 1302 003273 1305 003277 1307 003303 1308 003305 1310 003306 1311 003316 1312 003325 1313 003327 1315 003331 1316 003333 1319 003344 1323 003345 1328 003353 1329 003355 1331 003357 1332 003362 1333 003364 1334 003366 1335 003370 1337 003372 1342 003377 1346 003400 1349 003401 1351 003402 1352 003405 1353 003407 1354 003412 1355 003413 1356 003420 1357 003425 1358 003427 1359 003430 1360 003431 1361 003432 1362 003433 1363 003434 1364 003436 1365 003437 1367 003440 1369 003444 1371 003446 1372 003450 1375 003451 1377 003455 1378 003457 1381 003460 1384 003464 1385 003466 1388 003467 1390 003472 1392 003474 1394 003477 1395 003501 1400 003502 1402 003505 1403 003507 1406 003510 1407 003511 1408 003514 1409 003517 1410 003520 1412 003521 1416 003522 1417 003530 1419 003535 1421 003540 1422 003542 1425 003543 1426 003545 1427 003547 1429 003554 1431 003556 1432 003560 1433 003565 1434 003570 1435 003571 1437 003572 1439 003575 1441 003577 1443 003603 1445 003605 1446 003607 1448 003610 1451 003614 1454 003616 1457 003621 1459 003625 1463 003626 1464 003630 1466 003631 1470 003632 1472 003634 1475 003640 1477 003642 1478 003644 1481 003645 1483 003651 1486 003654 1488 003656 1491 003657 1495 003662 1498 003666 1499 003670 1504 003671 1507 003674 1508 003702 1509 003707 1511 003710 1513 003713 1514 003715 1517 003716 1521 003723 1523 003724 1526 003727 1527 003731 1530 003732 1533 003736 1536 003741 1538 003747 1539 003754 1541 003755 1543 003760 1544 003762 1547 003763 1549 003771 1551 003775 1553 003777 1554 004001 1557 004002 1559 004006 1560 004007 1561 004011 1564 004012 1570 004020 1571 004023 1572 004025 1573 004031 1575 004033 1577 004036 1578 004040 1581 004041 1582 004046 1584 004050 1586 004054 1588 004056 1589 004060 1592 004061 1595 004070 1599 004072 1600 004073 1603 004074 1604 004075 1606 004077 1608 004103 1610 004105 1611 004107 1614 004110 1616 004114 1617 004116 1620 004117 1623 004125 1626 004132 1629 004137 1632 004144 1636 004151 1637 004153 1641 004154 1643 004160 1645 004162 1646 004164 1649 004165 1651 004171 1652 004173 1655 004174 1658 004177 1660 004203 1662 004205 1663 004207 1666 004210 1668 004214 1669 004216 1673 004217 1675 004222 1676 004224 1679 004225 1681 004231 1683 004233 1684 004235 1687 004236 1690 004242 1693 004245 1695 004251 1697 004253 1698 004255 1701 004256 1703 004262 1704 004264 1709 004265 1712 004270 1715 004275 1716 004277 1718 004300 1721 004304 1723 004306 1725 004312 1727 004314 1728 004316 1731 004317 1733 004323 1734 004327 1736 004331 1737 004333 1741 004334 1743 004335 1747 004336 1750 004341 1753 004346 1754 004350 1756 004351 1759 004352 1761 004355 1763 004357 1765 004364 1766 004366 1769 004367 1772 004372 1776 004373 1778 004377 1780 004401 1782 004405 1784 004407 1785 004411 1788 004412 1793 004421 1794 004423 1798 004424 1801 004427 1803 004432 1807 004434 1809 004436 1811 004437 1814 004442 1815 004444 1818 004445 1820 004446 1824 004453 1826 004455 1828 004460 1829 004461 1830 004463 1831 004464 1833 004465 1837 004471 1840 004473 1843 004501 1845 004502 1846 004504 1848 004513 1854 004515 1855 004517 1856 004523 1858 004527 1861 004532 1863 004534 1864 004536 1866 004537 1870 004543 1871 004545 1872 004551 1874 004555 1878 004556 1884 004557 1889 004560 1890 004563 1891 004570 1892 004602 1894 004606 1897 004612 1898 004613 1900 004615 1925 004616 1927 004624 1930 004631 1935 004651 1936 004655 1938 004666 1941 004671 1943 004673 1945 004675 1946 004677 1948 004700 1949 004703 1950 004705 1953 004707 1954 004711 1955 004714 1956 004716 1958 004721 1960 004735 1962 004740 1965 004742 1968 004753 1969 004754 1972 004755 1973 004760 1974 004762 1975 004764 1976 004766 1978 004770 1980 005004 1982 005007 1984 005014 1986 005016 1989 005020 1992 005030 1994 005045 1995 005050 1996 005051 2000 005052 2001 005055 2002 005057 2004 005061 2006 005075 2007 005077 2011 005100 2042 005106 2044 005110 2046 005113 2051 005131 2053 005137 2054 005141 2055 005142 2058 005143 2061 005147 2064 005151 2066 005154 2072 005155 2075 005160 2077 005163 2078 005165 2081 005170 2083 005171 2087 005173 2089 005206 2090 005211 2092 005213 2094 005230 2096 005233 2097 005234 2098 005235 2099 005236 2100 005237 2101 005240 2104 005244 2106 005261 2108 005267 2109 005271 2112 005272 2115 005301 2116 005316 2118 005324 2119 005326 2122 005327 2123 005330 2125 005346 2127 005354 2128 005356 2131 005357 2134 005363 2137 005365 2140 005370 2143 005373 2145 005376 2146 005400 2149 005401 2151 005403 2152 005405 2155 005406 2157 005410 2158 005412 2161 005413 2163 005415 2164 005417 2168 005420 2170 005421 2173 005437 2176 005447 2179 005451 2183 005460 2188 005467 2190 005472 2193 005473 2196 005475 2199 005500 2201 005503 2203 005505 2207 005525 2213 005530 2218 005536 2219 005544 2220 005551 2221 005553 2222 005563 2226 005564 2232 005572 2233 005575 2234 005601 2235 005603 2239 005604 2244 005612 2246 005624 2248 005627 2251 005633 2253 005650 2254 005653 2256 005655 2262 005656 2276 005664 2277 005667 2278 005675 2281 005677 2283 005701 2284 005703 2285 005705 2286 005706 2287 005710 2288 005713 2289 005720 2290 005723 2291 005725 2293 005726 2301 005734 2314 005735 2315 005736 2316 005737 2318 005740 2320 005744 2322 005751 2324 005753 2326 005757 2331 005762 2332 005764 2335 005765 2337 005767 2340 005771 2345 005772 2346 005774 2352 005775 2354 006000 2357 006002 2359 006010 2360 006012 2362 006013 2364 006015 2365 006017 2366 006020 2368 006022 2370 006024 2371 006026 2373 006032 2375 006033 2378 006037 2382 006045 2383 006051 2384 006053 2385 006055 2388 006056 2389 006060 2390 006064 2392 006070 2396 006071 2397 006075 2398 006076 2399 006077 2400 006101 2402 006102 2405 006104 2408 006115 2409 006116 2412 006120 2414 006122 2415 006124 2418 006125 2421 006127 2423 006131 2426 006133 2428 006136 2430 006167 2431 006172 2433 006174 2436 006177 2438 006230 2439 006233 2440 006235 2442 006237 2444 006270 2445 006273 2446 006275 2447 006277 2449 006300 2454 006301 2455 006305 2456 006307 2458 006311 2460 006313 2462 006315 2465 006317 2467 006323 2473 006325 2475 006327 2479 006333 2481 006336 2482 006341 2483 006343 2485 006344 2486 006347 2489 006351 2490 006353 2491 006355 2492 006356 2494 006360 2496 006364 2497 006366 2498 006372 2500 006376 2503 006401 2506 006404 2508 006407 2510 006411 2511 006413 2512 006417 2514 006423 2516 006427 2517 006431 2518 006433 2519 006435 2520 006441 2521 006445 2523 006446 2526 006450 2527 006453 2528 006455 2531 006456 2534 006457 2535 006461 2536 006465 2537 006471 2540 006472 2542 006500 2543 006501 2551 006502 2553 006504 2554 006507 2555 006511 2557 006513 2559 006515 2560 006520 2562 006522 2564 006526 2567 006527 2568 006532 2570 006534 2572 006536 2573 006541 2574 006543 2576 006545 2579 006550 2582 006552 2584 006554 2586 006555 2587 006560 2589 006561 2590 006563 2591 006565 2592 006567 2593 006571 2594 006573 2595 006575 2596 006577 2597 006601 2598 006603 2600 006605 2602 006611 2605 006615 2606 006620 2608 006622 2611 006624 2613 006625 2614 006626 2615 006631 2617 006632 2618 006636 2619 006637 2620 006643 2621 006644 2622 006650 2623 006651 2624 006655 2625 006656 2626 006662 2627 006663 2628 006667 2629 006670 2630 006674 2631 006675 2632 006701 2633 006702 2635 006706 2637 006712 2640 006716 2641 006721 2643 006723 2646 006725 2648 006726 2649 006727 2650 006732 2652 006733 2653 006737 2654 006740 2655 006744 2656 006745 2657 006751 2658 006752 2659 006756 2660 006757 2661 006763 2662 006764 2663 006770 2664 006771 2665 006775 2666 006776 2667 007002 2668 007003 2670 007007 2672 007013 2674 007017 2675 007021 2676 007023 2677 007025 2678 007027 2680 007031 2682 007033 2683 007036 2685 007040 2687 007042 2689 007044 2690 007047 2692 007051 2694 007053 2696 007055 2698 007065 2699 007071 2703 007072 2705 007075 2708 007100 2711 007103 2713 007107 2714 007113 2715 007114 2717 007123 2719 007127 2722 007132 2729 007133 2730 007134 2731 007141 2733 007142 2735 007146 2737 007150 2745 007154 2750 007156 2751 007162 2753 007163 2758 007166 2760 007171 2762 007172 2764 007203 2766 007210 2767 007212 2768 007214 2770 007215 2773 007223 2774 007224 2777 007227 2779 007231 2780 007235 2782 007241 2786 007242 2789 007244 2791 007246 2794 007251 2797 007254 2800 007256 2801 007257 2803 007264 2806 007270 2808 007271 2810 007276 2813 007302 2815 007303 2817 007310 2819 007311 2821 007315 2822 007316 2824 007322 2826 007326 2828 007327 2831 007332 2832 007333 2833 007335 2837 007337 2841 007340 2844 007341 2846 007343 2847 007344 2848 007346 2850 007350 2852 007352 2853 007355 2855 007357 2859 007363 2863 007364 2888 007366 2889 007402 2891 007413 2895 007414 2898 007416 2899 007423 2900 007426 2902 007440 2904 007442 2912 007450 2966 007456 2967 007460 2968 007462 2969 007463 2971 007464 2974 007471 2978 007504 2980 007512 2984 007530 2988 007537 2990 007541 2993 007546 2996 007553 2999 007560 3001 007565 3003 007570 3006 007575 3008 007576 3011 007601 3014 007606 3016 007607 3018 007612 3020 007613 3023 007617 3026 007624 3029 007627 3031 007632 3034 007634 3037 007640 3040 007644 3043 007647 3045 007650 3049 007653 3051 007657 3052 007661 3053 007663 3055 007664 3057 007704 3059 007705 3063 007710 3065 007715 3067 007734 3070 007742 3072 007744 3074 007747 3077 007757 3078 007761 3080 007766 3081 007767 3082 007770 3084 007775 3089 010013 3092 010027 3094 010030 ----------------------------------------------------------- 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