COMPILATION LISTING OF SEGMENT cobol_gns 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 1011.0 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_gns.pl1 Reformatted code to new Cobol standard. 19* END HISTORY COMMENTS */ 20 21 22 /* Modified on 11/31/81 by FCH, [5.1-1], reset lerr to prevent loop, phx12017(BUG521) */ 23 /* Modified on 05/19/81 by FCH, [4.4-3], $ and _ allowed in symbols in some cases */ 24 /* Modified on 04/09/81 by FCH, [4.4-2], fix bugs in leveling for validation-81, BUG477 */ 25 /* Modified on 12/05/80 by FCH, [4.4-1], report_writer added */ 26 /* Modified on 04/18/80 by FCH, [4.2-8], zero length non-num lit, "" ,detected(BUG439) */ 27 /* Modified on 04/09/80 by FCH, [4.2-7], fix problems in flagging */ 28 /* Modified on 10/8/79 by MHD, [4.2-6], assigning 9999 to COLUMN for DEBUG statements */ 29 /* Modified on 05/15/79 by FCH, [4.0-5], debug statement */ 30 /* Modified on 04/17/79 by FCH, [4.0-4], " or ' delim alphanum lits */ 31 /* Modified on 04/11/79 by FCH, [4.0-3], ignore term . if skipping copy statement */ 32 /* Modified on 04/05/79 by FCH, [4.0-2], gcos alphalit continuation implemented */ 33 /* Modified on 03/22/79 by FCH, [4.0-1], prepare duplicated data name table */ 34 /* Modified on 03/28/78 by FCH, [3.0-4], lev diag 34 issued as extension */ 35 /* Modified on 01/02/78 by FCH, [3.0-3], program-id containing _ detected */ 36 /* Modified on 11/16/77 by FCH, [3.0-2], leveling diag 44 emitted */ 37 /* Modified on 09/08/77 by FCH, [3.0-1], emit level for leveling diags 1,2, and 4 fixed */ 38 /* Modified since Version 4.0 */ 39 40 41 42 43 44 /* format: style3 */ 45 cobol_gns: 46 proc; 47 48 /* ========================================================================== */ 49 /* */ 50 /* Procedure gns is the primary module of the lex complex. it is responsible */ 51 /* for the original classification and issolation of all items from the users */ 52 /* source cards. */ 53 /* */ 54 /* ========================================================================== */ 55 56 /* general overlay for any token */ 57 dcl 1 token based (cobol_current), 58 2 fwd_link pointer, 59 2 back_link pointer, 60 2 rep_link pointer, 61 2 l_info bit (8), 62 2 size fixed bin, 63 2 line fixed bin, 64 2 column fixed bin, 65 2 type fixed bin; /* reserved_word */ 66 dcl 1 reserved_word based (cobol_current), 67 2 fwd_link pointer, 68 2 back_link pointer, 69 2 rep_link pointer, 70 2 l_info bit (8), 71 2 size fixed bin, 72 2 line fixed bin, 73 2 column fixed bin, 74 2 type fixed bin, /* = 1 */ 75 2 key fixed bin, 76 2 class bit (26), 77 2 jump_index fixed bin, /*[4.4-1]*/ 78 2 length fixed bin, /*[4.4-1]*/ 79 2 name char (30); /* numeric_lit */ 80 dcl 1 numeric_lit based (cobol_current), 81 2 fwd_link pointer, 82 2 back_link pointer, 83 2 rep_link pointer, 84 2 l_info bit (8), 85 2 size fixed bin, 86 2 line fixed bin, 87 2 column fixed bin, 88 2 type fixed bin, /* = 2 */ 89 2 info bit (8), 90 2 sign char (1), 91 2 exp_sign char (1), 92 2 exp_places fixed bin, 93 2 places_left fixed bin, 94 2 places_right fixed bin, 95 2 places fixed bin, 96 2 literal char (30); 97 98 /* alphanum_lit */ 99 dcl 1 alphanum_lit based (cobol_current), 100 2 fwd_link pointer, 101 2 back_link pointer, 102 2 rep_link pointer, 103 2 l_info bit (8), 104 2 size fixed bin, 105 2 line fixed bin, 106 2 column fixed bin, 107 2 type fixed bin, /* = 3 */ 108 2 info bit (8), 109 2 length fixed bin, 110 2 string char (200); 111 112 /* picture */ 113 dcl 1 picture based (cobol_current), 114 2 fwd_link pointer, 115 2 back_link pointer, 116 2 rep_link pointer, 117 2 l_info bit (8), 118 2 size fixed bin, 119 2 line fixed bin, 120 2 column fixed bin, 121 2 type fixed bin, /* = 4 */ 122 2 length fixed bin, 123 2 string char (30); 124 125 /* user_word */ 126 dcl 1 user_word based (cobol_current), 127 2 fwd_link pointer, 128 2 back_link pointer, 129 2 rep_link pointer, 130 2 l_info bit (8), 131 2 size fixed bin, 132 2 line fixed bin, 133 2 column fixed bin, 134 2 type fixed bin, /* = 8 */ 135 2 info bit (8), 136 2 length fixed bin, 137 2 word char (30); 138 139 dcl 1 debug based (cobol_current), 140 2 fwd_link pointer, 141 2 back_link pointer, 142 2 rep_link pointer, 143 2 l_info bit (8), 144 2 size fixed bin, 145 2 line fixed bin, 146 2 column fixed bin, 147 2 type fixed bin, 148 2 debug_index fixed bin, 149 2 on_off bit (1); 150 151 dcl cobol_lexerr$lexerr3 152 entry (fixed bin, bit (1), fixed bin, char (50)) external; 153 dcl cobol_gns entry external; 154 dcl cobol_merge entry ext; 155 dcl cobol_insert_token entry (fixed bin, fixed bin) external; 156 dcl cobol_delete_tokens entry (pointer, pointer) external; 157 declare cobol_c_list entry (ptr); 158 dcl mask bit (8); 159 dcl (wl, wll, places_left, exp_places, i, save_pcol, rwk) 160 fixed bin; 161 dcl rwc bit (26); 162 dcl wb char (256) static; 163 dcl (num_sign, exp_sign, per) 164 char (1); 165 dcl (exp_sw, integer_sw, found_comma) 166 bit (1); 167 dcl period_sw bit (1) static init ("0"b); 168 dcl dlmck1_sw bit (1); 169 dcl (rep_factor, save_nr_char, slen) 170 fixed bin static, 171 (c1, hc, hc1) char (1); 172 dcl (hc_ptr, hc1_ptr) ptr; 173 dcl quot_ch char (1); 174 declare np_char bit (1); 175 dcl 1 hcs based, 176 2 lp bit (5), 177 2 rp bit (4); 178 dcl 1 hcs1 based, 179 2 lp bit (4), 180 2 rp bit (5); 181 dcl 1 hcs2 based (hc_ptr), 182 2 fill bit (3), 183 2 hc_ck bit (1), 184 2 ehc_ck bit (1), 185 2 fill2 bit (4); /*[4.4-2]*/ 186 /* declare CONT bit(1); */ 187 dcl (lerr, per_sw) bit (1) static; 188 dcl save_sw bit (1) static init ("0"b); 189 dcl xplus_op fixed bin static init (182); 190 dcl xequal_op fixed bin static init (102); 191 dcl xminus_op fixed bin static init (183); 192 dcl xtimes_op fixed bin static init (184); 193 dcl xdivide_op fixed bin static init (185); 194 dcl xexponent fixed bin static init (186); 195 dcl xleft_paren fixed bin static init (187); 196 dcl xright_paren fixed bin static init (188); 197 dcl xperiod fixed bin static init (189); 198 dcl xgreater_than fixed bin static init (113); 199 dcl xless_than fixed bin static init (123); 200 dcl (addr, fixed, index, null, substr, translate, unspec, mod) 201 builtin; 202 203 /*[4.4-2]*/ 204 /* CONT = "0"b; */ 205 206 207 start: 208 dlmck1_sw = "1"b; 209 210 do while (substr (cobol_cards.name, cobol_cards.nr_char, 1) = " "); 211 212 cobol_cards.nr_char = cobol_cards.nr_char + 1; 213 214 end; 215 216 if substr (cobol_cards.name, cobol_cards.nr_char, 1) = cobol_new_line_character 217 then do; /* get next card and scanoff spaces */ 218 call cobol_merge; 219 go to start; 220 end; 221 222 if cobol_scanoff_sw 223 then do; 224 per_sw = "0"b; 225 scanoff: 226 do while (substr (cobol_cards.name, cobol_cards.nr_char, 1) = cobol_new_line_character); 227 228 call cobol_merge; 229 230 do while (substr (cobol_cards.name, cobol_cards.nr_char, 1) = " "); 231 232 cobol_cards.nr_char = cobol_cards.nr_char + 1; 233 234 end; 235 236 end; 237 238 if cobol_cards.nr_char < 12 239 then return; 240 241 if substr (cobol_cards.name, cobol_cards.nr_char, 1) = "." 242 then do; 243 244 if per_sw = "0"b 245 then do; 246 per_sw = "1"b; 247 248 call cobol_insert_token (1, 0); 249 /*[4.0-1]*/ 250 prev_tok_type = 0; 251 252 reserved_word.line = cobol_save_cln; 253 reserved_word.column = cobol_save_col; 254 reserved_word.key = xperiod; 255 reserved_word.class = "0001"b; 256 end; 257 258 cobol_cards.nr_char = cobol_cards.nr_char + 1; 259 goto scanoff; 260 end; 261 262 cobol_cards.nr_char = cobol_cards.nr_char + 1; 263 goto scanoff; 264 end; 265 266 ck_stack_end: 267 if token.fwd_link ^= null () 268 then do; 269 270 cobol_current = token.fwd_link; 271 272 if (token.type = 6) | (token.type = 5) 273 then goto ck_stack_end; 274 return; 275 end; 276 277 cobol_save_cln = cobol_c_l_n; 278 cobol_save_col = cobol_cards.nr_char; 279 wl = 1; 280 281 /*[4.2-6]*/ 282 if substr (cobol_cards.name, 1, 6) = "~~~~~~" /*[4.2-6]*/ 283 then TOK_COLUMN = 9999; /*[4.2-6]*/ 284 else TOK_COLUMN = cobol_save_col; 285 286 if cobol_pic_switch 287 then goto pic_proc; /* switch on first character first */ 288 289 /*[4.4-1]*/ 290 new_ch = substr (cobol_cards.name, cobol_cards.nr_char, 1); 291 292 /*[4.4-1]*/ 293 goto l (x (fixed (unspec (new_ch), 15))); 294 295 /*[4.4-1]*/ 296 declare new_ch char (1); /* leveling diagnostics */ 297 298 lev_diag: 299 proc (lin, col, num); 300 301 declare (lin, col, num) fixed bin; 302 303 declare 1 diag_item, 304 2 size fixed bin, 305 2 line fixed bin, 306 2 column fixed bin, 307 2 type fixed bin, 308 2 run fixed bin, 309 2 number fixed bin, 310 2 info bit (32); 311 312 diag_item.size = 28; 313 diag_item.type = 5; 314 diag_item.run = 9; 315 diag_item.info = "0"b; 316 317 diag_item.line = lin; 318 diag_item.column = col; 319 diag_item.number = num; 320 321 call cobol_c_list (addr (diag_item)); 322 323 end; 324 325 326 /* COMMON OPERATOR CODE */ 327 328 ops1: 329 cobol_cards.nr_char = cobol_cards.nr_char + 1; 330 ops1a: 331 if substr (cobol_cards.name, cobol_cards.nr_char, 1) = cobol_new_line_character 332 then call cobol_merge; 333 334 call cobol_insert_token (1, 0); 335 336 /*[4.0-1]*/ 337 prev_tok_type = 0; 338 339 reserved_word.key = rwk; 340 reserved_word.class = rwc; 341 reserved_word.line = cobol_save_cln; /*[4.2-6]*/ 342 reserved_word.column = TOK_COLUMN; 343 344 /*[4.4-1]*/ 345 if report_exists /*[4.4-1]*/ 346 then do; /*[4.4-1]*/ 347 reserved_word.length = 1; /*[4.4-1]*/ 348 substr (reserved_word.name, 1, 1) = new_ch; 349 /*[4.4-1]*/ 350 reserved_word.size = reserved_word.size + 5; 351 /*[4.4-1]*/ 352 end; 353 354 /*[4.4-2]*/ 355 /* 356* if fixed_common.comp_level < "3" & CONT 357* then do; call lev_diag ( reserved_word.line, 358* reserved_word.column, 359* 1 360* ); 361* 362* CONT = "0"b; 363* end; 364**/ 365 /*[4.4-2]*/ 366 367 return; 368 369 /* end of first character selection portion */ 370 371 372 /* ALPHANUMERIC-- USER WORD */ 373 374 375 l (1): /* user words: a -> z */ 376 alpha: 377 mask = "10000000"b; 378 wll = 30; 379 call swm; 380 381 if lerr 382 then do; 383 w_l_err: 384 call cobol_lexerr$lexerr3 (2, "1"b, 2, "30"); 385 /*[5.1-1]*/ 386 lerr = "0"b; 387 return; 388 end; 389 390 if substr (cobol_cards.name, cobol_cards.nr_char, 1) = cobol_new_line_character 391 then do; 392 call cobol_merge; 393 394 if cobol_continuation = "1"b 395 then do; 396 cobol_continuation = "0"b; 397 398 /*[4.4-2]*/ 399 /* CONT = "1"b; */ 400 401 goto alpha; 402 end; 403 goto uw_dlm_ok; 404 end; 405 406 c1 = substr (wb, wl, 1); 407 mask = mem_tab (fixed (unspec (c1), 35)); 408 409 if mask & "00001000"b 410 then if c1 ^= """" 411 then do; 412 413 if c1 = "." 414 then period_sw = "1"b; 415 else period_sw = "0"b; 416 417 go to uw_dlm_ok; 418 end; 419 420 else do; 421 call ill_dlm; 422 goto uw_dlm_ok; 423 end; 424 425 if cobol_head_words (3) & ^cobol_head_words (4) 426 then do; 427 428 if dlmck1_sw 429 then dlmck1_sw = "0"b; 430 431 cobol_cards.nr_char = cobol_cards.nr_char + 1; 432 wl = wl + 1; 433 goto alpha; 434 end; 435 436 if cobol_progid_sw & c1 = "_" /*[3.0-3]*/ 437 then do; 438 cobol_cards.nr_char = cobol_cards.nr_char + 1; 439 wl = wl + 1; 440 substr (wb, wl, 1) = /*[3.0-3]*/ substr (cobol_cards.name, cobol_cards.nr_char, 1); 441 442 if substr (wb, wl, 1) = "." /*[3.0-3]*/ 443 then do; 444 period_sw = "1"b; 445 go to uw_dlm_ok; 446 end; /*[3.0-3]*/ 447 else go to alpha; /*[3.0-3]*/ 448 end; 449 call ill_char; 450 return; 451 452 uw_dlm_ok: 453 wl = wl - 1; 454 455 if substr (wb, wl, 1) = "-" /* illegal termination of item */ 456 then do; 457 call ill_char; 458 return; 459 end; 460 461 /*[4.4-1]*/ 462 if ^processing_report 463 then if cobol_lu_sw 464 then substr (wb, 1, wl) = translate (substr (wb, 1, wl), lower_case_alphabet); 465 466 call cobol_insert_token (8, wl); 467 468 /*[4.0-1]*/ 469 if fixed_common.comp_level < "3" /*[4.0-1]*/ 470 then /*[4.0-1]*/ 471 if prev_tok_type = 1 /*[4.0-1]*/ 472 then do; 473 ch36 = substr (wb, 1, wl) || "~"; 474 475 /*[4.0-1]*/ 476 if ch36 ^= "filler~" /*[4.0-1]*/ 477 then /*[4.0-1]*/ 478 if index (tok_string, "~" || ch36) <= 0 479 /*[4.0-1]*/ 480 then tok_string = tok_string || ch36; 481 /*[4.0-1]*/ 482 else call cobol_ddsyntax$enter_tok_string (ch36); 483 /*[4.0-1]*/ 484 end; 485 486 /*[4.0-1]*/ 487 prev_tok_type = 0; 488 489 user_word.line = cobol_save_cln; /*[4.2-6]*/ 490 user_word.column = TOK_COLUMN; 491 user_word.length = wl; 492 substr (user_word.word, 1, wl) = substr (wb, 1, wl); 493 494 /*[4.4-2]*/ 495 /* 496* if fixed_common.comp_level < "3" & CONT 497* then do; call lev_diag ( user_word.line, 498* user_word.column, 499* 1 500* ); 501* 502* CONT = "0"b; 503* end; 504**/ 505 /*[4.4-2]*/ 506 507 if fixed_common.comp_level < "3" & index ("0123456789", substr (user_word.word, 1, 1)) ^= 0 508 /*[3.0-1]*/ 509 then call lev_diag (user_word.line, user_word.column, 4); 510 511 if fixed_common.comp_level < "5" /* [3.0-4] */ & /* [3.0-4] */ cobol_progid_sw /* [3.0-4] */ 512 & /* [3.0-4] */ index (substr (wb, 1, wl), "_") ^= 0 513 /* [3.0-4] */ 514 then call lev_diag (user_word.line, /*[3.0-3]*/ 515 user_word.column, /*[3.0-3]*/ 516 34 /*[3.0-3]*/); /*[3.0-3]*/ 517 518 if ^dlmck1_sw 519 then call cobol_lexerr$lexerr3 (1, "0"b, 0, " "); 520 521 return; 522 523 524 /* NUMERIC LITERIAL (FLOATING POINT) */ 525 526 527 l (2): /* numeric literals: 0 -> 9 */ 528 digit: 529 if cobol_head_words (5) & (cobol_cards.nr_char < 12) 530 then goto alpha; /* label--treat as a word */ 531 532 num_sign = " "; 533 d1a: 534 integer_sw = "0"b; 535 exp_sign = " "; 536 exp_sw = "0"b; 537 places_left = 0; 538 exp_places = 0; 539 per = " "; 540 found_comma = "0"b; 541 542 d1: /* return label for continuation of part 1 of digits */ 543 /* following size limit is 30 because of numeric procedure names */ 544 mask = "01000000"b; 545 wll = 30; 546 call swm; 547 548 if lerr 549 then do; 550 nl_l_err: 551 call cobol_lexerr$lexerr3 (2, "1"b, 2, "30"); 552 /*[5.1-1]*/ 553 lerr = "0"b; 554 return; 555 end; 556 557 c1 = substr (cobol_cards.name, cobol_cards.nr_char, 1); 558 559 if c1 = cobol_new_line_character 560 then do; 561 call cobol_merge; 562 563 if cobol_continuation = "1"b 564 then do; 565 cobol_continuation = "0"b; 566 567 /*[4.4-2]*/ 568 /* CONT = "1"b; */ 569 570 goto d1; 571 end; 572 573 integer_sw = "1"b; 574 places_left = wl - 1; 575 goto nl_dlm_ok; 576 end; 577 578 if mem_tab (fixed (unspec (c1), 35)) & "10000000"b 579 then goto alpha; 580 581 integer_sw = "1"b; 582 places_left = wl - 1; /* set count field */ 583 584 if c1 = cobol_comma_character /*[4.2-7]*/ 585 then do; 586 found_comma = "1"b; /*[4.2-7]*/ 587 cobol_save_cln = cobol_c_l_n; /*[4.2-7]*/ 588 cobol_save_col = cobol_cards.nr_char; /*[4.2-7]*/ 589 end; 590 else if c1 ^= cobol_decimal_point_character 591 then do; 592 build_nlt: 593 c1 = substr (cobol_cards.name, cobol_cards.nr_char, 1); 594 mask = mem_tab (fixed (unspec (c1), 35)); 595 596 if (mask & "00000001"b) | (c1 = ")") 597 then goto nl_dlm_ok; 598 599 if (c1 ^= """") & (c1 ^= "(") 600 then do; 601 call ill_char; 602 return; 603 end; 604 605 /*call ill_dlm;*/ 606 607 nl_dlm_ok: 608 wl = wl - 1; 609 610 call cobol_insert_token (2, wl); 611 612 numeric_lit.line = cobol_save_cln; /*[4.2-6]*/ 613 numeric_lit.column = TOK_COLUMN; 614 numeric_lit.places = wl; 615 substr (numeric_lit.info, 1, 1) = integer_sw; 616 substr (numeric_lit.info, 2, 1) = exp_sw; 617 numeric_lit.sign = num_sign; 618 numeric_lit.exp_sign = exp_sign; 619 numeric_lit.places_left = places_left; 620 numeric_lit.exp_places = exp_places; 621 numeric_lit.places_right = wl - places_left - exp_places; 622 substr (numeric_lit.literal, 1, wl) = substr (wb, 1, wl); 623 624 /*[4.0-1]*/ 625 if fixed_common.comp_level < "3" 626 then do; 627 628 /*[4.0-1]*/ 629 prev_tok_type = 0; 630 631 /*[4.0-1]*/ 632 if cobol_head_words (4) & ^(cobol_head_words (5)) 633 /*[4.0-1]*/ 634 then if numeric_lit.sign = " " & numeric_lit.places_right = 0 635 /*[4.0-1]*/ 636 then do; 637 int_val = fixed (substr (numeric_lit.literal, 1, wl)); 638 639 /*[4.0-1]*/ 640 if int_val >= 2 & int_val <= 49 641 /*[4.0-1]*/ 642 then prev_tok_type = 1; 643 /*[4.0-1]*/ 644 end; 645 646 /*[4.0-1]*/ 647 end; 648 649 /*[4.4-2]*/ 650 /* 651* if fixed_common.comp_level < "3" & CONT 652* then do; call lev_diag ( numeric_lit.line, 653* numeric_lit.column, 654* 1 655* ); 656* 657* CONT = "0"b; 658* end; 659**/ 660 /*[4.4-2]*/ 661 662 if per = "." 663 then do; /* Generate reserved word token "." (EOS). */ 664 665 /*[4.0-3]*/ 666 token.l_info = linfo; 667 gen_per: 668 cobol_save_col = save_pcol; 669 rwk = xperiod; 670 rwc = "0001"b; 671 goto ops1a; 672 end; 673 return; 674 675 end; 676 677 save_pcol = cobol_cards.nr_char; 678 per = substr (cobol_cards.name, save_pcol, 1); /* save delimiter */ 679 cobol_cards.nr_char = cobol_cards.nr_char + 1; 680 c1 = substr (cobol_cards.name, cobol_cards.nr_char, 1); 681 682 /*[4.0-3]*/ 683 if per = "." 684 then linfo = token.l_info; 685 686 if c1 = cobol_new_line_character 687 then do; 688 call cobol_merge; 689 690 if cobol_continuation = "1"b 691 then do; 692 cobol_continuation = "0"b; 693 694 /*[4.4-2]*/ 695 /* CONT = "1"b; */ 696 697 if mem_tab (fixed (unspec (substr (cobol_cards.name, cobol_cards.nr_char, 1)), 35)) 698 & "01000000"b 699 then if found_comma 700 then do; 701 call ill_char; 702 return; 703 end; 704 else go to d2; 705 706 call cobol_lexerr$lexerr3 (9, "1"b, 0, " "); 707 708 return; 709 710 end; 711 goto nl_dlm_ok; 712 end; 713 714 if mem_tab (fixed (unspec (c1), 35)) & "01000000"b 715 then if found_comma 716 then do; 717 call ill_char; 718 return; 719 end; 720 else go to d2; 721 722 723 /*[4.2-7]*/ 724 if found_comma /*[4.2-7]*/ 725 then if fixed_common.comp_level < "3" /*[4.2-7]*/ 726 then call lev_diag (cobol_save_cln, cobol_save_col, 2); 727 /* ;, as sepatator */ 728 729 goto build_nlt; 730 731 /* right part of a number */ 732 733 d2: 734 integer_sw = "0"b; 735 per = " "; 736 mask = "01000000"b; 737 wll = 18; 738 call swm; 739 740 if lerr 741 then goto nl_l_err; 742 743 c1 = substr (cobol_cards.name, cobol_cards.nr_char, 1); 744 745 if c1 = cobol_new_line_character 746 then do; 747 call cobol_merge; 748 749 if cobol_continuation = "1"b 750 then do; 751 cobol_continuation = "0"b; 752 753 /*[4.4-2]*/ 754 /* CONT = "1"b; */ 755 756 goto d2; 757 end; 758 goto nl_dlm_ok; 759 end; 760 761 /* if c1 ^= "e" & c1 ^= "E" then */ 762 goto build_nlt; 763 764 /* STRING PROCESSING */ 765 766 s3: /* continuation loop label */ 767 slen = 768 index (substr (cobol_cards.name, cobol_cards.nr_char, cobol_cards.column - cobol_cards.nr_char + 1), """"); 769 770 if slen = 0 771 then slen = cobol_cards.column - cobol_cards.nr_char; 772 else slen = slen - 1; 773 774 if slen + wl - 1 > 200 775 then do; 776 al_l_err: 777 call cobol_lexerr$lexerr3 (4, "1"b, 3, "200"); 778 return; 779 end; 780 781 if slen ^= 0 782 then do; 783 784 substr (wb, wl, slen) = substr (cobol_cards.name, cobol_cards.nr_char, slen); 785 cobol_cards.nr_char = cobol_cards.nr_char + slen; 786 /* terminating " or new_line */ 787 wl = wl + slen; /* cobol_current true size + 1 */ 788 789 end; 790 791 if substr (cobol_cards.name, cobol_cards.nr_char, 1) = cobol_new_line_character 792 then do; 793 i = cobol_cards.tblanks; 794 795 call cobol_merge; 796 797 if cobol_continuation = "1"b 798 then do; 799 cobol_continuation = "0"b; 800 801 /*[4.4-2]*/ 802 /* CONT = "1"b; */ 803 804 if i ^= 0 805 then do; 806 substr (wb, wl, i) = " "; 807 wl = wl + i; 808 end; 809 810 811 812 if substr (cobol_cards.name, cobol_cards.nr_char, 1) ^= quot_ch 813 then do; 814 call cobol_lexerr$lexerr3 (5, "1"b, 0, " "); 815 call scan_off; 816 return; 817 end; 818 819 cobol_cards.nr_char = cobol_cards.nr_char + 1; 820 goto s3; /* normal continuation */ 821 822 end; 823 824 goto alit_err; 825 end; 826 827 if substr (cobol_cards.name, cobol_cards.nr_char, 1) = quot_ch 828 then goto ck_quote; 829 830 alit_err: /* illegal termination of literal string */ 831 call cobol_lexerr$lexerr3 (3, "1"b, 0, " "); 832 call scan_off; 833 return; 834 835 ck_quote: 836 if substr (cobol_cards.name, cobol_cards.nr_char + 1, 1) = quot_ch 837 then do; 838 substr (wb, wl, 1) = quot_ch; /* double quote */ 839 wl = wl + 1; 840 cobol_cards.nr_char = cobol_cards.nr_char + 2; 841 goto s3; 842 end; 843 844 if substr (cobol_cards.name, cobol_cards.nr_char + 1, 1) = cobol_new_line_character 845 /* single quote */ 846 then do; 847 call cobol_merge; 848 849 if cobol_continuation = "1"b 850 then do; 851 cobol_continuation = "0"b; 852 853 /*[4.4-2]*/ 854 /* CONT = "1"b; */ 855 856 if substr (cobol_cards.name, cobol_cards.nr_char, 1) ^= quot_ch 857 then do; 858 call cobol_lexerr$lexerr3 (5, "1"b, 0, " "); 859 call scan_off; 860 return; 861 end; 862 863 /*[4.0-2]*/ 864 /* continued double quote */ 865 866 /*[4.0-2]*/ 867 if substr (fixed_common.compile_mode, 1, 1) 868 /*[4.0-2]*/ 869 then do; /* gcos */ 870 871 /*[4.0-2]*/ 872 posit = cobol_cards.nr_char + 1; 873 /*[4.0-2]*/ 874 ch = substr (cobol_cards.name, posit, 1); 875 876 ct: /*[4.0-2]*/ 877 if ch = quot_ch /*[4.0-2]*/ 878 then do; 879 posit = posit + 1; 880 /*[4.0-2]*/ 881 ch = substr (cobol_cards.name, posit, 1); 882 883 /*[4.0-2]*/ 884 go to ct; /*[4.0-2]*/ 885 end; 886 887 /*[4.0-2]*/ 888 posit = posit - cobol_cards.nr_char; 889 890 /*[4.0-2]*/ 891 if ch = " 892 " 893 then posit = posit - 1; 894 895 /*[4.0-2]*/ 896 if mod (posit, 2) = 1 897 /*[4.0-2]*/ 898 then go to l (3); 899 900 /*[4.0-2]*/ 901 end; 902 903 goto ck_quote; 904 end; 905 goto al_dlm_ok; 906 end; 907 908 hc_ptr = addr (hc); 909 hc1_ptr = addr (hc1); 910 cobol_cards.nr_char = cobol_cards.nr_char + 1; 911 hc = substr (cobol_cards.name, cobol_cards.nr_char, 1); 912 hc = hexl_tab (fixed (unspec (hc), 35)); 913 914 if hcs2.hc_ck = "0"b 915 then goto end_alit; 916 917 np_char = "1"b; 918 919 goto next_hex1; 920 921 next_hex: 922 cobol_cards.nr_char = cobol_cards.nr_char + 1; 923 hc = substr (cobol_cards.name, cobol_cards.nr_char, 1); 924 925 if hc = quot_ch 926 then do; 927 cobol_cards.nr_char = cobol_cards.nr_char + 1; 928 goto s3; 929 end; 930 931 hc = hexl_tab (fixed (unspec (hc), 35)); 932 933 if hcs2.hc_ck = "0"b 934 then do; 935 936 if substr (cobol_cards.name, cobol_cards.nr_char, 1) = cobol_new_line_character 937 then do; 938 call cobol_merge; 939 940 if cobol_continuation = "1"b 941 then do; 942 cobol_continuation = "0"b; 943 944 /*[4.4-2]*/ 945 /* CONT = "1"b; */ 946 947 if substr (cobol_cards.name, cobol_cards.nr_char, 1) = quot_ch 948 then goto next_hex; 949 950 end; 951 end; 952 hex_err: 953 call cobol_lexerr$lexerr3 (25, "1"b, 0, " "); 954 955 return; 956 957 end; 958 959 next_hex1: 960 hc1_ptr -> hcs.lp = hc_ptr -> hcs1.rp; 961 962 hex_c: 963 cobol_cards.nr_char = cobol_cards.nr_char + 1; 964 hc = substr (cobol_cards.name, cobol_cards.nr_char, 1); 965 966 if hc = quot_ch 967 then goto hex_err; 968 969 970 hc = hexl_tab (fixed (unspec (hc), 35)); 971 972 if hcs2.hc_ck = "0"b 973 then do; 974 975 if substr (cobol_cards.name, cobol_cards.nr_char, 1) = cobol_new_line_character 976 then do; 977 call cobol_merge; 978 979 if cobol_continuation = "1"b 980 then do; 981 cobol_continuation = "0"b; 982 983 /*[4.4-2]*/ 984 /* CONT = "1"b; */ 985 986 if substr (cobol_cards.name, cobol_cards.nr_char, 1) = c1 987 then goto hex_c; 988 989 end; 990 end; 991 992 goto hex_err; 993 994 end; 995 996 hc1_ptr -> hcs.rp = hc_ptr -> hcs.rp; 997 substr (wb, wl, 1) = hc1; 998 wl = wl + 1; 999 1000 goto next_hex; 1001 1002 end_alit: /*[4.2-8]*/ 1003 if wl = 1 | wl > 211 1004 then do; /* literal too long */ 1005 call cobol_lexerr$lexerr3 (4, "1"b, 3, "200"); 1006 return; 1007 end; 1008 1009 c1 = substr (cobol_cards.name, cobol_cards.nr_char, 1); 1010 mask = mem_tab (fixed (unspec (c1), 35)); 1011 1012 if (mask & "00000001"b) | (c1 = ")") 1013 then goto al_dlm_ok; 1014 1015 call ill_dlm; 1016 al_dlm_ok: 1017 wl = wl - 1; 1018 1019 if np_char & fixed_common.comp_level < "5" 1020 then call lev_diag (cobol_save_cln, cobol_save_col, 134); 1021 1022 call cobol_insert_token (3, wl); 1023 1024 /*[4.0-1]*/ 1025 prev_tok_type = 0; 1026 1027 alphanum_lit.line = cobol_save_cln; /*[4.2-6]*/ 1028 alphanum_lit.column = TOK_COLUMN; 1029 alphanum_lit.length = wl; 1030 substr (alphanum_lit.string, 1, wl) = substr (wb, 1, wl); 1031 /*[4.4-2]*/ 1032 alpha_lit_bit = "0"b; 1033 1034 return; 1035 1036 /* BIT STRING LITERIALS */ 1037 1038 l (3): /* alpha-numeric literals and bit strings: " */ 1039 /*[4.0-4]*/ 1040 quot_ch = """"; /*[4.4-2]*/ 1041 alpha_lit_bit = "1"b; 1042 1043 l3: /* bit string */ 1044 /* alphanumeric literal */ 1045 np_char = "0"b; 1046 cobol_cards.nr_char = cobol_cards.nr_char + 1; 1047 goto s3; 1048 1049 l (4): /*[4.0-4]*/ 1050 if substr (fixed_common.compile_mode, 2, 1) /*[4.0-4]*/ 1051 then do; 1052 quot_ch = "'"; /*[4.0-4]*/ 1053 go to l3; /*[4.0-4]*/ 1054 end; 1055 1056 /*[4.0-4]*/ 1057 go to l (10); /* COMMA OR SEMI-COLOMN CHARACTERS */ 1058 1059 l (5): /* comma and semi colon */ 1060 cobol_cards.nr_char = cobol_cards.nr_char + 1; 1061 1062 if ^mem_tab (fixed (unspec (substr (cobol_cards.name, cobol_cards.nr_char, 1)), 35)) & "00000010"b 1063 then call ill_dlm; 1064 1065 if fixed_common.comp_level < "3" /*[3.0-1]*/ 1066 then call lev_diag (cobol_save_cln, cobol_save_col, 2); 1067 1068 goto start; 1069 1070 /* SIGN--ARITHEMATIC OPERATORS */ 1071 1072 l (6): 1073 ; /* + operator */ 1074 l (18): /* - operator */ 1075 if cobol_cards.nr_char > 12 1076 then if substr (cobol_cards.name, cobol_cards.nr_char - 1, 1) = ")" 1077 then call ill_dlm1; 1078 1079 c1 = substr (cobol_cards.name, cobol_cards.nr_char, 1); 1080 cobol_cards.nr_char = cobol_cards.nr_char + 1; 1081 1082 if substr (cobol_cards.name, cobol_cards.nr_char, 1) = cobol_new_line_character 1083 then do; 1084 call cobol_merge; 1085 1086 if cobol_continuation = "1"b 1087 then do; 1088 cobol_continuation = "0"b; 1089 1090 /*[4.4-2]*/ 1091 /* CONT = "1"b; */ 1092 1093 end; 1094 else goto sign1; 1095 1096 end; 1097 1098 if mem_tab (fixed (unspec (substr (cobol_cards.name, cobol_cards.nr_char, 1)), 35)) & "01000000"b 1099 then goto sign2; /* it is a sign character */ 1100 1101 if substr (cobol_cards.name, cobol_cards.nr_char, 1) = cobol_decimal_point_character 1102 then go to sign2; 1103 1104 if ^mem_tab (fixed (unspec (substr (cobol_cards.name, cobol_cards.nr_char, 1)), 35)) & "00000010"b 1105 then call ill_dlm2; 1106 1107 cobol_cards.nr_char = cobol_cards.nr_char - 1; 1108 1109 sign1: 1110 if c1 = "+" 1111 then do; 1112 rwk = xplus_op; 1113 rwc = "01"b; 1114 end; 1115 else do; 1116 rwk = xminus_op; 1117 rwc = "01"b; 1118 end; 1119 1120 go to ops1; 1121 1122 /* ARITHMETIC OPERATOR */ 1123 1124 sign2: /* must be a sign if here else an error */ 1125 num_sign = c1; 1126 goto d1a; 1127 1128 1129 1130 /* ASTERISK PROCESSOR */ 1131 1132 l (7): /* multiply and exponent operators */ 1133 if cobol_cards.nr_char > 12 1134 then if substr (cobol_cards.name, cobol_cards.nr_char - 1, 1) = ")" 1135 then call ill_dlm1; 1136 1137 c1 = substr (cobol_cards.name, cobol_cards.nr_char + 1, 1); 1138 1139 if mem_tab (fixed (unspec (c1), 35)) & "00000010"b 1140 then do; /* valid delimiter found */ 1141 put_ast: 1142 rwk = xtimes_op; 1143 rwc = "01"b; 1144 goto ops1; 1145 end; /* multiply operator */ 1146 1147 if c1 = "*" 1148 then do; /* exponent operator */ 1149 1150 c1 = substr (cobol_cards.name, cobol_cards.nr_char + 2, 1); 1151 rwk = xexponent; 1152 rwc = "01"b; 1153 1154 if ^mem_tab (fixed (unspec (c1), 35)) & "00000010"b 1155 then call ill_dlm2; 1156 1157 cobol_cards.nr_char = cobol_cards.nr_char + 1; 1158 go to ops1; 1159 1160 end; /* legal part */ 1161 1162 call ill_dlm2; /* must be illegal if here */ 1163 1164 goto put_ast; 1165 l (8): /* unused */ 1166 call ill_char; 1167 return; 1168 1169 1170 l (9): /* slash "/" */ 1171 if cobol_cards.nr_char > 12 1172 then if substr (cobol_cards.name, cobol_cards.nr_char - 1, 1) = ")" 1173 then call ill_dlm1; 1174 1175 if ^mem_tab (fixed (unspec (substr (cobol_cards.name, cobol_cards.nr_char + 1, 1)), 35)) & "00000010"b 1176 then call ill_dlm2; 1177 1178 rwk = xdivide_op; 1179 rwc = "01"b; 1180 1181 goto ops1; 1182 1183 /* BAD CHARACTER IN USERS INPUT SOURCE */ 1184 1185 l (10): /* 000->011 013->037 ! # $ : ? @ A->Z [ \ ] ^ _ ` { | } ~ PAD */ 1186 call ill_char; 1187 return; 1188 1189 ill_char: 1190 proc; 1191 1192 call cobol_lexerr$lexerr3 (1, "1"b, 0, " "); 1193 call scan_off; 1194 end; 1195 1196 /* SPECIAL OPERATORS--BLANKS NOT REQUIRED>> */ 1197 1198 l (11): /* ( character. */ 1199 rwk = xleft_paren; 1200 rwc = "0"b; 1201 goto ops1; 1202 1203 l (12): /* blank and end of line characters */ 1204 goto start; 1205 1206 l (13): /* ) character. */ 1207 rwk = xright_paren; 1208 rwc = "0"b; 1209 goto ops1; 1210 1211 /* NORMAL OPERATORS */ 1212 1213 l (14): /* "." */ 1214 c1 = substr (cobol_cards.name, cobol_cards.nr_char, 1); 1215 1216 if ^period_sw /* if not used as user word delimiter */ 1217 then do; 1218 1219 if c1 = cobol_decimal_point_character 1220 then if mem_tab (fixed (unspec (substr (cobol_cards.name, cobol_cards.nr_char + 1, 1)), 35)) 1221 & "01000000"b 1222 then go to digit; 1223 1224 end; 1225 else period_sw = "0"b; 1226 1227 if ^mem_tab (fixed (unspec (substr (cobol_cards.name, cobol_cards.nr_char + 1, 1)), 35)) & "00000010"b 1228 then do; 1229 call ill_dlm; 1230 1231 if fixed_common.comp_level < "5" 1232 then do; 1233 call lev_diag (reserved_word.line, reserved_word.column, 145); 1234 end; 1235 end; 1236 1237 rwk = xperiod; 1238 rwc = "0001"b; 1239 goto ops1; 1240 1241 l (15): /* "=" and "==" (psuedo-text delimiter) operators */ 1242 c1 = substr (cobol_cards.name, cobol_cards.nr_char + 1, 1); 1243 1244 if c1 = "=" 1245 then do; 1246 rwk = 256; /* == */ 1247 rwc = "0"b; 1248 cobol_cards.nr_char = cobol_cards.nr_char + 1; 1249 go to ops1; 1250 end; 1251 1252 if mem_tab (fixed (unspec (c1), 35)) & "00000010"b 1253 then do; 1254 put_eq: 1255 rwk = xequal_op; 1256 rwc = "0000110"b; 1257 goto ops1; 1258 end; 1259 1260 call ill_dlm; 1261 1262 goto put_eq; 1263 1264 l (16): /* "<" */ 1265 if ^mem_tab (fixed (unspec (substr (cobol_cards.name, cobol_cards.nr_char + 1, 1)), 35)) & "00000010"b 1266 then call ill_dlm; 1267 1268 rwk = xless_than; 1269 rwc = "0000110"b; 1270 goto ops1; 1271 1272 l (17): /* ">" */ 1273 if ^mem_tab (fixed (unspec (substr (cobol_cards.name, cobol_cards.nr_char + 1, 1)), 35)) & "00000010"b 1274 then call ill_dlm; 1275 1276 rwk = xgreater_than; 1277 rwc = "0000110"b; 1278 goto ops1; 1279 1280 /* PROCESS PICTURE CHARACTER STRINGS */ 1281 1282 pic_proc: /* picture string processor */ 1283 dcl (cont_flag, cont_flag1) 1284 bit (1), 1285 a char (1), 1286 (h_index, st_pos) fixed bin; 1287 1288 if substr (cobol_cards.name, cobol_cards.nr_char, 1) = "I" 1289 | substr (cobol_cards.name, cobol_cards.nr_char, 1) = "i" 1290 then goto alpha; /* handle the case of is */ 1291 1292 p_p: /* external entry--cobol_continuation point */ 1293 per = " "; 1294 mask = "00100000"b; 1295 wll = 31; 1296 call swm; 1297 1298 /* (31 to allow for a terminating "." in the scan) */ 1299 if lerr 1300 then goto w_l_err; 1301 1302 save_pcol = cobol_cards.nr_char - 1; 1303 per = substr (cobol_cards.name, save_pcol, 1); 1304 1305 1306 1307 1308 if substr (cobol_cards.name, cobol_cards.nr_char, 1) = cobol_new_line_character 1309 then do; 1310 call cobol_merge; 1311 1312 if cobol_continuation = "1"b 1313 then do; 1314 cobol_continuation = "0"b; 1315 1316 /*[4.4-2]*/ 1317 /* CONT = "1"b; */ 1318 1319 goto p_p; 1320 end; 1321 1322 if mem_tab (fixed (unspec (per), 35)) & "00000001"b 1323 then wl = wl - 2; 1324 else wl = wl - 1; 1325 1326 goto p_p2; 1327 end; 1328 1329 if mem_tab (fixed (unspec (substr (wb, wl, 1)), 35)) & "00000001"b 1330 then do; /* must back up one character position */ 1331 wl = wl - 1; 1332 1333 if mem_tab (fixed (unspec (substr (wb, wl, 1)), 35)) & "00000100"b 1334 then do; /* delimiter in the string now */ 1335 wl = wl - 1; 1336 p_p2: 1337 if wl > 30 1338 then do; /* too long */ 1339 call cobol_lexerr$lexerr3 (2, "1"b, 2, "30"); 1340 call scan_off; 1341 return; 1342 end; 1343 1344 if cobol_lu_sw 1345 then substr (wb, 1, wl) = translate (substr (wb, 1, wl), upper_case_alphabet); 1346 1347 call cobol_insert_token (4, wl); 1348 1349 /*[4.0-1]*/ 1350 prev_tok_type = 0; 1351 1352 picture.line = cobol_save_cln;/*[4.2-6]*/ 1353 picture.column = TOK_COLUMN; 1354 picture.length = wl; 1355 1356 /*[4.4-2]*/ 1357 /* 1358* if fixed_common.comp_level < "3" & CONT 1359* then do; call lev_diag ( picture.line, 1360* picture.column, 1361* 1 1362* ); 1363* 1364* CONT = "0"b; 1365* end; 1366**/ 1367 /*[4.4-2]*/ 1368 1369 if wl > 2 1370 then do; 1371 st_pos = 2; 1372 cont_flag = "1"b; 1373 end; 1374 else cont_flag = "0"b; 1375 1376 do while (cont_flag); 1377 1378 h_index = index (substr (wb, st_pos, wl - st_pos + 1), "-"); 1379 1380 if h_index = 0 1381 then cont_flag = "0"b; 1382 else do; 1383 1384 st_pos = st_pos + h_index; 1385 1386 if st_pos > wl - 1 1387 then cont_flag = "0"b; 1388 else do; 1389 1390 a = substr (wb, st_pos - 2, 1); 1391 1392 if a ^= "B" & a ^= "-" & a ^= "/" & a ^= "." & a ^= "," 1393 & a ^= "0" & a ^= "$" 1394 then do; 1395 1396 substr (wb, st_pos - 1, 1) = "h"; 1397 cont_flag1 = "1"b; 1398 cont_flag = "0"b; 1399 1400 do while (cont_flag1); 1401 1402 h_index = 1403 index (substr (wb, st_pos, wl - st_pos), "-"); 1404 1405 if h_index = 0 1406 then cont_flag1 = "0"b; 1407 else do; 1408 1409 st_pos = st_pos + h_index; 1410 1411 if st_pos > wl - 1 1412 then cont_flag1 = "0"b; 1413 substr (wb, st_pos - 1, 1) = "h"; 1414 1415 end; 1416 end; 1417 1418 end; 1419 end; 1420 1421 end; 1422 end; 1423 1424 substr (picture.string, 1, wl) = substr (wb, 1, wl); 1425 1426 if per = "." 1427 then goto gen_per; 1428 1429 /*[4.2-7]*/ 1430 if per = "," /*[4.2-7]*/ 1431 then if fixed_common.comp_level < "3" 1432 /*[4.2-7]*/ 1433 then call lev_diag (cobol_c_l_n, save_pcol, 2); 1434 /* ,; as separator */ 1435 1436 return; 1437 end; 1438 1439 goto p_p2; 1440 1441 end; 1442 1443 call ill_dlm; /* something fishy here */ 1444 1445 /* INTERNAL DEBUG ELEMENT */ 1446 1447 1448 call ill_char; 1449 return; 1450 1451 initialize: 1452 entry; 1453 1454 /*[4.4-2]*/ 1455 period_sw, save_sw, alpha_lit_bit = "0"b; 1456 1457 /*[4.0-5]*/ 1458 return; 1459 1460 /*[4.4-2]*/ 1461 dcl alpha_lit_bit bit (1) static internal; 1462 1463 alpha_lit: 1464 entry returns (bit (1)); 1465 1466 /*[4.4-2]*/ 1467 return (alpha_lit_bit); 1468 1469 set_table: 1470 entry; 1471 1472 /*[4.4-3]*/ 1473 if substr (fixed_common.compile_mode, 4, 1) /*[4.4-3]*/ 1474 then do; 1475 mem_tab (36) = "10100000"b; /* $ */ 1476 /*[4.4-3]*/ 1477 mem_tab (95) = "10100000"b; /* _ */ 1478 1479 /*[4.4-3]*/ 1480 x (36) = 1; /* $ */ 1481 /*[4.4-3]*/ 1482 x (95) = 1; /* _ */ 1483 /*[4.4-3]*/ 1484 end; /*[4.4-3]*/ 1485 else do; 1486 mem_tab (36) = "00100000"b; /*[4.4-3]*/ 1487 mem_tab (95) = "00100000"b; 1488 1489 /*[4.4-3]*/ 1490 x (36) = 10; /*[4.4-3]*/ 1491 x (95) = 10; /*[4.4-3]*/ 1492 end; 1493 1494 return; 1495 1496 swm: 1497 proc; 1498 1499 1500 /* ========================================================================== */ 1501 /* */ 1502 /* this procedure is used to scan a string of characters while they all */ 1503 /* belong to the same set of characters. its paramaters are:: */ 1504 /* mask--membership to be scanned for. */ 1505 /* ons--output string from the scan. */ 1506 /* onp--output position(updated) from the scan. */ 1507 /* */ 1508 /* ========================================================================== */ 1509 1510 slen = cobol_cards.nr_char; 1511 swm_loop: 1512 if mem_tab (fixed (unspec (substr (cobol_cards.name, slen, 1)), 35)) & mask 1513 then do; 1514 slen = slen + 1; 1515 go to swm_loop; 1516 end; 1517 1518 slen = slen - cobol_cards.nr_char; 1519 1520 1521 if slen = 0 1522 then return; 1523 1524 if slen + wl - 1 > wll 1525 then do; 1526 cobol_cards.nr_char = cobol_cards.nr_char + slen; 1527 lerr = "1"b; 1528 return; 1529 end; 1530 else lerr = "0"b; 1531 1532 substr (wb, wl, slen + 1) = substr (cobol_cards.name, cobol_cards.nr_char, slen + 1); 1533 cobol_cards.nr_char = cobol_cards.nr_char + slen; 1534 wl = wl + slen; 1535 end swm; 1536 1537 scan_off: 1538 proc; 1539 scan_off1: 1540 if ^mem_tab (fixed (unspec (substr (cobol_cards.name, cobol_cards.nr_char, 1)), 35)) & "00001000"b 1541 then do; 1542 cobol_cards.nr_char = cobol_cards.nr_char + 1; 1543 goto scan_off1; 1544 end; 1545 1546 if substr (cobol_cards.name, cobol_cards.nr_char, 1) = cobol_new_line_character 1547 then do; 1548 call cobol_merge; 1549 1550 if cobol_continuation = "1"b 1551 then do; 1552 cobol_continuation = "0"b; /*[4.4-2]*/ 1553 /* CONT = "1"b; */ 1554 goto scan_off1; 1555 end; 1556 end; 1557 end scan_off; 1558 1559 ill_dlm: 1560 proc; 1561 call cobol_lexerr$lexerr3 (6, "0"b, 0, " "); 1562 end ill_dlm; 1563 1564 ill_dlm1: 1565 proc; 1566 call cobol_lexerr$lexerr3 (30, "0"b, 0, " "); 1567 1568 if fixed_common.comp_level < "5" /*[3.0-2]*/ 1569 then call lev_diag (reserved_word.line, /*[3.0-2]*/ 1570 reserved_word.column, /*[3.0-2]*/ 1571 44 /*[3.0-2]*/); /*[3.0-2]*/ 1572 1573 1574 end ill_dlm1; 1575 1576 ill_dlm2: 1577 proc; 1578 call cobol_lexerr$lexerr3 (31, "0"b, 0, " "); 1579 1580 if fixed_common.comp_level < "5" /*[3.0-2]*/ 1581 then call lev_diag (reserved_word.line, /*[3.0-2]*/ 1582 reserved_word.column, /*[3.0-2]*/ 1583 44 /*[3.0-2]*/); /*[3.0-2]*/ 1584 1585 1586 end ill_dlm2; 1587 1588 /*[4.0-1]*/ 1589 init_tok_string: 1590 entry; 1591 1592 /*[4.0-1]*/ 1593 prev_tok_type = 0; /*[4.0-1]*/ 1594 tok_string = "~"; 1595 1596 /*[4.0-1]*/ 1597 call cobol_ddsyntax$init_tok_string; 1598 1599 /*[4.0-1]*/ 1600 return; 1601 1602 /*[4.0-1]*/ 1603 dcl cobol_ddsyntax$init_tok_string 1604 entry; /*[4.0-1]*/ 1605 dcl cobol_ddsyntax$enter_tok_string 1606 entry (char (36) varying); 1607 1608 /*[4.0-1]*/ 1609 dcl prev_tok_type fixed bin static internal; /*[4.0-1]*/ 1610 dcl tok_string char (1024) varying static internal; 1611 1612 /*[4.0-1]*/ 1613 dcl ch36 char (36) varying, 1614 int_val fixed bin; 1615 1616 /*[4.0-2]*/ 1617 dcl posit fixed bin, 1618 ch char (1), 1619 linfo bit (8); 1620 1621 1622 dcl lower_case_alphabet char (128) static options (constant) init (" 1623  !""#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\]^_`abcdefghijklmnopqrstuvwxyz{|}~"); 1624 dcl upper_case_alphabet char (128) static options (constant) init (" 1625  !""#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~"); 1626 1627 1628 /* +46 [] ->{} 1629*/* process EXPONENT expression %/ 1630*/* 1631*/* exp_sw = "1"b; 1632*/* cobol_cards.nr_char = cobol_cards.nr_char + 1; /* skip the e %/ 1633*/* if substr(cobol_cards.name, cobol_cards.nr_char, 1) = cobol_new_line_character then 1634*/* do; 1635*/* call cobol_merge; 1636*/* if cobol_continuation = "1"b then 1637*/* do; 1638*/* cobol_continuation = "0"b; 1639*/* goto d3; 1640*/* end; 1641*/* end; 1642*/* 1643*/*d3: 1644*/* 1645*/* c1 = substr(cobol_cards.name,cobol_cards.nr_char,1); 1646*/* if mem_tab(unspec(c1)) & "01000000"b then 1647*/* goto d4; 1648*/* if (c1 = "+") | (c1 = "-") then 1649*/* do; 1650*/* exp_sign = c1; 1651*/* cobol_cards.nr_char = cobol_cards.nr_char + 1; 1652*/* goto d4; 1653*/* end; 1654*/* 1655*/* not an exponent expression %/ 1656*/* 1657*/* cobol_cards.nr_char = cobol_cards.nr_char - 1; /* back up one character %/ 1658*/* goto build_nlt; 1659*/* 1660*/* accumulate exponent value now %/ 1661*/* 1662*/*d4: 1663*/* 1664*/* mask = "01000000"b; 1665*/* wll = 18; 1666*/* call swm; 1667*/* if lerr then goto nl_l_err; 1668*/* if substr(cobol_cards.name, cobol_cards.nr_char, 1) = cobol_new_line_character then 1669*/* do; 1670*/* call cobol_merge; 1671*/* if cobol_continuation = "1"b then 1672*/* do; 1673*/* cobol_continuation = "0"b; 1674*/* goto d4; 1675*/* end; 1676*/* end; 1677*/* goto build_nlt; 1678*/* -46 []->{} */ 1679 1680 1681 /* +68 []->{} 1682*/* bitstr_sw = "0"b; 1683*/* goto b_s1a; 1684*/*b_s1: /* continuation loop label %/ 1685*/* if substr(cobol_cards.name, cobol_cards.nr_char, 1) ^= """" then 1686*/* do; 1687*/*{%/ call cobol_lexerr$lexerr3(5,"1"b,0," "); /*}%/ 1688*/* call scan_off; 1689*/* return; 1690*/* end; 1691*/*b_s1a: 1692*/* cobol_cards.nr_char = cobol_cards.nr_char + 1; 1693*/* mask = "00010000"b; 1694*/* wll = /*{{{ 64 }}}%/ /*{%/ 200 /*}%/; 1695*/* call swm; 1696*/* if lerr then goto al_l_err; 1697*/* if substr(cobol_cards.name, cobol_cards.nr_char, 1) = cobol_new_line_character then 1698*/* do; 1699*/* call cobol_merge; 1700*/* if cobol_continuation = "1"b then 1701*/* do; 1702*/* cobol_continuation = "0"b; 1703*/* goto b_s1; 1704*/* end; 1705*/* end; 1706*/* if substr(cobol_cards.name,cobol_cards.nr_char,1) = """" then 1707*/* do; /* tail delimiter %/ 1708*/* if substr(cobol_cards.name, cobol_cards.nr_char + 1, 1) = """" then goto proc_quote; 1709*/* cobol_cards.nr_char = cobol_cards.nr_char + 1; 1710*/* 1711*/*b_s2: /* final delimiter processing %/ 1712*/* 1713*/* if substr(cobol_cards.name, cobol_cards.nr_char, 1) = cobol_new_line_character then 1714*/* do; 1715*/* call cobol_merge; 1716*/* if cobol_continuation = "1"b then 1717*/* do; 1718*/* cobol_continuation = "0"b; 1719*/* goto b_s2; 1720*/* end; 1721*/* end; 1722*/* hc = substr(cobol_cards.name, cobol_cards.nr_char, 1); 1723*/* hc = hexl_tab(unspec(hc)); 1724*/* if unspec(hc) ^= "0"b then goto next_hex2; 1725*/* if substr(cobol_cards.name,cobol_cards.nr_char,1) = "b" | substr(cobol_cards.name, cobol_cards.nr_char, 1) = "B" then 1726*/* do; 1727*/* bitstr_sw = "1"b; 1728*/* cobol_cards.nr_char = cobol_cards.nr_char + 1; 1729*/* end; 1730*/* 1731*/* goto build_alt; 1732*/* end; 1733*/* if substr(cobol_cards.name,cobol_cards.nr_char,1)^="(" then 1734*/* goto s3; /* only item allowed %/ 1735*/* goto s3; /* *** This bypasses the repitition code *** %/ 1736*/* cobol_cards.nr_char = cobol_cards.nr_char + 1; 1737*/* rep_factor = 0; 1738*/* 1739*/*b_s4: 1740*/* 1741*/* do while (mem_tab(unspec(substr(cobol_cards.name,cobol_cards.nr_char,1))) & "01000000"b ); 1742*/* rep_factor = rep_factor * 10 + unspec(substr(cobol_cards.name,cobol_cards.nr_char,1)) - 1743*/* /*{{{ 240 }}}%/ /*{%/ 48 /*}%/; 1744*/* cobol_cards.nr_char = cobol_cards.nr_char + 1; 1745*/* end; /* digit accumulation loop %/ 1746*/* if substr(cobol_cards.name, cobol_cards.nr_char, 1) = cobol_new_line_character then 1747*/* do; 1748*/* call cobol_merge; 1749*/* if cobol_continuation = "1"b then 1750*/* do; 1751*/* cobol_continuation = "0"b; 1752*/* goto b_s4; 1753*/* end; 1754*/* end; 1755*/* do rep_factor = rep_factor-1 by -1 to 1; 1756*/* substr(wb,wl,1) = 1757*/* substr(wb,wl-1,1); /* duplicate te character %/ 1758*/* wl = wl + 1; 1759*/* end; /* expansion part %/ 1760*/* 1761*/*b_s3: 1762*/* 1763*/* if substr(cobol_cards.name, cobol_cards.nr_char, 1) = cobol_new_line_character then 1764*/* do; 1765*/* call cobol_merge; 1766*/* if cobol_continuation = "1"b then 1767*/* do; 1768*/* cobol_continuation = "0"b; 1769*/* goto b_s3; 1770*/* end; 1771*/* end; 1772*/* if substr(cobol_cards.name,cobol_cards.nr_char,1)^=")" /* improper delimiter %/ 1773*/* then do; call ill_char; 1774*/* return; 1775*/* end; 1776*/* goto b_s1a; 1777*/* -68 []->{} */ 1778 1779 /* +67 []->{} *->% 1780*/* 1781*/* cobol_cards.nr_char = cobol_cards.nr_char + 1; /* skip the starting character %/ 1782*/* 1783*/*d_c1: 1784*/* 1785*/* call cobol_insert_token(8); 1786*/* user_word.length = 1; 1787*/* call swm("10000000"b,addr(user_word.word),user_word.length, 3); 1788*/* if lerr then do; call ill_char; 1789*/* return; 1790*/* end; 1791*/* 1792*/* we should now have either "on" or "off" %/ 1793*/* 1794*/*dcl (p,q) pointer static, 1795*/* (i, j) fixed bin static, 1796*/* xp bit (1) static; 1797*/* p = cobol_current; /* save the location within the stack %/ 1798*/* if substr(user_word.word,1,2) = "ON" then 1799*/* xp = "1"b; 1800*/* else 1801*/* if substr(user_word.word,1,3) = "OFF" then 1802*/* xp = "0"b; 1803*/* else do; call ill_char 1804*/* return; 1805*/* end; 1806*/* call cobol_gns; /* get the next symbol %/ 1807*/* if reserved_word.type = 1 then 1808*/* if reserved_word.key = xleft_paren then goto l2; 1809*/* else; 1810*/* else call lexerr(14, "0"b, 1, "("); /* missing ( %/ 1811*/* 1812*/*l2: 1813*/* 1814*/* call cobol_gns; /* get the first digit value %/ 1815*/* if reserved_word.type ^= 1 then goto l2; 1816*/* if reserved_word.key ^= xright_paren then goto l2; 1817*/* q = cobol_current; /* save the top end of the string %/ 1818*/* cobol_current = p; /* reset token stack %/ 1819*/* do while (cobol_current ^= q); 1820*/* if numeric_lit.type = 2 then 1821*/* do; /* valid item maybe %/ 1822*/* 1823*/* NOTICE==HANDLE CASE OF OUR OWN DEBUG ITEMS FIRST>> %/ 1824*/* 1825*/* i = 0; 1826*/* do j = 1 to numeric_lit.places; 1827*/* if mem_tab(unspec(substr(numeric_lit.literal,j,1))) & "01000000"b then 1828*/* i = i * 10 + unspec(substr(numeric_lit.literal,j,1)) - 48; 1829*/* end; 1830*/* if i <= 25 then 1831*/* bug(i) = xp; 1832*/* else 1833*/* do; /* not ours %/ 1834*/* 1835*/* set type and value into element %/ 1836*/* debug.type = 24; 1837*/* debug.size = 21; /* mark exact element size %/ 1838*/* debug.on_off = xp; 1839*/* debug.debug_index = i; 1840*/* end; 1841*/* end; /* element completed %/ 1842*/* cobol_current = numeric_lit.fwd_link; /* advance token index %/ 1843*/* end; 1844*/* cobol_current = q; 1845*/* call cobol_delete_tokens(p,q); 1846*/* call cobol_gns; /* make the actual token active %/ 1847*/* if (bug(1)) then call trace ("EXIT GNS--debug section"); 1848*/* return; 1849*/* -67 []->{} *->% */ 1850 1851 /* This variable is used to contain the column number to assign to COLUMN */ 1852 /* in the token header. It is either the actual source */ 1853 /* column number or 0 (for all columns inserted for debug */ 1854 1855 /*[4.2-6]*/ 1856 declare TOK_COLUMN fixed bin; 1 1 1 2 /* BEGIN INCLUDE FILE ... cobol_ext_lex.incl.pl1 */ 1 3 /* Last modified on 06/18/76 by ORN */ 1 4 1 5 /* * * * LEX EXTERNAL DATA * * * */ 1 6 1 7 /* Pointers */ 1 8 1 9 dcl cobol_ext_lex$cobol_current ptr ext; 1 10 dcl cobol_current ptr defined ( cobol_ext_lex$cobol_current); 1 11 dcl cobol_ext_lex$cobol_top ptr ext; 1 12 dcl cobol_top ptr defined ( cobol_ext_lex$cobol_top); 1 13 dcl cobol_ext_lex$cobol_frst ptr ext; 1 14 dcl cobol_frst ptr defined ( cobol_ext_lex$cobol_frst); 1 15 dcl cobol_ext_lex$cobol_mfp ptr ext; 1 16 dcl cobol_mfp ptr defined ( cobol_ext_lex$cobol_mfp); 1 17 dcl cobol_ext_lex$cobol_rt_ptr ptr ext; 1 18 dcl cobol_rt_ptr ptr defined ( cobol_ext_lex$cobol_rt_ptr); 1 19 dcl cobol_ext_lex$cobol_cfp ptr ext; 1 20 dcl cobol_cfp ptr defined ( cobol_ext_lex$cobol_cfp); 1 21 dcl cobol_ext_lex$cobol_ta_ptr ptr ext; 1 22 dcl cobol_ta_ptr ptr defined ( cobol_ext_lex$cobol_ta_ptr); 1 23 dcl cobol_ext_lex$cobol_elt_buf_ptr ptr ext; 1 24 dcl cobol_elt_buf_ptr ptr defined ( cobol_ext_lex$cobol_elt_buf_ptr); 1 25 dcl cobol_ext_lex$cobol_lex_exit /*[*/ label /*]*/ /*[[[ entry static ]]]*/ ext; 1 26 dcl cobol_lex_exit /*[*/ label /*]*/ /*[[[ entry static ]]]*/ defined( cobol_ext_lex$cobol_lex_exit); /* -6- */ 1 27 1 28 /* Character */ 1 29 1 30 dcl cobol_ext_lex$cobol_tarea char (300) ext; 1 31 dcl cobol_tarea char (300) defined ( cobol_ext_lex$cobol_tarea); /* -75- */ 1 32 dcl cobol_ext_lex$cobol_comma_character char (1) ext; 1 33 dcl cobol_comma_character char (1) defined ( cobol_ext_lex$cobol_comma_character); 1 34 dcl cobol_ext_lex$cobol_decimal_point_character char (1) ext; 1 35 dcl cobol_decimal_point_character char (1) defined ( cobol_ext_lex$cobol_decimal_point_character); 1 36 dcl cobol_ext_lex$cobol_new_line_character char (1) ext; 1 37 dcl cobol_new_line_character char (1) defined ( cobol_ext_lex$cobol_new_line_character); 1 38 dcl cobol_ext_lex$cobol_si_key char (5) ext; 1 39 dcl cobol_si_key char (5) defined ( cobol_ext_lex$cobol_si_key); /* -2- */ 1 40 dcl cobol_ext_lex$cobol_so_key char (5) ext; 1 41 dcl cobol_so_key char (5) defined ( cobol_ext_lex$cobol_so_key); /* -2- */ 1 42 1 43 /* Fixed bin */ 1 44 1 45 dcl cobol_ext_lex$ph_num fixed bin ext; 1 46 dcl ph_num fixed bin defined(cobol_ext_lex$ph_num ); 1 47 dcl cobol_ext_lex$cobol_c_l_n fixed bin ext; 1 48 dcl cobol_c_l_n fixed bin defined ( cobol_ext_lex$cobol_c_l_n); 1 49 dcl cobol_ext_lex$cobol_save_cln fixed bin ext; 1 50 dcl cobol_save_cln fixed bin defined ( cobol_ext_lex$cobol_save_cln); 1 51 dcl cobol_ext_lex$cobol_save_col fixed bin ext; 1 52 dcl cobol_save_col fixed bin defined ( cobol_ext_lex$cobol_save_col); 1 53 dcl cobol_ext_lex$cobol_name_number fixed bin ext; 1 54 dcl cobol_name_number fixed bin defined ( cobol_ext_lex$cobol_name_number); 1 55 dcl cobol_ext_lex$cobol_section_number fixed bin ext; 1 56 dcl cobol_section_number fixed bin defined ( cobol_ext_lex$cobol_section_number); 1 57 dcl cobol_ext_lex$cobol_sr fixed bin ext; 1 58 dcl cobol_sr fixed bin defined ( cobol_ext_lex$cobol_sr); 1 59 dcl cobol_ext_lex$cobol_elt_idx fixed bin ext; 1 60 dcl cobol_elt_idx fixed bin defined ( cobol_ext_lex$cobol_elt_idx); 1 61 1 62 /* Structures */ 1 63 1 64 dcl 1 cobol_ext_lex$cobol_cards ext like cobol_cards; 1 65 dcl 1 cobol_cards defined ( cobol_ext_lex$cobol_cards), /* -67- */ 1 66 2 column fixed bin, 1 67 2 tblanks fixed bin, 1 68 2 nr_char fixed bin, 1 69 2 name char (256); 1 70 1 71 /* Bits */ 1 72 1 73 dcl cobol_ext_lex$processing_report bit(1) ext; 1 74 dcl processing_report bit (1) defined (cobol_ext_lex$processing_report); 1 75 dcl cobol_ext_lex$real_end_report bit (1) ext; 1 76 dcl real_end_report bit (1) defined (cobol_ext_lex$real_end_report); 1 77 dcl cobol_ext_lex$cobol_continuation bit (1) ext; 1 78 dcl cobol_continuation bit (1) defined ( cobol_ext_lex$cobol_continuation); 1 79 dcl cobol_ext_lex$cobol_pic_switch bit (1) ext; 1 80 dcl cobol_pic_switch bit (1) defined ( cobol_ext_lex$cobol_pic_switch); 1 81 dcl cobol_ext_lex$cobol_allo_init_sw bit (1) ext; 1 82 dcl cobol_allo_init_sw bit (1) defined ( cobol_ext_lex$cobol_allo_init_sw); 1 83 dcl cobol_ext_lex$cobol_lu_sw bit (1) ext; 1 84 dcl cobol_lu_sw bit (1) defined ( cobol_ext_lex$cobol_lu_sw); 1 85 dcl cobol_ext_lex$cobol_scanoff_sw bit (1) ext; 1 86 dcl cobol_scanoff_sw bit (1) defined ( cobol_ext_lex$cobol_scanoff_sw); 1 87 dcl cobol_ext_lex$cobol_output_sw bit (1) ext; 1 88 dcl cobol_output_sw bit (1) defined ( cobol_ext_lex$cobol_output_sw); 1 89 dcl cobol_ext_lex$cobol_stack_sw bit (1) ext; 1 90 dcl cobol_stack_sw bit (1) defined ( cobol_ext_lex$cobol_stack_sw); 1 91 dcl cobol_ext_lex$cobol_copy_found bit (1) ext; 1 92 dcl cobol_copy_found bit (1) defined ( cobol_ext_lex$cobol_copy_found); 1 93 dcl cobol_ext_lex$cobol_head_words (5) bit (1) ext; 1 94 dcl cobol_head_words (5) bit (1) defined ( cobol_ext_lex$cobol_head_words); 1 95 dcl cobol_ext_lex$cobol_elnp_sw bit (1) ext; 1 96 dcl cobol_elnp_sw bit (1) defined ( cobol_ext_lex$cobol_elnp_sw); 1 97 dcl cobol_ext_lex$cobol_dp_sw bit (1) ext; 1 98 dcl cobol_dp_sw bit (1) defined ( cobol_ext_lex$cobol_dp_sw); 1 99 dcl cobol_ext_lex$cobol_endprog_sw bit (1) ext; 1 100 dcl cobol_endprog_sw bit (1) defined ( cobol_ext_lex$cobol_endprog_sw); 1 101 dcl cobol_ext_lex$cobol_debug_mode bit (1) ext; 1 102 dcl cobol_debug_mode bit (1) defined ( cobol_ext_lex$cobol_debug_mode); 1 103 dcl cobol_ext_lex$cobol_rwt_init_sw bit (1) ext; 1 104 dcl cobol_rwt_init_sw bit (1) defined ( cobol_ext_lex$cobol_rwt_init_sw); 1 105 dcl cobol_ext_lex$cobol_init_ta_sw bit (1) ext; 1 106 dcl cobol_init_ta_sw bit (1) defined ( cobol_ext_lex$cobol_init_ta_sw); 1 107 dcl cobol_ext_lex$cobol_rep_sw bit (1) ext; 1 108 dcl cobol_rep_sw bit (1) defined ( cobol_ext_lex$cobol_rep_sw); 1 109 dcl cobol_ext_lex$cobol_copy_active bit (1) ext; 1 110 dcl cobol_copy_active bit (1) defined ( cobol_ext_lex$cobol_copy_active); 1 111 dcl cobol_ext_lex$cobol_ln_sw (2) bit (1) ext; 1 112 dcl cobol_ln_sw (2) bit (1) defined ( cobol_ext_lex$cobol_ln_sw); 1 113 dcl cobol_ext_lex$cobol_prime_sw bit (1) ext; 1 114 dcl cobol_prime_sw bit (1) defined ( cobol_ext_lex$cobol_prime_sw); 1 115 dcl cobol_ext_lex$cobol_rec1_sw (2) bit (1) ext; 1 116 dcl cobol_rec1_sw (2) bit (1) defined ( cobol_ext_lex$cobol_rec1_sw); 1 117 dcl cobol_ext_lex$cobol_progid_sw bit(1) ext; 1 118 dcl cobol_progid_sw bit(1) defined ( cobol_ext_lex$cobol_progid_sw); 1 119 1 120 1 121 /* * * * END LEX EXTERNAL DATA * * * */ 1 122 /* END INCLUDE FILE ... cobol_ext_lex.incl.pl1 */ 1 123 1857 2 1 2 2 /* BEGIN INCLUDE FILE ... cobol_hexl_tab.incl.pl1 */ 2 3 2 4 dcl hexl_tab(0: 511) char(1) based(addr(hexl_tab1)); 2 5 dcl hexl_tab1(0: 511) bit(9) static init( 2 6 "000000000"b /* (NUL) 000 0 */ , 2 7 "000000000"b /* (SOH) 001 1 */ , 2 8 "000000000"b /* (STX) 002 2 */ , 2 9 "000000000"b /* (ETX) 003 3 */ , 2 10 "000000000"b /* (EOT) 004 4 */ , 2 11 "000000000"b /* (ENQ) 005 5 */ , 2 12 "000000000"b /* (ACK) 006 6 */ , 2 13 "000000000"b /* BEL 007 7 */ , 2 14 "000000000"b /* BS 010 8 */ , 2 15 "000000000"b /* HT 011 9 */ , 2 16 "000000000"b /* NL(LF) 012 10 */ , 2 17 "000000000"b /* VT 013 11 */ , 2 18 "000000000"b /* NP(FF) 014 12 */ , 2 19 "000000000"b /* (CR) 015 13 */ , 2 20 "000000000"b /* RRS(S0) 016 14 */ , 2 21 "000000000"b /* BRS(S1) 017 15 */ , 2 22 "000000000"b /* (DLE) 020 16 */ , 2 23 "000000000"b /* (DC1) 021 17 */ , 2 24 "000000000"b /* HLF(DC2) 022 18 */ , 2 25 "000000000"b /* (DC3) 023 19 */ , 2 26 "000000000"b /* HLR(DC4) 024 20 */ , 2 27 "000000000"b /* (NAK) 025 21 */ , 2 28 "000000000"b /* (SYN) 026 22 */ , 2 29 "000000000"b /* (ETB) 027 23 */ , 2 30 "000000000"b /* (CAN) 030 24 */ , 2 31 "000000000"b /* (EM) 031 25 */ , 2 32 "000000000"b /* (SUB) 032 26 */ , 2 33 "000000000"b /* (ESC) 033 27 */ , 2 34 "000000000"b /* (FS) 034 28 */ , 2 35 "000000000"b /* (GS) 035 29 */ , 2 36 "000000000"b /* (RS) 036 30 */ , 2 37 "000000000"b /* (US) 037 31 */ , 2 38 "000000000"b /* Space 040 32 */ , 2 39 "000000000"b /* ! 041 33 */ , 2 40 "000000000"b /* " 042 34 */ , 2 41 "000000000"b /* # 043 35 */ , 2 42 "000000000"b /* $ 044 36 */ , 2 43 "000000000"b /* % 045 37 */ , 2 44 "000000000"b /* & 046 38 */ , 2 45 "000000000"b /* ' 047 39 */ , 2 46 "000000000"b /* ( 050 40 */ , 2 47 "000000000"b /* ) 051 41 */ , 2 48 "000000000"b /* * 052 42 */ , 2 49 "000000000"b /* + 053 43 */ , 2 50 "000000000"b /* , 054 44 */ , 2 51 "000000000"b /* - 055 45 */ , 2 52 "000000000"b /* . 056 46 */ , 2 53 "000000000"b /* / 057 47 */ , 2 54 "000100000"b /* 0 060 48 */ , 2 55 "000100001"b /* 1 061 49 */ , 2 56 "000100010"b /* 2 062 50 */ , 2 57 "000100011"b /* 3 063 51 */ , 2 58 "000100100"b /* 4 064 52 */ , 2 59 "000100101"b /* 5 065 53 */ , 2 60 "000100110"b /* 6 066 54 */ , 2 61 "000100111"b /* 7 067 55 */ , 2 62 "000101000"b /* 8 070 56 */ , 2 63 "000101001"b /* 9 071 57 */ , 2 64 "000000000"b /* : 072 58 */ , 2 65 "000000000"b /* ; 073 59 */ , 2 66 "000000000"b /* < 074 60 */ , 2 67 "000000000"b /* = 075 61 */ , 2 68 "000000000"b /* > 076 62 */ , 2 69 "000000000"b /* ? 077 63 */ , 2 70 "000000000"b /* @ 100 64 */ , 2 71 "000101010"b /* A 101 65 */ , 2 72 "000101011"b /* B 102 66 */ , 2 73 "000101100"b /* C 103 67 */ , 2 74 "000101101"b /* D 104 68 */ , 2 75 "000101110"b /* E 105 69 */ , 2 76 "000101111"b /* F 106 70 */ , 2 77 "000110000"b /* G 107 71 */ , 2 78 "000110001"b /* H 110 72 */ , 2 79 "000110010"b /* I 111 73 */ , 2 80 "000110011"b /* J 112 74 */ , 2 81 "000110100"b /* K 113 75 */ , 2 82 "000110101"b /* L 114 76 */ , 2 83 "000110110"b /* M 115 77 */ , 2 84 "000110111"b /* N 116 78 */ , 2 85 "000111000"b /* O 117 79 */ , 2 86 "000111001"b /* P 120 80 */ , 2 87 "000111010"b /* Q 121 81 */ , 2 88 "000111011"b /* R 122 82 */ , 2 89 "000111100"b /* S 123 83 */ , 2 90 "000111101"b /* T 124 84 */ , 2 91 "000111110"b /* U 125 85 */ , 2 92 "000111111"b /* V 126 86 */ , 2 93 "000000000"b /* W 127 87 */ , 2 94 "000000000"b /* X 130 88 */ , 2 95 "000000000"b /* Y 131 89 */ , 2 96 "000000000"b /* Z 132 90 */ , 2 97 "000000000"b /* [ 133 91 */ , 2 98 "000000000"b /* \ 134 92 */ , 2 99 "000000000"b /* ] 135 93 */ , 2 100 "000000000"b /* ^ 136 94 */ , 2 101 "000000000"b /* _ 137 95 */ , 2 102 "000000000"b /* ` 140 96 */ , 2 103 "000101010"b /* a 141 97 */ , 2 104 "000101011"b /* b 142 98 */ , 2 105 "000101100"b /* c 143 99 */ , 2 106 "000101101"b /* d 144 100 */ , 2 107 "000101110"b /* e 145 101 */ , 2 108 "000101111"b /* f 146 102 */ , 2 109 "000110000"b /* g 147 103 */ , 2 110 "000110001"b /* h 150 104 */ , 2 111 "000110010"b /* i 151 105 */ , 2 112 "000110011"b /* j 152 106 */ , 2 113 "000110100"b /* k 153 107 */ , 2 114 "000110101"b /* l 154 108 */ , 2 115 "000110110"b /* m 155 109 */ , 2 116 "000110111"b /* n 156 110 */ , 2 117 "000111000"b /* o 157 111 */ , 2 118 "000111001"b /* p 160 112 */ , 2 119 "000111010"b /* q 161 113 */ , 2 120 "000111011"b /* r 162 114 */ , 2 121 "000111100"b /* s 163 115 */ , 2 122 "000111101"b /* t 164 116 */ , 2 123 "000111110"b /* u 165 117 */ , 2 124 "000111111"b /* v 166 118 */ , 2 125 "000000000"b /* w 167 119 */ , 2 126 "000000000"b /* x 170 120 */ , 2 127 "000000000"b /* y 171 121 */ , 2 128 "000000000"b /* z 172 122 */ , 2 129 "000000000"b /* { 173 123 */ , 2 130 "000000000"b /* | 174 124 */ , 2 131 "000000000"b /* } 175 125 */ , 2 132 "000000000"b /* ~ 176 126 */ , 2 133 "000000000"b /* DEL 177 127 */ , 2 134 (384)(1)"000000000"b 2 135 ); 2 136 2 137 /* END INCLUDE FILE ... cobol_hexl_tab.incl.pl1 */ 2 138 1858 3 1 3 2 /* BEGIN INCLUDE FILE ... cobol_gns_tab.incl.pl1 */ 3 3 3 4 /* Membership table for scans and character look-ups */ 3 5 /* column 1: alphanumeric characters [0->9 a->z A->Z -] */ 3 6 /* column 2: digits [0->9] */ 3 7 /* column 3: picture characters [all printable characters except " ;] */ 3 8 /* column 4: binary characters [0 1] */ 3 9 /* column 5: delimiters [nl space " ( ) , . ;] */ 3 10 /* column 6: delimiters [. ; ,] */ 3 11 /* column 7: delimiters [nl sp] */ 3 12 /* column 8: delimiters [nl sp . ; ,] */ 3 13 3 14 dcl mem_tab(0: 511) bit(8) static init( 3 15 "00000000"b /* (NUL) 000 0 */ , 3 16 "00000000"b /* (SOH) 001 1 */ , 3 17 "00000000"b /* (STX) 002 2 */ , 3 18 "00000000"b /* (ETX) 003 3 */ , 3 19 "00000000"b /* (EOT) 004 4 */ , 3 20 "00000000"b /* (ENQ) 005 5 */ , 3 21 "00000000"b /* (ACK) 006 6 */ , 3 22 "00000000"b /* BEL 007 7 */ , 3 23 "00000000"b /* BS 010 8 */ , 3 24 "00000000"b /* HT 011 9 */ , 3 25 "00001011"b /* NL(LF) 012 10 */ , 3 26 "00000000"b /* VT 013 11 */ , 3 27 "00000000"b /* NP(FF) 014 12 */ , 3 28 "00000000"b /* (CR) 015 13 */ , 3 29 "00000000"b /* RRS(S0) 016 14 */ , 3 30 "00000000"b /* BRS(S1) 017 15 */ , 3 31 "00000000"b /* (DLE) 020 16 */ , 3 32 "00000000"b /* (DC1) 021 17 */ , 3 33 "00000000"b /* HLF(DC2) 022 18 */ , 3 34 "00000000"b /* (DC3) 023 19 */ , 3 35 "00000000"b /* HLR(DC4) 024 20 */ , 3 36 "00000000"b /* (NAK) 025 21 */ , 3 37 "00000000"b /* (SYN) 026 22 */ , 3 38 "00000000"b /* (ETB) 027 23 */ , 3 39 "00000000"b /* (CAN) 030 24 */ , 3 40 "00000000"b /* (EM) 031 25 */ , 3 41 "00000000"b /* (SUB) 032 26 */ , 3 42 "00000000"b /* (ESC) 033 27 */ , 3 43 "00000000"b /* (FS) 034 28 */ , 3 44 "00000000"b /* (GS) 035 29 */ , 3 45 "00000000"b /* (RS) 036 30 */ , 3 46 "00000000"b /* (US) 037 31 */ , 3 47 "00001011"b /* Space 040 32 */ , 3 48 "00100000"b /* ! 041 33 */ , 3 49 "00001000"b /* " 042 34 */ , 3 50 "00100000"b /* # 043 35 */ , 3 51 "00100000"b /* $ 044 36 */ , 3 52 "00100000"b /* % 045 37 */ , 3 53 "00100000"b /* & 046 38 */ , 3 54 "00100000"b /* ' 047 39 */ , 3 55 "00101000"b /* ( 050 40 */ , 3 56 "00101000"b /* ) 051 41 */ , 3 57 "00100000"b /* * 052 42 */ , 3 58 "00100000"b /* + 053 43 */ , 3 59 "00101101"b /* , 054 44 */ , 3 60 "10100000"b /* - 055 45 */ , 3 61 "00101101"b /* . 056 46 */ , 3 62 "00100000"b /* / 057 47 */ , 3 63 "11110000"b /* 0 060 48 */ , 3 64 "11110000"b /* 1 061 49 */ , 3 65 "11100000"b /* 2 062 50 */ , 3 66 "11100000"b /* 3 063 51 */ , 3 67 "11100000"b /* 4 064 52 */ , 3 68 "11100000"b /* 5 065 53 */ , 3 69 "11100000"b /* 6 066 54 */ , 3 70 "11100000"b /* 7 067 55 */ , 3 71 "11100000"b /* 8 070 56 */ , 3 72 "11100000"b /* 9 071 57 */ , 3 73 "00100000"b /* : 072 58 */ , 3 74 "00001101"b /* ; 073 59 */ , 3 75 "00100000"b /* < 074 60 */ , 3 76 "00101010"b /* = 075 61 */ , 3 77 "00100000"b /* > 076 62 */ , 3 78 "00100000"b /* ? 077 63 */ , 3 79 "00100000"b /* @ 100 64 */ , 3 80 "10100000"b /* A 101 65 */ , 3 81 "10100000"b /* B 102 66 */ , 3 82 "10100000"b /* C 103 67 */ , 3 83 "10100000"b /* D 104 68 */ , 3 84 "10100000"b /* E 105 69 */ , 3 85 "10100000"b /* F 106 70 */ , 3 86 "10100000"b /* G 107 71 */ , 3 87 "10100000"b /* H 110 72 */ , 3 88 "10100000"b /* I 111 73 */ , 3 89 "10100000"b /* J 112 74 */ , 3 90 "10100000"b /* K 113 75 */ , 3 91 "10100000"b /* L 114 76 */ , 3 92 "10100000"b /* M 115 77 */ , 3 93 "10100000"b /* N 116 78 */ , 3 94 "10100000"b /* O 117 79 */ , 3 95 "10100000"b /* P 120 80 */ , 3 96 "10100000"b /* Q 121 81 */ , 3 97 "10100000"b /* R 122 82 */ , 3 98 "10100000"b /* S 123 83 */ , 3 99 "10100000"b /* T 124 84 */ , 3 100 "10100000"b /* U 125 85 */ , 3 101 "10100000"b /* V 126 86 */ , 3 102 "10100000"b /* W 127 87 */ , 3 103 "10100000"b /* X 130 88 */ , 3 104 "10100000"b /* Y 131 89 */ , 3 105 "10100000"b /* Z 132 90 */ , 3 106 "00100000"b /* [ 133 91 */ , 3 107 "00100000"b /* \ 134 92 */ , 3 108 "00100000"b /* ] 135 93 */ , 3 109 "00100000"b /* ^ 136 94 */ , 3 110 "00100000"b /* _ 137 95 */ , 3 111 "00100000"b /* ` 140 96 */ , 3 112 "10100000"b /* a 141 97 */ , 3 113 "10100000"b /* b 142 98 */ , 3 114 "10100000"b /* c 143 99 */ , 3 115 "10100000"b /* d 144 100 */ , 3 116 "10100000"b /* e 145 101 */ , 3 117 "10100000"b /* f 146 102 */ , 3 118 "10100000"b /* g 147 103 */ , 3 119 "10100000"b /* h 150 104 */ , 3 120 "10100000"b /* i 151 105 */ , 3 121 "10100000"b /* j 152 106 */ , 3 122 "10100000"b /* k 153 107 */ , 3 123 "10100000"b /* l 154 108 */ , 3 124 "10100000"b /* m 155 109 */ , 3 125 "10100000"b /* n 156 110 */ , 3 126 "10100000"b /* o 157 111 */ , 3 127 "10100000"b /* p 160 112 */ , 3 128 "10100000"b /* q 161 113 */ , 3 129 "10100000"b /* r 162 114 */ , 3 130 "10100000"b /* s 163 115 */ , 3 131 "10100000"b /* t 164 116 */ , 3 132 "10100000"b /* u 165 117 */ , 3 133 "10100000"b /* v 166 118 */ , 3 134 "10100000"b /* w 167 119 */ , 3 135 "10100000"b /* x 170 120 */ , 3 136 "10100000"b /* y 171 121 */ , 3 137 "10100000"b /* z 172 122 */ , 3 138 "00100000"b /* { 173 123 */ , 3 139 "00100000"b /* | 174 124 */ , 3 140 "00100000"b /* } 175 125 */ , 3 141 "00100000"b /* ~ 176 126 */ , 3 142 "00000000"b /* DEL 177 127 */ , 3 143 (384)(1)"00000000"b 3 144 ); 3 145 3 146 dcl x(0: 511) fixed bin (8) static init ( 3 147 10 ,10 ,10 ,10 ,10 ,10 ,10 ,10 ,10 ,10 ,12 ,10 ,10 ,10 ,10 ,10 ,10 ,10 , 3 148 10 ,10 ,10 ,10 ,10 ,10 ,10 ,10 ,10 ,10 ,10 ,10 ,10 ,10 ,12 ,10 ,3 ,10 , 3 149 10 ,8 ,10 ,4 ,11 ,13 ,7 ,6 ,5 ,18 ,14 ,9 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ,2 , 3 150 10 ,5 ,16 ,15 ,17 ,10 ,10 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 , 3 151 1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,10 ,10 ,10 , 3 152 10 ,10 ,10 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 , 3 153 1 ,1 ,1 ,1 ,1 ,1 ,10 ,10 ,10 ,10 ,10, 3 154 (384)10 3 155 ); /* end switch */ 3 156 3 157 /* END INCLUDE FILE ... cobol_gns_tab.incl.pl1 */ 3 158 1859 4 1 4 2 /* BEGIN INCLUDE FILE ... cobol_fixed_common.incl.pl1 */ 4 3 /* Modified on 10/27/82 by FCH, [5.1-1], cobol_cln added to save last line num, BUG543(phx13643) */ 4 4 /* Modified on 07/31/80 by FCH, [4.3-1], use_reporting field added for Report Writer */ 4 5 /* Modified on 03/30/79 by FCH, [4.1-1], -card option added */ 4 6 /* Modified on 03/30/79 by FCH, [4.0-2], -svNM option added */ 4 7 /* Modified on 03/02/79 by FCH, [4.0-1], -levNM option added */ 4 8 /* Modified by RAL on 10/13/78, [4.0-0], Added option exp from fil2. */ 4 9 /* Modified by BC on 06/20/77, descriptor added. */ 4 10 /* Modified by BC on 06/02/77, init_cd_seg, init_cd_offset added. */ 4 11 /* Modified by BC on 1/21/77, options.profile added. */ 4 12 /* Modified by FCH on 7/6/76, sysin_fno & sysout_fno deleted, accept_device & display_device added */ 4 13 /* Modified by FCH on 5/20/77, comp_level added */ 4 14 4 15 4 16 /* THE SIZE OF THIS STRUCTURE IN BYTES, (EXCLUDING VARIABLE 4 17* LENGTH ENTITIES), FOR EACH HARDWARE IMPLEMENTATION IS: 4 18* 4 19* HARDWARE | SIZE (BYTES) 4 20* --------------------------------- 4 21* 645/6180 | 464 4 22* P7 | 396 4 23* --------------------------------- 4 24* */ 4 25 4 26 dcl 1 fixed_common based ( cobol_com_ptr), 4 27 2 prog_name char (30), 4 28 2 compiler_rev_no char (25), 4 29 2 phase_name char (6), 4 30 2 currency char (1), 4 31 2 fatal_no fixed bin, 4 32 2 warn_no fixed bin, 4 33 2 proc_counter fixed bin, 4 34 2 spec_tag_counter fixed bin, 4 35 2 file_count fixed bin, 4 36 2 filedescr_offsets (20) char (5), 4 37 2 perf_alter_info char (5), 4 38 2 another_perform_info char (5), 4 39 2 sort_in_info char (5), 4 40 2 odo_info char (5), 4 41 2 size_seg fixed bin, 4 42 2 size_offset fixed bin(24), 4 43 2 size_perform_info char (5), 4 44 2 rename_info char (5), 4 45 2 report_names char (5), 4 46 2 rw_buf_seg fixed bin, 4 47 2 rw_buf_offset fixed bin(24), 4 48 2 rw_buf_length fixed bin(24), 4 49 2 file_keys char (5), 4 50 2 search_keys char (5), 4 51 2 dd_seg_size fixed bin(24), 4 52 2 pd_seg_size fixed bin(24), 4 53 2 seg_limit fixed bin , 4 54 2 number_of_dd_segs fixed bin, 4 55 2 seg_info char (5), 4 56 2 number_of_ls_pointers fixed bin, 4 57 2 link_sec_seg fixed bin, 4 58 2 link_sec_offset fixed bin(24), 4 59 2 sra_clauses fixed bin, 4 60 2 fix_up_info char (5), 4 61 2 linage_info char (5), 4 62 2 first_dd_item char (5), 4 63 2 sort_out_info char (5), 4 64 2 db_info char (5), 4 65 2 realm_info char (5), 4 66 2 rc_realm_info char (5), 4 67 2 last_file_key char (5), 4 68 2 prog_coll_seq fixed bin, 4 69 2 init_cd_seg fixed bin, 4 70 2 init_cd_offset fixed bin(24), 4 71 2 input_error_exit fixed bin, 4 72 2 output_error_exit fixed bin, 4 73 2 i_o_error_exit fixed bin, 4 74 2 extend_error_exit fixed bin, 4 75 2 dummy15 fixed bin, 4 76 2 options, 4 77 3 cu bit (1), 4 78 3 st bit (1), 4 79 3 wn bit (1), 4 80 3 obs bit (1), 4 81 3 dm bit (1), 4 82 3 xrl bit (1), 4 83 3 xrn bit (1), 4 84 3 src bit (1), 4 85 3 obj bit (1), 4 86 3 exs bit (1), 4 87 3 sck bit (1), 4 88 3 rno bit (1), 4 89 3 u_l bit (1), 4 90 3 cnv bit (1), 4 91 3 cos bit (1), 4 92 3 fmt bit (1), 4 93 3 profile bit(1), 4 94 3 nw bit (1), 4 95 3 exp bit (1), /* [4.0-0] */ 4 96 3 card bit (1), /*[4.1-1]*/ 4 97 3 fil2 bit (5), 4 98 3 m_map bit (1), 4 99 3 m_bf bit (1), 4 100 3 m_fat bit (1), 4 101 3 m_wn bit (1), 4 102 3 m_obs bit(1), 4 103 3 pd bit(1), 4 104 3 oc bit(1), 4 105 2 supervisor bit (1), 4 106 2 dec_comma bit (1), 4 107 2 init_cd bit (1), 4 108 2 corr bit (1), 4 109 2 initl bit (1), 4 110 2 debug bit (1), 4 111 2 report bit (1), 4 112 2 sync_in_prog bit (1), 4 113 2 pd_section bit (1), 4 114 2 list_switch bit (1), 4 115 2 alpha_cond bit (1), 4 116 2 num_cond bit (1), 4 117 2 spec_sysin bit (1), 4 118 2 spec_sysout bit (1), 4 119 2 cpl_files bit (1), 4 120 2 obj_dec_comma bit (1), 4 121 2 default_sign_type bit (3), 4 122 2 use_debug bit(1), 4 123 2 syntax_trace bit(1), 4 124 2 comp_defaults, 4 125 3 comp bit(1), 4 126 3 comp_1 bit(1), 4 127 3 comp_2 bit(1), 4 128 3 comp_3 bit(1), 4 129 3 comp_4 bit(1), 4 130 3 comp_5 bit(1), 4 131 3 comp_6 bit(1), 4 132 3 comp_7 bit(1), 4 133 3 comp_8 bit(1), 4 134 2 disp_defaults, 4 135 3 disp bit(1), 4 136 3 disp_1 bit(1), 4 137 3 disp_2 bit(1), 4 138 3 disp_3 bit(1), 4 139 3 disp_4 bit(1), 4 140 3 disp_5 bit(1), 4 141 3 disp_6 bit(1), 4 142 3 disp_7 bit(1), 4 143 2 descriptor bit(2), 4 144 2 levsv bit(3), /*[4.0-1]*/ 4 145 2 use_reporting bit(1), /*[4.3-1]*/ 4 146 2 cd bit(1), /*[4.4-1]*/ 4 147 2 dummy17 bit(3), 4 148 2 lvl_rstr bit(32), 4 149 2 inst_rstr bit(32), 4 150 2 comp_level char(1), 4 151 2 dummy18 char(30), 4 152 2 object_sign char (1), 4 153 2 last_print_rec char (5), 4 154 2 coll_seq_info char (5), 4 155 2 sys_status_seg fixed bin, 4 156 2 sys_status_offset fixed bin(24), 4 157 2 compiler_id fixed bin, 4 158 2 date_comp_ln fixed bin, 4 159 2 compile_mode bit(36), 4 160 2 default_temp fixed bin, 4 161 2 accept_device fixed bin, 4 162 2 display_device fixed bin, 4 163 2 cobol_cln fixed bin, /*[5.1-1]*/ 4 164 2 alphabet_offset fixed bin; 4 165 4 166 4 167 4 168 /* END INCLUDE FILE ... cobol_fixed_common.incl.pl1 */ 4 169 1860 5 1 5 2 /* BEGIN INCLUDE FILE ... cobol_ext_.incl.pl1 */ 5 3 /* Last modified on 06/17/76 by ORN */ 5 4 /* Last modified on 12/28/76 by FCH */ 5 5 /* Last modified on 12/01/80 by FCH */ 5 6 5 7 /* <<< SHARED EXTERNALS INCLUDE FILE >>> */ 5 8 5 9 5 10 dcl cobol_ext_$cobol_afp ptr ext; 5 11 dcl cobol_afp ptr defined ( cobol_ext_$cobol_afp); 5 12 dcl cobol_ext_$cobol_analin_fileno ptr ext; 5 13 dcl cobol_analin_fileno ptr defined ( cobol_ext_$cobol_analin_fileno); 5 14 dcl cobol_ext_$report_first_token ptr ext; 5 15 dcl report_first_token ptr defined( cobol_ext_$report_first_token); 5 16 dcl cobol_ext_$report_last_token ptr ext; 5 17 dcl report_last_token ptr defined ( cobol_ext_$report_last_token); 5 18 dcl cobol_ext_$cobol_eltp ptr ext; 5 19 dcl cobol_eltp ptr defined ( cobol_ext_$cobol_eltp); 5 20 dcl cobol_ext_$cobol_cmfp ptr ext; 5 21 dcl cobol_cmfp ptr defined ( cobol_ext_$cobol_cmfp); 5 22 dcl cobol_ext_$cobol_com_fileno ptr ext; 5 23 dcl cobol_com_fileno ptr defined ( cobol_ext_$cobol_com_fileno); 5 24 dcl cobol_ext_$cobol_com_ptr ptr ext; 5 25 dcl cobol_com_ptr ptr defined ( cobol_ext_$cobol_com_ptr); 5 26 dcl cobol_ext_$cobol_dfp ptr ext; 5 27 dcl cobol_dfp ptr defined ( cobol_ext_$cobol_dfp); 5 28 dcl cobol_ext_$cobol_hfp ptr ext; 5 29 dcl cobol_hfp ptr defined ( cobol_ext_$cobol_hfp); 5 30 dcl cobol_ext_$cobol_m1fp ptr ext; 5 31 dcl cobol_m1fp ptr defined ( cobol_ext_$cobol_m1fp); 5 32 dcl cobol_ext_$cobol_m2fp ptr ext; 5 33 dcl cobol_m2fp ptr defined ( cobol_ext_$cobol_m2fp); 5 34 dcl cobol_ext_$cobol_min1_fileno ptr ext; 5 35 dcl cobol_min1_fileno ptr defined ( cobol_ext_$cobol_min1_fileno); 5 36 dcl cobol_ext_$cobol_min2_fileno_ptr ptr ext; 5 37 dcl cobol_min2_fileno_ptr ptr defined ( cobol_ext_$cobol_min2_fileno_ptr); 5 38 dcl cobol_ext_$cobol_name_fileno ptr ext; 5 39 dcl cobol_name_fileno ptr defined ( cobol_ext_$cobol_name_fileno); 5 40 dcl cobol_ext_$cobol_name_fileno_ptr ptr ext; 5 41 dcl cobol_name_fileno_ptr ptr defined ( cobol_ext_$cobol_name_fileno_ptr); 5 42 dcl cobol_ext_$cobol_ntfp ptr ext; 5 43 dcl cobol_ntfp ptr defined ( cobol_ext_$cobol_ntfp); 5 44 dcl cobol_ext_$cobol_pdofp ptr ext; 5 45 dcl cobol_pdofp ptr defined ( cobol_ext_$cobol_pdofp); 5 46 dcl cobol_ext_$cobol_pfp ptr ext; 5 47 dcl cobol_pfp ptr defined ( cobol_ext_$cobol_pfp); 5 48 dcl cobol_ext_$cobol_rm2fp ptr ext; 5 49 dcl cobol_rm2fp ptr defined ( cobol_ext_$cobol_rm2fp); 5 50 dcl cobol_ext_$cobol_rmin2fp ptr ext; 5 51 dcl cobol_rmin2fp ptr defined ( cobol_ext_$cobol_rmin2fp); 5 52 dcl cobol_ext_$cobol_curr_in ptr ext; 5 53 dcl cobol_curr_in ptr defined ( cobol_ext_$cobol_curr_in); 5 54 dcl cobol_ext_$cobol_curr_out ptr ext; 5 55 dcl cobol_curr_out ptr defined ( cobol_ext_$cobol_curr_out); 5 56 dcl cobol_ext_$cobol_sfp ptr ext; 5 57 dcl cobol_sfp ptr defined ( cobol_ext_$cobol_sfp); 5 58 dcl cobol_ext_$cobol_w1p ptr ext; 5 59 dcl cobol_w1p ptr defined ( cobol_ext_$cobol_w1p); 5 60 dcl cobol_ext_$cobol_w2p ptr ext; 5 61 dcl cobol_w2p ptr defined ( cobol_ext_$cobol_w2p); 5 62 dcl cobol_ext_$cobol_w3p ptr ext; 5 63 dcl cobol_w3p ptr defined ( cobol_ext_$cobol_w3p); 5 64 dcl cobol_ext_$cobol_w5p ptr ext; 5 65 dcl cobol_w5p ptr defined ( cobol_ext_$cobol_w5p); 5 66 dcl cobol_ext_$cobol_w6p ptr ext; 5 67 dcl cobol_w6p ptr defined ( cobol_ext_$cobol_w6p); 5 68 dcl cobol_ext_$cobol_w7p ptr ext; 5 69 dcl cobol_w7p ptr defined ( cobol_ext_$cobol_w7p); 5 70 dcl cobol_ext_$cobol_x3fp ptr ext; 5 71 dcl cobol_x3fp ptr defined ( cobol_ext_$cobol_x3fp); 5 72 dcl cobol_ext_$cobol_rwdd ptr ext; 5 73 dcl cobol_rwdd ptr defined(cobol_ext_$cobol_rwdd); 5 74 dcl cobol_ext_$cobol_rwpd ptr ext; 5 75 dcl cobol_rwpd ptr defined(cobol_ext_$cobol_rwpd); 5 76 5 77 5 78 dcl cobol_ext_$cobol_fileno1 fixed bin(24)ext; 5 79 dcl cobol_fileno1 fixed bin(24)defined ( cobol_ext_$cobol_fileno1); 5 80 dcl cobol_ext_$cobol_options_len fixed bin(24)ext; 5 81 dcl cobol_options_len fixed bin(24)defined ( cobol_ext_$cobol_options_len); 5 82 dcl cobol_ext_$cobol_pdout_fileno fixed bin(24)ext; 5 83 dcl cobol_pdout_fileno fixed bin(24)defined ( cobol_ext_$cobol_pdout_fileno); 5 84 dcl cobol_ext_$cobol_print_fileno fixed bin(24)ext; 5 85 dcl cobol_print_fileno fixed bin(24)defined ( cobol_ext_$cobol_print_fileno); 5 86 dcl cobol_ext_$cobol_rmin2_fileno fixed bin(24)ext; 5 87 dcl cobol_rmin2_fileno fixed bin(24)defined ( cobol_ext_$cobol_rmin2_fileno); 5 88 dcl cobol_ext_$cobol_x1_fileno fixed bin(24)ext; 5 89 dcl cobol_x1_fileno fixed bin(24)defined ( cobol_ext_$cobol_x1_fileno); 5 90 dcl cobol_ext_$cobol_x2_fileno fixed bin(24)ext; 5 91 dcl cobol_x2_fileno fixed bin(24)defined ( cobol_ext_$cobol_x2_fileno); 5 92 dcl cobol_ext_$cobol_x3_fileno fixed bin(24)ext; 5 93 dcl cobol_x3_fileno fixed bin(24)defined ( cobol_ext_$cobol_x3_fileno); 5 94 5 95 dcl cobol_ext_$cobol_lpr char (5) ext; 5 96 dcl cobol_lpr char (5) defined ( cobol_ext_$cobol_lpr); /* -2- */ 5 97 dcl cobol_ext_$cobol_options char (120) ext; 5 98 dcl cobol_options char (120) defined ( cobol_ext_$cobol_options); /* -30- */ 5 99 5 100 dcl cobol_ext_$cobol_xlast8 bit (1) ext; 5 101 dcl cobol_xlast8 bit (1) defined ( cobol_ext_$cobol_xlast8); /* -1- */ 5 102 dcl cobol_ext_$report_exists bit (1) ext; 5 103 dcl report_exists bit (1) defined ( cobol_ext_$report_exists); 5 104 5 105 5 106 /* <<< END OF SHARED EXTERNALS INCLUDE FILE >>> */ 5 107 /* END INCLUDE FILE ... cobol_ext_.incl.pl1 */ 5 108 1861 1862 1863 end cobol_gns; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0835.2 cobol_gns.pl1 >spec>install>MR12.3-1048>cobol_gns.pl1 1857 1 03/27/82 0431.6 cobol_ext_lex.incl.pl1 >ldd>include>cobol_ext_lex.incl.pl1 1858 2 03/27/82 0439.7 cobol_hexl_tab.incl.pl1 >ldd>include>cobol_hexl_tab.incl.pl1 1859 3 03/27/82 0439.3 cobol_gns_tab.incl.pl1 >ldd>include>cobol_gns_tab.incl.pl1 1860 4 11/11/82 1712.8 cobol_fixed_common.incl.pl1 >ldd>include>cobol_fixed_common.incl.pl1 1861 5 03/27/82 0431.3 cobol_ext_.incl.pl1 >ldd>include>cobol_ext_.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. TOK_COLUMN 000156 automatic fixed bin(17,0) dcl 1856 set ref 282* 284* 342 490 613 1028 1353 a 000135 automatic char(1) packed unaligned dcl 1282 set ref 1390* 1392 1392 1392 1392 1392 1392 1392 addr builtin function dcl 200 ref 321 321 908 909 912 931 970 alpha_lit_bit 000115 internal static bit(1) packed unaligned dcl 1461 set ref 1032* 1041* 1455* 1467 alphanum_lit based structure level 1 unaligned dcl 99 c1 000120 automatic char(1) packed unaligned dcl 169 set ref 406* 407 409 413 436 557* 559 578 584 590 592* 594 596 599 599 680* 686 714 743* 745 986 1009* 1010 1012 1079* 1109 1124 1137* 1139 1147 1150* 1154 1213* 1219 1241* 1244 1252 ch 000154 automatic char(1) packed unaligned dcl 1617 set ref 874* 876 881* 891 ch36 000140 automatic varying char(36) dcl 1613 set ref 473* 476 476 476 482* class 14 based bit(26) level 2 packed packed unaligned dcl 66 set ref 255* 340* cobol_c_l_n defined fixed bin(17,0) dcl 1-48 set ref 277 587 1430* cobol_c_list 002110 constant entry external dcl 157 ref 321 cobol_cards defined structure level 1 unaligned dcl 1-65 cobol_com_ptr defined pointer dcl 5-25 ref 469 507 511 625 724 867 1019 1049 1065 1231 1430 1473 1568 1580 cobol_comma_character defined char(1) packed unaligned dcl 1-33 ref 584 cobol_continuation defined bit(1) packed unaligned dcl 1-78 set ref 394 396* 563 565* 690 692* 749 751* 797 799* 849 851* 940 942* 979 981* 1086 1088* 1312 1314* 1550 1552* cobol_current defined pointer dcl 1-10 set ref 252 253 254 255 266 270* 270 272 272 339 340 341 342 347 348 350 350 489 490 491 492 507 507 507 511 511 612 613 614 615 616 617 618 619 620 621 622 632 632 637 666 683 1027 1028 1029 1030 1233 1233 1352 1353 1354 1424 1568 1568 1580 1580 cobol_ddsyntax$enter_tok_string 002114 constant entry external dcl 1605 ref 482 cobol_ddsyntax$init_tok_string 002112 constant entry external dcl 1603 ref 1597 cobol_decimal_point_character defined char(1) packed unaligned dcl 1-35 ref 590 1101 1219 cobol_ext_$cobol_com_ptr 002154 external static pointer dcl 5-24 ref 469 469 507 507 511 511 625 625 724 724 867 867 1019 1019 1049 1049 1065 1065 1231 1231 1430 1430 1473 1473 1568 1568 1580 1580 cobol_ext_$report_exists 002156 external static bit(1) packed unaligned dcl 5-102 ref 345 345 cobol_ext_lex$cobol_c_l_n 002126 external static fixed bin(17,0) dcl 1-47 ref 277 277 587 587 1430 1430 cobol_ext_lex$cobol_cards 002134 external static structure level 1 unaligned dcl 1-64 set ref 210 210 210 210 212* 212 212 212 216 216 216 216 225 225 225 225 230 230 230 230 232* 232 232 232 238 238 241 241 241 241 258* 258 258 258 262* 262 262 262 278 278 282 282 290 290 290 290 328* 328 328 328 330 330 330 330 390 390 390 390 431* 431 431 431 438* 438 438 438 440 440 440 440 527 527 557 557 557 557 588 588 592 592 592 592 677 677 678 678 679* 679 679 679 680 680 680 680 697 697 697 697 743 743 743 743 766 766 766 766 766 766 766 766 770 770 770 770 784 784 784 784 785* 785 785 785 791 791 791 791 793 793 812 812 812 812 819* 819 819 819 827 827 827 827 835 835 835 835 840* 840 840 840 844 844 844 844 856 856 856 856 872 872 874 874 881 881 888 888 910* 910 910 910 911 911 911 911 921* 921 921 921 923 923 923 923 927* 927 927 927 936 936 936 936 947 947 947 947 962* 962 962 962 964 964 964 964 975 975 975 975 986 986 986 986 1009 1009 1009 1009 1046* 1046 1046 1046 1059* 1059 1059 1059 1062 1062 1062 1062 1074 1074 1074 1074 1074 1074 1079 1079 1079 1079 1080* 1080 1080 1080 1082 1082 1082 1082 1098 1098 1098 1098 1101 1101 1101 1101 1104 1104 1104 1104 1107* 1107 1107 1107 1132 1132 1132 1132 1132 1132 1137 1137 1137 1137 1150 1150 1150 1150 1157* 1157 1157 1157 1170 1170 1170 1170 1170 1170 1175 1175 1175 1175 1213 1213 1213 1213 1219 1219 1219 1219 1227 1227 1227 1227 1241 1241 1241 1241 1248* 1248 1248 1248 1264 1264 1264 1264 1272 1272 1272 1272 1288 1288 1288 1288 1288 1288 1288 1288 1302 1302 1303 1303 1308 1308 1308 1308 1510 1510 1511 1511 1518 1518 1526* 1526 1526 1526 1532 1532 1532 1532 1533* 1533 1533 1533 1539 1539 1539 1539 1542* 1542 1542 1542 1546 1546 1546 1546 cobol_ext_lex$cobol_comma_character 002120 external static char(1) packed unaligned dcl 1-32 ref 584 584 cobol_ext_lex$cobol_continuation 002140 external static bit(1) packed unaligned dcl 1-77 set ref 394 394 396* 396 563 563 565* 565 690 690 692* 692 749 749 751* 751 797 797 799* 799 849 849 851* 851 940 940 942* 942 979 979 981* 981 1086 1086 1088* 1088 1312 1312 1314* 1314 1550 1550 1552* 1552 cobol_ext_lex$cobol_current 002116 external static pointer dcl 1-9 set ref 252 252 253 253 254 254 255 255 266 266 270* 270 270 270 272 272 272 272 339 339 340 340 341 341 342 342 347 347 348 348 350 350 350 350 489 489 490 490 491 491 492 492 507 507 507 507 507 507 511 511 511 511 612 612 613 613 614 614 615 615 616 616 617 617 618 618 619 619 620 620 621 621 622 622 632 632 632 632 637 637 666 666 683 683 1027 1027 1028 1028 1029 1029 1030 1030 1233 1233 1233 1233 1352 1352 1353 1353 1354 1354 1424 1424 1568 1568 1568 1568 1580 1580 1580 1580 cobol_ext_lex$cobol_decimal_point_character 002122 external static char(1) packed unaligned dcl 1-34 ref 590 590 1101 1101 1219 1219 cobol_ext_lex$cobol_head_words 002150 external static bit(1) array packed unaligned dcl 1-93 ref 425 425 425 425 527 527 632 632 632 632 cobol_ext_lex$cobol_lu_sw 002144 external static bit(1) packed unaligned dcl 1-83 ref 462 462 1344 1344 cobol_ext_lex$cobol_new_line_character 002124 external static char(1) packed unaligned dcl 1-36 ref 216 216 225 225 330 330 390 390 559 559 686 686 745 745 791 791 844 844 936 936 975 975 1082 1082 1308 1308 1546 1546 cobol_ext_lex$cobol_pic_switch 002142 external static bit(1) packed unaligned dcl 1-79 ref 286 286 cobol_ext_lex$cobol_progid_sw 002152 external static bit(1) packed unaligned dcl 1-117 ref 436 436 511 511 cobol_ext_lex$cobol_save_cln 002130 external static fixed bin(17,0) dcl 1-49 set ref 252 252 277* 277 341 341 489 489 587* 587 612 612 724 724 1019 1019 1027 1027 1065 1065 1352 1352 cobol_ext_lex$cobol_save_col 002132 external static fixed bin(17,0) dcl 1-51 set ref 253 253 278* 278 284 284 588* 588 667* 667 724 724 1019 1019 1065 1065 cobol_ext_lex$cobol_scanoff_sw 002146 external static bit(1) packed unaligned dcl 1-85 ref 222 222 cobol_ext_lex$processing_report 002136 external static bit(1) packed unaligned dcl 1-73 ref 462 462 cobol_head_words defined bit(1) array packed unaligned dcl 1-94 ref 425 425 527 632 632 cobol_insert_token 002106 constant entry external dcl 155 ref 248 334 466 610 1022 1347 cobol_lexerr$lexerr3 002102 constant entry external dcl 151 ref 383 518 550 706 776 814 830 858 952 1005 1192 1339 1561 1566 1578 cobol_lu_sw defined bit(1) packed unaligned dcl 1-84 ref 462 1344 cobol_merge 002104 constant entry external dcl 154 ref 218 228 330 392 561 688 747 795 847 938 977 1084 1310 1548 cobol_new_line_character defined char(1) packed unaligned dcl 1-37 ref 216 225 330 390 559 686 745 791 844 936 975 1082 1308 1546 cobol_pic_switch defined bit(1) packed unaligned dcl 1-80 ref 286 cobol_progid_sw defined bit(1) packed unaligned dcl 1-118 ref 436 511 cobol_save_cln defined fixed bin(17,0) dcl 1-50 set ref 252 277* 341 489 587* 612 724* 1019* 1027 1065* 1352 cobol_save_col defined fixed bin(17,0) dcl 1-52 set ref 253 278* 284 588* 667* 724* 1019* 1065* cobol_scanoff_sw defined bit(1) packed unaligned dcl 1-86 ref 222 col parameter fixed bin(17,0) dcl 301 ref 298 318 column defined fixed bin(17,0) level 2 in structure "cobol_cards" dcl 1-65 in procedure "cobol_gns" ref 766 770 column 11 based fixed bin(17,0) level 2 in structure "user_word" dcl 126 in procedure "cobol_gns" set ref 490* 507* 511* column 2 000166 automatic fixed bin(17,0) level 2 in structure "diag_item" dcl 303 in procedure "lev_diag" set ref 318* column 11 based fixed bin(17,0) level 2 in structure "alphanum_lit" dcl 99 in procedure "cobol_gns" set ref 1028* column 11 based fixed bin(17,0) level 2 in structure "picture" dcl 113 in procedure "cobol_gns" set ref 1353* column 11 based fixed bin(17,0) level 2 in structure "numeric_lit" dcl 80 in procedure "cobol_gns" set ref 613* column 11 based fixed bin(17,0) level 2 in structure "reserved_word" dcl 66 in procedure "cobol_gns" set ref 253* 342* 1233* 1568* 1580* comp_level 137 based char(1) level 2 packed packed unaligned dcl 4-26 ref 469 507 511 625 724 1019 1065 1231 1430 1568 1580 compile_mode 156 based bit(36) level 2 packed packed unaligned dcl 4-26 ref 867 1049 1473 cont_flag 000133 automatic bit(1) packed unaligned dcl 1282 set ref 1372* 1374* 1376 1380* 1386* 1398* cont_flag1 000134 automatic bit(1) packed unaligned dcl 1282 set ref 1397* 1400 1405* 1411* diag_item 000166 automatic structure level 1 unaligned dcl 303 set ref 321 321 dlmck1_sw 000117 automatic bit(1) packed unaligned dcl 168 set ref 207* 428 428* 518 exp_places 000104 automatic fixed bin(17,0) dcl 159 in procedure "cobol_gns" set ref 538* 620 621 exp_places 14 based fixed bin(17,0) level 2 in structure "numeric_lit" dcl 80 in procedure "cobol_gns" set ref 620* exp_sign 000112 automatic char(1) packed unaligned dcl 163 in procedure "cobol_gns" set ref 535* 618 exp_sign 13(18) based char(1) level 2 in structure "numeric_lit" packed packed unaligned dcl 80 in procedure "cobol_gns" set ref 618* exp_sw 000114 automatic bit(1) packed unaligned dcl 165 set ref 536* 616 fixed builtin function dcl 200 ref 293 407 578 594 637 697 714 912 931 970 1010 1062 1098 1104 1139 1154 1175 1219 1227 1252 1264 1272 1322 1329 1333 1511 1539 fixed_common based structure level 1 unaligned dcl 4-26 found_comma 000116 automatic bit(1) packed unaligned dcl 165 set ref 540* 586* 697 714 724 fwd_link based pointer level 2 dcl 57 ref 266 270 h_index 000136 automatic fixed bin(17,0) dcl 1282 set ref 1378* 1380 1384 1402* 1405 1409 hc 000121 automatic char(1) packed unaligned dcl 169 set ref 908 911* 912* 912 923* 925 931* 931 964* 966 970* 970 hc1 000122 automatic char(1) packed unaligned dcl 169 set ref 909 997 hc1_ptr 000126 automatic pointer dcl 172 set ref 909* 959 996 hc_ck 0(03) based bit(1) level 2 packed packed unaligned dcl 181 ref 914 933 972 hc_ptr 000124 automatic pointer dcl 172 set ref 908* 914 933 959 972 996 hcs based structure level 1 packed packed unaligned dcl 175 hcs1 based structure level 1 packed packed unaligned dcl 178 hcs2 based structure level 1 packed packed unaligned dcl 181 hexl_tab based char(1) array packed unaligned dcl 2-4 ref 912 931 970 hexl_tab1 000520 internal static bit(9) initial array packed unaligned dcl 2-5 set ref 912 931 970 i 000105 automatic fixed bin(17,0) dcl 159 set ref 793* 804 806 807 index builtin function dcl 200 ref 476 507 511 766 1378 1402 info 13 based bit(8) level 2 in structure "numeric_lit" packed packed unaligned dcl 80 in procedure "cobol_gns" set ref 615* 616* info 6 000166 automatic bit(32) level 2 in structure "diag_item" packed packed unaligned dcl 303 in procedure "lev_diag" set ref 315* int_val 000152 automatic fixed bin(17,0) dcl 1613 set ref 637* 640 640 integer_sw 000115 automatic bit(1) packed unaligned dcl 165 set ref 533* 573* 581* 615 733* key 13 based fixed bin(17,0) level 2 dcl 66 set ref 254* 339* l_info 6 based bit(8) level 2 packed packed unaligned dcl 57 set ref 666* 683 length 14 based fixed bin(17,0) level 2 in structure "alphanum_lit" dcl 99 in procedure "cobol_gns" set ref 1029* length 13 based fixed bin(17,0) level 2 in structure "picture" dcl 113 in procedure "cobol_gns" set ref 1354* length 16 based fixed bin(17,0) level 2 in structure "reserved_word" dcl 66 in procedure "cobol_gns" set ref 347* length 14 based fixed bin(17,0) level 2 in structure "user_word" dcl 126 in procedure "cobol_gns" set ref 491* lerr 000112 internal static bit(1) packed unaligned dcl 187 set ref 381 386* 548 553* 740 1299 1527* 1530* lin parameter fixed bin(17,0) dcl 301 ref 298 317 line 10 based fixed bin(17,0) level 2 in structure "alphanum_lit" dcl 99 in procedure "cobol_gns" set ref 1027* line 10 based fixed bin(17,0) level 2 in structure "picture" dcl 113 in procedure "cobol_gns" set ref 1352* line 10 based fixed bin(17,0) level 2 in structure "user_word" dcl 126 in procedure "cobol_gns" set ref 489* 507* 511* line 10 based fixed bin(17,0) level 2 in structure "reserved_word" dcl 66 in procedure "cobol_gns" set ref 252* 341* 1233* 1568* 1580* line 1 000166 automatic fixed bin(17,0) level 2 in structure "diag_item" dcl 303 in procedure "lev_diag" set ref 317* line 10 based fixed bin(17,0) level 2 in structure "numeric_lit" dcl 80 in procedure "cobol_gns" set ref 612* linfo 000155 automatic bit(8) packed unaligned dcl 1617 set ref 666 683* literal 20 based char(30) level 2 packed packed unaligned dcl 80 set ref 622* 637 lower_case_alphabet 000062 constant char(128) initial packed unaligned dcl 1622 ref 462 lp based bit(5) level 2 packed packed unaligned dcl 175 set ref 959* mask 000100 automatic bit(8) packed unaligned dcl 158 set ref 375* 407* 409 542* 594* 596 736* 1010* 1012 1294* 1511 mem_tab 000720 internal static bit(8) initial array packed unaligned dcl 3-14 set ref 407 578 594 697 714 1010 1062 1098 1104 1139 1154 1175 1219 1227 1252 1264 1272 1322 1329 1333 1475* 1477* 1486* 1487* 1511 1539 mod builtin function dcl 200 ref 896 name 3 defined char(256) level 2 in structure "cobol_cards" packed packed unaligned dcl 1-65 in procedure "cobol_gns" ref 210 216 225 230 241 282 290 330 390 440 557 592 678 680 697 743 766 784 791 812 827 835 844 856 874 881 911 923 936 947 964 975 986 1009 1062 1074 1079 1082 1098 1101 1104 1132 1137 1150 1170 1175 1213 1219 1227 1241 1264 1272 1288 1288 1303 1308 1511 1532 1539 1546 name 17 based char(30) level 2 in structure "reserved_word" packed packed unaligned dcl 66 in procedure "cobol_gns" set ref 348* new_ch 000132 automatic char(1) packed unaligned dcl 296 set ref 290* 293 348 np_char 000131 automatic bit(1) packed unaligned dcl 174 set ref 917* 1019 1043* nr_char 2 defined fixed bin(17,0) level 2 dcl 1-65 set ref 210 212* 212 216 225 230 232* 232 238 241 258* 258 262* 262 278 290 328* 328 330 390 431* 431 438* 438 440 527 557 588 592 677 679* 679 680 697 743 766 766 770 784 785* 785 791 812 819* 819 827 835 840* 840 844 856 872 888 910* 910 911 921* 921 923 927* 927 936 947 962* 962 964 975 986 1009 1046* 1046 1059* 1059 1062 1074 1074 1079 1080* 1080 1082 1098 1101 1104 1107* 1107 1132 1132 1137 1150 1157* 1157 1170 1170 1175 1213 1219 1227 1241 1248* 1248 1264 1272 1288 1288 1302 1308 1510 1518 1526* 1526 1532 1533* 1533 1539 1542* 1542 1546 null builtin function dcl 200 ref 266 num parameter fixed bin(17,0) dcl 301 ref 298 319 num_sign 000111 automatic char(1) packed unaligned dcl 163 set ref 532* 617 1124* number 5 000166 automatic fixed bin(17,0) level 2 dcl 303 set ref 319* numeric_lit based structure level 1 unaligned dcl 80 per 000113 automatic char(1) packed unaligned dcl 163 set ref 539* 662 678* 683 735* 1292* 1303* 1322 1426 1430 per_sw 000113 internal static bit(1) packed unaligned dcl 187 set ref 224* 244 246* period_sw 000110 internal static bit(1) initial packed unaligned dcl 167 set ref 413* 415* 444* 1216 1225* 1455* picture based structure level 1 unaligned dcl 113 places 17 based fixed bin(17,0) level 2 dcl 80 set ref 614* places_left 000103 automatic fixed bin(17,0) dcl 159 in procedure "cobol_gns" set ref 537* 574* 582* 619 621 places_left 15 based fixed bin(17,0) level 2 in structure "numeric_lit" dcl 80 in procedure "cobol_gns" set ref 619* places_right 16 based fixed bin(17,0) level 2 dcl 80 set ref 621* 632 posit 000153 automatic fixed bin(17,0) dcl 1617 set ref 872* 874 879* 879 881 888* 888 891* 891 896 prev_tok_type 000116 internal static fixed bin(17,0) dcl 1609 set ref 250* 337* 469 487* 629* 640* 1025* 1350* 1593* processing_report defined bit(1) packed unaligned dcl 1-74 ref 462 quot_ch 000130 automatic char(1) packed unaligned dcl 173 set ref 812 827 835 838 856 876 925 947 966 1038* 1052* report_exists defined bit(1) packed unaligned dcl 5-103 ref 345 reserved_word based structure level 1 unaligned dcl 66 rp 0(04) based bit(5) level 2 in structure "hcs1" packed packed unaligned dcl 178 in procedure "cobol_gns" ref 959 rp 0(05) based bit(4) level 2 in structure "hcs" packed packed unaligned dcl 175 in procedure "cobol_gns" set ref 996* 996 run 4 000166 automatic fixed bin(17,0) level 2 dcl 303 set ref 314* rwc 000110 automatic bit(26) packed unaligned dcl 161 set ref 340 670* 1113* 1117* 1143* 1152* 1179* 1200* 1208* 1238* 1247* 1256* 1269* 1277* rwk 000107 automatic fixed bin(17,0) dcl 159 set ref 339 669* 1112* 1116* 1141* 1151* 1178* 1198* 1206* 1237* 1246* 1254* 1268* 1276* save_pcol 000106 automatic fixed bin(17,0) dcl 159 set ref 667 677* 678 1302* 1303 1430* save_sw 000114 internal static bit(1) initial packed unaligned dcl 188 set ref 1455* sign 13(09) based char(1) level 2 packed packed unaligned dcl 80 set ref 617* 632 size 7 based fixed bin(17,0) level 2 in structure "reserved_word" dcl 66 in procedure "cobol_gns" set ref 350* 350 size 000166 automatic fixed bin(17,0) level 2 in structure "diag_item" dcl 303 in procedure "lev_diag" set ref 312* slen 000111 internal static fixed bin(17,0) dcl 169 set ref 766* 770 770* 772* 772 774 781 784 784 785 787 1510* 1511 1514* 1514 1518* 1518 1521 1524 1526 1532 1532 1533 1534 st_pos 000137 automatic fixed bin(17,0) dcl 1282 set ref 1371* 1378 1378 1384* 1384 1386 1390 1396 1402 1402 1409* 1409 1411 1413 string 14 based char(30) level 2 in structure "picture" packed packed unaligned dcl 113 in procedure "cobol_gns" set ref 1424* string 15 based char(200) level 2 in structure "alphanum_lit" packed packed unaligned dcl 99 in procedure "cobol_gns" set ref 1030* substr builtin function dcl 200 set ref 210 216 225 230 241 282 290 330 348* 390 406 440* 440 442 455 462* 462 473 492* 492 507 511 557 592 615* 616* 622* 622 637 678 680 697 743 766 784* 784 791 806* 812 827 835 838* 844 856 867 874 881 911 923 936 947 964 975 986 997* 1009 1030* 1030 1049 1062 1074 1079 1082 1098 1101 1104 1132 1137 1150 1170 1175 1213 1219 1227 1241 1264 1272 1288 1288 1303 1308 1329 1333 1344* 1344 1378 1390 1396* 1402 1413* 1424* 1424 1473 1511 1532* 1532 1539 1546 tblanks 1 defined fixed bin(17,0) level 2 dcl 1-65 ref 793 tok_string 000117 internal static varying char(1024) dcl 1610 set ref 476 476* 476 1594* token based structure level 1 unaligned dcl 57 translate builtin function dcl 200 ref 462 1344 type 3 000166 automatic fixed bin(17,0) level 2 in structure "diag_item" dcl 303 in procedure "lev_diag" set ref 313* type 12 based fixed bin(17,0) level 2 in structure "token" dcl 57 in procedure "cobol_gns" ref 272 272 unspec builtin function dcl 200 ref 293 407 578 594 697 714 912 931 970 1010 1062 1098 1104 1139 1154 1175 1219 1227 1252 1264 1272 1322 1329 1333 1511 1539 upper_case_alphabet 000022 constant char(128) initial packed unaligned dcl 1624 ref 1344 user_word based structure level 1 unaligned dcl 126 wb 000010 internal static char(256) packed unaligned dcl 162 set ref 406 440* 442 455 462* 462 473 492 511 622 784* 806* 838* 997* 1030 1329 1333 1344* 1344 1378 1390 1396* 1402 1413* 1424 1532* wl 000101 automatic fixed bin(17,0) dcl 159 set ref 279* 406 432* 432 439* 439 440 442 452* 452 455 462 462 466* 473 491 492 492 511 574 582 607* 607 610* 614 621 622 622 637 774 784 787* 787 806 807* 807 838 839* 839 997 998* 998 1002 1002 1016* 1016 1022* 1029 1030 1030 1322* 1322 1324* 1324 1329 1331* 1331 1333 1335* 1335 1336 1344 1344 1347* 1354 1369 1378 1386 1402 1411 1424 1424 1524 1532 1534* 1534 wll 000102 automatic fixed bin(17,0) dcl 159 set ref 378* 545* 737* 1295* 1524 word 15 based char(30) level 2 packed packed unaligned dcl 126 set ref 492* 507 x 001102 internal static fixed bin(8,0) initial array dcl 3-146 set ref 293 1480* 1482* 1490* 1491* xdivide_op constant fixed bin(17,0) initial dcl 193 ref 1178 xequal_op constant fixed bin(17,0) initial dcl 190 ref 1254 xexponent constant fixed bin(17,0) initial dcl 194 ref 1151 xgreater_than constant fixed bin(17,0) initial dcl 198 ref 1276 xleft_paren constant fixed bin(17,0) initial dcl 195 ref 1198 xless_than constant fixed bin(17,0) initial dcl 199 ref 1268 xminus_op constant fixed bin(17,0) initial dcl 191 ref 1116 xperiod constant fixed bin(17,0) initial dcl 197 ref 254 669 1237 xplus_op constant fixed bin(17,0) initial dcl 189 ref 1112 xright_paren constant fixed bin(17,0) initial dcl 196 ref 1206 xtimes_op constant fixed bin(17,0) initial dcl 192 ref 1141 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. cobol_afp defined pointer dcl 5-11 cobol_allo_init_sw defined bit(1) packed unaligned dcl 1-82 cobol_analin_fileno defined pointer dcl 5-13 cobol_cfp defined pointer dcl 1-20 cobol_cmfp defined pointer dcl 5-21 cobol_com_fileno defined pointer dcl 5-23 cobol_copy_active defined bit(1) packed unaligned dcl 1-110 cobol_copy_found defined bit(1) packed unaligned dcl 1-92 cobol_curr_in defined pointer dcl 5-53 cobol_curr_out defined pointer dcl 5-55 cobol_debug_mode defined bit(1) packed unaligned dcl 1-102 cobol_delete_tokens 000000 constant entry external dcl 156 cobol_dfp defined pointer dcl 5-27 cobol_dp_sw defined bit(1) packed unaligned dcl 1-98 cobol_elnp_sw defined bit(1) packed unaligned dcl 1-96 cobol_elt_buf_ptr defined pointer dcl 1-24 cobol_elt_idx defined fixed bin(17,0) dcl 1-60 cobol_eltp defined pointer dcl 5-19 cobol_endprog_sw defined bit(1) packed unaligned dcl 1-100 cobol_ext_$cobol_afp external static pointer dcl 5-10 cobol_ext_$cobol_analin_fileno external static pointer dcl 5-12 cobol_ext_$cobol_cmfp external static pointer dcl 5-20 cobol_ext_$cobol_com_fileno external static pointer dcl 5-22 cobol_ext_$cobol_curr_in external static pointer dcl 5-52 cobol_ext_$cobol_curr_out external static pointer dcl 5-54 cobol_ext_$cobol_dfp external static pointer dcl 5-26 cobol_ext_$cobol_eltp external static pointer dcl 5-18 cobol_ext_$cobol_fileno1 external static fixed bin(24,0) dcl 5-78 cobol_ext_$cobol_hfp external static pointer dcl 5-28 cobol_ext_$cobol_lpr external static char(5) packed unaligned dcl 5-95 cobol_ext_$cobol_m1fp external static pointer dcl 5-30 cobol_ext_$cobol_m2fp external static pointer dcl 5-32 cobol_ext_$cobol_min1_fileno external static pointer dcl 5-34 cobol_ext_$cobol_min2_fileno_ptr external static pointer dcl 5-36 cobol_ext_$cobol_name_fileno external static pointer dcl 5-38 cobol_ext_$cobol_name_fileno_ptr external static pointer dcl 5-40 cobol_ext_$cobol_ntfp external static pointer dcl 5-42 cobol_ext_$cobol_options external static char(120) packed unaligned dcl 5-97 cobol_ext_$cobol_options_len external static fixed bin(24,0) dcl 5-80 cobol_ext_$cobol_pdofp external static pointer dcl 5-44 cobol_ext_$cobol_pdout_fileno external static fixed bin(24,0) dcl 5-82 cobol_ext_$cobol_pfp external static pointer dcl 5-46 cobol_ext_$cobol_print_fileno external static fixed bin(24,0) dcl 5-84 cobol_ext_$cobol_rm2fp external static pointer dcl 5-48 cobol_ext_$cobol_rmin2_fileno external static fixed bin(24,0) dcl 5-86 cobol_ext_$cobol_rmin2fp external static pointer dcl 5-50 cobol_ext_$cobol_rwdd external static pointer dcl 5-72 cobol_ext_$cobol_rwpd external static pointer dcl 5-74 cobol_ext_$cobol_sfp external static pointer dcl 5-56 cobol_ext_$cobol_w1p external static pointer dcl 5-58 cobol_ext_$cobol_w2p external static pointer dcl 5-60 cobol_ext_$cobol_w3p external static pointer dcl 5-62 cobol_ext_$cobol_w5p external static pointer dcl 5-64 cobol_ext_$cobol_w6p external static pointer dcl 5-66 cobol_ext_$cobol_w7p external static pointer dcl 5-68 cobol_ext_$cobol_x1_fileno external static fixed bin(24,0) dcl 5-88 cobol_ext_$cobol_x2_fileno external static fixed bin(24,0) dcl 5-90 cobol_ext_$cobol_x3_fileno external static fixed bin(24,0) dcl 5-92 cobol_ext_$cobol_x3fp external static pointer dcl 5-70 cobol_ext_$cobol_xlast8 external static bit(1) packed unaligned dcl 5-100 cobol_ext_$report_first_token external static pointer dcl 5-14 cobol_ext_$report_last_token external static pointer dcl 5-16 cobol_ext_lex$cobol_allo_init_sw external static bit(1) packed unaligned dcl 1-81 cobol_ext_lex$cobol_cfp external static pointer dcl 1-19 cobol_ext_lex$cobol_copy_active external static bit(1) packed unaligned dcl 1-109 cobol_ext_lex$cobol_copy_found external static bit(1) packed unaligned dcl 1-91 cobol_ext_lex$cobol_debug_mode external static bit(1) packed unaligned dcl 1-101 cobol_ext_lex$cobol_dp_sw external static bit(1) packed unaligned dcl 1-97 cobol_ext_lex$cobol_elnp_sw external static bit(1) packed unaligned dcl 1-95 cobol_ext_lex$cobol_elt_buf_ptr external static pointer dcl 1-23 cobol_ext_lex$cobol_elt_idx external static fixed bin(17,0) dcl 1-59 cobol_ext_lex$cobol_endprog_sw external static bit(1) packed unaligned dcl 1-99 cobol_ext_lex$cobol_frst external static pointer dcl 1-13 cobol_ext_lex$cobol_init_ta_sw external static bit(1) packed unaligned dcl 1-105 cobol_ext_lex$cobol_lex_exit external static label variable dcl 1-25 cobol_ext_lex$cobol_ln_sw external static bit(1) array packed unaligned dcl 1-111 cobol_ext_lex$cobol_mfp external static pointer dcl 1-15 cobol_ext_lex$cobol_name_number external static fixed bin(17,0) dcl 1-53 cobol_ext_lex$cobol_output_sw external static bit(1) packed unaligned dcl 1-87 cobol_ext_lex$cobol_prime_sw external static bit(1) packed unaligned dcl 1-113 cobol_ext_lex$cobol_rec1_sw external static bit(1) array packed unaligned dcl 1-115 cobol_ext_lex$cobol_rep_sw external static bit(1) packed unaligned dcl 1-107 cobol_ext_lex$cobol_rt_ptr external static pointer dcl 1-17 cobol_ext_lex$cobol_rwt_init_sw external static bit(1) packed unaligned dcl 1-103 cobol_ext_lex$cobol_section_number external static fixed bin(17,0) dcl 1-55 cobol_ext_lex$cobol_si_key external static char(5) packed unaligned dcl 1-38 cobol_ext_lex$cobol_so_key external static char(5) packed unaligned dcl 1-40 cobol_ext_lex$cobol_sr external static fixed bin(17,0) dcl 1-57 cobol_ext_lex$cobol_stack_sw external static bit(1) packed unaligned dcl 1-89 cobol_ext_lex$cobol_ta_ptr external static pointer dcl 1-21 cobol_ext_lex$cobol_tarea external static char(300) packed unaligned dcl 1-30 cobol_ext_lex$cobol_top external static pointer dcl 1-11 cobol_ext_lex$ph_num external static fixed bin(17,0) dcl 1-45 cobol_ext_lex$real_end_report external static bit(1) packed unaligned dcl 1-75 cobol_fileno1 defined fixed bin(24,0) dcl 5-79 cobol_frst defined pointer dcl 1-14 cobol_gns 000000 constant entry external dcl 153 cobol_hfp defined pointer dcl 5-29 cobol_init_ta_sw defined bit(1) packed unaligned dcl 1-106 cobol_lex_exit defined label variable dcl 1-26 cobol_ln_sw defined bit(1) array packed unaligned dcl 1-112 cobol_lpr defined char(5) packed unaligned dcl 5-96 cobol_m1fp defined pointer dcl 5-31 cobol_m2fp defined pointer dcl 5-33 cobol_mfp defined pointer dcl 1-16 cobol_min1_fileno defined pointer dcl 5-35 cobol_min2_fileno_ptr defined pointer dcl 5-37 cobol_name_fileno defined pointer dcl 5-39 cobol_name_fileno_ptr defined pointer dcl 5-41 cobol_name_number defined fixed bin(17,0) dcl 1-54 cobol_ntfp defined pointer dcl 5-43 cobol_options defined char(120) packed unaligned dcl 5-98 cobol_options_len defined fixed bin(24,0) dcl 5-81 cobol_output_sw defined bit(1) packed unaligned dcl 1-88 cobol_pdofp defined pointer dcl 5-45 cobol_pdout_fileno defined fixed bin(24,0) dcl 5-83 cobol_pfp defined pointer dcl 5-47 cobol_prime_sw defined bit(1) packed unaligned dcl 1-114 cobol_print_fileno defined fixed bin(24,0) dcl 5-85 cobol_rec1_sw defined bit(1) array packed unaligned dcl 1-116 cobol_rep_sw defined bit(1) packed unaligned dcl 1-108 cobol_rm2fp defined pointer dcl 5-49 cobol_rmin2_fileno defined fixed bin(24,0) dcl 5-87 cobol_rmin2fp defined pointer dcl 5-51 cobol_rt_ptr defined pointer dcl 1-18 cobol_rwdd defined pointer dcl 5-73 cobol_rwpd defined pointer dcl 5-75 cobol_rwt_init_sw defined bit(1) packed unaligned dcl 1-104 cobol_section_number defined fixed bin(17,0) dcl 1-56 cobol_sfp defined pointer dcl 5-57 cobol_si_key defined char(5) packed unaligned dcl 1-39 cobol_so_key defined char(5) packed unaligned dcl 1-41 cobol_sr defined fixed bin(17,0) dcl 1-58 cobol_stack_sw defined bit(1) packed unaligned dcl 1-90 cobol_ta_ptr defined pointer dcl 1-22 cobol_tarea defined char(300) packed unaligned dcl 1-31 cobol_top defined pointer dcl 1-12 cobol_w1p defined pointer dcl 5-59 cobol_w2p defined pointer dcl 5-61 cobol_w3p defined pointer dcl 5-63 cobol_w5p defined pointer dcl 5-65 cobol_w6p defined pointer dcl 5-67 cobol_w7p defined pointer dcl 5-69 cobol_x1_fileno defined fixed bin(24,0) dcl 5-89 cobol_x2_fileno defined fixed bin(24,0) dcl 5-91 cobol_x3_fileno defined fixed bin(24,0) dcl 5-93 cobol_x3fp defined pointer dcl 5-71 cobol_xlast8 defined bit(1) packed unaligned dcl 5-101 debug based structure level 1 unaligned dcl 139 ph_num defined fixed bin(17,0) dcl 1-46 real_end_report defined bit(1) packed unaligned dcl 1-76 rep_factor internal static fixed bin(17,0) dcl 169 report_first_token defined pointer dcl 5-15 report_last_token defined pointer dcl 5-17 save_nr_char internal static fixed bin(17,0) dcl 169 NAMES DECLARED BY EXPLICIT CONTEXT. al_dlm_ok 003037 constant label dcl 1016 ref 905 1012 al_l_err 002127 constant label dcl 776 alit_err 002303 constant label dcl 830 ref 824 alpha 000475 constant label dcl 375 ref 401 433 442 527 578 1288 alpha_lit 004433 constant entry external dcl 1463 build_nlt 001410 constant label dcl 592 ref 729 762 ck_quote 002340 constant label dcl 835 ref 827 903 ck_stack_end 000322 constant label dcl 266 ref 272 cobol_gns 000146 constant entry external dcl 45 ct 002457 constant label dcl 876 ref 884 d1 001250 constant label dcl 542 ref 570 d1a 001240 constant label dcl 533 ref 1126 d2 002031 constant label dcl 733 ref 697 714 756 digit 001226 constant label dcl 527 ref 1219 end_alit 002752 constant label dcl 1002 ref 914 gen_per 001613 constant label dcl 667 ref 1426 hex_c 002663 constant label dcl 962 ref 986 hex_err 002623 constant label dcl 952 ref 966 992 ill_char 004614 constant entry internal dcl 1189 ref 449 457 601 701 717 1165 1185 1448 ill_dlm 005001 constant entry internal dcl 1559 ref 421 1015 1062 1229 1260 1264 1272 1443 ill_dlm1 005030 constant entry internal dcl 1564 ref 1074 1132 1170 ill_dlm2 005104 constant entry internal dcl 1576 ref 1104 1154 1162 1175 init_tok_string 004533 constant entry external dcl 1589 initialize 004406 constant entry external dcl 1451 l 000000 constant label array(18) dcl 375 ref 293 896 1057 l3 003132 constant label dcl 1043 ref 1053 lev_diag 004563 constant entry internal dcl 298 ref 507 511 724 1019 1065 1233 1430 1568 1580 next_hex 002543 constant label dcl 921 ref 947 1000 next_hex1 002657 constant label dcl 959 ref 919 nl_dlm_ok 001453 constant label dcl 607 ref 575 596 711 758 nl_l_err 001260 constant label dcl 550 ref 740 ops1 000406 constant label dcl 328 ref 1120 1144 1158 1181 1201 1209 1239 1249 1257 1270 1278 ops1a 000411 constant label dcl 330 ref 671 p_p 003747 constant label dcl 1292 ref 1319 p_p2 004072 constant label dcl 1336 ref 1326 1439 pic_proc 003736 constant label dcl 1282 ref 286 put_ast 003370 constant label dcl 1141 ref 1164 put_eq 003655 constant label dcl 1254 ref 1262 s3 002074 constant label dcl 766 ref 820 841 928 1047 scan_off 004730 constant entry internal dcl 1537 ref 815 832 859 1193 1340 scan_off1 004731 constant label dcl 1539 ref 1543 1554 scanoff 000212 constant label dcl 225 ref 259 263 set_table 004457 constant entry external dcl 1469 sign1 003320 constant label dcl 1109 ref 1086 sign2 003335 constant label dcl 1124 ref 1098 1101 start 000155 constant label dcl 207 set ref 219 1068 1203 swm 004644 constant entry internal dcl 1496 ref 379 546 738 1296 swm_loop 004651 constant label dcl 1511 ref 1515 uw_dlm_ok 000676 constant label dcl 452 ref 403 417 422 445 w_l_err 000505 constant label dcl 383 ref 1299 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 6134 10314 5570 6144 Length 11004 5570 2160 454 343 2072 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_gns 490 external procedure is an external procedure. lev_diag internal procedure shares stack frame of external procedure cobol_gns. ill_char internal procedure shares stack frame of external procedure cobol_gns. swm internal procedure shares stack frame of external procedure cobol_gns. scan_off internal procedure shares stack frame of external procedure cobol_gns. ill_dlm internal procedure shares stack frame of external procedure cobol_gns. ill_dlm1 internal procedure shares stack frame of external procedure cobol_gns. ill_dlm2 internal procedure shares stack frame of external procedure cobol_gns. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 wb cobol_gns 000110 period_sw cobol_gns 000111 slen cobol_gns 000112 lerr cobol_gns 000113 per_sw cobol_gns 000114 save_sw cobol_gns 000115 alpha_lit_bit cobol_gns 000116 prev_tok_type cobol_gns 000117 tok_string cobol_gns 000520 hexl_tab1 cobol_gns 000720 mem_tab cobol_gns 001102 x cobol_gns STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_gns 000100 mask cobol_gns 000101 wl cobol_gns 000102 wll cobol_gns 000103 places_left cobol_gns 000104 exp_places cobol_gns 000105 i cobol_gns 000106 save_pcol cobol_gns 000107 rwk cobol_gns 000110 rwc cobol_gns 000111 num_sign cobol_gns 000112 exp_sign cobol_gns 000113 per cobol_gns 000114 exp_sw cobol_gns 000115 integer_sw cobol_gns 000116 found_comma cobol_gns 000117 dlmck1_sw cobol_gns 000120 c1 cobol_gns 000121 hc cobol_gns 000122 hc1 cobol_gns 000124 hc_ptr cobol_gns 000126 hc1_ptr cobol_gns 000130 quot_ch cobol_gns 000131 np_char cobol_gns 000132 new_ch cobol_gns 000133 cont_flag cobol_gns 000134 cont_flag1 cobol_gns 000135 a cobol_gns 000136 h_index cobol_gns 000137 st_pos cobol_gns 000140 ch36 cobol_gns 000152 int_val cobol_gns 000153 posit cobol_gns 000154 ch cobol_gns 000155 linfo cobol_gns 000156 TOK_COLUMN cobol_gns 000166 diag_item lev_diag THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_char_temp call_ext_out return_mac mdfx1 signal_op shorten_stack ext_entry set_chars_eis index_chars_eis any_to_any_truncate_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cobol_c_list cobol_ddsyntax$enter_tok_string cobol_ddsyntax$init_tok_string cobol_insert_token cobol_lexerr$lexerr3 cobol_merge THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cobol_ext_$cobol_com_ptr cobol_ext_$report_exists cobol_ext_lex$cobol_c_l_n cobol_ext_lex$cobol_cards cobol_ext_lex$cobol_comma_character cobol_ext_lex$cobol_continuation cobol_ext_lex$cobol_current cobol_ext_lex$cobol_decimal_point_character cobol_ext_lex$cobol_head_words cobol_ext_lex$cobol_lu_sw cobol_ext_lex$cobol_new_line_character cobol_ext_lex$cobol_pic_switch cobol_ext_lex$cobol_progid_sw cobol_ext_lex$cobol_save_cln cobol_ext_lex$cobol_save_col cobol_ext_lex$cobol_scanoff_sw cobol_ext_lex$processing_report LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 45 000145 207 000155 210 000157 212 000171 214 000174 216 000175 218 000201 219 000205 222 000206 224 000211 225 000212 228 000224 230 000230 232 000237 234 000242 236 000243 238 000244 241 000256 244 000261 246 000263 248 000265 250 000300 252 000302 253 000306 254 000310 255 000312 258 000314 259 000316 262 000317 263 000321 266 000322 270 000330 272 000333 274 000342 277 000351 278 000353 279 000356 282 000360 284 000370 286 000372 290 000375 293 000402 328 000406 330 000411 334 000425 337 000441 339 000443 340 000447 341 000451 342 000453 345 000455 347 000460 348 000462 350 000464 367 000466 375 000475 378 000477 379 000501 381 000502 383 000505 386 000532 387 000534 390 000543 392 000552 394 000556 396 000563 401 000565 403 000566 406 000567 407 000574 409 000603 413 000611 415 000616 417 000617 421 000620 422 000621 425 000622 428 000630 431 000633 432 000636 433 000637 436 000640 438 000646 439 000651 440 000652 442 000657 444 000663 445 000665 449 000666 450 000667 452 000676 455 000700 457 000706 458 000707 462 000716 466 000735 469 000750 473 000762 476 001003 482 001047 487 001056 489 001060 490 001064 491 001066 492 001070 507 001073 511 001126 518 001170 521 001217 527 001226 532 001236 533 001240 535 001241 536 001243 537 001244 538 001245 539 001246 540 001247 542 001250 545 001252 546 001254 548 001255 550 001260 553 001305 554 001307 557 001316 559 001324 561 001331 563 001335 565 001342 570 001344 573 001345 574 001347 575 001352 578 001353 581 001364 582 001366 584 001371 586 001375 587 001377 588 001401 589 001403 590 001404 592 001410 594 001417 596 001426 599 001436 601 001443 602 001444 607 001453 610 001455 612 001470 613 001475 614 001477 615 001501 616 001505 617 001512 618 001515 619 001520 620 001522 621 001524 622 001530 625 001534 629 001542 632 001543 637 001560 640 001573 662 001603 666 001606 667 001613 669 001616 670 001620 671 001622 673 001623 677 001632 678 001634 679 001640 680 001642 683 001647 686 001656 688 001661 690 001665 692 001672 697 001674 701 001715 702 001716 706 001725 708 001751 711 001760 714 001761 717 001774 718 001775 724 002004 729 002030 733 002031 735 002032 736 002034 737 002036 738 002040 740 002041 743 002044 745 002052 747 002056 749 002062 751 002067 756 002071 758 002072 762 002073 766 002074 770 002113 772 002120 774 002122 776 002127 778 002154 781 002163 784 002165 785 002171 787 002173 791 002175 793 002205 795 002207 797 002213 799 002220 804 002222 806 002224 807 002230 812 002231 814 002237 815 002263 816 002264 819 002273 820 002276 824 002277 827 002300 830 002303 832 002330 833 002331 835 002340 838 002351 839 002355 840 002356 841 002361 844 002362 847 002366 849 002372 851 002377 856 002401 858 002407 859 002433 860 002434 867 002443 872 002450 874 002453 876 002457 879 002462 881 002463 884 002472 888 002473 891 002477 896 002503 903 002510 905 002511 908 002512 909 002514 910 002516 911 002521 912 002526 914 002534 917 002540 919 002542 921 002543 923 002546 925 002553 927 002556 928 002561 931 002562 933 002570 936 002575 938 002602 940 002606 942 002613 947 002615 952 002623 955 002650 959 002657 962 002663 964 002666 966 002673 970 002676 972 002704 975 002711 977 002716 979 002722 981 002727 986 002731 992 002737 996 002740 997 002744 998 002750 1000 002751 1002 002752 1005 002757 1006 003004 1009 003013 1010 003017 1012 003026 1015 003036 1016 003037 1019 003041 1022 003066 1025 003101 1027 003103 1028 003107 1029 003111 1030 003113 1032 003116 1034 003117 1038 003126 1041 003130 1043 003132 1046 003133 1047 003136 1049 003137 1052 003144 1053 003146 1057 003147 1059 003150 1062 003153 1065 003173 1068 003216 1072 003217 1074 003220 1079 003230 1080 003237 1082 003242 1084 003250 1086 003254 1088 003261 1098 003263 1101 003302 1104 003310 1107 003314 1109 003320 1112 003323 1113 003325 1114 003327 1116 003330 1117 003332 1120 003334 1124 003335 1126 003337 1132 003340 1137 003350 1139 003357 1141 003370 1143 003372 1144 003374 1147 003375 1150 003400 1151 003405 1152 003407 1154 003411 1157 003424 1158 003427 1162 003430 1164 003431 1165 003432 1167 003433 1170 003442 1175 003452 1178 003474 1179 003476 1181 003500 1185 003501 1187 003502 1198 003511 1200 003513 1201 003514 1203 003515 1206 003516 1208 003520 1209 003521 1213 003522 1216 003526 1219 003530 1224 003552 1225 003553 1227 003554 1229 003573 1231 003574 1233 003603 1237 003621 1238 003623 1239 003625 1241 003626 1244 003632 1246 003635 1247 003637 1248 003640 1249 003643 1252 003644 1254 003655 1256 003657 1257 003661 1260 003662 1262 003663 1264 003664 1268 003704 1269 003706 1270 003710 1272 003711 1276 003731 1277 003733 1278 003735 1288 003736 1292 003747 1294 003751 1295 003753 1296 003755 1299 003756 1302 003761 1303 003765 1308 003771 1310 003777 1312 004003 1314 004010 1319 004012 1322 004013 1324 004027 1326 004031 1329 004032 1331 004050 1333 004052 1335 004070 1336 004072 1339 004075 1340 004122 1341 004123 1344 004132 1347 004146 1350 004161 1352 004163 1353 004167 1354 004171 1369 004173 1371 004175 1372 004177 1373 004201 1374 004202 1376 004203 1378 004206 1380 004224 1384 004227 1386 004230 1390 004236 1392 004243 1396 004262 1397 004265 1398 004267 1400 004270 1402 004272 1405 004307 1409 004312 1411 004313 1413 004320 1416 004324 1422 004325 1424 004326 1426 004335 1430 004340 1436 004364 1439 004373 1443 004374 1448 004375 1449 004376 1451 004405 1455 004415 1458 004421 1463 004430 1467 004441 1469 004456 1473 004466 1475 004474 1477 004500 1480 004504 1482 004506 1484 004507 1486 004510 1487 004514 1490 004520 1491 004522 1494 004523 1589 004532 1593 004542 1594 004544 1597 004550 1600 004554 298 004563 312 004565 313 004567 314 004571 315 004573 317 004574 318 004576 319 004600 321 004602 323 004613 1189 004614 1192 004615 1193 004642 1194 004643 1496 004644 1510 004645 1511 004651 1514 004671 1515 004672 1518 004673 1521 004675 1524 004700 1526 004704 1527 004707 1528 004711 1530 004712 1532 004713 1533 004722 1534 004725 1535 004727 1537 004730 1539 004731 1542 004752 1543 004755 1546 004756 1548 004764 1550 004770 1552 004775 1554 004777 1557 005000 1559 005001 1561 005002 1562 005027 1564 005030 1566 005031 1568 005056 1574 005103 1576 005104 1578 005105 1580 005132 1586 005157 ----------------------------------------------------------- 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