COMPILATION LISTING OF SEGMENT cobol_idedsyn 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 1009.8 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_idedsyn.pl1 Reformatted code to new Cobol standard. 19* END HISTORY COMMENTS */ 20 21 22 /* Modified on 09/08/81 by FCH, [5.0-1], fix flagging for Validation-81, BUG501(SQ431,SG441) */ 23 /* Modified on 07/16/81 by FCH, [4.4-3], DEFAULT FOR COMP IS DISPLAY does not work, phx10066(BUG494) */ 24 /* Modified on 04/09/81 by FCH, [4.4-2], fix bugs in leveling for validation-81, BUG477 */ 25 /* Modified on 10/22/80 by FCH, COBOL_SYNTAX_TRACE_ changed to cobol_syntax_trace_ */ 26 /* Modified on 09/30/80 by FCH, [4.4-1], density is 6250 is supported, BUG447(TR7681) */ 27 /* Modified on 07/17/80 by FCH, [4.3-1], ignore APPLY TEMP for external files */ 28 /* Modified on 04/17/80 by FCH, [4.2-2], L-216 added (DYNAMIC phrase), level-6 consistancy */ 29 /* Modified on 12/12/79 by MHD, [4.2-1], added action(78) and check(28) - leveling for SORT files */ 30 /* Modified on 10/11/79 by MHD, [4.1-1], RERUN clause */ 31 /* Modified on 09/10/79 by FCH, [4.0-9], set attach_options_info */ 32 /* Modified on 08/28/79 by FCH, [4.0-8], fix lev diags for same area */ 33 /* Modified on 08/24/79 by FCH, [4.0-7], fix ALSO HIGH-VALUE NC219 */ 34 /* Modified on 06/18/79 by MHD, [4.0-6], appended to debug statement */ 35 /* Modified on 05/17/79 by FCH, [4.0-6], debug statement */ 36 /* Modified on 03/23/79 by FCH, [4.0-5], fix select statement flagging */ 37 /* Modified on 03/21/79 by FCH, [4.0-4], fix file_table.detach setting */ 38 /* Modified on 03/21/79 by FCH, [4.0-3], preattached implies no detach on close */ 39 /* Modified on 03/13/79 by FCH, [4.0-2], set debug bit */ 40 /* Modified on 03/13/79 by FCH, [4.0-1], preattached implies external and non-optional */ 41 /* Modified on 01/09/79 by FCH, [3.0-7] , alt key chain */ 42 /* Modified on 12/11/78 by RAL [3.0-6]. made seq default organization */ 43 /* Modified on 12/05/78 by RAL, [3.0-5], added dupl_alt to indicate that file has duplicate keys */ 44 /* Modified on 11/13/78 by RAL, [3.0-4], added counting of alternate_keys in file_table */ 45 /* Modified on 06/07/78 by RAL, [3.0-3], action(173) leveling diag 169 */ 46 /* Modified on 03/30/78 by FCH, [3.0-2], set file_key.next_alt + other additions for alt record MR7.0 */ 47 /* Mofified on 03/30/78 by FCH, [3.0-1], new action(75), duplicates clause, alt rec key */ 48 /* Modified since Version 3.0 */ 49 50 51 52 53 54 55 56 57 /* format: style3 */ 58 cobol_idedsyn: 59 proc; 60 61 62 63 call cobol_ided (p1, n_reducs); 64 65 fixed_common.cpl_files = "0"b; 66 diag_num = 0; 67 current_line = 3; /* 2*5+5 */ 68 69 coll_seq = collate (); 70 71 /* initialize automatic data */ 72 73 zero = "000000000000000000"; 74 75 call alloc; 76 77 error = " "; 78 fixed_common.seg_limit = 1; 79 kill_diag = 0; 80 mod_num = 0; /*[5.0-1]*/ 81 seg_limit = 0; 82 nat_alf_size = 127; 83 addr (indicators) -> bit36 = "0"b; 84 samect = 0; 85 samerecct = 0; 86 mult_fil_no = 0; 87 rerunclock = "0"b; 88 remarksbit = "0"b; 89 debugbit = "0"b; 90 optional_file = "0"b; 91 external_file = "0"b; 92 previous_valid_fkeys = "0"b; 93 implnm_bit = "0"b; 94 ed_found = "0"b; 95 console_name = "0"b; 96 dec_is_com = fixed_common.dec_comma; 97 fixed_common.dec_comma = "0"b; 98 fixed_common.comp_defaults.comp_5 = "1"b; 99 dpass_sw = "0"b; 100 qual_sw = "0"b; /* init value */ 101 /* initialize contradiction matrix for select clause */ 102 array (1) = "00011011111010110010"b; 103 array (2) = "00011011111001010010"b; 104 array (3) = "00000100000000001101"b; 105 array (4) = "00000011110111110101"b; 106 array (5) = "00000011110111111001"b; 107 array (6) = "00000000000000000000"b; 108 array (7) = "00000000000001010000"b; 109 array (8) = "00000000000010100000"b; 110 array (9) = "00000000000111110000"b; 111 array (10) = "00000000000111100000"b; 112 array (11) = "00000000000001100000"b; 113 array (12) = "00000000000000000000"b; 114 array (13) = "00000000000001100000"b; 115 array (14) = "00000000000000110000"b; 116 array (15) = "00000000000000010000"b; 117 array (16) = "00000000000000000000"b; 118 array (17) = "00000000000000000000"b; 119 array (18) = "00000000000000000000"b; 120 array (19) = "00010011110111111100"b; 121 array (20) = "00000000000000000000"b; 122 array (21) = "001111111111111111110"b; 123 124 /* initialize word_array table */ 125 126 word_array.word_size (1) = 6; 127 word_array.word (1) = "assign"; 128 word_array.word_size (2) = 6; 129 word_array.word (2) = "assign"; 130 word_array.word_size (3) = 12; 131 word_array.word (3) = "organization"; 132 word_array.word_size (4) = 12; 133 word_array.word (4) = "organization"; 134 word_array.word_size (5) = 12; 135 word_array.word (5) = "organization"; 136 word_array.word_size (6) = 6; 137 word_array.word (6) = "access"; 138 word_array.word_size (7) = 6; 139 word_array.word (7) = "device"; 140 word_array.word_size (8) = 6; 141 word_array.word (8) = "device"; 142 word_array.word_size (9) = 6; 143 word_array.word (9) = "device"; 144 word_array.word_size (10) = 6; 145 word_array.word (10) = "device"; 146 word_array.word_size (11) = 6; 147 word_array.word (11) = "prefix"; 148 word_array.word_size (12) = 6; 149 word_array.word (12) = "prefix"; 150 word_array.word_size (13) = 6; 151 word_array.word (13) = "prefix"; 152 word_array.word_size (14) = 5; 153 word_array.word (14) = "sysin"; 154 word_array.word_size (15) = 6; 155 word_array.word (15) = "sysout"; 156 word_array.word_size (16) = 8; 157 word_array.word (16) = "optional"; 158 word_array.word_size (17) = 12; 159 word_array.word (17) = "relative key"; 160 word_array.word_size (18) = 10; 161 word_array.word (18) = "record key"; 162 word_array.word_size (19) = 12; 163 word_array.word (19) = "organization"; 164 word_array.word_size (20) = 9; 165 word_array.word (20) = "keyed key"; 166 word_array.word_size (21) = 6; 167 word_array.word (21) = "assign"; 168 169 /*[4.0-6]*/ 170 if fixed_common.debug /*[4.0-6]*/ 171 then do; 172 right.line = 0; /* sets up entry in table for mnemonic name "SWITCH-8" */ 173 /*[4.0-6]*/ 174 right.column = 15; /*[4.0-6]*/ 175 right.name = "switch-8"; /*[4.0-6]*/ 176 addr (mnemonic_name.class) -> bit8 = "0"b; 177 /*[4.0-6]*/ 178 mnemonic_name.class.switch_name = "1"b; /*[4.0-6]*/ 179 left.number = 8; /*[4.0-6]*/ 180 call nm (addr (right), left.number); /* switch8 to name table */ 181 182 /* sets up entry in table for condition name "DEBUG-ON" */ 183 184 /*[4.0-6]*/ 185 substr (switch_bits, left.num, 1) = "1"b; 186 /*[4.0-6]*/ 187 addr (mnemonic_name.class) -> bit8 = "0"b; 188 /*[4.0-6]*/ 189 mnemonic_name.class.switch_condition = "1"b; 190 /*[4.0-6]*/ 191 mnemonic_name.on_status = "1"b; /*[4.0-6]*/ 192 mnemonic_name.column = 30; /* means nothing */ 193 /*[4.0-6]*/ 194 mnemonic_name.def_line = 0; /* line is not actually in program */ 195 /*[4.0-6]*/ 196 mnemonic_name.name = "debug-on"; /*[4.0-6]*/ 197 mnemonic_name.name_size = length (mnemonic_name.name); 198 mnemonic_name.size = mnemonic_name.name_size + type17_size; 199 /*[4.0-6]*/ 200 mnemonic_name.iw_key = left.number; /* see cobol_imp_word */ 201 /*[4.0-6]*/ 202 call buildnm; /* puts the name in the table */ 203 /*[4.0-6]*/ 204 end; 205 206 /* initialize diag_item structure */ 207 208 diag1_ptr = addr (diag_item); 209 diag_item.type = 5; 210 diag_item.run = 2; 211 diag_item.replace = "0"b; 212 diag_item.filler = "000000"b; 213 214 diag2_ptr = addr (lev_diag_item); 215 lev_diag_item.type = 5; 216 lev_diag_item.size = 28; 217 lev_diag_item.run = 9; 218 219 defaults = "0"b; 220 clause_num = 0; 221 last_clause = 0; 222 pcs.type = 0; 223 char1_ptr = addr (char1); 224 trace_ptr = addr (interp); 225 tbit = fixed_common.syntax_trace; 226 if tbit 227 then call cobol_syntax_trace_$initialize_phase (trace_ptr, 1); 228 call scan; /* read first minpral item */ 229 230 go to loop; 231 232 alloc: 233 proc; 234 235 ft_ptr = addr (ft_build_area (1)); 236 file_table_size = size (file_table) * 4; 237 238 name_ptr = addr (ft_build_area (1)); 239 mnemonic_name.name_size = 0; 240 type17_size = size (mnemonic_name) * 4; 241 242 fkey_ptr = addr (ft_build_area (1)); 243 file_key.name_size = 0; 244 file_key_size = size (file_key) * 4; 245 246 qual_ptr = addr (ft_build_area (1)); 247 qual_rec.size = 0; 248 key_qual_size = size (qual_rec) * 4; 249 250 alpha_ptr = addr (ft_build_area (1)); 251 alphabet_name.name_size = 0; 252 alphabet_name_size = size (alphabet_name) * 4; 253 254 end; 255 256 257 258 259 /* */ 260 /* syntax interpreter */ 261 /* */ 262 263 fail: 264 if tbit 265 then call cobol_syntax_trace_$trace (trace_ptr, tm2); 266 current_line = current_line + 1; 267 268 loop: 269 syntax_line_ptr = addr (syntax_table (current_line)); 270 go to test (syntax_line.t_type); 271 272 test (0): 273 if reserved_word.type ^= 1 274 then go to fail; 275 if reserved_word.key ^= syntax_line.t_field 276 then go to fail; 277 278 success: 279 if tbit 280 then call cobol_syntax_trace_$trace (trace_ptr, tm1); 281 282 ucon: 283 if syntax_line.o_bit ^= " " 284 then do; 285 if syntax_line.o_bit > fixed_common.comp_level 286 then call lev_diag (syntax_line.a_num, record.header.line, record.header.column); 287 go to ret; 288 end; 289 290 go to action (syntax_line.a_num); 291 292 test (1): 293 go to check (syntax_line.t_field); /* check routine test */ 294 295 test (2): 296 diag_num = syntax_line.t_field; /* unconditional branch */ 297 act_num = syntax_line.a_num; 298 299 if syntax_line.o_bit ^= " " 300 then do; 301 if syntax_line.o_bit > fixed_common.comp_level 302 then do; 303 mod_num = syntax_line.a_num; 304 call lev_diag (diag_num, record.header.line, record.header.column); 305 end; 306 307 diag_num = 0; 308 act_num = 0; 309 end; 310 311 if tbit 312 then call cobol_syntax_trace_$trace (trace_ptr, tm1); 313 314 go to action (act_num); 315 316 check (0): 317 wnum = cobol_imp_word$imp_word (p2); 318 319 if wnum = 0 | wnum ^= syntax_line.a_num 320 then go to fail; 321 322 if tbit 323 then call cobol_syntax_trace_$trace (trace_ptr, tm1); 324 325 go to ret; 326 327 ret: 328 action (0): 329 if kill_diag ^= 0 330 then kill_diag, diag_num = 0; 331 else if diag_num ^= 0 332 then call diag; 333 334 if syntax_line.s_bit = "s" 335 then call scan; 336 337 current_line = syntax_line.s_exit; 338 339 go to loop; 340 341 declare tm1 fixed bin init (1), 342 tm2 fixed bin init (2), 343 tm3 fixed bin init (3), 344 tm4 fixed bin init (4), 345 tm5 fixed bin init (5); 346 347 declare cobol_syntax_trace_$trace 348 entry (ptr, fixed bin); 349 declare cobol_syntax_trace_$initialize_phase 350 entry (ptr, fixed bin); 351 352 declare (syntax_line_ptr, trace_ptr) 353 ptr; 354 355 declare tbit bit (1); 356 declare (diag_num, kill_diag) 357 fixed bin; 358 359 declare 1 interp, 360 2 current_line fixed bin, 361 2 phase fixed bin, 362 2 p2 ptr, 363 2 p1 ptr, 364 2 directory_ptr ptr, 365 2 source_ptr ptr; 366 367 declare 1 syntax_table (0:10000) based (p1), 368 2 b1 fixed bin, 369 2 b2 fixed bin, 370 2 b3 fixed bin, 371 2 b4 fixed bin, 372 2 b5 fixed bin; 373 374 375 declare 1 syntax_line based (syntax_line_ptr), 376 2 s_bit char (1), 377 2 o_bit char (1), 378 2 t_type fixed bin, 379 2 t_field fixed bin, 380 2 s_exit fixed bin, 381 2 a_num fixed bin; 382 383 diag: 384 proc; 385 386 if remarksbit = "1"b 387 then return; 388 389 diag_item.line = record.header.line; 390 diag_item.column = record.header.column; 391 diag_item.size = 25; 392 diag_item.number = diag_num; 393 diag_item.param_at_end = "0"b; 394 395 call cobol_c_list (diag1_ptr); /* issue diagnostic */ 396 397 diag_num = 0; 398 end; 399 400 lev_diag: 401 proc (diag_num, lin, col); 402 403 /*[4.4-2]*/ 404 declare (diag_num, lin, col) 405 fixed bin; 406 407 /*[4.4-2]*/ 408 lev_diag_item.line = lin; /*[4.4-2]*/ 409 lev_diag_item.column = col; 410 lev_diag_item.number = diag_num; 411 lev_diag_item.module = mod_num; 412 413 call cobol_c_list (diag2_ptr); 414 415 mod_num = 0; 416 417 end; 418 419 scan: 420 proc; 421 422 do while ("1"b); 423 424 call cobol_swf_get (cobol_min1_fileno, min1_status, p2, mrcsz); 425 426 rw_ptr = p2; /* set reserved word token structure. */ 427 nlit_ptr = p2; /* set numeric literal token structure. */ 428 alit_ptr = p2; /* set alphanumeric literal token structure */ 429 430 if substr (min1_status, 17, 16) ^= "0000000000000000"b 431 then go to action (61); 432 433 if record.header.type ^= 6 434 then do; 435 if record.header.type ^= 5 436 then do; 437 dpass_sw = "0"b; 438 return; 439 end; 440 441 if dpass_sw = "1"b 442 then dpass_sw = "0"b; 443 else do; 444 if remarksbit = "0"b 445 then call cobol_c_list (p2); 446 447 if message.body.info.replaces_token ^= "0"b 448 then do; 449 if ed_found = "0"b 450 then current_line = 1; 451 /* 0*1+1 */ 452 else current_line = 2; 453 /* 1*5+5 */ 454 455 go to loop; 456 end; 457 end; 458 end; 459 460 end; 461 462 end; 463 464 465 466 /* CHECK ROUTINES */ 467 468 alfnam: 469 check (1): /* name of program collating sequence alphabet */ 470 call system_name (addr (left)); 471 472 if left.type = 0 473 then go to fail; 474 475 go to success; 476 477 478 system_name: 479 proc (p); 480 481 declare p ptr, 482 key fixed bin; 483 484 declare 1 sys_name based (p), 485 2 type fixed bin, /* 0 undefined */ 486 /* 1 user name */ 487 /* 2 switch name */ 488 /* 3 device name */ 489 /* 4 impl alpha name */ 490 /* 5 standard alpha name */ 491 /* 6 printer ctl word */ 492 2 line fixed bin, 493 2 column fixed bin, 494 2 number fixed bin, 495 2 num fixed bin, 496 2 name char (32) varying; 497 498 sys_name.type = 0; 499 sys_name.number = 0; 500 sys_name.name = ""; 501 502 if reserved_word.type = 1 503 then do; 504 key = reserved_word.key; 505 506 if key = 288 507 then num = 1; /* is_word("native") */ 508 else if key = 505 509 then num = 2; /* is_word("standard-1") */ 510 else if key = 208 511 then num = 3; /* is_word("standard-2") */ 512 else return; 513 514 sys_name.type = 5; 515 sys_name.number = num; 516 sys_name.line = reserved_word.line; 517 sys_name.column = reserved_word.column; 518 return; 519 end; 520 521 else if user_word.type ^= 8 522 then return; 523 sys_name.number = cobol_imp_word$imp_word (p2); 524 sys_name.num = cobol_imp_word$switch_name (p2); 525 526 if sys_name.num ^= 0 527 then sys_name.type = 2; 528 else do; 529 sys_name.num = cobol_imp_word$device_name (p2); 530 531 if sys_name.num ^= 0 532 then sys_name.type = 3; 533 else do; 534 sys_name.num = cobol_imp_word$alphabet_name (p2); 535 536 if sys_name.num ^= 0 537 then sys_name.type = 4; 538 else do; 539 sys_name.num = cobol_imp_word$printer_control (p2); 540 541 if sys_name.num ^= 0 542 then sys_name.type = 6; 543 else sys_name.type = 1; 544 end; 545 546 end; 547 548 end; 549 550 551 sys_name.name = user_word.word; 552 sys_name.line = user_word.line; 553 sys_name.column = user_word.column; 554 555 end; 556 557 558 clorder: 559 check (2): /* check for improper clause ordering */ 560 if clause_order = 0 561 then go to success; 562 563 go to fail; 564 565 566 567 check (3): 568 ; 569 areaa: 570 if record.column < 12 571 then go to success; 572 573 if fixed_common.comp_level < "3" 574 then call lev_diag (133, record.header.line, record.header.column); 575 576 go to fail; 577 578 579 580 check (4): 581 ; 582 asgn: /* assumes ft_ptr set to correct file */ 583 if file_table.ifn ^= " " 584 then go to success; 585 586 go to fail; 587 588 check (5): 589 comptype: 590 comp_type = cobol_imp_word$comp_type (p2); 591 592 if comp_type ^= 0 593 then go to success; 594 595 comp_type = cobol_imp_word$disp_type (p2); 596 597 if comp_type = 0 598 then go to fail; 599 600 comp_type = comp_type + 10; 601 602 go to success; 603 604 /* is the current word the name of a file selected in the file-control paragraph? */ 605 606 check (6): 607 ; 608 chckft: 609 call check_ft; 610 611 if res = 0 612 then go to success; 613 614 go to fail; 615 616 check_ft: 617 proc; 618 619 /*[4.1-1]*/ 620 /* Changed to return res = 1 if an error occurs. IO_ERROR used to be seperated */ 621 /* from this procedure and set error to "E" but error was never referenced. Also */ 622 /* reorganized it a little to help readability */ 623 624 625 res = 0; 626 627 if record.header.type = 8 628 then if fixed_common.file_count ^= 0 /* fail then if no files selected */ 629 then do; 630 631 com_io_key = filedescr_offsets (1);/* get 1st file_table */ 632 633 do while ("1"b); 634 635 call cobol_vdwf_dget (cobol_com_fileno, com_status, file_ptr, common_recsize, com_io_key); 636 637 if substr (com_status, 17, 16) ^= "0000000000000000"b 638 then go to io_error; 639 640 if user_word.word 641 = substr (file_ptr -> file_table.name, 1, file_ptr -> file_table.name_size) 642 then return; 643 644 if file_ptr -> file_table.next = "00000" 645 then goto io_error; 646 647 com_io_key = file_ptr -> file_table.next; 648 649 end; /* do while */ 650 651 end; /* then */ 652 653 io_error: 654 file_ptr = null (); 655 res = 1; 656 return; 657 658 end check_ft; 659 660 661 662 663 comp_test: 664 check (7): /* determine if computer not multics */ 665 if comp_num = 1 | comp_num = 7 666 then go to success; 667 668 go to fail; 669 670 671 672 dupdev: 673 check (8): /* test for duplicate device name */ 674 if right.type = 3 & substr (dev_bits, right.num, 1) 675 then go to fail; 676 677 substr (dev_bits, right.num, 1) = "1"b; 678 679 go to success; 680 681 682 dupsw: 683 check (9): /* test for duplicate switch name */ 684 if substr (switch_bits, left.num, 1) 685 then go to fail; 686 687 substr (switch_bits, left.num, 1) = "1"b; 688 689 go to success; 690 691 fileorg: 692 check (10): /* check for legal file organization */ 693 file_org = 1; 694 695 if reserved_word.type ^= 1 696 then go to fail; 697 698 key = reserved_word.key; 699 700 if key = 597 701 then file_org = 1; /* is_word("sequential") */ 702 else if key = 223 703 then file_org = 2; /* is_word("indexed") */ 704 else if key = 167 705 then file_org = 3; /* is_word("relative") */ 706 else if key = 407 707 then file_org = 4; /* is_word("stream") */ 708 else if key = 423 709 then file_org = 5; /* is_word("ids-ii") */ 710 else if key = 416 711 then file_org = 6; /* is_word("keyed") */ 712 else go to fail; 713 714 if file_org > 3 & fixed_common.comp_level ^= "5" 715 then call lev_diag (157, record.header.line, record.header.column); 716 717 go to success; 718 719 720 721 filequal: 722 check (11): /* test for legal file qualifier before file organization */ 723 file_qual = cobol_imp_word$computer_name (p2); 724 725 if file_qual ^= 0 726 then go to success; 727 728 fq = cobol_imp_word$file_org (p2); 729 730 if fq <= 3 731 then go to fail; 732 733 file_qual = fq + 6; 734 735 go to success; 736 737 /* is the current word different from previously selected file names? */ 738 739 check (12): 740 ; 741 cknew: 742 if fixed_common.file_count = 0 743 then go to success; 744 com_io_key = filedescr_offsets (1); /* get 1st file_table */ 745 call cobol_vdwf_dget (cobol_com_fileno, com_status, file_ptr, common_recsize, com_io_key); 746 747 check12a: 748 if user_word.word = substr (file_ptr -> file_table.name, 1, file_ptr -> file_table.name_size) 749 then go to fail; 750 751 if file_ptr -> file_table.next = "00000" 752 then go to success; 753 754 com_io_key = file_ptr -> file_table.next; /* get next file_ptr -> file_table */ 755 call cobol_vdwf_dget (cobol_com_fileno, com_status, file_ptr, common_recsize, com_io_key); 756 757 go to check12a; 758 759 switch_2: 760 check (13): 761 call set_sw; 762 763 764 765 go to success; 766 767 768 769 770 idparnm: 771 check (14): /* determine id paragraph number */ 772 if reserved_word.type = 1 773 then do; 774 key = reserved_word.key; 775 776 if key = 510 777 then clause_num = 2; /* is_word("author") */ 778 else if key = 554 779 then clause_num = 3; /* is_word("installation") */ 780 else if key = 528 781 then clause_num = 4; /* is_word("date-written") */ 782 else if key = 527 /* is_word("date-compiled") */ 783 then do; 784 clause_num = 5; 785 if fixed_common.comp_level < "3" 786 then call lev_diag (3, record.header.line, record.header.column); 787 end; 788 else if key = 594 789 then clause_num = 6; /* is_word("security") */ 790 else if key = 586 /* is_word("remarks") */ 791 then do; 792 clause_num = 7; 793 if fixed_common.comp_level < "5" 794 then call lev_diag (152, record.header.line, record.header.column); 795 end; 796 else go to fail; 797 798 go to success; 799 800 end; 801 802 go to fail; 803 804 805 806 in_dev: 807 check (15): /* test for input device */ 808 key = cobol_imp_word$device_name (p2); 809 810 if key = 1 | key = 3 811 then go to success; 812 813 go to fail; 814 815 816 817 out_dev: 818 check (16): /* test for output device name */ 819 key = cobol_imp_word$device_name (p2); 820 821 if key = 2 | key = 3 822 then go to success; 823 824 go to fail; 825 826 827 /* has the program name been stored in common? */ 828 829 check (17): 830 ; 831 ckpnm: 832 if fixed_common.prog_name ^= " " 833 then go to success; 834 835 go to fail; 836 837 is_dev: 838 check (18): 839 if clause_num = 2 840 then go to success; 841 842 go to fail; 843 844 is_alf: 845 check (19): 846 if clause_num = 3 847 then go to success; 848 849 go to fail; 850 851 852 /* is temp1 greater than zero, meaning current clause is not simple SAME AREA? */ 853 854 check (20): 855 ; 856 cktemp1: 857 if temp1 > 0 858 then go to success; 859 860 go to fail; 861 862 dupopt: 863 check (21): 864 if sk_ind 865 then go to fail; 866 else go to success; 867 868 is_sw: 869 check (22): 870 if clause_num = 1 871 then go to success; 872 873 go to fail; 874 875 /* is the currency sign literal valid? */ 876 877 check (23): 878 ; 879 currlit: 880 if record.type ^= 3 | alphanum_lit.lit_size ^= 1 881 then go to fail; 882 883 tempn1 = 884 index ("0123456789abcdefghijklmnopqrstuvwxyzABCDLPRSVXZ *+-,.;()""/=", substr (alphanum_lit.string, 1, 1)); 885 886 if tempn1 ^= 0 887 then go to fail; 888 889 go to success; 890 891 /* a) if lexical scan recognized a decimal-point clause, was the clause found in special-names? 892* b) if lexical scan found no decimal-point clause, was the clause not found in special-names? */ 893 894 check (24): 895 ; 896 decptok: 897 if dec_is_com = "1"b & fixed_common.dec_comma = "0"b 898 then go to fail; 899 else go to success; 900 leftname: 901 check (25): /* left hand name in special-names paragraph clause */ 902 call system_name (addr (left)); 903 904 if left.type = 0 | left.type = 5 905 then go to fail; 906 907 go to success; 908 909 910 /* is the current numeric literal greater than 1? */ 911 912 oc_name: 913 check (26): /* determine number of object computer */ 914 call computer_name; 915 916 if comp_num = 0 917 then go to fail; 918 else obj_comp_num = comp_num; 919 920 go to success; 921 922 rempar: 923 check (27): /* determine if remarks paragraph used */ 924 if clause_num = 7 925 then go to success; 926 927 go to fail; 928 929 /*[4.2-1]*/ 930 sortfile: 931 check (28): /* check if file_name represents a sort file */ 932 if cobol_res_words$check_sort_list (alphanum_lit.string) 933 then go to success; 934 935 go to fail; 936 937 /* is the current item a valid implementor-name for use in an ASSIGN clause? */ 938 939 check (29): 940 ; 941 implnm: 942 dpass_sw = "1"b; 943 944 if record.header.type ^= 8 945 then go to fail; 946 947 n = index (user_word.word, "-"); 948 949 if n = 0 950 then do; 951 file_table.device = 6; 952 953 if user_word.length > 16 954 then do; 955 diag_num = 106; 956 call diag; 957 958 user_word.length = 16; 959 end; 960 961 go to success; 962 963 end; 964 965 if n = 1 966 then go to fail; 967 968 device_name_size = user_word.length - n; 969 970 if n > 17 971 then do; 972 diag_num = 106; 973 call diag; 974 975 user_word.length = 16; 976 end; 977 978 else user_word.length = n - 1; 979 980 device_name = substr (user_word.word, n + 1, device_name_size); 981 982 if device_name = "printer" | device_name = "PRINTER" 983 then do; 984 property (7) = "1"b; 985 file_table.device = 1; 986 end; 987 988 else if device_name = "card-reader" | device_name = "CARD-READER" 989 then do; 990 property (8) = "1"b; 991 file_table.device = 2; 992 end; 993 994 else if device_name = "card-punch" | device_name = "CARD-PUNCH" 995 then do; 996 property (9) = "1"b; 997 file_table.device = 3; 998 end; 999 1000 else if device_name = "msd" | device_name = "MSD" 1001 then file_table.device = 4; 1002 1003 else if device_name = "tape" | device_name = "TAPE" 1004 then do; 1005 property (10) = "1"b; 1006 file_table.device = 5; 1007 end; 1008 1009 else if device_name = "virtual" | device_name = "VIRTUAL" 1010 then file_table.device = 6; 1011 1012 else if device_name = "preattached" | device_name = "PREATTACHED" 1013 then file_table.device = 7; 1014 1015 else do; 1016 diag_num = 107; 1017 call diag; 1018 1019 file_table.device = 6; 1020 end; 1021 1022 go to success; 1023 1024 1025 /* is the current item a valid implementor-name for use to indicate the place where RERUN 1026* information is to be stored? */ 1027 1028 check (30): 1029 ; 1030 implnm1: /*[4.1-1]*/ 1031 if cobol_imp_word$imp_word (p2) = 1009 /* is it "checkpoint-file" */ 1032 /*[4.1-1]*/ 1033 then goto success; 1034 1035 go to fail; 1036 1037 /* is current word an integer? */ 1038 1039 check (31): 1040 ; 1041 integr: 1042 call integer; /*[5.0-1]*/ 1043 seg_limit = num_binary; 1044 if num_binary = 0 1045 then go to fail; 1046 else go to success; 1047 1048 integer: 1049 proc; 1050 1051 num_binary = 0; 1052 1053 1054 if record.header.type ^= 2 1055 then return; 1056 if numeric_lit.integral = "0"b 1057 then return; 1058 if numeric_lit.sign ^= " " 1059 then return; 1060 if numeric_lit.literal = substr (zero, 1, numeric_lit.places) 1061 then return; 1062 1063 call dtb; /* converte current decimal string to binary value */ 1064 1065 /* binary value is stored in num_binary fixed bin(24) field */ 1066 1067 end; 1068 1069 rightname: 1070 check (32): /* right hand name in special-names paragraph clause */ 1071 call system_name (addr (right)); 1072 1073 if right.type = 0 1074 then go to fail; 1075 1076 go to success; 1077 1078 1079 /* if a key has been specified for the current file, is the type of key consistent with 1080*the file's organization? */ 1081 1082 check (33): 1083 ; 1084 keyok: /* assumes ft_ptr set to correct file */ 1085 if file_table.relative_key = "1"b 1086 then go to check33a; 1087 1088 if file_table.organization = 3 1089 then go to success; 1090 1091 go to fail; 1092 1093 check33a: 1094 if file_table.organization = 2 1095 then go to success; 1096 1097 go to fail; 1098 1099 /* if the organization of the current file requires a key, has the key been specified? */ 1100 1101 check (34): 1102 ; 1103 keyreqd: /* assumes ft_ptr set to correct file */ 1104 if file_table.organization = 2 1105 then go to check34a; 1106 if file_table.organization = 3 1107 then go to check34b; 1108 1109 go to success; 1110 1111 check34a: 1112 if file_table.access <= 1 1113 then go to success; /* key not required for sequential access */ 1114 if file_table.relative_key = "1"b 1115 then go to success; 1116 1117 go to fail; 1118 1119 check34b: 1120 if file_table.record_key 1121 then go to success; 1122 1123 go to fail; /* has the current file been named in a previous multiple file clause? */ 1124 1125 check (35): 1126 ; 1127 multok: /* assumes ft_ptr set to correct file */ 1128 if file_ptr = null () 1129 then do; 1130 diag_num = 101; 1131 call diag; 1132 end; 1133 else if file_ptr -> file_table.mult_position_no ^= 0 1134 then do; 1135 file_ptr = null (); 1136 1137 go to fail; 1138 end; 1139 else temp1 = temp1 + 1; 1140 1141 go to success; 1142 1143 sncl: 1144 check (36): 1145 go to LT (left.type); 1146 1147 LT (0): /* illegal */ 1148 clause_num = 0; 1149 1150 go to success; 1151 1152 LT (1): /* user name */ 1153 if right.type = 4 | right.type = 5 1154 then clause_num = 3; 1155 else clause_num = 0; 1156 1157 go to success; 1158 1159 LT (2): /* switch name */ 1160 if right.type = 5 1161 then clause_num = 3; 1162 else clause_num = 1; 1163 1164 go to success; 1165 1166 LT (3): /* device name */ 1167 if right.type = 5 1168 then clause_num = 3; 1169 else clause_num = 2; 1170 1171 go to success; 1172 1173 LT (4): /* implementor alphabet name */ 1174 if right.type = 4 | right.type = 5 1175 then clause_num = 3; 1176 else clause_num = 0; 1177 1178 go to success; 1179 1180 LT (5): /* standard alphabet name */ 1181 clause_num = 0; 1182 1183 go to success; 1184 1185 LT (6): /* printer control name */ 1186 if right.type = 5 1187 then clause_num = 3; 1188 else clause_num = 2; 1189 1190 go to success; 1191 1192 check (37): 1193 figcon: 1194 if reserved_word.type = 1 & reserved_word.figcon 1195 then go to success; 1196 1197 go to fail; 1198 1199 check (39): 1200 go to success; 1201 1202 1203 check (40): 1204 ; 1205 switchnm: /* is the current item a switch-name? */ 1206 wnum = cobol_imp_word$switch_name (p2); 1207 1208 if wnum = 0 1209 then go to fail; 1210 1211 go to success; 1212 1213 tempint: 1214 check (41): /* check for legal integer in temp clause */ 1215 if numeric_lit.type ^= 2 | ^numeric_lit.integral 1216 then go to fail; 1217 1218 int_res = fixed (numeric_lit.literal); 1219 1220 if int_res < 18 | int_res > 61 1221 then go to fail; 1222 1223 go to success; 1224 1225 1226 /* is the current numeric literal 1 through 49? */ 1227 1228 check (42): 1229 ; 1230 smal50: 1231 if num_binary > 0 & num_binary < 50 1232 then go to success; 1233 1234 go to fail; 1235 1236 /* has the current file been named previously in a SAME AREA clause? */ 1237 1238 check (43): 1239 ; 1240 samefree: /* legality test, same clause */ 1241 if file_ptr = null () 1242 then do; 1243 diag_num = 101; 1244 call diag; 1245 1246 go to success; 1247 end; 1248 else if same_type ^= 0 1249 then go to SM (same_type); 1250 1251 go to fail; 1252 1253 SM (1): /* same record area clause */ 1254 if file_ptr -> file_table.same_rec_clause = 0 1255 then go to success; 1256 1257 go to fail; 1258 1259 SM (2): /* same sort area clause */ 1260 if file_ptr -> file_table.same_sort_clause = 0 1261 then go to success; 1262 1263 go to fail; 1264 1265 SM (3): /* same sort-merge area clause */ 1266 if file_ptr -> file_table.same_sort_clause = 0 1267 then go to success; 1268 go to fail; 1269 1270 SM (4): /* same area clause */ 1271 if file_ptr -> file_table.same_area_clause = 0 1272 then go to success; 1273 1274 go to fail; 1275 1276 /* is the current item a special-name other than a switch? */ 1277 1278 check (45): 1279 ; 1280 specnam: 1281 if record.header.type ^= 1 1282 then go to fail; 1283 if reserved_word.key = 197 1284 then go to success; /* CONSOLE */ 1285 if reserved_word.key = 281 1286 then go to success; /* SYSIN */ 1287 if reserved_word.key = 294 1288 then go to success; /* SYSOUT */ 1289 1290 go to fail; 1291 1292 sc_name: 1293 check (46): /* determine number of source computer */ 1294 call computer_name; 1295 1296 if comp_num = 0 1297 then go to fail; 1298 else source_comp_num = comp_num; 1299 1300 go to success; 1301 1302 computer_name: 1303 proc; 1304 1305 comp_num = cobol_imp_word$computer_name (p2); 1306 1307 if comp_num ^= 0 1308 then return; 1309 1310 comp_num = cobol_imp_word$file_org (p2); 1311 1312 if comp_num = 4 1313 then comp_num = 9; 1314 else comp_num = 0; 1315 1316 end; 1317 1318 /* is temp1 equal to 1, meaning the current clause is a SaME RECORD AREA clause? */ 1319 1320 check (47): 1321 ; 1322 temp1eq1: 1323 if temp1 = 1 1324 then go to success; 1325 1326 go to fail; 1327 1328 /* is the current item a user word? */ 1329 1330 check (48): 1331 ; 1332 usrwd: 1333 if record.type = 8 1334 then go to success; 1335 1336 go to fail; 1337 1338 switch: 1339 check (49): /* test for unique switch name before on-off */ 1340 if left.type ^= 2 1341 then go to fail; 1342 1343 if substr (switch_bits, left.num, 1) 1344 then go to fail; 1345 1346 substr (switch_bits, left.num, 1) = "1"b; 1347 call set_sw; 1348 1349 go to success; 1350 1351 set_sw: 1352 proc; 1353 1354 addr (mnemonic_name.class) -> bit8 = "0"b; 1355 1356 mnemonic_name.class.switch_condition = "1"b; 1357 mnemonic_name.iw_key = left.number; 1358 1359 if reserved_word.key = 134 1360 then mnemonic_name.on_status = "1"b; /* is_word("ON") */ 1361 else mnemonic_name.off_status = "1"b; /* is_word("OFF") */ 1362 1363 end; 1364 1365 switch_1: 1366 check (50): /* test for unique switch name before mnemonic name */ 1367 if left.type ^= 2 | right.type = 5 1368 then go to fail; 1369 1370 if substr (switch_bits, left.num, 1) 1371 then go to fail; 1372 1373 substr (switch_bits, left.num, 1) = "1"b; 1374 1375 call set_sw; 1376 1377 go to success; 1378 1379 /* is the current word an alphanumeric literal? */ 1380 1381 check (51): 1382 ; 1383 alphanmlit: 1384 if record.type = 3 1385 then go to success; 1386 1387 go to fail; 1388 1389 1390 /* can recovery be made on the current word? */ 1391 1392 check (52): 1393 ; 1394 recovword: 1395 if record.header.type ^= 1 1396 then go to fail; 1397 if reserved_word.ided_recovery = "1"b 1398 then go to success; 1399 1400 go to fail; 1401 1402 check (53): 1403 ; 1404 orgqualok: /* success if organization and organization qualifier are compatible */ 1405 if file_table.organization = 2 & property (19) = "1"b 1406 then if file_table.org_qual = 6 1407 then go to success; 1408 else go to fail; 1409 if file_table.organization = 2 & property (19) = "0"b & file_table.org_qual = 6 1410 then go to fail; 1411 if file_table.organization = 3 & file_table.org_qual = 7 1412 then go to fail; 1413 if file_table.organization = 1 & file_table.org_qual = 5 1414 then go to fail; 1415 if file_table.org_qual < 100 1416 then go to success; 1417 if file_table.organization < 2 1418 then go to success; 1419 1420 go to fail; 1421 1422 check (54): 1423 ; 1424 catusrwd: /* Scan to bypass illegal character err diag */ 1425 dpass_sw = "1"b; 1426 if record.header.type ^= 8 1427 then go to fail; 1428 if user_word.length > 200 1429 then go to fail; /* catalogue name too large */ 1430 1431 go to success; 1432 1433 check (55): 1434 ; 1435 charst1: /* set character string for ATTACH-OPTIONS */ 1436 dpass_sw = "1"b; 1437 if record.header.type ^= 3 1438 then go to fail; 1439 if alphanum_lit.lit_size > 128 1440 then go to fail; 1441 1442 go to success; 1443 1444 check (56): 1445 ; 1446 catalphalit: 1447 dpass_sw = "1"b; 1448 if alphanum_lit.type ^= 3 1449 then go to fail; 1450 if alphanum_lit.lit_size > 200 1451 then go to fail; 1452 file_table.cat_nm = alphanum_lit.string; 1453 1454 go to success; 1455 1456 dupdef: 1457 check (57): /* check for duplicate clause */ 1458 if ^substr (clause_bits, clause_num, 1) 1459 then go to success; 1460 1461 go to fail; 1462 1463 denint: 1464 check (58): 1465 call integer; 1466 1467 /*[4.4-1]*/ 1468 if num_binary = 800 | num_binary = 1600 | num_binary = 6250 1469 then go to success; 1470 1471 go to fail; 1472 1473 check (59): 1474 ckintnm: 1475 if fixed_common.file_count = 0 1476 then go to success; 1477 1478 com_io_key = filedescr_offsets (1); 1479 1480 call cobol_vdwf_dget (cobol_com_fileno, com_status, file_ptr, common_recsize, com_io_key); 1481 1482 do while ("1"b); 1483 1484 if user_word.word = substr (file_table.ifn, 1, file_table.ifn_size) 1485 then go to fail; 1486 1487 if file_ptr -> file_table.next = "00000" 1488 then go to success; 1489 1490 call cobol_vdwf_dget (cobol_com_fileno, com_status, file_ptr, common_recsize, com_io_key); 1491 com_io_key = file_ptr -> file_table.next; 1492 end; 1493 1494 1495 1496 /* ACTION ROUTINES */ 1497 /* perform necessary initialization functions */ 1498 1499 action (1): 1500 ; 1501 begrun: 1502 fixed_common.phase_name = "IDED20"; 1503 fixed_common.dd_seg_size = 1048576; 1504 fixed_common.pd_seg_size = 1048576; 1505 fixed_common.object_sign = fixed_common.currency; 1506 name_ptr = addr (ft_build_area (1)); /* initialize mnemonic-name pointer */ 1507 1508 last_clause = 0; 1509 clause_order = 0; 1510 clause_bits = "0"b; 1511 1512 go to ret; 1513 1514 action (2): /* initialize for source computer paragraph */ 1515 clause_bits = "0"b; 1516 last_clause = 0; 1517 clause_order = 0; 1518 1519 go to ret; 1520 1521 1522 action (3): /* determine number of source computer clause */ 1523 key = reserved_word.key; 1524 1525 if key = 568 1526 then clause_num = 1; /* is_word("memory") */ 1527 else if key = 88 1528 then clause_num = 2; /* is_word("debugging") */ 1529 else if key = 604 1530 then clause_num = 3; /* is_word("supervisor") */ 1531 else clause_num = 0; 1532 1533 go to ret; 1534 1535 action (4): /* source computer clauses */ 1536 if clause_num ^= 0 1537 then go to SC (clause_num); 1538 else go to ret; 1539 1540 SC (1): /* memory size clause */ 1541 go to dup_order; 1542 1543 SC (2): /* debugging mode clause */ 1544 /*[4.0-2]*/ 1545 fixed_common.debug = "1"b; 1546 go to dup_order; 1547 1548 SC (3): /* supervisor clause */ 1549 go to dup_order; 1550 1551 action (5): /* initialize for object computer paragraph */ 1552 clause_bits = "0"b; 1553 last_clause = 0; 1554 clause_order = 0; 1555 1556 obj_comp_name = 1; 1557 seg_lim = 0; 1558 alf_type = 0; 1559 1560 1561 1562 1563 go to ret; 1564 1565 action (6): /* determine number of object computer clause */ 1566 key = reserved_word.key; 1567 1568 if key = 604 1569 then clause_num = 1; /* is_word("SUPERVISOR") */ 1570 else if key = 568 1571 then clause_num = 2; /* is_word("MEMORY") */ 1572 else if key = 587 /* is_word("SEQUENCE") */ 1573 then do; 1574 clause_num = 3; 1575 call set_pcs_loc; 1576 end; 1577 else if key = 595 1578 then clause_num = 4; /* is_word("SEGMENT-LIMIT") */ 1579 else if key = 509 1580 then clause_num = 5; /* is_word("ASSIGN") */ 1581 else if key = 196 1582 then clause_num = 6; /* is_word("DATA") */ 1583 else if key = 142 1584 then clause_num = 7; /* is_word("PROCEDURE") */ 1585 else clause_num = 0; 1586 1587 go to ret; 1588 1589 set_pcs_loc: 1590 proc; 1591 1592 pcs.line = reserved_word.line; 1593 pcs.column = reserved_word.column; 1594 1595 end; 1596 1597 action (7): /* execute object computer clause */ 1598 if clause_num ^= 0 1599 then go to OC (clause_num); 1600 else go to ret; 1601 1602 OC (1): /* supervisor_clause */ 1603 fixed_common.supervisor = "1"b; 1604 1605 go to dup_order; 1606 1607 OC (2): /* memory clause */ 1608 go to dup_order; 1609 1610 OC (3): /* program collating sequence clause */ 1611 pcs.type = alf_type; 1612 pcs.name = alf_name; 1613 pcs.num = alf_num; 1614 1615 go to dup_order; 1616 1617 OC (4): /* segment-limit clause */ 1618 fixed_common.seg_limit = num_binary; 1619 1620 go to dup_order; 1621 1622 OC (5): /* assign clause */ 1623 go to dup_order; 1624 1625 OC (6): /* maximum data clause */ 1626 fixed_common.dd_seg_size = num_binary; 1627 1628 go to dup_order; 1629 1630 OC (7): /* maximum procedure clause */ 1631 fixed_common.pd_seg_size = num_binary; 1632 1633 go to dup_order; 1634 1635 action (8): /* program collating sequence clause found */ 1636 clause_num = 3; 1637 1638 go to ret; 1639 1640 /* store the name from PROGRAM-ID in common */ 1641 1642 action (9): 1643 ; 1644 1645 if record.type = 2 1646 then fixed_common.prog_name = numeric_lit.literal; 1647 else fixed_common.prog_name = user_word.word; 1648 1649 go to ret; /* set on remarks bit to suppress any diags issued by lexical scan on comment-entries in ID */ 1650 1651 action (10): 1652 ; 1653 1654 remarksbit = "1"b; 1655 1656 go to ret; /* set off the remarks bit */ 1657 1658 action (11): 1659 ; 1660 1661 remarksbit = "0"b; 1662 1663 go to ret; /* set on DEBUGGING MODE indicators */ 1664 1665 action (12): 1666 ; 1667 1668 temp1 = 4; 1669 debugbit = "1"b; 1670 fixed_common.debug = "1"b; 1671 1672 go to ret; /* store the segment limit integer in common */ 1673 1674 action (13): /* initialize for special names paragraph */ 1675 clause_bits = "0"b; 1676 last_clause = 0; 1677 clause_order = 0; 1678 1679 currsign = " "; 1680 objsign = " "; 1681 1682 switch_bits = "0"b; 1683 dev_bits = "0"b; 1684 alph_bits = "0"b; 1685 1686 go to ret; 1687 1688 action (14): /* determine clause number for special-names paragraph */ 1689 key = reserved_word.key; 1690 1691 if key = 504 1692 then clause_num = 3; /* is_word("ALPHABET") */ 1693 else if key = 525 1694 then clause_num = 4; /* is_word("CURRENCY") */ 1695 else if key = 538 /* is_word("DECIMAL-POINT") */ 1696 then do; 1697 clause_num = 5; 1698 dec_com = "0"b; 1699 obj_com = "0"b; 1700 end; 1701 else clause_num = 0; 1702 1703 go to ret; 1704 1705 action (15): 1706 clause_num = 0; 1707 last_clause = 0; 1708 clause_order = 0; 1709 1710 go to ret; 1711 1712 action (16): 1713 dec_com = "1"b; 1714 obj_com = "1"b; 1715 1716 go to ret; 1717 1718 action (17): 1719 obj_com = "1"b; 1720 1721 go to ret; 1722 1723 action (18): 1724 ; 1725 1726 fixed_common.seg_limit = num_binary; 1727 1728 go to ret; 1729 1730 action (19): 1731 currsign = alphanum_lit.string; 1732 1733 go to ret; 1734 1735 action (20): 1736 objsign = currsign; 1737 1738 go to ret; 1739 1740 action (21): /* alphabet_name is alpha_def: initialization */ 1741 call reset_alpha; 1742 clause_num = 3; 1743 call char_spec (addr (left_char_spec)); 1744 if left_char_spec.type = 1 1745 then alphabet_name.loval_char = addr (left_char_spec.value) -> ch.ch4; 1746 else alphabet_name.loval_char = left_char_spec.char; 1747 1748 if fixed_common.comp_level < "3" 1749 then call lev_diag (6, record.header.line, record.header.column); 1750 go to ret; 1751 1752 reset_alpha: 1753 proc; 1754 1755 declare i fixed bin; 1756 1757 do i = 1 by 1 to 500; 1758 ft_build_area (i) = 0; 1759 end; 1760 1761 alphabet_name.def_line = user_word.line; 1762 alphabet_name.type = 40; 1763 1764 do i = 0 by 1 to 511; 1765 tran_tab (i) = 0; 1766 end; 1767 1768 addr (nat_bits) -> bit512 = "0"b; 1769 ord_num = 0; 1770 call alf_ent; 1771 dup_alpha_value = "1"b; 1772 one_one_bit = "0"b; 1773 alf_range = 1; 1774 dup_alf_value = "0"b; 1775 high_value_value = 0; 1776 1777 end; 1778 1779 alf_ent: 1780 proc; 1781 1782 ord_num = 0; 1783 curr_ord_num = 0; 1784 ord_max = 0; 1785 1786 end; 1787 1788 action (22): /* type 17 name table entry: switch name */ 1789 addr (mnemonic_name.class) -> bit8 = "0"b; 1790 mnemonic_name.class.switch_name = "1"b; 1791 1792 call nm (addr (right), left.number); 1793 1794 go to ret; 1795 1796 nm: 1797 proc (p, num); 1798 1799 declare (L, num) fixed bin, 1800 p ptr; 1801 1802 declare 1 N based (p), 1803 2 type fixed bin, 1804 2 line fixed bin, 1805 2 column fixed bin, 1806 2 number fixed bin, 1807 2 num fixed bin, 1808 2 name char (32) varying; 1809 1810 L = length (N.name); 1811 1812 mnemonic_name.iw_key = num; 1813 mnemonic_name.size = L + type17_size; 1814 mnemonic_name.def_line = N.line; 1815 mnemonic_name.column = N.column; 1816 mnemonic_name.name_size = L; 1817 mnemonic_name.name = substr (N.name, 1, L); 1818 1819 call buildnm; 1820 1821 end; 1822 1823 action (23): /* type 17 name table entry, switch condition name */ 1824 mnemonic_name.size = user_word.length + type17_size; 1825 mnemonic_name.column = user_word.column; 1826 mnemonic_name.def_line = user_word.line; 1827 mnemonic_name.name_size = user_word.length; 1828 mnemonic_name.name = substr (user_word.word, 1, mnemonic_name.name_size); 1829 mnemonic_name.iw_key = left.number; 1830 1831 call buildnm; 1832 1833 go to ret; 1834 1835 buildnm: 1836 proc; 1837 1838 mnemonic_name.type = 17; 1839 mnemonic_name.line = 0; 1840 mnemonic_name.string_ptr = null (); 1841 mnemonic_name.prev_rec = null (); 1842 mnemonic_name.alphabet_offset = 0; 1843 1844 call cobol_vdwf_sput (cobol_name_fileno, name_status, name_ptr, mnemonic_name.size, name_key); 1845 1846 end; 1847 1848 1849 action (24): 1850 ; 1851 buildft: 1852 do i = 1 by 1 to 500; 1853 ft_build_area (i) = 0; 1854 end; 1855 1856 ft_ptr = addr (ft_build_area (1)); 1857 temp4 = user_word.length + file_table_size; 1858 1859 file_table.name_size = user_word.length; 1860 file_table.name = user_word.word; 1861 file_table.next = "00000"; 1862 file_table.tape_device_key = "00000"; 1863 file_table.add_cat_key = "00000"; 1864 file_table.ifn = " "; 1865 file_table.file_id_info = "00000"; 1866 file_table.retention_info = "00000"; 1867 file_table.padding_char = " "; 1868 file_table.banner_char = "!"; /* ! = octal 41 */ 1869 file_table.file_status_info = "00000"; 1870 file_table.extra_status_info = "00000"; 1871 file_table.cat_id_info = "00000"; 1872 file_table.r_key_info = "00000"; 1873 file_table.alt_key_info = "00000"; 1874 file_table.rec_do_info = "00000"; 1875 file_table.label_info = "00000"; 1876 file_table.data_info = "00000"; 1877 file_table.attach_options_info = "00000"; 1878 file_table.replacement_info = "00000"; 1879 file_table.report_info = "00000"; 1880 file_table.linage_info = "00000"; 1881 file_table.optional = optional_file; 1882 file_table.external = external_file; 1883 file_table.record_format = 0; 1884 file_table.label_format = 0; 1885 file_table.cat_nm = " "; 1886 1887 file_table.ao_string = "00000"; 1888 file_table.file_desc_1_offset = 0; /* [3.0-2] */ 1889 file_table.alternate_keys = 0; /* [3.0-4] */ 1890 file_table.dupl_alt = "0"b; /* [3.0-5] */ 1891 file_table.organization = 1; /* seq default */ 1892 /* [3.0-6] */ 1893 file_table.om_string = " "; 1894 1895 file_table.file_no = fixed_common.file_count + 1; 1896 file_table.code_set = 1; /* set to default code set of EBCDIC */ 1897 ft_size = temp4; /* save file table size for replace_io */ 1898 1899 ignore_file = "0"b; 1900 1901 go to ret; 1902 1903 emit_ft: 1904 proc; 1905 1906 /*[4.0-5]*/ 1907 dcl (i, num) fixed bin; 1908 1909 fixed_common.file_count = fixed_common.file_count + 1; 1910 1911 call cobol_vdwf_sput (cobol_com_fileno, com_status, ft_ptr, ft_size, common_key); 1912 1913 /* put default file table */ 1914 1915 if fixed_common.file_count < 21 1916 then fixed_common.filedescr_offsets (fixed_common.file_count) = common_key; 1917 1918 /* save file table address */ 1919 1920 if fixed_common.file_count > 1 1921 then do; 1922 1923 /*establish link from last file table to this file */ 1924 1925 call cobol_vdwf_dget (cobol_com_fileno, com_status, last_ft_ptr, common_recsize, last_prev_file_key); 1926 1927 last_ft_ptr -> file_table.next = common_key; 1928 /* now linked */ 1929 1930 call cobol_vdwf_dput (cobol_com_fileno, com_status, last_ft_ptr, common_recsize, last_prev_file_key); 1931 1932 end; 1933 1934 last_prev_file_key = common_key; /* save current file table address for linking */ 1935 1936 /*[4.0-5]*/ 1937 do i = 1 by 1 to 10; 1938 1939 /*[4.0-5]*/ 1940 if source_pos.line (i) ^= 0 1941 then do; 1942 1943 /*[4.0-5]*/ 1944 lev_diag_item.line = source_pos.line (i); 1945 /*[4.0-5]*/ 1946 lev_diag_item.column = source_pos.column (i); 1947 /*[4.0-5]*/ 1948 org = file_table.organization; 1949 1950 /*[4.2-1]*/ 1951 if sort_name = "1"b 1952 then org = 6; 1953 1954 /*[4.0-5]*/ 1955 go to FT (i); 1956 1957 FT (1): 1958 num = 113; 1959 call LEV1; 1960 go to FT1; /* organization clause */ 1961 FT (2): 1962 num = 117; 1963 mod_num = 16; 1964 LEV = "3"; 1965 go to FT1; /* optional phrase */ 1966 FT (3): 1967 num = 118; 1968 call LEV2; 1969 go to FT1; /* reserve clause */ 1970 FT (4): 1971 num = 188; 1972 call LEV1; 1973 go to FT1; /* record key clause */ 1974 FT (5): 1975 num = 126; 1976 call LEV2; 1977 go to FT1; /* alt rec key clause */ 1978 FT (6): 1979 num = 183; 1980 call LEV1; 1981 go to FT1; /* select clause */ 1982 FT (7): 1983 num = 184; 1984 call LEV1; 1985 go to FT1; /* assign clause */ 1986 FT (8): 1987 num = 185; 1988 1989 /*[4.2-2]*/ 1990 call LEV1; 1991 1992 /*[4.2-2]*/ 1993 if dynamic_acc 1994 then do; 1995 LEV_NUM = lev2_org (org);/* access clause */ 1996 /*[4.2-2]*/ 1997 MOD_NUM = lev2_mod (org);/*[4.2-2]*/ 1998 end; 1999 2000 /*[4.0-5]*/ 2001 go to FT1; 2002 2003 FT (9): 2004 num = 186; 2005 call LEV1; 2006 go to FT1; /* file status clause */ 2007 FT (10): 2008 num = 187; 2009 call LEV1; 2010 go to FT1; /* relative key clause */ 2011 2012 FT1: /*[4.0-5]*/ 2013 if LEV > fixed_common.comp_level 2014 then do; 2015 2016 lev_diag_item.module = mod_num; 2017 lev_diag_item.number = num; 2018 2019 call cobol_c_list (diag2_ptr); 2020 2021 /*[4.0-5]*/ 2022 end; 2023 2024 mod_num = 0; /*[4.0-5]*/ 2025 end; 2026 2027 /*[4.0-5]*/ 2028 end; 2029 2030 /*[4.2-2]*/ 2031 if dynamic_acc /*[4.2-2]*/ 2032 then if LEV_NUM > fixed_common.comp_level /*[4.2-2]*/ 2033 then do; 2034 lev_diag_item.module = MOD_NUM; /*[4.2-2]*/ 2035 lev_diag_item.number = 216; /*[4.2-2]*/ 2036 lev_diag_item.line = dyn.line; /*[4.2-2]*/ 2037 lev_diag_item.column = dyn.column; 2038 2039 /*[4.2-2]*/ 2040 call cobol_c_list (diag2_ptr); 2041 2042 /*[4.2-2]*/ 2043 end; 2044 2045 end; 2046 2047 LEV1: 2048 proc; 2049 2050 /*[4.0-5]*/ 2051 mod_num = lev1_mod (org); 2052 LEV = lev1_org (org); 2053 2054 end; /*[4.0-5]*/ 2055 /*[4.0-5]*/ 2056 LEV2: 2057 proc; 2058 2059 /*[4.0-5]*/ 2060 mod_num = lev2_mod (org); 2061 LEV = lev2_org (org); 2062 2063 end; /*[4.0-5]*/ 2064 /*[4.0-5]*/ 2065 2066 action (25): /* file_contol paragraph: execute clause */ 2067 if clause_num ^= 0 2068 then go to FCC (clause_num); 2069 2070 go to ret; 2071 2072 FCC (1): /* assign clause */ 2073 file_table.ifn_size = user_word.length; 2074 file_table.ifn = substr (user_word.word, 1, file_table.ifn_size); 2075 2076 go to ret; 2077 2078 FCC (2): /* organization clause */ 2079 if file_org = 0 2080 then go to ret; 2081 2082 file_table.org_qual = 4; /* set default to multics */ 2083 file_table.code_set = 1; 2084 2085 go to FO (file_org); 2086 2087 FO (1): /* sequential */ 2088 property (3) = "1"b; 2089 file_table.organization = 1; 2090 2091 if file_qual = 12 /* ibm-dos */ 2092 then do; 2093 file_table.org_qual = 5; 2094 file_table.code_set = 4; 2095 end; 2096 else if file_qual = 10 /* h-2000 */ 2097 then do; 2098 file_table.org_qual = 6; 2099 file_table.code_set = 2; 2100 end; 2101 else if file_qual = 13 /* ibm-os */ 2102 then do; 2103 file_table.org_qual = 7; 2104 end; 2105 2106 go to FO1; 2107 2108 FO (2): /* indexed */ 2109 property (5) = "1"b; 2110 file_table.organization = 3; 2111 2112 if file_qual = 8 /* level-64 */ 2113 then do; 2114 file_table.org_qual = 3; 2115 file_table.code_set = 1; 2116 end; 2117 else if file_qual = 12 /* ibm-dos */ 2118 then do; 2119 file_table.org_qual = 5; 2120 file_table.code_set = 1; 2121 end; 2122 2123 go to FO1; 2124 2125 FO (3): /* relative */ 2126 property (4) = "1"b; 2127 file_table.organization = 2; 2128 2129 if org_qual = 10 /* h-2000 */ 2130 then do; 2131 file_table.org_qual = 6; 2132 file_table.code_set = 2; 2133 end; 2134 else if org_qual = 12 2135 then do; 2136 file_table.org_qual = 5; 2137 file_table.code_set = 1; 2138 end; 2139 2140 go to FO1; 2141 2142 FO (4): /* stream */ 2143 file_table.organization = 5; 2144 2145 go to FO1; 2146 2147 FO (5): /* ids-ii */ 2148 file_table.organization = 5; 2149 2150 go to FO1; 2151 2152 FO (6): /* keyed */ 2153 property (19) = "1"b; 2154 file_table.organization = 2; 2155 2156 go to FO1; 2157 2158 FO1: 2159 if file_qual = 15 2160 then do; 2161 file_table.org_qual = 1; 2162 file_table.code_set = 1; 2163 end; 2164 2165 go to ret; 2166 2167 FCC (3): /* reserve clause */ 2168 file_table.buffers = num_binary; 2169 2170 go to ret; 2171 2172 FCC (4): /* access clause */ 2173 if file_acc ^= 0 2174 then go to FA (file_acc); 2175 2176 go to ret; 2177 2178 FA (1): /* sequential */ 2179 file_table.access = 1; 2180 2181 go to ret; 2182 2183 FA (2): /* random */ 2184 property (6) = "1"b; 2185 file_table.access = 2; 2186 2187 go to ret; 2188 2189 FA (3): /* dynamic */ 2190 property (6) = "1"b; 2191 file_table.access = 3; 2192 2193 go to ret; 2194 2195 FCC (5): /* record key clause */ 2196 rec_key = "1"b; 2197 2198 go to ret; 2199 2200 FCC (6): /* file status clause */ 2201 go to ret; 2202 2203 FCC (7): /* alternate key clause */ 2204 go to ret; 2205 2206 FCC (8): /* catalog name clause */ 2207 go to ret; 2208 2209 FCC (9): /* ssf, flr, vlr, bsn */ 2210 if ssf_ind 2211 then do; 2212 property (12) = "1"b; 2213 file_table.record_prefix = 2; 2214 2215 end; 2216 2217 if flr_ind 2218 then file_table.fixed_recs = "1"b; 2219 else if vlr_ind 2220 then file_table.variable_recs = "1"b; 2221 else if span_ind 2222 then file_table.spanned_recs = "1"b; 2223 2224 if bsn_ind 2225 then file_table.bsn = "1"b; 2226 2227 go to ret; 2228 2229 FCC (10): /* process area */ 2230 file_table.process_area = "1"b; 2231 2232 go to ret; 2233 2234 FCC (11): /* interchange */ 2235 file_table.interchange = "1"b; 2236 2237 go to ret; 2238 2239 FCC (12): /* relative key clause */ 2240 rel_key = "1"b; 2241 2242 go to ret; 2243 2244 FCC (13): /* no process area */ 2245 file_table.process_area = "0"b; 2246 2247 go to ret; 2248 2249 action (26): 2250 ; 2251 2252 ed_found = "1"b; 2253 2254 go to ret; 2255 2256 2257 action (27): /* i-o-control: initialize */ 2258 mult_fil_no = 0; 2259 clause_bits = "0"b; 2260 last_clause = 0; 2261 clause_order = 0; 2262 2263 go to ret; 2264 2265 action (28): /* i-o-control: set clause number */ 2266 key = reserved_word.key; 2267 2268 if key = 508 2269 then clause_num = 1; /* is_word("apply") */ 2270 else if key = 588 2271 then clause_num = 2; /* is_word("rerun") */ 2272 else if key = 593 /* id_word("same") */ 2273 /*[5.0-1]*/ 2274 then do; 2275 clause_num = 3; /*[5.0-1]*/ 2276 same_loc.line = record.header.line; /*[5.0-1]*/ 2277 same_loc.column = record.header.column; /*[5.0-1]*/ 2278 end; 2279 else if key = 570 2280 then clause_num = 4; /* is_word("multiple") */ 2281 else clause_num = 0; 2282 2283 temp1 = 0; 2284 2285 go to ret; 2286 2287 action (29): /* file_control_control: access clause */ 2288 rel_key = "0"b; 2289 rec_key = "0"b; 2290 2291 key = reserved_word.key; 2292 2293 if key = 597 2294 then file_acc = 1; /* is_word("sequential") */ 2295 else if key = 147 2296 then file_acc = 2; /* is_word("random") */ 2297 else if key = 169 /* is_word("dynamic") */ 2298 /*[4.2-2]*/ 2299 then do; 2300 file_acc = 3; /*[4.2-2]*/ 2301 dynamic_acc = "1"b; /*[4.2-2]*/ 2302 dyn.line = reserved_word.line; /*[4.2-2]*/ 2303 dyn.column = reserved_word.column; /*[4.2-2]*/ 2304 end; 2305 2306 else file_acc = 0; 2307 2308 go to ret; 2309 2310 action (30): /*[4.0-5]*/ 2311 key = reserved_word.key; 2312 2313 /*[4.0-5]*/ 2314 if key = 167 /*relative*/ 2315 /*[4.0-5]*/ 2316 then do; 2317 rel_key = "1"b; /*[4.0-5]*/ 2318 source_pos.line (10) = record.header.line; 2319 /*[4.0-5]*/ 2320 source_pos.column (10) = record.header.column; 2321 /*[4.0-5]*/ 2322 end; /*[4.0-5]*/ 2323 else /*[4.0-5]*/ 2324 if key = 148 /*record*/ 2325 /*[4.0-5]*/ 2326 then do; 2327 rec_key = "1"b; /*[4.0-5]*/ 2328 source_pos.line (4) = record.header.line; 2329 /*[4.0-5]*/ 2330 source_pos.column (4) = record.header.column; 2331 /*[4.0-5]*/ 2332 end; 2333 2334 go to ret; 2335 2336 action (31): /* file control paragraph: select clause */ 2337 key = reserved_word.key; 2338 2339 if key = 307 2340 then external_file = "1"b; /* is_word("external") */ 2341 else do; /* is_word("optional") */ 2342 optional_file = "1"b; 2343 source_pos.line (2) = record.header.line; 2344 source_pos.column (2) = record.header.column; 2345 end; 2346 2347 go to ret; 2348 2349 action (32): /* indicate alternate record key */ 2350 call enter_key (5); 2351 2352 go to ret; 2353 2354 action (33): /* file organization is indexed */ 2355 file_org = 2; 2356 2357 go to ret; 2358 2359 action (34): /* vlr, flr, bsn, spanned */ 2360 key = reserved_word.key; 2361 2362 if key = 85 2363 then ssf_ind = "1"b; /* is_word("ssf") */ 2364 else if key = 272 2365 then flr_ind = "1"b; /* is_word("flr") */ 2366 else if key = 201 2367 then vlr_ind = "1"b; /* is_word("vlr") */ 2368 else if key = 413 2369 then bsn_ind = "1"b; /* is_word("bsn") */ 2370 else if key = 601 2371 then span_ind = "1"b; /* is_word("spanned") */ 2372 2373 go to ret; 2374 2375 /* construct an entry in common for the current relative key name */ 2376 2377 action (35): 2378 ; 2379 2380 property (17) = "1"b; /* indicate relative key */ 2381 file_table.relative_key = "1"b; 2382 file_table.address_format = 3; 2383 2384 call enter_key (1); 2385 2386 go to ret; 2387 2388 enter_key: 2389 proc (temp6); 2390 2391 declare (temp6, temp4) fixed bin; 2392 2393 temp4 = user_word.length + file_key_size; 2394 fkey_ptr = addr (file_key_area); 2395 file_key.next = "00000"; 2396 2397 /*[3.0-7]*/ 2398 if temp6 = 5 /*[3.0-7]*/ 2399 then file_key.next_alt = file_table.alt_key_info; /*[3.0-7]*/ 2400 else file_key.next_alt = "00000"; 2401 2402 file_key.qual = "00000"; /*[3.0-7]*/ 2403 addr (file_key.info) -> bit8 = "00000000"b; 2404 file_key.file_no = file_table.file_no; 2405 file_key.key_type = temp6; 2406 file_key.line = user_word.line; 2407 file_key.column = user_word.column; 2408 file_key.temp_seg = 0; 2409 file_key.temp_offset = 0; 2410 file_key.desc = " "; 2411 2412 if user_word.type = 8 2413 then do; 2414 file_key.name_size = user_word.length; 2415 file_key.name = user_word.word; 2416 end; 2417 else do; 2418 file_key.name_size = alphanum_lit.lit_size; 2419 file_key.name = alphanum_lit.string; 2420 end; 2421 file_key_type = file_key.key_type; /*for check */ 2422 common_recsize = temp4; /* temp4 contains size of file_key. */ 2423 2424 call cobol_vdwf_sput (cobol_com_fileno, com_status, fkey_ptr, common_recsize, common_key); 2425 2426 if fixed_common.file_keys = "00000" 2427 then fixed_common.file_keys = common_key; 2428 else do; 2429 2430 call cobol_vdwf_dget (cobol_com_fileno, com_status, work_ptr, common_recsize, 2431 fixed_common.last_file_key); /*link key rec */ 2432 2433 work_ptr -> file_key.next = common_key; /* now linked */ 2434 2435 call cobol_vdwf_dput (cobol_com_fileno, com_status, work_ptr, common_recsize, 2436 fixed_common.last_file_key); 2437 2438 end; 2439 2440 fixed_common.last_file_key = common_key; /* save current file key address */ 2441 2442 if temp6 > 100 2443 then temp6 = temp6 - 100; 2444 2445 if temp6 < 14 2446 then do; 2447 go to T (temp6); 2448 2449 T (1): 2450 file_table.r_key_info = common_key; 2451 go to T1; 2452 T (2): 2453 file_table.r_key_info = common_key; 2454 go to T1; 2455 T (3): 2456 file_table.file_status_info = common_key; 2457 go to T1; 2458 T (4): 2459 file_table.extra_status_info = common_key; 2460 go to T1; 2461 T (5): 2462 file_table.alternate_keys = file_table.alternate_keys + 1; 2463 /* [3.0-4] */ 2464 /*[3.0-7]*/ 2465 file_table.alt_key_info = common_key; 2466 go to T1; /* [3.0-2] */ 2467 2468 T (6): 2469 go to T1; 2470 T (7): 2471 file_table.cat_id_info = common_key; 2472 go to T1; 2473 T (8): 2474 file_table.attach_options_info = common_key; 2475 go to T1; 2476 T (9): 2477 file_table.replacement_info = common_key; 2478 go to T1; 2479 T (10): 2480 go to T1; 2481 T (11): 2482 go to T1; 2483 T (12): 2484 file_table.add_cat_key = common_key; 2485 go to T1; 2486 T (13): 2487 file_table.file_id_info = common_key; 2488 go to T1; 2489 T (14): 2490 file_table.retention_info = common_key; 2491 go to T1; 2492 2493 T1: 2494 end; 2495 2496 qual_sw = "0"b; /* this item is a subject of file key */ 2497 2498 end; 2499 2500 2501 2502 2503 2504 2505 2506 2507 action (36): /* apply attach options */ 2508 if alphanum_lit.type = 3 /* alphanumeric literal */ 2509 then do; 2510 apply_num = 5; 2511 2512 file_table.ao_len = alphanum_lit.lit_size; 2513 file_table.ao_string = alphanum_lit.string; 2514 2515 call enter_key (108); 2516 end; 2517 else if user_word.type = 8 /* data-name */ 2518 then do; 2519 apply_num = 6; 2520 call enter_key (8); 2521 end; 2522 else apply_num = 0; 2523 2524 go to ret; 2525 2526 action (37): /* apply tape-option: execute clause */ 2527 key = cobol_imp_word$io_technique (p2); 2528 2529 if key = 0 2530 then go to ret; 2531 2532 if substr (options_bits, key, 1) 2533 then sk_ind = "1"b; 2534 else do; 2535 sk_ind = "0"b; 2536 substr (options_bits, key, 1) = "1"b; 2537 end; 2538 2539 go to ATO (key); 2540 2541 ATO (1): /* additional */ 2542 go to ret; 2543 2544 ATO (5): /* density */ 2545 go to ret; 2546 2547 ATO (7): /* device */ 2548 go to ret; 2549 2550 ATO (8): /* force */ 2551 file_table.force = "1"b; 2552 2553 go to ret; 2554 2555 ATO (10): /* output-mode */ 2556 go to ret; 2557 2558 ATO (12): /* protect */ 2559 file_table.protect = "1"b; 2560 2561 go to ret; 2562 2563 ATO (13): /* retain */ 2564 file_table.retain = "1"b; 2565 2566 go to ret; 2567 2568 action (38): /* apply file is */ 2569 key = cobol_imp_word$io_technique (p2); 2570 2571 if key = 15 2572 then apply_num = 1; /* is_word("temporary") */ 2573 else if key = 11 2574 then apply_num = 2; /* is_word("permanent") */ 2575 else apply_num = 0; 2576 2577 go to ret; 2578 2579 action (39): /* apply [no] detach */ 2580 key = reserved_word.key; 2581 2582 if key = 129 2583 then apply_num = 3; /* is_word("no") */ 2584 else if key = 405 2585 then apply_num = 4; /* is_word("detach") */ 2586 else apply_num = 0; 2587 2588 go to ret; 2589 2590 action (40): /* program collating sequence: save line and col */ 2591 call set_pcs_loc; 2592 2593 go to ret; 2594 2595 2596 action (41): /* apply tape-options: initialization */ 2597 options_bits = "0"b; 2598 apply_num = 7; 2599 2600 addr (file_table.tape) -> bit18 = "0"b; 2601 2602 file_table.ao_len = 0; 2603 file_table.ao_string = "00000"; 2604 2605 file_table.output_mode = 0; 2606 file_table.tape_device = 0; 2607 2608 file_table.add_cat_key = "00000"; 2609 2610 go to ret; 2611 2612 action (42): /* select clause: initialization */ 2613 /*[4.2-1]*/ 2614 sort_name = "0"b; 2615 2616 vector = "0"b; 2617 clause_bits = "0"b; 2618 external_file = "0"b; 2619 optional_file = "0"b; 2620 ignore_file = "1"b; 2621 cat_type = 0; 2622 2623 2624 do i = 1 by 1 to 10; 2625 2626 source_pos.line (i) = 0; 2627 2628 end; 2629 2630 /*[4.0-5]*/ 2631 source_pos.line (6) = record.header.line; /*[4.0-5]*/ 2632 source_pos.column (6) = record.header.column; /*[4.0-5]*/ 2633 dynamic_acc = "0"b; 2634 2635 go to ret; 2636 2637 action (43): /* apply: execute clause */ 2638 if file_ptr = null () 2639 then do; 2640 diag_num = 101; 2641 call diag; 2642 end; 2643 else if apply_num ^= 0 2644 then go to AP (apply_num); 2645 2646 go to ret; 2647 2648 AP (1): /* apply file is temporary */ 2649 if ^(file_ptr -> file_table.temp) & ^(file_ptr -> file_table.perm) 2650 /*[4.3-1]*/ 2651 then if file_ptr -> file_table.external /*[4.3-1]*/ 2652 then do; 2653 diag_num = 181; /*[4.3-1]*/ 2654 call diag; /*[4.3-1]*/ 2655 end; /*[4.3-1]*/ 2656 else file_ptr -> file_table.temp = "1"b; 2657 2658 go to ret; 2659 2660 AP (2): /* apply file is permanent */ 2661 if ^(file_ptr -> file_table.temp) & ^(file_ptr -> file_table.perm) 2662 then file_ptr -> file_table.perm = "1"b; 2663 2664 2665 go to ret; 2666 2667 AP (3): /* apply no detach */ 2668 if ^(file_ptr -> file_table.attach) & ^(file_ptr -> file_table.detach) 2669 then file_ptr -> file_table.detach = "1"b; /*[4.0-3]*/ 2670 2671 go to ret; 2672 2673 AP (4): /* apply detach */ 2674 if ^(file_ptr -> file_table.attach) & ^(file_ptr -> file_table.detach) 2675 then file_ptr -> file_table.detach = "0"b; /*[4.0-3]*/ 2676 2677 go to ret; 2678 2679 AP (5): /* attach options literal */ 2680 if file_ptr -> file_table.ao_len = 0 & file_ptr -> file_table.ao_string = "00000" 2681 then do; 2682 file_ptr -> file_table.ao_len = file_table.ao_len; 2683 file_ptr -> file_table.ao_string = substr (file_table.ao_string, 1, file_table.ao_len); 2684 end; 2685 2686 go to ret; 2687 2688 AP (6): /* attach-options data-name */ 2689 /*[4.0-9]*/ 2690 if file_ptr -> file_table.attach_options_info = "00000" 2691 /*[4.0-9]*/ 2692 then do; 2693 file_ptr -> file_table.attach_options_info = 2694 /*[4.0-9]*/ substr (file_table.attach_options_info, 1, 5); 2695 end; 2696 2697 go to ret; 2698 2699 AP (7): /* tape-options: enter file table */ 2700 if ^(file_ptr -> file_table.temp) 2701 then file_ptr -> file_table.temp = file_table.temp; 2702 if ^(file_ptr -> file_table.perm) 2703 then file_ptr -> file_table.perm = file_table.perm; 2704 if ^(file_ptr -> file_table.attach) 2705 then file_ptr -> file_table.attach = file_table.attach; 2706 if ^(file_ptr -> file_table.detach) 2707 then file_ptr -> file_table.detach = file_table.detach; 2708 if ^(file_ptr -> file_table.density) 2709 then file_ptr -> file_table.density = file_table.density; 2710 if ^(file_ptr -> file_table.retain) 2711 then file_ptr -> file_table.retain = file_table.retain; 2712 if ^(file_ptr -> file_table.force) 2713 then file_ptr -> file_table.force = file_table.force; 2714 if ^(file_ptr -> file_table.protect) 2715 then file_ptr -> file_table.protect = file_table.protect; 2716 /*[4.4-1]*/ 2717 if ^(file_ptr -> file_table.den_6250) /*[4.4-1]*/ 2718 then file_ptr -> file_table.den_6250 = file_table.den_6250; 2719 2720 if file_ptr -> file_table.output_mode = 0 & file_table.output_mode ^= 0 2721 then do; 2722 file_ptr -> file_table.output_mode = file_table.output_mode; 2723 file_ptr -> file_table.om_len = file_table.om_len; 2724 file_ptr -> file_table.om_string = file_table.om_string; 2725 end; 2726 2727 if file_ptr -> file_table.tape_device = 0 & file_table.tape_device ^= 0 2728 then do; 2729 file_ptr -> file_table.tape_device = file_table.tape_device; 2730 file_ptr -> file_table.tape_device_num = file_table.tape_device_num; 2731 file_ptr -> file_table.tape_device_key = file_table.tape_device_key; 2732 end; 2733 2734 if file_ptr -> file_table.add_cat_key = "00000" & file_table.add_cat_key ^= "00000" 2735 then file_ptr -> file_table.add_cat_key = file_table.add_cat_key; 2736 2737 go to ret; 2738 2739 action (44): /* alphabet definition: left operand */ 2740 call char_spec (addr (left_char_spec)); 2741 curr_ord_num = ord_num; 2742 ord_max = 0; 2743 right_char_spec.type = left_char_spec.type; 2744 right_char_spec.value = left_char_spec.value; 2745 if left_char_spec.type = 2 2746 then right_char_spec.char = left_char_spec.char; 2747 2748 go to ret; 2749 2750 action (45): /* apply tape-option: device */ 2751 if sk_ind 2752 then go to ret; 2753 2754 if numeric_lit.type = 2 /* literal */ 2755 then do; 2756 file_table.tape_device = 1; 2757 file_table.tape_device_num = num_binary; 2758 end; 2759 2760 else if user_word.type = 8 /* data-name */ 2761 then do; 2762 file_table.tape_device = 2; 2763 call enter_key (10); 2764 file_table.tape_device_key = common_key; 2765 end; 2766 2767 else file_table.tape_device = 0; 2768 2769 go to ret; 2770 2771 action (46): /* apply tape-option; output-mode */ 2772 if sk_ind 2773 then go to ret; 2774 2775 key = cobol_imp_word$io_technique (p2); 2776 2777 if key = 16 2778 then file_table.output_mode = 1; /* is_word("generation") */ 2779 else if key = 9 2780 then file_table.output_mode = 2; /* is_word("modification") */ 2781 else if key = 17 2782 then file_table.output_mode = 3; /* is_wod("replacement") */ 2783 else file_table.output_mode = 0; 2784 2785 go to ret; 2786 2787 action (47): /* apply tape-option: output-mode */ 2788 if sk_ind 2789 then go to ret; 2790 2791 if user_word.type = 8 /* data-name */ 2792 then do; 2793 file_table.output_mode = 4; 2794 call enter_key (9); 2795 end; 2796 2797 else if alphanum_lit.type = 3 /* alphanumeric literal */ 2798 then do; 2799 file_table.output_mode = 3; 2800 call enter_key (109); 2801 end; 2802 2803 else file_table.output_mode = 0; 2804 2805 go to ret; 2806 2807 action (48): /* apply tape-options: density */ 2808 if sk_ind 2809 then go to ret; 2810 2811 /*[4.4-1]*/ 2812 file_table.tape.density, file_table.tape.den_6250 = "0"b; 2813 2814 /*[4.4-1]*/ 2815 if num_binary = 1600 /*[4.4-1]*/ 2816 then file_table.tape.density = "1"b; /*[4.4-1]*/ 2817 else if num_binary = 6250 /*[4.4-1]*/ 2818 then file_table.tape.den_6250 = "1"b; 2819 2820 go to ret; 2821 2822 action (49): /* apply tape-options; catalogue-name */ 2823 if sk_ind 2824 then go to ret; 2825 2826 if alphanum_lit.type = 3 /* alphanumeric liteal */ 2827 then call enter_key (112); 2828 else if user_word.type = 8 /* data-name */ 2829 then do; 2830 call enter_key (12); 2831 end; 2832 2833 go to ret; 2834 2835 action (50): 2836 if clause_num < last_clause 2837 then clause_order = 1; 2838 2839 last_clause = clause_num; 2840 2841 go to ret; 2842 2843 action (51): /* same clause */ 2844 if same_type = 0 2845 then go to ret; 2846 else go to SMN (same_type); 2847 2848 SMN (1): /* same record area clause */ 2849 file_ptr -> file_table.same_rec_clause = samerecct; 2850 2851 go to SMN1; 2852 2853 SMN (2): /* same sort area clause */ 2854 file_ptr -> file_table.same_sort_clause = samesct; 2855 2856 go to SMN1; 2857 2858 SMN (3): /* same sort-merge area clause */ 2859 go to SMN1; 2860 2861 SMN (4): /* same area clause */ 2862 file_ptr -> file_table.same_area_clause = samect; 2863 2864 go to SMN1; 2865 2866 SMN1: 2867 file_ptr -> file_table.same_file = "1"b; 2868 2869 call cobol_vdwf_dget (cobol_com_fileno, com_status, file_ptr, common_recsize, com_io_key); 2870 2871 go to ret; 2872 2873 action (52): /* object is decimal-point */ 2874 obj_com = "0"b; 2875 2876 go to ret; 2877 2878 action (53): /* move table to alphabet entry */ 2879 call init_alpha; 2880 2881 alphabet_name.one_one = one_one_bit; 2882 alf_size = ord_num; 2883 2884 if one_one_bit | dup_alpha_value 2885 then alphabet_name.onto = "1"b; 2886 2887 alphabet_name.hi_value = addr (ord_num) -> ch.ch4; 2888 alphabet_name.hival_char = addr (high_value_value) -> ch.ch4; 2889 2890 orig_alf_size = alf_size; 2891 2892 do i = 0 by 1 to nat_alf_size; 2893 2894 if nat_bits (i) = "0"b 2895 then do; 2896 tran_tab (i) = alf_size; 2897 alf_size = alf_size + 1; 2898 end; 2899 2900 end; 2901 2902 if alf_size ^= orig_alf_size 2903 then alphabet_name.hi_value = addr (alf_size) -> ch.ch4; 2904 2905 if nat_alf_size < 511 2906 then do i = nat_alf_size + 1 by 1 to 511; 2907 2908 if nat_bits (i) = "0"b 2909 then do; 2910 tran_tab (i) = alf_size; 2911 alf_size = alf_size + 1; 2912 end; 2913 2914 end; 2915 2916 call set_table; 2917 2918 go to ret; 2919 2920 set_table: 2921 proc; /* define table in alphabet def */ 2922 2923 declare (table_ptr, tran_ptr) 2924 ptr; 2925 declare table (0:511) char (1) based (table_ptr); 2926 declare 1 tran (0:511) based (tran_ptr), 2927 2 ch1 char (1), 2928 2 ch2 char (1), 2929 2 ch3 char (1), 2930 2 ch4 char (1); 2931 2932 declare i fixed bin; 2933 2934 table_ptr = addr (alphabet_name.table); 2935 tran_ptr = addr (tran_tab (0)); 2936 2937 do i = 0 by 1 to 511; 2938 2939 table (i) = tran.ch4 (i); 2940 2941 end; 2942 2943 end; 2944 2945 action (54): 2946 fixed_common.descriptor = "01"b; 2947 2948 go to ret; 2949 2950 action (55): 2951 fixed_common.descriptor = "10"b; 2952 2953 go to ret; 2954 2955 action (56): 2956 ; 2957 intpos: /* assumes ft_ptr set to correct file */ 2958 if file_ptr ^= null () 2959 then do; 2960 file_ptr -> file_table.mult_position_no = num_binary; 2961 2962 call cobol_vdwf_dput (cobol_com_fileno, com_status, file_ptr, common_recsize, com_io_key); 2963 2964 end; 2965 2966 go to ret; 2967 2968 /* store the implicit position number of the current file on multiple file tape */ 2969 2970 action (57): 2971 ; /* assumes ft_ptr set to correct file */ 2972 2973 file_table.mult_position_no = temp1; 2974 2975 call cobol_vdwf_dput (cobol_com_fileno, com_status, ft_ptr, common_recsize, com_io_key); 2976 2977 go to ret; /* increment the MULTIPLE FILE position number in temp1 by 1 */ 2978 2979 action (58): 2980 ; 2981 2982 if file_ptr ^= null () 2983 then file_ptr -> file_table.mult_position_no = temp1; 2984 2985 go to ret; 2986 2987 /* load the success exit of the current syntax line in the line storage area with the relative 2988*address of the first syntax line of the recovery routine currently being executed */ 2989 2990 action (59): 2991 ; 2992 2993 current_line = recovaddress; 2994 kill_diag = 1; /* suppress diag */ 2995 2996 go to loop; 2997 2998 /* store the relative address of the first syntax line of the recovery routine which is being entered */ 2999 3000 action (60): 3001 ; 3002 3003 recovaddress = current_line; 3004 3005 go to ret; /* perform necessary termination functions */ 3006 3007 action (61): 3008 ; 3009 3010 if fixed_common.file_count > 0 3011 then cobol_$misc_end_ptr = addrel (cobol_$misc_end_ptr, file_table_size); 3012 3013 if pcs.type = 1 | pcs.type = 2 | pcs.type = 3 3014 then do; 3015 diag_item.number = 99; 3016 diag_item.size = 25; 3017 diag_item.param_at_end = "0"b; 3018 diag_item.line = pcs.line; 3019 diag_item.column = pcs.column; 3020 3021 call cobol_c_list (diag1_ptr); 3022 3023 pcs.type = 0; 3024 end; 3025 else if pcs.type = 4 3026 then do; 3027 call set_iw_key (pcs.type, pcs.num); 3028 3029 call set_offset (pcs.num - 9); 3030 3031 call cobol_vdwf_sput (cobol_name_fileno, name_status, alpha_ptr, alphabet_name.size, name_key); 3032 3033 diag_num = 103; 3034 call diag; 3035 3036 if alphabet_name.iw_key ^= 11 3037 then fixed_common.prog_coll_seq = addr (name_key) -> fb; 3038 end; 3039 3040 return; 3041 3042 action (62): /* character size is ... */ 3043 alphabet_name.char_size = num_binary; 3044 3045 go to ret; 3046 3047 action (63): /* program collating sequence clause: save alphabet name */ 3048 alf_type = left.type; 3049 alf_name = left.name; 3050 alf_num = left.number; 3051 go to ret; 3052 3053 /* store the procedure segment size in common */ 3054 action (64): 3055 objsign = alphanum_lit.string; 3056 3057 go to ret; 3058 3059 action (65): /** special-names paragraph, execute clause */ 3060 if clause_num ^= 0 3061 then go to SNP (clause_num); 3062 3063 go to ret; 3064 3065 SNP (1): /* switch clause */ 3066 go to dup_order; 3067 3068 SNP (2): /* device clause */ 3069 go to dup_order; 3070 3071 SNP (3): /* alphabet clause */ 3072 addr (alphabet_name.prev_rec) -> fb = fixed_common.alphabet_offset; 3073 3074 call cobol_vdwf_sput (cobol_name_fileno, name_status, alpha_ptr, alphabet_name.size, name_key); 3075 3076 fixed_common.alphabet_offset = addr (name_key) -> fb; 3077 if dup_alf_value 3078 then do; 3079 diag_num = 157; 3080 call diag; 3081 end; 3082 if pcs.type ^= 0 3083 then do; 3084 if alphabet_name.name = pcs.name 3085 then do; 3086 pcs.type = 10; 3087 if alphabet_name.iw_key ^= 11 3088 then fixed_common.prog_coll_seq = addr (name_key) -> fb; 3089 3090 end; 3091 end; 3092 3093 go to dup_order; 3094 3095 SNP (4): /*currency sign clause */ 3096 if currsign ^= " " 3097 then fixed_common.currency = currsign; 3098 if objsign ^= " " 3099 then fixed_common.object_sign = objsign; 3100 3101 go to dup_order; 3102 3103 SNP (5): /* decimal-point clause */ 3104 fixed_common.dec_comma = dec_com; 3105 fixed_common.obj_dec_comma = obj_com; 3106 3107 go to dup_order; 3108 3109 init_alpha: 3110 proc; 3111 3112 i = length (left.name); 3113 3114 alphabet_name.size = i + alphabet_name_size; 3115 alphabet_name.line = left.line; 3116 alphabet_name.column = left.column; 3117 alphabet_name.string_ptr = null (); 3118 alphabet_name.prev_rec = null (); 3119 alphabet_name.name_size = i; 3120 alphabet_name.name = left.name; 3121 3122 end; 3123 3124 action (66): /* alphabet_name is name */ 3125 clause_num = 3; 3126 3127 call set_iw_key (right.type, right.number); 3128 3129 call set_offset (alphabet_name.iw_key); 3130 3131 go to ret; 3132 3133 set_iw_key: 3134 proc (type, number); 3135 3136 declare (type, number) fixed bin; 3137 3138 call reset_alpha; 3139 3140 call init_alpha; 3141 3142 if type = 4 3143 then do; 3144 alphabet_name.iw_key = number - 9; /* implementor name */ 3145 end; 3146 else do; 3147 alphabet_name.iw_key = number; /* standard name */ 3148 end; 3149 3150 3151 if alphabet_name.iw_key > 0 & alphabet_name.iw_key < 10 3152 then go to STD (alphabet_name.iw_key); 3153 else go to STD0; 3154 3155 STD (1): /* NATIVE */ 3156 alphabet_name.iw_key = 11; 3157 3158 go to STD0; 3159 3160 STD (2): /* STANDARD-1 */ 3161 alphabet_name.iw_key = 11; 3162 3163 go to STD0; 3164 3165 STD (3): /* STANDARD-2 */ 3166 alphabet_name.iw_key = 11; 3167 3168 go to STD0; 3169 3170 STD0: 3171 end; 3172 3173 set_offset: 3174 proc (key); 3175 3176 declare key fixed bin; 3177 3178 if key > 11 3179 then go to IMP (key - 11); 3180 else return; 3181 IMP (1): /*ebcdic */ 3182 call cobol_set_type40_$ebcdic (alpha_ptr); 3183 3184 go to IMP0; 3185 3186 IMP (2): /* gbcd */ 3187 go to IMP0; 3188 3189 IMP (3): /* hbcd */ 3190 go to IMP0; 3191 3192 IMP (4): /* ibcd */ 3193 go to IMP0; 3194 3195 IMP (5): /* jis */ 3196 go to IMP0; 3197 3198 IMP0: 3199 end; 3200 3201 action (67): /* left operand, alphabet clause */ 3202 if reserved_word.type = 1 3203 then do; 3204 key = reserved_word.key; 3205 3206 if key = 166 3207 then alf_range = 1; /* is_word("thru") */ 3208 else if key = 96 3209 then alf_range = 2; /* is_word("also") */ 3210 else alf_range = 0; 3211 3212 end; 3213 3214 else alf_range = 0; 3215 3216 go to ret; 3217 3218 char_spec: 3219 proc (p); 3220 3221 declare p ptr; 3222 3223 declare 1 char_spec based (p), 3224 2 type fixed bin, 3225 2 value fixed bin, 3226 2 char char (256) varying; 3227 3228 if numeric_lit.type = 2 3229 then do; 3230 char_spec.type = 1; 3231 char_spec.value = fixed (numeric_lit.literal) - 1; 3232 3233 if char_spec.value < 0 | char_spec.value > nat_alf_size 3234 then do; 3235 diag_num = 102; 3236 call diag; 3237 end; 3238 3239 end; 3240 3241 else if alphanum_lit.type = 3 3242 then do; 3243 char_spec.type = 2; 3244 char_spec.char = alphanum_lit.string; 3245 3246 if fixed_common.comp_level < "5" & alphanum_lit.lit_size > 1 3247 then call lev_diag (124, record.header.line, record.header.column); 3248 3249 end; 3250 3251 else if reserved_word.type = 1 3252 then do; 3253 key = reserved_word.key; 3254 3255 if key = 180 3256 then char_spec.type = 3; /* is_word("zero") */ 3257 else if key = 192 3258 then char_spec.type = 4; /* is_word("space") */ 3259 else if key = 235 3260 then char_spec.type = 5; /* is_word("quote") */ 3261 else if key = 221 3262 then char_spec.type = 6; /* is_word ("high-value") */ 3263 else if key = 229 3264 then char_spec.type = 7; /* is_word("low-value") */ 3265 3266 else char_spec.type = 0; 3267 3268 end; 3269 3270 else char_spec.type = 0; 3271 3272 3273 end; 3274 3275 action (68): /* right operand, alphabet clause */ 3276 call char_spec (addr (right_char_spec)); 3277 3278 go to ret; 3279 3280 action (69): /** unary ALSO */ 3281 call range_spec; 3282 alf_range = 3; 3283 3284 go to ret; 3285 3286 action (70): /* range specification, alphabet clause */ 3287 call range_spec; /*[4.0-7]*/ 3288 alf_range = 1; 3289 go to ret; 3290 3291 range_spec: 3292 proc; 3293 3294 /* range specification */ 3295 3296 go to AR (alf_range); 3297 3298 AR (0): /* illegal */ 3299 go to AR1; 3300 3301 AR (1): /* left THRU right */ 3302 call range; 3303 3304 go to AR1; 3305 3306 AR (2): /* left ALSO right */ 3307 call also (addr (left_char_spec)); 3308 call also (addr (right_char_spec)); 3309 3310 go to AR1; 3311 3312 AR (3): /* ALSO right */ 3313 call also (addr (right_char_spec)); 3314 3315 AR1: 3316 end; 3317 3318 also: 3319 proc (p); 3320 3321 declare p ptr; 3322 declare (loc, L, i) fixed bin; 3323 3324 declare 1 char_spec based (p), 3325 2 type fixed bin, 3326 2 value fixed bin, 3327 2 char char (256) varying; 3328 3329 go to AL (char_spec.type); 3330 3331 AL (0): /* illegal */ 3332 return; 3333 3334 AL (1): /* numeric literal */ 3335 go to AL1; 3336 3337 AL (2): /* alphanumeric literal */ 3338 L = length (char_spec.char); 3339 call setup; 3340 3341 do i = 1 by 1 to L; 3342 3343 char1 = substr (char_spec.char, i, 1); 3344 call set_also_char (fixed (char1_ptr -> bit9)); 3345 3346 end; 3347 3348 return; 3349 3350 AL (3): /* is_word("zero") */ 3351 char_spec.value = index (coll_seq, "0"); 3352 3353 go to AL1; 3354 3355 AL (4): /* is_word("space") */ 3356 char_spec.value = index (coll_seq, " "); 3357 3358 go to AL1; 3359 3360 AL (5): /* is_word("quote") */ 3361 char_spec.value = index (coll_seq, """"); 3362 3363 go to AL1; 3364 3365 AL (6): /* is_word("high-value") */ 3366 char_spec.value = 128; 3367 3368 go to AL1; 3369 3370 AL (7): /* is_word("low-value") */ 3371 char_spec.value = 1; 3372 3373 go to AL1; 3374 3375 AL1: 3376 call setup; 3377 call set_also_char (char_spec.value); 3378 3379 end; 3380 3381 setup: 3382 proc; 3383 3384 one_one_bit = "1"b; 3385 3386 ord_num = curr_ord_num; 3387 3388 end; 3389 3390 set_also_char: 3391 proc (loc); 3392 3393 declare loc fixed bin; 3394 3395 /*[4.0-7]*/ 3396 if loc < 0 | loc > nat_alf_size + 1 3397 then return; 3398 3399 if nat_bits (loc) 3400 then dup_alf_value = "1"b; 3401 3402 else do; 3403 nat_bits (loc) = "1"b; 3404 tran_tab (loc) = ord_num; 3405 3406 if ord_num >= ord_max 3407 then do; 3408 high_value_value = loc; 3409 ord_max = ord_num; 3410 end; 3411 3412 ord_num = ord_num + 1; 3413 end; 3414 3415 end; 3416 3417 set_char: 3418 proc (loc); 3419 3420 declare loc fixed bin; 3421 3422 if nat_bits (loc) 3423 then dup_alf_value = "1"b; 3424 else do; 3425 nat_bits (loc) = "1"b; 3426 tran_tab (loc) = ord_num; 3427 ord_num = ord_num + 1; 3428 3429 high_value_value = loc; 3430 end; 3431 3432 end; 3433 3434 range: 3435 proc; 3436 3437 declare (L, i, loc) fixed bin; 3438 3439 ord_num = curr_ord_num + ord_max; 3440 3441 go to TL (left_char_spec.type); 3442 3443 TL (0): /* illegal */ 3444 return; 3445 3446 TL (1): /* left side is numeric literal*/ 3447 left_number = left_char_spec.value; 3448 3449 go to T1; 3450 3451 TL (2): /* left side is alphanumeric literal */ 3452 L = length (left_char_spec.char); 3453 char1 = substr (left_char_spec.char, L, 1); 3454 left_number = fixed (char1_ptr -> bit9); 3455 3456 if L > 1 3457 then do i = 1 by 1 to L - 1; 3458 3459 char1 = substr (left_char_spec.char, i, 1); 3460 loc = fixed (char1_ptr -> bit9); 3461 call set_char (loc); 3462 3463 end; 3464 3465 go to T1; 3466 3467 TL (3): /* left side is zero */ 3468 left_number = index (coll_seq, "0"); 3469 3470 go to T1; 3471 3472 TL (4): /* left side is space */ 3473 left_number = index (coll_seq, " "); 3474 3475 go to T1; 3476 3477 TL (5): /* left side is quote */ 3478 left_number = index (coll_seq, """"); 3479 3480 go to T1; 3481 3482 TL (6): /* left side is high-value */ 3483 left_number = 128; 3484 3485 go to T1; 3486 3487 TL (7): /* left-side is low-value */ 3488 left_number = 1; 3489 3490 go to T1; 3491 3492 T1: 3493 go to TR (right_char_spec.type); 3494 3495 TR (0): 3496 right_number = left_number; 3497 3498 call emit_range; 3499 3500 go to T2; 3501 3502 TR (1): /* right side is numeric literal */ 3503 right_number = right_char_spec.value; 3504 call emit_range; 3505 3506 go to T2; 3507 3508 TR (2): /* right side is alphanumeric literal */ 3509 L = length (right_char_spec.char); 3510 char1 = substr (right_char_spec.char, 1, 1); 3511 right_number = fixed (char1_ptr -> bit9); 3512 call emit_range; 3513 3514 if L > 1 3515 then do i = 2 by 1 to L; 3516 3517 char1 = substr (right_char_spec.char, i, 1); 3518 loc = fixed (char1_ptr -> bit9); 3519 call set_char (loc); 3520 3521 end; 3522 3523 go to T2; 3524 3525 TR (3): /* right side is zero */ 3526 right_number = index (coll_seq, "0"); 3527 call emit_range; 3528 3529 go to T2; 3530 3531 3532 TR (4): /* right side is space */ 3533 right_number = index (coll_seq, " "); 3534 call emit_range; 3535 3536 go to T2; 3537 3538 TR (5): /* right side is quote */ 3539 right_number = index (coll_seq, """"); 3540 call emit_range; 3541 3542 go to T2; 3543 3544 TR (6): /* right side is high-value */ 3545 right_number = 128; 3546 call emit_range; 3547 3548 go to T2; 3549 3550 TR (7): /* right side is low-value */ 3551 right_number = 1; 3552 call emit_range; 3553 3554 go to T2; 3555 3556 3557 T2: 3558 curr_ord_num = ord_num; 3559 ord_max = 0; 3560 3561 end; 3562 3563 3564 emit_range: 3565 proc; 3566 3567 if left_number < 0 | left_number > nat_alf_size | right_number < 0 | right_number > nat_alf_size 3568 then return; 3569 3570 if left_number <= right_number 3571 then do i = left_number by 1 to right_number; 3572 3573 call set_char (i); 3574 3575 end; 3576 3577 else do i = left_number by -1 to right_number; 3578 3579 call set_char (i); 3580 3581 end; 3582 3583 end; 3584 3585 3586 action (71): 3587 if user_word.type = 8 3588 then do; 3589 file_table.catalogued = 3; 3590 call enter_key (7); 3591 end; 3592 else if alphanum_lit.type = 3 3593 then file_table.catalogued = 2; 3594 3595 go to ret; 3596 3597 action (72): 3598 right_char_spec.type = 0; 3599 3600 call range_spec; 3601 3602 go to ret; 3603 3604 action (73): 3605 org = file_ptr -> file_table.organization; 3606 3607 mod_num = lev1_mod (org); 3608 3609 current_line = current_line + org + 1; 3610 3611 go to loop; 3612 3613 action (74): 3614 org = file_table.organization; 3615 3616 mod_num = lev2_mod (org); 3617 3618 current_line = current_line + org + 1; 3619 3620 go to loop; 3621 3622 action (75): 3623 call cobol_vdwf_dget (cobol_com_fileno, /* [3.0-1] */ 3624 com_status, /* [3.0-1] */ 3625 work_ptr, /* [3.0-1] */ 3626 common_recsize, /* [3.0-1] */ 3627 fixed_common.last_file_key /* [3.0-1] */); /* [3.0-1] */ 3628 3629 work_ptr -> file_key.duplicates = "1"b; /* [3.0-1] */ 3630 3631 call cobol_vdwf_dput (cobol_com_fileno, /* [3.0-1] */ 3632 com_status, /* [3.0-1] */ 3633 work_ptr, /* [3.0-1] */ 3634 common_recsize, /* [3.0-1] */ 3635 fixed_common.last_file_key /* [3.0-1] */); /* [3.0-1] */ 3636 file_table.dupl_alt = "1"b; /* [3.0-5] */ 3637 3638 go to ret; /* [3.0-1] */ 3639 3640 action (76): /*[4.0-8]*/ 3641 current_line = current_line + same_type + 1; 3642 3643 go to loop; 3644 3645 action (77): /* issue diagnostic m = 2srt(131) with mod_num = 6 */ 3646 if "4" > fixed_common.comp_level 3647 then do; 3648 mod_num = 6; /* 2srt */ 3649 call lev_diag (131, rec_loc.line, rec_loc.column); 3650 /* SAME RECORD AREA */ 3651 end; 3652 3653 go to ret; 3654 3655 action (78): /* set sort_name to show that file name is a sort file */ 3656 /*[4.2-1]*/ 3657 sort_name = "1"b; 3658 3659 go to ret; 3660 3661 action (79): 3662 property (18) = "1"b; /* indicate record key */ 3663 file_table.record_key = "1"b; 3664 call enter_key (2); 3665 3666 go to ret; 3667 3668 /* catalogue name clause */ 3669 3670 /* construct an entry in common for the current file status item name */ 3671 3672 action (80): /* assumes ft_ptr set to correct file */ 3673 /* indicate file status item name */ 3674 file_table.file_status = "1"b; 3675 call enter_key (3); 3676 3677 go to ret; 3678 action (84): 3679 go to dup_order; 3680 3681 action (85): /* begin the mnemonic-name record for this item */ 3682 mnemonic_name.class = class24; 3683 mnemonic_name.on_status = "0"b; 3684 mnemonic_name.off_status = "0"b; 3685 3686 go to ret; 3687 3688 action (92): /* same clause */ 3689 /*[5.0-1]*/ 3690 string (org_vector) = "0"b; 3691 3692 /*[5.0-1]*/ 3693 if reserved_word.type ^= 1 /*[5.0-1]*/ 3694 then do; 3695 same_type = 4; /*[5.0-1]*/ 3696 samect = samect + 1; /*[5.0-1]*/ 3697 go to ret; /*[5.0-1]*/ 3698 end; 3699 3700 key = reserved_word.key; 3701 3702 if key = 148 /* is_word("record") */ 3703 then do; 3704 same_type = 1; 3705 samerecct = samerecct + 1; 3706 fixed_common.sra_clauses = samerecct; 3707 3708 /*[5.0-1]*/ 3709 rec_loc.line = record.header.line; /*[5.0-1]*/ 3710 rec_loc.column = record.header.column; 3711 end; 3712 else if key = 49 /* is_word("sort) */ 3713 then do; 3714 same_type = 2; 3715 samesct = samesct + 1; 3716 end; 3717 else if key = 598 /* is_word("sort-merge") */ 3718 then do; 3719 same_type = 3; 3720 samesmct = samesmct + 1; 3721 end; 3722 else do; 3723 same_type = 4; 3724 samect = samect + 1; 3725 end; 3726 3727 go to ret; 3728 3729 /* increment the sequential number of the current SAME AREA clause by 1, and set temp1, temp2, and 3730* temp3 to zero */ 3731 3732 action (93): 3733 samect = samect + 1; 3734 temp1 = 0; 3735 temp2 = 0; 3736 temp3 = 0; 3737 3738 go to ret; 3739 3740 /* build qualifier record in common for file key or file status name being processed */ 3741 3742 action (95): 3743 ; /* assumes fkey_ptr set to correct key or file status name */ 3744 3745 temp4 = user_word.length + key_qual_size; 3746 qual_ptr = addr (file_key_area); 3747 qual_rec.next = "00000"; 3748 qual_rec.size = user_word.length; 3749 qual_rec.name = user_word.word; 3750 common_recsize = temp4; /* temp4 contains size of qual_rec. */ 3751 3752 call cobol_vdwf_sput (cobol_com_fileno, com_status, qual_ptr, common_recsize, common_key); 3753 3754 if qual_sw = "0"b 3755 then do; /* is this 1st qual?*/ 3756 3757 call cobol_vdwf_dget (cobol_com_fileno, com_status, work_ptr, common_recsize, 3758 fixed_common.last_file_key); /* get subject */ 3759 3760 work_ptr -> file_key.qual = common_key; /* link to current qual*/ 3761 3762 call cobol_vdwf_dput (cobol_com_fileno, com_status, work_ptr, common_recsize, 3763 fixed_common.last_file_key); 3764 3765 end; 3766 3767 else do; /* two or more qual. */ 3768 3769 call cobol_vdwf_dget (cobol_com_fileno, com_status, work_ptr, common_recsize, prev_qual_key); 3770 /* get qual. */ 3771 3772 work_ptr -> qual_rec.next = common_key; /* now link to current qual. */ 3773 3774 call cobol_vdwf_dput (cobol_com_fileno, com_status, work_ptr, common_recsize, prev_qual_key); 3775 3776 end; 3777 3778 prev_qual_key = common_key; /* save current qual. rec. */ 3779 qual_sw = "1"b; 3780 3781 go to ret; 3782 3783 action (96): /* file table to variable common */ 3784 if file_table.organization = 2 & file_table.access = 0 3785 then file_table.access = 1; 3786 if ^ignore_file 3787 then call emit_ft; 3788 3789 go to ret; 3790 3791 action (97): /* type 17 name table entry, device number */ 3792 addr (mnemonic_name.class) -> bit8 = "0"b; 3793 3794 if left.number >= 210 3795 then mnemonic_name.class.printer_control = "1"b; 3796 else do; 3797 3798 if left.number ^= 0 3799 then left.number = left.number - 8; 3800 3801 go to RN (left.number); 3802 3803 RN (0): /* illegal */ 3804 go to RN1; 3805 3806 RN (1): /* SYSIN */ 3807 mnemonic_name.class.accept_device = "1"b; 3808 3809 go to RN1; 3810 3811 RN (2): /* SYSOUT */ 3812 mnemonic_name.class.display_device = "1"b; 3813 3814 go to RN1; 3815 3816 RN (3): /* CONSOLE */ 3817 mnemonic_name.class.accept_device = "1"b; 3818 mnemonic_name.class.display_device = "1"b; 3819 3820 go to RN1; 3821 3822 RN1: 3823 end; 3824 call nm (addr (right), left.number); 3825 3826 go to ret; 3827 3828 action (98): /* file control paragraph: determine clause number */ 3829 file_qual = 0; 3830 key = reserved_word.key; 3831 3832 if key = 509 3833 then clause_num = 1; /* is_word("assign") */ 3834 else if key = 181 3835 then clause_num = 2; /* is_word("organization") */ 3836 3837 else if key = 589 /* is_word("reserve") */ 3838 then clause_num = 3; 3839 3840 else if key = 501 3841 then clause_num = 4; /* is_word("access") */ 3842 else if key = 108 3843 then clause_num = 6; /* is_word("file") */ 3844 else if key = 247 3845 then clause_num = 6; /* is_word("status") */ 3846 else if key = 331 3847 then clause_num = 8; /* is_word("catalog-name") */ 3848 3849 else if key = 85 3850 then /* is_word("ssf") */ 3851 do; 3852 clause_num = 9; 3853 ssf_ind = "1"b; 3854 end; 3855 3856 else if key = 272 3857 then /* is_word("flr") */ 3858 do; 3859 clause_num = 9; 3860 flr_ind = "1"b; 3861 end; 3862 3863 else if key = 201 3864 then /* is_word("vlr") */ 3865 do; 3866 clause_num = 9; 3867 vlr_ind = "1"b; 3868 end; 3869 3870 else if key = 413 3871 then /* is_word("bsn") */ 3872 do; 3873 clause_num = 9; 3874 bsn_ind = "1"b; 3875 end; 3876 3877 else if key = 601 3878 then /* is_word("spanned") */ 3879 do; 3880 clause_num = 9; 3881 span_ind = "1"b; 3882 end; 3883 3884 else if key = 329 3885 then clause_num = 10; /* is_word("process-area") */ 3886 else if key = 327 3887 then clause_num = 11; /* is_word("interchange") */ 3888 else if key = 167 3889 then clause_num = 12; /* is_word("relative") */ 3890 3891 else if key = 507 /* is_word("alternate") */ 3892 then clause_num = 7; 3893 3894 else if key = 148 3895 then clause_num = 5; /* is_word("record") */ 3896 else if key = 129 3897 then clause_num = 13; /* is_word("no") */ 3898 else clause_num = 0; 3899 3900 /*[4.0-5]*/ 3901 if clause_num ^= 0 3902 then go to SL (clause_num); /*[4.0-5]*/ 3903 SL (1): 3904 val = 7; 3905 go to SLL; 3906 SL (2): 3907 val = 1; 3908 go to SLL; 3909 SL (3): 3910 val = 3; 3911 go to SLL; 3912 SL (4): 3913 val = 8; 3914 go to SLL; 3915 SL (5): 3916 val = 4; 3917 rec_key = "1"b; 3918 go to SLL; 3919 SL (6): 3920 val = 9; 3921 go to SLL; 3922 SL (7): 3923 val = 5; 3924 go to SLL; 3925 SL (8): 3926 go to ret; 3927 SL (9): 3928 go to ret; 3929 SL (10): 3930 go to ret; 3931 SL (11): 3932 go to ret; 3933 SL (12): 3934 val = 10; 3935 rel_key = "1"b; 3936 go to SLL; 3937 SL (13): 3938 go to ret; 3939 3940 /*[4.0-5]*/ 3941 /*[4.0-5]*/ 3942 SLL: /*[4.0-5]*/ 3943 /*[4.0-5]*/ 3944 source_pos.line (val) = record.header.line; /*[4.0-5]*/ 3945 source_pos.column (val) = record.header.column; 3946 go to ret; /*[4.0-5]*/ 3947 3948 3949 action (125): /* construct a file key record for the status key 3 item */ 3950 temp6 = 4; /* indicate status key 3 name in file status clause */ 3951 file_table.extra_status = "1"b; 3952 call enter_key (4); 3953 3954 go to ret; 3955 3956 action (133): /* diagnose any contradictions in previous select clause */ 3957 if file_table.organization = 0 3958 then file_table.organization = 1; 3959 if file_table.buffers = 0 3960 then file_table.buffers = 1; 3961 3962 /*[4.0-1]*/ 3963 if file_table.device = 7 /* preattached */ 3964 /*[4.0-1]*/ 3965 then do; 3966 file_table.optional = "0"b; /*[4.0-1]*/ 3967 file_table.external = "1"b; /*[4.0-3]*/ 3968 file_table.detach = "1"b; /*[4.0-1]*/ 3969 end; 3970 3971 3972 if file_table.optional 3973 then if file_table.organization ^= 1 3974 then do; 3975 diag_num = 110; 3976 call diag; 3977 3978 if fixed_common.comp_level < "5" 3979 then call lev_diag (9, record.header.line, record.header.column); 3980 3981 end; 3982 3983 if file_table.access > 1 3984 then if file_table.organization ^= 2 & file_table.organization ^= 3 3985 then do; 3986 diag_num = 109; 3987 call diag; 3988 3989 file_table.access = 1; 3990 end; 3991 3992 if (file_table.device ^= 1) 3993 then if file_table.record_prefix = 0 3994 then file_table.record_prefix = 2; 3995 3996 do i = 1 to 21; 3997 3998 if property (i) ^= "0"b 3999 then do; 4000 4001 vector_temp = vector & array (i); 4002 4003 if vector_temp ^= "0"b 4004 then do; 4005 4006 diag_item.line = record.header.line; 4007 diag_item.column = record.header.column; 4008 diag_item.number = 9; 4009 diag_item.param_at_end = "1"b; 4010 diag_item.image_size = word_array.word_size (i) + 5; 4011 diag_item.image = word_array.word (i); 4012 4013 substr (diag_item.image, word_array.word_size (i) + 1, 5) = " and "; 4014 4015 do j = 1 to 21; 4016 4017 if temp_bit (j) ^= "0"b 4018 then do; 4019 4020 substr (diag_item.image, word_array.word_size (i) + 6, 4021 word_array.word_size (j)) = word_array.word (j); 4022 4023 diag_item.image_size = 4024 word_array.word_size (i) + 5 + word_array.word_size (j); 4025 4026 diag_item.size = 32 + diag_item.image_size; 4027 4028 call cobol_c_list (diag1_ptr); 4029 4030 end; 4031 4032 end; 4033 4034 end; 4035 4036 end; 4037 end; 4038 4039 go to ret; 4040 4041 action (162): /* determine number of default section clause */ 4042 call def_clause_num; 4043 4044 go to ret; 4045 4046 def_clause_num: 4047 proc; 4048 4049 if reserved_word.type = 1 4050 then do; 4051 key = reserved_word.key; 4052 4053 if key = 122 4054 then clause_num = 2; /* is_word("leading") */ 4055 else if key = 255 4056 then clause_num = 2; /* is_word("trailing") */ 4057 else if key = 106 4058 then clause_num = 3; /* is_word("comp") */ 4059 else if key = 1 4060 then clause_num = 5; /* is_word("accept") */ 4061 else if key = 42 4062 then clause_num = 6; /* is_word("display") */ 4063 else if key = 251 4064 then clause_num = 1; /* is_word("symbolic") */ 4065 else if key = 131 4066 then clause_num = 4; /* is_word("numeric") */ 4067 else clause_num = 0; 4068 4069 end; 4070 4071 else if user_word.type = 8 4072 then do; 4073 key = cobol_imp_word$imp_word (p2); 4074 4075 if key = 11 4076 then clause_num = 6; /* IS_WORD("console") */ 4077 else if key = 10 4078 then clause_num = 6; /* IS_WORD("sysout") */ 4079 else if key = 1000 4080 then clause_num = 4; /* is_word("temp") */ 4081 else clause_num = 0; 4082 4083 end; 4084 4085 else clause_num = 0; 4086 4087 end; 4088 4089 action (163): /* initialize for default section */ 4090 lead_trail = 0; /* sign is trailing */ 4091 sep_sign = 0; /* sign is non-separate */ 4092 acc_dev_num = 0; /* accept device is sysin */ 4093 disp_dev_num = 0; /* display device is sysout */ 4094 int_res = 30; /* intermediate results to 30 digits */ 4095 queue_name = 0; /* symbolic queue is omitted */ 4096 comp_type = 0; /* default comp is display */ 4097 4098 clause_bits = "0"b; 4099 last_clause = 0; 4100 clause_order = 0; 4101 4102 go to ret; 4103 4104 action (164): /* determine accept device number */ 4105 key = cobol_imp_word$device_name (p2); 4106 4107 if key = 1 4108 then acc_dev_num = 0; /* IS_WORD("sysin") */ 4109 else if key = 3 4110 then acc_dev_num = 1; /* IS_WORD("console") */ 4111 else acc_dev_num = 0; 4112 4113 go to ret; 4114 4115 action (165): /* determine display device number */ 4116 key = cobol_imp_word$device_name (p2); 4117 4118 if key = 2 4119 then disp_dev_num = 0; /* IS_WORD("sysout") */ 4120 else if key = 3 4121 then disp_dev_num = 1; /* IS_WORD("console") */ 4122 else disp_dev_num = 0; 4123 4124 call def_clause_num; 4125 4126 go to ret; 4127 4128 action (166): 4129 go to ret; 4130 4131 action (167): /* determine message queue number */ 4132 key = reserved_word.key; 4133 4134 if key = 203 4135 then queue_name = 0; /* is_word("omitted") */ 4136 else if key = 126 4137 then queue_name = 1; /* is_word("message") */ 4138 else queue_name = 0; 4139 4140 go to ret; 4141 4142 action (168): /* initialize for id paragraphs */ 4143 clause_bits = "0"b; 4144 last_clause = 0; 4145 clause_order = 0; 4146 4147 4148 go to ret; 4149 4150 action (169): /* default section clause */ 4151 if clause_num ^= 0 4152 then go to D (clause_num); 4153 else go to ret; 4154 4155 D (1): /* symbolic queue clause */ 4156 go to dup_order; 4157 4158 D (2): /* display sign clause */ 4159 if lead_trail ^= 0 4160 then substr (dst, 2, 1) = "1"b; 4161 else substr (dst, 3, 1) = "1"b; 4162 4163 if sep_sign ^= 0 4164 then if substr (dst, 2, 2) = "10"b 4165 then substr (dst, 1, 3) = "100"b; 4166 else substr (dst, 1, 3) = "011"b; 4167 4168 if dst ^= "0"b 4169 then fixed_common.default_sign_type = dst; 4170 4171 go to dup_order; 4172 4173 D (3): /* default_comp_clause */ 4174 if comp_type ^= 0 4175 then do; 4176 if comp_type < 10 4177 then do; 4178 def_ptr = addr (fixed_common.comp_defaults); 4179 def_ptr -> bit9 = "0"b; 4180 addr (fixed_common.disp_defaults) -> bit8 = "0"b; 4181 /*[4.4-3]*/ 4182 substr (def_ptr -> bit9, comp_type, 1) = "1"b; 4183 end; 4184 else do; 4185 def_ptr = addr (fixed_common.disp_defaults); 4186 def_ptr -> bit8 = "0"b; 4187 addr (fixed_common.comp_defaults) -> bit9 = "0"b; 4188 /*[4.4-3]*/ 4189 substr (def_ptr -> bit8, comp_type - 10, 1) = "1"b; 4190 end; 4191 end; 4192 4193 go to dup_order; 4194 4195 D (4): /* temp_clause */ 4196 fixed_common.default_temp = int_res; 4197 4198 go to ret; 4199 4200 D (5): /* accept_device clause */ 4201 fixed_common.accept_device = acc_dev_num; 4202 4203 go to dup_order; 4204 4205 D (6): /* display device clause */ 4206 fixed_common.display_device = disp_dev_num; 4207 4208 go to dup_order; 4209 4210 dup_order: 4211 if clause_num < last_clause 4212 then clause_order = 1; 4213 4214 last_clause = clause_num; 4215 4216 go to ret; 4217 4218 action (170): /* default sign is leading */ 4219 call def_clause_num; 4220 lead_trail = 1; 4221 4222 go to ret; 4223 4224 action (171): /* default_sign is trailing */ 4225 call def_clause_num; 4226 lead_trail = 0; 4227 4228 go to ret; 4229 4230 action (172): /* sign is separate */ 4231 sep_sign = 1; 4232 4233 go to ret; 4234 4235 action (173): /* [3.0-3] issue lev diag for 169-missing period after division */ 4236 if fixed_common.comp_level < "5" 4237 then call lev_diag (169, record.header.line, record.header.column); 4238 4239 go to ret; 4240 4241 action (174): /*[4.4-2]*/ 4242 mod_num = 0; 4243 go to ret; 4244 4245 action (175): /*[4.4-2]*/ 4246 call sav_lin_col; 4247 go to ret; 4248 4249 action (176): /*[4.4-2]*/ 4250 qualif = "1"b; 4251 go to ret; 4252 4253 action (177): /*[4.4-2]*/ 4254 if fixed_common.comp_level < "3" /*[4.4-2]*/ 4255 then if qualif /*[4.4-2]*/ 4256 then call lev_diag (5, save.line, save.column); 4257 go to ret; 4258 4259 /*[5.0-1]*/ 4260 4261 action (178): /* SAME AREA clause */ 4262 go to SA (org); 4263 4264 SA (1): /* seq file */ 4265 mod_num = 0; 4266 go to SA0; 4267 4268 SA (2): /* rel file */ 4269 call sa_mess (2, 17); 4270 go to SA0; 4271 4272 SA (3): /* inx file */ 4273 call sa_mess (3, 19); 4274 go to SA0; 4275 4276 SA (4): /* illegal */ 4277 go to SA0; 4278 4279 SA (5): /* str file */ 4280 call sa_mess (5, 25); 4281 go to SA0; 4282 SA0: 4283 go to ret; 4284 4285 declare org_vector (5) bit (1); 4286 4287 declare 1 same_loc, 4288 2 line fixed bin, 4289 2 column fixed bin; 4290 dcl level_num (26) char (1) 4291 init ("1", "3", "1", "3", "3", "4", "2", "4", "2", "4", "2", "3", "2", "3", "1", "3", "2", 4292 "3", "4", "4", "4", "4", "3", "3", "5", "5"); 4293 4294 sa_mess: 4295 proc (org_num, md_num); 4296 4297 declare (org_num, md_num) fixed bin; 4298 4299 if org_vector (org_num) 4300 then return; 4301 4302 org_vector (org_num) = "1"b; 4303 mod_num = md_num; 4304 4305 if level_num (md_num) > fixed_common.comp_level 4306 then call lev_diag (211, same_loc.line, same_loc.column); 4307 4308 end; 4309 4310 action (179): /* SAME RECORD AREA clause */ 4311 go to SRA (org); 4312 4313 SRA (1): /* seq file */ 4314 if org_vector (org) 4315 then go to ret; 4316 4317 org_vector (org) = "1"b; 4318 mod_num = 16; 4319 if "3" > fixed_common.comp_level 4320 then call lev_diag (131, rec_loc.line, rec_loc.column); 4321 go to SRA0; 4322 4323 SRA (2): /* rel file */ 4324 call sra_mess (2, 17); 4325 go to SRA0; 4326 4327 SRA (3): /* inx file */ 4328 call sra_mess (3, 19); 4329 go to SRA0; 4330 4331 SRA (4): /* illegal */ 4332 go to SRA0; 4333 4334 SRA (5): /* str file */ 4335 call sra_mess (5, 25); 4336 go to SRA0; 4337 4338 SRA0: 4339 go to ret; 4340 4341 declare 1 rec_loc, 4342 2 line fixed bin, 4343 2 column fixed bin; 4344 4345 sra_mess: 4346 proc (org_num, md_num); 4347 4348 declare (org_num, md_num) fixed bin; 4349 4350 if org_vector (org_num) 4351 then return; 4352 4353 org_vector (org_num) = "1"b; 4354 mod_num = md_num; 4355 4356 if level_num (md_num) > fixed_common.comp_level 4357 then call lev_diag (211, same_loc.line, same_loc.column); 4358 4359 md_num = md_num + 1; 4360 mod_num = md_num; 4361 4362 if level_num (md_num) > fixed_common.comp_level 4363 then call lev_diag (131, rec_loc.line, rec_loc.column); 4364 4365 end; 4366 4367 sav_lin_col: 4368 proc; 4369 4370 /*[4.4-2]*/ 4371 save.line = record.header.line; 4372 save.column = record.header.column; /*[4.4-2]*/ 4373 qualif = "0"b; 4374 end; 4375 4376 dtb: 4377 proc; 4378 num_binary = fixed (numeric_lit.literal); 4379 end; 4380 4381 /*[5.0-1]*/ 4382 declare seg_limit fixed bin static internal; 4383 4384 get_seg_limit: 4385 entry returns (fixed bin); 4386 4387 /*[5.0-1]*/ 4388 return (seg_limit); 4389 4390 4391 /*[4.2-1]*/ 4392 dcl sort_name bit (1), 4393 cobol_res_words$check_sort_list 4394 entry (char (*)) returns (bit (1)); 4395 declare LEV char (1); 4396 4397 declare lev1_org (6) char (1) init ("0", "2", "4", "0", "0", "3"); 4398 declare lev2_org (6) char (1) init ("3", "3", "4", "0", "5", "4"); 4399 4400 /*[4.0-5]*/ 4401 dcl dynamic_acc bit (1), 4402 val fixed bin; 4403 declare 1 source_pos (10), 4404 2 line fixed bin, 4405 2 column fixed bin; 4406 4407 declare lev1_mod (6) fixed bin init (15, 17, 19, 0, 25, 5); 4408 declare lev2_mod (6) fixed bin init (16, 18, 20, 0, 26, 6); 4409 4410 declare (mod_num, act_num, org) 4411 fixed bin; 4412 4413 /*[4.2-2]*/ 4414 declare 1 dyn, /*[4.2-2]*/ 4415 2 line fixed bin, /*[4.2-2]*/ 4416 2 column fixed bin; 4417 4418 /*[4.2-2]*/ 4419 declare LEV_NUM char (1), 4420 MOD_NUM fixed bin; 4421 4422 declare (addr, addrel, index, null, rel, substr, unspec, fixed, char, length, size, string) 4423 builtin; 4424 declare (collate) builtin; 4425 4426 4427 dcl 1 qual_rec based (qual_ptr), 4428 2 next char (5), 4429 /******** new i_o key ******/ 4430 2 size fixed bin, 4431 2 name char (0 refer (qual_rec.size)); 4432 4433 /* general form of internal record */ 4434 /* current minpral item buffer */ 4435 dcl 1 record based (p2), 4436 2 header, 4437 3 size fixed bin, 4438 3 line fixed bin, 4439 3 column fixed bin, 4440 3 type fixed bin, 4441 2 body char (record.header.size - 16); 4442 4443 /* description of diagnostic item in input minpral */ 4444 dcl 1 message based (p2), 4445 2 header, 4446 3 size fixed bin, 4447 3 line fixed bin, 4448 3 column fixed bin, 4449 3 type fixed bin, /* = 5 */ 4450 2 body, 4451 3 run fixed bin, 4452 3 number fixed bin, 4453 3 info, 4454 4 param_at_end 4455 bit (1), 4456 4 replaces_token 4457 bit (1), 4458 4 filler bit (6), 4459 3 length fixed bin, 4460 3 image char (message.length); 4461 4462 /* type 5 structure used to construct diagnostics issued by idedsyn */ 4463 dcl 1 diag_item, /* header */ 4464 2 size fixed bin, 4465 2 line fixed bin, 4466 2 column fixed bin, 4467 2 type fixed bin, /* body */ 4468 2 run fixed bin, 4469 2 number fixed bin, 4470 2 param_at_end bit (1), 4471 2 replace bit (1), 4472 2 filler bit (6), 4473 2 image_size fixed bin, 4474 2 image char (29); 4475 4476 /*[4.4-2]*/ 4477 declare qualif bit (1); 4478 4479 /*[4.4-2]*/ 4480 declare 1 save, /*[4.4-2]*/ 4481 2 line fixed bin, /*[4.4-2]*/ 4482 2 column fixed bin; 4483 4484 declare 1 lev_diag_item, 4485 2 size fixed bin, 4486 2 line fixed bin, 4487 2 column fixed bin, 4488 2 type fixed bin, 4489 2 run fixed bin, 4490 2 number fixed bin, 4491 2 module fixed bin; 4492 4493 /* external entry declarations */ 4494 dcl cobol_swf_get entry (ptr, bit (32), ptr, fixed bin) ext; 4495 dcl cobol_vdwf_dput entry (ptr, bit (32), ptr, fixed bin, char (5)) ext; 4496 dcl cobol_vdwf_dget entry (ptr, bit (32), ptr, fixed bin, char (5)) ext; 4497 dcl cobol_vdwf_sput entry (ptr, bit (32), ptr, fixed bin, char (5)) ext; 4498 dcl cobol_c_list entry (ptr) ext; /* called to print source images and diagnostics */ 4499 dcl cobol_ided entry (ptr, fixed bin) ext; /* called to get syntax table 1st line */ 4500 dcl n_reducs fixed bin; 4501 4502 /*work area for io */ 4503 dcl min1_status bit (32); /*minpral file return code */ 4504 dcl com_status bit (32); /*common file return code */ 4505 dcl name_status bit (32); /*name_tbl file return code */ 4506 dcl ft_size fixed bin; /*file table item size */ 4507 dcl prev_qual_key char (5); /* previous qual_key record address */ 4508 dcl last_prev_file_key char (5); /* last previous file_table address */ 4509 dcl same_ptr_key char (5); /* same area previous file table address */ 4510 dcl last_fkey_ptr char (5); /*address of last file_key record */ 4511 dcl last_ft_ptr ptr; /* previous file table pointer */ 4512 dcl file_key_type fixed bin; /* file key type saving area */ 4513 dcl qual_sw bit (1); /* indicator if qualifier exist */ 4514 dcl com_io_key char (5); /*common_file io key */ 4515 4516 /* work areas */ 4517 dcl file_key_area char (256); /* work area for file key record */ 4518 declare x bit (8) based; 4519 declare class24 bit (24) based (addr (reserved_word.verb)); 4520 4521 declare ft_build_area (500) fixed bin; /* file table entry */ 4522 4523 dcl zero char (18); /* constant zero */ 4524 dcl banchar char (1); /* banner character from apply clause saved here */ 4525 dcl padchar char (1); /* padding character from apply clause saved here */ 4526 dcl error char (1); /* set to "E" if run interrupted by io error */ 4527 declare device_name_size fixed bin; 4528 declare device_name char (32) varying; 4529 dcl current_file_no fixed bin; /* same area file no */ 4530 /* pointers */ 4531 dcl name_ptr ptr; /* pointer to mnemonic-name record in common */ 4532 dcl ft_ptr ptr; /* pointer to current file table record in common */ 4533 dcl (work_ptr, save_ptr) 4534 ptr; 4535 dcl fkey_ptr ptr; /* pointer to current file key or file status record in common */ 4536 dcl qual_ptr ptr; /* pointer to qualifier record in common */ 4537 dcl same_ptr ptr; /* pointer to file table for previous file in current SAME [RECORD] AREA clause */ 4538 dcl (diag1_ptr, diag2_ptr) 4539 ptr; /* pointer to diag_item, passed to print routine */ 4540 4541 /*work area for output item size */ 4542 dcl file_table_size fixed bin; /*file table base */ 4543 dcl type17_size fixed bin; /*mnemonic name item size*/ 4544 dcl file_key_size fixed bin; /*key name itemsize:*/ 4545 dcl key_qual_size fixed bin; /* qualifier itemsize:*/ 4546 /* fixed binary work fields */ 4547 dcl i fixed bin; /* counter for contradiction matrix action routine */ 4548 dcl j fixed bin; /* counter for contradiction matrix action routine */ 4549 dcl n fixed bin; /*pointer to the specified device type in device_name */ 4550 dcl n1 fixed bin; /* temp length of userword.body.word8 */ 4551 dcl tempn1 fixed bin; /* temp field , used immed... thereby avail most anytime */ 4552 dcl temp1 fixed bin; 4553 dcl temp2 fixed bin; 4554 dcl temp3 fixed bin; 4555 dcl temp4 fixed bin; /* work area */ 4556 dcl temp5 fixed bin; 4557 dcl temp6 fixed bin; /* work area */ 4558 dcl num_binary fixed bin; /* numeric literal binary value */ 4559 dcl mrcsz fixed bin; /* minpral file record size */ 4560 4561 declare (samect, samerecct, samesct, samesmct, same_type) 4562 fixed bin init (0); 4563 declare (nat_alf_size, orig_alf_size) 4564 fixed bin; 4565 4566 dcl mult_fil_no fixed bin; 4567 dcl recovaddress fixed bin; 4568 dcl addrform fixed bin; /* number identifying address format from apply clause saved here */ 4569 dcl common_recsize fixed bin; /* size of record just read from common file */ 4570 dcl (common_key, save_common_key) 4571 char (5); /* record number of common record just read or to be read */ 4572 dcl name_key char (5); /* bit strings */ 4573 dcl rerunclock bit (1); /* set on if RERUN ... CLOCK-UNITS specified in program */ 4574 dcl remarksbit bit (1); 4575 dcl debugbit bit (1); 4576 dcl optional_file bit (1); /* set on if OPTIONAL found in SELECT clause for a file */ 4577 dcl external_file bit (1); /* set on if EXTERNAL found in SELECT clause for a file */ 4578 dcl previous_valid_fkeys 4579 bit (1); 4580 dcl implnm_bit bit (1); 4581 dcl ed_found bit (1); /* set on when ENVIRONMENT DIVISION header found */ 4582 dcl console_name bit (1); /* set on when a mnemonic name for CONSOLE is found */ 4583 dcl dec_is_com bit (1); /* set on when decimal-point is comma is found (NOT set when */ 4584 /* decimal-point is decimal-point) */ 4585 dcl dpass_sw bit (1); /* Set on when a special character (such as _ ) is detected */ 4586 4587 4588 /* structures associated with contradiction checking of select statement clauses */ 4589 /* the positional significance of the bits in the 18-bit string is: 4590* (1) assign...H_RD 4591* (2) assign...H_PR 4592* (3) sequential organization 4593* (4) relative organization 4594* (5) indexed organization 4595* (6) non-sequential access (either random or dynamic) 4596* (7) device is printer 4597* (8) device is card-reader 4598* (9) device is card-punch 4599* (10) device is tape 4600* (11) standard record prefix 4601* (12) ssf record prefix 4602* (13) dof record prefix 4603* (14) sysin 4604* (15) sysout 4605* (16) optional 4606* (17) relative key 4607* (18) record key 4608* (19) keyed organization 4609* (20) keyed key 4610* (21) assign...H_SORT */ 4611 dcl array (21) bit (21); 4612 dcl property (21) bit (1); 4613 dcl vector bit (21) based (addr (property)); 4614 dcl vector_temp bit (21); 4615 dcl temp_bit (21) bit (1) based (addr (vector_temp)); 4616 dcl 1 word_array (21), 4617 2 word_size fixed bin, 4618 2 word char (12); 4619 4620 4621 declare fbarray (100000) fixed bin based; 4622 declare bit8 bit (8) based; 4623 declare bit9 bit (9) based; 4624 declare bit512 bit (512) based; 4625 declare bit18 bit (18) based; 4626 declare bit36 bit (36) based; 4627 declare fb fixed bin based; 4628 4629 declare 1 ch based, 4630 2 ch1 char (1), 4631 2 ch2 char (1), 4632 2 ch3 char (1), 4633 2 ch4 char (1); 4634 4635 declare options_bits bit (18); 4636 4637 declare (lead_trail, file_org, file_qual, opt_num, fq, ord_num, alf_range, ord_max, curr_ord_num, sep_sign, key, 4638 apply_num, max, left_number, right_number, wnum, comp_num, obj_comp_num, source_comp_num, alf_type, alf_size, 4639 alf_num, high_value_value, alphabet_name_size, cat_type, file_acc, last_clause, clause_order, clause_num, 4640 seg_lim, int_res, comp_name, source_comp_name, obj_comp_name, acc_dev_num, disp_dev_num, queue_name, comp_type) 4641 fixed bin; 4642 4643 declare tran_tab (0:511) fixed bin; 4644 declare nat_bits (0:511) bit (1); 4645 4646 declare coll_seq char (128); 4647 4648 declare 1 indicators, 4649 2 dec_com bit (1), 4650 2 dup_alf_value bit (1), 4651 2 ignore_file bit (1), 4652 2 rel_key bit (1), 4653 2 rec_key bit (1), 4654 2 one_one_bit bit (1), 4655 2 dup_alpha_value bit (1), 4656 2 ssf_ind bit (1), 4657 2 flr_ind bit (1), 4658 2 vlr_ind bit (1), 4659 2 bsn_ind bit (1), 4660 2 sk_ind bit (1), 4661 2 span_ind bit (1), 4662 2 obj_com bit (1); 4663 4664 declare (file_ptr, alpha_ptr, def_ptr, char1_ptr) 4665 ptr; 4666 4667 declare (clause_bits, switch_bits, defaults, dev_bits, alph_bits) 4668 bit (36); 4669 4670 declare 1 left, 4671 2 type fixed bin, 4672 2 line fixed bin, 4673 2 column fixed bin, 4674 2 number fixed bin, 4675 2 num fixed bin, 4676 2 name char (32) varying; 4677 4678 declare 1 right, 4679 2 type fixed bin, 4680 2 line fixed bin, 4681 2 column fixed bin, 4682 2 number fixed bin, 4683 2 num fixed bin, 4684 2 name char (32) varying; 4685 4686 declare 1 left_char_spec, 4687 2 type fixed bin, 4688 2 value fixed bin, 4689 2 char char (256) varying; 4690 4691 declare 1 right_char_spec, 4692 2 type fixed bin, 4693 2 value fixed bin, 4694 2 char char (256) varying; 4695 4696 declare res fixed bin; 4697 declare dst bit (3) init ("0"b); 4698 declare currsign char (1); 4699 declare objsign char (1); 4700 declare char1 char (1); 4701 declare alf_name char (32) varying; 4702 4703 declare 1 pcs, /* program collating sequence */ 4704 2 type fixed bin, 4705 2 line fixed bin, 4706 2 column fixed bin, 4707 2 num fixed bin, 4708 2 name char (32) varying; 4709 4710 declare cobol_set_type40_$ebcdic 4711 entry (ptr); 4712 declare cobol_imp_word$device_name 4713 entry (ptr) returns (fixed bin); 4714 declare cobol_imp_word$printer_control 4715 entry (ptr) returns (fixed bin); 4716 declare cobol_imp_word$computer_name 4717 entry (ptr) returns (fixed bin); 4718 declare cobol_imp_word$imp_word 4719 entry (ptr) returns (fixed bin); 4720 declare cobol_imp_word$file_org 4721 entry (ptr) returns (fixed bin); 4722 declare cobol_imp_word$disp_type 4723 entry (ptr) returns (fixed bin); 4724 declare cobol_imp_word$comp_type 4725 entry (ptr) returns (fixed bin); 4726 declare cobol_imp_word$alphabet_name 4727 entry (ptr) returns (fixed bin); 4728 declare cobol_imp_word$switch_name 4729 entry (ptr) returns (fixed bin); 4730 declare cobol_imp_word$io_technique 4731 entry (ptr) returns (fixed bin); 4732 1 1 1 2 /* BEGIN INCLUDE FILE ... cobol_.incl.pl1 */ 1 3 /* last modified Feb 4, 1977 by ORN */ 1 4 1 5 /* This file defines all external data used in the generator phase of Multics Cobol */ 1 6 1 7 /* POINTERS */ 1 8 dcl cobol_$text_base_ptr ptr ext; 1 9 dcl text_base_ptr ptr defined (cobol_$text_base_ptr); 1 10 dcl cobol_$con_end_ptr ptr ext; 1 11 dcl con_end_ptr ptr defined (cobol_$con_end_ptr); 1 12 dcl cobol_$def_base_ptr ptr ext; 1 13 dcl def_base_ptr ptr defined (cobol_$def_base_ptr); 1 14 dcl cobol_$link_base_ptr ptr ext; 1 15 dcl link_base_ptr ptr defined (cobol_$link_base_ptr); 1 16 dcl cobol_$sym_base_ptr ptr ext; 1 17 dcl sym_base_ptr ptr defined (cobol_$sym_base_ptr); 1 18 dcl cobol_$reloc_text_base_ptr ptr ext; 1 19 dcl reloc_text_base_ptr ptr defined (cobol_$reloc_text_base_ptr); 1 20 dcl cobol_$reloc_def_base_ptr ptr ext; 1 21 dcl reloc_def_base_ptr ptr defined (cobol_$reloc_def_base_ptr); 1 22 dcl cobol_$reloc_link_base_ptr ptr ext; 1 23 dcl reloc_link_base_ptr ptr defined (cobol_$reloc_link_base_ptr); 1 24 dcl cobol_$reloc_sym_base_ptr ptr ext; 1 25 dcl reloc_sym_base_ptr ptr defined (cobol_$reloc_sym_base_ptr); 1 26 dcl cobol_$reloc_work_base_ptr ptr ext; 1 27 dcl reloc_work_base_ptr ptr defined (cobol_$reloc_work_base_ptr); 1 28 dcl cobol_$pd_map_ptr ptr ext; 1 29 dcl pd_map_ptr ptr defined (cobol_$pd_map_ptr); 1 30 dcl cobol_$fixup_ptr ptr ext; 1 31 dcl fixup_ptr ptr defined (cobol_$fixup_ptr); 1 32 dcl cobol_$initval_base_ptr ptr ext; 1 33 dcl initval_base_ptr ptr defined (cobol_$initval_base_ptr); 1 34 dcl cobol_$initval_file_ptr ptr ext; 1 35 dcl initval_file_ptr ptr defined (cobol_$initval_file_ptr); 1 36 dcl cobol_$perform_list_ptr ptr ext; 1 37 dcl perform_list_ptr ptr defined (cobol_$perform_list_ptr); 1 38 dcl cobol_$alter_list_ptr ptr ext; 1 39 dcl alter_list_ptr ptr defined (cobol_$alter_list_ptr); 1 40 dcl cobol_$seg_init_list_ptr ptr ext; 1 41 dcl seg_init_list_ptr ptr defined (cobol_$seg_init_list_ptr); 1 42 dcl cobol_$temp_token_area_ptr ptr ext; 1 43 dcl temp_token_area_ptr ptr defined (cobol_$temp_token_area_ptr); 1 44 dcl cobol_$temp_token_ptr ptr ext; 1 45 dcl temp_token_ptr ptr defined (cobol_$temp_token_ptr); 1 46 dcl cobol_$token_block1_ptr ptr ext; 1 47 dcl token_block1_ptr ptr defined (cobol_$token_block1_ptr); 1 48 dcl cobol_$token_block2_ptr ptr ext; 1 49 dcl token_block2_ptr ptr defined (cobol_$token_block2_ptr); 1 50 dcl cobol_$minpral5_ptr ptr ext; 1 51 dcl minpral5_ptr ptr defined (cobol_$minpral5_ptr); 1 52 dcl cobol_$tag_table_ptr ptr ext; 1 53 dcl tag_table_ptr ptr defined (cobol_$tag_table_ptr); 1 54 dcl cobol_$map_data_ptr ptr ext; 1 55 dcl map_data_ptr ptr defined (cobol_$map_data_ptr); 1 56 dcl cobol_$ptr_status_ptr ptr ext; 1 57 dcl ptr_status_ptr ptr defined (cobol_$ptr_status_ptr); 1 58 dcl cobol_$reg_status_ptr ptr ext; 1 59 dcl reg_status_ptr ptr defined (cobol_$reg_status_ptr); 1 60 dcl cobol_$misc_base_ptr ptr ext; 1 61 dcl misc_base_ptr ptr defined (cobol_$misc_base_ptr); 1 62 dcl cobol_$misc_end_ptr ptr ext; 1 63 dcl misc_end_ptr ptr defined (cobol_$misc_end_ptr); 1 64 dcl cobol_$list_ptr ptr ext; 1 65 dcl list_ptr ptr defined (cobol_$list_ptr); 1 66 dcl cobol_$allo1_ptr ptr ext; 1 67 dcl allo1_ptr ptr defined (cobol_$allo1_ptr); 1 68 dcl cobol_$eln_ptr ptr ext; 1 69 dcl eln_ptr ptr defined (cobol_$eln_ptr); 1 70 dcl cobol_$diag_ptr ptr ext; 1 71 dcl diag_ptr ptr defined (cobol_$diag_ptr); 1 72 dcl cobol_$xref_token_ptr ptr ext; 1 73 dcl xref_token_ptr ptr defined (cobol_$xref_token_ptr); 1 74 dcl cobol_$xref_chain_ptr ptr ext; 1 75 dcl xref_chain_ptr ptr defined (cobol_$xref_chain_ptr); 1 76 dcl cobol_$statement_info_ptr ptr ext; 1 77 dcl statement_info_ptr ptr defined (cobol_$statement_info_ptr); 1 78 dcl cobol_$reswd_ptr ptr ext; 1 79 dcl reswd_ptr ptr defined (cobol_$reswd_ptr); 1 80 dcl cobol_$op_con_ptr ptr ext; 1 81 dcl op_con_ptr ptr defined (cobol_$op_con_ptr); 1 82 dcl cobol_$ntbuf_ptr ptr ext; 1 83 dcl ntbuf_ptr ptr defined (cobol_$ntbuf_ptr); 1 84 dcl cobol_$main_pcs_ptr ptr ext; 1 85 dcl main_pcs_ptr ptr defined (cobol_$main_pcs_ptr); 1 86 dcl cobol_$include_info_ptr ptr ext; 1 87 dcl include_info_ptr ptr defined (cobol_$include_info_ptr); 1 88 1 89 /* FIXED BIN */ 1 90 dcl cobol_$text_wd_off fixed bin ext; 1 91 dcl text_wd_off fixed bin defined (cobol_$text_wd_off); 1 92 dcl cobol_$con_wd_off fixed bin ext; 1 93 dcl con_wd_off fixed bin defined (cobol_$con_wd_off); 1 94 dcl cobol_$def_wd_off fixed bin ext; 1 95 dcl def_wd_off fixed bin defined (cobol_$def_wd_off); 1 96 dcl cobol_$def_max fixed bin ext; 1 97 dcl def_max fixed bin defined (cobol_$def_max); 1 98 dcl cobol_$link_wd_off fixed bin ext; 1 99 dcl link_wd_off fixed bin defined (cobol_$link_wd_off); 1 100 dcl cobol_$link_max fixed bin ext; 1 101 dcl link_max fixed bin defined (cobol_$link_max); 1 102 dcl cobol_$sym_wd_off fixed bin ext; 1 103 dcl sym_wd_off fixed bin defined (cobol_$sym_wd_off); 1 104 dcl cobol_$sym_max fixed bin ext; 1 105 dcl sym_max fixed bin defined (cobol_$sym_max); 1 106 dcl cobol_$reloc_text_max fixed bin(24) ext; 1 107 dcl reloc_text_max fixed bin(24) defined (cobol_$reloc_text_max); 1 108 dcl cobol_$reloc_def_max fixed bin(24) ext; 1 109 dcl reloc_def_max fixed bin(24) defined (cobol_$reloc_def_max); 1 110 dcl cobol_$reloc_link_max fixed bin(24) ext; 1 111 dcl reloc_link_max fixed bin(24) defined (cobol_$reloc_link_max); 1 112 dcl cobol_$reloc_sym_max fixed bin(24) ext; 1 113 dcl reloc_sym_max fixed bin(24) defined (cobol_$reloc_sym_max); 1 114 dcl cobol_$reloc_work_max fixed bin(24) ext; 1 115 dcl reloc_work_max fixed bin(24) defined (cobol_$reloc_work_max); 1 116 dcl cobol_$pd_map_index fixed bin ext; 1 117 dcl pd_map_index fixed bin defined (cobol_$pd_map_index); 1 118 dcl cobol_$cobol_data_wd_off fixed bin ext; 1 119 dcl cobol_data_wd_off fixed bin defined (cobol_$cobol_data_wd_off); 1 120 dcl cobol_$stack_off fixed bin ext; 1 121 dcl stack_off fixed bin defined (cobol_$stack_off); 1 122 dcl cobol_$max_stack_off fixed bin ext; 1 123 dcl max_stack_off fixed bin defined (cobol_$max_stack_off); 1 124 dcl cobol_$init_stack_off fixed bin ext; 1 125 dcl init_stack_off fixed bin defined (cobol_$init_stack_off); 1 126 dcl cobol_$pd_map_sw fixed bin ext; 1 127 dcl pd_map_sw fixed bin defined (cobol_$pd_map_sw); 1 128 dcl cobol_$next_tag fixed bin ext; 1 129 dcl next_tag fixed bin defined (cobol_$next_tag); 1 130 dcl cobol_$data_init_flag fixed bin ext; 1 131 dcl data_init_flag fixed bin defined (cobol_$data_init_flag); 1 132 dcl cobol_$seg_init_flag fixed bin ext; 1 133 dcl seg_init_flag fixed bin defined (cobol_$seg_init_flag); 1 134 dcl cobol_$alter_flag fixed bin ext; 1 135 dcl alter_flag fixed bin defined (cobol_$alter_flag); 1 136 dcl cobol_$sect_eop_flag fixed bin ext; 1 137 dcl sect_eop_flag fixed bin defined (cobol_$sect_eop_flag); 1 138 dcl cobol_$para_eop_flag fixed bin ext; 1 139 dcl para_eop_flag fixed bin defined (cobol_$para_eop_flag); 1 140 dcl cobol_$priority_no fixed bin ext; 1 141 dcl priority_no fixed bin defined (cobol_$priority_no); 1 142 dcl cobol_$compile_count fixed bin ext; 1 143 dcl compile_count fixed bin defined (cobol_$compile_count); 1 144 dcl cobol_$ptr_assumption_ind fixed bin ext; 1 145 dcl ptr_assumption_ind fixed bin defined (cobol_$ptr_assumption_ind); 1 146 dcl cobol_$reg_assumption_ind fixed bin ext; 1 147 dcl reg_assumption_ind fixed bin defined (cobol_$reg_assumption_ind); 1 148 dcl cobol_$perform_para_index fixed bin ext; 1 149 dcl perform_para_index fixed bin defined (cobol_$perform_para_index); 1 150 dcl cobol_$perform_sect_index fixed bin ext; 1 151 dcl perform_sect_index fixed bin defined (cobol_$perform_sect_index); 1 152 dcl cobol_$alter_index fixed bin ext; 1 153 dcl alter_index fixed bin defined (cobol_$alter_index); 1 154 dcl cobol_$list_off fixed bin ext; 1 155 dcl list_off fixed bin defined (cobol_$list_off); 1 156 dcl cobol_$constant_offset fixed bin ext; 1 157 dcl constant_offset fixed bin defined (cobol_$constant_offset); 1 158 dcl cobol_$misc_max fixed bin ext; 1 159 dcl misc_max fixed bin defined (cobol_$misc_max); 1 160 dcl cobol_$pd_map_max fixed bin ext; 1 161 dcl pd_map_max fixed bin defined (cobol_$pd_map_max); 1 162 dcl cobol_$map_data_max fixed bin ext; 1 163 dcl map_data_max fixed bin defined (cobol_$map_data_max); 1 164 dcl cobol_$fixup_max fixed bin ext; 1 165 dcl fixup_max fixed bin defined (cobol_$fixup_max); 1 166 dcl cobol_$tag_table_max fixed bin ext; 1 167 dcl tag_table_max fixed bin defined (cobol_$tag_table_max); 1 168 dcl cobol_$temp_token_max fixed bin ext; 1 169 dcl temp_token_max fixed bin defined (cobol_$temp_token_max); 1 170 dcl cobol_$allo1_max fixed bin ext; 1 171 dcl allo1_max fixed bin defined (cobol_$allo1_max); 1 172 dcl cobol_$eln_max fixed bin ext; 1 173 dcl eln_max fixed bin defined (cobol_$eln_max); 1 174 dcl cobol_$debug_enable fixed bin ext; 1 175 dcl debug_enable fixed bin defined (cobol_$debug_enable); 1 176 dcl cobol_$non_source_offset fixed bin ext; 1 177 dcl non_source_offset fixed bin defined (cobol_$non_source_offset); 1 178 dcl cobol_$initval_flag fixed bin ext; 1 179 dcl initval_flag fixed bin defined (cobol_$initval_flag); 1 180 dcl cobol_$date_compiled_sw fixed bin ext; 1 181 dcl date_compiled_sw fixed bin defined (cobol_$date_compiled_sw); 1 182 dcl cobol_$include_cnt fixed bin ext; 1 183 dcl include_cnt fixed bin defined (cobol_$include_cnt); 1 184 dcl cobol_$fs_charcnt fixed bin ext; 1 185 dcl fs_charcnt fixed bin defined (cobol_$fs_charcnt); 1 186 dcl cobol_$ws_charcnt fixed bin ext; 1 187 dcl ws_charcnt fixed bin defined (cobol_$ws_charcnt); 1 188 dcl cobol_$coms_charcnt fixed bin ext; 1 189 dcl coms_charcnt fixed bin defined (cobol_$coms_charcnt); 1 190 dcl cobol_$ls_charcnt fixed bin ext; 1 191 dcl ls_charcnt fixed bin defined (cobol_$ls_charcnt); 1 192 dcl cobol_$cons_charcnt fixed bin ext; 1 193 dcl cons_charcnt fixed bin defined (cobol_$cons_charcnt); 1 194 dcl cobol_$value_cnt fixed bin ext; 1 195 dcl value_cnt fixed bin defined (cobol_$value_cnt); 1 196 dcl cobol_$cd_cnt fixed bin ext; 1 197 dcl cd_cnt fixed bin defined (cobol_$cd_cnt); 1 198 dcl cobol_$fs_wdoff fixed bin ext; 1 199 dcl fs_wdoff fixed bin defined (cobol_$fs_wdoff); 1 200 dcl cobol_$ws_wdoff fixed bin ext; 1 201 dcl ws_wdoff fixed bin defined (cobol_$ws_wdoff); 1 202 dcl cobol_$coms_wdoff fixed bin ext; 1 203 dcl coms_wdoff fixed bin defined (cobol_$coms_wdoff); 1 204 1 205 /* CHARACTER */ 1 206 dcl cobol_$scratch_dir char (168) aligned ext; 1 207 dcl scratch_dir char (168) aligned defined (cobol_$scratch_dir); /* -42- */ 1 208 dcl cobol_$obj_seg_name char (32) aligned ext; 1 209 dcl obj_seg_name char (32) aligned defined (cobol_$obj_seg_name); /* -8- */ 1 210 1 211 /* BIT */ 1 212 dcl cobol_$xref_bypass bit(1) aligned ext; 1 213 dcl xref_bypass bit(1) aligned defined (cobol_$xref_bypass); /* -1- */ 1 214 dcl cobol_$same_sort_merge_proc bit(1) aligned ext; 1 215 dcl same_sort_merge_proc bit(1) aligned defined (cobol_$same_sort_merge_proc); /* -1- */ 1 216 1 217 1 218 /* END INCLUDE FILE ... cobol_incl.pl1*/ 1 219 1 220 4733 2 1 2 2 /* BEGIN INCLUDE FILE ... cobol_ext_.incl.pl1 */ 2 3 /* Last modified on 06/17/76 by ORN */ 2 4 /* Last modified on 12/28/76 by FCH */ 2 5 /* Last modified on 12/01/80 by FCH */ 2 6 2 7 /* <<< SHARED EXTERNALS INCLUDE FILE >>> */ 2 8 2 9 2 10 dcl cobol_ext_$cobol_afp ptr ext; 2 11 dcl cobol_afp ptr defined ( cobol_ext_$cobol_afp); 2 12 dcl cobol_ext_$cobol_analin_fileno ptr ext; 2 13 dcl cobol_analin_fileno ptr defined ( cobol_ext_$cobol_analin_fileno); 2 14 dcl cobol_ext_$report_first_token ptr ext; 2 15 dcl report_first_token ptr defined( cobol_ext_$report_first_token); 2 16 dcl cobol_ext_$report_last_token ptr ext; 2 17 dcl report_last_token ptr defined ( cobol_ext_$report_last_token); 2 18 dcl cobol_ext_$cobol_eltp ptr ext; 2 19 dcl cobol_eltp ptr defined ( cobol_ext_$cobol_eltp); 2 20 dcl cobol_ext_$cobol_cmfp ptr ext; 2 21 dcl cobol_cmfp ptr defined ( cobol_ext_$cobol_cmfp); 2 22 dcl cobol_ext_$cobol_com_fileno ptr ext; 2 23 dcl cobol_com_fileno ptr defined ( cobol_ext_$cobol_com_fileno); 2 24 dcl cobol_ext_$cobol_com_ptr ptr ext; 2 25 dcl cobol_com_ptr ptr defined ( cobol_ext_$cobol_com_ptr); 2 26 dcl cobol_ext_$cobol_dfp ptr ext; 2 27 dcl cobol_dfp ptr defined ( cobol_ext_$cobol_dfp); 2 28 dcl cobol_ext_$cobol_hfp ptr ext; 2 29 dcl cobol_hfp ptr defined ( cobol_ext_$cobol_hfp); 2 30 dcl cobol_ext_$cobol_m1fp ptr ext; 2 31 dcl cobol_m1fp ptr defined ( cobol_ext_$cobol_m1fp); 2 32 dcl cobol_ext_$cobol_m2fp ptr ext; 2 33 dcl cobol_m2fp ptr defined ( cobol_ext_$cobol_m2fp); 2 34 dcl cobol_ext_$cobol_min1_fileno ptr ext; 2 35 dcl cobol_min1_fileno ptr defined ( cobol_ext_$cobol_min1_fileno); 2 36 dcl cobol_ext_$cobol_min2_fileno_ptr ptr ext; 2 37 dcl cobol_min2_fileno_ptr ptr defined ( cobol_ext_$cobol_min2_fileno_ptr); 2 38 dcl cobol_ext_$cobol_name_fileno ptr ext; 2 39 dcl cobol_name_fileno ptr defined ( cobol_ext_$cobol_name_fileno); 2 40 dcl cobol_ext_$cobol_name_fileno_ptr ptr ext; 2 41 dcl cobol_name_fileno_ptr ptr defined ( cobol_ext_$cobol_name_fileno_ptr); 2 42 dcl cobol_ext_$cobol_ntfp ptr ext; 2 43 dcl cobol_ntfp ptr defined ( cobol_ext_$cobol_ntfp); 2 44 dcl cobol_ext_$cobol_pdofp ptr ext; 2 45 dcl cobol_pdofp ptr defined ( cobol_ext_$cobol_pdofp); 2 46 dcl cobol_ext_$cobol_pfp ptr ext; 2 47 dcl cobol_pfp ptr defined ( cobol_ext_$cobol_pfp); 2 48 dcl cobol_ext_$cobol_rm2fp ptr ext; 2 49 dcl cobol_rm2fp ptr defined ( cobol_ext_$cobol_rm2fp); 2 50 dcl cobol_ext_$cobol_rmin2fp ptr ext; 2 51 dcl cobol_rmin2fp ptr defined ( cobol_ext_$cobol_rmin2fp); 2 52 dcl cobol_ext_$cobol_curr_in ptr ext; 2 53 dcl cobol_curr_in ptr defined ( cobol_ext_$cobol_curr_in); 2 54 dcl cobol_ext_$cobol_curr_out ptr ext; 2 55 dcl cobol_curr_out ptr defined ( cobol_ext_$cobol_curr_out); 2 56 dcl cobol_ext_$cobol_sfp ptr ext; 2 57 dcl cobol_sfp ptr defined ( cobol_ext_$cobol_sfp); 2 58 dcl cobol_ext_$cobol_w1p ptr ext; 2 59 dcl cobol_w1p ptr defined ( cobol_ext_$cobol_w1p); 2 60 dcl cobol_ext_$cobol_w2p ptr ext; 2 61 dcl cobol_w2p ptr defined ( cobol_ext_$cobol_w2p); 2 62 dcl cobol_ext_$cobol_w3p ptr ext; 2 63 dcl cobol_w3p ptr defined ( cobol_ext_$cobol_w3p); 2 64 dcl cobol_ext_$cobol_w5p ptr ext; 2 65 dcl cobol_w5p ptr defined ( cobol_ext_$cobol_w5p); 2 66 dcl cobol_ext_$cobol_w6p ptr ext; 2 67 dcl cobol_w6p ptr defined ( cobol_ext_$cobol_w6p); 2 68 dcl cobol_ext_$cobol_w7p ptr ext; 2 69 dcl cobol_w7p ptr defined ( cobol_ext_$cobol_w7p); 2 70 dcl cobol_ext_$cobol_x3fp ptr ext; 2 71 dcl cobol_x3fp ptr defined ( cobol_ext_$cobol_x3fp); 2 72 dcl cobol_ext_$cobol_rwdd ptr ext; 2 73 dcl cobol_rwdd ptr defined(cobol_ext_$cobol_rwdd); 2 74 dcl cobol_ext_$cobol_rwpd ptr ext; 2 75 dcl cobol_rwpd ptr defined(cobol_ext_$cobol_rwpd); 2 76 2 77 2 78 dcl cobol_ext_$cobol_fileno1 fixed bin(24)ext; 2 79 dcl cobol_fileno1 fixed bin(24)defined ( cobol_ext_$cobol_fileno1); 2 80 dcl cobol_ext_$cobol_options_len fixed bin(24)ext; 2 81 dcl cobol_options_len fixed bin(24)defined ( cobol_ext_$cobol_options_len); 2 82 dcl cobol_ext_$cobol_pdout_fileno fixed bin(24)ext; 2 83 dcl cobol_pdout_fileno fixed bin(24)defined ( cobol_ext_$cobol_pdout_fileno); 2 84 dcl cobol_ext_$cobol_print_fileno fixed bin(24)ext; 2 85 dcl cobol_print_fileno fixed bin(24)defined ( cobol_ext_$cobol_print_fileno); 2 86 dcl cobol_ext_$cobol_rmin2_fileno fixed bin(24)ext; 2 87 dcl cobol_rmin2_fileno fixed bin(24)defined ( cobol_ext_$cobol_rmin2_fileno); 2 88 dcl cobol_ext_$cobol_x1_fileno fixed bin(24)ext; 2 89 dcl cobol_x1_fileno fixed bin(24)defined ( cobol_ext_$cobol_x1_fileno); 2 90 dcl cobol_ext_$cobol_x2_fileno fixed bin(24)ext; 2 91 dcl cobol_x2_fileno fixed bin(24)defined ( cobol_ext_$cobol_x2_fileno); 2 92 dcl cobol_ext_$cobol_x3_fileno fixed bin(24)ext; 2 93 dcl cobol_x3_fileno fixed bin(24)defined ( cobol_ext_$cobol_x3_fileno); 2 94 2 95 dcl cobol_ext_$cobol_lpr char (5) ext; 2 96 dcl cobol_lpr char (5) defined ( cobol_ext_$cobol_lpr); /* -2- */ 2 97 dcl cobol_ext_$cobol_options char (120) ext; 2 98 dcl cobol_options char (120) defined ( cobol_ext_$cobol_options); /* -30- */ 2 99 2 100 dcl cobol_ext_$cobol_xlast8 bit (1) ext; 2 101 dcl cobol_xlast8 bit (1) defined ( cobol_ext_$cobol_xlast8); /* -1- */ 2 102 dcl cobol_ext_$report_exists bit (1) ext; 2 103 dcl report_exists bit (1) defined ( cobol_ext_$report_exists); 2 104 2 105 2 106 /* <<< END OF SHARED EXTERNALS INCLUDE FILE >>> */ 2 107 /* END INCLUDE FILE ... cobol_ext_.incl.pl1 */ 2 108 4734 3 1 3 2 /* BEGIN INCLUDE FILE ... cobol_fixed_common.incl.pl1 */ 3 3 /* Modified on 10/27/82 by FCH, [5.1-1], cobol_cln added to save last line num, BUG543(phx13643) */ 3 4 /* Modified on 07/31/80 by FCH, [4.3-1], use_reporting field added for Report Writer */ 3 5 /* Modified on 03/30/79 by FCH, [4.1-1], -card option added */ 3 6 /* Modified on 03/30/79 by FCH, [4.0-2], -svNM option added */ 3 7 /* Modified on 03/02/79 by FCH, [4.0-1], -levNM option added */ 3 8 /* Modified by RAL on 10/13/78, [4.0-0], Added option exp from fil2. */ 3 9 /* Modified by BC on 06/20/77, descriptor added. */ 3 10 /* Modified by BC on 06/02/77, init_cd_seg, init_cd_offset added. */ 3 11 /* Modified by BC on 1/21/77, options.profile added. */ 3 12 /* Modified by FCH on 7/6/76, sysin_fno & sysout_fno deleted, accept_device & display_device added */ 3 13 /* Modified by FCH on 5/20/77, comp_level added */ 3 14 3 15 3 16 /* THE SIZE OF THIS STRUCTURE IN BYTES, (EXCLUDING VARIABLE 3 17* LENGTH ENTITIES), FOR EACH HARDWARE IMPLEMENTATION IS: 3 18* 3 19* HARDWARE | SIZE (BYTES) 3 20* --------------------------------- 3 21* 645/6180 | 464 3 22* P7 | 396 3 23* --------------------------------- 3 24* */ 3 25 3 26 dcl 1 fixed_common based ( cobol_com_ptr), 3 27 2 prog_name char (30), 3 28 2 compiler_rev_no char (25), 3 29 2 phase_name char (6), 3 30 2 currency char (1), 3 31 2 fatal_no fixed bin, 3 32 2 warn_no fixed bin, 3 33 2 proc_counter fixed bin, 3 34 2 spec_tag_counter fixed bin, 3 35 2 file_count fixed bin, 3 36 2 filedescr_offsets (20) char (5), 3 37 2 perf_alter_info char (5), 3 38 2 another_perform_info char (5), 3 39 2 sort_in_info char (5), 3 40 2 odo_info char (5), 3 41 2 size_seg fixed bin, 3 42 2 size_offset fixed bin(24), 3 43 2 size_perform_info char (5), 3 44 2 rename_info char (5), 3 45 2 report_names char (5), 3 46 2 rw_buf_seg fixed bin, 3 47 2 rw_buf_offset fixed bin(24), 3 48 2 rw_buf_length fixed bin(24), 3 49 2 file_keys char (5), 3 50 2 search_keys char (5), 3 51 2 dd_seg_size fixed bin(24), 3 52 2 pd_seg_size fixed bin(24), 3 53 2 seg_limit fixed bin , 3 54 2 number_of_dd_segs fixed bin, 3 55 2 seg_info char (5), 3 56 2 number_of_ls_pointers fixed bin, 3 57 2 link_sec_seg fixed bin, 3 58 2 link_sec_offset fixed bin(24), 3 59 2 sra_clauses fixed bin, 3 60 2 fix_up_info char (5), 3 61 2 linage_info char (5), 3 62 2 first_dd_item char (5), 3 63 2 sort_out_info char (5), 3 64 2 db_info char (5), 3 65 2 realm_info char (5), 3 66 2 rc_realm_info char (5), 3 67 2 last_file_key char (5), 3 68 2 prog_coll_seq fixed bin, 3 69 2 init_cd_seg fixed bin, 3 70 2 init_cd_offset fixed bin(24), 3 71 2 input_error_exit fixed bin, 3 72 2 output_error_exit fixed bin, 3 73 2 i_o_error_exit fixed bin, 3 74 2 extend_error_exit fixed bin, 3 75 2 dummy15 fixed bin, 3 76 2 options, 3 77 3 cu bit (1), 3 78 3 st bit (1), 3 79 3 wn bit (1), 3 80 3 obs bit (1), 3 81 3 dm bit (1), 3 82 3 xrl bit (1), 3 83 3 xrn bit (1), 3 84 3 src bit (1), 3 85 3 obj bit (1), 3 86 3 exs bit (1), 3 87 3 sck bit (1), 3 88 3 rno bit (1), 3 89 3 u_l bit (1), 3 90 3 cnv bit (1), 3 91 3 cos bit (1), 3 92 3 fmt bit (1), 3 93 3 profile bit(1), 3 94 3 nw bit (1), 3 95 3 exp bit (1), /* [4.0-0] */ 3 96 3 card bit (1), /*[4.1-1]*/ 3 97 3 fil2 bit (5), 3 98 3 m_map bit (1), 3 99 3 m_bf bit (1), 3 100 3 m_fat bit (1), 3 101 3 m_wn bit (1), 3 102 3 m_obs bit(1), 3 103 3 pd bit(1), 3 104 3 oc bit(1), 3 105 2 supervisor bit (1), 3 106 2 dec_comma bit (1), 3 107 2 init_cd bit (1), 3 108 2 corr bit (1), 3 109 2 initl bit (1), 3 110 2 debug bit (1), 3 111 2 report bit (1), 3 112 2 sync_in_prog bit (1), 3 113 2 pd_section bit (1), 3 114 2 list_switch bit (1), 3 115 2 alpha_cond bit (1), 3 116 2 num_cond bit (1), 3 117 2 spec_sysin bit (1), 3 118 2 spec_sysout bit (1), 3 119 2 cpl_files bit (1), 3 120 2 obj_dec_comma bit (1), 3 121 2 default_sign_type bit (3), 3 122 2 use_debug bit(1), 3 123 2 syntax_trace bit(1), 3 124 2 comp_defaults, 3 125 3 comp bit(1), 3 126 3 comp_1 bit(1), 3 127 3 comp_2 bit(1), 3 128 3 comp_3 bit(1), 3 129 3 comp_4 bit(1), 3 130 3 comp_5 bit(1), 3 131 3 comp_6 bit(1), 3 132 3 comp_7 bit(1), 3 133 3 comp_8 bit(1), 3 134 2 disp_defaults, 3 135 3 disp bit(1), 3 136 3 disp_1 bit(1), 3 137 3 disp_2 bit(1), 3 138 3 disp_3 bit(1), 3 139 3 disp_4 bit(1), 3 140 3 disp_5 bit(1), 3 141 3 disp_6 bit(1), 3 142 3 disp_7 bit(1), 3 143 2 descriptor bit(2), 3 144 2 levsv bit(3), /*[4.0-1]*/ 3 145 2 use_reporting bit(1), /*[4.3-1]*/ 3 146 2 cd bit(1), /*[4.4-1]*/ 3 147 2 dummy17 bit(3), 3 148 2 lvl_rstr bit(32), 3 149 2 inst_rstr bit(32), 3 150 2 comp_level char(1), 3 151 2 dummy18 char(30), 3 152 2 object_sign char (1), 3 153 2 last_print_rec char (5), 3 154 2 coll_seq_info char (5), 3 155 2 sys_status_seg fixed bin, 3 156 2 sys_status_offset fixed bin(24), 3 157 2 compiler_id fixed bin, 3 158 2 date_comp_ln fixed bin, 3 159 2 compile_mode bit(36), 3 160 2 default_temp fixed bin, 3 161 2 accept_device fixed bin, 3 162 2 display_device fixed bin, 3 163 2 cobol_cln fixed bin, /*[5.1-1]*/ 3 164 2 alphabet_offset fixed bin; 3 165 3 166 3 167 3 168 /* END INCLUDE FILE ... cobol_fixed_common.incl.pl1 */ 3 169 4735 4 1 4 2 /* BEGIN INCLUDE FILE ... cobol_file_table.incl.pl1 */ 4 3 /* <<< INCLUDE FILE FOR FILE TABLE IN COMMON >>> */ 4 4 4 5 /* Modified on 09/30/80 by FCH, [4.4-1], density is 6250 is supported */ 4 6 /* Modified on 12/05/78 by RAL, [3.0-3], added dupl_alt from dummy102 */ 4 7 /* Modified on 11/21/78 by RAL, [3.0-2], added space for abs_record_offset from filler */ 4 8 /* Modified on 10/26/78 by RAL, [3.0-1], added space for file_desc_1 table offset from filler */ 4 9 /* <<< LAST MODIFIED ON 06-02-77 by GM >>> */ 4 10 /* <<< LAST MODIFIED ON 05-31-77 by GM >>> */ 4 11 /* <<< LAST MODIFIED ON 06-30-76 by GM >>> */ 4 12 /* <<< LAST MODIFIED ON 06-07-76 by GM >>> */ 4 13 /* <<< LAST MODIFIED ON 11-29-74 by orn >>> */ 4 14 4 15 /* 4 16*A file table is created in variable common for each file selected in the 4 17*environment division. The fields of a given file table provide information 4 18*about the specific file for which the file table is generated. The 4 19*addresses which may be contained in the various "info" fields of the file 4 20*table are addresses in variable common. 4 21**/ 4 22 4 23 /* THE FILE TABLE STRUCTURE */ 4 24 4 25 dcl 1 file_table based (ft_ptr), 4 26 2 next char (5), 4 27 2 ifn char (16), 4 28 2 attach_options_info char(5), /*06/02/77*/ 4 29 2 replacement_info char(5), /*06/02/77*/ 4 30 2 file_id_info char(5), /*05/31/77*/ 4 31 2 retention_info char(5), /*05/31/77*/ 4 32 2 filler0 char (3) , /* [3.0-1] */ 4 33 2 file_desc_1_offset fixed bin (24), /* [3.0-1] */ 4 34 2 abs_record_offset fixed bin (24), /* [3.-02] */ 4 35 2 filler char(5), /* this area is available.*/ 4 36 2 padding_char char (1), 4 37 2 banner_char char (1), 4 38 2 file_status_info char (5), 4 39 2 extra_status_info char (5), 4 40 2 cat_id_info char (5), 4 41 2 r_key_info char (5), 4 42 2 alt_key_info char (5), 4 43 2 rec_do_info char (5), 4 44 2 label_info char (5), 4 45 2 data_info char (5), 4 46 2 report_info char (5), 4 47 2 linage_info char (5), 4 48 2 optional bit (1), /*06/07/76*/ 4 49 2 external bit (1), 4 50 2 file_status bit (1), 4 51 2 extra_status bit (1), 4 52 2 sysin bit (1), 4 53 2 sysout bit (1), 4 54 2 move_mode bit (1), 4 55 2 locate_mode bit (1), 4 56 2 fixed_recs bit (1), 4 57 2 variable_recs bit (1), 4 58 2 spanned_recs bit (1), /*06/07/76*/ 4 59 2 interchange bit (1), /*06/07/76*/ 4 60 2 relative_key bit (1), 4 61 2 record_key bit (1), 4 62 2 even_parity bit (1), 4 63 2 odd_parity bit (1), 4 64 2 padding bit (1), 4 65 2 banner bit (1), 4 66 2 random bit (1), 4 67 2 no_file_lockout bit (1), 4 68 2 no_write_check bit (1), 4 69 2 no_resident_index bit (1), 4 70 2 same_file bit (1), 4 71 2 sort_file bit (1), 4 72 2 rec_do bit (1), 4 73 2 linage bit (1), 4 74 2 code_set_clause bit (1), 4 75 /* history */ 4 76 2 close bit (1), 4 77 2 delete bit (1), 4 78 2 open_in bit (1), 4 79 2 open_out bit (1), 4 80 2 open_io bit (1), 4 81 2 open_ext bit (1), 4 82 2 read bit (1), 4 83 2 release bit (1), 4 84 2 return_bit bit (1), 4 85 2 rewrite bit (1), 4 86 2 sort bit (1), 4 87 2 start bit (1), 4 88 2 use_error bit (1), 4 89 2 write bit (1), 4 90 2 read_next bit (1), 4 91 2 read_key bit (1), 4 92 2 accept bit (1), 4 93 2 display bit (1), 4 94 2 unequal_recs bit (1), 4 95 2 dummy_sysin bit (1), 4 96 2 dummy_sysout bit (1), 4 97 2 file_no fixed bin, 4 98 2 uca_offset fixed bin(24), 4 99 2 cra_seg fixed bin, 4 100 2 cra_offset fixed bin(24), 4 101 2 max_cra_size fixed bin(24), 4 102 2 catalogued fixed bin, 4 103 2 organization fixed bin, 4 104 2 org_qual fixed bin, 4 105 2 access fixed bin, 4 106 2 buffers fixed bin, 4 107 2 device fixed bin, 4 108 2 record_prefix fixed bin, /*06/07/76*/ 4 109 2 alternate_keys fixed bin, 4 110 2 record_format fixed bin, 4 111 2 label_format fixed bin, 4 112 2 key_location fixed bin, 4 113 2 key_size fixed bin, 4 114 2 temporary fixed bin, 4 115 2 address_format fixed bin, 4 116 2 same_area_clause fixed bin, 4 117 2 same_rec_clause fixed bin, 4 118 2 same_sort_clause fixed bin, 4 119 2 mult_clause_no fixed bin, 4 120 2 mult_position_no fixed bin, 4 121 2 block_desc fixed bin, 4 122 2 block_min fixed bin(24), 4 123 2 block_max fixed bin(24), 4 124 2 rec_min fixed bin(24), 4 125 2 rec_max fixed bin(24), 4 126 2 label_count fixed bin, 4 127 2 ifn_size fixed bin, 4 128 2 data_count fixed bin, 4 129 2 report_count fixed bin, 4 130 2 code_set fixed bin, 4 131 2 error_exit fixed bin, 4 132 2 prefix_size fixed bin, 4 133 2 blocked bit (1), 4 134 2 variable bit (1), 4 135 2 unbannered bit (1), 4 136 2 prefix_clause bit (1), 4 137 2 symbolic bit (1), 4 138 2 address_format_bit bit (1), 4 139 2 bsn bit(1), /*06/07/76*/ 4 140 2 process_area bit(1), /*06/07/76*/ 4 141 2 dupl_alt bit (1), /* [3.0-3] */ 4 142 2 dummy102 bit (23), 4 143 2 name_size fixed bin, 4 144 2 name char(32), 4 145 2 id char(32), 4 146 2 temp bit(1) , 4 147 2 perm bit(1) , 4 148 2 attach bit(1) , 4 149 2 detach bit(1) , 4 150 2 fsb , /* file state block */ 4 151 3 seg fixed bin(24), /* internal addr */ 4 152 3 off fixed bin(24), 4 153 2 tape, 4 154 3 density bit(1) , /* 0-hi 1-lo */ 4 155 3 retain bit(1), /* 0 not retained across attachment, 1 retained */ 4 156 3 force bit(1), /* 0 check retention date, 1 no check */ 4 157 3 protect bit(1) , /* 0-no 1-yes */ 4 158 3 den_6250 bit(1), /* 0-no 1-yes */ /*[4.4-1]*/ 4 159 2 cat_nm char(200), 4 160 2 ao_len fixed bin(24), /* attach options */ 4 161 2 ao_string char(256), 4 162 2 output_mode fixed bin, /* 0 not specified 4 163* 1 generation 4 164* 2 modification 4 165* 3 replacement literal 4 166* 4 replacement dataname */ 4 167 2 om_len fixed bin, /* length of output mode */ 4 168 2 om_string char(17), 4 169 2 tape_device fixed bin, /* 0 not specified 4 170* 1 integer 4 171* 2 dataname */ 4 172 2 tape_device_num fixed bin, 4 173 2 tape_device_key char(5), 4 174 2 add_cat_key char(5); 4 175 4 176 4 177 /* END INCLUDE FILE ... cobol_file_table.incl.pl1 */ 4 178 4736 5 1 5 2 /* BEGIN INCLUDE FILE ... cobol_file_key.incl.pl1 */ 5 3 /* Last modified on 03/30/78 by FCH */ 5 4 5 5 /* 5 6*A file key record is created in variable common for any one of several 5 7*data items which may be associated with a file name. The key_type field in 5 8*the file key record identifies the type of item for which the record is 5 9*created. The name in a file key record is resolved by the replacement 5 10*phase, and a section of the type 9 entry in the name table for the 5 11*specified data item is stored in the file key record. The stored 5 12*description is subsequently used by the generator phase. 5 13**/ 5 14 5 15 /* THE FILE KEY RECORD STRUCTURE */ 5 16 5 17 dcl 1 file_key based (fkey_ptr), 5 18 2 next char(5), 5 19 2 next_alt char(5), 5 20 2 qual char(5), 5 21 2 info, 5 22 3 duplicates bit(1), 5 23 3 filler bit(7), 5 24 2 file_no fixed bin, 5 25 2 key_type fixed bin, 5 26 2 line fixed bin, 5 27 2 column fixed bin, 5 28 2 temp_seg fixed bin, 5 29 2 temp_offset fixed bin(24), 5 30 2 desc char(40), 5 31 2 name_size fixed bin, 5 32 2 name char(0 refer(file_key.name_size)); 5 33 5 34 /* END INCLUDE FILE ... cobol_file_key.incl.pl1 */ 5 35 4737 6 1 6 2 /* BEGIN INCLUDE FILE ... cobol_type1.incl.pl1 */ 6 3 /* Last modified on 11/19/76 by ORN */ 6 4 6 5 /* 6 6*A reserved word token is created in the minpral files for each occurrence 6 7*of a reserved word in the source program. The value of the key field 6 8*indicates the specific reserved word which a type 1 token represents. 6 9**/ 6 10 6 11 dcl rw_ptr ptr; 6 12 6 13 /* BEGIN DECLARATION OF TYPE1 (RESERVED WORD) TOKEN */ 6 14 dcl 1 reserved_word based (rw_ptr), 7 1 7 2 /* begin include file ... cobol_TYPE1.incl.pl1 */ 7 3 /* Last modified on 11/17/76 by ORN */ 7 4 /* Last modified on 12/28/76 by FCH */ 7 5 /* Last modified on 12/16/80 by FCH */ 7 6 7 7 /* header */ 7 8 2 size fixed bin, 7 9 2 line fixed bin, 7 10 2 column fixed bin, 7 11 2 type fixed bin, 7 12 /* body */ 7 13 2 key fixed bin, 7 14 /* procedure division class bits */ 7 15 2 verb bit (1), 7 16 2 arith_op bit (1), 7 17 2 figcon bit (1), 7 18 2 terminator bit (1), 7 19 2 end_dec bit (1), 7 20 2 rel_op bit (1), 7 21 2 imper_verb bit (1), 7 22 2 end_cobol bit (1), 7 23 /* data division class bits */ 7 24 2 section_header bit (1), 7 25 2 fs_ind bit (1), 7 26 2 fd_clause bit (1), 7 27 2 dd_clause bit (1), 7 28 2 cd_input bit (1), 7 29 2 cd_output bit (1), 7 30 2 cset_name bit (1), 7 31 2 ss_division bit (1), 7 32 2 repl_jump_ind bit (4), 7 33 2 ided_recovery bit (1), 7 34 2 report_writer bit (5), 7 35 2 ss_desc_entry bit (1), 7 36 2 jump_index fixed bin, 7 37 2 length fixed bin, 7 38 2 name char(0 refer(reserved_word.length)); 7 39 7 40 7 41 7 42 /* end include file ... cobol_TYPE1.incl.pl1 */ 7 43 6 15 6 16 /* END DECLARATION OF TYPE1 (RESERVED WORD) TOKEN */ 6 17 6 18 /* END INCLUDE FILE ... cobol_type1.incl.pl1 */ 6 19 4738 8 1 8 2 /* BEGIN INCLUDE FILE ... cobol_type2.incl.pl1 */ 8 3 /* Last modified on 11/19/76 by ORN */ 8 4 8 5 /* 8 6*A type 2 numeric literal token is entered into the minpral file by the 8 7*lexical analysis phase for each numeric literal encountered in the source 8 8*program. 8 9**/ 8 10 8 11 dcl nlit_ptr ptr; 8 12 8 13 /* BEGIN DECLARATION OF TYPE2 (NUMERIC LITERAL) TOKEN */ 8 14 dcl 1 numeric_lit based (nlit_ptr), 9 1 9 2 /* begin include file ... cobol_TYPE2.incl.pl1 */ 9 3 /* Last modified on 12/28/76 by FCH */ 9 4 9 5 /* header */ 9 6 2 size fixed bin, 9 7 2 line fixed bin, 9 8 2 column fixed bin, 9 9 2 type fixed bin, 9 10 /* body */ 9 11 2 integral bit(1), 9 12 2 floating bit(1), 9 13 2 seg_range bit(1), 9 14 2 filler1 bit(4), 9 15 2 subscript bit(1), 9 16 2 sign char(1), 9 17 2 exp_sign char(1), 9 18 2 exp_places fixed bin, 9 19 2 places_left fixed bin, 9 20 2 places_right fixed bin, 9 21 2 places fixed bin, 9 22 2 literal char(0 refer(numeric_lit.places)); 9 23 9 24 9 25 9 26 /* end include file ... cobol_TYPE2.incl.pl1 */ 9 27 8 15 8 16 /* END DECLARATION OF TYPE2 (NUMERIC LITERAL) TOKEN */ 8 17 8 18 /* END INCLUDE FILE ... cobol_type2.incl.pl1 */ 8 19 4739 10 1 10 2 /* BEGIN INCLUDE FILE ... cobol_type3.incl.pl1 */ 10 3 /* Last modified on 11/19/76 by ORN */ 10 4 10 5 /* 10 6*A type 3 alphanumeric literal token is entered into the minpral file by the 10 7*lexical analysis phase for each alphanumeric literal encountered in the 10 8*source program. 10 9**/ 10 10 10 11 dcl alit_ptr ptr; 10 12 10 13 /* BEGIN DECLARATION OR TYPE3 (ALPHANUMERIC LITERAL) TOKEN */ 10 14 dcl 1 alphanum_lit based (alit_ptr), 11 1 11 2 /* begin include file ... cobol_TYPE3.incl.pl1 */ 11 3 /* Last modified on 11/17/76 by ORN */ 11 4 /* Last modified on 12/28/76 by FCH */ 11 5 11 6 /* header */ 11 7 2 size fixed bin, 11 8 2 line fixed bin, 11 9 2 column fixed bin, 11 10 2 type fixed bin, 11 11 /* body */ 11 12 2 lit_type bit (1), 11 13 2 all_lit bit (1), 11 14 2 filler1 bit (6), 11 15 2 lit_size fixed bin, 11 16 2 string char(0 refer(alphanum_lit.lit_size)); 11 17 11 18 11 19 11 20 /* end include file ... cobol_TYPE3.incl.pl1 */ 11 21 10 15 10 16 /* END DECLARATION OF TYPE3 (ALPHANUMERIC LITERAL) TOKEN */ 10 17 10 18 /* END INCLUDE FILE ... cobol_type3.incl.pl1 */ 10 19 4740 4741 declare 1 user_word based (p2), 12 1 12 2 /* begin include file ... cobol_TYPE.incl.pl1 */ 12 3 /* Last modified on 11/17/76 by ORN */ 12 4 12 5 /* header */ 12 6 2 size fixed bin, 12 7 2 line fixed bin, 12 8 2 column fixed bin, 12 9 2 type fixed bin, 12 10 /* body */ 12 11 2 info bit (8), 12 12 2 length fixed bin, 12 13 2 word char (0 refer(user_word.length)); 12 14 12 15 /* end include file ... cobol_TYPE8.incl.pl1 */ 12 16 4742 4743 declare 1 alphabet_name based (alpha_ptr), 13 1 13 2 /* begin include file ... cobol_TYPE40.incl.pl1 */ 13 3 /* Last modified on 11/17/76 by ORN */ 13 4 13 5 /* header */ 13 6 2 size fixed bin, 13 7 2 line fixed bin, 13 8 2 column fixed bin, 13 9 2 type fixed bin, 13 10 /* body */ 13 11 2 string_ptr ptr, 13 12 2 prev_rec ptr, 13 13 2 info, 13 14 3 repl bit(8), 13 15 3 one_one bit(1), 13 16 3 onto bit(1), 13 17 2 hival_char char(1), 13 18 2 loval_char char(1), 13 19 2 iw_key fixed bin, 13 20 2 def_line fixed bin, 13 21 2 char_size fixed bin, 13 22 2 hi_value char(1), 13 23 2 segno fixed bin, 13 24 2 offset fixed bin, 13 25 2 dn_offset fixed bin, 13 26 2 table char(512), 13 27 2 name_size fixed bin, 13 28 2 name char(0 refer(alphabet_name.name_size)); 13 29 13 30 /* end include file ... cobol_TYPE40.incl.pl1 */ 13 31 4744 14 1 14 2 /* BEGIN INCLUDE FILE ... cobol_type17.incl.pl1 */ 14 3 /* Last modified on 11/19/76 by ORN */ 14 4 14 5 /* 14 6*A mnemonic name token is created for each user-defined mnemonic name 14 7*specified in the special-names paragraph. 14 8**/ 14 9 14 10 /* dcl name_ptr ptr; */ 14 11 14 12 /* BEGIN DECLARATION OF TYPE17 (MNEMONIC NAME) TOKEN */ 14 13 dcl 1 mnemonic_name based (name_ptr), 15 1 15 2 /* begin include file ... cobol_TYPE17.incl.pl1 */ 15 3 /* Last modified on 11/17/76 by ORN */ 15 4 15 5 /* header */ 15 6 2 size fixed bin, 15 7 2 line fixed bin, 15 8 2 column fixed bin, 15 9 2 type fixed bin, 15 10 /* body */ 15 11 2 string_ptr ptr, 15 12 2 prev_rec ptr, 15 13 2 info bit(8), 15 14 2 class, 15 15 3 switch_condition bit(1), 15 16 3 switch_name bit(1), 15 17 3 accept_device bit(1), 15 18 3 display_device bit(1), 15 19 3 printer_control bit(1), 15 20 3 alphabet_name bit(1), 15 21 2 on_status bit(1), 15 22 2 off_status bit(1), 15 23 2 def_line fixed bin, 15 24 2 iw_key fixed bin, 15 25 2 reserved bit(36), 15 26 2 alphabet_offset fixed bin, 15 27 2 name_size fixed bin, 15 28 2 name char(0 refer (mnemonic_name.name_size)); 15 29 15 30 15 31 /* end include file ... cobol_TYPE17.incl.pl1 */ 15 32 14 14 14 15 /* END DECLARATION OF TYPE17 (MNEMONIC NAME) TOKEN */ 14 16 14 17 /* END INCLUDE FILE ... cobol_type17.incl.pl1 */ 14 18 4745 4746 4747 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0835.2 cobol_idedsyn.pl1 >spec>install>MR12.3-1048>cobol_idedsyn.pl1 4733 1 11/11/82 1712.7 cobol_.incl.pl1 >ldd>include>cobol_.incl.pl1 4734 2 03/27/82 0431.3 cobol_ext_.incl.pl1 >ldd>include>cobol_ext_.incl.pl1 4735 3 11/11/82 1712.8 cobol_fixed_common.incl.pl1 >ldd>include>cobol_fixed_common.incl.pl1 4736 4 11/11/82 1712.7 cobol_file_table.incl.pl1 >ldd>include>cobol_file_table.incl.pl1 4737 5 11/11/82 1712.8 cobol_file_key.incl.pl1 >ldd>include>cobol_file_key.incl.pl1 4738 6 03/27/82 0439.8 cobol_type1.incl.pl1 >ldd>include>cobol_type1.incl.pl1 6-15 7 11/11/82 1712.8 cobol_TYPE1.incl.pl1 >ldd>include>cobol_TYPE1.incl.pl1 4739 8 03/27/82 0439.8 cobol_type2.incl.pl1 >ldd>include>cobol_type2.incl.pl1 8-15 9 11/11/82 1712.8 cobol_TYPE2.incl.pl1 >ldd>include>cobol_TYPE2.incl.pl1 4740 10 03/27/82 0439.8 cobol_type3.incl.pl1 >ldd>include>cobol_type3.incl.pl1 10-15 11 11/11/82 1712.8 cobol_TYPE3.incl.pl1 >ldd>include>cobol_TYPE3.incl.pl1 4742 12 03/27/82 0439.6 cobol_TYPE8.incl.pl1 >ldd>include>cobol_TYPE8.incl.pl1 4744 13 11/11/82 1712.8 cobol_TYPE40.incl.pl1 >ldd>include>cobol_TYPE40.incl.pl1 4745 14 03/27/82 0439.8 cobol_type17.incl.pl1 >ldd>include>cobol_type17.incl.pl1 14-14 15 11/11/82 1712.8 cobol_TYPE17.incl.pl1 >ldd>include>cobol_TYPE17.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. L 003614 automatic fixed bin(17,0) dcl 3437 in procedure "range" set ref 3451* 3453 3456 3456 3508* 3514 3514 L 003560 automatic fixed bin(17,0) dcl 3322 in procedure "also" set ref 3337* 3341 L 003434 automatic fixed bin(17,0) dcl 1799 in procedure "nm" set ref 1810* 1813 1816 1817 LEV 000147 automatic char(1) packed unaligned dcl 4395 set ref 1964* 2012 2052* 2061* LEV_NUM 000224 automatic char(1) packed unaligned dcl 4419 set ref 1995* 2031 MOD_NUM 000225 automatic fixed bin(17,0) dcl 4419 set ref 1997* 2034 N based structure level 1 unaligned dcl 1802 a_num 4 based fixed bin(17,0) level 2 dcl 375 set ref 285* 290 297 303 319 acc_dev_num 001675 automatic fixed bin(17,0) dcl 4637 set ref 4092* 4107* 4109* 4111* 4200 accept_device 10(10) based bit(1) level 3 in structure "mnemonic_name" packed packed unaligned dcl 14-13 in procedure "cobol_idedsyn" set ref 3806* 3816* accept_device 160 based fixed bin(17,0) level 2 in structure "fixed_common" dcl 3-26 in procedure "cobol_idedsyn" set ref 4200* access 45 based fixed bin(17,0) level 2 dcl 4-25 set ref 1111 2178* 2185* 2191* 3783 3783* 3983 3989* act_num 000217 automatic fixed bin(17,0) dcl 4410 set ref 297* 308* 314 add_cat_key 324(09) based char(5) level 2 packed packed unaligned dcl 4-25 set ref 1863* 2483* 2608* 2734 2734 2734* 2734 addr builtin function dcl 4422 ref 83 176 180 180 187 208 214 223 224 235 238 242 246 250 268 468 468 900 900 1069 1069 1354 1506 1743 1743 1744 1768 1788 1792 1792 1856 2394 2403 2600 2616 2739 2739 2887 2888 2902 2934 2935 3036 3071 3076 3087 3275 3275 3306 3306 3308 3308 3312 3312 3681 3746 3791 3824 3824 4001 4017 4178 4180 4185 4187 addrel builtin function dcl 4422 ref 3010 address_format 57 based fixed bin(17,0) level 2 dcl 4-25 set ref 2382* alf_name 003246 automatic varying char(32) dcl 4701 set ref 1612 3049* alf_num 001662 automatic fixed bin(17,0) dcl 4637 set ref 1613 3050* alf_range 001644 automatic fixed bin(17,0) dcl 4637 set ref 1773* 3206* 3208* 3210* 3214* 3282* 3288* 3296 alf_size 001661 automatic fixed bin(17,0) dcl 4637 set ref 2882* 2890 2896 2897* 2897 2902 2902 2910 2911* 2911 alf_type 001660 automatic fixed bin(17,0) dcl 4637 set ref 1558* 1610 3047* alit_ptr 003300 automatic pointer dcl 10-11 set ref 428* 879 883 930 1439 1448 1450 1452 1730 2418 2419 2507 2512 2513 2797 2826 3054 3241 3244 3246 3592 alph_bits 002776 automatic bit(36) packed unaligned dcl 4667 set ref 1684* alpha_ptr 002764 automatic pointer dcl 4664 set ref 250* 251 252 1744 1746 1761 1762 2881 2884 2887 2888 2902 2934 3031* 3031 3036 3042 3071 3074* 3074 3084 3087 3114 3115 3116 3117 3118 3119 3120 3129 3144 3147 3151 3151 3151 3155 3160 3165 3181* alphabet_name based structure level 1 unaligned dcl 4743 set ref 252 alphabet_name_size 001664 automatic fixed bin(17,0) dcl 4637 set ref 252* 3114 alphabet_offset 163 based fixed bin(17,0) level 2 in structure "fixed_common" dcl 3-26 in procedure "cobol_idedsyn" set ref 3071 3076* alphabet_offset 14 based fixed bin(17,0) level 2 in structure "mnemonic_name" dcl 14-13 in procedure "cobol_idedsyn" set ref 1842* alphanum_lit based structure level 1 unaligned dcl 10-14 alt_key_info 23(27) based char(5) level 2 packed packed unaligned dcl 4-25 set ref 1873* 2398 2465* alternate_keys 51 based fixed bin(17,0) level 2 dcl 4-25 set ref 1889* 2461* 2461 ao_len 211 based fixed bin(24,0) level 2 dcl 4-25 set ref 2512* 2602* 2679 2682* 2682 2683 ao_string 212 based char(256) level 2 packed packed unaligned dcl 4-25 set ref 1887* 2513* 2603* 2679 2683* 2683 apply_num 001651 automatic fixed bin(17,0) dcl 4637 set ref 2510* 2519* 2522* 2571* 2573* 2575* 2582* 2584* 2586* 2598* 2643 2643 array 001473 automatic bit(21) array packed unaligned dcl 4611 set ref 102* 103* 104* 105* 106* 107* 108* 109* 110* 111* 112* 113* 114* 115* 116* 117* 118* 119* 120* 121* 122* 4001 attach 123(02) based bit(1) level 2 packed packed unaligned dcl 4-25 set ref 2667 2673 2704 2704* 2704 attach_options_info 5(09) based char(5) level 2 packed packed unaligned dcl 4-25 set ref 1877* 2473* 2688 2693* 2693 banner_char 16(18) based char(1) level 2 packed packed unaligned dcl 4-25 set ref 1868* bit18 based bit(18) packed unaligned dcl 4625 set ref 2600* bit36 based bit(36) packed unaligned dcl 4626 set ref 83* bit512 based bit(512) packed unaligned dcl 4624 set ref 1768* bit8 based bit(8) packed unaligned dcl 4622 set ref 176* 187* 1354* 1788* 2403* 3791* 4180* 4186* 4189* bit9 based bit(9) packed unaligned dcl 4623 set ref 3344 3344 3454 3460 3511 3518 4179* 4182* 4187* body 4 based structure level 2 unaligned dcl 4444 bsn 101(06) based bit(1) level 2 packed packed unaligned dcl 4-25 set ref 2224* bsn_ind 0(10) 002760 automatic bit(1) level 2 packed packed unaligned dcl 4648 set ref 2224 2368* 3874* buffers 46 based fixed bin(17,0) level 2 dcl 4-25 set ref 2167* 3959 3959* cat_id_info 21(09) based char(5) level 2 packed packed unaligned dcl 4-25 set ref 1871* 2470* cat_nm 126(09) based char(200) level 2 packed packed unaligned dcl 4-25 set ref 1452* 1885* cat_type 001665 automatic fixed bin(17,0) dcl 4637 set ref 2621* catalogued 42 based fixed bin(17,0) level 2 dcl 4-25 set ref 3589* 3592* ch based structure level 1 packed packed unaligned dcl 4629 ch4 0(27) based char(1) level 2 in structure "ch" packed packed unaligned dcl 4629 in procedure "cobol_idedsyn" ref 1744 2887 2888 2902 ch4 0(27) based char(1) array level 2 in structure "tran" packed packed unaligned dcl 2926 in procedure "set_table" ref 2939 char 2 003033 automatic varying char(256) level 2 in structure "left_char_spec" dcl 4686 in procedure "cobol_idedsyn" set ref 1746 2745 3451 3453 3459 char 2 003136 automatic varying char(256) level 2 in structure "right_char_spec" dcl 4691 in procedure "cobol_idedsyn" set ref 2745* 3508 3510 3517 char 2 based varying char(256) level 2 in structure "char_spec" dcl 3324 in procedure "also" ref 3337 3343 char 2 based varying char(256) level 2 in structure "char_spec" dcl 3223 in procedure "char_spec" set ref 3244* char1 003245 automatic char(1) packed unaligned dcl 4700 set ref 223 3343* 3453* 3459* 3510* 3517* char1_ptr 002770 automatic pointer dcl 4664 set ref 223* 3344 3344 3454 3460 3511 3518 char_size 13 based fixed bin(17,0) level 2 dcl 4743 set ref 3042* char_spec based structure level 1 unaligned dcl 3324 in procedure "also" char_spec based structure level 1 unaligned dcl 3223 in procedure "char_spec" class 10(08) based structure level 2 packed packed unaligned dcl 14-13 set ref 176 187 1354 1788 3681* 3791 class24 based bit(24) packed unaligned dcl 4519 ref 3681 clause_bits 002772 automatic bit(36) packed unaligned dcl 4667 set ref 1456 1510* 1514* 1551* 1674* 2259* 2617* 4098* 4142* clause_num 001671 automatic fixed bin(17,0) dcl 4637 set ref 220* 776* 778* 780* 784* 788* 792* 837 844 868 922 1147* 1152* 1155* 1159* 1162* 1166* 1169* 1173* 1176* 1180* 1185* 1188* 1456 1525* 1527* 1529* 1531* 1535 1535 1568* 1570* 1574* 1577* 1579* 1581* 1583* 1585* 1597 1597 1635* 1691* 1693* 1697* 1701* 1705* 1742* 2066 2066 2268* 2270* 2275* 2279* 2281* 2835 2839 3059 3059 3124* 3832* 3834* 3837* 3840* 3842* 3844* 3846* 3852* 3859* 3866* 3873* 3880* 3884* 3886* 3888* 3891* 3894* 3896* 3898* 3901 3901 4053* 4055* 4057* 4059* 4061* 4063* 4065* 4067* 4075* 4077* 4079* 4081* 4085* 4150 4150 4210 4214 clause_order 001670 automatic fixed bin(17,0) dcl 4637 set ref 558 1509* 1517* 1554* 1677* 1708* 2261* 2835* 4100* 4145* 4210* cobol_$misc_end_ptr 000062 external static pointer dcl 1-62 set ref 3010* 3010 cobol_c_list 000030 constant entry external dcl 4498 ref 395 413 444 2019 2040 3021 4028 cobol_com_fileno defined pointer dcl 2-23 set ref 635* 745* 755* 1480* 1490* 1911* 1925* 1930* 2424* 2430* 2435* 2869* 2962* 2975* 3622* 3631* 3752* 3757* 3762* 3769* 3774* cobol_com_ptr defined pointer dcl 2-25 ref 65 78 96 97 98 170 225 285 301 573 627 631 714 741 744 785 793 831 896 1473 1478 1501 1503 1504 1505 1505 1543 1602 1617 1625 1630 1645 1647 1670 1726 1748 1895 1909 1909 1915 1915 1915 1920 2012 2031 2426 2426 2430 2435 2440 2945 2950 3010 3036 3071 3076 3087 3095 3098 3103 3105 3246 3622 3631 3645 3706 3757 3762 3978 4168 4178 4180 4185 4187 4195 4200 4205 4235 4253 4305 4319 4356 4362 cobol_ext_$cobol_com_fileno 000064 external static pointer dcl 2-22 ref 635 635 745 745 755 755 1480 1480 1490 1490 1911 1911 1925 1925 1930 1930 2424 2424 2430 2430 2435 2435 2869 2869 2962 2962 2975 2975 3622 3622 3631 3631 3752 3752 3757 3757 3762 3762 3769 3769 3774 3774 cobol_ext_$cobol_com_ptr 000066 external static pointer dcl 2-24 ref 65 65 78 78 96 96 97 97 98 98 170 170 225 225 285 285 301 301 573 573 627 627 631 631 714 714 741 741 744 744 785 785 793 793 831 831 896 896 1473 1473 1478 1478 1501 1501 1503 1503 1504 1504 1505 1505 1505 1505 1543 1543 1602 1602 1617 1617 1625 1625 1630 1630 1645 1645 1647 1647 1670 1670 1726 1726 1748 1748 1895 1895 1909 1909 1909 1909 1915 1915 1915 1915 1915 1915 1920 1920 2012 2012 2031 2031 2426 2426 2426 2426 2430 2430 2435 2435 2440 2440 2945 2945 2950 2950 3010 3010 3036 3036 3071 3071 3076 3076 3087 3087 3095 3095 3098 3098 3103 3103 3105 3105 3246 3246 3622 3622 3631 3631 3645 3645 3706 3706 3757 3757 3762 3762 3978 3978 4168 4168 4178 4178 4180 4180 4185 4185 4187 4187 4195 4195 4200 4200 4205 4205 4235 4235 4253 4253 4305 4305 4319 4319 4356 4356 4362 4362 cobol_ext_$cobol_min1_fileno 000070 external static pointer dcl 2-34 ref 424 424 cobol_ext_$cobol_name_fileno 000072 external static pointer dcl 2-38 ref 1844 1844 3031 3031 3074 3074 cobol_ided 000032 constant entry external dcl 4499 ref 63 cobol_imp_word$alphabet_name 000054 constant entry external dcl 4726 ref 534 cobol_imp_word$comp_type 000052 constant entry external dcl 4724 ref 588 cobol_imp_word$computer_name 000042 constant entry external dcl 4716 ref 721 1305 cobol_imp_word$device_name 000036 constant entry external dcl 4712 ref 529 806 817 4104 4115 cobol_imp_word$disp_type 000050 constant entry external dcl 4722 ref 595 cobol_imp_word$file_org 000046 constant entry external dcl 4720 ref 728 1310 cobol_imp_word$imp_word 000044 constant entry external dcl 4718 ref 316 523 1030 4073 cobol_imp_word$io_technique 000060 constant entry external dcl 4730 ref 2526 2568 2775 cobol_imp_word$printer_control 000040 constant entry external dcl 4714 ref 539 cobol_imp_word$switch_name 000056 constant entry external dcl 4728 ref 524 1205 cobol_min1_fileno defined pointer dcl 2-35 set ref 424* cobol_name_fileno defined pointer dcl 2-39 set ref 1844* 3031* 3074* cobol_res_words$check_sort_list 000016 constant entry external dcl 4392 ref 930 cobol_set_type40_$ebcdic 000034 constant entry external dcl 4710 ref 3181 cobol_swf_get 000020 constant entry external dcl 4494 ref 424 cobol_syntax_trace_$initialize_phase 000014 constant entry external dcl 349 ref 226 cobol_syntax_trace_$trace 000012 constant entry external dcl 347 ref 263 278 311 322 cobol_vdwf_dget 000024 constant entry external dcl 4496 ref 635 745 755 1480 1490 1925 2430 2869 3622 3757 3769 cobol_vdwf_dput 000022 constant entry external dcl 4495 ref 1930 2435 2962 2975 3631 3762 3774 cobol_vdwf_sput 000026 constant entry external dcl 4497 ref 1844 1911 2424 3031 3074 3752 code_set 76 based fixed bin(17,0) level 2 dcl 4-25 set ref 1896* 2083* 2094* 2099* 2115* 2120* 2132* 2137* 2162* col parameter fixed bin(17,0) dcl 404 ref 400 409 coll_seq 002720 automatic char(128) packed unaligned dcl 4646 set ref 69* 3350 3355 3360 3467 3472 3477 3525 3532 3538 collate builtin function dcl 4424 ref 69 column 2 based fixed bin(17,0) level 2 in structure "N" dcl 1802 in procedure "nm" ref 1815 column 2 000226 automatic fixed bin(17,0) level 2 in structure "diag_item" dcl 4463 in procedure "cobol_idedsyn" set ref 390* 3019* 4007* column 2 based fixed bin(17,0) level 2 in structure "alphabet_name" dcl 4743 in procedure "cobol_idedsyn" set ref 3116* column 2 based fixed bin(17,0) level 2 in structure "reserved_word" dcl 6-14 in procedure "cobol_idedsyn" ref 517 1593 2303 column 2 003015 automatic fixed bin(17,0) level 2 in structure "right" dcl 4678 in procedure "cobol_idedsyn" set ref 174* column 1 000132 automatic fixed bin(17,0) level 2 in structure "same_loc" dcl 4287 in procedure "cobol_idedsyn" set ref 2277* 4305* 4356* column 2 based fixed bin(17,0) level 2 in structure "sys_name" dcl 484 in procedure "system_name" set ref 517* 553* column 1 000250 automatic fixed bin(17,0) level 2 in structure "save" dcl 4480 in procedure "cobol_idedsyn" set ref 4253* 4372* column 2 based fixed bin(17,0) level 2 in structure "mnemonic_name" dcl 14-13 in procedure "cobol_idedsyn" set ref 192* 1815* 1825* column 2 003257 automatic fixed bin(17,0) level 2 in structure "pcs" dcl 4703 in procedure "cobol_idedsyn" set ref 1593* 3019 column 2 000252 automatic fixed bin(17,0) level 2 in structure "lev_diag_item" dcl 4484 in procedure "cobol_idedsyn" set ref 409* 1946* 2037* column 2 based fixed bin(17,0) level 3 in structure "record" dcl 4435 in procedure "cobol_idedsyn" set ref 285* 304* 390 569 573* 714* 785* 793* 1748* 2277 2320 2330 2344 2632 3246* 3710 3945 3978* 4007 4235* 4372 column 2 002777 automatic fixed bin(17,0) level 2 in structure "left" dcl 4670 in procedure "cobol_idedsyn" set ref 3116 column 1 000222 automatic fixed bin(17,0) level 2 in structure "dyn" dcl 4414 in procedure "cobol_idedsyn" set ref 2037 2303* column 1 000156 automatic fixed bin(17,0) array level 2 in structure "source_pos" dcl 4403 in procedure "cobol_idedsyn" set ref 1946 2320* 2330* 2344* 2632* 3945* column 7 based fixed bin(17,0) level 2 in structure "file_key" dcl 5-17 in procedure "cobol_idedsyn" set ref 2407* column 1 000144 automatic fixed bin(17,0) level 2 in structure "rec_loc" dcl 4341 in procedure "cobol_idedsyn" set ref 3649* 3710* 4319* 4362* column 2 based fixed bin(17,0) level 2 in structure "user_word" dcl 4741 in procedure "cobol_idedsyn" ref 553 1825 2407 com_io_key 000276 automatic char(5) packed unaligned dcl 4514 set ref 631* 635* 647* 744* 745* 754* 755* 1478* 1480* 1490* 1491* 2869* 2962* 2975* com_status 000263 automatic bit(32) packed unaligned dcl 4504 set ref 635* 637 745* 755* 1480* 1490* 1911* 1925* 1930* 2424* 2430* 2435* 2869* 2962* 2975* 3622* 3631* 3752* 3757* 3762* 3769* 3774* common_key 001454 automatic char(5) packed unaligned dcl 4570 set ref 1911* 1915 1927 1934 2424* 2426 2433 2440 2449 2452 2455 2458 2465 2470 2473 2476 2483 2486 2489 2764 3752* 3760 3772 3778 common_recsize 001452 automatic fixed bin(17,0) dcl 4569 set ref 635* 745* 755* 1480* 1490* 1925* 1930* 2422* 2424* 2430* 2435* 2869* 2962* 2975* 3622* 3631* 3750* 3752* 3757* 3762* 3769* 3774* comp_5 134(22) based bit(1) level 3 packed packed unaligned dcl 3-26 set ref 98* comp_defaults 134(17) based structure level 2 packed packed unaligned dcl 3-26 set ref 4178 4187 comp_level 137 based char(1) level 2 packed packed unaligned dcl 3-26 ref 285 301 573 714 785 793 1748 2012 2031 3246 3645 3978 4235 4253 4305 4319 4356 4362 comp_num 001655 automatic fixed bin(17,0) dcl 4637 set ref 663 663 916 918 1296 1298 1305* 1307 1310* 1312 1312* 1314* comp_type 001700 automatic fixed bin(17,0) dcl 4637 set ref 588* 592 595* 597 600* 600 4096* 4173 4176 4182 4189 console_name 001470 automatic bit(1) packed unaligned dcl 4582 set ref 95* cpl_files 134(10) based bit(1) level 2 packed packed unaligned dcl 3-26 set ref 65* curr_ord_num 001646 automatic fixed bin(17,0) dcl 4637 set ref 1783* 2741* 3386 3439 3557* currency 17(09) based char(1) level 2 packed packed unaligned dcl 3-26 set ref 1505 3095* current_line 000116 automatic fixed bin(17,0) level 2 dcl 359 set ref 67* 266* 266 268 337* 449* 452* 2993* 3003 3609* 3609 3618* 3618 3640* 3640 currsign 003243 automatic char(1) packed unaligned dcl 4698 set ref 1679* 1730* 1735 3095 3095 data_info 27(18) based char(5) level 2 packed packed unaligned dcl 4-25 set ref 1876* dd_seg_size 77 based fixed bin(24,0) level 2 dcl 3-26 set ref 1503* 1625* debug 134(01) based bit(1) level 2 packed packed unaligned dcl 3-26 set ref 170 1543* 1670* debugbit 001462 automatic bit(1) packed unaligned dcl 4575 set ref 89* 1669* dec_com 002760 automatic bit(1) level 2 packed packed unaligned dcl 4648 set ref 1698* 1712* 3103 dec_comma 133(33) based bit(1) level 2 packed packed unaligned dcl 3-26 set ref 96 97* 896 3103* dec_is_com 001471 automatic bit(1) packed unaligned dcl 4583 set ref 96* 896 def_line 11 based fixed bin(17,0) level 2 in structure "mnemonic_name" dcl 14-13 in procedure "cobol_idedsyn" set ref 194* 1814* 1826* def_line 12 based fixed bin(17,0) level 2 in structure "alphabet_name" dcl 4743 in procedure "cobol_idedsyn" set ref 1761* def_ptr 002766 automatic pointer dcl 4664 set ref 4178* 4179 4182 4185* 4186 4189 default_sign_type 134(12) based bit(3) level 2 packed packed unaligned dcl 3-26 set ref 4168* default_temp 157 based fixed bin(17,0) level 2 dcl 3-26 set ref 4195* defaults 002774 automatic bit(36) packed unaligned dcl 4667 set ref 219* den_6250 126(04) based bit(1) level 3 packed packed unaligned dcl 4-25 set ref 2717 2717* 2717 2812* 2817* density 126 based bit(1) level 3 packed packed unaligned dcl 4-25 set ref 2708 2708* 2708 2812* 2815* desc 12 based char(40) level 2 packed packed unaligned dcl 5-17 set ref 2410* descriptor 134(34) based bit(2) level 2 packed packed unaligned dcl 3-26 set ref 2945* 2950* detach 123(03) based bit(1) level 2 packed packed unaligned dcl 4-25 set ref 2667 2667* 2673 2673* 2706 2706* 2706 3968* dev_bits 002775 automatic bit(36) packed unaligned dcl 4667 set ref 672 677* 1683* device 47 based fixed bin(17,0) level 2 dcl 4-25 set ref 951* 985* 991* 997* 1000* 1006* 1009* 1012* 1019* 3963 3992 device_name 001373 automatic varying char(32) dcl 4528 set ref 980* 982 982 988 988 994 994 1000 1000 1003 1003 1009 1009 1012 1012 device_name_size 001372 automatic fixed bin(17,0) dcl 4527 set ref 968* 980 diag1_ptr 001416 automatic pointer dcl 4538 set ref 208* 395* 3021* 4028* diag2_ptr 001420 automatic pointer dcl 4538 set ref 214* 413* 2019* 2040* diag_item 000226 automatic structure level 1 unaligned dcl 4463 set ref 208 diag_num parameter fixed bin(17,0) dcl 404 in procedure "lev_diag" ref 400 410 diag_num 000113 automatic fixed bin(17,0) dcl 356 in procedure "cobol_idedsyn" set ref 66* 295* 304* 307* 327* 331 392 397* 955* 972* 1016* 1130* 1243* 2640* 2653* 3033* 3079* 3235* 3975* 3986* disp_defaults 134(26) based structure level 2 packed packed unaligned dcl 3-26 set ref 4180 4185 disp_dev_num 001676 automatic fixed bin(17,0) dcl 4637 set ref 4093* 4118* 4120* 4122* 4205 display_device 161 based fixed bin(17,0) level 2 in structure "fixed_common" dcl 3-26 in procedure "cobol_idedsyn" set ref 4205* display_device 10(11) based bit(1) level 3 in structure "mnemonic_name" packed packed unaligned dcl 14-13 in procedure "cobol_idedsyn" set ref 3811* 3818* dpass_sw 001472 automatic bit(1) packed unaligned dcl 4585 set ref 99* 437* 441 441* 941* 1424* 1435* 1446* dst 003242 automatic bit(3) initial packed unaligned dcl 4697 set ref 4158* 4161* 4163 4163* 4166* 4168 4168 4697* dup_alf_value 0(01) 002760 automatic bit(1) level 2 packed packed unaligned dcl 4648 set ref 1774* 3077 3399* 3422* dup_alpha_value 0(06) 002760 automatic bit(1) level 2 packed packed unaligned dcl 4648 set ref 1771* 2884 dupl_alt 101(08) based bit(1) level 2 packed packed unaligned dcl 4-25 set ref 1890* 3636* duplicates 3(27) based bit(1) level 3 packed packed unaligned dcl 5-17 set ref 3629* dyn 000222 automatic structure level 1 unaligned dcl 4414 dynamic_acc 000154 automatic bit(1) packed unaligned dcl 4401 set ref 1993 2031 2301* 2633* ed_found 001467 automatic bit(1) packed unaligned dcl 4581 set ref 94* 449 2252* error 001371 automatic char(1) packed unaligned dcl 4526 set ref 77* external 33(10) based bit(1) level 2 packed packed unaligned dcl 4-25 set ref 1882* 2648 3967* external_file 001464 automatic bit(1) packed unaligned dcl 4577 set ref 91* 1882 2339* 2618* extra_status 33(12) based bit(1) level 2 packed packed unaligned dcl 4-25 set ref 3951* extra_status_info 20 based char(5) level 2 packed packed unaligned dcl 4-25 set ref 1870* 2458* fb based fixed bin(17,0) dcl 4627 set ref 3036 3071* 3076 3087 figcon 5(02) based bit(1) level 2 packed packed unaligned dcl 6-14 ref 1192 file_acc 001666 automatic fixed bin(17,0) dcl 4637 set ref 2172 2172 2293* 2295* 2300* 2306* file_count 24 based fixed bin(17,0) level 2 dcl 3-26 set ref 627 741 1473 1895 1909* 1909 1915 1915 1920 3010 file_desc_1_offset 13 based fixed bin(24,0) level 2 dcl 4-25 set ref 1888* file_id_info 7(27) based char(5) level 2 packed packed unaligned dcl 4-25 set ref 1865* 2486* file_key based structure level 1 unaligned dcl 5-17 set ref 244 file_key_area 000300 automatic char(256) packed unaligned dcl 4517 set ref 2394 3746 file_key_size 001424 automatic fixed bin(17,0) dcl 4544 set ref 244* 2393 file_key_type 000274 automatic fixed bin(17,0) dcl 4512 set ref 2421* file_keys 74 based char(5) level 2 packed packed unaligned dcl 3-26 set ref 2426 2426* file_no 35 based fixed bin(17,0) level 2 in structure "file_table" dcl 4-25 in procedure "cobol_idedsyn" set ref 1895* 2404 file_no 4 based fixed bin(17,0) level 2 in structure "file_key" dcl 5-17 in procedure "cobol_idedsyn" set ref 2404* file_org 001640 automatic fixed bin(17,0) dcl 4637 set ref 691* 700* 702* 704* 706* 708* 710* 714 2078 2085 2354* file_ptr 002762 automatic pointer dcl 4664 set ref 635* 640 640 644 647 653* 745* 747 747 751 754 755* 1127 1133 1135* 1240 1253 1259 1265 1270 1480* 1487 1490* 1491 2637 2648 2648 2648 2656 2660 2660 2660 2667 2667 2667 2673 2673 2673 2679 2679 2682 2683 2688 2693 2699 2699 2702 2702 2704 2704 2706 2706 2708 2708 2710 2710 2712 2712 2714 2714 2717 2717 2720 2722 2723 2724 2727 2729 2730 2731 2734 2734 2848 2853 2861 2866 2869* 2957 2960 2962* 2982 2982 3604 file_qual 001641 automatic fixed bin(17,0) dcl 4637 set ref 721* 725 733* 2091 2096 2101 2112 2117 2158 3828* file_status 33(11) based bit(1) level 2 packed packed unaligned dcl 4-25 set ref 3672* file_status_info 16(27) based char(5) level 2 packed packed unaligned dcl 4-25 set ref 1869* 2455* file_table based structure level 1 unaligned dcl 4-25 set ref 236 file_table_size 001422 automatic fixed bin(17,0) dcl 4542 set ref 236* 1857 3010 filedescr_offsets 25 based char(5) array level 2 packed packed unaligned dcl 3-26 set ref 631 744 1478 1915* filler 6(02) 000226 automatic bit(6) level 2 packed packed unaligned dcl 4463 set ref 212* fixed builtin function dcl 4422 ref 1218 3231 3344 3344 3454 3460 3511 3518 4378 fixed_common based structure level 1 unaligned dcl 3-26 fixed_recs 33(17) based bit(1) level 2 packed packed unaligned dcl 4-25 set ref 2217* fkey_ptr 001412 automatic pointer dcl 4535 set ref 242* 243 244 2394* 2395 2398 2400 2402 2403 2404 2405 2406 2407 2408 2409 2410 2414 2415 2418 2419 2421 2424* flr_ind 0(08) 002760 automatic bit(1) level 2 packed packed unaligned dcl 4648 set ref 2217 2364* 3860* force 126(02) based bit(1) level 3 packed packed unaligned dcl 4-25 set ref 2550* 2712 2712* 2712 fq 001642 automatic fixed bin(17,0) dcl 4637 set ref 728* 730 733 ft_build_area 000400 automatic fixed bin(17,0) array dcl 4521 set ref 235 238 242 246 250 1506 1758* 1853* 1856 ft_ptr 001406 automatic pointer dcl 4532 set ref 235* 236 582 951 985 991 997 1000 1006 1009 1012 1019 1084 1088 1093 1103 1106 1111 1114 1119 1404 1404 1409 1409 1411 1411 1413 1413 1415 1417 1452 1484 1484 1856* 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1887 1888 1889 1890 1891 1893 1895 1896 1911* 1948 2072 2074 2074 2082 2083 2089 2093 2094 2098 2099 2103 2110 2114 2115 2119 2120 2127 2129 2131 2132 2134 2136 2137 2142 2147 2154 2161 2162 2167 2178 2185 2191 2213 2217 2219 2221 2224 2229 2234 2244 2381 2382 2398 2404 2449 2452 2455 2458 2461 2461 2465 2470 2473 2476 2483 2486 2489 2512 2513 2550 2558 2563 2600 2602 2603 2605 2606 2608 2682 2683 2683 2693 2699 2702 2704 2706 2708 2710 2712 2714 2717 2720 2722 2723 2724 2727 2729 2730 2731 2734 2734 2756 2757 2762 2764 2767 2777 2779 2781 2783 2793 2799 2803 2812 2812 2815 2817 2973 2975* 3589 3592 3613 3636 3663 3672 3783 3783 3783 3951 3956 3956 3959 3959 3963 3966 3967 3968 3972 3972 3983 3983 3983 3989 3992 3992 3992 ft_size 000265 automatic fixed bin(17,0) dcl 4506 set ref 1897* 1911* header based structure level 2 unaligned dcl 4435 hi_value 14 based char(1) level 2 packed packed unaligned dcl 4743 set ref 2887* 2902* high_value_value 001663 automatic fixed bin(17,0) dcl 4637 set ref 1775* 2888 3408* 3429* hival_char 10(18) based char(1) level 2 packed packed unaligned dcl 4743 set ref 2888* i 003416 automatic fixed bin(17,0) dcl 1755 in procedure "reset_alpha" set ref 1757* 1758* 1764* 1765* i 003561 automatic fixed bin(17,0) dcl 3322 in procedure "also" set ref 3341* 3343* i 003615 automatic fixed bin(17,0) dcl 3437 in procedure "range" set ref 3456* 3459* 3514* 3517* i 001426 automatic fixed bin(17,0) dcl 4547 in procedure "cobol_idedsyn" set ref 1851* 1853* 2624* 2626* 2892* 2894 2896* 2905* 2908 2910* 3112* 3114 3119 3570* 3573* 3577* 3579* 3996* 3998 4001 4010 4011 4013 4020 4023* i 003512 automatic fixed bin(17,0) dcl 2932 in procedure "set_table" set ref 2937* 2939 2939* i 003452 automatic fixed bin(17,0) dcl 1907 in procedure "emit_ft" set ref 1937* 1940 1944 1946 1955* ided_recovery 5(20) based bit(1) level 2 packed packed unaligned dcl 6-14 ref 1397 ifn 1(09) based char(16) level 2 packed packed unaligned dcl 4-25 set ref 582 1484 1864* 2074* ifn_size 73 based fixed bin(17,0) level 2 dcl 4-25 set ref 1484 2072* 2074 ignore_file 0(02) 002760 automatic bit(1) level 2 packed packed unaligned dcl 4648 set ref 1899* 2620* 3786 image 10 000226 automatic char(29) level 2 packed packed unaligned dcl 4463 set ref 4011* 4013* 4020* image_size 7 000226 automatic fixed bin(17,0) level 2 dcl 4463 set ref 4010* 4023* 4026 implnm_bit 001466 automatic bit(1) packed unaligned dcl 4580 set ref 93* index builtin function dcl 4422 ref 883 947 3350 3355 3360 3467 3472 3477 3525 3532 3538 indicators 002760 automatic structure level 1 packed packed unaligned dcl 4648 set ref 83 info 3(27) based structure level 2 in structure "file_key" packed packed unaligned dcl 5-17 in procedure "cobol_idedsyn" set ref 2403 info 6 based structure level 3 in structure "message" packed packed unaligned dcl 4444 in procedure "cobol_idedsyn" info 10 based structure level 2 in structure "alphabet_name" packed packed unaligned dcl 4743 in procedure "cobol_idedsyn" int_res 001673 automatic fixed bin(17,0) dcl 4637 set ref 1218* 1220 1220 4094* 4195 integral 4 based bit(1) level 2 packed packed unaligned dcl 8-14 ref 1056 1213 interchange 33(20) based bit(1) level 2 packed packed unaligned dcl 4-25 set ref 2234* interp 000116 automatic structure level 1 unaligned dcl 359 set ref 224 iw_key 11 based fixed bin(17,0) level 2 in structure "alphabet_name" dcl 4743 in procedure "cobol_idedsyn" set ref 3036 3087 3129* 3144* 3147* 3151 3151 3151 3155* 3160* 3165* iw_key 12 based fixed bin(17,0) level 2 in structure "mnemonic_name" dcl 14-13 in procedure "cobol_idedsyn" set ref 200* 1357* 1812* 1829* j 001427 automatic fixed bin(17,0) dcl 4548 set ref 4015* 4017 4020 4020 4023* key 003350 automatic fixed bin(17,0) dcl 481 in procedure "system_name" set ref 504* 506 508 510 key 4 based fixed bin(17,0) level 2 in structure "reserved_word" dcl 6-14 in procedure "cobol_idedsyn" ref 275 504 698 774 1283 1285 1287 1359 1522 1565 1688 2265 2291 2310 2336 2359 2579 3204 3253 3700 3830 4051 4131 key 001650 automatic fixed bin(17,0) dcl 4637 in procedure "cobol_idedsyn" set ref 698* 700 702 704 706 708 710 774* 776 778 780 782 788 790 806* 810 810 817* 821 821 1522* 1525 1527 1529 1565* 1568 1570 1572 1577 1579 1581 1583 1688* 1691 1693 1695 2265* 2268 2270 2272 2279 2291* 2293 2295 2297 2310* 2314 2323 2336* 2339 2359* 2362 2364 2366 2368 2370 2526* 2529 2532 2536 2539 2568* 2571 2573 2579* 2582 2584 2775* 2777 2779 2781 3204* 3206 3208 3253* 3255 3257 3259 3261 3263 3700* 3702 3712 3717 3830* 3832 3834 3837 3840 3842 3844 3846 3849 3856 3863 3870 3877 3884 3886 3888 3891 3894 3896 4051* 4053 4055 4057 4059 4061 4063 4065 4073* 4075 4077 4079 4104* 4107 4109 4115* 4118 4120 4131* 4134 4136 key parameter fixed bin(17,0) dcl 3176 in procedure "set_offset" ref 3173 3178 3178 key_qual_size 001425 automatic fixed bin(17,0) dcl 4545 set ref 248* 3745 key_type 5 based fixed bin(17,0) level 2 dcl 5-17 set ref 2405* 2421 kill_diag 000114 automatic fixed bin(17,0) dcl 356 set ref 79* 327 327* 2994* label_format 53 based fixed bin(17,0) level 2 dcl 4-25 set ref 1884* label_info 26(09) based char(5) level 2 packed packed unaligned dcl 4-25 set ref 1875* last_clause 001667 automatic fixed bin(17,0) dcl 4637 set ref 221* 1508* 1516* 1553* 1676* 1707* 2260* 2835 2839* 4099* 4144* 4210 4214* last_file_key 121(27) based char(5) level 2 packed packed unaligned dcl 3-26 set ref 2430* 2435* 2440* 3622* 3631* 3757* 3762* last_ft_ptr 000272 automatic pointer dcl 4511 set ref 1925* 1927 1930* last_prev_file_key 000270 automatic char(5) packed unaligned dcl 4508 set ref 1925* 1930* 1934* lead_trail 001637 automatic fixed bin(17,0) dcl 4637 set ref 4089* 4158 4220* 4226* left 002777 automatic structure level 1 unaligned dcl 4670 set ref 468 468 900 900 left_char_spec 003033 automatic structure level 1 unaligned dcl 4686 set ref 1743 1743 2739 2739 3306 3306 left_number 001652 automatic fixed bin(17,0) dcl 4637 set ref 3446* 3454* 3467* 3472* 3477* 3482* 3487* 3495 3567 3567 3570 3570 3577 length 5 based fixed bin(17,0) level 2 in structure "user_word" dcl 4741 in procedure "cobol_idedsyn" set ref 551 640 747 947 953 958* 968 975* 978* 980 1428 1484 1647 1823 1827 1828 1857 1859 1860 2072 2074 2393 2414 2415 3745 3748 3749 length builtin function dcl 4422 in procedure "cobol_idedsyn" ref 197 1810 3112 3337 3451 3508 lev1_mod 000202 automatic fixed bin(17,0) initial array dcl 4407 set ref 2051 3607 4407* 4407* 4407* 4407* 4407* 4407* lev1_org 000150 automatic char(1) initial array packed unaligned dcl 4397 set ref 2052 4397* 4397* 4397* 4397* 4397* 4397* lev2_mod 000210 automatic fixed bin(17,0) initial array dcl 4408 set ref 1997 2060 3616 4408* 4408* 4408* 4408* 4408* 4408* lev2_org 000152 automatic char(1) initial array packed unaligned dcl 4398 set ref 1995 2061 4398* 4398* 4398* 4398* 4398* 4398* lev_diag_item 000252 automatic structure level 1 unaligned dcl 4484 set ref 214 level_num 000134 automatic char(1) initial array packed unaligned dcl 4290 set ref 4290* 4290* 4290* 4290* 4290* 4290* 4290* 4290* 4290* 4290* 4290* 4290* 4290* 4290* 4290* 4290* 4290* 4290* 4290* 4290* 4290* 4290* 4290* 4290* 4290* 4290* 4305 4356 4362 lin parameter fixed bin(17,0) dcl 404 ref 400 408 linage_info 32 based char(5) level 2 packed packed unaligned dcl 4-25 set ref 1880* line 1 based fixed bin(17,0) level 2 in structure "alphabet_name" dcl 4743 in procedure "cobol_idedsyn" set ref 3115* line 1 002777 automatic fixed bin(17,0) level 2 in structure "left" dcl 4670 in procedure "cobol_idedsyn" set ref 3115 line 1 based fixed bin(17,0) level 2 in structure "sys_name" dcl 484 in procedure "system_name" set ref 516* 552* line 1 based fixed bin(17,0) level 3 in structure "record" dcl 4435 in procedure "cobol_idedsyn" set ref 285* 304* 389 573* 714* 785* 793* 1748* 2276 2318 2328 2343 2631 3246* 3709 3942 3978* 4006 4235* 4371 line 1 000226 automatic fixed bin(17,0) level 2 in structure "diag_item" dcl 4463 in procedure "cobol_idedsyn" set ref 389* 3018* 4006* line 1 based fixed bin(17,0) level 2 in structure "mnemonic_name" dcl 14-13 in procedure "cobol_idedsyn" set ref 1839* line 000156 automatic fixed bin(17,0) array level 2 in structure "source_pos" dcl 4403 in procedure "cobol_idedsyn" set ref 1940 1944 2318* 2328* 2343* 2626* 2631* 3942* line 1 003257 automatic fixed bin(17,0) level 2 in structure "pcs" dcl 4703 in procedure "cobol_idedsyn" set ref 1592* 3018 line 000250 automatic fixed bin(17,0) level 2 in structure "save" dcl 4480 in procedure "cobol_idedsyn" set ref 4253* 4371* line 000132 automatic fixed bin(17,0) level 2 in structure "same_loc" dcl 4287 in procedure "cobol_idedsyn" set ref 2276* 4305* 4356* line 000144 automatic fixed bin(17,0) level 2 in structure "rec_loc" dcl 4341 in procedure "cobol_idedsyn" set ref 3649* 3709* 4319* 4362* line 1 based fixed bin(17,0) level 2 in structure "reserved_word" dcl 6-14 in procedure "cobol_idedsyn" ref 516 1592 2302 line 1 based fixed bin(17,0) level 2 in structure "N" dcl 1802 in procedure "nm" ref 1814 line 000222 automatic fixed bin(17,0) level 2 in structure "dyn" dcl 4414 in procedure "cobol_idedsyn" set ref 2036 2302* line 1 000252 automatic fixed bin(17,0) level 2 in structure "lev_diag_item" dcl 4484 in procedure "cobol_idedsyn" set ref 408* 1944* 2036* line 6 based fixed bin(17,0) level 2 in structure "file_key" dcl 5-17 in procedure "cobol_idedsyn" set ref 2406* line 1 based fixed bin(17,0) level 2 in structure "user_word" dcl 4741 in procedure "cobol_idedsyn" ref 552 1761 1826 2406 line 1 003015 automatic fixed bin(17,0) level 2 in structure "right" dcl 4678 in procedure "cobol_idedsyn" set ref 172* lit_size 5 based fixed bin(17,0) level 2 dcl 10-14 ref 879 883 930 930 1439 1450 1452 1730 2418 2419 2512 2513 3054 3244 3246 literal 11 based char level 2 packed packed unaligned dcl 8-14 ref 1060 1218 1645 3231 4378 loc parameter fixed bin(17,0) dcl 3393 in procedure "set_also_char" ref 3390 3396 3396 3399 3403 3404 3408 loc parameter fixed bin(17,0) dcl 3420 in procedure "set_char" ref 3417 3422 3425 3426 3429 loc 003616 automatic fixed bin(17,0) dcl 3437 in procedure "range" set ref 3460* 3461* 3518* 3519* loval_char 10(27) based char(1) level 2 packed packed unaligned dcl 4743 set ref 1744* 1746* md_num parameter fixed bin(17,0) dcl 4297 in procedure "sa_mess" ref 4294 4303 4305 md_num parameter fixed bin(17,0) dcl 4348 in procedure "sra_mess" set ref 4345 4354 4356 4359* 4359 4360 4362 message based structure level 1 unaligned dcl 4444 min1_status 000262 automatic bit(32) packed unaligned dcl 4503 set ref 424* 430 mnemonic_name based structure level 1 unaligned dcl 14-13 set ref 240 mod_num 000216 automatic fixed bin(17,0) dcl 4410 set ref 80* 303* 411 415* 1963* 2016 2024* 2051* 2060* 3607* 3616* 3648* 4241* 4264* 4303* 4318* 4354* 4360* module 6 000252 automatic fixed bin(17,0) level 2 dcl 4484 set ref 411* 2016* 2034* mrcsz 001440 automatic fixed bin(17,0) dcl 4559 set ref 424* mult_fil_no 001450 automatic fixed bin(17,0) dcl 4566 set ref 86* 2257* mult_position_no 64 based fixed bin(17,0) level 2 dcl 4-25 set ref 1133 2960* 2973* 2982* n 001430 automatic fixed bin(17,0) dcl 4549 set ref 947* 949 965 968 970 978 980 n_reducs 000261 automatic fixed bin(17,0) dcl 4500 set ref 63* name 221 based char level 2 in structure "alphabet_name" packed packed unaligned dcl 4743 in procedure "cobol_idedsyn" set ref 3084 3120* name 5 based varying char(32) level 2 in structure "N" dcl 1802 in procedure "nm" ref 1810 1817 name 16 based char level 2 in structure "mnemonic_name" packed packed unaligned dcl 14-13 in procedure "cobol_idedsyn" set ref 196* 197 1817* 1828* name 103 based char(32) level 2 in structure "file_table" packed packed unaligned dcl 4-25 in procedure "cobol_idedsyn" set ref 640 747 1860* name 5 002777 automatic varying char(32) level 2 in structure "left" dcl 4670 in procedure "cobol_idedsyn" set ref 3049 3112 3120 name 25 based char level 2 in structure "file_key" packed packed unaligned dcl 5-17 in procedure "cobol_idedsyn" set ref 2415* 2419* name 5 based varying char(32) level 2 in structure "sys_name" dcl 484 in procedure "system_name" set ref 500* 551* name 4 003257 automatic varying char(32) level 2 in structure "pcs" dcl 4703 in procedure "cobol_idedsyn" set ref 1612* 3084 name 3 based char level 2 in structure "qual_rec" packed packed unaligned dcl 4427 in procedure "cobol_idedsyn" set ref 3749* name 5 003015 automatic varying char(32) level 2 in structure "right" dcl 4678 in procedure "cobol_idedsyn" set ref 175* name_key 001456 automatic char(5) packed unaligned dcl 4572 set ref 1844* 3031* 3036 3074* 3076 3087 name_ptr 001404 automatic pointer dcl 4531 set ref 176 178 187 189 191 192 194 196 197 197 198 198 200 238* 239 240 1354 1356 1357 1359 1361 1506* 1788 1790 1812 1813 1814 1815 1816 1817 1823 1825 1826 1827 1828 1828 1829 1838 1839 1840 1841 1842 1844* 1844 3681 3683 3684 3791 3794 3806 3811 3816 3818 name_size 220 based fixed bin(17,0) level 2 in structure "alphabet_name" dcl 4743 in procedure "cobol_idedsyn" set ref 251* 3084 3119* 3120 name_size 24 based fixed bin(17,0) level 2 in structure "file_key" dcl 5-17 in procedure "cobol_idedsyn" set ref 243* 2414* 2415 2418* 2419 name_size 15 based fixed bin(17,0) level 2 in structure "mnemonic_name" dcl 14-13 in procedure "cobol_idedsyn" set ref 196 197* 197 198 239* 1816* 1817 1827* 1828 1828 name_size 102 based fixed bin(17,0) level 2 in structure "file_table" dcl 4-25 in procedure "cobol_idedsyn" set ref 640 747 1859* name_status 000264 automatic bit(32) packed unaligned dcl 4505 set ref 1844* 3031* 3074* nat_alf_size 001446 automatic fixed bin(17,0) dcl 4563 set ref 82* 2892 2905 2905 3233 3396 3567 3567 nat_bits 002701 automatic bit(1) array packed unaligned dcl 4644 set ref 1768 2894 2908 3399 3403* 3422 3425* next based char(5) level 2 in structure "file_table" packed packed unaligned dcl 4-25 in procedure "cobol_idedsyn" set ref 644 647 751 754 1487 1491 1861* 1927* next based char(5) level 2 in structure "qual_rec" packed packed unaligned dcl 4427 in procedure "cobol_idedsyn" set ref 3747* 3772* next based char(5) level 2 in structure "file_key" packed packed unaligned dcl 5-17 in procedure "cobol_idedsyn" set ref 2395* 2433* next_alt 1(09) based char(5) level 2 packed packed unaligned dcl 5-17 set ref 2398* 2400* nlit_ptr 003276 automatic pointer dcl 8-11 set ref 427* 1056 1058 1060 1060 1213 1213 1218 1645 2754 3228 3231 4378 null builtin function dcl 4422 ref 653 1127 1135 1240 1840 1841 2637 2957 2982 3117 3118 num 3 003257 automatic fixed bin(17,0) level 2 in structure "pcs" dcl 4703 in procedure "cobol_idedsyn" set ref 1613* 3027* 3029 num parameter fixed bin(17,0) dcl 1799 in procedure "nm" ref 1796 1812 num 003453 automatic fixed bin(17,0) dcl 1907 in procedure "emit_ft" set ref 1957* 1961* 1966* 1970* 1974* 1978* 1982* 1986* 2003* 2007* 2017 num 4 003015 automatic fixed bin(17,0) level 2 in structure "right" dcl 4678 in procedure "cobol_idedsyn" set ref 672 677 num 4 002777 automatic fixed bin(17,0) level 2 in structure "left" dcl 4670 in procedure "cobol_idedsyn" set ref 185 682 687 1343 1346 1370 1373 num 4 based fixed bin(17,0) level 2 in structure "sys_name" dcl 484 in procedure "system_name" set ref 506* 508* 510* 515 524* 526 529* 531 534* 536 539* 541 num_binary 001437 automatic fixed bin(17,0) dcl 4558 set ref 1043 1044 1051* 1230 1230 1468 1468 1468 1617 1625 1630 1726 2167 2757 2815 2817 2960 3042 4378* number 3 002777 automatic fixed bin(17,0) level 2 in structure "left" dcl 4670 in procedure "cobol_idedsyn" set ref 179* 180* 200 1357 1792* 1829 3050 3794 3798 3798* 3798 3801 3824* number 3 based fixed bin(17,0) level 2 in structure "sys_name" dcl 484 in procedure "system_name" set ref 499* 515* 523* number 3 003015 automatic fixed bin(17,0) level 2 in structure "right" dcl 4678 in procedure "cobol_idedsyn" set ref 3127* number 5 000252 automatic fixed bin(17,0) level 2 in structure "lev_diag_item" dcl 4484 in procedure "cobol_idedsyn" set ref 410* 2017* 2035* number 5 000226 automatic fixed bin(17,0) level 2 in structure "diag_item" dcl 4463 in procedure "cobol_idedsyn" set ref 392* 3015* 4008* number parameter fixed bin(17,0) dcl 3136 in procedure "set_iw_key" ref 3133 3144 3147 numeric_lit based structure level 1 unaligned dcl 8-14 o_bit 0(09) based char(1) level 2 packed packed unaligned dcl 375 ref 282 285 299 301 obj_com 0(13) 002760 automatic bit(1) level 2 packed packed unaligned dcl 4648 set ref 1699* 1714* 1718* 2873* 3105 obj_comp_name 001674 automatic fixed bin(17,0) dcl 4637 set ref 1556* obj_comp_num 001656 automatic fixed bin(17,0) dcl 4637 set ref 918* obj_dec_comma 134(11) based bit(1) level 2 packed packed unaligned dcl 3-26 set ref 3105* object_sign 146(27) based char(1) level 2 packed packed unaligned dcl 3-26 set ref 1505* 3098* objsign 003244 automatic char(1) packed unaligned dcl 4699 set ref 1680* 1735* 3054* 3098 3098 off_status 10(15) based bit(1) level 2 packed packed unaligned dcl 14-13 set ref 1361* 3684* om_len 313 based fixed bin(17,0) level 2 dcl 4-25 set ref 2723* 2723 om_string 314 based char(17) level 2 packed packed unaligned dcl 4-25 set ref 1893* 2724* 2724 on_status 10(14) based bit(1) level 2 packed packed unaligned dcl 14-13 set ref 191* 1359* 3683* one_one 10(08) based bit(1) level 3 packed packed unaligned dcl 4743 set ref 2881* one_one_bit 0(05) 002760 automatic bit(1) level 2 packed packed unaligned dcl 4648 set ref 1772* 2881 2884 3384* onto 10(09) based bit(1) level 3 packed packed unaligned dcl 4743 set ref 2884* optional 33(09) based bit(1) level 2 packed packed unaligned dcl 4-25 set ref 1881* 3966* 3972 optional_file 001463 automatic bit(1) packed unaligned dcl 4576 set ref 90* 1881 2342* 2619* options_bits 001636 automatic bit(18) packed unaligned dcl 4635 set ref 2532 2536* 2596* ord_max 001645 automatic fixed bin(17,0) dcl 4637 set ref 1784* 2742* 3406 3409* 3439 3559* ord_num 001643 automatic fixed bin(17,0) dcl 4637 set ref 1769* 1782* 2741 2882 2887 3386* 3404 3406 3409 3412* 3412 3426 3427* 3427 3439* 3557 org 000220 automatic fixed bin(17,0) dcl 4410 set ref 1948* 1951* 1995 1997 2051 2052 2060 2061 3604* 3607 3609 3613* 3616 3618 4261 4310 4313 4317 org_num parameter fixed bin(17,0) dcl 4348 in procedure "sra_mess" ref 4345 4350 4353 org_num parameter fixed bin(17,0) dcl 4297 in procedure "sa_mess" ref 4294 4299 4302 org_qual 44 based fixed bin(17,0) level 2 dcl 4-25 set ref 1404 1409 1411 1413 1415 2082* 2093* 2098* 2103* 2114* 2119* 2129 2131* 2134 2136* 2161* org_vector 000130 automatic bit(1) array packed unaligned dcl 4285 set ref 3688* 4299 4302* 4313 4317* 4350 4353* organization 43 based fixed bin(17,0) level 2 dcl 4-25 set ref 1088 1093 1103 1106 1404 1409 1411 1413 1417 1891* 1948 2089* 2110* 2127* 2142* 2147* 2154* 3604 3613 3783 3956 3956* 3972 3983 3983 orig_alf_size 001447 automatic fixed bin(17,0) dcl 4563 set ref 2890* 2902 output_mode 312 based fixed bin(17,0) level 2 dcl 4-25 set ref 2605* 2720 2720 2722* 2722 2777* 2779* 2781* 2783* 2793* 2799* 2803* p parameter pointer dcl 3321 in procedure "also" ref 3318 3329 3337 3343 3350 3355 3360 3365 3370 3377 p parameter pointer dcl 1799 in procedure "nm" ref 1796 1810 1814 1815 1817 p parameter pointer dcl 481 in procedure "system_name" ref 478 498 499 500 506 508 510 514 515 515 516 517 523 524 526 526 529 531 531 534 536 536 539 541 541 543 551 552 553 p parameter pointer dcl 3221 in procedure "char_spec" ref 3218 3230 3231 3233 3233 3243 3244 3255 3257 3259 3261 3263 3266 3270 p1 4 000116 automatic pointer level 2 dcl 359 set ref 63* 268 p2 2 000116 automatic pointer level 2 dcl 359 set ref 285 285 304 304 316* 389 390 424* 426 427 428 433 435 444* 447 521 523* 524* 529* 534* 539* 551 552 553 569 573 573 588* 595* 627 640 714 714 721* 728* 747 785 785 793 793 806* 817* 879 944 947 953 958 968 975 978 980 1030* 1054 1205* 1280 1305* 1310* 1332 1383 1394 1426 1428 1437 1484 1645 1647 1748 1748 1761 1823 1825 1826 1827 1828 1857 1859 1860 2072 2074 2276 2277 2318 2320 2328 2330 2343 2344 2393 2406 2407 2412 2414 2415 2517 2526* 2568* 2631 2632 2760 2775* 2791 2828 3246 3246 3586 3709 3710 3745 3748 3749 3942 3945 3978 3978 4006 4007 4071 4073* 4104* 4115* 4235 4235 4371 4372 padding_char 16(09) based char(1) level 2 packed packed unaligned dcl 4-25 set ref 1867* param_at_end 6 000226 automatic bit(1) level 2 packed packed unaligned dcl 4463 set ref 393* 3017* 4009* pcs 003257 automatic structure level 1 unaligned dcl 4703 pd_seg_size 100 based fixed bin(24,0) level 2 dcl 3-26 set ref 1504* 1630* perm 123(01) based bit(1) level 2 packed packed unaligned dcl 4-25 set ref 2648 2660 2660* 2702 2702* 2702 phase_name 15(27) based char(6) level 2 packed packed unaligned dcl 3-26 set ref 1501* places 10 based fixed bin(17,0) level 2 dcl 8-14 ref 1060 1060 1218 1645 3231 4378 prev_qual_key 000266 automatic char(5) packed unaligned dcl 4507 set ref 3769* 3774* 3778* prev_rec 6 based pointer level 2 in structure "alphabet_name" dcl 4743 in procedure "cobol_idedsyn" set ref 3071 3118* prev_rec 6 based pointer level 2 in structure "mnemonic_name" dcl 14-13 in procedure "cobol_idedsyn" set ref 1841* previous_valid_fkeys 001465 automatic bit(1) packed unaligned dcl 4578 set ref 92* printer_control 10(12) based bit(1) level 3 packed packed unaligned dcl 14-13 set ref 3794* process_area 101(07) based bit(1) level 2 packed packed unaligned dcl 4-25 set ref 2229* 2244* prog_coll_seq 123 based fixed bin(17,0) level 2 dcl 3-26 set ref 3036* 3087* prog_name based char(30) level 2 packed packed unaligned dcl 3-26 set ref 831 1645* 1647* property 001510 automatic bit(1) array packed unaligned dcl 4612 set ref 984* 990* 996* 1005* 1404 1409 2087* 2108* 2125* 2152* 2183* 2189* 2212* 2380* 2616 3661* 3998 4001 protect 126(03) based bit(1) level 3 packed packed unaligned dcl 4-25 set ref 2558* 2714 2714* 2714 qual 2(18) based char(5) level 2 packed packed unaligned dcl 5-17 set ref 2402* 3760* qual_ptr 001414 automatic pointer dcl 4536 set ref 246* 247 248 3746* 3747 3748 3749 3752* qual_rec based structure level 1 unaligned dcl 4427 set ref 248 qual_sw 000275 automatic bit(1) packed unaligned dcl 4513 set ref 100* 2496* 3754 3779* qualif 000246 automatic bit(1) packed unaligned dcl 4477 set ref 4249* 4253 4373* queue_name 001677 automatic fixed bin(17,0) dcl 4637 set ref 4095* 4134* 4136* 4138* r_key_info 22(18) based char(5) level 2 packed packed unaligned dcl 4-25 set ref 1872* 2449* 2452* rec_do_info 25 based char(5) level 2 packed packed unaligned dcl 4-25 set ref 1874* rec_key 0(04) 002760 automatic bit(1) level 2 packed packed unaligned dcl 4648 set ref 2195* 2289* 2327* 3917* rec_loc 000144 automatic structure level 1 unaligned dcl 4341 record based structure level 1 unaligned dcl 4435 record_format 52 based fixed bin(17,0) level 2 dcl 4-25 set ref 1883* record_key 33(22) based bit(1) level 2 packed packed unaligned dcl 4-25 set ref 1119 3663* record_prefix 50 based fixed bin(17,0) level 2 dcl 4-25 set ref 2213* 3992 3992* recovaddress 001451 automatic fixed bin(17,0) dcl 4567 set ref 2993 3003* rel_key 0(03) 002760 automatic bit(1) level 2 packed packed unaligned dcl 4648 set ref 2239* 2287* 2317* 3935* relative_key 33(21) based bit(1) level 2 packed packed unaligned dcl 4-25 set ref 1084 1114 2381* remarksbit 001461 automatic bit(1) packed unaligned dcl 4574 set ref 88* 386 444 1654* 1661* replace 6(01) 000226 automatic bit(1) level 2 packed packed unaligned dcl 4463 set ref 211* replacement_info 6(18) based char(5) level 2 packed packed unaligned dcl 4-25 set ref 1878* 2476* replaces_token 6(01) based bit(1) level 4 packed packed unaligned dcl 4444 ref 447 report_info 30(27) based char(5) level 2 packed packed unaligned dcl 4-25 set ref 1879* rerunclock 001460 automatic bit(1) packed unaligned dcl 4573 set ref 87* res 003241 automatic fixed bin(17,0) dcl 4696 set ref 611 625* 655* reserved_word based structure level 1 unaligned dcl 6-14 retain 126(01) based bit(1) level 3 packed packed unaligned dcl 4-25 set ref 2563* 2710 2710* 2710 retention_info 11 based char(5) level 2 packed packed unaligned dcl 4-25 set ref 1866* 2489* right 003015 automatic structure level 1 unaligned dcl 4678 set ref 180 180 1069 1069 1792 1792 3824 3824 right_char_spec 003136 automatic structure level 1 unaligned dcl 4691 set ref 3275 3275 3308 3308 3312 3312 right_number 001653 automatic fixed bin(17,0) dcl 4637 set ref 3495* 3502* 3511* 3525* 3532* 3538* 3544* 3550* 3567 3567 3570 3570 3577 run 4 000252 automatic fixed bin(17,0) level 2 in structure "lev_diag_item" dcl 4484 in procedure "cobol_idedsyn" set ref 217* run 4 000226 automatic fixed bin(17,0) level 2 in structure "diag_item" dcl 4463 in procedure "cobol_idedsyn" set ref 210* rw_ptr 003274 automatic pointer dcl 6-11 set ref 272 275 426* 502 504 516 517 695 698 770 774 1192 1192 1283 1285 1287 1359 1397 1522 1565 1592 1593 1688 2265 2291 2302 2303 2310 2336 2359 2579 3201 3204 3251 3253 3681 3693 3700 3830 4049 4051 4131 s_bit based char(1) level 2 packed packed unaligned dcl 375 ref 334 s_exit 3 based fixed bin(17,0) level 2 dcl 375 ref 337 same_area_clause 60 based fixed bin(17,0) level 2 dcl 4-25 set ref 1270 2861* same_file 33(31) based bit(1) level 2 packed packed unaligned dcl 4-25 set ref 2866* same_loc 000132 automatic structure level 1 unaligned dcl 4287 same_rec_clause 61 based fixed bin(17,0) level 2 dcl 4-25 set ref 1253 2848* same_sort_clause 62 based fixed bin(17,0) level 2 dcl 4-25 set ref 1259 1265 2853* same_type 001445 automatic fixed bin(17,0) initial dcl 4561 set ref 1248 1248 2843 2846 3640 3695* 3704* 3714* 3719* 3723* 4561* samect 001441 automatic fixed bin(17,0) initial dcl 4561 set ref 84* 2861 3696* 3696 3724* 3724 3732* 3732 4561* samerecct 001442 automatic fixed bin(17,0) initial dcl 4561 set ref 85* 2848 3705* 3705 3706 4561* samesct 001443 automatic fixed bin(17,0) initial dcl 4561 set ref 2853 3715* 3715 4561* samesmct 001444 automatic fixed bin(17,0) initial dcl 4561 set ref 3720* 3720 4561* save 000250 automatic structure level 1 unaligned dcl 4480 seg_lim 001672 automatic fixed bin(17,0) dcl 4637 set ref 1557* seg_limit 101 based fixed bin(17,0) level 2 in structure "fixed_common" dcl 3-26 in procedure "cobol_idedsyn" set ref 78* 1617* 1726* seg_limit 000010 internal static fixed bin(17,0) dcl 4382 in procedure "cobol_idedsyn" set ref 81* 1043* 4388 sep_sign 001647 automatic fixed bin(17,0) dcl 4637 set ref 4091* 4163 4230* sign 4(09) based char(1) level 2 packed packed unaligned dcl 8-14 ref 1058 size based fixed bin(17,0) level 2 in structure "mnemonic_name" dcl 14-13 in procedure "cobol_idedsyn" set ref 198* 1813* 1823* 1844* size builtin function dcl 4422 in procedure "cobol_idedsyn" ref 236 240 244 248 252 size 000252 automatic fixed bin(17,0) level 2 in structure "lev_diag_item" dcl 4484 in procedure "cobol_idedsyn" set ref 216* size 000226 automatic fixed bin(17,0) level 2 in structure "diag_item" dcl 4463 in procedure "cobol_idedsyn" set ref 391* 3016* 4026* size 2 based fixed bin(17,0) level 2 in structure "qual_rec" dcl 4427 in procedure "cobol_idedsyn" set ref 247* 3748* 3749 size based fixed bin(17,0) level 2 in structure "alphabet_name" dcl 4743 in procedure "cobol_idedsyn" set ref 3031* 3074* 3114* sk_ind 0(11) 002760 automatic bit(1) level 2 packed packed unaligned dcl 4648 set ref 862 2532* 2535* 2750 2771 2787 2807 2822 sort_name 000146 automatic bit(1) packed unaligned dcl 4392 set ref 1951 2612* 3655* source_comp_num 001657 automatic fixed bin(17,0) dcl 4637 set ref 1298* source_pos 000156 automatic structure array level 1 unaligned dcl 4403 span_ind 0(12) 002760 automatic bit(1) level 2 packed packed unaligned dcl 4648 set ref 2221 2370* 3881* spanned_recs 33(19) based bit(1) level 2 packed packed unaligned dcl 4-25 set ref 2221* sra_clauses 110 based fixed bin(17,0) level 2 dcl 3-26 set ref 3706* ssf_ind 0(07) 002760 automatic bit(1) level 2 packed packed unaligned dcl 4648 set ref 2209 2362* 3853* string 6 based char level 2 in structure "alphanum_lit" packed packed unaligned dcl 10-14 in procedure "cobol_idedsyn" set ref 883 930* 1452 1730 2419 2513 3054 3244 string builtin function dcl 4422 in procedure "cobol_idedsyn" set ref 3688* string_ptr 4 based pointer level 2 in structure "mnemonic_name" dcl 14-13 in procedure "cobol_idedsyn" set ref 1840* string_ptr 4 based pointer level 2 in structure "alphabet_name" dcl 4743 in procedure "cobol_idedsyn" set ref 3117* substr builtin function dcl 4422 set ref 185* 430 637 640 672 677* 682 687* 747 883 980 1060 1343 1346* 1370 1373* 1456 1484 1817 1828 2074 2532 2536* 2683 2693 3343 3453 3459 3510 3517 4013* 4020* 4158* 4161* 4163 4163* 4166* 4182* 4189* supervisor 133(32) based bit(1) level 2 packed packed unaligned dcl 3-26 set ref 1602* switch_bits 002773 automatic bit(36) packed unaligned dcl 4667 set ref 185* 682 687* 1343 1346* 1370 1373* 1682* switch_condition 10(08) based bit(1) level 3 packed packed unaligned dcl 14-13 set ref 189* 1356* switch_name 10(09) based bit(1) level 3 packed packed unaligned dcl 14-13 set ref 178* 1790* syntax_line based structure level 1 unaligned dcl 375 syntax_line_ptr 000106 automatic pointer dcl 352 set ref 268* 270 275 282 285 285 290 292 295 297 299 301 303 319 334 337 syntax_table based structure array level 1 unaligned dcl 367 set ref 268 syntax_trace 134(16) based bit(1) level 2 packed packed unaligned dcl 3-26 ref 225 sys_name based structure level 1 unaligned dcl 484 t_field 2 based fixed bin(17,0) level 2 dcl 375 ref 275 292 295 t_type 1 based fixed bin(17,0) level 2 dcl 375 ref 270 table 20 based char(512) level 2 in structure "alphabet_name" packed packed unaligned dcl 4743 in procedure "cobol_idedsyn" set ref 2934 table based char(1) array packed unaligned dcl 2925 in procedure "set_table" set ref 2939* table_ptr 003506 automatic pointer dcl 2923 set ref 2934* 2939 tape 126 based structure level 2 packed packed unaligned dcl 4-25 set ref 2600 tape_device 321 based fixed bin(17,0) level 2 dcl 4-25 set ref 2606* 2727 2727 2729* 2729 2756* 2762* 2767* tape_device_key 323 based char(5) level 2 packed packed unaligned dcl 4-25 set ref 1862* 2731* 2731 2764* tape_device_num 322 based fixed bin(17,0) level 2 dcl 4-25 set ref 2730* 2730 2757* tbit 000112 automatic bit(1) packed unaligned dcl 355 set ref 225* 226 263 278 311 322 temp 123 based bit(1) level 2 packed packed unaligned dcl 4-25 set ref 2648 2656* 2660 2699 2699* 2699 temp1 001432 automatic fixed bin(17,0) dcl 4552 set ref 856 1139* 1139 1322 1668* 2283* 2973 2982 3734* temp2 001433 automatic fixed bin(17,0) dcl 4553 set ref 3735* temp3 001434 automatic fixed bin(17,0) dcl 4554 set ref 3736* temp4 001435 automatic fixed bin(17,0) dcl 4555 in procedure "cobol_idedsyn" set ref 1857* 1897 3745* 3750 temp4 003476 automatic fixed bin(17,0) dcl 2391 in procedure "enter_key" set ref 2393* 2422 temp6 001436 automatic fixed bin(17,0) dcl 4557 in procedure "cobol_idedsyn" set ref 3949* temp6 parameter fixed bin(17,0) dcl 2391 in procedure "enter_key" set ref 2388 2398 2405 2442 2442* 2442 2445 2447 temp_bit based bit(1) array packed unaligned dcl 4615 ref 4017 temp_offset 11 based fixed bin(24,0) level 2 dcl 5-17 set ref 2409* temp_seg 10 based fixed bin(17,0) level 2 dcl 5-17 set ref 2408* tempn1 001431 automatic fixed bin(17,0) dcl 4551 set ref 883* 886 tm1 000100 automatic fixed bin(17,0) initial dcl 341 set ref 278* 311* 322* 341* tm2 000101 automatic fixed bin(17,0) initial dcl 341 set ref 263* 341* tm3 000102 automatic fixed bin(17,0) initial dcl 341 set ref 341* tm4 000103 automatic fixed bin(17,0) initial dcl 341 set ref 341* tm5 000104 automatic fixed bin(17,0) initial dcl 341 set ref 341* trace_ptr 000110 automatic pointer dcl 352 set ref 224* 226* 263* 278* 311* 322* tran based structure array level 1 packed packed unaligned dcl 2926 tran_ptr 003510 automatic pointer dcl 2923 set ref 2935* 2939 tran_tab 001701 automatic fixed bin(17,0) array dcl 4643 set ref 1765* 2896* 2910* 2935 3404* 3426* type 3 based fixed bin(17,0) level 3 in structure "record" dcl 4435 in procedure "cobol_idedsyn" ref 433 435 627 879 944 1054 1280 1332 1383 1394 1426 1437 1645 type 3 based fixed bin(17,0) level 2 in structure "mnemonic_name" dcl 14-13 in procedure "cobol_idedsyn" set ref 1838* type based fixed bin(17,0) level 2 in structure "char_spec" dcl 3324 in procedure "also" ref 3329 type 3 000226 automatic fixed bin(17,0) level 2 in structure "diag_item" dcl 4463 in procedure "cobol_idedsyn" set ref 209* type based fixed bin(17,0) level 2 in structure "sys_name" dcl 484 in procedure "system_name" set ref 498* 514* 526* 531* 536* 541* 543* type 003033 automatic fixed bin(17,0) level 2 in structure "left_char_spec" dcl 4686 in procedure "cobol_idedsyn" set ref 1744 2743 2745 3441 type 3 based fixed bin(17,0) level 2 in structure "numeric_lit" dcl 8-14 in procedure "cobol_idedsyn" ref 1213 2754 3228 type 3 based fixed bin(17,0) level 2 in structure "alphanum_lit" dcl 10-14 in procedure "cobol_idedsyn" ref 1448 2507 2797 2826 3241 3592 type 003136 automatic fixed bin(17,0) level 2 in structure "right_char_spec" dcl 4691 in procedure "cobol_idedsyn" set ref 2743* 3492 3597* type 002777 automatic fixed bin(17,0) level 2 in structure "left" dcl 4670 in procedure "cobol_idedsyn" set ref 472 904 904 1143 1338 1365 3047 type 3 based fixed bin(17,0) level 2 in structure "reserved_word" dcl 6-14 in procedure "cobol_idedsyn" ref 272 502 695 770 1192 3201 3251 3693 4049 type 003015 automatic fixed bin(17,0) level 2 in structure "right" dcl 4678 in procedure "cobol_idedsyn" set ref 672 1073 1152 1152 1159 1166 1173 1173 1185 1365 3127* type 003257 automatic fixed bin(17,0) level 2 in structure "pcs" dcl 4703 in procedure "cobol_idedsyn" set ref 222* 1610* 3013 3013 3013 3023* 3025 3027* 3082 3086* type parameter fixed bin(17,0) dcl 3136 in procedure "set_iw_key" ref 3133 3142 type 3 000252 automatic fixed bin(17,0) level 2 in structure "lev_diag_item" dcl 4484 in procedure "cobol_idedsyn" set ref 215* type based fixed bin(17,0) level 2 in structure "char_spec" dcl 3223 in procedure "char_spec" set ref 3230* 3243* 3255* 3257* 3259* 3261* 3263* 3266* 3270* type 3 based fixed bin(17,0) level 2 in structure "user_word" dcl 4741 in procedure "cobol_idedsyn" ref 521 2412 2517 2760 2791 2828 3586 4071 type 3 based fixed bin(17,0) level 2 in structure "alphabet_name" dcl 4743 in procedure "cobol_idedsyn" set ref 1762* type17_size 001423 automatic fixed bin(17,0) dcl 4543 set ref 198 240* 1813 1823 user_word based structure level 1 unaligned dcl 4741 val 000155 automatic fixed bin(17,0) dcl 4401 set ref 3903* 3906* 3909* 3912* 3915* 3919* 3922* 3933* 3942 3945 value 1 003136 automatic fixed bin(17,0) level 2 in structure "right_char_spec" dcl 4691 in procedure "cobol_idedsyn" set ref 2744* 3502 value 1 based fixed bin(17,0) level 2 in structure "char_spec" dcl 3324 in procedure "also" set ref 3350* 3355* 3360* 3365* 3370* 3377* value 1 based fixed bin(17,0) level 2 in structure "char_spec" dcl 3223 in procedure "char_spec" set ref 3231* 3233 3233 value 1 003033 automatic fixed bin(17,0) level 2 in structure "left_char_spec" dcl 4686 in procedure "cobol_idedsyn" set ref 1744 2744 3446 variable_recs 33(18) based bit(1) level 2 packed packed unaligned dcl 4-25 set ref 2219* vector based bit(21) packed unaligned dcl 4613 set ref 2616* 4001 vector_temp 001511 automatic bit(21) packed unaligned dcl 4614 set ref 4001* 4003 4017 verb 5 based bit(1) level 2 packed packed unaligned dcl 6-14 set ref 3681 vlr_ind 0(09) 002760 automatic bit(1) level 2 packed packed unaligned dcl 4648 set ref 2219 2366* 3867* wnum 001654 automatic fixed bin(17,0) dcl 4637 set ref 316* 319 319 1205* 1208 word 1 001512 automatic char(12) array level 2 in structure "word_array" packed packed unaligned dcl 4616 in procedure "cobol_idedsyn" set ref 127* 129* 131* 133* 135* 137* 139* 141* 143* 145* 147* 149* 151* 153* 155* 157* 159* 161* 163* 165* 167* 4011 4020 word 6 based char level 2 in structure "user_word" packed packed unaligned dcl 4741 in procedure "cobol_idedsyn" ref 551 640 747 947 980 1484 1647 1828 1860 2074 2415 3749 word_array 001512 automatic structure array level 1 unaligned dcl 4616 word_size 001512 automatic fixed bin(17,0) array level 2 dcl 4616 set ref 126* 128* 130* 132* 134* 136* 138* 140* 142* 144* 146* 148* 150* 152* 154* 156* 158* 160* 162* 164* 166* 4010 4013 4020 4020 4023 4023 work_ptr 001410 automatic pointer dcl 4533 set ref 2430* 2433 2435* 3622* 3629 3631* 3757* 3760 3762* 3769* 3772 3774* zero 001364 automatic char(18) packed unaligned dcl 4523 set ref 73* 1060 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. addrform automatic fixed bin(17,0) dcl 4568 allo1_max defined fixed bin(17,0) dcl 1-171 allo1_ptr defined pointer dcl 1-67 alter_flag defined fixed bin(17,0) dcl 1-135 alter_index defined fixed bin(17,0) dcl 1-153 alter_list_ptr defined pointer dcl 1-39 banchar automatic char(1) packed unaligned dcl 4524 cd_cnt defined fixed bin(17,0) dcl 1-197 char builtin function dcl 4422 cobol_$allo1_max external static fixed bin(17,0) dcl 1-170 cobol_$allo1_ptr external static pointer dcl 1-66 cobol_$alter_flag external static fixed bin(17,0) dcl 1-134 cobol_$alter_index external static fixed bin(17,0) dcl 1-152 cobol_$alter_list_ptr external static pointer dcl 1-38 cobol_$cd_cnt external static fixed bin(17,0) dcl 1-196 cobol_$cobol_data_wd_off external static fixed bin(17,0) dcl 1-118 cobol_$compile_count external static fixed bin(17,0) dcl 1-142 cobol_$coms_charcnt external static fixed bin(17,0) dcl 1-188 cobol_$coms_wdoff external static fixed bin(17,0) dcl 1-202 cobol_$con_end_ptr external static pointer dcl 1-10 cobol_$con_wd_off external static fixed bin(17,0) dcl 1-92 cobol_$cons_charcnt external static fixed bin(17,0) dcl 1-192 cobol_$constant_offset external static fixed bin(17,0) dcl 1-156 cobol_$data_init_flag external static fixed bin(17,0) dcl 1-130 cobol_$date_compiled_sw external static fixed bin(17,0) dcl 1-180 cobol_$debug_enable external static fixed bin(17,0) dcl 1-174 cobol_$def_base_ptr external static pointer dcl 1-12 cobol_$def_max external static fixed bin(17,0) dcl 1-96 cobol_$def_wd_off external static fixed bin(17,0) dcl 1-94 cobol_$diag_ptr external static pointer dcl 1-70 cobol_$eln_max external static fixed bin(17,0) dcl 1-172 cobol_$eln_ptr external static pointer dcl 1-68 cobol_$fixup_max external static fixed bin(17,0) dcl 1-164 cobol_$fixup_ptr external static pointer dcl 1-30 cobol_$fs_charcnt external static fixed bin(17,0) dcl 1-184 cobol_$fs_wdoff external static fixed bin(17,0) dcl 1-198 cobol_$include_cnt external static fixed bin(17,0) dcl 1-182 cobol_$include_info_ptr external static pointer dcl 1-86 cobol_$init_stack_off external static fixed bin(17,0) dcl 1-124 cobol_$initval_base_ptr external static pointer dcl 1-32 cobol_$initval_file_ptr external static pointer dcl 1-34 cobol_$initval_flag external static fixed bin(17,0) dcl 1-178 cobol_$link_base_ptr external static pointer dcl 1-14 cobol_$link_max external static fixed bin(17,0) dcl 1-100 cobol_$link_wd_off external static fixed bin(17,0) dcl 1-98 cobol_$list_off external static fixed bin(17,0) dcl 1-154 cobol_$list_ptr external static pointer dcl 1-64 cobol_$ls_charcnt external static fixed bin(17,0) dcl 1-190 cobol_$main_pcs_ptr external static pointer dcl 1-84 cobol_$map_data_max external static fixed bin(17,0) dcl 1-162 cobol_$map_data_ptr external static pointer dcl 1-54 cobol_$max_stack_off external static fixed bin(17,0) dcl 1-122 cobol_$minpral5_ptr external static pointer dcl 1-50 cobol_$misc_base_ptr external static pointer dcl 1-60 cobol_$misc_max external static fixed bin(17,0) dcl 1-158 cobol_$next_tag external static fixed bin(17,0) dcl 1-128 cobol_$non_source_offset external static fixed bin(17,0) dcl 1-176 cobol_$ntbuf_ptr external static pointer dcl 1-82 cobol_$obj_seg_name external static char(32) dcl 1-208 cobol_$op_con_ptr external static pointer dcl 1-80 cobol_$para_eop_flag external static fixed bin(17,0) dcl 1-138 cobol_$pd_map_index external static fixed bin(17,0) dcl 1-116 cobol_$pd_map_max external static fixed bin(17,0) dcl 1-160 cobol_$pd_map_ptr external static pointer dcl 1-28 cobol_$pd_map_sw external static fixed bin(17,0) dcl 1-126 cobol_$perform_list_ptr external static pointer dcl 1-36 cobol_$perform_para_index external static fixed bin(17,0) dcl 1-148 cobol_$perform_sect_index external static fixed bin(17,0) dcl 1-150 cobol_$priority_no external static fixed bin(17,0) dcl 1-140 cobol_$ptr_assumption_ind external static fixed bin(17,0) dcl 1-144 cobol_$ptr_status_ptr external static pointer dcl 1-56 cobol_$reg_assumption_ind external static fixed bin(17,0) dcl 1-146 cobol_$reg_status_ptr external static pointer dcl 1-58 cobol_$reloc_def_base_ptr external static pointer dcl 1-20 cobol_$reloc_def_max external static fixed bin(24,0) dcl 1-108 cobol_$reloc_link_base_ptr external static pointer dcl 1-22 cobol_$reloc_link_max external static fixed bin(24,0) dcl 1-110 cobol_$reloc_sym_base_ptr external static pointer dcl 1-24 cobol_$reloc_sym_max external static fixed bin(24,0) dcl 1-112 cobol_$reloc_text_base_ptr external static pointer dcl 1-18 cobol_$reloc_text_max external static fixed bin(24,0) dcl 1-106 cobol_$reloc_work_base_ptr external static pointer dcl 1-26 cobol_$reloc_work_max external static fixed bin(24,0) dcl 1-114 cobol_$reswd_ptr external static pointer dcl 1-78 cobol_$same_sort_merge_proc external static bit(1) dcl 1-214 cobol_$scratch_dir external static char(168) dcl 1-206 cobol_$sect_eop_flag external static fixed bin(17,0) dcl 1-136 cobol_$seg_init_flag external static fixed bin(17,0) dcl 1-132 cobol_$seg_init_list_ptr external static pointer dcl 1-40 cobol_$stack_off external static fixed bin(17,0) dcl 1-120 cobol_$statement_info_ptr external static pointer dcl 1-76 cobol_$sym_base_ptr external static pointer dcl 1-16 cobol_$sym_max external static fixed bin(17,0) dcl 1-104 cobol_$sym_wd_off external static fixed bin(17,0) dcl 1-102 cobol_$tag_table_max external static fixed bin(17,0) dcl 1-166 cobol_$tag_table_ptr external static pointer dcl 1-52 cobol_$temp_token_area_ptr external static pointer dcl 1-42 cobol_$temp_token_max external static fixed bin(17,0) dcl 1-168 cobol_$temp_token_ptr external static pointer dcl 1-44 cobol_$text_base_ptr external static pointer dcl 1-8 cobol_$text_wd_off external static fixed bin(17,0) dcl 1-90 cobol_$token_block1_ptr external static pointer dcl 1-46 cobol_$token_block2_ptr external static pointer dcl 1-48 cobol_$value_cnt external static fixed bin(17,0) dcl 1-194 cobol_$ws_charcnt external static fixed bin(17,0) dcl 1-186 cobol_$ws_wdoff external static fixed bin(17,0) dcl 1-200 cobol_$xref_bypass external static bit(1) dcl 1-212 cobol_$xref_chain_ptr external static pointer dcl 1-74 cobol_$xref_token_ptr external static pointer dcl 1-72 cobol_afp defined pointer dcl 2-11 cobol_analin_fileno defined pointer dcl 2-13 cobol_cmfp defined pointer dcl 2-21 cobol_curr_in defined pointer dcl 2-53 cobol_curr_out defined pointer dcl 2-55 cobol_data_wd_off defined fixed bin(17,0) dcl 1-119 cobol_dfp defined pointer dcl 2-27 cobol_eltp defined pointer dcl 2-19 cobol_ext_$cobol_afp external static pointer dcl 2-10 cobol_ext_$cobol_analin_fileno external static pointer dcl 2-12 cobol_ext_$cobol_cmfp external static pointer dcl 2-20 cobol_ext_$cobol_curr_in external static pointer dcl 2-52 cobol_ext_$cobol_curr_out external static pointer dcl 2-54 cobol_ext_$cobol_dfp external static pointer dcl 2-26 cobol_ext_$cobol_eltp external static pointer dcl 2-18 cobol_ext_$cobol_fileno1 external static fixed bin(24,0) dcl 2-78 cobol_ext_$cobol_hfp external static pointer dcl 2-28 cobol_ext_$cobol_lpr external static char(5) packed unaligned dcl 2-95 cobol_ext_$cobol_m1fp external static pointer dcl 2-30 cobol_ext_$cobol_m2fp external static pointer dcl 2-32 cobol_ext_$cobol_min2_fileno_ptr external static pointer dcl 2-36 cobol_ext_$cobol_name_fileno_ptr external static pointer dcl 2-40 cobol_ext_$cobol_ntfp external static pointer dcl 2-42 cobol_ext_$cobol_options external static char(120) packed unaligned dcl 2-97 cobol_ext_$cobol_options_len external static fixed bin(24,0) dcl 2-80 cobol_ext_$cobol_pdofp external static pointer dcl 2-44 cobol_ext_$cobol_pdout_fileno external static fixed bin(24,0) dcl 2-82 cobol_ext_$cobol_pfp external static pointer dcl 2-46 cobol_ext_$cobol_print_fileno external static fixed bin(24,0) dcl 2-84 cobol_ext_$cobol_rm2fp external static pointer dcl 2-48 cobol_ext_$cobol_rmin2_fileno external static fixed bin(24,0) dcl 2-86 cobol_ext_$cobol_rmin2fp external static pointer dcl 2-50 cobol_ext_$cobol_rwdd external static pointer dcl 2-72 cobol_ext_$cobol_rwpd external static pointer dcl 2-74 cobol_ext_$cobol_sfp external static pointer dcl 2-56 cobol_ext_$cobol_w1p external static pointer dcl 2-58 cobol_ext_$cobol_w2p external static pointer dcl 2-60 cobol_ext_$cobol_w3p external static pointer dcl 2-62 cobol_ext_$cobol_w5p external static pointer dcl 2-64 cobol_ext_$cobol_w6p external static pointer dcl 2-66 cobol_ext_$cobol_w7p external static pointer dcl 2-68 cobol_ext_$cobol_x1_fileno external static fixed bin(24,0) dcl 2-88 cobol_ext_$cobol_x2_fileno external static fixed bin(24,0) dcl 2-90 cobol_ext_$cobol_x3_fileno external static fixed bin(24,0) dcl 2-92 cobol_ext_$cobol_x3fp external static pointer dcl 2-70 cobol_ext_$cobol_xlast8 external static bit(1) packed unaligned dcl 2-100 cobol_ext_$report_exists external static bit(1) packed unaligned dcl 2-102 cobol_ext_$report_first_token external static pointer dcl 2-14 cobol_ext_$report_last_token external static pointer dcl 2-16 cobol_fileno1 defined fixed bin(24,0) dcl 2-79 cobol_hfp defined pointer dcl 2-29 cobol_lpr defined char(5) packed unaligned dcl 2-96 cobol_m1fp defined pointer dcl 2-31 cobol_m2fp defined pointer dcl 2-33 cobol_min2_fileno_ptr defined pointer dcl 2-37 cobol_name_fileno_ptr defined pointer dcl 2-41 cobol_ntfp defined pointer dcl 2-43 cobol_options defined char(120) packed unaligned dcl 2-98 cobol_options_len defined fixed bin(24,0) dcl 2-81 cobol_pdofp defined pointer dcl 2-45 cobol_pdout_fileno defined fixed bin(24,0) dcl 2-83 cobol_pfp defined pointer dcl 2-47 cobol_print_fileno defined fixed bin(24,0) dcl 2-85 cobol_rm2fp defined pointer dcl 2-49 cobol_rmin2_fileno defined fixed bin(24,0) dcl 2-87 cobol_rmin2fp defined pointer dcl 2-51 cobol_rwdd defined pointer dcl 2-73 cobol_rwpd defined pointer dcl 2-75 cobol_sfp defined pointer dcl 2-57 cobol_w1p defined pointer dcl 2-59 cobol_w2p defined pointer dcl 2-61 cobol_w3p defined pointer dcl 2-63 cobol_w5p defined pointer dcl 2-65 cobol_w6p defined pointer dcl 2-67 cobol_w7p defined pointer dcl 2-69 cobol_x1_fileno defined fixed bin(24,0) dcl 2-89 cobol_x2_fileno defined fixed bin(24,0) dcl 2-91 cobol_x3_fileno defined fixed bin(24,0) dcl 2-93 cobol_x3fp defined pointer dcl 2-71 cobol_xlast8 defined bit(1) packed unaligned dcl 2-101 comp_name automatic fixed bin(17,0) dcl 4637 compile_count defined fixed bin(17,0) dcl 1-143 coms_charcnt defined fixed bin(17,0) dcl 1-189 coms_wdoff defined fixed bin(17,0) dcl 1-203 con_end_ptr defined pointer dcl 1-11 con_wd_off defined fixed bin(17,0) dcl 1-93 cons_charcnt defined fixed bin(17,0) dcl 1-193 constant_offset defined fixed bin(17,0) dcl 1-157 current_file_no automatic fixed bin(17,0) dcl 4529 data_init_flag defined fixed bin(17,0) dcl 1-131 date_compiled_sw defined fixed bin(17,0) dcl 1-181 debug_enable defined fixed bin(17,0) dcl 1-175 def_base_ptr defined pointer dcl 1-13 def_max defined fixed bin(17,0) dcl 1-97 def_wd_off defined fixed bin(17,0) dcl 1-95 diag_ptr defined pointer dcl 1-71 eln_max defined fixed bin(17,0) dcl 1-173 eln_ptr defined pointer dcl 1-69 fbarray based fixed bin(17,0) array dcl 4621 fixup_max defined fixed bin(17,0) dcl 1-165 fixup_ptr defined pointer dcl 1-31 fs_charcnt defined fixed bin(17,0) dcl 1-185 fs_wdoff defined fixed bin(17,0) dcl 1-199 include_cnt defined fixed bin(17,0) dcl 1-183 include_info_ptr defined pointer dcl 1-87 init_stack_off defined fixed bin(17,0) dcl 1-125 initval_base_ptr defined pointer dcl 1-33 initval_file_ptr defined pointer dcl 1-35 initval_flag defined fixed bin(17,0) dcl 1-179 last_fkey_ptr automatic char(5) packed unaligned dcl 4510 link_base_ptr defined pointer dcl 1-15 link_max defined fixed bin(17,0) dcl 1-101 link_wd_off defined fixed bin(17,0) dcl 1-99 list_off defined fixed bin(17,0) dcl 1-155 list_ptr defined pointer dcl 1-65 loc automatic fixed bin(17,0) dcl 3322 ls_charcnt defined fixed bin(17,0) dcl 1-191 main_pcs_ptr defined pointer dcl 1-85 map_data_max defined fixed bin(17,0) dcl 1-163 map_data_ptr defined pointer dcl 1-55 max automatic fixed bin(17,0) dcl 4637 max_stack_off defined fixed bin(17,0) dcl 1-123 minpral5_ptr defined pointer dcl 1-51 misc_base_ptr defined pointer dcl 1-61 misc_end_ptr defined pointer dcl 1-63 misc_max defined fixed bin(17,0) dcl 1-159 n1 automatic fixed bin(17,0) dcl 4550 next_tag defined fixed bin(17,0) dcl 1-129 non_source_offset defined fixed bin(17,0) dcl 1-177 ntbuf_ptr defined pointer dcl 1-83 obj_seg_name defined char(32) dcl 1-209 op_con_ptr defined pointer dcl 1-81 opt_num automatic fixed bin(17,0) dcl 4637 padchar automatic char(1) packed unaligned dcl 4525 para_eop_flag defined fixed bin(17,0) dcl 1-139 pd_map_index defined fixed bin(17,0) dcl 1-117 pd_map_max defined fixed bin(17,0) dcl 1-161 pd_map_ptr defined pointer dcl 1-29 pd_map_sw defined fixed bin(17,0) dcl 1-127 perform_list_ptr defined pointer dcl 1-37 perform_para_index defined fixed bin(17,0) dcl 1-149 perform_sect_index defined fixed bin(17,0) dcl 1-151 priority_no defined fixed bin(17,0) dcl 1-141 ptr_assumption_ind defined fixed bin(17,0) dcl 1-145 ptr_status_ptr defined pointer dcl 1-57 reg_assumption_ind defined fixed bin(17,0) dcl 1-147 reg_status_ptr defined pointer dcl 1-59 rel builtin function dcl 4422 reloc_def_base_ptr defined pointer dcl 1-21 reloc_def_max defined fixed bin(24,0) dcl 1-109 reloc_link_base_ptr defined pointer dcl 1-23 reloc_link_max defined fixed bin(24,0) dcl 1-111 reloc_sym_base_ptr defined pointer dcl 1-25 reloc_sym_max defined fixed bin(24,0) dcl 1-113 reloc_text_base_ptr defined pointer dcl 1-19 reloc_text_max defined fixed bin(24,0) dcl 1-107 reloc_work_base_ptr defined pointer dcl 1-27 reloc_work_max defined fixed bin(24,0) dcl 1-115 report_exists defined bit(1) packed unaligned dcl 2-103 report_first_token defined pointer dcl 2-15 report_last_token defined pointer dcl 2-17 reswd_ptr defined pointer dcl 1-79 same_ptr automatic pointer dcl 4537 same_ptr_key automatic char(5) packed unaligned dcl 4509 same_sort_merge_proc defined bit(1) dcl 1-215 save_common_key automatic char(5) packed unaligned dcl 4570 save_ptr automatic pointer dcl 4533 scratch_dir defined char(168) dcl 1-207 sect_eop_flag defined fixed bin(17,0) dcl 1-137 seg_init_flag defined fixed bin(17,0) dcl 1-133 seg_init_list_ptr defined pointer dcl 1-41 source_comp_name automatic fixed bin(17,0) dcl 4637 stack_off defined fixed bin(17,0) dcl 1-121 statement_info_ptr defined pointer dcl 1-77 sym_base_ptr defined pointer dcl 1-17 sym_max defined fixed bin(17,0) dcl 1-105 sym_wd_off defined fixed bin(17,0) dcl 1-103 tag_table_max defined fixed bin(17,0) dcl 1-167 tag_table_ptr defined pointer dcl 1-53 temp5 automatic fixed bin(17,0) dcl 4556 temp_token_area_ptr defined pointer dcl 1-43 temp_token_max defined fixed bin(17,0) dcl 1-169 temp_token_ptr defined pointer dcl 1-45 text_base_ptr defined pointer dcl 1-9 text_wd_off defined fixed bin(17,0) dcl 1-91 token_block1_ptr defined pointer dcl 1-47 token_block2_ptr defined pointer dcl 1-49 unspec builtin function dcl 4422 value_cnt defined fixed bin(17,0) dcl 1-195 ws_charcnt defined fixed bin(17,0) dcl 1-187 ws_wdoff defined fixed bin(17,0) dcl 1-201 x based bit(8) packed unaligned dcl 4518 xref_bypass defined bit(1) dcl 1-213 xref_chain_ptr defined pointer dcl 1-75 xref_token_ptr defined pointer dcl 1-73 NAMES DECLARED BY EXPLICIT CONTEXT. AL 000600 constant label array(0:7) dcl 3331 set ref 3329 AL1 014301 constant label dcl 3375 ref 3334 3353 3358 3363 3368 3373 AP 000453 constant label array(7) dcl 2648 ref 2643 AR 000574 constant label array(0:3) dcl 3298 ref 3296 AR1 014161 constant label dcl 3315 ref 3298 3304 3310 ATO 000436 constant label array(13) dcl 2541 set ref 2539 D 000514 constant label array(6) dcl 4155 ref 4150 FA 000433 constant label array(3) dcl 2178 set ref 2172 FCC 000410 constant label array(13) dcl 2072 ref 2066 FO 000425 constant label array(6) dcl 2087 ref 2085 FO1 005535 constant label dcl 2158 ref 2106 2123 2140 2145 2150 2156 FT 000534 constant label array(10) dcl 1957 ref 1955 FT1 013163 constant label dcl 2012 ref 1960 1965 1969 1973 1977 1981 1985 2001 2006 2010 IMP 000567 constant label array(5) dcl 3181 ref 3178 IMP0 013750 constant label dcl 3198 ref 3184 3186 3189 3192 3195 LEV1 013237 constant entry internal dcl 2047 ref 1959 1972 1980 1984 1990 2005 2009 LEV2 013250 constant entry internal dcl 2056 ref 1968 1976 LT 000363 constant label array(0:6) dcl 1147 ref 1143 OC 000401 constant label array(7) dcl 1602 set ref 1597 RN 000473 constant label array(0:3) dcl 3803 ref 3801 RN1 010556 constant label dcl 3822 ref 3803 3809 3814 3820 SA 000522 constant label array(5) dcl 4264 ref 4261 SA0 011644 constant label dcl 4282 ref 4266 4270 4274 4276 4281 SC 000376 constant label array(3) dcl 1540 ref 1535 SL 000477 constant label array(13) dcl 3903 ref 3901 SLL 011000 constant label dcl 3942 ref 3905 3908 3911 3914 3918 3921 3924 3936 SM 000372 constant label array(4) dcl 1253 ref 1248 SMN 000462 constant label array(4) dcl 2848 ref 2846 SMN1 007132 constant label dcl 2866 ref 2851 2856 2858 2864 SNP 000466 constant label array(5) dcl 3065 ref 3059 SRA 000527 constant label array(5) dcl 4313 ref 4310 SRA0 011722 constant label dcl 4338 ref 4321 4325 4329 4331 4336 STD 000564 constant label array(3) dcl 3155 ref 3151 STD0 013724 constant label dcl 3170 ref 3153 3158 3163 3168 T 000546 constant label array(14) dcl 2449 ref 2447 T1 013611 constant label dcl 2493 in procedure "enter_key" ref 2451 2454 2457 2460 2466 2468 2472 2475 2478 2479 2481 2485 2488 2491 T1 014531 constant label dcl 3492 in procedure "range" ref 3449 3465 3470 3475 3480 3485 3490 T2 014662 constant label dcl 3557 ref 3500 3506 3523 3529 3536 3542 3548 3554 TL 000610 constant label array(0:7) dcl 3443 set ref 3441 TR 000620 constant label array(0:7) dcl 3495 ref 3492 action 000077 constant label array(0:179) dcl 327 ref 290 314 430 alf_ent 012655 constant entry internal dcl 1779 ref 1770 alfnam 002440 constant label dcl 468 alloc 011750 constant entry internal dcl 232 ref 75 alphanmlit 004236 constant label dcl 1383 also 014162 constant entry internal dcl 3318 ref 3306 3308 3312 areaa 002453 constant label dcl 569 asgn 002504 constant label dcl 582 begrun 004514 constant label dcl 1501 buildft 005212 constant label dcl 1851 buildnm 012711 constant entry internal dcl 1835 ref 202 1819 1831 catalphalit 004363 constant label dcl 1446 catusrwd 004334 constant label dcl 1424 char_spec 013751 constant entry internal dcl 3218 ref 1743 2739 3275 charst1 004347 constant label dcl 1435 chckft 002544 constant label dcl 608 check 000003 constant label array(0:59) dcl 316 ref 292 check12a 002761 constant label dcl 747 ref 757 check33a 003662 constant label dcl 1093 ref 1084 check34a 003676 constant label dcl 1111 ref 1103 check34b 003707 constant label dcl 1119 ref 1106 check_ft 012376 constant entry internal dcl 616 ref 608 ckintnm 004420 constant label dcl 1473 cknew 002732 constant label dcl 741 ckpnm 003176 constant label dcl 831 cktemp1 003217 constant label dcl 856 clorder 002447 constant label dcl 558 cobol_idedsyn 001440 constant entry external dcl 58 comp_test 002550 constant label dcl 663 comptype 002512 constant label dcl 588 computer_name 012520 constant entry internal dcl 1302 ref 912 1292 currlit 003233 constant label dcl 879 decptok 003257 constant label dcl 896 def_clause_num 014733 constant entry internal dcl 4046 ref 4041 4124 4218 4224 denint 004407 constant label dcl 1463 diag 012016 constant entry internal dcl 383 ref 331 956 973 1017 1131 1244 2641 2654 3034 3080 3236 3976 3987 dtb 015161 constant entry internal dcl 4376 ref 1063 dup_order 011516 constant label dcl 4210 ref 1540 1546 1548 1605 1607 1615 1620 1622 1628 1633 3065 3068 3093 3101 3107 3678 4155 4171 4193 4203 4208 dupdef 004401 constant label dcl 1456 dupdev 002556 constant label dcl 672 dupopt 003222 constant label dcl 862 dupsw 002573 constant label dcl 682 emit_ft 012744 constant entry internal dcl 1903 ref 3786 emit_range 014666 constant entry internal dcl 3564 ref 3498 3504 3512 3527 3534 3540 3546 3552 enter_key 013261 constant entry internal dcl 2388 ref 2349 2384 2515 2520 2763 2794 2800 2826 2830 3590 3664 3675 3952 fail 002205 constant label dcl 263 ref 272 275 319 472 563 576 586 597 614 668 672 682 695 710 730 747 790 802 813 824 835 842 849 860 862 873 879 886 896 904 916 927 935 944 965 1035 1044 1073 1091 1097 1117 1123 1137 1197 1208 1213 1220 1234 1251 1257 1263 1268 1274 1280 1290 1296 1326 1336 1338 1343 1365 1370 1387 1394 1400 1408 1409 1411 1413 1420 1426 1428 1437 1439 1448 1450 1461 1471 1484 figcon 004021 constant label dcl 1192 fileorg 002604 constant label dcl 691 filequal 002677 constant label dcl 721 get_seg_limit 011726 constant entry external dcl 4384 idparnm 003022 constant label dcl 770 implnm 003341 constant label dcl 941 implnm1 003614 constant label dcl 1030 in_dev 003137 constant label dcl 806 init_alpha 013637 constant entry internal dcl 3109 ref 2878 3140 integer 012466 constant entry internal dcl 1048 ref 1041 1463 integr 003632 constant label dcl 1041 intpos 007302 constant label dcl 2957 io_error 012461 constant label dcl 653 ref 637 644 is_alf 003212 constant label dcl 844 is_dev 003206 constant label dcl 837 is_sw 003226 constant label dcl 868 keyok 003650 constant label dcl 1084 keyreqd 003667 constant label dcl 1103 leftname 003271 constant label dcl 900 lev_diag 012047 constant entry internal dcl 400 ref 285 304 573 714 785 793 1748 3246 3649 3978 4235 4253 4305 4319 4356 4362 loop 002221 constant label dcl 268 ref 230 339 455 2996 3611 3620 3643 multok 003714 constant label dcl 1127 nm 012662 constant entry internal dcl 1796 ref 180 1792 3824 oc_name 003302 constant label dcl 912 orgqualok 004260 constant label dcl 1404 out_dev 003156 constant label dcl 817 range 014404 constant entry internal dcl 3434 ref 3301 range_spec 014136 constant entry internal dcl 3291 ref 3280 3286 3600 recovword 004244 constant label dcl 1394 rempar 003307 constant label dcl 922 reset_alpha 012607 constant entry internal dcl 1752 ref 1740 3138 ret 002417 constant label dcl 327 ref 287 325 1512 1519 1533 1538 1563 1587 1600 1638 1649 1656 1663 1672 1686 1703 1710 1716 1721 1728 1733 1738 1750 1794 1833 1901 2070 2076 2078 2165 2170 2176 2181 2187 2193 2198 2200 2203 2206 2227 2232 2237 2242 2247 2254 2263 2285 2308 2334 2347 2352 2357 2373 2386 2524 2529 2541 2544 2547 2553 2555 2561 2566 2577 2588 2593 2610 2635 2646 2658 2665 2671 2677 2686 2697 2737 2748 2750 2769 2771 2785 2787 2805 2807 2820 2822 2833 2841 2843 2871 2876 2918 2948 2953 2966 2977 2985 3005 3045 3051 3057 3063 3131 3216 3278 3284 3289 3595 3602 3638 3653 3659 3666 3677 3686 3697 3727 3738 3781 3789 3826 3925 3927 3929 3931 3937 3946 3954 4039 4044 4102 4113 4126 4128 4140 4148 4153 4198 4216 4222 4228 4233 4239 4243 4247 4251 4257 4282 4313 4338 rightname 003640 constant label dcl 1069 sa_mess 015050 constant entry internal dcl 4294 ref 4268 4272 4279 samefree 004106 constant label dcl 1240 sav_lin_col 015151 constant entry internal dcl 4367 ref 4245 sc_name 004160 constant label dcl 1292 scan 012072 constant entry internal dcl 419 ref 228 334 set_also_char 014322 constant entry internal dcl 3390 ref 3344 3377 set_char 014361 constant entry internal dcl 3417 ref 3461 3519 3573 3579 set_iw_key 013665 constant entry internal dcl 3133 ref 3027 3127 set_offset 013725 constant entry internal dcl 3173 ref 3029 3129 set_pcs_loc 012600 constant entry internal dcl 1589 ref 1575 2590 set_sw 012556 constant entry internal dcl 1351 ref 759 1347 1375 set_table 013613 constant entry internal dcl 2920 ref 2916 setup 014314 constant entry internal dcl 3381 ref 3339 3375 smal50 004100 constant label dcl 1230 sncl 003734 constant label dcl 1143 sortfile 003313 constant label dcl 930 specnam 004143 constant label dcl 1280 sra_mess 015101 constant entry internal dcl 4345 ref 4323 4327 4334 success 002236 constant label dcl 278 ref 475 558 569 582 592 602 611 663 679 689 717 725 735 741 751 765 798 810 821 831 837 844 856 866 868 889 899 907 920 922 930 961 1022 1030 1046 1076 1088 1093 1109 1111 1114 1119 1141 1150 1157 1164 1171 1178 1183 1190 1192 1199 1211 1223 1230 1246 1253 1259 1265 1270 1283 1285 1287 1300 1322 1332 1349 1377 1383 1397 1404 1415 1417 1431 1442 1454 1456 1468 1473 1487 switch 004200 constant label dcl 1338 switch_1 004215 constant label dcl 1365 switch_2 003020 constant label dcl 759 switchnm 004033 constant label dcl 1205 system_name 012163 constant entry internal dcl 478 ref 468 900 1069 temp1eq1 004166 constant label dcl 1322 tempint 004047 constant label dcl 1213 test 000000 constant label array(0:2) dcl 272 ref 270 ucon 002251 constant label dcl 282 usrwd 004173 constant label dcl 1332 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 16026 16122 15472 16036 Length 16764 15472 74 625 333 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_idedsyn 2634 external procedure is an external procedure. alloc internal procedure shares stack frame of external procedure cobol_idedsyn. diag internal procedure shares stack frame of external procedure cobol_idedsyn. lev_diag internal procedure shares stack frame of external procedure cobol_idedsyn. scan internal procedure shares stack frame of external procedure cobol_idedsyn. system_name internal procedure shares stack frame of external procedure cobol_idedsyn. check_ft internal procedure shares stack frame of external procedure cobol_idedsyn. integer internal procedure shares stack frame of external procedure cobol_idedsyn. computer_name internal procedure shares stack frame of external procedure cobol_idedsyn. set_sw internal procedure shares stack frame of external procedure cobol_idedsyn. set_pcs_loc internal procedure shares stack frame of external procedure cobol_idedsyn. reset_alpha internal procedure shares stack frame of external procedure cobol_idedsyn. alf_ent internal procedure shares stack frame of external procedure cobol_idedsyn. nm internal procedure shares stack frame of external procedure cobol_idedsyn. buildnm internal procedure shares stack frame of external procedure cobol_idedsyn. emit_ft internal procedure shares stack frame of external procedure cobol_idedsyn. LEV1 internal procedure shares stack frame of external procedure cobol_idedsyn. LEV2 internal procedure shares stack frame of external procedure cobol_idedsyn. enter_key internal procedure shares stack frame of external procedure cobol_idedsyn. set_table internal procedure shares stack frame of external procedure cobol_idedsyn. init_alpha internal procedure shares stack frame of external procedure cobol_idedsyn. set_iw_key internal procedure shares stack frame of external procedure cobol_idedsyn. set_offset internal procedure shares stack frame of external procedure cobol_idedsyn. char_spec internal procedure shares stack frame of external procedure cobol_idedsyn. range_spec internal procedure shares stack frame of external procedure cobol_idedsyn. also internal procedure shares stack frame of external procedure cobol_idedsyn. setup internal procedure shares stack frame of external procedure cobol_idedsyn. set_also_char internal procedure shares stack frame of external procedure cobol_idedsyn. set_char internal procedure shares stack frame of external procedure cobol_idedsyn. range internal procedure shares stack frame of external procedure cobol_idedsyn. emit_range internal procedure shares stack frame of external procedure cobol_idedsyn. def_clause_num internal procedure shares stack frame of external procedure cobol_idedsyn. sa_mess internal procedure shares stack frame of external procedure cobol_idedsyn. sra_mess internal procedure shares stack frame of external procedure cobol_idedsyn. sav_lin_col internal procedure shares stack frame of external procedure cobol_idedsyn. dtb internal procedure shares stack frame of external procedure cobol_idedsyn. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 seg_limit cobol_idedsyn STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_idedsyn 000100 tm1 cobol_idedsyn 000101 tm2 cobol_idedsyn 000102 tm3 cobol_idedsyn 000103 tm4 cobol_idedsyn 000104 tm5 cobol_idedsyn 000106 syntax_line_ptr cobol_idedsyn 000110 trace_ptr cobol_idedsyn 000112 tbit cobol_idedsyn 000113 diag_num cobol_idedsyn 000114 kill_diag cobol_idedsyn 000116 interp cobol_idedsyn 000130 org_vector cobol_idedsyn 000132 same_loc cobol_idedsyn 000134 level_num cobol_idedsyn 000144 rec_loc cobol_idedsyn 000146 sort_name cobol_idedsyn 000147 LEV cobol_idedsyn 000150 lev1_org cobol_idedsyn 000152 lev2_org cobol_idedsyn 000154 dynamic_acc cobol_idedsyn 000155 val cobol_idedsyn 000156 source_pos cobol_idedsyn 000202 lev1_mod cobol_idedsyn 000210 lev2_mod cobol_idedsyn 000216 mod_num cobol_idedsyn 000217 act_num cobol_idedsyn 000220 org cobol_idedsyn 000222 dyn cobol_idedsyn 000224 LEV_NUM cobol_idedsyn 000225 MOD_NUM cobol_idedsyn 000226 diag_item cobol_idedsyn 000246 qualif cobol_idedsyn 000250 save cobol_idedsyn 000252 lev_diag_item cobol_idedsyn 000261 n_reducs cobol_idedsyn 000262 min1_status cobol_idedsyn 000263 com_status cobol_idedsyn 000264 name_status cobol_idedsyn 000265 ft_size cobol_idedsyn 000266 prev_qual_key cobol_idedsyn 000270 last_prev_file_key cobol_idedsyn 000272 last_ft_ptr cobol_idedsyn 000274 file_key_type cobol_idedsyn 000275 qual_sw cobol_idedsyn 000276 com_io_key cobol_idedsyn 000300 file_key_area cobol_idedsyn 000400 ft_build_area cobol_idedsyn 001364 zero cobol_idedsyn 001371 error cobol_idedsyn 001372 device_name_size cobol_idedsyn 001373 device_name cobol_idedsyn 001404 name_ptr cobol_idedsyn 001406 ft_ptr cobol_idedsyn 001410 work_ptr cobol_idedsyn 001412 fkey_ptr cobol_idedsyn 001414 qual_ptr cobol_idedsyn 001416 diag1_ptr cobol_idedsyn 001420 diag2_ptr cobol_idedsyn 001422 file_table_size cobol_idedsyn 001423 type17_size cobol_idedsyn 001424 file_key_size cobol_idedsyn 001425 key_qual_size cobol_idedsyn 001426 i cobol_idedsyn 001427 j cobol_idedsyn 001430 n cobol_idedsyn 001431 tempn1 cobol_idedsyn 001432 temp1 cobol_idedsyn 001433 temp2 cobol_idedsyn 001434 temp3 cobol_idedsyn 001435 temp4 cobol_idedsyn 001436 temp6 cobol_idedsyn 001437 num_binary cobol_idedsyn 001440 mrcsz cobol_idedsyn 001441 samect cobol_idedsyn 001442 samerecct cobol_idedsyn 001443 samesct cobol_idedsyn 001444 samesmct cobol_idedsyn 001445 same_type cobol_idedsyn 001446 nat_alf_size cobol_idedsyn 001447 orig_alf_size cobol_idedsyn 001450 mult_fil_no cobol_idedsyn 001451 recovaddress cobol_idedsyn 001452 common_recsize cobol_idedsyn 001454 common_key cobol_idedsyn 001456 name_key cobol_idedsyn 001460 rerunclock cobol_idedsyn 001461 remarksbit cobol_idedsyn 001462 debugbit cobol_idedsyn 001463 optional_file cobol_idedsyn 001464 external_file cobol_idedsyn 001465 previous_valid_fkeys cobol_idedsyn 001466 implnm_bit cobol_idedsyn 001467 ed_found cobol_idedsyn 001470 console_name cobol_idedsyn 001471 dec_is_com cobol_idedsyn 001472 dpass_sw cobol_idedsyn 001473 array cobol_idedsyn 001510 property cobol_idedsyn 001511 vector_temp cobol_idedsyn 001512 word_array cobol_idedsyn 001636 options_bits cobol_idedsyn 001637 lead_trail cobol_idedsyn 001640 file_org cobol_idedsyn 001641 file_qual cobol_idedsyn 001642 fq cobol_idedsyn 001643 ord_num cobol_idedsyn 001644 alf_range cobol_idedsyn 001645 ord_max cobol_idedsyn 001646 curr_ord_num cobol_idedsyn 001647 sep_sign cobol_idedsyn 001650 key cobol_idedsyn 001651 apply_num cobol_idedsyn 001652 left_number cobol_idedsyn 001653 right_number cobol_idedsyn 001654 wnum cobol_idedsyn 001655 comp_num cobol_idedsyn 001656 obj_comp_num cobol_idedsyn 001657 source_comp_num cobol_idedsyn 001660 alf_type cobol_idedsyn 001661 alf_size cobol_idedsyn 001662 alf_num cobol_idedsyn 001663 high_value_value cobol_idedsyn 001664 alphabet_name_size cobol_idedsyn 001665 cat_type cobol_idedsyn 001666 file_acc cobol_idedsyn 001667 last_clause cobol_idedsyn 001670 clause_order cobol_idedsyn 001671 clause_num cobol_idedsyn 001672 seg_lim cobol_idedsyn 001673 int_res cobol_idedsyn 001674 obj_comp_name cobol_idedsyn 001675 acc_dev_num cobol_idedsyn 001676 disp_dev_num cobol_idedsyn 001677 queue_name cobol_idedsyn 001700 comp_type cobol_idedsyn 001701 tran_tab cobol_idedsyn 002701 nat_bits cobol_idedsyn 002720 coll_seq cobol_idedsyn 002760 indicators cobol_idedsyn 002762 file_ptr cobol_idedsyn 002764 alpha_ptr cobol_idedsyn 002766 def_ptr cobol_idedsyn 002770 char1_ptr cobol_idedsyn 002772 clause_bits cobol_idedsyn 002773 switch_bits cobol_idedsyn 002774 defaults cobol_idedsyn 002775 dev_bits cobol_idedsyn 002776 alph_bits cobol_idedsyn 002777 left cobol_idedsyn 003015 right cobol_idedsyn 003033 left_char_spec cobol_idedsyn 003136 right_char_spec cobol_idedsyn 003241 res cobol_idedsyn 003242 dst cobol_idedsyn 003243 currsign cobol_idedsyn 003244 objsign cobol_idedsyn 003245 char1 cobol_idedsyn 003246 alf_name cobol_idedsyn 003257 pcs cobol_idedsyn 003274 rw_ptr cobol_idedsyn 003276 nlit_ptr cobol_idedsyn 003300 alit_ptr cobol_idedsyn 003350 key system_name 003416 i reset_alpha 003434 L nm 003452 i emit_ft 003453 num emit_ft 003476 temp4 enter_key 003506 table_ptr set_table 003510 tran_ptr set_table 003512 i set_table 003560 L also 003561 i also 003614 L range 003615 i range 003616 loc range THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as call_ext_out_desc call_ext_out return_mac signal_op ext_entry any_to_any_truncate_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cobol_c_list cobol_ided cobol_imp_word$alphabet_name cobol_imp_word$comp_type cobol_imp_word$computer_name cobol_imp_word$device_name cobol_imp_word$disp_type cobol_imp_word$file_org cobol_imp_word$imp_word cobol_imp_word$io_technique cobol_imp_word$printer_control cobol_imp_word$switch_name cobol_res_words$check_sort_list cobol_set_type40_$ebcdic cobol_swf_get cobol_syntax_trace_$initialize_phase cobol_syntax_trace_$trace cobol_vdwf_dget cobol_vdwf_dput cobol_vdwf_sput THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cobol_$misc_end_ptr cobol_ext_$cobol_com_fileno cobol_ext_$cobol_com_ptr cobol_ext_$cobol_min1_fileno cobol_ext_$cobol_name_fileno LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 341 001034 4290 001046 4397 001251 4398 001310 4407 001347 4408 001377 4561 001427 4697 001434 58 001437 63 001450 65 001461 66 001466 67 001467 69 001471 73 001474 75 001477 77 001500 78 001502 79 001507 80 001510 81 001511 82 001512 83 001514 84 001515 85 001516 86 001517 87 001520 88 001521 89 001522 90 001523 91 001524 92 001525 93 001526 94 001527 95 001530 96 001531 97 001535 98 001537 99 001541 100 001542 102 001543 103 001547 104 001555 105 001561 106 001566 107 001572 108 001575 109 001602 110 001606 111 001614 112 001620 113 001625 114 001627 115 001633 116 001640 117 001644 118 001647 119 001651 120 001654 121 001662 122 001664 126 001671 127 001673 128 001676 129 001677 130 001702 131 001704 132 001712 133 001714 134 001722 135 001724 136 001732 137 001734 138 001737 139 001740 140 001743 141 001744 142 001747 143 001750 144 001753 145 001754 146 001757 147 001760 148 001763 149 001764 150 001767 151 001770 152 001773 153 001775 154 002000 155 002002 156 002005 157 002007 158 002012 159 002014 160 002021 161 002023 162 002026 163 002030 164 002036 165 002040 166 002043 167 002045 170 002050 172 002053 174 002054 175 002056 176 002063 178 002066 179 002070 180 002072 185 002076 187 002102 189 002105 191 002107 192 002111 194 002113 196 002114 197 002120 198 002122 200 002124 202 002126 208 002127 209 002131 210 002133 211 002135 212 002137 214 002141 215 002143 216 002145 217 002147 219 002151 220 002152 221 002153 222 002154 223 002155 224 002157 225 002161 226 002170 228 002203 230 002204 263 002205 266 002220 268 002221 270 002225 272 002227 275 002233 278 002236 282 002251 285 002257 287 002302 290 002303 292 002306 295 002310 297 002312 299 002314 301 002321 303 002331 304 002333 307 002346 308 002347 311 002350 314 002363 316 002365 319 002376 322 002403 325 002416 327 002417 331 002424 334 002427 337 002434 339 002437 468 002440 472 002444 475 002446 558 002447 563 002451 567 002452 569 002453 573 002457 576 002502 580 002503 582 002504 586 002511 588 002512 592 002523 595 002525 597 002536 600 002540 602 002542 606 002543 608 002544 611 002545 614 002547 663 002550 668 002555 672 002556 677 002566 679 002572 682 002573 687 002600 689 002603 691 002604 695 002606 698 002612 700 002614 702 002617 704 002624 706 002631 708 002636 710 002643 714 002647 717 002676 721 002677 725 002710 728 002712 730 002723 733 002726 735 002730 739 002731 741 002732 744 002737 745 002743 747 002761 751 002771 754 002776 755 003000 757 003017 759 003020 765 003021 770 003022 774 003026 776 003030 778 003035 780 003042 782 003047 784 003051 785 003053 787 003077 788 003100 790 003105 792 003107 793 003111 798 003135 802 003136 806 003137 810 003150 813 003155 817 003156 821 003167 824 003174 829 003175 831 003176 835 003205 837 003206 842 003211 844 003212 849 003215 854 003216 856 003217 860 003221 862 003222 866 003225 868 003226 873 003231 877 003232 879 003233 883 003243 886 003254 889 003255 894 003256 896 003257 899 003270 900 003271 904 003275 907 003301 912 003302 916 003303 918 003305 920 003306 922 003307 927 003312 930 003313 935 003337 939 003340 941 003341 944 003343 947 003347 949 003361 951 003362 953 003365 955 003370 956 003372 958 003373 961 003376 965 003377 968 003401 970 003404 972 003407 973 003411 975 003412 976 003415 978 003416 980 003420 982 003432 984 003444 985 003446 986 003451 988 003452 990 003464 991 003466 992 003471 994 003472 996 003504 997 003506 998 003511 1000 003512 1003 003530 1005 003542 1006 003544 1007 003547 1009 003550 1012 003566 1016 003604 1017 003606 1019 003607 1022 003612 1028 003613 1030 003614 1035 003630 1039 003631 1041 003632 1043 003633 1044 003636 1046 003637 1069 003640 1073 003644 1076 003646 1082 003647 1084 003650 1088 003656 1091 003661 1093 003662 1097 003665 1101 003666 1103 003667 1106 003673 1109 003675 1111 003676 1114 003701 1117 003706 1119 003707 1123 003712 1125 003713 1127 003714 1130 003720 1131 003722 1132 003723 1133 003724 1135 003727 1137 003731 1139 003732 1141 003733 1143 003734 1147 003736 1150 003737 1152 003740 1155 003750 1157 003751 1159 003752 1162 003760 1164 003762 1166 003763 1169 003771 1171 003773 1173 003774 1176 004004 1178 004005 1180 004006 1183 004007 1185 004010 1188 004016 1190 004020 1192 004021 1197 004030 1199 004031 1203 004032 1205 004033 1208 004044 1211 004046 1213 004047 1218 004056 1220 004071 1223 004076 1228 004077 1230 004100 1234 004104 1238 004105 1240 004106 1243 004112 1244 004114 1246 004115 1248 004116 1251 004121 1253 004122 1257 004125 1259 004126 1263 004131 1265 004132 1268 004135 1270 004136 1274 004141 1278 004142 1280 004143 1283 004147 1285 004153 1287 004155 1290 004157 1292 004160 1296 004161 1298 004163 1300 004164 1320 004165 1322 004166 1326 004171 1330 004172 1332 004173 1336 004177 1338 004200 1343 004203 1346 004210 1347 004213 1349 004214 1365 004215 1370 004223 1373 004230 1375 004233 1377 004234 1381 004235 1383 004236 1387 004242 1392 004243 1394 004244 1397 004250 1400 004256 1402 004257 1404 004260 1408 004300 1409 004301 1411 004310 1413 004316 1415 004324 1417 004327 1420 004332 1422 004333 1424 004334 1426 004336 1428 004342 1431 004345 1433 004346 1435 004347 1437 004351 1439 004355 1442 004361 1444 004362 1446 004363 1448 004365 1450 004371 1452 004374 1454 004400 1456 004401 1461 004406 1463 004407 1468 004410 1471 004417 1473 004420 1478 004425 1480 004431 1482 004447 1484 004450 1487 004460 1490 004466 1491 004505 1492 004512 1499 004513 1501 004514 1503 004522 1504 004524 1505 004525 1506 004530 1508 004532 1509 004533 1510 004534 1512 004535 1514 004536 1516 004537 1517 004540 1519 004541 1522 004542 1525 004545 1527 004552 1529 004557 1531 004564 1533 004565 1535 004566 1538 004571 1540 004572 1543 004573 1546 004600 1548 004601 1551 004602 1553 004603 1554 004604 1556 004605 1557 004607 1558 004610 1563 004611 1565 004612 1568 004615 1570 004622 1572 004627 1574 004631 1575 004633 1576 004634 1577 004635 1579 004642 1581 004647 1583 004654 1585 004661 1587 004662 1597 004663 1600 004666 1602 004667 1605 004674 1607 004675 1610 004676 1612 004700 1613 004705 1615 004707 1617 004710 1620 004715 1622 004716 1625 004717 1628 004724 1630 004725 1633 004732 1635 004733 1638 004735 1642 004736 1645 004737 1647 004754 1649 004763 1651 004764 1654 004765 1656 004767 1658 004770 1661 004771 1663 004772 1665 004773 1668 004774 1669 004776 1670 005000 1672 005005 1674 005006 1676 005007 1677 005010 1679 005011 1680 005013 1682 005014 1683 005015 1684 005016 1686 005017 1688 005020 1691 005023 1693 005030 1695 005035 1697 005037 1698 005041 1699 005043 1700 005045 1701 005046 1703 005047 1705 005050 1707 005051 1708 005052 1710 005053 1712 005054 1714 005056 1716 005060 1718 005061 1721 005063 1723 005064 1726 005065 1728 005072 1730 005073 1733 005101 1735 005102 1738 005104 1740 005105 1742 005106 1743 005110 1744 005114 1746 005123 1748 005130 1750 005154 1788 005155 1790 005160 1792 005162 1794 005166 1823 005167 1825 005173 1826 005176 1827 005200 1828 005202 1829 005205 1831 005207 1833 005210 1849 005211 1851 005212 1853 005217 1854 005220 1856 005222 1857 005224 1859 005230 1860 005232 1861 005236 1862 005241 1863 005244 1864 005247 1865 005252 1866 005255 1867 005260 1868 005262 1869 005264 1870 005267 1871 005272 1872 005275 1873 005300 1874 005303 1875 005306 1876 005311 1877 005314 1878 005317 1879 005322 1880 005325 1881 005330 1882 005335 1883 005342 1884 005343 1885 005344 1887 005347 1888 005352 1889 005353 1890 005354 1891 005356 1893 005360 1895 005363 1896 005371 1897 005373 1899 005375 1901 005377 2066 005400 2070 005403 2072 005404 2074 005410 2076 005413 2078 005414 2082 005416 2083 005421 2085 005423 2087 005425 2089 005427 2091 005430 2093 005433 2094 005435 2095 005437 2096 005440 2098 005442 2099 005444 2100 005446 2101 005447 2103 005451 2106 005453 2108 005454 2110 005456 2112 005460 2114 005463 2115 005465 2116 005467 2117 005470 2119 005472 2120 005474 2123 005476 2125 005477 2127 005501 2129 005503 2131 005506 2132 005510 2133 005512 2134 005513 2136 005515 2137 005517 2140 005521 2142 005522 2145 005524 2147 005525 2150 005527 2152 005530 2154 005532 2156 005534 2158 005535 2161 005540 2162 005542 2165 005543 2167 005544 2170 005547 2172 005550 2176 005553 2178 005554 2181 005557 2183 005560 2185 005562 2187 005565 2189 005566 2191 005570 2193 005573 2195 005574 2198 005576 2200 005577 2203 005600 2206 005601 2209 005602 2212 005605 2213 005607 2217 005612 2219 005621 2221 005630 2224 005636 2227 005644 2229 005645 2232 005650 2234 005651 2237 005654 2239 005655 2242 005657 2244 005660 2247 005663 2249 005664 2252 005665 2254 005667 2257 005670 2259 005671 2260 005672 2261 005673 2263 005674 2265 005675 2268 005700 2270 005705 2272 005712 2275 005714 2276 005716 2277 005721 2278 005723 2279 005724 2281 005731 2283 005732 2285 005733 2287 005734 2289 005736 2291 005740 2293 005743 2295 005750 2297 005755 2300 005757 2301 005761 2302 005763 2303 005765 2304 005767 2306 005770 2308 005771 2310 005772 2314 005775 2317 005777 2318 006001 2320 006004 2322 006006 2323 006007 2327 006011 2328 006013 2330 006016 2334 006020 2336 006021 2339 006024 2342 006031 2343 006033 2344 006036 2347 006040 2349 006041 2352 006045 2354 006046 2357 006050 2359 006051 2362 006054 2364 006061 2366 006066 2368 006073 2370 006100 2373 006104 2377 006105 2380 006106 2381 006110 2382 006113 2384 006115 2386 006121 2507 006122 2510 006126 2512 006130 2513 006133 2515 006136 2516 006142 2517 006143 2519 006147 2520 006151 2521 006155 2522 006156 2524 006157 2526 006160 2529 006171 2532 006173 2535 006202 2536 006204 2539 006207 2541 006210 2544 006211 2547 006212 2550 006213 2553 006216 2555 006217 2558 006220 2561 006223 2563 006224 2566 006227 2568 006230 2571 006241 2573 006247 2575 006254 2577 006255 2579 006256 2582 006261 2584 006266 2586 006273 2588 006274 2590 006275 2593 006276 2596 006277 2598 006300 2600 006302 2602 006305 2603 006306 2605 006311 2606 006312 2608 006313 2610 006316 2612 006317 2616 006320 2617 006322 2618 006323 2619 006324 2620 006325 2621 006327 2624 006330 2626 006335 2628 006337 2631 006341 2632 006344 2633 006346 2635 006347 2637 006350 2640 006354 2641 006356 2642 006357 2643 006360 2646 006363 2648 006364 2653 006373 2654 006375 2655 006376 2656 006377 2658 006401 2660 006402 2665 006410 2667 006411 2671 006417 2673 006420 2677 006426 2679 006427 2682 006436 2683 006441 2686 006445 2688 006446 2693 006455 2697 006462 2699 006463 2702 006474 2704 006504 2706 006514 2708 006524 2710 006534 2712 006544 2714 006554 2717 006564 2720 006574 2722 006601 2723 006602 2724 006604 2727 006607 2729 006614 2730 006615 2731 006617 2734 006623 2737 006645 2739 006646 2741 006652 2742 006654 2743 006655 2744 006657 2745 006661 2748 006671 2750 006672 2754 006675 2756 006701 2757 006704 2758 006706 2760 006707 2762 006713 2763 006716 2764 006722 2765 006726 2767 006727 2769 006731 2771 006732 2775 006735 2777 006746 2779 006755 2781 006763 2783 006771 2785 006773 2787 006774 2791 006777 2793 007003 2794 007006 2795 007012 2797 007013 2799 007017 2800 007022 2801 007026 2803 007027 2805 007031 2807 007032 2812 007035 2815 007042 2817 007050 2820 007054 2822 007055 2826 007060 2828 007071 2830 007075 2833 007101 2835 007102 2839 007107 2841 007111 2843 007112 2846 007114 2848 007115 2851 007120 2853 007121 2856 007124 2858 007125 2861 007126 2864 007131 2866 007132 2869 007135 2871 007154 2873 007155 2876 007157 2878 007160 2881 007161 2882 007167 2884 007171 2887 007176 2888 007201 2890 007204 2892 007205 2894 007213 2896 007217 2897 007222 2900 007223 2902 007225 2905 007234 2908 007245 2910 007251 2911 007254 2914 007255 2916 007257 2918 007260 2945 007261 2948 007270 2950 007271 2953 007300 2955 007301 2957 007302 2960 007306 2962 007311 2966 007330 2970 007331 2973 007332 2975 007335 2977 007354 2979 007355 2982 007356 2985 007365 2990 007366 2993 007367 2994 007371 2996 007373 3000 007374 3003 007375 3005 007377 3007 007400 3010 007401 3013 007413 3015 007422 3016 007424 3017 007426 3018 007430 3019 007432 3021 007434 3023 007442 3024 007443 3025 007444 3027 007446 3029 007450 3031 007455 3033 007474 3034 007476 3036 007477 3040 007510 3042 007517 3045 007522 3047 007523 3049 007525 3050 007532 3051 007534 3054 007535 3057 007543 3059 007544 3063 007547 3065 007550 3068 007551 3071 007552 3074 007560 3076 007576 3077 007603 3079 007606 3080 007610 3082 007611 3084 007613 3086 007622 3087 007624 3093 007634 3095 007635 3098 007645 3101 007655 3103 007656 3105 007666 3107 007673 3124 007674 3127 007676 3129 007700 3131 007707 3201 007710 3204 007714 3206 007716 3208 007723 3210 007730 3212 007731 3214 007732 3216 007733 3275 007734 3278 007740 3280 007741 3282 007742 3284 007744 3286 007745 3288 007746 3289 007750 3586 007751 3589 007755 3590 007760 3591 007764 3592 007765 3595 007774 3597 007775 3600 007776 3602 007777 3604 010000 3607 010003 3609 010005 3611 010011 3613 010012 3616 010015 3618 010017 3620 010023 3622 010024 3629 010047 3631 010052 3636 010075 3638 010100 3640 010101 3643 010105 3645 010106 3648 010115 3649 010117 3653 010123 3655 010124 3659 010126 3661 010127 3663 010131 3664 010134 3666 010140 3672 010141 3675 010144 3677 010150 3678 010151 3681 010152 3683 010230 3684 010232 3686 010234 3688 010235 3693 010237 3695 010243 3696 010245 3697 010246 3700 010247 3702 010251 3704 010253 3705 010255 3706 010256 3709 010263 3710 010266 3711 010270 3712 010271 3714 010273 3715 010275 3716 010276 3717 010277 3719 010301 3720 010303 3721 010304 3723 010305 3724 010307 3727 010310 3732 010311 3734 010312 3735 010313 3736 010314 3738 010315 3742 010316 3745 010317 3746 010323 3747 010325 3748 010330 3749 010332 3750 010336 3752 010340 3754 010357 3757 010361 3760 010404 3762 010411 3765 010434 3769 010435 3772 010454 3774 010461 3778 010500 3779 010503 3781 010505 3783 010506 3786 010516 3789 010522 3791 010523 3794 010526 3798 010534 3801 010540 3803 010542 3806 010543 3809 010545 3811 010546 3814 010550 3816 010551 3818 010553 3820 010555 3824 010556 3826 010562 3828 010563 3830 010564 3832 010567 3834 010574 3837 010601 3840 010606 3842 010613 3844 010620 3846 010625 3849 010632 3852 010634 3853 010636 3854 010640 3856 010641 3859 010643 3860 010645 3861 010647 3863 010650 3866 010652 3867 010654 3868 010656 3870 010657 3873 010661 3874 010663 3875 010665 3877 010666 3880 010670 3881 010672 3882 010674 3884 010675 3886 010702 3888 010707 3891 010714 3894 010721 3896 010726 3898 010733 3901 010734 3903 010737 3905 010741 3906 010742 3908 010744 3909 010745 3911 010747 3912 010750 3914 010752 3915 010753 3917 010755 3918 010757 3919 010760 3921 010762 3922 010763 3924 010765 3925 010766 3927 010767 3929 010770 3931 010771 3933 010772 3935 010774 3936 010776 3937 010777 3942 011000 3945 011005 3946 011007 3949 011010 3951 011012 3952 011015 3954 011020 3956 011021 3959 011026 3963 011032 3966 011035 3967 011037 3968 011041 3972 011043 3975 011051 3976 011053 3978 011054 3983 011100 3986 011111 3987 011113 3989 011114 3992 011117 3996 011126 3998 011133 4001 011137 4003 011147 4006 011150 4007 011153 4008 011155 4009 011157 4010 011161 4011 011167 4013 011173 4015 011177 4017 011205 4020 011211 4023 011223 4026 011227 4028 011231 4032 011240 4037 011242 4039 011244 4041 011245 4044 011246 4089 011247 4091 011250 4092 011251 4093 011252 4094 011253 4095 011255 4096 011256 4098 011257 4099 011260 4100 011261 4102 011262 4104 011263 4107 011274 4109 011301 4111 011306 4113 011307 4115 011310 4118 011321 4120 011326 4122 011333 4124 011334 4126 011335 4128 011336 4131 011337 4134 011342 4136 011346 4138 011353 4140 011354 4142 011355 4144 011356 4145 011357 4148 011360 4150 011361 4153 011364 4155 011365 4158 011366 4161 011373 4163 011375 4166 011411 4168 011415 4171 011427 4173 011430 4176 011432 4178 011434 4179 011443 4180 011446 4182 011450 4183 011453 4185 011454 4186 011463 4187 011466 4189 011470 4193 011473 4195 011474 4198 011501 4200 011502 4203 011507 4205 011510 4208 011515 4210 011516 4214 011523 4216 011525 4218 011526 4220 011527 4222 011531 4224 011532 4226 011533 4228 011534 4230 011535 4233 011537 4235 011540 4239 011564 4241 011565 4243 011566 4245 011567 4247 011570 4249 011571 4251 011573 4253 011574 4257 011611 4261 011612 4264 011614 4266 011615 4268 011616 4270 011624 4272 011625 4274 011633 4276 011634 4279 011635 4281 011643 4282 011644 4310 011645 4313 011647 4317 011653 4318 011656 4319 011660 4321 011673 4323 011674 4325 011702 4327 011703 4329 011711 4331 011712 4334 011713 4336 011721 4338 011722 4384 011723 4388 011735 232 011750 235 011751 236 011753 238 011755 239 011757 240 011760 242 011765 243 011767 244 011770 246 011775 247 011777 248 012000 250 012005 251 012007 252 012010 254 012015 383 012016 386 012017 389 012023 390 012026 391 012030 392 012032 393 012034 395 012036 397 012045 398 012046 400 012047 408 012051 409 012053 410 012055 411 012057 413 012061 415 012070 417 012071 419 012072 422 012073 424 012074 426 012111 427 012113 428 012114 430 012115 433 012120 435 012123 437 012125 438 012126 441 012127 444 012134 447 012145 449 012151 452 012156 455 012160 460 012161 462 012162 478 012163 498 012165 499 012167 500 012171 502 012172 504 012176 506 012200 508 012205 510 012212 512 012217 514 012220 515 012222 516 012224 517 012226 518 012230 521 012231 523 012236 524 012247 526 012263 529 012273 531 012304 534 012314 536 012325 539 012335 541 012346 543 012356 551 012360 552 012371 553 012373 555 012375 616 012376 625 012377 627 012400 631 012411 633 012415 635 012416 637 012435 640 012440 644 012451 647 012456 649 012460 653 012461 655 012463 656 012465 1048 012466 1051 012467 1054 012470 1056 012475 1058 012502 1060 012510 1063 012516 1067 012517 1302 012520 1305 012521 1307 012532 1310 012535 1312 012546 1314 012554 1316 012555 1351 012556 1354 012557 1356 012562 1357 012564 1359 012566 1361 012575 1363 012577 1589 012600 1592 012601 1593 012604 1595 012606 1752 012607 1757 012610 1758 012615 1759 012616 1761 012620 1762 012624 1764 012626 1765 012633 1766 012634 1768 012636 1769 012641 1770 012642 1771 012643 1772 012645 1773 012647 1774 012651 1775 012653 1777 012654 1779 012655 1782 012656 1783 012657 1784 012660 1786 012661 1796 012662 1810 012664 1812 012670 1813 012673 1814 012676 1815 012700 1816 012702 1817 012704 1819 012707 1821 012710 1835 012711 1838 012712 1839 012715 1840 012716 1841 012720 1842 012722 1844 012724 1846 012743 1903 012744 1909 012745 1911 012751 1915 012767 1920 013001 1925 013004 1927 013022 1930 013026 1934 013045 1937 013050 1940 013055 1944 013061 1946 013062 1948 013065 1951 013070 1955 013075 1957 013077 1959 013101 1960 013102 1961 013103 1963 013105 1964 013107 1965 013111 1966 013112 1968 013114 1969 013115 1970 013116 1972 013120 1973 013121 1974 013122 1976 013124 1977 013125 1978 013126 1980 013130 1981 013131 1982 013132 1984 013134 1985 013135 1986 013136 1990 013140 1993 013141 1995 013143 1997 013150 2001 013152 2003 013153 2005 013155 2006 013156 2007 013157 2009 013161 2010 013162 2012 013163 2016 013172 2017 013174 2019 013176 2024 013204 2028 013205 2031 013207 2034 013220 2035 013222 2036 013224 2037 013226 2040 013230 2045 013236 2047 013237 2051 013240 2052 013243 2054 013247 2056 013250 2060 013251 2061 013254 2063 013260 2388 013261 2393 013263 2394 013267 2395 013271 2398 013274 2400 013306 2402 013311 2403 013314 2404 013316 2405 013321 2406 013323 2407 013326 2408 013330 2409 013331 2410 013332 2412 013335 2414 013340 2415 013342 2416 013346 2418 013347 2419 013352 2421 013356 2422 013360 2424 013362 2426 013401 2430 013415 2433 013435 2435 013441 2440 013464 2442 013473 2445 013501 2447 013504 2449 013505 2451 013512 2452 013513 2454 013520 2455 013521 2457 013526 2458 013527 2460 013533 2461 013534 2465 013536 2466 013542 2468 013543 2470 013544 2472 013551 2473 013552 2475 013557 2476 013560 2478 013565 2479 013566 2481 013567 2483 013570 2485 013575 2486 013576 2488 013603 2489 013604 2491 013610 2496 013611 2498 013612 2920 013613 2934 013614 2935 013617 2937 013621 2939 013625 2941 013634 2943 013636 3109 013637 3112 013640 3114 013642 3115 013644 3116 013647 3117 013651 3118 013653 3119 013655 3120 013660 3122 013664 3133 013665 3138 013667 3140 013670 3142 013671 3144 013675 3145 013701 3147 013702 3151 013705 3153 013712 3155 013713 3158 013715 3160 013716 3163 013720 3165 013721 3168 013723 3170 013724 3173 013725 3178 013727 3180 013733 3181 013734 3184 013743 3186 013744 3189 013745 3192 013746 3195 013747 3198 013750 3218 013751 3228 013753 3230 013757 3231 013762 3233 014004 3235 014010 3236 014012 3239 014013 3241 014014 3243 014020 3244 014023 3246 014034 3249 014063 3251 014064 3253 014070 3255 014072 3257 014100 3259 014106 3261 014114 3263 014122 3266 014130 3268 014132 3270 014133 3273 014135 3291 014136 3296 014137 3298 014141 3301 014142 3304 014143 3306 014144 3308 014150 3310 014154 3312 014155 3315 014161 3318 014162 3329 014164 3331 014167 3334 014170 3337 014171 3339 014174 3341 014175 3343 014205 3344 014214 3346 014225 3348 014227 3350 014230 3353 014242 3355 014243 3358 014255 3360 014256 3363 014270 3365 014271 3368 014274 3370 014275 3373 014300 3375 014301 3377 014302 3379 014313 3381 014314 3384 014315 3386 014317 3388 014321 3390 014322 3396 014324 3399 014333 3403 014343 3404 014346 3406 014350 3408 014353 3409 014355 3412 014357 3415 014360 3417 014361 3422 014363 3425 014373 3426 014376 3427 014400 3429 014401 3432 014403 3434 014404 3439 014405 3441 014410 3443 014412 3446 014413 3449 014415 3451 014416 3453 014420 3454 014424 3456 014433 3459 014445 3460 014451 3461 014460 3463 014462 3465 014464 3467 014465 3470 014476 3472 014477 3475 014510 3477 014511 3480 014522 3482 014523 3485 014525 3487 014526 3490 014530 3492 014531 3495 014533 3498 014535 3500 014536 3502 014537 3504 014541 3506 014542 3508 014543 3510 014545 3511 014550 3512 014557 3514 014560 3517 014571 3518 014575 3519 014604 3521 014606 3523 014610 3525 014611 3527 014622 3529 014623 3532 014624 3534 014635 3536 014636 3538 014637 3540 014650 3542 014651 3544 014652 3546 014654 3548 014655 3550 014656 3552 014660 3554 014661 3557 014662 3559 014664 3561 014665 3564 014666 3567 014667 3570 014700 3573 014711 3575 014713 3577 014716 3579 014725 3581 014727 3583 014732 4046 014733 4049 014734 4051 014740 4053 014742 4055 014747 4057 014754 4059 014761 4061 014766 4063 014773 4065 015000 4067 015005 4069 015006 4071 015007 4073 015013 4075 015024 4077 015032 4079 015037 4081 015044 4083 015045 4085 015046 4087 015047 4294 015050 4299 015052 4302 015060 4303 015063 4305 015065 4308 015100 4345 015101 4350 015103 4353 015111 4354 015114 4356 015116 4359 015131 4360 015133 4362 015135 4365 015150 4367 015151 4371 015152 4372 015155 4373 015157 4374 015160 4376 015161 4378 015162 4379 015176 ----------------------------------------------------------- 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