COMPILATION LISTING OF SEGMENT cobol_expand_source_ 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 1026.6 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_expand_source_.pl1 Reformatted code to new Cobol standard. 19* END HISTORY COMMENTS */ 20 21 22 /* Modified on 04/04/83 by FCH, [5.2-1], span changed to fixed bin(24), phx14809(BUG550) */ 23 /* Modified on 12/29/81 by FCH, [5.1-2], ecs command makes COPY and REPLACE statements into comments, phx11818(BUG519) */ 24 /* Modified on 10/27/81 by FCH, [5.1-1], include file cobol_ecs_info changed, phx11819(BUG517) */ 25 /* Recompiled on 12/10/79 to fix problem with leveling diags on COPY statements */ 26 /* Modified on 04/09/79 by FCH, [4.0-3], emit text manip statement */ 27 /* Modified on 04/05/79 by FCH, [4.0-2], detect illegal pseudo-text */ 28 /* Modified on 02/23/79 by FCH, [4.0-1], copy file name qualification */ 29 /* created for Version 4.0 */ 30 31 32 33 34 35 36 /* format: style3 */ 37 cobol_expand_source_: 38 proc; 39 40 41 replace: 42 entry (ecs_info_ptr, bc, command, expand_cobol_source_area_ptr); 43 44 call init; 45 46 /* Main processing loop for replace statement */ 47 48 replace_err: 49 call clear_copy; 50 51 do while ("1"b); 52 53 lexeme_env.error = 0; 54 call cobol_lexeme$find_replace (lexeme_ptr); 55 next_replace: 56 if lexeme_env.error = 1 57 then do; 58 59 call merge_to_end; 60 bc = (next_new_position - 1) * 9; 61 call finish; 62 return; 63 end; 64 else do; 65 66 replace_active = "1"b; 67 save_copy_line = lexeme_env.token.line; 68 copy_line_length = lexeme_env.current_line.length; 69 save_copy_column = lexeme_env.token.column; 70 save_source_offset = lexeme_env.token.offset - 1; 71 copy_line_ptr = lexeme_env.current_line.loc; 72 73 call process_replace_statement; 74 75 end; 76 77 end; /* end processing loop for replace statement */ 78 79 process_replace_statement: 80 proc; 81 82 /*[4.0-3]*/ 83 state_pos = lexeme_env.token.offset; 84 85 comp_str_used = 1; 86 cr_used, cr_largest, semi_sw, comma_sw = 0; 87 88 lexeme_env.indicators.copy_replace = "1"b; 89 lexeme_env.pseudo_text = 1; 90 91 92 call cobol_lexeme$cobol_lexeme (lexeme_ptr); 93 94 if lexeme_env.error = 1 95 then return; /* replace off. */ 96 if lexeme_env.token.type = 3 & lexeme_env.token.string = "off" 97 then do; 98 99 call cobol_lexeme$cobol_lexeme (lexeme_ptr); 100 if lexeme_env.error = 1 101 then return; 102 103 if lexeme_env.token.type = 4 & lexeme_env.token.string = "." 104 then do; 105 106 call merge_to_copy; 107 last_source_offset = lexeme_env.token.offset + 2; 108 return; 109 end; 110 end; /* replace statement */ 111 if substr (word, 1, lexeme_env.token.string_size) ^= "==" 112 then return; 113 114 do while (lexeme_env.token.string ^= "."); 115 116 if (cr_used + 1) > cr_max 117 then do; 118 119 call T_alloc (addr (cr_control), "0"b); 120 cr_max = cr_cap / 3; 121 end; 122 cr_used = cr_used + 1; 123 124 call pseudo_text ("L"); 125 126 if lexeme_env.error = 1 | ^(lexeme_env.token.type = 3 & lexeme_env.token.string = "by") 127 then return; 128 129 call get_next_lexeme (""); 130 131 call pseudo_text ("R"); 132 133 end; 134 135 call merge_to_copy; 136 call replace_process; 137 138 lexeme_env.indicators.copy_replace = "0"b; 139 140 end process_replace_statement; 141 142 init: 143 proc; 144 145 /* 146* INITILIZATION 147* */ 148 149 /*[5.1-2]*/ 150 if ecs_info_table_.command 151 then char10 = "******* "; 152 else char10 = " "; 153 154 next_new_position, last_source_offset = 1; 155 last_copy_line, insert_space_span = 0; 156 fill_last_ln = "0"b; 157 replace_active = "0"b; 158 159 /* Allocate Tables for Copy Replacement */ 160 161 call T_alloc (addr (cr_control), "1"b); 162 cr_max = cr_cap / 3; 163 164 call T_alloc (addr (lbw_control), "1"b); 165 166 lbw_max = lbw_cap / 2; 167 168 call T_alloc (addr (cs_control), "1"b); 169 170 cs_max = cs_cap * 4; 171 172 allocate lexeme_env in (expand_cobol_source_area) set (lexeme_ptr); 173 174 call cobol_lexeme$open (lexeme_ptr); 175 176 lexeme_env.ecs_ptr = expand_cobol_source_area_ptr; 177 old_file_ptr = ecs_info_table_.input_ptr; 178 new_file_ptr = ecs_info_table_.output_ptr; 179 p1 = lexeme_ptr; 180 181 /* 182* Make the old file known to cobol_lexeme. 183* */ 184 185 lexeme_ptr = p1; 186 p1 -> lexeme_env.source_table.loc = old_file_ptr; 187 lexeme_env.error = 0; 188 189 call cobol_lexeme$set (p1, "file_name", old_file_ptr); 190 191 if lexeme_env.error ^= 0 192 then do; 193 194 bc = (next_new_position - 1) * 9; 195 call finish; 196 197 return; 198 end; 199 200 end init; 201 202 copy: 203 entry (ecs_info_ptr, bc, command, expand_cobol_source_area_ptr); 204 205 call init; 206 207 /*[4.0-4]*/ 208 last_char_nl = 0; 209 210 cpr_error: 211 call clear_copy; 212 213 /* Main processing loop for copy replacing */ 214 215 do while ("1"b); 216 217 start: 218 lexeme_env.error = 0; 219 call cobol_lexeme$find_copy (lexeme_ptr); 220 221 if lexeme_env.error = 1 /* eof */ 222 then do; 223 224 call merge_to_end; 225 bc = (next_new_position - 1) * 9; 226 call finish; 227 return; 228 229 end; 230 else do; 231 232 save_copy_line = lexeme_env.token.line; 233 copy_line_length = lexeme_env.current_line.length; 234 save_copy_column = lexeme_env.token.column; 235 copy_line_ptr = lexeme_env.current_line.loc; 236 save_source_offset = lexeme_env.token.offset - 1; 237 238 call process_copy_statement; 239 240 end; 241 242 end; 243 244 process_copy_statement: 245 proc; 246 247 if lexeme_env.token.col_7 = "D" | lexeme_env.token.col_7 = "d" 248 then return; 249 250 251 /*[4.0-3]*/ 252 state_pos = lexeme_env.token.offset; 253 254 call get_lib_name; 255 256 /* 257* get_lib_name returns with next word 258* */ 259 260 if lexeme_env.token.type = 3 261 then if lexeme_env.token.string = "replacing" 262 then do; 263 264 /* 265* We now have a COPY ... REPLACING statement to process. 266* 267* Perform syntax on statement and generate tables. 268* */ 269 270 lexeme_env.indicators.copy_replace = "1"b; 271 lexeme_env.pseudo_text = 1; 272 call rep_spec; 273 274 /* 275* Merge the library file with the specified replacements. 276* */ 277 278 if valid_lib 279 then call replace_process; 280 else goto cpr_error; 281 282 end; 283 284 else goto cpr_error; 285 286 else if lexeme_env.token.type = 4 287 then if lexeme_env.token.string = "." 288 then do; 289 290 /* 291* This is a simple COPY so merge the library and go back to start. 292* */ 293 294 if valid_lib 295 then call merge_library; 296 else goto cpr_error; 297 298 299 return; 300 301 end; 302 303 else goto cpr_error; 304 305 else goto cpr_error; 306 307 end process_copy_statement; 308 309 get_lib_name: 310 proc; 311 312 /* 313* Get copy file name without converting to lower case. 314* */ 315 316 lexeme_env.indicators.lc = "0"b; 317 call get_next_lexeme (""); 318 lexeme_env.indicators.lc = "1"b; 319 320 /* 321* Save copy file name. 322* */ 323 324 lib_name = substr (word, 1, lexeme_env.token.string_size); 325 326 /* 327* make library known to cobol_lexeme. 328* */ 329 330 allocate lexeme_env in (expand_cobol_source_area) set (lexeme_ptr); 331 332 lexeme_env.ecs_ptr = expand_cobol_source_area_ptr; 333 p2 = lexeme_ptr; 334 p2 -> lexeme_env.error = 0; 335 p2 -> lexeme_env.mem_tab_ptr = p1 -> lexeme_env.mem_tab_ptr; 336 p2 -> lexeme_env.x_ptr = p1 -> lexeme_env.x_ptr; 337 338 lexeme_ptr = p1; 339 340 /* call cobol_lexeme$reset(p1); */ 341 /* 342* Check for qualification of copy file name. 343* */ 344 345 call get_next_lexeme (""); 346 347 if lexeme_env.token.string ^= "of" & lexeme_env.token.string ^= "in" 348 /*[4.0-1]*/ 349 then qual_name = ""; /*[4.0-1]*/ 350 else do; 351 352 /* 353* Get library name without converting to lower case. 354* */ 355 356 lexeme_env.indicators.lc = "0"b; 357 358 call get_next_lexeme (""); 359 360 lexeme_env.indicators.lc = "1"b; 361 362 /*[4.0-1]*/ 363 qual_name = substr (word, 1, lexeme_env.token.string_size); 364 365 /*[4.0-1]*/ 366 end; 367 368 /*[4.0-1]*/ 369 call expand_cobol_source$find_incl_file /*[4.0-1]*/ (substr (lib_name, 1, length (lib_name)), 370 /*[4.0-1]*/ 371 substr (qual_name, 1, length (qual_name)), /*[4.0-1]*/ 372 old_file_ptr, /*[4.0-1]*/ 373 p2 -> lexeme_env.source_table.loc, /*[4.0-1]*/ 374 code /*[4.0-1]*/); 375 376 377 /*[4.0-1]*/ 378 call cobol_lexeme$envinit (p2); 379 380 /*[4.0-1]*/ 381 if code ^= 0 382 then do; 383 valid_lib = "0"b; /*[4.0-1]*/ 384 free p2 -> lexeme_env; /*[4.0-1]*/ 385 end; /*[4.0-1]*/ 386 else do; 387 valid_lib = "1"b; /*[4.0-1]*/ 388 lib_file_ptr = p2 -> lexeme_env.source_table.loc; 389 /*[4.0-1]*/ 390 end; 391 392 /* 393* Call cobol_lexeme so when we return we will 394* be looking at "REPLACING". 395* */ 396 397 /*[4.0-1]*/ 398 if qual_name ^= "" 399 then call get_next_lexeme (""); 400 401 end get_lib_name; 402 403 rep_spec: 404 proc; 405 406 /* 407* Initialize text replacement control parameters. 408* */ 409 410 semi_sw, comma_sw = 0; 411 cr_used, cr_largest = 0; 412 comp_str_used = 1; 413 414 415 /* 416* Get token after 'replacing'. 417* */ 418 419 call get_next_lexeme (""); 420 421 /* 422* Main loop for processing replacing specification. 423* */ 424 425 do while (lexeme_env.token.string ^= "."); 426 427 /* 428* Check and see if tcr_table is full. 429* */ 430 431 if (cr_used + 1) > cr_max 432 then do; 433 434 call T_alloc (addr (cr_control), "0"b); 435 cr_max = cr_cap / 3; 436 end; 437 438 cr_used = cr_used + 1; 439 440 /* 441* Process the left specitication and 442* build the replacement table. 443* */ 444 445 call left_spec; 446 447 /* 448* Check for the word 'by'. 449* */ 450 451 if lexeme_env.token.string ^= "by" 452 then do; 453 454 cr_used = cr_used - 1; 455 goto cpr_error; 456 end; 457 458 call get_next_lexeme (""); 459 460 /* 461* Scan off the word 'by' and 462* process the right specitication. 463* */ 464 465 call right_spec; 466 467 /* put skip edit ("key ->", substr(compare_string,comp_start(cr_used),comp_len(cr_used)),"<-") (a); */ 468 469 end; /* end of main loop */ 470 471 lexeme_env.indicators.copy_replace = "0"b; 472 473 end rep_spec; 474 475 left_spec: 476 proc; 477 478 /* This routine calls substr_word with an indicator 479* to process the compare text 480* */ 481 482 call subst_word ("L"); 483 484 end left_spec; 485 486 487 right_spec: 488 proc; 489 490 /* This routine calls substr_word with an indicator 491* to process the replacement text 492* */ 493 494 call subst_word ("R"); 495 496 end right_spec; 497 498 subst_word: 499 proc (mode); 500 501 dcl mode char (1); 502 503 /* 504* This routines identifies 505* ==pseudo-text== 506* identifier 507* literal 508* word 509* and calls the appropiate subroutine for process. 510* On entry word contains the token. 511* */ 512 513 if substr (word, 1, lexeme_env.token.string_size) = "==" 514 /* pseudo-text delimiter */ 515 then call pseudo_text (mode); 516 else if token.type = 3 /* word*/ 517 then call ident (mode); 518 else if token.type = 2 519 then call literal (mode); 520 else goto cpr_error; 521 522 end subst_word; 523 524 pseudo_text: 525 proc (mode); 526 527 dcl mode char (1); 528 dcl c2 char (2); 529 530 531 text_string = ""; 532 533 if mode = "R" 534 then do; 535 536 call cobol_lexeme$find_pseudo_text (lexeme_ptr); 537 538 if lexeme_env.error = 1 539 then goto cpr_error; 540 541 /* 542* Save offset and span of replacement text. 543* */ 544 545 repl_offset (cr_used) = lexeme_env.token.offset; 546 repl_span (cr_used) = lexeme_env.token.span; 547 end; 548 549 /* 550* Process left specification pseudo-text. 551* */ 552 553 else do; 554 555 /* 556* Scan past current '==' and get first token in psuedo-text. 557* */ 558 559 call get_next_lexeme ("text_word"); 560 561 if substr (word, 1, lexeme_env.token.string_size) = "," 562 | substr (word, 1, lexeme_env.token.string_size) = ";" 563 then do; 564 565 /* 566* Special processing if comma or semi-colon. 567* */ 568 569 text_string = " " || substr (word, 1, lexeme_env.token.string_size); 570 571 call get_next_lexeme (""); 572 573 if substr (word, 1, lexeme_env.token.string_size) ^= "==" 574 then text_string = ""; 575 576 end; 577 578 do while (substr (word, 1, lexeme_env.token.string_size) ^= "=="); 579 580 text_string = text_string || " " || substr (word, 1, lexeme_env.token.string_size); 581 call get_next_lexeme (""); 582 583 /*[4.0-2]*/ 584 if lexeme_env.error ^= 0 585 then go to cpr_error; 586 587 end; 588 589 /* 590* Insert pseudo-text into the compare_string 591* and update the parameters in cr_table. 592* */ 593 594 text_string_length = length (text_string); 595 comp_start (cr_used) = comp_str_used; 596 597 /* 598* Check and see if text_string will fit into compare_string. 599* */ 600 601 do while ((text_string_length + comp_str_used) > cs_max); 602 603 call T_alloc (addr (cs_control), "0"b); 604 cs_max = cs_cap * 4; 605 606 end; 607 608 substr (compare_string, comp_str_used, text_string_length) = text_string; 609 comp_len (cr_used) = text_string_length; 610 comp_str_used = comp_str_used + text_string_length; 611 612 if text_string_length > cr_largest 613 then cr_largest = text_string_length; 614 615 /* 616* Test and set an indicator if pseudo-text consists 617* solely of a comma(,) or a semi-colon(;). 618* */ 619 620 if text_string_length = 2 621 then do; 622 623 c2 = substr (text_string, 1, 2); 624 625 if c2 = " ;" 626 then semi_sw = cr_used; 627 else if c2 = " ," 628 then comma_sw = cr_used; 629 630 end; 631 632 end; 633 634 /* 635* Position to 'by or '.' on return. 636* */ 637 638 call get_next_lexeme (""); 639 640 return; 641 642 end pseudo_text; 643 644 ident: 645 proc (mode); 646 647 dcl mode char (1); 648 dcl replacement_span fixed bin; 649 650 /* If this is the right specification save the offset of the source 651* for replacement. */ 652 653 654 if mode = "R" 655 then do; 656 657 repl_offset (cr_used) = token.offset; 658 replacement_span = (lexeme_env.token.offset - repl_offset (cr_used)) + lexeme_env.token.span; 659 end; 660 661 else do; 662 663 text_string = ""; 664 text_string = text_string || " " || substr (word, 1, string_size); 665 end; 666 667 call get_next_lexeme (""); 668 669 /* 670* Continue to scan and build text_string string as long 671* as the identifier is qualified with an "of" or "in". 672* */ 673 674 do while (substr (word, 1, lexeme_env.token.string_size) = "in" 675 | substr (word, 1, lexeme_env.token.string_size) = "of"); 676 677 if mode = "R" 678 then replacement_span = (lexeme_env.token.offset - repl_offset (cr_used)) + lexeme_env.token.span; 679 else text_string = text_string || " " || substr (word, 1, lexeme_env.token.string_size); 680 681 call get_next_lexeme (""); 682 683 if token.type ^= 3 /* type 3 = word */ 684 then do; 685 call copy_error (1); 686 687 cr_used = cr_used - 1; 688 goto cpr_error; 689 end; 690 691 if mode = "R" 692 then replacement_span = (lexeme_env.token.offset - repl_offset (cr_used)) + lexeme_env.token.span; 693 else text_string = text_string || " " || substr (word, 1, lexeme_env.token.string_size); 694 695 call get_next_lexeme (""); 696 697 end; 698 699 /* 700* Check and see if the identifier is subscripted. If it is 701* scan until a right paren ")" is found saving the tokens 702* in text_string string; 703* */ 704 705 706 if substr (word, 1, lexeme_env.token.string_size) = "(" 707 then do; 708 709 if mode = "R" 710 then replacement_span = (lexeme_env.token.offset - repl_offset (cr_used)) + lexeme_env.token.span; 711 else text_string = text_string || " ("; 712 713 call get_next_lexeme (""); 714 715 do while (substr (word, 1, lexeme_env.token.string_size) ^= ")"); 716 717 if mode = "R" 718 then replacement_span = 719 (lexeme_env.token.offset - repl_offset (cr_used)) + lexeme_env.token.span; 720 else text_string = text_string || " " || substr (word, 1, lexeme_env.token.string_size); 721 722 call get_next_lexeme (""); 723 724 if string = "by" | string = "copy" | string = "." 725 then do; 726 727 call copy_error (5); 728 goto cpr_error; 729 730 end; 731 end; 732 733 if mode = "R" 734 then replacement_span = (lexeme_env.token.offset - repl_offset (cr_used)) + lexeme_env.token.span; 735 else text_string = text_string || " )"; 736 737 call get_next_lexeme (""); 738 end; 739 740 741 /* If identifier is from right specification save the span in the source file. 742* If the identifier is from the left specification insert the identifier into 743* the compare string and make the entries is the cr_table for it. 744* */ 745 746 747 if mode = "R" 748 then repl_span (cr_used) = replacement_span; 749 else do; 750 comp_start (cr_used) = comp_str_used; 751 text_string_length = length (text_string); 752 comp_len (cr_used) = text_string_length; 753 754 755 /* Check and see if text_string will fit into compare_string */ 756 757 758 do while ((text_string_length + comp_str_used) > cs_max); 759 760 call T_alloc (addr (cs_control), "0"b); 761 cs_max = cs_cap * 4; 762 end; 763 764 substr (compare_string, comp_str_used, text_string_length) = text_string; 765 comp_str_used = comp_str_used + text_string_length; 766 767 /* 768* Check and update cr_largest if necessary. 769* */ 770 771 if text_string_length > cr_largest 772 then cr_largest = text_string_length; 773 end; 774 775 end ident; 776 777 literal: 778 proc (mode); 779 780 dcl mode char (1); 781 782 if mode = "R" /* 783* Process the left specification: Save the offset and the 784* span of the replacement text from the source file. 785* */ 786 then do; 787 repl_offset (cr_used) = lexeme_env.token.offset; 788 repl_span (cr_used) = lexeme_env.token.span; 789 end; 790 791 /* 792* Process the right specification: insert the 793* literal into the compare_string and update the 794* cr_table parameters. 795* */ 796 797 else do; 798 799 comp_start (cr_used) = comp_str_used; 800 comp_len (cr_used) = lexeme_env.token.string_size + 1; 801 /* 802* Check and see if literal will fit into compare_string. 803* */ 804 do while ((comp_len (cr_used) + comp_str_used) > cs_max); 805 806 call T_alloc (addr (cs_control), "0"b); 807 cs_max = cs_cap * 4; 808 end; 809 810 substr (compare_string, comp_str_used, lexeme_env.token.string_size + 1) = 811 " " || substr (word, 1, lexeme_env.token.string_size); 812 comp_str_used = comp_str_used + lexeme_env.token.string_size + 1; 813 814 if (lexeme_env.token.string_size + 1) > cr_largest 815 then cr_largest = (token.string_size + 1); 816 end; 817 818 /* 819* Call cobol_lexeme to position to the next word on return. 820* */ 821 822 call get_next_lexeme (""); 823 824 end literal; 825 826 merge_library: 827 proc; 828 829 /* 830* Copy the old source into the new source up to the copy statement. 831* */ 832 833 call merge_to_copy; 834 835 span = p2 -> lexeme_env.source_table.size; 836 substr (new_file, next_new_position, span) = substr (lib_file, 1, span); 837 838 839 next_new_position = next_new_position + span; 840 841 end merge_library; 842 843 844 merge_to_end: 845 proc; 846 847 /* 848* Check and see in any remaining text was on the last copy line. 849* */ 850 851 if fill_last_ln 852 then do; 853 854 substr (new_file, next_new_position, insert_space_span) = substr (spaces, 1, insert_space_span); 855 next_new_position = next_new_position + insert_space_span; 856 end; 857 858 span = p1 -> lexeme_env.source_table.size - last_source_offset + 1; 859 860 861 substr (new_file, next_new_position, span) = substr (old_file, last_source_offset, span); 862 next_new_position = next_new_position + span; 863 864 end merge_to_end; 865 866 merge_to_copy: 867 proc; 868 869 /* 870* Check and see if wee have to preserve the column position of remaining 871* text on a line with a copy statement. 872* */ 873 874 /*[4.0-3]*/ 875 state_span = lexeme_env.token.offset - state_pos + 1; 876 877 if (last_copy_line = lexeme_env.token.line) | fill_last_ln 878 then do; 879 span = save_source_offset - last_source_offset + 1; 880 881 if substr (old_file, last_source_offset, span) ^= substr (spaces, 1, span) 882 then do; 883 substr (new_file, next_new_position, insert_space_span) = 884 substr (spaces, 1, insert_space_span); 885 886 next_new_position = next_new_position + insert_space_span; 887 if fill_last_ln 888 then fill_last_ln = "0"b; 889 890 end; 891 end; /* 892* Is the copy the first word on the current line? 893* */ 894 895 if substr (source_line, 8, save_copy_column - 8) = substr (spaces, 1, save_copy_column - 8) 896 then fill_sw = "0"b; 897 else fill_sw = "1"b; 898 899 /* 900* Do we want to include the beginning of the line 901* to the copy. 902* */ 903 904 if fill_sw 905 then span = save_source_offset - last_source_offset; 906 else span = (save_source_offset - last_source_offset) - (save_copy_column - 2); 907 908 if span > 0 909 then do; 910 911 912 substr (new_file, next_new_position, span) = substr (old_file, last_source_offset, span); 913 next_new_position = next_new_position + span; 914 915 if fill_sw 916 then do; 917 918 substr (new_file, next_new_position, 1) = new_line_character; 919 next_new_position = next_new_position + 1; 920 921 end; 922 923 end; 924 925 if lexeme_env.token.column < (lexeme_env.current_line.length - 1) 926 then do; 927 ; 928 929 last_source_offset = lexeme_env.token.offset + 1; 930 fill_last_ln = "1"b; 931 end; 932 else do; 933 934 fill_last_ln = "0"b; 935 last_source_offset = lexeme_env.token.offset + 2; 936 end; 937 938 last_copy_line = lexeme_env.token.line; 939 insert_space_span = lexeme_env.token.column; 940 941 /*[4.0-4]*/ 942 if ecs_info_table_.format_indicator 943 then return; 944 945 /*[4.0-3]*/ 946 substr (new_file, next_new_position, state_span + 11) = 947 /* emit the statement */ /*[5.1-2]*/ char10 || substr (old_file, state_pos, state_span) || " 948 "; 949 950 /*[4.0-3]*/ 951 STR_PTR = addr (new_array (next_new_position)); /*[4.0-3]*/ 952 SIZE = state_span + 11; 953 954 /*[4.0-3]*/ 955 do while ("1"b); 956 957 /*[4.0-3]*/ 958 CR_LOC = index (STR, " 959 "); 960 961 /*[4.0-3]*/ 962 if CR_LOC = SIZE 963 then go to MC; 964 965 /*[4.0-3]*/ 966 STR_PTR = addr (STR_ARRAY (CR_LOC + 1)); /*[4.0-3]*/ 967 SIZE = SIZE - CR_LOC; /*[5.1-2]*/ 968 if ecs_info_table_.command 969 then substr (STR, 1, 7) = "*******"; /*[4.0-3]*/ 970 end; 971 972 MC: /*[4.0-3]*/ 973 next_new_position = next_new_position + state_span + 11; 974 975 976 977 end merge_to_copy; 978 979 T_alloc: 980 proc (TT_ptr, first_time); 981 982 declare 1 TT_a based (TT_ptr), 983 2 loc ptr, 984 2 parity fixed bin, 985 2 cap fixed bin, 986 2 incr fixed bin; 987 988 dcl TT_0 (TABLE_SIZE) aligned fixed bin (35) based (TABLE_PTR); 989 dcl TT_1 (TABLE_SIZE) aligned fixed bin (35) based (TABLE_PTR); 990 dcl TABLE_SIZE fixed bin; 991 dcl (TT_ptr, TABLE_PTR) ptr; 992 dcl first_time bit (1); 993 994 TABLE_SIZE = TT_a.cap + TT_a.incr; 995 996 if TT_a.parity = 0 997 then do; 998 allocate TT_1 in (expand_cobol_source_area) set (TABLE_PTR); 999 1000 if ^first_time 1001 then do; 1002 do i = 1 to TT_a.cap; 1003 TT_1 (i) = TT_0 (i); 1004 end; 1005 TT_a.loc = TABLE_PTR; 1006 free TT_0; 1007 end; 1008 else TT_a.loc = TABLE_PTR; 1009 1010 TT_a.parity = 1; 1011 1012 end; 1013 else do; 1014 allocate TT_0 in (expand_cobol_source_area) set (TABLE_PTR); 1015 1016 if ^first_time 1017 then do; 1018 do i = 1 to TT_a.cap; 1019 TT_0 (i) = TT_1 (i); 1020 end; 1021 TT_a.loc = TABLE_PTR; 1022 free TT_1; 1023 end; 1024 else TT_a.loc = TABLE_PTR; 1025 1026 TT_a.parity = 0; 1027 1028 end; 1029 1030 TT_a.cap = TABLE_SIZE; 1031 end T_alloc; 1032 1033 T_free: 1034 proc (TT_ptr); 1035 1036 dcl 1 TT_a based (TT_ptr), 1037 2 loc ptr, 1038 2 parity fixed bin, 1039 2 cap fixed bin, 1040 2 incr fixed bin; 1041 1042 dcl TT_0 (TT_a.cap) aligned fixed bin (35) based (TT_a.loc); 1043 dcl TT_1 (TT_a.cap) aligned fixed bin (35) based (TT_a.loc); 1044 dcl TT_ptr ptr; 1045 1046 if TT_a.parity = 0 1047 then free TT_0; 1048 else free TT_1; 1049 1050 end T_free; 1051 1052 clear_copy: 1053 proc; 1054 1055 cr_used = 0; 1056 comp_str_used = 1; 1057 1058 do i = 1 to cr_max; 1059 cr_table (i) = 0; 1060 end; 1061 1062 do i = 1 to cs_max; 1063 substr (compare_string, i, 1) = " "; 1064 end; 1065 1066 end clear_copy; 1067 1068 finish: 1069 proc; 1070 1071 lexeme_ptr = p1; 1072 free lexeme_env; 1073 1074 call cobol_lexeme$close (p1); 1075 call T_free (addr (cs_control)); 1076 call T_free (addr (cr_control)); 1077 call T_free (addr (lbw_control)); 1078 1079 end finish; 1080 1081 get_next_lexeme: 1082 proc (entry); 1083 1084 dcl entry char (9); 1085 1086 if entry = "token" 1087 then call cobol_lexeme$token (lexeme_ptr); 1088 else if entry = "text_word" 1089 then call cobol_lexeme$text_word (lexeme_ptr); 1090 else call cobol_lexeme$cobol_lexeme (lexeme_ptr); 1091 1092 if lexeme_env.error > 1 1093 then if ^replace_active 1094 then goto cpr_error; 1095 else goto replace_err; 1096 1097 end get_next_lexeme; 1098 1099 replace_process: 1100 proc; 1101 1102 dcl library_string char (cr_largest); 1103 1104 /* 1105* Copy the old source into the new source up to the copy statement. 1106* */ 1107 1108 if ^replace_active 1109 then do; 1110 1111 call merge_to_copy; 1112 1113 /* 1114* Make library file known to cobol lexeme. 1115* */ 1116 1117 lexeme_ptr = p2; 1118 end; 1119 1120 /* 1121* Initialize the replacemnt parameters and get the first library word. 1122* */ 1123 1124 lbs_length, lbs_sum, lbw_used = 0; 1125 lbs_size = cr_largest; 1126 library_string = spaces; 1127 base_offset = 1; 1128 1129 call build_library_string; 1130 1131 read_more_text = "1"b; 1132 1133 do while (read_more_text); /* end of file indicator */ 1134 1135 matched_word_pos, spec_index = 0; 1136 1137 call compare_text; /* 1138* If matched_word_pos returns greater than zero it 1139* will point to the first word matched in the 1140* library_string and spec_index will be the 1141* index to the specification in cr_table. 1142* */ 1143 /* put skip edit (matched_word_pos,"->",library_string,"<-") (f(4),x(2),3 a); */ 1144 1145 if matched_word_pos > 0 1146 then call replace_text; 1147 1148 call build_library_string; 1149 1150 end; /* do while not end of file */ 1151 1152 if replace_active 1153 then do; 1154 1155 replace_active = "0"b; 1156 goto next_replace; 1157 1158 end; 1159 1160 /* 1161* The remaining library text from the last replacement 1162* to the end of the segment must also be moved to the new source. 1163* */ 1164 1165 move_span = (p2 -> lexeme_env.source_table.size - base_offset) + 1; 1166 1167 /* 1168* Size contains the offset of the last character in the 1169* library file. Plus one is used to get the NL character. 1170* */ 1171 1172 substr (new_file, next_new_position, move_span) = substr (lib_file, base_offset, move_span); 1173 next_new_position = next_new_position + move_span; 1174 1175 /* 1176* Reset lexeme_ptr so cobol_lexeme will 1177* get tokens from the source file. 1178* */ 1179 free lexeme_env; 1180 lexeme_ptr = p1; 1181 1182 /* 1183* Reset cr_table and clear compare_string. 1184* */ 1185 call clear_copy; 1186 1187 build_library_string: 1188 proc; 1189 1190 dcl chr char (1); 1191 1192 read_next_word: 1193 call cobol_lexeme$text_word (lexeme_ptr); 1194 1195 if lexeme_env.error = 1 | (replace_active & lexeme_env.token.type = 3 & lexeme_env.token.string = "replace") 1196 then do; 1197 1198 library_string = spaces; 1199 lbw_table (*), lbs_length, lbs_sum = 0; 1200 read_more_text = "0"b; 1201 1202 return; 1203 1204 end; 1205 1206 /* Is library word greater than largest compare search key 1207* if so no checking is needed and the words in the library 1208* string can be cleared */ 1209 1210 word_length = lexeme_env.token.string_size; 1211 1212 if (word_length + 1) > cr_largest 1213 then do; 1214 1215 do j = 1 to lbw_max; 1216 lbw_table (j) = 0; 1217 end; 1218 1219 lbw_used, lbs_length = 0; 1220 library_string = spaces; 1221 goto read_next_word; 1222 1223 end; 1224 1225 /* check for special processing for comma and semi */ 1226 1227 1228 1229 1230 if word_length = 1 1231 then do; 1232 1233 chr = substr (word, 1, 1); 1234 1235 if (chr = "," & comma_sw < 1) | (chr = ";" & semi_sw < 1) 1236 then goto read_next_word; 1237 end; 1238 1239 /* 1240* The library word will be used for comparision. 1241* Insert it into the library_string and update lbw_table. 1242* */ 1243 1244 if lbw_used + 1 > lbw_max /* 1245* The Library Word Table is new full, allocate more space . 1246* */ 1247 then do; 1248 1249 call T_alloc (addr (lbw_control), "0"b); 1250 lbw_max = lbw_cap / 2; 1251 end; 1252 1253 lbw_used = lbw_used + 1; 1254 lbw_length (lbw_used) = lexeme_env.token.string_size + 1; 1255 lbw_offset (lbw_used) = token.offset; 1256 lbw_span (lbw_used) = token.span; 1257 substr (aword, 1, 1) = " "; 1258 substr (aword, 2, word_length) = substr (word, 1, word_length); 1259 word_length = word_length + 1; 1260 1261 /* 1262* If the word will not fit into the library_string remove the 1263* oldest word from the left. Shift the remainging words to the 1264* lift to make rome for the new word and insert the new word. 1265* */ 1266 1267 do while (lbs_length + word_length > lbs_size); 1268 1269 lbs_sum = 0; 1270 1271 do j = 1 to (lbw_used - 1); 1272 lbs_sum = lbs_sum + lbw_length (j); 1273 end; 1274 1275 lbs_sum = lbs_size - lbs_sum; 1276 1277 /* 1278* lbs_sum is now the size of the remaining space in the library_string 1279* */ 1280 1281 if lbs_sum < word_length /* 1282* The space abailable in library_string is less 1283* than the length of the word. Remove a word from 1284* library-string 1285* */ 1286 then do; 1287 1288 substr (library_string, lbs_sum + 1, lbw_length (1)) = substr (spaces, 1, lbw_length (1)); 1289 lbs_length = lbs_length - lbw_length (1); 1290 1291 do j = 1 to (lbw_used - 1); 1292 1293 lbw_table (j) = lbw_table (j + 1); 1294 end; 1295 1296 lbw_used = lbw_used - 1; 1297 1298 end; /* removing word from library_string */ 1299 1300 end; /* do while */ 1301 1302 /* 1303* Now we shift the library_string to the left 1304* to make room for the new word 1305* */ 1306 1307 substr (library_string, 1, lbs_size) = substr (library_string, 1 + word_length, lbs_size - word_length); 1308 1309 /* 1310* Insert word in library_string 1311* */ 1312 1313 lbs_length = lbs_length + word_length; 1314 substr (library_string, lbs_size + 1 - word_length, word_length) = substr (aword, 1, word_length); 1315 1316 end build_library_string; 1317 1318 1319 1320 1321 1322 compare_text: 1323 proc; 1324 1325 dcl ii fixed bin; 1326 1327 ii = 1; 1328 1329 start_compare: 1330 matched_word_pos = 0; 1331 1332 do i = ii to cr_used while (matched_word_pos = 0); 1333 1334 spec_index = i; 1335 1336 if comp_len (spec_index) <= lbs_length 1337 then matched_word_pos = 1338 index (library_string, substr (compare_string, comp_start (spec_index), comp_len (spec_index))); 1339 end; /* 1340* if matched_word_pos is greater than zero it 1341* points to the first word matched in the 1342* library_string. The word matched in the 1343* library_string should be right justified. 1344* A check is made to see and if it is not 1345* the rest of the compare keys if any are used. 1346* */ 1347 1348 if matched_word_pos > 0 1349 then if (cr_largest - matched_word_pos + 1) ^= comp_len (spec_index) 1350 then do; 1351 ii = i; 1352 goto start_compare; 1353 end; 1354 1355 end compare_text; 1356 1357 1358 replace_text: 1359 proc; 1360 1361 1362 /* Locate the starting word of the matched phrase 1363* from the library_string. 1364* */ 1365 1366 lbs_sum = lbs_size - lbs_length; /* starting position of first word */ 1367 i = 0; 1368 1369 do j = 1 to lbw_used while (lbs_sum < matched_word_pos); 1370 1371 i = j; 1372 lbs_sum = lbs_sum + lbw_length (i); 1373 end; 1374 1375 /* 1376* Move the library source from the last replacement to 1377* the current replacement to the new source 1378* */ 1379 1380 /* put skip edit ("REP ->", substr(old_file,repl_offset(spec_index),repl_span(spec_index)),"<-") (a); */ 1381 1382 if replace_active 1383 then do; 1384 1385 move_span = lbw_offset (i) - last_source_offset; 1386 substr (new_file, next_new_position, move_span) = substr (old_file, last_source_offset, move_span); 1387 1388 end; 1389 else do; 1390 1391 move_span = lbw_offset (i) - base_offset; 1392 substr (new_file, next_new_position, move_span) = substr (lib_file, base_offset, move_span); 1393 1394 end; 1395 1396 /* 1397* Insert the replacement text from the source file 1398* */ 1399 1400 next_new_position = next_new_position + move_span; 1401 substr (new_file, next_new_position, repl_span (spec_index)) = 1402 substr (old_file, repl_offset (spec_index), repl_span (spec_index)); 1403 1404 /* 1405* Update next_new_position and base_offset for next time 1406* */ 1407 1408 next_new_position = next_new_position + repl_span (spec_index); 1409 1410 if replace_active 1411 then last_source_offset = lbw_offset (i) + lbw_span (i); 1412 else base_offset = lbw_offset (lbw_used) + lbw_span (lbw_used); 1413 1414 /* 1415* Clear library string and library word table 1416* */ 1417 1418 library_string = spaces; 1419 1420 do i = 1 to lbw_max; 1421 lbw_table (i) = 0; 1422 end; 1423 1424 lbw_used, lbs_length = 0; 1425 1426 end replace_text; 1427 1428 1429 end replace_process; 1430 1431 1432 1433 1434 1435 1436 1437 1438 copy_error: 1439 proc (error_no); 1440 1441 dcl error_no fixed bin; 1442 dcl error_msg (6) char (40) 1443 init ("A COBOL word is expected here", "End of text during error recovery", 1444 "The word BY is expected here", "Null or blank pseudo-text illegal", 1445 "Unmatched left parenthesis", "Error in finding include file"); 1446 dcl source_line char (current_line.length) based (current_line.loc); 1447 1448 call ioa_ ("cobol: COPY REPLACING... ^a on line ^d.", error_msg (error_no), lexeme_env.token.line); 1449 1450 end copy_error; 1451 1452 /* STRUCTURE */ 1453 1454 dcl 01 ecs_info_table aligned automatic structure like ecs_info_table_; 1455 1456 /* BUILTIN */ 1457 1458 dcl substr builtin; 1459 dcl length builtin; 1460 dcl addr builtin; 1461 dcl index builtin; 1462 1463 1464 /* CHARACTER */ 1465 1466 dcl text_string char (256) varying; 1467 dcl (lib_name, qual_name) 1468 char (128) varying; /*[4.0-1]*/ 1469 dcl source_line char (copy_line_length) based (copy_line_ptr); 1470 dcl word char (32) based (lexeme_env.token.string_ptr); 1471 dcl aword char (265); 1472 dcl spaces char (254) init ((254)" "); 1473 dcl old_file char (1048576) based (old_file_ptr); 1474 dcl new_file char (1048576) based (new_file_ptr); 1475 /*[4.0-3]*/ 1476 dcl new_array (1048576) char (1) based (new_file_ptr); 1477 /*[4.0-3]*/ 1478 dcl STR char (SIZE) based (STR_PTR); /*[4.0-3]*/ 1479 dcl STR_ARRAY (SIZE) char (1) based (STR_PTR); 1480 1481 /*[5.1-2]*/ 1482 dcl char10 char (10); 1483 dcl lib_file char (1048576) based (lib_file_ptr); 1484 dcl new_line_character char (1) init (" 1485 "); 1486 1487 1488 /* POINTERS */ 1489 1490 dcl expand_cobol_source_area_ptr 1491 ptr; 1492 dcl lexeme_ptr ptr; 1493 dcl old_file_ptr ptr; 1494 dcl new_file_ptr ptr; 1495 dcl lib_file_ptr ptr; 1496 dcl (p1, p2) ptr; 1497 dcl copy_line_ptr ptr; 1498 1499 /* BIT */ 1500 1501 dcl read_more_text bit (1); 1502 dcl replace_active bit (1); 1503 dcl command bit (1); 1504 dcl fill_sw bit (1); 1505 dcl fill_last_ln bit (1); 1506 dcl valid_lib bit (1); 1507 1508 /* ENTRIES */ 1509 1510 dcl ioa_ entry options (variable); 1511 dcl expand_cobol_source$find_incl_file 1512 entry (char (*), char (*), ptr, ptr, fixed bin (35)); 1513 /*[4.0-1]*/ 1514 dcl cobol_lexeme$envinit 1515 entry (ptr); /*[4.0-1]*/ 1516 1517 1518 /* AREA */ 1519 1520 dcl expand_cobol_source_area 1521 area based (expand_cobol_source_area_ptr); 1522 /* FIXED BINARY */ 1523 1524 dcl bc fixed bin (24); 1525 dcl save_copy_line fixed bin; 1526 dcl copy_line_length fixed bin; 1527 dcl next_new_position fixed bin (35); 1528 dcl cr_used fixed bin; 1529 dcl cr_largest fixed bin; 1530 dcl comma_sw fixed bin; 1531 dcl semi_sw fixed bin; /* 550 */ 1532 dcl (span, last_char_nl) 1533 fixed bin (24); 1534 dcl (i, j) fixed bin; 1535 dcl comp_str_used fixed bin init (1); 1536 dcl text_string_length fixed bin; 1537 dcl cr_max fixed bin; 1538 dcl lbw_max fixed bin; 1539 dcl lbw_used fixed bin; 1540 dcl cs_max fixed bin; 1541 dcl code fixed bin (35); /*[4.0-1]*/ 1542 dcl last_copy_line fixed bin; 1543 dcl insert_space_span fixed bin; 1544 dcl save_copy_column fixed bin; 1545 dcl save_source_offset fixed bin; 1546 dcl last_source_offset fixed bin (35); 1547 dcl base_offset fixed bin; 1548 dcl lbs_size fixed bin; 1549 dcl lbs_length fixed bin; 1550 dcl lbs_sum fixed bin; 1551 dcl word_length fixed bin; 1552 dcl move_span fixed bin; 1553 dcl matched_word_pos fixed bin; 1554 dcl spec_index fixed bin; /*[4.0-3]*/ 1555 dcl (state_span, state_pos, SIZE, CR_LOC) 1556 fixed bin, 1557 STR_PTR ptr; 1558 1559 /* 1560* 1561**/ 1562 1563 1564 /* Compare String */ 1565 1566 dcl compare_string char (cs_max) aligned based (cs_ptr); 1567 1568 dcl /* Copy Replaceing Table */ 1569 1 cr_table (cr_max) aligned based (cr_ptr), 1570 2 comp_start unaligned fixed bin, /* begin char pos in compare string */ 1571 2 comp_len unaligned fixed bin, /* length of compare key in string */ 1572 2 repl_offset unaligned fixed bin (35), /* offset of replacement text in source */ 1573 2 repl_span unaligned fixed bin (35); /* span of replacement text in source */ 1574 1575 1576 dcl /* Library Word Table */ 1577 1 lbw_table (lbw_max) aligned based (lbw_ptr), 1578 2 lbw_length unaligned fixed bin, /* length of word */ 1579 2 lbw_offset unaligned fixed bin (35), /* offset of word in library */ 1580 2 lbw_span unaligned fixed bin; /* span of word in library */ 1581 1582 1583 dcl /* Control table for compare string */ 1584 1 cs_control, 1585 2 cs_ptr ptr, 1586 2 cs_parity fixed bin init (1), 1587 2 cs_cap fixed bin init (100), /* 400 bytes */ 1588 2 cs_incr fixed bin init (10); /* increase by 40 bytes */ 1589 1590 dcl /* Control table for library word table */ 1591 1 lbw_control, 1592 2 lbw_ptr ptr, 1593 2 lbw_parity fixed bin init (1), 1594 2 lbw_cap fixed bin init (40), /* room for 25 library words */ 1595 2 lbw_incr fixed bin init (10); /* add space for 5 more library words */ 1596 1597 dcl /* Control Table for Copy Replaceing Table */ 1598 1 cr_control, 1599 2 cr_ptr ptr, 1600 2 cr_parity fixed bin initial (1), 1601 2 cr_cap fixed bin initial (60), /* room for 25 entries in cr_table */ 1602 2 cr_incr fixed bin initial (15); /* increase cr_table by 5 entries */ 1603 /* 1604* 1605**/ 1 1 /* BEGIN INCLUDE FILE ... cobol_lexeme_env.incl.pl1 */ 1 2 1 3 /* entry declarations for cobol_lexeme */ 1 4 1 5 declare cobol_lexeme$open entry (ptr); 1 6 declare cobol_lexeme$close entry(ptr); 1 7 declare cobol_lexeme$set entry(ptr,char(*),ptr); 1 8 declare cobol_lexeme$find_copy entry(ptr); 1 9 declare cobol_lexeme$find_replace entry(ptr); 1 10 declare cobol_lexeme$find_pseudo_text entry(ptr); 1 11 declare cobol_lexeme$text_word entry(ptr); 1 12 declare cobol_lexeme$token entry(ptr); 1 13 declare cobol_lexeme$cobol_lexeme entry(ptr); 1 14 1 15 dcl 1 16 1 17 1 lexeme_env based(lexeme_ptr), 1 18 2 token, 1 19 3 line fixed bin, 1 20 3 column fixed bin, 1 21 3 type fixed bin, 1 22 3 offset fixed bin(35), 1 23 3 span fixed bin, 1 24 3 string_size fixed bin(35), 1 25 3 string_cap fixed bin, 1 26 3 string_ptr ptr, 1 27 3 string char(32) varying, 1 28 3 col_7 char(1), 1 29 2 source_table, 1 30 3 line fixed bin, 1 31 3 loc ptr, 1 32 3 offset fixed bin(35), 1 33 3 size fixed bin(24), 1 34 2 current_line, 1 35 3 loc ptr, 1 36 3 column fixed bin, 1 37 3 size fixed bin, 1 38 3 length fixed bin, 1 39 3 offset fixed bin(35), 1 40 2 next_line, 1 41 3 loc ptr, 1 42 3 column fixed bin, 1 43 3 size fixed bin, 1 44 3 length fixed bin, 1 45 3 offset fixed bin(35), 1 46 2 alloc, 1 47 3 parity fixed bin, 1 48 3 ptr1 ptr, 1 49 3 ptr2 ptr, 1 50 3 cap1 fixed bin, 1 51 3 cap2 fixed bin, 1 52 2 error fixed bin, 1 53 2 pseudo_text fixed bin, 1 54 2 indicators, 1 55 3 copy_replace bit(1), 1 56 3 lc bit(1), 1 57 3 filler bit(7), 1 58 2 environment, 1 59 3 ecs_ptr ptr, 1 60 3 mem_tab_ptr ptr, 1 61 3 x_ptr ptr; 1 62 1 63 /* 1 64* token 1 65* 1 66* line line on which lexeme begins 1 67* column column in which lexeme begins 1 68* type lexeme type 1 69* 1: space token 1 70* 2: literal 1 71* 3: word 1 72* 4: separator 1 73* 5: comment entry 1 74* 6: pseudo-text 1 75* offset postiion of lexeme in source file 1 76* span size of lexeme in source file 1 77* string_size size (characters) of lexeme 1 78* only if type = 2, 3, 4 1 79* string_cap maximum size for lexeme string 1 80* string_ptr pointer to lexeme string 1 81* string the string of characters comprising the lexeme, 1 82* valid only string_size <= 32 & (type = 3 | type = 4) 1 83* col_7 contents of column 7 1 84* 1 85* source_table 1 86* 1 87* line current line number 1 88* loc pointer to source table 1 89* offset position of next line 1 90* size size of table 1 91* 1 92* current_line 1 93* next_line 1 94* 1 95* loc pointer to line 1 96* null() if no line 1 97* column current column number 1 98* size size of reduced line 1 99* terminal blanks and LF not counted 1 100* 1,...,7 if blank line 1 101* length actual size of line 1 102* normally ends in LF 1 103* 0 if EOF 1 104* offset offset of line in source file 1 105* 1 106* alloc 1 107* 1 108* parity 0 or 1 1 109* ptr1 location of table 1 1 110* ptr2 location of table 2 1 111* cap1 capacity of table 1 1 112* cap2 capacity of table 2 1 113* 1 114* error error status 1 115* 0 no error 1 116* 1 end of token stream 1 117* 2 set: data not in expected format 1 118* 1 119* pseudo_text status for pseudo_text parsing 1 120* 1 121* indicators 1 122* 1 123* copy_replace "1"b if copy/replace statement being parsed 1 124* lc "0"b if no conversion to lower case desired 1 125**/ 1 126 1 127 /* END INCLUDE FILE ... cobol_lexeme_env.incl.pl1 */ 1 128 1606 2 1 /* BEGIN INCLUDE FILE ... cobol_ecs_info.incl.pl1 */ 2 2 /* Modified on 10/09/79 by FCH, [4.0-2], new field added */ 2 3 /* Modified on 03/02/79 by FCH, [4.0-1], -levsv option */ 2 4 /* Modified on 10/27/81 by FCH, [5.1-1], new fields added */ 2 5 2 6 dcl ecs_info_ptr ptr; 2 7 2 8 dcl 2 9 2 10 1 ecs_info_table_ based (ecs_info_ptr), 2 11 2 12 2 expand_cobol_source_info, 2 13 3 input_ptr ptr, 2 14 3 output_ptr ptr, 2 15 3 format_indicator bit (1), 2 16 3 card_indicator bit(1), /*[4.0-2]*/ 2 17 3 exp_indicator bit(1), /*[4.0-2]*/ 2 18 3 command bit(1), /*[5.1-1]*/ 2 19 3 dir char(168), /*[4.0-2]*/ 2 20 3 ent char(32), /*[4.0-2]*/ 2 21 2 22 2 compiler_info, 2 23 3 compiler_level char (1), 2 24 3 diag_indicators bit (3), 2 25 3 levsv bit(3), /*[4.0-1]*/ 2 26 3 fatal_count fixed bin, 2 27 3 bc fixed bin(24); /*[5.1-1]*/ 2 28 2 29 /* END INCLUDE FILE ... cobol_ecs_info.incl.pl1 */ 1607 1608 end cobol_expand_source_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0836.9 cobol_expand_source_.pl1 >spec>install>MR12.3-1048>cobol_expand_source_.pl1 1606 1 03/27/82 0439.4 cobol_lexeme_env.incl.pl1 >ldd>include>cobol_lexeme_env.incl.pl1 1607 2 11/11/82 1712.8 cobol_ecs_info.incl.pl1 >ldd>include>cobol_ecs_info.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. CR_LOC 000577 automatic fixed bin(17,0) dcl 1555 set ref 958* 962 966 967 SIZE 000576 automatic fixed bin(17,0) dcl 1555 set ref 952* 958 962 967* 967 968 STR based char packed unaligned dcl 1478 set ref 958 968* STR_ARRAY based char(1) array packed unaligned dcl 1479 set ref 966 STR_PTR 000600 automatic pointer dcl 1555 set ref 951* 958 966* 966 968 TABLE_PTR 000102 automatic pointer dcl 991 set ref 998* 1003 1003 1005 1006 1008 1014* 1019 1019 1021 1022 1024 TABLE_SIZE 000100 automatic fixed bin(17,0) dcl 990 set ref 994* 998 1006 1014 1022 1030 TT_0 based fixed bin(35,0) array dcl 1042 in procedure "T_free" ref 1046 TT_0 based fixed bin(35,0) array dcl 988 in procedure "T_alloc" set ref 1003 1006 1014 1019* TT_1 based fixed bin(35,0) array dcl 1043 in procedure "T_free" ref 1048 TT_1 based fixed bin(35,0) array dcl 989 in procedure "T_alloc" set ref 998 1003* 1019 1022 TT_a based structure level 1 unaligned dcl 1036 in procedure "T_free" TT_a based structure level 1 unaligned dcl 982 in procedure "T_alloc" TT_ptr parameter pointer dcl 991 in procedure "T_alloc" ref 979 994 994 996 1002 1005 1008 1010 1018 1021 1024 1026 1030 TT_ptr parameter pointer dcl 1044 in procedure "T_free" ref 1033 1046 1046 1046 1048 1048 addr builtin function dcl 1460 ref 119 119 161 161 164 164 168 168 434 434 603 603 760 760 806 806 951 966 1075 1075 1076 1076 1077 1077 1249 1249 aword 000303 automatic char(265) packed unaligned dcl 1471 set ref 1257* 1258* 1314 base_offset 000564 automatic fixed bin(17,0) dcl 1547 set ref 1127* 1165 1172 1391 1392 1412* bc parameter fixed bin(24,0) dcl 1524 set ref 41 60* 194* 202 225* c2 000712 automatic char(2) packed unaligned dcl 528 set ref 623* 625 627 cap 3 based fixed bin(17,0) level 2 in structure "TT_a" dcl 982 in procedure "T_alloc" set ref 994 1002 1018 1030* cap 3 based fixed bin(17,0) level 2 in structure "TT_a" dcl 1036 in procedure "T_free" ref 1046 1048 char10 000506 automatic char(10) packed unaligned dcl 1482 set ref 150* 152* 946 chr 000112 automatic char(1) packed unaligned dcl 1190 set ref 1233* 1235 1235 cobol_lexeme$close 000020 constant entry external dcl 1-6 ref 1074 cobol_lexeme$cobol_lexeme 000036 constant entry external dcl 1-13 ref 92 99 1090 cobol_lexeme$envinit 000014 constant entry external dcl 1514 ref 378 cobol_lexeme$find_copy 000024 constant entry external dcl 1-8 ref 219 cobol_lexeme$find_pseudo_text 000030 constant entry external dcl 1-10 ref 536 cobol_lexeme$find_replace 000026 constant entry external dcl 1-9 ref 54 cobol_lexeme$open 000016 constant entry external dcl 1-5 ref 174 cobol_lexeme$set 000022 constant entry external dcl 1-7 ref 189 cobol_lexeme$text_word 000032 constant entry external dcl 1-11 ref 1088 1192 cobol_lexeme$token 000034 constant entry external dcl 1-12 ref 1086 code 000556 automatic fixed bin(35,0) dcl 1541 set ref 369* 381 col_7 23 based char(1) level 3 packed packed unaligned dcl 1-15 ref 247 247 column 1 based fixed bin(17,0) level 3 dcl 1-15 ref 69 234 925 939 comma_sw 000542 automatic fixed bin(17,0) dcl 1530 set ref 86* 410* 627* 1235 command 4(03) based bit(1) level 3 in structure "ecs_info_table_" packed packed unaligned dcl 2-8 in procedure "cobol_expand_source_" ref 150 968 command parameter bit(1) packed unaligned dcl 1503 in procedure "cobol_expand_source_" ref 41 202 comp_len 0(18) based fixed bin(17,0) array level 2 packed packed unaligned dcl 1568 set ref 609* 752* 800* 804 1336 1336 1348 comp_start based fixed bin(17,0) array level 2 packed packed unaligned dcl 1568 set ref 595* 750* 799* 1336 comp_str_used 000550 automatic fixed bin(17,0) initial dcl 1535 set ref 85* 412* 595 601 608 610* 610 750 758 764 765* 765 799 804 810 812* 812 1056* 1535* compare_string based char dcl 1566 set ref 608* 764* 810* 1063* 1336 copy_line_length 000536 automatic fixed bin(17,0) dcl 1526 set ref 68* 233* 895 copy_line_ptr 000526 automatic pointer dcl 1497 set ref 71* 235* 895 copy_replace 60 based bit(1) level 3 packed packed unaligned dcl 1-15 set ref 88* 138* 270* 471* cr_cap 3 000616 automatic fixed bin(17,0) initial level 2 dcl 1597 set ref 120 162 435 1597* cr_control 000616 automatic structure level 1 unaligned dcl 1597 set ref 119 119 161 161 434 434 1076 1076 cr_incr 4 000616 automatic fixed bin(17,0) initial level 2 dcl 1597 set ref 1597* cr_largest 000541 automatic fixed bin(17,0) dcl 1529 set ref 86* 411* 612 612* 771 771* 814 814* 1102 1125 1212 1348 cr_max 000552 automatic fixed bin(17,0) dcl 1537 set ref 116 120* 162* 431 435* 1058 cr_parity 2 000616 automatic fixed bin(17,0) initial level 2 dcl 1597 set ref 1597* cr_ptr 000616 automatic pointer level 2 dcl 1597 set ref 545 546 595 609 657 658 677 691 709 717 733 747 750 752 787 788 799 800 804 1059 1336 1336 1336 1348 1401 1401 1401 1408 cr_table based structure array level 1 dcl 1568 set ref 1059* cr_used 000540 automatic fixed bin(17,0) dcl 1528 set ref 86* 116 122* 122 411* 431 438* 438 454* 454 545 546 595 609 625 627 657 658 677 687* 687 691 709 717 733 747 750 752 787 788 799 800 804 1055* 1332 cs_cap 3 000602 automatic fixed bin(17,0) initial level 2 dcl 1583 set ref 170 604 761 807 1583* cs_control 000602 automatic structure level 1 unaligned dcl 1583 set ref 168 168 603 603 760 760 806 806 1075 1075 cs_incr 4 000602 automatic fixed bin(17,0) initial level 2 dcl 1583 set ref 1583* cs_max 000555 automatic fixed bin(17,0) dcl 1540 set ref 170* 601 604* 608 758 761* 764 804 807* 810 1062 1063 1336 cs_parity 2 000602 automatic fixed bin(17,0) initial level 2 dcl 1583 set ref 1583* cs_ptr 000602 automatic pointer level 2 dcl 1583 set ref 608 764 810 1063 1336 current_line 32 based structure level 2 unaligned dcl 1-15 ecs_info_ptr parameter pointer dcl 2-6 ref 41 150 177 178 202 942 968 ecs_info_table_ based structure level 1 unaligned dcl 2-8 ecs_ptr 62 based pointer level 3 dcl 1-15 set ref 176* 332* entry parameter char(9) packed unaligned dcl 1084 ref 1081 1086 1088 environment 62 based structure level 2 unaligned dcl 1-15 error 56 based fixed bin(17,0) level 2 dcl 1-15 set ref 53* 55 94 100 126 187* 191 217* 221 334* 538 584 1092 1195 error_msg 000776 automatic char(40) initial array packed unaligned dcl 1442 set ref 1442* 1442* 1442* 1442* 1442* 1442* 1448* error_no parameter fixed bin(17,0) dcl 1441 ref 1438 1448 expand_cobol_source$find_incl_file 000012 constant entry external dcl 1511 ref 369 expand_cobol_source_area based area(1024) dcl 1520 ref 172 330 998 1014 expand_cobol_source_area_ptr parameter pointer dcl 1490 ref 41 172 176 202 330 332 998 1014 expand_cobol_source_info based structure level 2 unaligned dcl 2-8 fill_last_ln 000533 automatic bit(1) packed unaligned dcl 1505 set ref 156* 851 877 887 887* 930* 934* fill_sw 000532 automatic bit(1) packed unaligned dcl 1504 set ref 895* 897* 904 915 first_time parameter bit(1) packed unaligned dcl 992 ref 979 1000 1016 format_indicator 4 based bit(1) level 3 packed packed unaligned dcl 2-8 ref 942 i 000546 automatic fixed bin(17,0) dcl 1534 set ref 1002* 1003 1003* 1018* 1019 1019* 1058* 1059 1059 1059 1059* 1062* 1063* 1332* 1334* 1351 1367* 1371* 1372 1385 1391 1410 1410 1420* 1421 1421 1421* ii 000126 automatic fixed bin(17,0) dcl 1325 set ref 1327* 1332 1351* incr 4 based fixed bin(17,0) level 2 dcl 982 ref 994 index builtin function dcl 1461 ref 958 1336 indicators 60 based structure level 2 packed packed unaligned dcl 1-15 input_ptr based pointer level 3 dcl 2-8 ref 177 insert_space_span 000560 automatic fixed bin(17,0) dcl 1543 set ref 155* 854 854 855 883 883 886 939* ioa_ 000010 constant entry external dcl 1510 ref 1448 j 000547 automatic fixed bin(17,0) dcl 1534 set ref 1215* 1216 1216 1216* 1271* 1272* 1291* 1293 1293* 1369* 1371* last_char_nl 000545 automatic fixed bin(24,0) dcl 1532 set ref 208* last_copy_line 000557 automatic fixed bin(17,0) dcl 1542 set ref 155* 877 938* last_source_offset 000563 automatic fixed bin(35,0) dcl 1546 set ref 107* 154* 858 861 879 881 904 906 912 929* 935* 1385 1386 1410* lbs_length 000566 automatic fixed bin(17,0) dcl 1549 set ref 1124* 1199* 1219* 1267 1289* 1289 1313* 1313 1336 1366 1424* lbs_size 000565 automatic fixed bin(17,0) dcl 1548 set ref 1125* 1267 1275 1307 1307 1314 1366 lbs_sum 000567 automatic fixed bin(17,0) dcl 1550 set ref 1124* 1199* 1269* 1272* 1272 1275* 1275 1281 1288 1366* 1369 1372* 1372 lbw_cap 3 000610 automatic fixed bin(17,0) initial level 2 dcl 1590 set ref 166 1250 1590* lbw_control 000610 automatic structure level 1 unaligned dcl 1590 set ref 164 164 1077 1077 1249 1249 lbw_incr 4 000610 automatic fixed bin(17,0) initial level 2 dcl 1590 set ref 1590* lbw_length based fixed bin(17,0) array level 2 packed packed unaligned dcl 1576 set ref 1254* 1272 1288 1288 1289 1372 lbw_max 000553 automatic fixed bin(17,0) dcl 1538 set ref 166* 1199 1215 1244 1250* 1420 lbw_offset 0(18) based fixed bin(35,0) array level 2 packed packed unaligned dcl 1576 set ref 1255* 1385 1391 1410 1412 lbw_parity 2 000610 automatic fixed bin(17,0) initial level 2 dcl 1590 set ref 1590* lbw_ptr 000610 automatic pointer level 2 dcl 1590 set ref 1199 1216 1254 1255 1256 1272 1288 1288 1289 1293 1293 1372 1385 1391 1410 1410 1412 1412 1421 lbw_span 1(18) based fixed bin(17,0) array level 2 packed packed unaligned dcl 1576 set ref 1256* 1410 1412 lbw_table based structure array level 1 dcl 1576 set ref 1199* 1216* 1293* 1293 1421* lbw_used 000554 automatic fixed bin(17,0) dcl 1539 set ref 1124* 1219* 1244 1253* 1253 1254 1255 1256 1271 1291 1296* 1296 1369 1412 1412 1424* lc 60(01) based bit(1) level 3 packed packed unaligned dcl 1-15 set ref 316* 318* 356* 360* length 36 based fixed bin(17,0) level 3 in structure "lexeme_env" dcl 1-15 in procedure "cobol_expand_source_" ref 68 233 925 length builtin function dcl 1459 in procedure "cobol_expand_source_" ref 369 369 369 369 594 751 lexeme_env based structure level 1 unaligned dcl 1-15 set ref 172 330 384 1072 1179 lexeme_ptr 000512 automatic pointer dcl 1492 set ref 53 54* 55 67 68 69 70 71 83 88 89 92* 94 96 96 99* 100 103 103 107 111 111 114 126 126 126 138 172* 174* 176 179 185* 187 191 217 219* 221 232 233 234 235 236 247 247 252 260 260 270 271 286 286 316 318 324 324 330* 332 333 338* 347 347 356 360 363 363 425 451 471 513 513 516 518 536* 538 545 546 561 561 561 561 569 569 573 573 578 578 580 580 584 657 658 658 664 664 674 674 674 674 677 677 679 679 683 691 691 693 693 706 706 709 709 715 715 717 717 720 720 724 724 724 733 733 787 788 800 810 810 810 812 814 814 875 877 925 925 929 935 938 939 1071* 1072 1086* 1088* 1090* 1092 1117* 1179 1180* 1192* 1195 1195 1195 1210 1233 1254 1255 1256 1258 1448 lib_file based char(1048576) packed unaligned dcl 1483 ref 836 1172 1392 lib_file_ptr 000520 automatic pointer dcl 1495 set ref 388* 836 1172 1392 lib_name 000201 automatic varying char(128) dcl 1467 set ref 324* 369 369 369 369 library_string 000100 automatic char packed unaligned dcl 1102 set ref 1126* 1198* 1220* 1288* 1307* 1307 1314* 1336 1418* line based fixed bin(17,0) level 3 dcl 1-15 set ref 67 232 877 938 1448* loc 26 based pointer level 3 in structure "lexeme_env" dcl 1-15 in procedure "cobol_expand_source_" set ref 186* 369* 388 loc based pointer level 2 in structure "TT_a" dcl 1036 in procedure "T_free" ref 1046 1048 loc 32 based pointer level 3 in structure "lexeme_env" dcl 1-15 in procedure "cobol_expand_source_" ref 71 235 loc based pointer level 2 in structure "TT_a" dcl 982 in procedure "T_alloc" set ref 1005* 1008* 1021* 1024* matched_word_pos 000572 automatic fixed bin(17,0) dcl 1553 set ref 1135* 1145 1329* 1332 1336* 1348 1348 1369 mem_tab_ptr 64 based pointer level 3 dcl 1-15 set ref 335* 335 mode parameter char(1) packed unaligned dcl 780 in procedure "literal" ref 777 782 mode parameter char(1) packed unaligned dcl 527 in procedure "pseudo_text" ref 524 533 mode parameter char(1) packed unaligned dcl 501 in procedure "subst_word" set ref 498 513* 516* 518* mode parameter char(1) packed unaligned dcl 647 in procedure "ident" ref 644 654 677 691 709 717 733 747 move_span 000571 automatic fixed bin(17,0) dcl 1552 set ref 1165* 1172 1172 1173 1385* 1386 1386 1391* 1392 1392 1400 new_array based char(1) array packed unaligned dcl 1476 set ref 951 new_file based char(1048576) packed unaligned dcl 1474 set ref 836* 854* 861* 883* 912* 918* 946* 1172* 1386* 1392* 1401* new_file_ptr 000516 automatic pointer dcl 1494 set ref 178* 836 854 861 883 912 918 946 951 1172 1386 1392 1401 new_line_character 000511 automatic char(1) initial packed unaligned dcl 1484 set ref 918 1484* next_new_position 000537 automatic fixed bin(35,0) dcl 1527 set ref 60 154* 194 225 836 839* 839 854 855* 855 861 862* 862 883 886* 886 912 913* 913 918 919* 919 946 951 972* 972 1172 1173* 1173 1386 1392 1400* 1400 1401 1408* 1408 offset 3 based fixed bin(35,0) level 3 dcl 1-15 ref 70 83 107 236 252 545 657 658 677 691 709 717 733 787 875 929 935 1255 old_file based char(1048576) packed unaligned dcl 1473 ref 861 881 912 946 1386 1401 old_file_ptr 000514 automatic pointer dcl 1493 set ref 177* 186 189* 369* 861 881 912 946 1386 1401 output_ptr 2 based pointer level 3 dcl 2-8 ref 178 p1 000522 automatic pointer dcl 1496 set ref 179* 185 186 189* 335 336 338 858 1071 1074* 1180 p2 000524 automatic pointer dcl 1496 set ref 333* 334 335 336 369 378* 384 388 835 1117 1165 parity 2 based fixed bin(17,0) level 2 in structure "TT_a" dcl 1036 in procedure "T_free" ref 1046 parity 2 based fixed bin(17,0) level 2 in structure "TT_a" dcl 982 in procedure "T_alloc" set ref 996 1010* 1026* pseudo_text 57 based fixed bin(17,0) level 2 dcl 1-15 set ref 89* 271* qual_name 000242 automatic varying char(128) dcl 1467 set ref 347* 363* 369 369 369 369 398 read_more_text 000530 automatic bit(1) packed unaligned dcl 1501 set ref 1131* 1133 1200* repl_offset 1 based fixed bin(35,0) array level 2 packed packed unaligned dcl 1568 set ref 545* 657* 658 677 691 709 717 733 787* 1401 repl_span 2 based fixed bin(35,0) array level 2 packed packed unaligned dcl 1568 set ref 546* 747* 788* 1401 1401 1408 replace_active 000531 automatic bit(1) packed unaligned dcl 1502 set ref 66* 157* 1092 1108 1152 1155* 1195 1382 1410 replacement_span 000722 automatic fixed bin(17,0) dcl 648 set ref 658* 677* 691* 709* 717* 733* 747 save_copy_column 000561 automatic fixed bin(17,0) dcl 1544 set ref 69* 234* 895 895 906 save_copy_line 000535 automatic fixed bin(17,0) dcl 1525 set ref 67* 232* save_source_offset 000562 automatic fixed bin(17,0) dcl 1545 set ref 70* 236* 879 904 906 semi_sw 000543 automatic fixed bin(17,0) dcl 1531 set ref 86* 410* 625* 1235 size 31 based fixed bin(24,0) level 3 dcl 1-15 ref 835 858 1165 source_line based char packed unaligned dcl 1469 ref 895 source_table 24 based structure level 2 unaligned dcl 1-15 spaces 000406 automatic char(254) initial packed unaligned dcl 1472 set ref 854 881 883 895 1126 1198 1220 1288 1418 1472* span 000544 automatic fixed bin(24,0) dcl 1532 in procedure "cobol_expand_source_" set ref 835* 836 836 839 858* 861 861 862 879* 881 881 904* 906* 908 912 912 913 span 4 based fixed bin(17,0) level 3 in structure "lexeme_env" dcl 1-15 in procedure "cobol_expand_source_" ref 546 658 677 691 709 717 733 788 1256 spec_index 000573 automatic fixed bin(17,0) dcl 1554 set ref 1135* 1334* 1336 1336 1336 1348 1401 1401 1401 1408 state_pos 000575 automatic fixed bin(17,0) dcl 1555 set ref 83* 252* 875 946 state_span 000574 automatic fixed bin(17,0) dcl 1555 set ref 875* 946 946 952 972 string 12 based varying char(32) level 3 dcl 1-15 ref 96 103 114 126 260 286 347 347 425 451 724 724 724 1195 string_ptr 10 based pointer level 3 dcl 1-15 ref 111 324 363 513 561 561 569 573 578 580 664 674 674 679 693 706 715 720 810 1233 1258 string_size 5 based fixed bin(35,0) level 3 dcl 1-15 ref 111 324 363 513 561 561 569 573 578 580 664 674 674 679 693 706 715 720 800 810 810 812 814 814 1210 1254 substr builtin function dcl 1458 set ref 111 324 363 369 369 369 369 513 561 561 569 573 578 580 608* 623 664 674 674 679 693 706 715 720 764* 810* 810 836* 836 854* 854 861* 861 881 881 883* 883 895 895 912* 912 918* 946* 946 968* 1063* 1172* 1172 1233 1257* 1258* 1258 1288* 1288 1307* 1307 1314* 1314 1336 1386* 1386 1392* 1392 1401* 1401 text_string 000100 automatic varying char(256) dcl 1466 set ref 531* 569* 573* 580* 580 594 608 623 663* 664* 664 679* 679 693* 693 711* 711 720* 720 735* 735 751 764 text_string_length 000551 automatic fixed bin(17,0) dcl 1536 set ref 594* 601 608 609 610 612 612 620 751* 752 758 764 765 771 771 token based structure level 2 unaligned dcl 1-15 type 2 based fixed bin(17,0) level 3 dcl 1-15 ref 96 103 126 260 286 516 518 683 1195 valid_lib 000534 automatic bit(1) packed unaligned dcl 1506 set ref 278 294 383* 387* word based char(32) packed unaligned dcl 1470 ref 111 324 363 513 561 561 569 573 578 580 664 674 674 679 693 706 715 720 810 1233 1258 word_length 000570 automatic fixed bin(17,0) dcl 1551 set ref 1210* 1212 1230 1258 1258 1259* 1259 1267 1281 1307 1307 1313 1314 1314 1314 x_ptr 66 based pointer level 3 dcl 1-15 set ref 336* 336 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ecs_info_table automatic structure level 1 dcl 1454 source_line based char packed unaligned dcl 1446 NAMES DECLARED BY EXPLICIT CONTEXT. MC 003377 constant label dcl 972 ref 962 T_alloc 003407 constant entry internal dcl 979 ref 119 161 164 168 434 603 760 806 1249 T_free 003564 constant entry internal dcl 1033 ref 1075 1076 1077 build_library_string 004112 constant entry internal dcl 1187 ref 1129 1148 clear_copy 003601 constant entry internal dcl 1052 ref 48 210 1185 cobol_expand_source_ 000166 constant entry external dcl 37 compare_text 004475 constant entry internal dcl 1322 ref 1137 copy 000276 constant entry external dcl 202 copy_error 005037 constant entry internal dcl 1438 ref 685 727 cpr_error 000306 constant label dcl 210 ref 260 278 286 286 294 455 518 538 584 688 728 1092 finish 003657 constant entry internal dcl 1068 ref 61 195 226 get_lib_name 001104 constant entry internal dcl 309 ref 254 get_next_lexeme 003710 constant entry internal dcl 1081 ref 129 317 345 358 398 419 458 559 571 581 638 667 681 695 713 722 737 822 ident 002010 constant entry internal dcl 644 ref 516 init 000601 constant entry internal dcl 142 ref 44 205 left_spec 001432 constant entry internal dcl 475 ref 445 literal 002627 constant entry internal dcl 777 ref 518 merge_library 002774 constant entry internal dcl 826 ref 294 merge_to_copy 003065 constant entry internal dcl 866 ref 106 135 833 1111 merge_to_end 003017 constant entry internal dcl 844 ref 59 224 next_replace 000227 constant label dcl 55 ref 1156 process_copy_statement 001026 constant entry internal dcl 244 ref 238 process_replace_statement 000366 constant entry internal dcl 79 ref 73 pseudo_text 001511 constant entry internal dcl 524 ref 124 131 513 read_next_word 004113 constant label dcl 1192 ref 1221 1235 rep_spec 001333 constant entry internal dcl 403 ref 272 replace 000202 constant entry external dcl 41 replace_err 000211 constant label dcl 48 ref 1095 replace_process 003763 constant entry internal dcl 1099 ref 136 278 replace_text 004571 constant entry internal dcl 1358 ref 1145 right_spec 001440 constant entry internal dcl 487 ref 465 start 000312 constant label dcl 217 start_compare 004500 constant label dcl 1329 ref 1352 subst_word 001446 constant entry internal dcl 498 ref 482 494 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 5450 5510 5242 5460 Length 5750 5242 40 223 205 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_expand_source_ 752 external procedure is an external procedure. process_replace_statement internal procedure shares stack frame of external procedure cobol_expand_source_. init internal procedure shares stack frame of external procedure cobol_expand_source_. process_copy_statement internal procedure shares stack frame of external procedure cobol_expand_source_. get_lib_name internal procedure shares stack frame of external procedure cobol_expand_source_. rep_spec internal procedure shares stack frame of external procedure cobol_expand_source_. left_spec internal procedure shares stack frame of external procedure cobol_expand_source_. right_spec internal procedure shares stack frame of external procedure cobol_expand_source_. subst_word internal procedure shares stack frame of external procedure cobol_expand_source_. pseudo_text internal procedure shares stack frame of external procedure cobol_expand_source_. ident internal procedure shares stack frame of external procedure cobol_expand_source_. literal internal procedure shares stack frame of external procedure cobol_expand_source_. merge_library internal procedure shares stack frame of external procedure cobol_expand_source_. merge_to_end internal procedure shares stack frame of external procedure cobol_expand_source_. merge_to_copy 67 internal procedure is called by several nonquick procedures. T_alloc 70 internal procedure is called by several nonquick procedures. T_free internal procedure shares stack frame of external procedure cobol_expand_source_. clear_copy 67 internal procedure is called by several nonquick procedures. finish internal procedure shares stack frame of external procedure cobol_expand_source_. get_next_lexeme internal procedure shares stack frame of external procedure cobol_expand_source_. replace_process 117 internal procedure uses auto adjustable storage. build_library_string internal procedure shares stack frame of internal procedure replace_process. compare_text internal procedure shares stack frame of internal procedure replace_process. replace_text internal procedure shares stack frame of internal procedure replace_process. copy_error internal procedure shares stack frame of external procedure cobol_expand_source_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME T_alloc 000100 TABLE_SIZE T_alloc 000102 TABLE_PTR T_alloc cobol_expand_source_ 000100 text_string cobol_expand_source_ 000201 lib_name cobol_expand_source_ 000242 qual_name cobol_expand_source_ 000303 aword cobol_expand_source_ 000406 spaces cobol_expand_source_ 000506 char10 cobol_expand_source_ 000511 new_line_character cobol_expand_source_ 000512 lexeme_ptr cobol_expand_source_ 000514 old_file_ptr cobol_expand_source_ 000516 new_file_ptr cobol_expand_source_ 000520 lib_file_ptr cobol_expand_source_ 000522 p1 cobol_expand_source_ 000524 p2 cobol_expand_source_ 000526 copy_line_ptr cobol_expand_source_ 000530 read_more_text cobol_expand_source_ 000531 replace_active cobol_expand_source_ 000532 fill_sw cobol_expand_source_ 000533 fill_last_ln cobol_expand_source_ 000534 valid_lib cobol_expand_source_ 000535 save_copy_line cobol_expand_source_ 000536 copy_line_length cobol_expand_source_ 000537 next_new_position cobol_expand_source_ 000540 cr_used cobol_expand_source_ 000541 cr_largest cobol_expand_source_ 000542 comma_sw cobol_expand_source_ 000543 semi_sw cobol_expand_source_ 000544 span cobol_expand_source_ 000545 last_char_nl cobol_expand_source_ 000546 i cobol_expand_source_ 000547 j cobol_expand_source_ 000550 comp_str_used cobol_expand_source_ 000551 text_string_length cobol_expand_source_ 000552 cr_max cobol_expand_source_ 000553 lbw_max cobol_expand_source_ 000554 lbw_used cobol_expand_source_ 000555 cs_max cobol_expand_source_ 000556 code cobol_expand_source_ 000557 last_copy_line cobol_expand_source_ 000560 insert_space_span cobol_expand_source_ 000561 save_copy_column cobol_expand_source_ 000562 save_source_offset cobol_expand_source_ 000563 last_source_offset cobol_expand_source_ 000564 base_offset cobol_expand_source_ 000565 lbs_size cobol_expand_source_ 000566 lbs_length cobol_expand_source_ 000567 lbs_sum cobol_expand_source_ 000570 word_length cobol_expand_source_ 000571 move_span cobol_expand_source_ 000572 matched_word_pos cobol_expand_source_ 000573 spec_index cobol_expand_source_ 000574 state_span cobol_expand_source_ 000575 state_pos cobol_expand_source_ 000576 SIZE cobol_expand_source_ 000577 CR_LOC cobol_expand_source_ 000600 STR_PTR cobol_expand_source_ 000602 cs_control cobol_expand_source_ 000610 lbw_control cobol_expand_source_ 000616 cr_control cobol_expand_source_ 000712 c2 pseudo_text 000722 replacement_span ident 000776 error_msg copy_error replace_process 000100 library_string replace_process 000112 chr build_library_string 000126 ii compare_text THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out call_int_this call_int_other return_mac tra_ext_1 alloc_auto_adj mpfx2 shorten_stack ext_entry int_entry trunc_fx2 set_chars_eis index_chars_eis divide_fx1 op_alloc_ op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cobol_lexeme$close cobol_lexeme$cobol_lexeme cobol_lexeme$envinit cobol_lexeme$find_copy cobol_lexeme$find_pseudo_text cobol_lexeme$find_replace cobol_lexeme$open cobol_lexeme$set cobol_lexeme$text_word cobol_lexeme$token expand_cobol_source$find_incl_file ioa_ NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1472 000133 1484 000136 1535 000140 1583 000142 1590 000147 1597 000155 37 000165 41 000174 44 000210 48 000211 51 000215 53 000216 54 000220 55 000227 59 000233 60 000234 61 000247 62 000250 66 000251 67 000253 68 000255 69 000257 70 000261 71 000267 73 000271 77 000272 202 000273 205 000304 208 000305 210 000306 217 000312 219 000314 221 000323 224 000327 225 000330 226 000343 227 000344 232 000345 233 000347 234 000351 235 000353 236 000355 238 000363 242 000364 1608 000365 79 000366 83 000367 85 000372 86 000374 88 000400 89 000402 92 000403 94 000412 96 000417 99 000427 100 000436 103 000443 106 000453 107 000457 108 000464 111 000465 114 000474 116 000502 119 000506 120 000522 122 000531 124 000532 126 000536 129 000553 131 000560 133 000564 135 000565 136 000571 138 000575 140 000600 142 000601 150 000602 152 000616 154 000621 155 000624 156 000626 157 000627 161 000630 162 000644 164 000653 166 000667 168 000676 170 000712 172 000715 174 000724 176 000733 177 000740 178 000744 179 000750 185 000752 186 000754 187 000757 189 000761 191 001005 194 001010 195 001023 197 001024 200 001025 244 001026 247 001027 252 001040 254 001042 260 001043 270 001054 271 001056 272 001060 278 001061 282 001067 286 001070 294 001077 299 001102 307 001103 309 001104 316 001105 317 001110 318 001115 324 001120 330 001131 332 001140 333 001144 334 001146 335 001150 336 001153 338 001157 345 001161 347 001166 356 001203 358 001205 360 001212 363 001215 369 001226 378 001275 381 001305 383 001307 384 001310 385 001312 387 001313 388 001315 398 001320 401 001332 403 001333 410 001334 411 001336 412 001340 419 001342 425 001347 431 001356 434 001362 435 001376 438 001405 445 001406 451 001407 454 001415 455 001417 458 001420 465 001425 469 001426 471 001427 473 001431 475 001432 482 001433 484 001437 487 001440 494 001441 496 001445 498 001446 513 001450 516 001466 518 001500 522 001510 524 001511 531 001513 533 001514 536 001521 538 001530 545 001534 546 001542 547 001544 559 001545 561 001553 569 001566 571 001607 573 001615 578 001625 580 001635 581 001671 584 001677 587 001702 594 001703 595 001705 601 001715 603 001722 604 001736 606 001741 608 001742 609 001751 610 001760 612 001761 620 001764 623 001766 625 001771 627 001776 638 002002 640 002007 644 002010 654 002012 657 002017 658 002026 659 002035 663 002036 664 002037 665 002075 667 002076 674 002103 677 002117 679 002141 681 002175 683 002203 685 002207 687 002213 688 002215 691 002216 693 002240 695 002275 697 002303 706 002304 709 002310 711 002332 713 002344 715 002351 717 002361 720 002403 722 002437 724 002445 727 002465 728 002471 731 002472 733 002473 735 002515 737 002527 747 002534 750 002551 751 002561 752 002563 758 002565 760 002572 761 002606 762 002611 764 002612 765 002621 771 002623 775 002626 777 002627 782 002631 787 002636 788 002645 789 002647 799 002650 800 002660 804 002666 806 002677 807 002713 808 002716 810 002717 812 002746 814 002754 822 002766 824 002773 826 002774 833 002775 835 003001 836 003004 839 003012 841 003016 844 003017 851 003020 854 003022 855 003030 858 003034 861 003044 862 003057 864 003063 866 003064 875 003072 877 003103 879 003110 881 003117 883 003126 886 003134 887 003140 895 003143 897 003160 904 003162 906 003173 908 003207 912 003210 913 003223 915 003227 918 003231 919 003235 925 003241 929 003246 930 003252 931 003254 934 003255 935 003256 938 003262 939 003264 942 003266 946 003274 951 003332 952 003337 958 003342 962 003356 966 003360 967 003363 968 003365 970 003376 972 003377 977 003405 979 003406 994 003414 996 003422 998 003424 1000 003434 1002 003442 1003 003456 1004 003462 1005 003464 1006 003470 1007 003472 1008 003473 1010 003475 1012 003502 1014 003503 1016 003513 1018 003521 1019 003534 1020 003540 1021 003542 1022 003546 1023 003550 1024 003551 1026 003553 1030 003557 1031 003563 1033 003564 1046 003566 1048 003575 1050 003577 1052 003600 1055 003606 1056 003610 1058 003612 1059 003622 1060 003636 1062 003640 1063 003650 1064 003654 1066 003656 1068 003657 1071 003660 1072 003662 1074 003664 1075 003673 1076 003677 1077 003703 1079 003707 1081 003710 1086 003712 1088 003727 1090 003743 1092 003752 1095 003760 1097 003761 1099 003762 1102 003770 1108 004000 1111 004002 1117 004007 1124 004013 1125 004017 1126 004021 1127 004026 1129 004030 1131 004031 1133 004034 1135 004037 1137 004041 1145 004042 1148 004046 1150 004047 1152 004050 1155 004052 1156 004053 1165 004056 1172 004063 1173 004072 1179 004076 1180 004100 1185 004104 1429 004111 1187 004112 1192 004113 1195 004123 1198 004142 1199 004147 1200 004200 1202 004201 1210 004202 1212 004204 1215 004207 1216 004220 1217 004236 1219 004240 1220 004242 1221 004247 1230 004250 1233 004253 1235 004260 1244 004273 1249 004277 1250 004314 1253 004324 1254 004325 1255 004340 1256 004345 1257 004350 1258 004352 1259 004357 1267 004360 1269 004365 1271 004366 1272 004400 1273 004405 1275 004407 1281 004411 1288 004414 1289 004423 1291 004426 1293 004440 1294 004447 1296 004451 1300 004453 1307 004454 1313 004464 1314 004466 1316 004474 1322 004475 1327 004476 1329 004500 1332 004502 1334 004514 1336 004516 1339 004545 1348 004547 1351 004565 1352 004567 1355 004570 1358 004571 1366 004572 1367 004576 1369 004577 1371 004613 1372 004615 1373 004622 1382 004624 1385 004626 1386 004644 1388 004654 1391 004655 1392 004673 1400 004703 1401 004707 1408 004727 1410 004734 1412 004757 1418 004777 1420 005004 1421 005014 1422 005032 1424 005034 1426 005036 1438 005037 1442 005041 1448 005114 1450 005142 ----------------------------------------------------------- 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