COMPILATION LISTING OF SEGMENT cobol_pdstax Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-04-18_1139.27_Tue_mdt 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,MCR8063), 17* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 18* MCR8063 cobol_pdstax.pl1 Fix bug in abbreviated conditionals. 19* 2) change(89-04-23,Zimmerman), approve(89-04-23,MCR8082), 20* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 21* MCR8082 cobol_pdstax.pl1 Fix wild array subscript. 22* END HISTORY COMMENTS */ 23 24 25 /* Modified on 01/24/85 by FCH, [5.3-2], RLS for cond statements drastically changed, BUG561 */ 26 /* Modified on 11/04/83 by FCH, [5.3-1], illegal abbrev rel cond caused abort, BUG563(phx16292) */ 27 /* Modified on 07/11/83 by FCH, [5.2-1], SUPPRESS verb does not work, BUG553(phx15481) */ 28 /* Modified on 11/1/82 by FCH, [5.1-5], delete certain diags concerning files, BUG542(phx13372) */ 29 /* Modified on 03/10/82 by FCH, [5.1-4], dont set file_table.read_next, BUG529 */ 30 /* Modified on 03/05/82 by FCH, [5.1-3], NEXT STATEMENT sometimes blows conpiler, BUG527 */ 31 /* Modified on 12/22/81 by FCH, [5.1-2], set LTP = "1"b, phx12120(BUG5.1) */ 32 /* Modified on 12/17/81 by FCH, [5.1-1], fix bug in NOT(condition), BUG300 */ 33 /* Modified on 10/02/81 by FCH, [5.0-1], fix flagging for validation-81, BUG501 */ 34 /* Modified on 06/23/81 by FCH, [4.4-12], SUBJ_REQ saved in cstack, BUG487 */ 35 /* Modified on 06/11/81 by FCH, [4.4-11], end_stmt.a = "010"b for STOP RUN if CD INITIAL, BUG468 */ 36 /* Modified on 05/19/81 by FCH, [4.4-10], using param not 01 or 77 must begin on full word, TR9918(BUG483) */ 37 /* Modified on 04/17/81 by FCH, [4.4-9], Format 1 SEND statement incorrectly parsed, BUG478 */ 38 /* Modified on 04/06/81 by FCH, [4.4-8], fix bugs in leveling for validation-81, BUG477 */ 39 /* Modified on 02/21/81 by FCH, [4.4-7], receive statement syntax incorrect, new actions added */ 40 /* Modified on 01/17/81 by FCH, [4.4-6], bug 5-206 illegally issued on subscripted refs, BUG460(phx08894) */ 41 /* Modified on 12/10/80 by FCH, [4.4-5], report writer added */ 42 /* Modified on 12/08/80 by FCH, [4.4-4], reset UB_ind if end word */ 43 /* Modified on 11/26/80 by FCH, [4.4-3] diag 5-274 added added, BUG456(phx08316) */ 44 /* Modified on 11/04/80 by FCH, [4.4-2], BUG454(TR3324), action 300,diag 279 on prev tok */ 45 /* Modified on 11/04/80 by FCH, [4.4-1], fix leveling diags in ae */ 46 /* Modified on 04/08/80 by FCH, [4.2-8], diags not issued on class tests, BUG434(TR5876) */ 47 /* Modified on 04/05/80 by FCH, [4.2-7], fix out-of-range checking, BUG430(TR4533) */ 48 /* Modified on 03/22/80 by FCH, [4.2-6], corrections to leveling diags for conditions */ 49 /* Modified on 03/13/80/by FCH, [4.2-5], num.edit to alphabetic move not detected, BUG431 */ 50 /* Modified on 03/13/80 by FCH, [4.2-4], BUG429, L-11 issued illegally when two numeric items compared, SQ431 */ 51 /* Modified on 02/08/80 by MHD,[4.2-3], fixed leveling problem on condition names and more than one SORT */ 52 /* Modified on 12/20/79 by MHD,[4.2-2], fixed bug 416, OCCURS DEPENDING ON * 53*/* Modified on 11/20/79 by MHD, [4.2-1], check for both debug and use_debug */ 54 /* Modified on 10/30/79 by MHD, [4.1-1], diagnostic is put out on previous token if current line = 0 */ 55 /* Modified on 09/27/79 by MHD, [4.1-7], put diagnostics on correct symbol */ 56 /* Modified on 08/29/79 by FCH, [4.0-6], L-11 at correct token */ 57 /* Modified on 06/26/79 by FCH, [4.0-5], stream files allowed in sort */ 58 /* Modified on 05/11/79 by FCH, [4.0-4], debug */ 59 /* Modified on 04/02/79 by FCH, [4.0-3], mixed subs and indexing illegal */ 60 /* Modified on 03/28/79 by FCH, [4.0-2], fix leveling diags */ 61 /* Modified on 03/21/79 by FCH, [4.0-1], dont test sizes if numeric */ 62 /* Modified on 12/20/78 by RAL, [3.0-16] added check seqstmfil using savitmptr */ 63 /* Modified on 10/27/78 by RAL, [3.0-15] rewote check (158) and added action (288) for alternate record keys */ 64 /* Modified on 09/13/78 by RAL, [3.0-14] check(210) is file device suffix printer */ 65 /* Modified on 06/15/78 by RAL, [3.0-13], action(287) check to issue leveling diag 172 */ 66 /* Modified on 06/08/78 by RAL, [3.0-12], action(286) issue leveling diag 169 */ 67 /* Modified on 05/16/78 by FCH, [3.0-11], diag 147 issued illegally */ 68 /* Modified on 05/05/78 by FCH, [3.0-10], flag illegal comparisions as extensions */ 69 /* Modified on 05/03/78 by FCH, [3.0-9], when(search) sets UB_ind to 0 */ 70 /* Modified on 04/24/78 by FCH, [3.0-8], check for section name */ 71 /* Modified on 04/20/78 by FCH, [3.0-7], check(28):sizlit, inspect statement */ 72 /* Modified on 03/23/78 by FCH, [3.0-6], lev diag, non-positive integer */ 73 /* Modified on 03/08/78 by FCH, [3.0-5], action(211), test for index name */ 74 /* Modified on 02/17/78 by FCH, [3.0-4], correct values for mnemonic_name.iw_key */ 75 /* Modified on 01/05/78 by FCH, [3.0-3], check170(ckintbit) fixed, used by perform */ 76 /* Modified on 12/27/77 by FCH, [3.0-2], write stream file required invalid option */ 77 /* Modified on 09/08/77 by FCH, [3.0-1], emit level for levelling diags 11,12,13 fixed */ 78 /* Changes made since Version 3.0 */ 79 80 81 82 83 84 85 86 87 /* format: style3 */ 88 cobol_pdstax: 89 proc; 90 91 /*[4.1-7]*/ 92 prev_token_ptr = null (); /*[4.1-7]*/ 93 mptr = null (); 94 seg_usage_ptr = addr (seg_usage_string); 95 sort_count = 0; 96 O1_ptr = addr (O1); 97 O2_ptr = addr (O2); 98 message_ind = 0; 99 comsrtrngptr = (null ()); 100 addr (stat.procdef) -> bit9 = "0"b; 101 next_sent_label = 0; 102 perflink, perflink1 = "00000"; 103 perfext = 0; 104 gotodep, preospn_bit, srchfm2bit, ns_found = "0"b; 105 106 107 /*[5.3-2]*/ 108 nest_lev = 1; /*[5.3-2]*/ 109 call reset_st; 110 111 fircar = "1"b; 112 dbp, drc = 1; 113 common_eof = "0"b; 114 115 act_log_ptr = addr (act_log); 116 act_log_ptr -> bit16 = "0"b; /*[5.3-2]*/ 117 addr (ST (0)) -> bit180 = "0"b; /*[5.0-1]*/ 118 seg_limit = cobol_idedsyn$get_seg_limit (); 119 120 cssub, assub, mod_num, decswitch, secswitch, debugsw, diagno, cursecnum = 0; 121 122 i1 = 0; 123 syntax_line_ptr = addr (sline); 124 sline.s_exit = 70; 125 126 end_stmt.size = 38; 127 end_stmt.line = 0; 128 end_stmt.column = 0; 129 end_stmt.type = 19; 130 end_stmt.verb = 0; 131 132 seq, input, rewind = 1; 133 output = 2; 134 135 dumprocname.size = 49; 136 dumprocname.line = 0; 137 dumprocname.column = 0; 138 dumprocname.type = 18; 139 dumprocname.searched = "0"b; 140 dumprocname.duplicate = "0"b; 141 142 dpnptr = addr (dumprocname); /*[5.2-1]*/ 143 end_decl_bit = "1"b; 144 sav_ptr = addr (saveitem); 145 head_ptr = addr (header); 146 147 work_ptr = addr (work); 148 subject_ptr = addr (subject); 149 soperator_ptr = addr (soperator); 150 coperator_ptr = addr (coperator); 151 end_stmt_ptr = addr (end_stmt.verb); 152 es_ptr = addr (end_stmt); 153 sav_bit, arith_op = "0"b; 154 155 c_ptr = addr (coperator.c); 156 157 code_env_ptr = addr (code_env); 158 code_env.arg_1 = addr (end_stmt); 159 code_env.arg_2 = addr (opeos); 160 code_env.arg_3 = addr (dumprocname); 161 code_env.arg_4 = addr (code_env); 162 code_env.arg_5 = addr (code_option); 163 164 code_env.arg_6 = addr (DATA); 165 call cobol_pd_code$initialize (code_env_ptr); 166 167 addr_record = addr (header); 168 cdtoken_ptr = addr_record; 169 op_ptr = addr (op); /*[3.0-10]*/ 170 left_ptr = addr (left); /*[3.0-10]*/ 171 172 /* end of init changed to assign */ 173 174 savidptr = addr (saveident); /* init to saved identifier*/ 175 opeosptr = addr (opeos); /*initialize opeosptr to addr of operation eos */ 176 savitmptr = addr (saveitem); 177 eosptr = addr (end_stmt); /* used for i-o */ 178 179 180 call cobol_pdst (pointer_to_internal, dumfix); /* initialize diag item */ 181 dg_ptr = addr (diag_item); 182 diag_item.size = 28; 183 diag_item.type = 5; 184 diag_item.run = 5; /*[4.4-5]*/ 185 eos_perform_ptr = addr (eos_perform); 186 rw_perform_ptr = addr (rw_perform); /*[5.2-1]*/ 187 rw_move_ptr = addr (rw_move); /*[5.2-1]*/ 188 supp_lit_ptr = addr (supp_lit); /*[5.2-1]*/ 189 eos_move_ptr = addr (eos_move); 190 lev_dg_ptr = addr (lev_diag_item); 191 lev_diag_item.size = 28; 192 lev_diag_item.type = 5; 193 lev_diag_item.run = 9; 194 195 decswitch = 0; 196 diag_item.info = "00000000"b; 197 198 DIAG_NUM = 0; 199 trace_ptr = addr (interp); 200 tbit = fixed_common.syntax_trace; 201 202 if tbit 203 then call cobol_syntax_trace_$initialize_phase (trace_ptr, 3); 204 205 call SCAN; 206 207 current_line = syntax_line.s_exit; 208 209 go to new_inst; 210 211 /* */ 212 /* syntax interpreter */ 213 /* */ 214 215 fail: /*failure */ 216 if tbit 217 then call cobol_syntax_trace_$trace (trace_ptr, tm2); 218 219 next_inst: 220 current_line = current_line + 1; 221 222 new_inst: /* new instruction */ 223 syntax_line_ptr = addr (syntax_table (current_line)); 224 225 go to test (syntax_line.t_type); 226 227 test (0): /* reserved word test */ 228 if reserved_word.type ^= 1 229 then go to fail; 230 231 if reserved_word.key ^= syntax_line.t_field 232 then go to fail; 233 234 success: /* success */ 235 if tbit 236 then call cobol_syntax_trace_$trace (trace_ptr, tm1); 237 238 ucon: 239 if syntax_line.o_bit ^= " " 240 then if syntax_line.o_bit ^= "o" 241 then do; 242 if syntax_line.o_bit > fixed_common.comp_level 243 /*[4.4-2]*/ 244 then do; 245 if sav_bit /*[4.4-2]*/ 246 then call LEV_DIAG (syntax_line.a_num, sav.line, sav.column); 247 /*[4.4-2]*/ 248 else call lev_diag (syntax_line.a_num); 249 250 /*[4.4-2]*/ 251 end; 252 253 /*[4.4-2]*/ 254 sav_bit = "0"b; 255 256 go to ret; 257 end; 258 259 go to action (syntax_line.a_num); 260 261 test (1): /* check routine test */ 262 go to check (syntax_line.t_field); 263 264 test (2): /* unconditional branch */ 265 DIAG_NUM = syntax_line.t_field; 266 act_num = syntax_line.a_num; 267 268 if syntax_line.o_bit ^= " " 269 then if syntax_line.o_bit ^= "o" 270 then do; 271 if syntax_line.o_bit > fixed_common.comp_level 272 then do; 273 mod_num = syntax_line.a_num; 274 275 /*[4.4-2]*/ 276 if sav_bit /*[4.4-2]*/ 277 then call LEV_DIAG (DIAG_NUM, sav.line, sav.column); 278 /*[4.4-2]*/ 279 else call lev_diag (DIAG_NUM); 280 281 end; 282 283 DIAG_NUM = 0; 284 act_num = 0; /*[4.4-2]*/ 285 sav_bit = "0"b; 286 end; 287 288 if tbit 289 then call cobol_syntax_trace_$trace (trace_ptr, tm1); 290 291 go to action (act_num); 292 293 test (3): 294 i1 = i1 + 1; 295 if tbit 296 then call cobol_syntax_trace_$trace (trace_ptr, tm3); 297 298 if i1 > 75 299 then go to comp_error; 300 301 intrp_stack (i1) = current_line; 302 current_line = syntax_line.t_field; 303 304 go to new_inst; 305 306 ret: 307 action (0): 308 if DIAG_NUM ^= 0 309 then do; 310 if message_ind = 0 /*[4.1-1]*/ 311 then if header.line ^= 0 312 then call diag (DIAG_NUM); /*[4.1-1]*/ 313 else call DIAG_PREV_TOKEN (DIAG_NUM); 314 message_ind, DIAG_NUM = 0; 315 end; 316 317 if syntax_line.o_bit = "o" 318 then if ^ST.skip_ind (nest_lev) 319 then call put; 320 321 if syntax_line.s_bit = "s" 322 then call SCAN; 323 324 current_line = syntax_line.s_exit; 325 326 go to new_inst; 327 328 action (1): /* exit true */ 329 current_line = intrp_stack (i1); 330 331 if tbit 332 then call cobol_syntax_trace_$trace (trace_ptr, tm4); 333 334 syntax_line_ptr = addr (syntax_table (current_line)); 335 i1 = i1 - 1; 336 337 go to ucon; 338 339 action (2): /* exit false */ 340 current_line = intrp_stack (i1); 341 342 if tbit 343 then call cobol_syntax_trace_$trace (trace_ptr, tm5); 344 345 i1 = i1 - 1; 346 347 go to next_inst; 348 349 comp_error: 350 diag_item.number = 183; 351 diag_item.column = header.column; 352 diag_item.line = header.line; 353 354 call cobol_c_list (dg_ptr); 355 356 return; 357 358 SCAN: 359 proc; 360 361 do while ("1"b); 362 363 /*[4.1-7]*/ 364 prev_token_ptr = mptr; /* saves pointer to previous token_ptr */ 365 366 /*[4.4-2]*/ 367 LTP = last_wd_per; /*[4.4-2]*/ 368 last_wd_per = "0"b; 369 370 call cobol_swf_get (cobol_rm2fp, st, mptr, tln); 371 372 if substr (st, 17, 16) ^= "0"b 373 then go to endint; 374 375 substr (addr_record -> itemsize1, 1, headerb.size) = mptr -> itemsize1; 376 377 if header.type = 5 378 then do; 379 call cobol_c_list (addr_record); 380 381 if message.rep_bit = "0"b 382 then message_ind = 1; 383 384 else if diag_file.diag_table.d_type (diag_file.run_table.base (message.run) + message.number) = 3 385 then return; 386 387 end; 388 389 else if header.type = 6 390 then call cobol_c_list (addr_record); 391 392 /*[5.2-1]*/ 393 else if header.type = 9 & ^end_decl_bit /*[5.2-1]*/ 394 then if substr (data_name.name, 1, 2) = "SS" /*[5.2-1]*/ 395 then data_name.type = 91; 396 return; 397 end; 398 399 end; 400 401 put: 402 proc; /* routine to output the window token */ 403 seqvarptr = addr_record; 404 seqvarleng = header.size; 405 call seqput; 406 end put; 407 408 diag: 409 proc (diag_num); 410 411 declare diag_num fixed bin; 412 413 if header.type = 5 & (syntax_line.t_field = 7 | syntax_line.t_field ^= 164) 414 then return; 415 else do; 416 diag_item.number = diag_num; 417 diag_item.column = header.column; 418 diag_item.line = header.line; 419 call cobol_c_list (dg_ptr); 420 end; 421 end diag; 422 423 lev_diag: 424 proc (diag_num); 425 426 declare diag_num fixed bin; 427 428 lev_diag_item.line = header.line; 429 lev_diag_item.column = header.column; 430 lev_diag_item.number = diag_num; 431 lev_diag_item.module = mod_num; 432 433 call cobol_c_list (lev_dg_ptr); 434 435 mod_num = 0; 436 437 end; 438 439 /*[4.1-7]*/ 440 DIAG_PREV_TOKEN: 441 proc (diag_num); 442 443 /* This procedure emits a diagnostic message referenced by diag_num and puts it at the */ 444 /* previous token. Used when look-ahead is needed to determine the error */ 445 446 declare diag_num fixed bin; 447 448 diag_item.number = diag_num; 449 diag_item.column = prev_token_ptr -> source.column; 450 diag_item.line = prev_token_ptr -> source.line; 451 call cobol_c_list (dg_ptr); 452 453 end DIAG_PREV_TOKEN; 454 455 /*[4.1-7]*/ 456 DIAG: 457 proc (diag_num); 458 459 /* This procedure emits a diagnostic message reference by diag_num and puts it at locatiion */ 460 /* represented in prev_diag. This is used when look-ahead for more than 1 symbol needed to determine the error */ 461 /* For look-ahead for only 1 symbol see DIAG_PREV_TOKEN above */ 462 463 declare diag_num fixed bin; 464 465 diag_item.number = diag_num; 466 diag_item.column = prev_diag.column_num; 467 diag_item.line = prev_diag.line_num; 468 call cobol_c_list (dg_ptr); 469 470 end DIAG; 471 472 /*[4.0-1]*/ 473 LEV_DIAG: 474 proc (diag_num, line_num, col_num); 475 476 /*[4.0-1]*/ 477 dcl (diag_num, line_num, col_num) 478 fixed bin; 479 480 /*[4.0-1]*/ 481 lev_diag_item.line = line_num; /*[4.0-1]*/ 482 lev_diag_item.column = col_num; /*[4.0-1]*/ 483 lev_diag_item.number = diag_num; /*[4.0-1]*/ 484 lev_diag_item.module = mod_num; 485 486 /*[4.0-6]*/ 487 call cobol_c_list (lev_dg_ptr); 488 489 end; /*[4.0-1]*/ 490 491 seqput: 492 proc; 493 494 if ^ST.skip_ind (nest_lev) 495 then call cobol_swf_put (cobol_pdofp, st, seqvarptr, seqvarleng); 496 497 end seqput; 498 499 seqputeos: 500 proc; 501 502 if ^ST.skip_ind (nest_lev) 503 then call cobol_swf_put (cobol_pdofp, st, eosptr, end_stmt.size); 504 505 end seqputeos; 506 507 vardget: 508 proc; 509 510 call cobol_vdwf_dget (cobol_cmfp, st, seqvarptr, common_recsize, varrecaddr); 511 512 end vardget; 513 514 vardput: 515 proc; 516 517 if ^ST.skip_ind (nest_lev) 518 then call cobol_vdwf_dput (cobol_cmfp, st, seqvarptr, seqvarleng, varrecaddr); 519 520 end vardput; 521 522 523 /* the following are the check routines */ 524 525 /* is dd cd initial bit not set */ 526 527 528 529 530 check (1): 531 inbit: 532 if ^init_cd 533 then go to success; 534 go to fail; 535 536 /* is item an 01 or 77 item in linkage section */ 537 538 539 540 check (2): 541 lident: 542 if (header.type = 9) & ((data_name.level = 01) | (data_name.level = 77)) & data_name.linkage_section 543 then go to success; 544 go to fail; 545 check (3): 546 linktot: 547 if end_stmt.e = number_of_ls_pointers 548 then go to success; 549 go to fail; /* is it a section header */ 550 check (4): 551 sechdr: 552 if (header.type = 7) & (proc_def.section_name = "1"b) 553 then go to success; 554 go to fail; /* is it a non sort file name */ 555 556 557 558 check (5): 559 filenm: 560 if header.type = 12 561 then if fd_token.file_no ^= 0 562 then do; 563 call cobol_read_ft_ (fd_token.file_no, ft_ptr); 564 565 file_org = file_table.organization; 566 go to success; 567 end; 568 569 go to fail; /* is it not format 2 or 570* is it format 2 without labels are omitted clause */ 571 572 573 574 check (6): 575 formtlb: 576 if (end_stmt.a ^= "001"b) /* chk filtbl for no labels if frmt 2 */ 577 then go to success; 578 go to fail; /* is it a report section group item */ 579 check (7): 580 rident: 581 if header.type = 21 582 then go to success; 583 go to fail; /* is it a procedure definition */ 584 check (8): 585 paranm: 586 prdef: 587 if (header.type = 7 & proc_def.section_name = "0"b) 588 then go to success; 589 go to fail; /* is it a verb */ 590 591 592 593 check (9): 594 verb: /*[5.2-1]*/ 595 if ((header.type = 1) & (reserved_word.verb = "1"b)) | header.type = 91 596 then do; 597 if UB_ind 598 then call diag (126); 599 600 UB_ind = "0"b; 601 go to success; 602 end; 603 go to fail; /* is section number legitimate */ 604 605 606 check (10): 607 prnum: 608 if header.type = 2 & numeric_lit.integral = "1"b & numeric_lit.sign = " " & numeric_lit.seg_range = "1"b 609 then go to success; 610 go to fail; /* is saved item not alphabetic */ 611 check (11): 612 sina: 613 if (savitmptr -> data_name.numeric) | (savitmptr -> data_name.numeric_edited) 614 | (savitmptr -> data_name.alphanum) 615 then go to success; 616 go to fail; /* is it a numeric literal */ 617 618 619 check (12): 620 numlit: /*[5.0-1]*/ 621 if header.type = 2 /*[5.0-1]*/ 622 then seg_num = fixed (numeric_lit.literal); /*[5.0-1]*/ 623 else seg_num = 0; 624 625 if fixed_common.comp_level < "4" 626 then do; 627 if last_seg_num ^= 1000 628 then do; 629 if seg_usage (seg_num) & seg_num ^= last_seg_num 630 then call lev_diag (81); 631 632 end; 633 634 last_seg_num = seg_num; 635 seg_usage (seg_num) = "1"b; 636 637 end; 638 639 if header.type = 2 640 then go to success; 641 go to fail; /* is it an alterable procedure name reference */ 642 643 644 check (13): 645 altprnm: 646 if (header.type = 18 & proc_def.alterable = "1"b) 647 then go to success; 648 go to fail; /* is it a procedure name reference */ 649 650 651 check (14): 652 prnm: 653 if header.type = 18 654 then go to success; 655 go to fail; /* is it a non numeric literal */ 656 check (15): 657 nonumlit: 658 if header.type = 3 659 then go to success; 660 go to fail; /* is it an 01 or 77 item within file working-storage communication or link section */ 661 662 663 check (16): 664 useid: 665 if header.type = 2 | header.type = 3 666 then do; 667 668 if fixed_common.comp_level < "5" 669 then call lev_diag (153); 670 671 go to success; 672 end; 673 674 if header.type = 9 675 then do; 676 if ((data_name.level = 1 | data_name.level = 77) 677 & (data_name.file_section | data_name.working_storage | data_name.communication_section 678 | data_name.linkage_section | data_name.constant_section)) 679 then go to success; 680 end; 681 682 go to fail; 683 684 /* is it a non sort file name */ 685 686 687 check (17): 688 nsfilnm: 689 if header.type = 12 690 then if fd_token.file_no ^= 0 691 then do; 692 call cobol_read_ft_ (fd_token.file_no, ft_ptr); 693 file_org = file_table.organization; 694 go to success; 695 end; 696 go to fail; /* is it an input cd name */ 697 698 699 check (18): 700 incdnm: 701 if (header.type = 13 & cdtoken.options.input) 702 then go to success; 703 go to fail; /* is it an output cd name */ 704 705 706 check (19): 707 outcdnm: 708 if (cdtoken.type = 13 & cdtoken.output) 709 then go to success; 710 go to fail; 711 712 /*is saved file indexed */ 713 714 715 716 check (20): 717 ixfil: 718 if savitmptr -> fd_token.file_no = 0 719 then go to fail; 720 721 file_number = savitmptr -> fd_token.file_no; 722 call cobol_read_ft_ (file_number, ft_ptr); 723 724 if organization = 3 725 then go to success; 726 go to fail; 727 728 /* is it a literal */ 729 730 731 732 check (21): 733 lit: 734 if header.type = 2 | header.type = 3 735 then go to success; 736 go to fail; /* is item a figurative constant except all */ 737 check (22): 738 figconall: 739 if fixed_common.comp_level < "3" 740 then do; 741 if header.type = 1 & reserved_word.figcon 742 then do; 743 if reserved_word.end_dec 744 then call lev_diag (154); 745 go to success; 746 end; 747 end; 748 else do; 749 if header.type = 1 & reserved_word.figcon 750 then go to success; 751 end; 752 753 go to fail; 754 755 /* does file have sequential access or dynamic access */ 756 757 check (23): 758 sqacdyac: 759 if savitmptr -> fd_token.file_no = 0 760 then go to fail; 761 762 file_number = savitmptr -> fd_token.file_no; 763 call cobol_read_ft_ (file_number, ft_ptr); 764 765 if access < 2 | access = 3 766 then go to success; 767 go to fail; 768 769 check (24): 770 is_cobol: 771 if lang_num = 1 772 then go to success; 773 774 go to fail; 775 776 check (25): 777 rpid: /*[4.4-5]*/ 778 if header.type = 18 779 then go to success; 780 go to fail; /* is it a declarative section name reference */ 781 check (26): 782 descnm: 783 if header.type = 18 & proc_def.section_name & proc_def.declarative_proc 784 then go to success; 785 go to fail; /* is it an rd report name */ 786 check (27): 787 repnm: /*[4.4-5]*/ 788 if header.type = 18 789 then go to success; 790 go to fail; /* is current size = to saved item size */ 791 check (28): 792 sizlit: /*[3.0-7]*/ 793 /*[]*/ 794 if header.type = 1 795 then go to success; /* fig_con */ 796 /*[]*/ 797 /*[]*/ 798 if saveitem.type = 3 /*[]*/ 799 then do; 800 LL = savitmptr -> alphanum_lit.lit_size;/*[]*/ 801 /*[]*/ 802 if header.type = 3 /*[]*/ 803 then do; 804 if LL = alphanum_lit.lit_size 805 then go to success; /*[]*/ 806 end; /*[]*/ 807 else /*[]*/ /*[]*/ 808 if header.type = 9 /*[]*/ 809 then do; 810 call sizedn (addr_record); /*[]*/ 811 /*[]*/ 812 if LL = L 813 then go to success; /*[]*/ 814 end; /*[]*/ 815 end; /*[]*/ 816 else /*[]*/ /*[]*/ 817 if saveitem.type = 9 /*[]*/ 818 then do; 819 call sizedn (savitmptr); /*[]*/ 820 /*[]*/ 821 if header.type = 3 /*[]*/ 822 then do; 823 if L = alphanum_lit.lit_size 824 then go to success; /*[]*/ 825 end; /*[]*/ 826 else /*[]*/ /*[]*/ 827 if header.type = 9 /*[]*/ 828 then do; 829 LL = L; /*[]*/ 830 call sizedn (addr_record); /*[]*/ 831 /*[]*/ 832 if LL = L 833 then go to success; /*[]*/ 834 end; /*[]*/ 835 end; /*[]*/ 836 else /*[]*/ /*[]*/ 837 if saveitem.type = 1 /*[]*/ 838 then do; 839 if header.type = 3 /*[]*/ 840 then do; 841 if alphanum_lit.lit_size = 1 842 then go to success; /*[]*/ 843 end; /*[]*/ 844 else /*[]*/ /*[]*/ 845 if header.type = 9 /*[]*/ 846 then do; 847 call sizedn (addr_record); /*[]*/ 848 /*[]*/ 849 if L = 1 850 then go to success; /*[]*/ 851 end; /*[]*/ 852 end; 853 854 go to fail; 855 856 857 sizedn: 858 proc (p); 859 860 /*[]*/ 861 declare p ptr; /*[]*/ 862 /*[]*/ 863 if p -> data_name.numeric | p -> data_name.numeric_edited 864 /*[]*/ 865 then L = p -> data_name.places_left + p -> data_name.places_right; 866 /*[]*/ 867 else L = p -> data_name.item_length; 868 869 end; /*[3.0-7]*/ 870 871 /*is file not sequentila access 872* not file table already in core from check 38 */ 873 874 check (29): 875 notseqac: 876 if access > 1 877 then go to success; 878 go to fail; 879 880 /* is saved item not mass storage and 881* is it sequential and is it single reel */ 882 883 884 check (30): 885 nomsss: 886 if savitmptr -> fd_token.file_no ^= 0 887 then do; 888 file_number = savitmptr -> fd_token.file_no; 889 call cobol_read_ft_ (file_number, ft_ptr); 890 end; 891 else go to fail; 892 893 if organization = 1 894 then go to success; 895 go to fail; /* is it a non sort mass storage file */ 896 check (31): 897 msfilnm: /* according to ron ham we do not check for ms file regardless of codasyl rules */ 898 if header.type = 12 899 then go to success; 900 go to fail; 901 902 /* is there a format 1 use procedure associated with the delete statement 903* note file table already in core from check 38 */ 904 905 check (32): 906 useform1: 907 if error_exit ^= 0 908 then go to success; 909 go to fail; 910 911 /* is it an index name */ 912 check (33): 913 xnm: 914 if header.type = 10 915 then do; 916 min_index = max (min_index, 0); /*[4.2-7]*/ 917 max_index = min (max_index, index_name.max); 918 go to success; 919 end; 920 go to fail; 921 922 /* no more than 2 afters in a perform statement */ 923 924 check (34): 925 ecnt: 926 if end_stmt.e = 3 927 then go to success; 928 go to fail; /* is item a declarative section name reference */ 929 /* and is it a random processing section */ 930 931 932 933 check (35): 934 descnmra: 935 if header.type = 18 & proc_def.section_name /*[3.0-8]*/ 936 then go to success; 937 go to fail; /* is it an sa area name */ 938 check (36): 939 saanm: 940 if header.type = 15 941 then go to success; 942 go to fail; /* is it an 01 data name under sa */ 943 check (37): 944 said: 945 if header.type = 9 & data_name.level_01 & data_name.exp_redefining 946 then go to success; 947 go to fail; 948 949 /* is file not sequential organization */ 950 951 check (38): 952 notseqfl: 953 if fd_token.file_no ^= 0 954 then do; 955 file_number = fd_token.file_no; 956 call cobol_read_ft_ (file_number, ft_ptr); 957 end; 958 else go to fail; 959 960 if organization ^= 1 & organization ^= 5 961 then go to success; /*[3.0-2]*/ 962 go to fail; 963 964 /* is it end cobol statement */ 965 check (39): 966 endcob: 967 if header.type = 1 & reserved_word.end_cobol = "1"b 968 then go to success; 969 go to fail; /* was previous eos a special case */ 970 971 972 check (40): 973 preosp: 974 if end_stmt.verb = 12 & reserved_word.imper_verb = "0"b 975 then go to success; 976 go to fail; /* is verb an imperative verb */ 977 check (41): 978 impvrb: /*[5.3-2]*/ 979 if data_name.type = 91 /* suppress */ 980 /*[5.3-2]*/ 981 then go to success; /*[5.3-2]*/ 982 else if reserved_word.type = 1 /*[5.3-2]*/ 983 then if reserved_word.verb /*[5.3-2]*/ 984 then go to success; /*[5.3-2]*/ 985 else if reserved_word.key = 500 /* evaluate */ 986 /*[5.3-2]*/ 987 then go to success; /*[5.3-2]*/ 988 else ; /*[5.3-2]*/ 989 else ; 990 go to fail; 991 992 /* are records fixed length */ 993 994 995 996 check (42): 997 varsiz: 998 if savitmptr -> fd_token.file_no = 0 999 then go to fail; 1000 1001 file_number = savitmptr -> fd_token.file_no; 1002 call cobol_read_ft_ (file_number, ft_ptr); 1003 1004 if file_table.variable = "0"b 1005 then go to success; 1006 go to fail; 1007 1008 /* is item file no not equal to saved file no */ 1009 check (43): 1010 fileno: 1011 if header.type = 9 1012 then if data_name.file_num ^= savitmptr -> data_name.file_num 1013 then goto success; 1014 else goto fail; 1015 else if data_name.file_num ^= savitmptr -> fd_token.file_no 1016 then go to success; 1017 go to fail; /* is saved item filename isn sequential mode */ 1018 1019 1020 1021 check (44): 1022 sqfl: /* if savitmptr -> seqbit then go to success; 1023*go to fail; */ /* is saved file in random access mode */ 1024 check (45): 1025 rafl: 1026 if savitmptr -> fd_token.file_no ^= 0 1027 then do; 1028 file_number = savitmptr -> fd_token.file_no; 1029 call cobol_read_ft_ (file_number, ft_ptr); 1030 end; 1031 else go to fail; 1032 1033 if access = 2 1034 then go to success; 1035 go to fail; /* is this item a record within the associated sort file */ 1036 check (46): 1037 recnm: 1038 if header.type ^= 9 1039 then go to fail; 1040 1041 sort_key = sort_in_info; 1042 1043 do while ("1"b); 1044 if sort_key = "00000" 1045 then go to fail; 1046 1047 varrecaddr = sort_key; 1048 call vardget; 1049 srtrngptr = seqvarptr; 1050 1051 if (cursecnum > sstop) | (cursecnum < sstart) | (data_name.file_num ^= srtfilno) 1052 then sort_key = sptr; 1053 else go to success; 1054 end; 1055 1056 /* are we in an input sort range */ 1057 check (47): 1058 inrng: 1059 if sv_isrbit 1060 then go to success; 1061 go to fail; 1062 1063 /* are we in an output sort range */ 1064 check (48): 1065 outrng: 1066 if sv_osrbit 1067 then go to success; 1068 go to fail; 1069 1070 /* is this file the same as associated file in the sort statement */ 1071 check (49): 1072 asfil: 1073 if header.type ^= 16 1074 then go to fail; 1075 1076 sort_key = sort_out_info; 1077 1078 do while ("1"b); 1079 if sort_key = "00000" 1080 then go to fail; 1081 1082 varrecaddr = sort_key; 1083 call vardget; 1084 srtrngptr = seqvarptr; 1085 1086 if (cursecnum > sstop) | (cursecnum < sstart) | (fd_token.file_no ^= srtfilno) 1087 then sort_key = sptr; 1088 else go to success; 1089 end; 1090 1091 /* is item not subscripted and not indexed */ 1092 /* but still has the occurs and indexed by clauses */ 1093 check (50): 1094 srchid: 1095 if header.type = 9 & data_name.subscripted & data_name.indexed_by 1096 then go to success; 1097 else go to fail; /* is item an integer type or is it usage is index */ 1098 check (51): 1099 usornm: 1100 if header.type = 9 & (data_name.pic_integer | data_name.usage_index) 1101 then go to success; 1102 else go to fail; /* does item have the key is clause */ 1103 check (52): 1104 keylbl: 1105 if data_name.key_a | data_name.key_d 1106 then go to success; 1107 else go to fail; 1108 1109 /* is it a sequential file */ 1110 1111 1112 1113 check (53): 1114 seqfil: 1115 if fd_token.file_no = 0 1116 then go to fail; 1117 1118 file_number = fd_token.file_no; 1119 call cobol_read_ft_ (file_number, ft_ptr); 1120 1121 /*[4.0-5]*/ 1122 if organization = 1 | organization = 5 1123 then go to success; 1124 go to fail; 1125 1126 /* is it a one character integer without an operational sign */ 1127 1128 1129 1130 check (54): 1131 onechnosn: 1132 if data_name.item_length = 1 & data_name.pic_integer & ^data_name.item_signed 1133 then go to success; 1134 go to fail; 1135 1136 /* is saved file sequential or relative and does it have sequential access mode */ 1137 1138 check (55): 1139 sqrlsqac: 1140 if savitmptr -> data_name.file_num = 0 1141 then go to fail; 1142 1143 file_number = savitmptr -> data_name.file_num; 1144 call cobol_read_ft_ (file_number, ft_ptr); 1145 1146 if (organization = 1 | organization = 2) & (access < 2) 1147 then go to success; 1148 go to fail; 1149 1150 /* is it a mneemonic name */ 1151 check (56): 1152 mnenm: 1153 if header.type = 17 1154 then go to success; 1155 go to fail; 1156 1157 /* does the file have an associated format 1 use procedure */ 1158 1159 check (57): 1160 useform1a: 1161 if savitmptr -> data_name.file_num = 0 1162 then go to fail; 1163 go to useform1; 1164 1165 /* is it an index data item or 1166* is it an elementary integer item */ 1167 check (58): 1168 xint: 1169 if header.type = 9 & data_name.elementary & data_name.usage_index = "1"b 1170 then do; 1171 set_sop.int_lit = "1"b; 1172 set_sop.int_data = "1"b; 1173 go to success; 1174 end; 1175 1176 if header.type = 9 & data_name.elementary = "1"b & data_name.pic_integer = "1"b 1177 then do; 1178 set_sop.int_lit = "1"b; 1179 set_sop.int_data = "1"b; 1180 set_sop.ind_data = "1"b; 1181 go to success; 1182 end; 1183 go to fail; /* is it a positive integer literal */ 1184 1185 1186 1187 check (59): 1188 posint: 1189 if header.type = 2 & numeric_lit.integral = "1"b & numeric_lit.sign ^= "-" 1190 then go to success; 1191 go to fail; /* is it a sortt file */ 1192 1193 1194 1195 check (60): 1196 srtfil: 1197 if header.type = 16 1198 then go to success; 1199 go to fail; /* is itt a data_name within the saved file */ 1200 1201 1202 check (61): 1203 dninfl: 1204 if header.type = 9 & data_name.file_num = savitmptr -> fd_token.file_no 1205 then go to success; 1206 go to fail; /* does item have usage is display clause */ 1207 1208 check (62): 1209 usisds: 1210 if data_name.non_elementary | (data_name.elementary & data_name.display) 1211 then go to success; 1212 go to fail; /* is item fixed length with usage is display clause */ 1213 check (63): 1214 flusisds: 1215 if data_name.display & ^data_name.variable_length 1216 then go to success; 1217 go to fail; /* is item an elementary data item with usage is display clause 1218* and with no edit symbols */ 1219 check (64): 1220 elneds: 1221 if data_name.elementary & data_name.display & ^data_name.numeric_edited & ^data_name.alphanum_edited 1222 & ^data_name.alphabetic_edited 1223 then go to success; 1224 go to fail; /* is itt an elementary numeric integer data item */ 1225 check (65): 1226 elnuindi: 1227 if data_name.elementary & data_name.numeric & data_name.pic_integer 1228 then go to success; 1229 go to fail; /* is it an elementary numeric item */ 1230 1231 1232 1233 check (66): 1234 elnuit: 1235 if header.type = 9 & data_name.elementary & data_name.numeric 1236 then go to success; 1237 go to fail; /* is it a file name */ 1238 1239 1240 1241 check (67): 1242 file: 1243 if header.type = 12 | header.type = 16 1244 then go to success; 1245 go to fail; /* is it an alphanumeric data item */ 1246 check (68): 1247 andait: 1248 if data_name.alphanum | data_name.alphanum_edited 1249 then go to success; 1250 go to fail; /* is contents of e counter greater than 0 ? */ 1251 check (69): 1252 egrze: 1253 if end_stmt.e > 0 1254 then go to success; 1255 go to fail; /* is item a non_sort record name */ 1256 1257 1258 1259 check (70): 1260 nsrecnm: 1261 if header.type = 9 & data_name.file_section & data_name.file_num ^= 0 & data_name.level_01 1262 then go to check70a; 1263 go to fail; 1264 check70a: 1265 file_number = data_name.file_num; 1266 call cobol_read_ft_ (file_number, ft_ptr); 1267 1268 file_org = file_table.organization; 1269 1270 if ^sort_file 1271 then go to success; 1272 go to fail; /* does saved item have linage clause */ 1273 /* not to be executed until common is all set */ 1274 check (71): 1275 linage: 1276 if file_table.linage 1277 then go to success; 1278 1279 go to fail; 1280 1281 1282 1283 /* is saved item a mass storage file */ 1284 /* the filetable is already in core from doing check 70 */ 1285 /* used by the write verb */ 1286 check (72): 1287 msfile: /* is saved item a mass storage file with other than sequential organization */ 1288 /*is file not stream organization */ 1289 if organization ^= 1 & organization ^= 5 1290 then go to success; /*[3.0-2]*/ 1291 go to fail; 1292 1293 /* is item an unsubscripted data name excluding index data names */ 1294 1295 1296 1297 check (73): 1298 undana: 1299 if header.type = 9 & ^data_name.subscripted & ^data_name.usage_index 1300 then go to success; 1301 else go to fail; 1302 1303 /* is item a subscripted data name excluding index data names */ 1304 1305 check (74): 1306 sudana: 1307 if header.type = 9 & data_name.subscripted & ^data_name.usage_index 1308 then go to success; 1309 else go to fail; 1310 1311 /* is subcnt less than level of occurs in the saved ident */ 1312 check (75): 1313 ieqlvl: /*[4.0-3]*/ 1314 if subcnt = 0 /*[4.0-3]*/ 1315 then do; 1316 if header.type = 2 /*[4.0-3]*/ 1317 then format = 0; /*[4.0-3]*/ 1318 else if header.type = 10 /*[4.0-3]*/ 1319 then format = 2; /*[4.0-3]*/ 1320 else format = 1; /*[4.0-3]*/ 1321 err = 0; /*[4.0-3]*/ 1322 end; /*[4.0-3]*/ 1323 else do; 1324 if header.type ^= 1 /*[4.0-3]*/ 1325 then /*[4.0-3]*/ 1326 if format = 0 /*[4.0-3]*/ 1327 then if header.type = 2 /*[4.0-3]*/ 1328 then ; /*[4.0-3]*/ 1329 else if header.type = 10 /*[4.0-3]*/ 1330 then format = 2; /*[4.0-3]*/ 1331 else format = 1; /*[4.0-3]*/ 1332 else if format = 1 /*[4.0-3]*/ 1333 then if header.type = 10 /*[4.0-3]*/ 1334 then err = 167; /*[4.0-3]*/ 1335 else ; /*[4.0-3]*/ 1336 else if header.type ^= 10 & header.type ^= 2 1337 /*[4.0-3]*/ 1338 then err = 167; /*[4.0-3]*/ 1339 else ; /*[4.0-3]*/ 1340 end; 1341 1342 if subcnt < dimensions 1343 then go to success; 1344 go to fail; /* is the saved ident indexed at this level */ 1345 check (76): 1346 indexed: 1347 if indexedno (subcnt) ^= 0 1348 then do; 1349 sub_loc = sub_loc + 1; 1350 go to success; 1351 end; 1352 go to fail; /* is index no of curent item = to 1353* index no of saved item */ 1354 check (77): 1355 indeqind: 1356 if index_name.index_no = indexedno (subcnt) 1357 then go to success; 1358 go to fail; /* is item a positive integer whose value is greater than zero */ 1359 check (78): 1360 pigz: 1361 call pigz_sub; 1362 1363 if pigz_res = 0 1364 then go to success; 1365 else go to fail; 1366 1367 pigz_sub: 1368 proc; 1369 1370 pigz_res = 0; 1371 litcnt = 1; 1372 1373 if header.type = 2 & numeric_lit.integral & numeric_lit.sign ^= "-" 1374 then do while ("1"b); 1375 1376 if substr (numeric_lit.literal, litcnt, 1) ^= "0" 1377 then return; 1378 1379 if litcnt = numeric_lit.places 1380 then do; 1381 pigz_res = 1; 1382 return; 1383 end; 1384 1385 litcnt = litcnt + 1; 1386 1387 end; 1388 1389 pigz_res = 1; 1390 1391 end; 1392 1393 /* is item an unsigned integer */ 1394 check (79): 1395 unsint: 1396 if header.type = 2 & numeric_lit.integral & numeric_lit.sign = " " 1397 then go to success; 1398 go to fail; /* is item an arithemetic operator */ 1399 check (80): 1400 arop: 1401 if header.type = 1 & reserved_word.arith_op 1402 then go to success; 1403 go to fail; /* is item a single character non numeric literal or a fig con */ 1404 check (81): 1405 examlitid: 1406 if header.type = 9 & data_name.display & data_name.item_length = 1 1407 then go to check81a; 1408 1409 if header.type = 1 & reserved_word.figcon 1410 then go to check81b; 1411 1412 if header.type = 3 & alphanum_lit.lit_size = 1 1413 then go to check81d; 1414 1415 if header.type = 2 & numeric_lit.places = 1 & numeric_lit.sign = " " 1416 then go to check81c; 1417 go to fail; 1418 1419 check81a: 1420 if savitmptr -> data_name.numeric = data_name.numeric 1421 then go to success; 1422 go to fail; 1423 1424 check81b: 1425 if savitmptr -> data_name.numeric & reserved_word.jump_index ^= 1 1426 then go to fail; 1427 go to success; 1428 1429 check81c: 1430 if savitmptr -> data_name.numeric 1431 then go to success; 1432 go to fail; 1433 1434 check81d: 1435 if ^savitmptr -> data_name.numeric 1436 then go to success; 1437 go to fail; /* is item elementary or redefined */ 1438 1439 check (82): 1440 elemred: 1441 if data_name.elementary | data_name.s_of_rdf | data_name.o_of_rdf 1442 then go to success; 1443 go to fail; 1444 1445 /* is saved file indexed or relative and is access random or dynamic */ 1446 1447 check (83): 1448 ixrlrady: 1449 if savitmptr -> data_name.file_num = 0 1450 then go to fail; 1451 1452 if (organization = 2 | organization = 3) & (access = 2 | access = 3) 1453 then go to success; 1454 go to fail; 1455 1456 /* does program contain sections */ 1457 check (84): 1458 secsw: /*[4.4-6]*/ 1459 if fixed_common.report 1460 then go to success; 1461 if secswitch = 1 1462 then go to success; 1463 go to fail; /* does imperative switch = 0 */ 1464 1465 1466 check (85): 1467 is_rel: /*[5.3-2]*/ 1468 if reserved_word.type ^= 1 1469 then go to fail; 1470 1471 /*[5.3-2]*/ 1472 ky = reserved_word.key; /*[5.3-2]*/ 1473 if ky = 130 | ky = 118 | ky = 113 | ky = 117 | ky = 141 | ky = 127 | ky = 180 | ky = 181 | ky = 74 1474 /*[5.3-2]*/ 1475 then go to success; 1476 1477 /* not,is,=,exceeds,unequal,positive,negative,zero,numeric,alphabetic */ 1478 1479 go to fail; /* is there no previous sections within declaratives */ 1480 1481 1482 1483 check (86): 1484 deswz: 1485 if debugsw = 0 1486 then go to success; 1487 go to fail; /* is it a cdname */ 1488 check (87): 1489 cdname: 1490 if header.type = 13 1491 then go to success; 1492 go to fail; /* is it a data name not in report section */ 1493 check (88): 1494 dana: 1495 if header.type = 9 & data_name.report_section = "0"b 1496 then go to success; 1497 go to fail; 1498 1499 /* is there a format 1 use verb associated with this verb */ 1500 1501 1502 1503 check (89): 1504 useform1b: 1505 if savitmptr -> fd_token.file_no = 0 1506 then go to fail; 1507 1508 file_number = savitmptr -> fd_token.file_no; 1509 call cobol_read_ft_ (file_number, ft_ptr); 1510 1511 go to useform1; 1512 1513 /*is declarative switch = 1 */ 1514 1515 check (90): 1516 deswon: 1517 if decswitch = 1 1518 then go to success; 1519 go to fail; 1520 1521 /* is saved file sequential or was NEXT option used */ 1522 1523 check (91): 1524 seqnext: 1525 if end_stmt.d 1526 then go to success; 1527 1528 if savitmptr -> fd_token.file_no = 0 1529 then go to fail; 1530 1531 file_number = savitmptr -> fd_token.file_no; 1532 call cobol_read_ft_ (file_number, ft_ptr); 1533 1534 if access < 2 1535 then go to success; 1536 go to fail; 1537 1538 /* is it an unsubscripted elementary data name */ 1539 1540 check (92): 1541 unelnudn: 1542 if header.type = 9 & ^data_name.subscripted & data_name.elementary & ^data_name.constant_section 1543 & data_name.numeric 1544 then go to success; 1545 go to fail; /* is it a statement termiator */ 1546 check (93): 1547 sterm: 1548 if header.type = 1 & reserved_word.terminator 1549 then go to success; 1550 1551 if header.type = 7 1552 then go to success; 1553 go to fail; /* is it a group item or does it have usage is display */ 1554 1555 1556 1557 check (94): 1558 usagid: 1559 if header.type = 9 & (data_name.non_elementary | data_name.display) 1560 then do; 1561 repcsbit = data_name.constant_section; /*[4.1-7]*/ 1562 prev_diag.line_num = header.line; /*[4.1-7]*/ 1563 prev_diag.column_num = header.column; 1564 go to success; 1565 end; 1566 go to fail; 1567 1568 /* is item an elementary item with usage is display clause */ 1569 check (95): 1570 eldis: 1571 if header.type = 9 & data_name.display & data_name.elementary 1572 then go to success; 1573 go to fail; /* was previous eos a paragraph definition */ 1574 1575 1576 1577 check (96): 1578 preospn: 1579 if end_stmt.verb = 55 1580 then go to success; 1581 go to fail; /* are both saved and current item elementary numeric */ 1582 /* and are both signed or unsigned */ 1583 /* and is left of dp in saved item le than current item*/ 1584 /* and is right of dp in saved item le than current item */ 1585 /* and does saved item not share core with current item */ 1586 check (97): 1587 nues: 1588 if saveitem.type = 2 1589 then if data_name.numeric_edited 1590 then if savitmptr -> numeric_lit.places_left <= data_name.places_left 1591 & savitmptr -> numeric_lit.places_right <= data_name.places_right 1592 then go to success; 1593 else go to fail; 1594 else if data_name.alphanum | data_name.alphanum_edited 1595 then if savitmptr -> numeric_lit.sign = " " & savitmptr -> numeric_lit.integral 1596 & savitmptr -> numeric_lit.places_left <= data_name.places_left 1597 then go to success; 1598 else go to fail; 1599 else if data_name.elementary & data_name.numeric 1600 & (data_name.item_signed | (^data_name.item_signed & savitmptr -> numeric_lit.sign = " ")) 1601 & savitmptr -> numeric_lit.places_left <= data_name.places_left 1602 & savitmptr -> numeric_lit.places_right <= data_name.places_right 1603 then go to success; 1604 else go to fail; 1605 else if saveitem.type = 1 & savitmptr -> reserved_word.key = 192 1606 /*SPACES*/ 1607 then go to fail; 1608 else if saveitem.type = 1 & savitmptr -> reserved_word.figcon 1609 then if data_name.numeric | ^data_name.alphabetic 1610 then go to success; 1611 else go to fail; 1612 else if saveitem.type = 3 1613 then if data_name.elementary & (data_name.numeric | data_name.numeric_edited) 1614 & savitmptr -> alphanum_lit.lit_size <= data_name.places_left 1615 then go to success; 1616 else go to fail; 1617 else if data_name.elementary & savitmptr -> data_name.elementary & data_name.numeric 1618 & savitmptr -> data_name.numeric 1619 & ((data_name.item_signed & savitmptr -> data_name.item_signed) 1620 | (^data_name.item_signed & ^savitmptr -> data_name.item_signed)) 1621 & savitmptr -> data_name.places_left <= data_name.places_left 1622 & savitmptr -> data_name.places_right <= data_name.places_right 1623 then do; 1624 call overlap; 1625 if res 1626 then go to success; 1627 else go to fail; 1628 end; 1629 go to fail; 1630 1631 overlap: 1632 proc; 1633 1634 if data_name.type ^= 9 | saveitem.type ^= 9 1635 then do; 1636 res = "1"b; 1637 return; 1638 end; 1639 1640 if data_name.seg_num ^= savitmptr -> data_name.seg_num | data_name.def_line = savitmptr -> data_name.def_line 1641 then do; 1642 res = "1"b; 1643 return; 1644 end; 1645 1646 /*[3.0-11]*/ 1647 /*[]*/ 1648 if data_name.linkage_section | savitmptr -> data_name.linkage_section 1649 /*[]*/ 1650 then do; 1651 if data_name.linkage_section & savitmptr -> data_name.linkage_section 1652 /*[]*/ 1653 then do; 1654 if data_name.linkage ^= savitmptr -> data_name.linkage 1655 /*[]*/ 1656 then do; 1657 res = "1"b; /*[]*/ 1658 return; /*[]*/ 1659 end; /*[]*/ 1660 end; /*[]*/ 1661 else do; 1662 res = "1"b; /*[]*/ 1663 return; /*[]*/ 1664 end; /*[]*/ 1665 end; /*[3.0-11]*/ 1666 1667 call get_pos (addr_record, O1_ptr); 1668 call get_pos (savitmptr, O2_ptr); 1669 1670 if (O1.o1 < O2.o2 & O1.o1 + O1.l1 <= O2.o2) | O2.o2 + O2.l2 <= O1.o1 1671 then res = "1"b; 1672 else res = "0"b; 1673 1674 get_pos: 1675 proc (p, q); 1676 1677 declare (p, q) ptr; 1678 1679 declare 1 O based (q), 1680 2 o fixed bin, 1681 2 l fixed bin; 1682 1683 O.o = p -> data_name.offset; 1684 O.o = O.o + O.o; 1685 1686 if p -> data_name.ascii_packed_dec_h 1687 then do; 1688 if p -> data_name.bit_offset 1689 then O.o = O.o + 1; /* comp-8 */ 1690 1691 O.l = p -> data_name.places_left + p -> data_name.places_right; 1692 1693 if p -> data_name.item_signed 1694 then O.l = O.l + 1; 1695 end; 1696 else do; 1697 O.l = p -> data_name.item_length; 1698 O.l = O.l + O.l; 1699 end; 1700 end; 1701 end; /* are both saved and current item alphanumeic */ 1702 /*and is saved item le current item */ 1703 /* and does saved item not share core with current item */ 1704 check (98): 1705 anes: 1706 if saveitem.type = 2 1707 then go to fail; 1708 else if saveitem.type = 1 & savitmptr -> reserved_word.figcon 1709 then if data_name.alphanum | data_name.non_elementary | data_name.alphanum_edited 1710 then go to success; 1711 else if savitmptr -> reserved_word.key = 180 /*ZERO*/ 1712 then go to fail; 1713 else if data_name.alphabetic 1714 then go to success; 1715 else go to fail; 1716 else if saveitem.type = 3 1717 then if (data_name.alphanum | data_name.alphanum_edited) 1718 & data_name.item_length >= savitmptr -> alphanum_lit.lit_size 1719 then go to success; 1720 else if data_name.non_elementary & data_name.item_length >= savitmptr -> alphanum_lit.lit_size 1721 then go to success; 1722 else go to fail; 1723 else if savitmptr -> data_name.numeric_edited 1724 then if (data_name.alphanum | data_name.alphanum_edited) 1725 & data_name.item_length >= savitmptr -> data_name.item_length 1726 then do; 1727 call overlap; 1728 if res 1729 then go to success; 1730 else go to fail; 1731 end; 1732 else go to fail; 1733 else if (data_name.alphanum | data_name.alphanum_edited) 1734 & (savitmptr -> data_name.alphanum | savitmptr -> data_name.alphanum_edited 1735 | savitmptr -> data_name.alphabetic) & data_name.item_length >= savitmptr -> data_name.item_length 1736 then do; 1737 call overlap; 1738 if res 1739 then go to success; 1740 else go to fail; 1741 end; 1742 go to fail; 1743 1744 /* is either saved item or current item a group item */ 1745 check (99): 1746 group: 1747 if data_name.non_elementary 1748 then go to success; 1749 1750 else if saveitem.type = 2 1751 then go to fail; 1752 1753 else if saveitem.type = 9 & savitmptr -> data_name.non_elementary 1754 then go to success; 1755 go to fail; 1756 1757 /* is sending item size le receiving size + 1 */ 1758 check (100): 1759 sler: 1760 if saveitem.type = 2 1761 then if savitmptr -> numeric_lit.places <= data_name.item_length 1762 then go to success; 1763 else go to fail; 1764 else if saveitem.type = 3 1765 then if savitmptr -> alphanum_lit.lit_size <= data_name.item_length 1766 then go to success; 1767 else go to fail; 1768 else if savitmptr -> data_name.item_length <= data_name.item_length 1769 then go to success; 1770 go to fail; 1771 1772 /* does sending item not overlap receiving item */ 1773 1774 check (101): 1775 snor: 1776 if saveitem.type = 3 | saveitem.type = 2 1777 then go to success; 1778 else do; 1779 call overlap; 1780 if res 1781 then go to success; 1782 else go to fail; 1783 end; 1784 1785 /* is it alphaanumeric or alphanumeric_edited */ 1786 1787 check (102): 1788 an: 1789 if data_name.alphanum | data_name.alphanum_edited 1790 then go to success; 1791 go to fail; 1792 1793 /* does sending item not have any digits to right of dp */ 1794 check (103): 1795 sndrdp: 1796 if saveitem.type = 3 | (saveitem.type = 2 & savitmptr -> numeric_lit.integral) 1797 | (savitmptr -> data_name.numeric_edited | savitmptr -> data_name.places_right <= 0) 1798 then go to success; 1799 go to fail; 1800 1801 /* is sending item not signed */ 1802 check (104): 1803 snos: 1804 if saveitem.type = 3 | ^(savitmptr -> data_name.item_signed) 1805 then go to success; 1806 go to fail; 1807 1808 /* is it alphabetic */ 1809 check (105): 1810 alph: 1811 if data_name.alphabetic | data_name.alphabetic_edited 1812 then go to success; 1813 go to fail; 1814 1815 /* is sending item not numeric */ 1816 check (106): 1817 snon: /*[4.2-5]*/ 1818 if saveitem.type = 9 /*[4.2-5]*/ 1819 then do; 1820 if savitmptr -> data_name.numeric /*[4.2-5]*/ 1821 then do; 1822 call diag (151); /*[4.2-5]*/ 1823 go to fail; /*[4.2-5]*/ 1824 end; 1825 1826 /*[4.2-5]*/ 1827 if savitmptr -> data_name.numeric_edited/*[4.2-5]*/ 1828 then do; 1829 call diag (136); /*[4.2-5]*/ 1830 go to fail; /*[4.2-5]*/ 1831 end; 1832 1833 /*[4.2-5]*/ 1834 go to success; /*[4.2-5]*/ 1835 end; 1836 1837 /*[4.2-5]*/ 1838 if saveitem.type = 3 | saveitem.type = 1 1839 then go to success; 1840 1841 /*[4.2-5]*/ 1842 call diag (151); 1843 1844 go to fail; 1845 1846 /* is sending field not alphabetic */ 1847 check (107): 1848 snal: 1849 if saveitem.type = 3 | saveitem.type = 2 | (saveitem.type = 9 & ^(savitmptr -> data_name.alphabetic)) 1850 then go to success; 1851 go to fail; 1852 1853 /* is sending field not alphanumeric edited */ 1854 check (108): 1855 snae: 1856 if saveitem.type = 3 | saveitem.type = 2 | ^(savitmptr -> data_name.alphanum_edited) 1857 then go to success; 1858 go to fail; 1859 1860 /* is sending field not numeric edited */ 1861 check (109): 1862 snne: 1863 if saveitem.type = 3 1864 then go to success; /* sending field is alphanumeric literal */ 1865 1866 if saveitem.type = 2 1867 then go to success; 1868 1869 if ^savitmptr -> data_name.numeric_edited 1870 then go to success; 1871 go to fail; /* is sending item alphanumeric */ 1872 check (110): 1873 san: 1874 if saveitem.type = 2 1875 then go to fail; 1876 1877 if saveitem.type = 3 1878 then go to success; /* sending field is alphanumeric literal */ 1879 1880 if savitmptr -> data_name.alphanum 1881 then go to success; 1882 go to fail; /* is sending right of dp le receiving right of dp */ 1883 check (111): 1884 ritdep: 1885 if saveitem.type = 2 1886 then go to check111a; 1887 1888 if savitmptr -> data_name.places_right <= data_name.places_right 1889 then go to success; 1890 go to fail; 1891 1892 check111a: 1893 if savitmptr -> numeric_lit.places_right <= data_name.places_right 1894 then go to success; 1895 go to fail; /* is sending left of dp le receiving lift of dp */ 1896 check (112): 1897 lefdep: 1898 if saveitem.type = 2 1899 then go to check112a; 1900 1901 if savitmptr -> data_name.places_left <= data_name.places_left 1902 then go to success; 1903 go to fail; 1904 1905 check112a: 1906 if savitmptr -> numeric_lit.places_left <= data_name.places_left 1907 then go to success; 1908 go to fail; /* is sending field signed and receiveng field unsigned */ 1909 check (113): 1910 stun: 1911 if saveitem.type = 2 1912 then go to check113a; /* numeric literal */ 1913 1914 if savitmptr -> data_name.item_signed & ^data_name.item_signed 1915 then go to success; 1916 go to fail; 1917 1918 check113a: /* numeric literal */ 1919 if savitmptr -> numeric_lit.sign ^= " " & ^data_name.item_signed 1920 then go to success; 1921 go to fail; /* is sending item total size le left of dp redeiving field */ 1922 check (114): 1923 slelef: 1924 if (saveitem.type = 3 & savitmptr -> alphanum_lit.lit_size <= data_name.places_left) 1925 | (saveitem.type = 9 & savitmptr -> data_name.item_length <= data_name.places_left) 1926 then go to success; 1927 go to fail; 1928 1929 /* is it end declaratives */ 1930 1931 1932 check (115): 1933 enddec: /*[5.2-1]*/ 1934 if header.type = 1 & reserved_word.key = 98 /*[5.2-1]*/ & reserved_word.end_dec = "1"b 1935 then do; 1936 end_decl_bit = "1"b; 1937 go to success; 1938 end; 1939 go to fail; /* is item alterable */ 1940 1941 check (116): 1942 edalit: 1943 if header.type = 9 & data_name.constant_section = "0"b 1944 then go to success; 1945 go to fail; /* is it an alterable elementary numeric item */ 1946 check (117): 1947 alelnuitm: 1948 if header.type = 9 & data_name.constant_section = "0"b & data_name.elementary = "1"b & data_name.numeric = "1"b 1949 then go to success; 1950 go to fail; /* is it an integer */ 1951 check (118): 1952 elnuint: 1953 if header.type = 2 & numeric_lit.integral 1954 then go to success; 1955 go to fail; /* is it an elementary numeric data name and an integer */ 1956 check (119): 1957 elnudnint: 1958 if header.type = 9 & data_name.elementary & data_name.pic_integer 1959 then go to success; 1960 go to fail; /* is it an edited or non edited alterable 1961* elementary numeric item */ 1962 check (120): 1963 edalelnue: 1964 if header.type = 9 & ^data_name.constant_section & data_name.elementary 1965 & (data_name.numeric | data_name.numeric_edited) 1966 then go to success; 1967 go to fail; /* is curerent item file number not equal to saved item file number */ 1968 1969 check (121): 1970 filno: 1971 if data_name.file_num ^= savitmptr -> data_name.file_num 1972 then go to success; 1973 go to fail; /* is item alphabetic or alphanumeric */ 1974 check (122): 1975 alphoral: 1976 if data_name.alphanum | data_name.alphabetic 1977 then go to success; 1978 go to fail; /* is item an arithmetic operator or right paren */ 1979 check (123): 1980 aroprp: 1981 if header.type = 1 & reserved_word.arith_op 1982 then go to success; 1983 1984 if header.type = 1 & reserved_word.key = 188 1985 then go to success; 1986 go to fail; /* is item a relation operator */ 1987 1988 check (124): 1989 relop: 1990 if fixed_common.comp_level < "3" 1991 then do; 1992 if header.type = 1 & reserved_word.rel_op 1993 then do; 1994 if reserved_word.end_dec 1995 then call lev_diag (10); 1996 go to success; 1997 end; 1998 1999 end; 2000 else do; 2001 if header.type = 1 & reserved_word.rel_op 2002 then go to success; 2003 end; 2004 2005 go to fail; /* is token res word positive or negative or zero */ 2006 check (125): 2007 pnz: 2008 if header.type = 1 & reserved_word.key = 141 | reserved_word.key = 127 | reserved_word.key = 180 2009 then go to success; 2010 go to fail; /* is subject not = 0 --- do we have a subject present */ 2011 check (126): 2012 is_sub_opt: 2013 if SUBJ_REQ 2014 then go to fail; 2015 else go to success; 2016 2017 /* is item on stack numeric */ 2018 check (127): /* sign condition test */ 2019 numstak: /*[4.2-8]*/ 2020 if op.loc = null () 2021 then go to success; 2022 2023 /*[4.2-8]*/ 2024 if op.loc -> data_name.type ^= 9 2025 then go to fail; 2026 2027 /*[4.2-8]*/ 2028 if op.loc -> data_name.non_elementary 2029 then go to fail; 2030 2031 /*[4.2-8]*/ 2032 if ^op.loc -> data_name.numeric 2033 then go to fail; 2034 2035 /*[4.2-8]*/ 2036 go to success; /* is item on stack not numerical */ 2037 check (128): /* alphabetic class condition */ 2038 notnumstk: /*[4.2-8]*/ 2039 if op.loc = null () 2040 then go to fail; 2041 2042 /*[4.2-8]*/ 2043 if op.loc -> data_name.type ^= 9 2044 then go to fail; 2045 2046 /*[4.2-8]*/ 2047 if op.loc -> data_name.elementary /*[4.2-8]*/ 2048 then if ^op.loc -> data_name.display /*[4.2-8]*/ 2049 then go to fail; /*[4.2-8]*/ 2050 else if op.loc -> data_name.numeric /*[4.2-8]*/ 2051 then go to fail; 2052 2053 /*[4.2-8]*/ 2054 go to success; /* is item on stack not alphabetic */ 2055 check (129): /* numeric condition test */ 2056 notalpstk: /*[4.2-8]*/ 2057 if op.loc = null () 2058 then go to fail; 2059 2060 /*[4.2-8]*/ 2061 if op.loc -> data_name.type ^= 9 2062 then go to fail; 2063 2064 /*[4.2-8]*/ 2065 if op.loc -> data_name.elementary /*[4.2-8]*/ 2066 then if ^op.loc -> data_name.display /*[4.2-8]*/ 2067 then go to fail; /*[4.2-8]*/ 2068 else if op.loc -> data_name.alphabetic /*[4.2-8]*/ 2069 then go to fail; 2070 2071 /*[4.2-8]*/ 2072 go to success; /* is arithmetic stack = 0 */ 2073 check (130): 2074 zerstk: 2075 if assub = 1 | assub = 0 2076 then go to success; 2077 go to fail; /* does item on arithmetic stack = left parenthesis */ 2078 check (131): 2079 lefparstk: 2080 if assub = 0 2081 then go to fail; 2082 if astack.lefpar (assub) 2083 then go to success; 2084 else go to fail; /* is the logical stack = ( and is bit logical = 0 */ 2085 check (132): 2086 logbitstk: 2087 if cssub = 0 2088 then go to fail; 2089 2090 if cstack.leftpar (cssub) & ^cstack.logical (cssub) 2091 then go to success; 2092 go to fail; /* is logical stack = ( */ 2093 check (133): 2094 logstk: 2095 if cstack.leftpar (cssub) 2096 then go to success; 2097 go to fail; /* is item a status switch condition name */ 2098 check (134): 2099 sscondnm: 2100 if mnemonic_name.type = 17 & mnemonic_name.class.switch_condition 2101 then go to success; 2102 2103 go to fail; 2104 2105 /* to be done later */ 2106 2107 /* are the arguments of the relation compatible */ 2108 check (135): 2109 argscomp: 2110 go to success; /* is item in active logical a left parenthesis */ 2111 check (136): 2112 actloglp: 2113 if act_log.leftpar 2114 then go to success; 2115 go to fail; /* is top of stack a left parenthesis */ 2116 check (137): 2117 lptopstk: 2118 if cstack.leftpar (cssub) 2119 then go to success; 2120 go to fail; 2121 2122 /* is item an unsubscripted index data name */ 2123 2124 check (138): 2125 unxdnm: 2126 if header.type = 9 & ^data_name.subscripted & data_name.usage_index 2127 then go to success; 2128 go to fail; /* can we expect another else or a period at this point */ 2129 check (139): 2130 is_imp: /*[5.3-2]*/ 2131 if ST.cond (nest_lev + 1) 2132 then go to fail; 2133 else go to success; 2134 2135 /* are the subscripts compatible */ 2136 check (140): 2137 daib: 2138 if data_name_bit ^= index_name_bit 2139 then go to success; 2140 go to fail; 2141 2142 2143 check (141): 2144 go to fail; /* NOT USED */ 2145 /* NOT USED */ 2146 2147 2148 check (142): 2149 go to fail; /* NOT USED */ 2150 /* NOT USED */ 2151 2152 /* is present file number not equal to saved file number */ 2153 2154 check (143): 2155 filnefil: 2156 if data_name.file_num ^= savitmptr -> data_name.file_num 2157 then go to success; 2158 go to fail; 2159 2160 check (144): 2161 indxfile: 2162 if data_name.file_num ^= 0 2163 then do; 2164 file_number = data_name.file_num; 2165 call cobol_read_ft_ (file_number, ft_ptr); 2166 end; 2167 else go to fail; 2168 2169 if organization = 3 2170 then go to success; 2171 go to fail; 2172 2173 check (145): 2174 gotod: /* are we processing a go to depending in if statement */ 2175 if gotodep 2176 then go to success; 2177 go to fail; /* is the justified right bit not set */ 2178 check (146): 2179 njustr: 2180 if ^data_name.just_right 2181 then go to success; 2182 go to fail; 2183 2184 /* is item alphanumeric */ 2185 2186 check (147): 2187 nonumdn: 2188 if header.type = 9 & data_name.alphanum 2189 then go to success; 2190 go to fail; /* is receiving field alphanumeric edited */ 2191 2192 2193 2194 check (148): 2195 rae: 2196 if data_name.alphanum_edited 2197 then go to success; 2198 go to fail; 2199 2200 /* is item elementary alphabetic,alphanumeric or numeric edited or a group item */ 2201 2202 2203 2204 check (149): 2205 elaanne: 2206 if header.type = 9 2207 & ((data_name.elementary & (data_name.numeric_edited | data_name.alphanum | data_name.alphabetic)) 2208 | data_name.non_elementary) 2209 then go to success; 2210 go to fail; 2211 2212 /* is item a subscribted idndex data name */ 2213 2214 2215 2216 check (150): 2217 suxdnm: 2218 if header.type = 9 & data_name.subscripted & data_name.usage_index 2219 then go to success; 2220 go to fail; /* does declarative portion reference non-declarative portion or vice versa */ 2221 2222 check (151): 2223 decnondec: 2224 if decswitch = 1 | ^proc_def.declarative_proc 2225 then go to success; 2226 go to fail; 2227 2228 /* was there a procedure definition before the EXIT verb */ 2229 2230 2231 2232 check (152): 2233 ckprpnbit: 2234 if preospn_bit 2235 then go to success; 2236 go to fail; 2237 2238 /* is this MNEMONIC NAME an input device */ 2239 2240 2241 2242 check (153): 2243 indev: 2244 if mnemonic_name.iw_key = 3 | mnemonic_name.iw_key = 1 2245 then go to success; /*[3.0-4]*/ 2246 go to fail; 2247 2248 /* is MNEMONIC NAME input device */ 2249 2250 check (154): 2251 outdev: 2252 if mnemonic_name.iw_key = 3 | mnemonic_name.iw_key = 2 2253 then go to success; /*[3.0-4]*/ 2254 go to fail; 2255 2256 /* is file either relative or INDEXED */ 2257 /* is ACCESS either SEQUENTIAL or DYNAMIC */ 2258 /* used for START verb */ 2259 2260 check (155): 2261 ixrlsqdy: 2262 if fd_token.file_no ^= 0 2263 then do; 2264 file_number = fd_token.file_no; 2265 call cobol_read_ft_ (file_number, ft_ptr); 2266 end; 2267 else go to fail; 2268 2269 if (organization = 2 & relative_key) | organization = 3 2270 then if access < 2 | access = 3 2271 then go to success; 2272 go to fail; 2273 2274 /* is file ORGANIZATION RELATIVE */ 2275 /* used for START verb */ 2276 /* buffer already has record from common */ 2277 2278 check (156): 2279 relfile: 2280 if organization = 2 2281 then go to success; 2282 go to fail; 2283 2284 /* is ITEM NAME & ADDRESS same as info in KEY NAME in SELECT clause */ 2285 /* FILE TABLE already in core */ 2286 /* processing START verb */ 2287 2288 check (157): 2289 keyiskey: 2290 if r_key_info = "00000" 2291 then go to fail; 2292 2293 varrecaddr = r_key_info; 2294 call vardget; 2295 fkey_ptr = seqvarptr; 2296 2297 if substr (data_name.name, 1, data_name.name_size) = substr (fkname, 1, file_key.fkname_size) 2298 & data_name.seg_num = fkseg_num & data_name.offset = fkoffset 2299 then go to success; 2300 go to fail; 2301 2302 /* is ADDRESS same as FILE KEY in COMMON */ 2303 /* FILE TABLE already in core */ 2304 /* processing START verb */ 2305 2306 check (158): /*[3.0-15]*/ 2307 adrisadr: /*[]*/ 2308 if alternate_keys = 0 /*[]*/ 2309 then if r_key_info = "00000" /*[]*/ 2310 then go to fail; /*[]*/ 2311 else ; /*[]*/ 2312 else if alt_key_info = "00000" /*[]*/ 2313 then go to fail; /*[]*/ 2314 /*[]*/ 2315 file_desc_1_ptr = addrel (cobol_$con_end_ptr, -(file_desc_1_offset - 1)); 2316 /*[]*/ 2317 /*[]*/ 2318 if header.type = 9 /*[]*/ & /*[]*/ (data_name.file_num = file_table.file_no | alternate_keys = 0) 2319 /*[]*/ 2320 then do; /*[]*/ 2321 if get_rel_offset (data_name.offset) = file_desc_1.prime_key.offset 2322 /*[]*/ 2323 then do; /*[]*/ 2324 vfile_key = 511; /* prime vfile_ key */ 2325 /*[]*/ 2326 go to success; /*[]*/ 2327 end; /*[]*/ 2328 else do kc = 1 to alternate_keys; /*[]*/ 2329 if get_rel_offset (data_name.offset) = file_desc_1.alt_key (kc).offset 2330 /*[]*/ 2331 then do; /*[]*/ 2332 vfile_key = kc; /*[]*/ 2333 go to success; /*[]*/ 2334 end; /*[]*/ 2335 end; /*[]*/ 2336 end; /*[]*/ 2337 /*[]*/ 2338 /*[]*/ 2339 go to fail; 2340 2341 2342 get_rel_offset: 2343 proc (abs_offset) /*[]*/ returns (fixed bin (24)); 2344 2345 /*[]*/ 2346 dcl abs_offset fixed bin (24); /*[]*/ 2347 dcl rel_offset fixed bin (24); /*[]*/ 2348 /*[]*/ 2349 rel_offset = abs_offset - file_table.abs_record_offset; 2350 /*[]*/ 2351 return (rel_offset); /*[]*/ 2352 end get_rel_offset; 2353 2354 check (159): 2355 ssnm: 2356 if mnemonic_name.type = 17 & mnemonic_name.class.switch_name 2357 then go to success; 2358 2359 go to fail; 2360 2361 check (160): /* enter, routine name */ 2362 is_rout: 2363 if lang_num = 1 2364 then go to fail; 2365 2366 if header.type = 8 2367 then go to success; 2368 2369 go to fail; 2370 2371 check (161): 2372 edick: 2373 if data_name.alphanum | data_name.alphabetic 2374 | (data_name.numeric & data_name.places_left ^< 0 & data_name.places_right ^< 0) 2375 then go to success; 2376 go to fail; 2377 2378 check (162): 2379 cktp25: 2380 if header.type = 25 2381 then go to success; 2382 go to fail; 2383 2384 /* range check for set verb format 1 */ 2385 check (163): 2386 ckrng1: 2387 convtemp = 0; 2388 2389 do ii = 1 to numeric_lit.places; 2390 tempchar1 = substr (numeric_lit.literal, ii, 1); 2391 convtemp = convtemp * 10 + fixed (unspec (tempchar1), 8) - convalue; 2392 end; 2393 2394 if convtemp ^> savitmptr -> index_name.max 2395 then go to success; 2396 go to fail; 2397 2398 /* range check for set verb format 2 */ 2399 check (164): 2400 ckrng2: 2401 convtemp = 0; 2402 2403 do ii = 1 to numeric_lit.places; 2404 tempchar1 = substr (numeric_lit.literal, ii, 1); 2405 convtemp = convtemp * 10 + fixed (unspec (tempchar1), 8) - convalue; 2406 end; 2407 2408 if convtemp < savitmptr -> index_name.max 2409 then go to success; 2410 go to fail; 2411 2412 /* check ssf or dof in file table - already in core from check(70) */ 2413 2414 check (165): 2415 ckrcpref: 2416 if (record_prefix = 2 | record_prefix = 3) 2417 then go to success; 2418 go to fail; 2419 2420 /* check to insure that the literal used for the program-id is less than 13 characters */ 2421 2422 2423 2424 check (166): 2425 cklit: 2426 if header.type = 3 & alphanum_lit.lit_size < 31 2427 then go to success; 2428 go to fail; 2429 2430 /* are both proc-names non-declaratives or both declaratives in same declarative section */ 2431 2432 check (167): 2433 ckdecpn: 2434 if ^proc_def.declarative_proc & ^(savitmptr -> proc_def.declarative_proc) 2435 then go to success; 2436 2437 if (proc_def.declarative_proc & savitmptr -> proc_def.declarative_proc) 2438 & (proc_def.section_num = savitmptr -> proc_def.section_num) 2439 then go to success; 2440 go to fail; 2441 2442 /* independent & non-independent segment checks for perform verb */ 2443 check (168): 2444 cksegm: 2445 if secswitch = 0 2446 then go to success; 2447 if shprio > 99 2448 then go to fail; 2449 2450 prio1 = fixed (unspec (savitmptr -> proc_def.priority), 16); 2451 2452 if prio1 > 99 2453 then go to fail; 2454 2455 prio2 = fixed (unspec (proc_def.priority), 16); 2456 2457 if prio2 > 99 2458 then go to fail; 2459 if shprio > 49 2460 then go to check168a; 2461 if prio1 < 50 & prio2 < 50 2462 then go to success; 2463 if prio1 = prio2 2464 then go to success; 2465 go to fail; 2466 check168a: 2467 if prio1 < 50 & prio2 < 50 2468 then go to success; 2469 2470 if (prio1 = prio2) & (prio1 = shprio) 2471 then go to success; 2472 go to fail; 2473 2474 /* check for a nonzero numeric literal */ 2475 check (169): 2476 nznumlit: 2477 if header.type = 2 2478 then do; 2479 litcnt = 1; 2480 2481 do while ("1"b); 2482 2483 if substr (numeric_lit.literal, litcnt, 1) ^= "0" 2484 then go to success; 2485 2486 if litcnt = numeric_lit.places 2487 then go to fail; 2488 2489 litcnt = litcnt + 1; 2490 2491 end; 2492 end; 2493 2494 go to fail; 2495 2496 /* check integer bit in saved identifier */ 2497 check (170): 2498 ckintbit: 2499 if numeric_lit.integral 2500 then go to success; /*[3.0-3]*/ 2501 go to fail; 2502 2503 /* check segment number in declaratives */ 2504 2505 2506 check (171): 2507 ckdsegnum: 2508 if perfprio < 50 2509 then go to success; 2510 go to fail; 2511 2512 /* is a use procedure already associated with this file */ 2513 2514 check (172): 2515 ckerrex: 2516 if end_stmt.a = "000"b & fd_token.file_no ^= 0 2517 then do; 2518 2519 file_number = fd_token.file_no; 2520 call cobol_read_ft_ (file_number, ft_ptr); 2521 2522 if error_exit = 0 2523 then go to success; 2524 else go to fail; 2525 2526 end; 2527 go to fail; 2528 2529 /* is a use procedure already associated with input */ 2530 2531 check (173): 2532 ckinput: 2533 if input_error_exit = 0 2534 then go to success; 2535 else go to fail; 2536 2537 /* is a use procedure already associated with output */ 2538 2539 check (174): 2540 ckoutput: 2541 if output_error_exit = 0 2542 then go to success; 2543 else go to fail; 2544 2545 /* is a use procedure already associated with i-o */ 2546 2547 check (175): 2548 ckio: 2549 if i_o_error_exit = 0 2550 then go to success; 2551 else go to fail; 2552 2553 /* is a use procedure already associated with extend */ 2554 2555 check (176): 2556 ckextend: 2557 if extend_error_exit = 0 2558 then go to success; 2559 else go to fail; 2560 2561 /* for delete and start verbs - does a use procedure exist */ 2562 2563 check (177): 2564 useformds: 2565 if error_exit ^= 0 2566 then go to success; 2567 if input_error_exit ^= 0 2568 then go to success; 2569 if output_error_exit ^= 0 2570 then go to success; 2571 if i_o_error_exit ^= 0 2572 then go to success; 2573 if extend_error_exit ^= 0 2574 then go to success; 2575 go to fail; 2576 2577 /* for read verb - does a use procedure exist */ 2578 2579 check (178): 2580 useformr: 2581 if error_exit ^= 0 2582 then go to success; 2583 if input_error_exit ^= 0 2584 then go to success; 2585 if i_o_error_exit ^= 0 2586 then go to success; 2587 go to fail; 2588 2589 /* for write and rewrite verbs - does a use procedure exist */ 2590 2591 check (179): 2592 useformrw: 2593 if error_exit ^= 0 2594 then go to success; 2595 if output_error_exit ^= 0 2596 then go to success; 2597 if i_o_error_exit ^= 0 2598 then go to success; 2599 if extend_error_exit ^= 0 2600 then go to success; 2601 go to fail; 2602 2603 /* is an lit < 32 chars for CALL */ 2604 2605 check (180): 2606 cklit1: 2607 if alphanum_lit.lit_size < 32 2608 then go to success; 2609 go to fail; 2610 2611 /* are we executing multics cobol compiler */ 2612 2613 check (181): 2614 mcobol: 2615 if compiler_id = 3 2616 then go to success; 2617 go to fail; 2618 2619 /* is an lit < 66 chars for CALL */ 2620 2621 check (182): 2622 cklit2: 2623 if alphanum_lit.lit_size < 66 2624 then go to success; 2625 go to fail; 2626 2627 /* is organization not stream */ 2628 2629 check (183): 2630 nstream: 2631 if header.type = 12 2632 then do; 2633 2634 if fd_token.file_no ^= 0 2635 then do; 2636 2637 file_number = fd_token.file_no; 2638 call cobol_read_ft_ (file_number, ft_ptr); 2639 2640 if organization ^= 5 2641 then go to success; /*[3.0-2]*/ 2642 go to fail; 2643 2644 end; 2645 2646 end; 2647 go to fail; 2648 2649 /* is orgganization stream */ 2650 2651 check (184): 2652 stream: 2653 if fd_token.file_no = 0 2654 then go to fail; 2655 2656 file_number = fd_token.file_no; 2657 call cobol_read_ft_ (file_number, ft_ptr); 2658 2659 if organization = 5 2660 then go to success; /*[3.0-2]*/ 2661 go to fail; 2662 2663 /* is organization not stream */ 2664 2665 check (185): 2666 nstorg: 2667 if organization ^= 5 2668 then go to success; /*[3.0-2]*/ 2669 go to fail; 2670 2671 /* is item unsubscripted data name excluding index data names, and, 2672* is it elementary, numeric ,integer data item. */ 2673 check (186): 2674 udneli: 2675 if header.type = 9 & ^data_name.subscripted & ^data_name.usage_index & data_name.elementary 2676 & data_name.numeric & data_name.pic_integer 2677 then do; 2678 sub_loc = sub_loc + 1; 2679 go to success; 2680 end; 2681 go to fail; 2682 2683 check (187): 2684 cstst: 2685 if ^data_name.constant_section 2686 then go to success; 2687 else go to fail; 2688 2689 check (188): 2690 altst: 2691 if header.type = 9 & data_name.elementary & data_name.numeric 2692 then go to success; 2693 else go to fail; 2694 2695 check (189): 2696 edaltst: 2697 if header.type = 9 & data_name.elementary & (data_name.numeric | data_name.numeric_edited) 2698 then go to success; 2699 else go to fail; 2700 2701 check (190): 2702 csstst: 2703 if ^cssavebit 2704 then go to success; 2705 else go to fail; 2706 2707 check (191): 2708 altlegal: 2709 if declprocbit | ^proc_def.declarative_proc 2710 then go to success; 2711 else go to fail; 2712 2713 check (192): 2714 lev_test: 2715 if lev_save = cssub 2716 then go to success; 2717 else go to fail; 2718 2719 check (193): 2720 resword: /*[4.2-6]*/ 2721 oploc.line = reserved_word.line; /*[4.2-6]*/ 2722 oploc.col = reserved_word.column; 2723 2724 /*[4.2-6]*/ 2725 if reserved_word.type = 1 /*[4.2-6]*/ 2726 then go to success; /*[4.2-6]*/ 2727 else go to fail; 2728 2729 check (194): 2730 type9: 2731 if header.type = 9 2732 then go to success; 2733 else go to fail; 2734 2735 check (195): 2736 alphnm: /* check for alphabet name token */ 2737 if alphabet_name.type = 40 2738 then do; 2739 end_stmt.i = alphabet_name.iw_key; 2740 end_stmt.d = "10"b; 2741 end; 2742 else go to fail; 2743 2744 go to success; 2745 2746 check (196): 2747 on_off: /* test for ON or OFF */ 2748 if reserved_word.type ^= 1 2749 then go to fail; 2750 2751 key = reserved_word.key; 2752 2753 if key = 134 2754 then end_stmt.c = "1"b; /* is_word("ON") */ 2755 else if key = 574 2756 then end_stmt.c = "0"b; /* is_word("OFF") */ 2757 else go to fail; 2758 2759 end_stmt.a = "010"b; 2760 2761 go to success; 2762 2763 acc_dev: 2764 check (197): /* test for accept device */ 2765 if mnemonic_name.type = 17 & mnemonic_name.class.accept_device 2766 then go to success; 2767 2768 go to fail; 2769 2770 disp_dev: 2771 check (198): /* test for display device */ 2772 if mnemonic_name.type = 17 & mnemonic_name.class.display_device 2773 then go to success; 2774 2775 go to fail; 2776 2777 prt_con: 2778 check (199): /* test for printer control */ 2779 if mnemonic_name.type = 17 & mnemonic_name.class.printer_control 2780 then go to success; 2781 2782 go to fail; 2783 2784 check (200): /* enter, language name */ 2785 is_lang: 2786 lang_num = cobol_imp_word$lang_name (addr_record); 2787 2788 if lang_num = 0 2789 then go to fail; 2790 2791 go to success; 2792 2793 check (201): 2794 amarg: 2795 if header.column < 12 2796 then go to success; 2797 go to fail; 2798 2799 check (202): 2800 set_xint: 2801 if header.type = 9 & data_name.elementary 2802 then go to success; 2803 2804 go to fail; 2805 2806 check (203): 2807 set_pigz: 2808 call pigz_sub; 2809 2810 if pigz_res = 0 2811 then go to success; 2812 2813 go to fail; 2814 2815 check (204): 2816 tst_xint: 2817 if data_name.usage_index 2818 then do; 2819 if set_sop.ind_data 2820 then do; 2821 call diag (280); 2822 go to fail; 2823 end; 2824 go to success; 2825 end; 2826 2827 if data_name.pic_integer 2828 then do; 2829 if set_sop.int_data 2830 then do; 2831 call diag (281); 2832 go to fail; 2833 end; 2834 2835 go to success; 2836 end; 2837 2838 call diag (178); 2839 2840 go to fail; 2841 2842 check (205): 2843 tst_pigz: 2844 if set_sop.int_lit 2845 then do; 2846 call diag (282); 2847 go to fail; 2848 end; 2849 2850 go to success; 2851 2852 check (206): 2853 is_user_word: 2854 if data_name.type = 9 2855 then go to success; 2856 2857 go to fail; 2858 2859 check (207): 2860 open_mode: 2861 if reserved_word.type = 1 2862 then do; 2863 if reserved_word.key = 115 2864 then op_mode = 1; /* input */ 2865 else if reserved_word.key = 137 2866 then op_mode = 2; /* output */ 2867 else if reserved_word.key = 119 2868 then op_mode = 3; /* i-o */ 2869 else if reserved_word.key = 216 /* extend */ 2870 /*[4.4-8]*/ 2871 then do; 2872 op_mode = 4; /*[4.4-8]*/ 2873 if fixed_common.comp_level < "3" 2874 then call lev_diag (39); /*[4.4-8]*/ 2875 end; 2876 else go to fail; 2877 go to success; 2878 end; 2879 2880 go to fail; 2881 2882 check (208): 2883 nlit: 2884 if header.type = 2 2885 then go to success; 2886 2887 go to fail; 2888 2889 check (209): /*[3.0-6]*/ 2890 pigz_by: /*[3.0-6]*/ 2891 litcnt = 1; /*[3.0-6]*/ 2892 2893 if header.type = 2 /*[3.0-6]*/ & /*[3.0-6]*/ numeric_lit.integral 2894 /*[3.0-6]*/ 2895 then do while ("1"b); /*[3.0-6]*/ 2896 2897 if substr (numeric_lit.literal, litcnt, 1) ^= "0" 2898 /*[3.0-6]*/ 2899 then do; 2900 if numeric_lit.sign = "-" /*[3.0-6]*/ 2901 then do; 2902 if fixed_common.comp_level < "5" 2903 /*[3.0-6]*/ 2904 then call lev_diag (40); 2905 /*[3.0-6]*/ 2906 end; /*[3.0-6]*/ 2907 2908 go to success; /*[3.0-6]*/ 2909 end; /*[3.0-6]*/ 2910 2911 if litcnt = numeric_lit.places 2912 then go to fail; /*[3.0-6]*/ 2913 2914 litcnt = litcnt + 1; /*[3.0-6]*/ 2915 2916 end; /*[3.0-6]*/ 2917 2918 go to fail; /*[3.0-10]*/ 2919 2920 /* the following proc is used by the action routines 2921* ieo means exclusive or 2922* set coperator.not to coperator.not eo lognot eo parameter 2923* clear lognot 2924* if param = 0 move use (true of active ) to tag field of coperator and go to second next inst 2925* if param not 0 then move use (false of active ) to tag field of coperator and go to next inst 2926* output the coperator 2927* clear operator 2928* return*/ 2929 2930 /* if file device suffix printer */ 2931 2932 check (210): /*[3.0-14]*/ 2933 devptr: /*[3.0-14]*/ 2934 if savitmptr -> data_name.file_num = 0 /*[3.0-14]*/ 2935 then goto fail; /*[3.0-14]*/ 2936 2937 file_number = savitmptr -> data_name.file_num; /*[3.0-14]*/ 2938 call cobol_read_ft_ (file_number, ft_ptr); /*[3.0-14]*/ 2939 2940 if file_table.device = 1 2941 then goto success; /*[3.0-14]*/ 2942 2943 goto fail; /*[3.0-14]*/ 2944 2945 2946 2947 /*[3.0-16]*/ 2948 /* check for sequential file using savitmptr */ 2949 2950 check (211): 2951 seqstmfil: 2952 if savitmptr -> data_name.file_num = 0 2953 then go to fail; 2954 2955 file_number = savitmptr -> data_name.file_num; 2956 call cobol_read_ft_ (file_number, ft_ptr); 2957 2958 if organization = 1 | organization = 5 2959 then go to success; 2960 2961 go to fail; 2962 2963 /*[4.0-1]*/ 2964 check (212): 2965 cond_name: /*[4.0-1]*/ 2966 if reserved_word.section_header 2967 then go to success; 2968 else go to fail; 2969 2970 check (213): 2971 pn_pres: /*[4.0-4]*/ 2972 if end_stmt.d = "00"b 2973 then go to success; 2974 else go to fail; 2975 2976 check (214): 2977 debug: /*[4.4-5]*/ 2978 if fixed_common.debug & fixed_common.use_debug 2979 then go to success; /*[4.4-5]*/ 2980 if fixed_common.use_reporting /*[4.4-5]*/ 2981 then do while (addr_record -> reserved_word.column = 9999); 2982 /*[4.4-5]*/ 2983 call SCAN; /*[4.4-5]*/ 2984 end; 2985 2986 /*[5.1-2]*/ 2987 LTP, last_wd_per = "1"b; /*[4.4-5]*/ 2988 if fixed_common.report 2989 then go to success; 2990 else go to fail; 2991 2992 check (215): 2993 not_opt: /*[5.3-2]*/ 2994 if ST.not_opt (nest_lev) 2995 then go to success; 2996 else go to fail; 2997 2998 check (216): /* check for figurative constant ZERO */ 2999 figzero: /*[4.2-3]*/ 3000 if reserved_word.type = 1 & reserved_word.key = 180 3001 then if fixed_common.comp_level < "3" & reserved_word.end_dec 3002 then call lev_diag (154); 3003 else /* do nothing */ 3004 ; 3005 else go to fail; 3006 3007 go to success; 3008 3009 check (217): 3010 noo: /*[5.3-2]*/ 3011 if reserved_word.type = 1 /*[5.3-2]*/ 3012 then if reserved_word.key = 130 | reserved_word.key = 134 | reserved_word.key = 6 3013 /*[5.3-2]*/ 3014 then go to success; /*[5.3-2]*/ 3015 else go to fail; /*[5.3-2]*/ 3016 else go to fail; 3017 3018 3019 3020 3021 3022 3023 3024 3025 check (218): 3026 is_cond: 3027 if iscond 3028 then go to success; 3029 else go to fail; 3030 3031 check (219): 3032 period: /*[4.4-2]*/ 3033 if reserved_word.type = 1 /*[4.4-2]*/ 3034 then if reserved_word.key = 189 /* . */ 3035 /*[4.4-2]*/ 3036 then do; 3037 last_wd_per = "1"b; 3038 3039 /*[4.4-2]*/ 3040 go to success; /*[4.4-2]*/ 3041 end; /*[4.4-2]*/ 3042 go to fail; 3043 3044 check (220): 3045 nae: /*[5.3-2]*/ 3046 if reserved_word.type = 1 /*[5.3-2]*/ 3047 then if reserved_word.key = 130 | reserved_word.key = 79 | reserved_word.key = 100 3048 /*not,at,eop */ 3049 /*[5.3-2]*/ 3050 then go to success; /*[5.3-2]*/ 3051 else go to fail; 3052 3053 3054 3055 /***********************************************:*****************************/ 3056 /***** PLACE NEW CHECKS BEFORE THIS COMMENT ********/ 3057 /*****************************************************************************/ 3058 3059 EQ: 3060 proc (tag1, tag2); 3061 3062 /*[4.4-5]*/ 3063 declare (tag1, tag2) fixed bin; 3064 3065 /*[5.1-1]*/ 3066 if tag1 = 0 3067 then return; /*[5.1-1]*/ 3068 if tag2 = 0 /*[5.1-1]*/ 3069 then do; 3070 tag2 = tag1; 3071 return; 3072 end; /*[5.1-1]*/ 3073 else call out_equiv (tag1, tag2); 3074 3075 end; 3076 3077 TEST: 3078 proc (tag, bool_fcn); 3079 3080 /*[4.4-5]*/ 3081 declare tag fixed bin, 3082 bool_fcn bit (4); 3083 3084 /*[5.1-1]*/ 3085 coperator.not = bool (coperator.not, lognot, bool_fcn); 3086 3087 /*[4.4-5]*/ 3088 if tag = 0 /*[4.4-5]*/ 3089 then tag, coperator.tag = assign_value (); /*[4.4-5]*/ 3090 else coperator.tag = tag; 3091 3092 lognot = "0"b; 3093 unspec (opeos.i) = cop_c_bits; 3094 3095 call emit_type_13 (coperator.op, coperator.tag); 3096 3097 coperator_bits = "0"b; 3098 3099 end; /* the param is usually a tag name 3100* if param = 0 return to caller 3101* if not output a pseudo-procedure-definition 3102* with param as an operand 3103* move t zero to param return to caller */ 3104 3105 DEF: 3106 proc (param); 3107 3108 3109 dcl param fixed bin; 3110 3111 if param = 0 3112 then return; 3113 3114 dumprocname.type = 30; 3115 3116 dumprocname.proc_num = param; 3117 seqvarptr = dpnptr; 3118 seqvarleng = dumprocname.size; 3119 3120 call seqput; 3121 3122 param = 0; 3123 3124 end DEF; /* the parameters are usually tag names or procedure names 3125* if paramerer 1 = 0 return to caller 3126* if paramerer w 2 0 move paramerer 1 to parameter 2 3127* and return to caller 3128* all othe cases output an equivalence operator with 3129* paramerer1 and parameter2 as opearands then return 3130* to caller */ 3131 3132 out_equiv: 3133 proc (param1, param2); 3134 3135 dcl param1 fixed bin; 3136 dcl param2 fixed bin; 3137 3138 /*[4.4-5]*/ 3139 if param1 = param2 3140 then return; 3141 3142 if param1 = 0 | param2 = 0 3143 then return; 3144 3145 opeos.e = param1; 3146 opeos.h = param2; 3147 opeos.type = 31; 3148 seqvarptr = opeosptr; 3149 seqvarleng = opeos.size; 3150 3151 call seqput; 3152 3153 opeos.type = 19; /* restore to eos type */ 3154 3155 end out_equiv; 3156 3157 /*output eos */ 3158 3159 action (3): 3160 call seqputeos; 3161 go to ret; 3162 3163 /* after in use verb */ 3164 /* reel or unit in close verb */ 3165 /* invalid present in delete statement */ 3166 /* repeated tallying phrase in INSPECT verb */ 3167 3168 action (4): 3169 end_stmt.b = "1"b; 3170 go to ret; 3171 3172 /* for INVALID clear eos, move 3 to verb type in eos*/ 3173 3174 action (5): 3175 end_stmt_bits = "0"b; 3176 end_stmt.verb = 3; 3177 go to ret; 3178 3179 action (6): /*NOT USED*/ 3180 go to ret; 3181 3182 /* filename is present in use verb and add 1 to filename counter */ 3183 3184 action (7): 3185 end_stmt.d = "00"b; 3186 end_stmt.e = end_stmt.e + 1; 3187 go to ret; 3188 3189 /* count params after using */ 3190 /* count procedure names for go to depending */ 3191 /* count operands after to in move statement */ 3192 /* count TALLYINGS in inspect statement */ 3193 /* count operands of display statement and set statement*?*/ 3194 3195 action (8): 3196 end_stmt.e = end_stmt.e + 1; 3197 go to ret; 3198 3199 /* descending bit for sort */ 3200 3201 action (9): 3202 end_stmt.b = "0"b; 3203 go to ret; /* set leading bit in eos for examine verb */ 3204 /* input is present in use verb */ 3205 /* REMOVAL is present in CLOSE verb */ 3206 /* RANDOM is present in SORT verb */ 3207 3208 action (10): 3209 go to IOM (op_mode); 3210 3211 IOM (1): 3212 end_stmt.d = "00"b; 3213 go to ret; /* input */ 3214 3215 IOM (2): 3216 end_stmt.d = "01"b; 3217 go to ret; /* output */ 3218 3219 IOM (3): 3220 end_stmt.d = "10"b; 3221 go to ret; /* i-o */ 3222 3223 IOM (4): 3224 end_stmt.d = "11"b; 3225 go to ret; /* extend */ 3226 3227 action (11): 3228 current_line = current_line + op_mode + 1; 3229 3230 go to new_inst; 3231 3232 action (12): 3233 current_line = current_line + file_org + 1; 3234 3235 go to new_inst; 3236 3237 /* format 2 and no standard in use verb */ 3238 3239 action (13): 3240 end_stmt.a = "001"b; 3241 end_stmt.c = "0"b; 3242 go to ret; 3243 3244 /* beginning in use verb */ 3245 /* LOCK is present in CLOSE verb */ 3246 3247 action (14): 3248 end_stmt.f = "01"b; 3249 go to ret; /* reel in use verb */ 3250 3251 action (15): 3252 end_stmt.g = "01"b; 3253 go to ret; /* file in use verb */ 3254 action (16): 3255 end_stmt.g = "10"b; 3256 go to ret; /* unit in use verb */ 3257 action (17): 3258 end_stmt.g = "11"b; 3259 go to ret; /* ending in use verb */ 3260 3261 action (18): 3262 end_stmt.f = "10"b; 3263 go to ret; 3264 3265 /* format 4 in use verb */ 3266 /* BCD-1400 is present in SORT verb */ 3267 3268 action (19): 3269 end_stmt.a = "011"b; 3270 go to ret; 3271 3272 /* standard in use verb */ 3273 /* repeated replacing phrase in INSPECT verb */ 3274 3275 action (20): /* from is present in write verb */ 3276 end_stmt.c = "1"b; 3277 go to ret; 3278 3279 /* using is present */ 3280 /* all iis present in search verb */ 3281 /* ASCII is present in SORT verb */ 3282 3283 action (21): 3284 end_stmt.a = "001"b; 3285 go to ret; 3286 3287 /* for INSPECT format 3 add rePLACINGS */ 3288 3289 action (22): 3290 end_stmt.a = "010"b; 3291 end_stmt.h = end_stmt.h + 1; 3292 if repcsbit 3293 then call DIAG (248); 3294 go to ret; 3295 3296 action (23): /* enter */ 3297 end_stmt.a = "000"b; 3298 end_stmt.e = 0; 3299 end_stmt.verb = 5; 3300 end_stmt.h = lang_num; 3301 go to action (3); 3302 3303 /* format 3 in use verb */ 3304 /* H-200 is present in SORT verb */ 3305 3306 action (24): 3307 end_stmt.a = "010"b; 3308 go to ret; 3309 3310 /* format 2 in use verb and standard present */ 3311 3312 action (25): 3313 end_stmt.a = "001"b; 3314 end_stmt.c = "1"b; 3315 go to ret; 3316 3317 /* format 5 in use verb */ 3318 /* JIS in SORT verb */ 3319 3320 action (26): 3321 end_stmt.a = "100"b; 3322 go to ret; 3323 3324 action (27): /*[4.0-1]*/ 3325 if reserved_word.key = 2 3326 then END_WORD = 1; /* add */ 3327 /*[4.0-1]*/ 3328 else if reserved_word.key = 11 3329 then END_WORD = 17; /* subtract */ 3330 /*[4.0-1]*/ 3331 else if reserved_word.key = 40 3332 then END_WORD = 3; /* compute */ 3333 /*[4.0-1]*/ 3334 else if reserved_word.key = 10 3335 then END_WORD = 8; /* multiply */ 3336 /*[4.0-1]*/ 3337 else if reserved_word.key = 9 3338 then END_WORD = 5; /* divide */ 3339 call NL; 3340 go to ret; 3341 3342 NL: 3343 proc; /*[5.3-2]*/ 3344 ST.option (nest_lev), ST.not_opt (nest_lev) = "0"b; 3345 call sav_lin_col; /*[5.3-2]*/ 3346 ST.end_wd (nest_lev) = END_WORD; 3347 3348 /*[4.0-1]*/ 3349 call act87; 3350 end; 3351 3352 action (28): 3353 call act28; 3354 go to ret; 3355 3356 act28: 3357 proc; 3358 substr (addr (saveitem) -> itemsize, 1, header.size) = substr (head_ptr -> itemsize, 1, header.size); 3359 end; 3360 3361 /* save item and add 1 to operand count after giving in divide verb */ 3362 3363 action (29): 3364 substr (addr (saveitem) -> itemsize, 1, header.size) = substr (head_ptr -> itemsize, 1, header.size); 3365 end_stmt.h = end_stmt.h + 1; 3366 go to ret; 3367 3368 /* set rounded bit in saved item */ 3369 3370 action (30): 3371 savitmptr -> data_name.rounded = "1"b; 3372 go to ret; 3373 3374 /* output saved item save current item 3375* add 1 to operand count after giving for divide verb */ 3376 3377 action (31): 3378 arg_1 = savitmptr; 3379 code_option = 31; 3380 if ^ST.skip_ind (nest_lev) 3381 then call cobol_pd_code$code; 3382 substr (addr (saveitem) -> itemsize, 1, header.size) = substr (head_ptr -> itemsize, 1, header.size); 3383 go to ret; 3384 3385 /* output saved item in compute verb */ 3386 3387 action (32): 3388 call act32; 3389 go to ret; 3390 3391 act32: 3392 proc; 3393 arg_1 = savitmptr; 3394 code_option = 32; 3395 if ^ST.skip_ind (nest_lev) 3396 then call cobol_pd_code$code; 3397 end; 3398 3399 /* compute the composite */ 3400 3401 action (33): 3402 if header.type = 1 /* fig con */ 3403 then ; 3404 else if header.type = 2 /* num lit */ 3405 then do; 3406 3407 if numeric_lit.places_left > end_stmt.i 3408 then end_stmt.i = numeric_lit.places_left; 3409 if numeric_lit.places_right > end_stmt.j 3410 then end_stmt.j = numeric_lit.places_right; 3411 3412 end; 3413 else do; 3414 3415 if data_name.places_left > end_stmt.i 3416 then end_stmt.i = data_name.places_left; 3417 if data_name.places_right > end_stmt.j 3418 then end_stmt.j = data_name.places_right; 3419 end; 3420 3421 end_stmt.e = end_stmt.e + 1; 3422 3423 go to ret; 3424 3425 /* compute the composite count arguments and save item */ 3426 3427 action (34): 3428 end_stmt.h = end_stmt.h + 1; 3429 cssavebit = data_name.constant_section; 3430 3431 /*[4.1-7]*/ 3432 prev_diag.line_num = header.line; /*[4.1-7]*/ 3433 prev_diag.column_num = header.column; 3434 3435 call act28; 3436 go to ret; 3437 3438 /* set rounded bit in saved item for add verb */ 3439 action (35): 3440 savitmptr -> data_name.rounded = "1"b; 3441 go to ret; /* add 1 to operand count 3442* output saved item 3443* save current item for add verb*/ 3444 3445 action (36): 3446 arg_1 = savitmptr; 3447 code_option = 17; 3448 if ^ST.skip_ind (nest_lev) 3449 then call cobol_pd_code$code; 3450 substr (sav_ptr -> itemsize, 1, header.size) = substr (addr_record -> itemsize, 1, header.size); 3451 go to ret; 3452 3453 /* program in exit verb or on size error in compute verb output eos */ 3454 /* or at end in search verb */ 3455 3456 action (37): 3457 call act37; 3458 go to ret; 3459 3460 act37: 3461 proc; 3462 end_stmt.b = "1"b; 3463 call seqputeos; 3464 end; 3465 3466 action (38): /* type 8 to type 3 */ 3467 if alphanum_lit.type = 8 3468 then do; 3469 alphanum_lit.type = 3; 3470 alphanum_lit.lit_type = "0"b; 3471 alphanum_lit.all_lit = "0"b; 3472 end; 3473 else alphanum_lit.type = 8; 3474 3475 go to ret; 3476 3477 /* output eos */ 3478 3479 action (39): 3480 call seqputeos; 3481 go to ret; 3482 3483 action (40): /* merge statement */ 3484 call PERF (44); 3485 call act145; 3486 go to ret; 3487 3488 action (41): /* sort statement */ 3489 end_stmt.d = "01"b; 3490 file_count, key_count = 0; 3491 call act28; 3492 go to ret; 3493 3494 action (42): /*[4.0-1]*/ 3495 if reserved_word.key = 47 3496 then END_WORD = 7; /*if */ 3497 /*[4.0-1]*/ 3498 else if reserved_word.key = 5 3499 then END_WORD = 2; /* call */ 3500 /*[4.0-1]*/ 3501 else if reserved_word.key = 34 3502 then END_WORD = 16; /* string */ 3503 /*[4.0-1]*/ 3504 else if reserved_word.key = 37 3505 then END_WORD = 18; /* unstring */ 3506 /*[4.0-1]*/ 3507 else if reserved_word.key = 25 3508 then END_WORD = 12; /* return */ 3509 3510 /*[4.0-1]*/ 3511 call NL; 3512 go to ret; 3513 3514 /* lock present in close verb and output eos */ 3515 action (43): 3516 end_stmt.f = "01"b; 3517 call seqputeos; 3518 go to ret; 3519 3520 action (44): /*[4.0-1]*/ 3521 if reserved_word.key = 21 3522 then END_WORD = 10; /* read */ 3523 /*[4.0-1]*/ 3524 else if reserved_word.key = 38 3525 then END_WORD = 19; /* write */ 3526 /*[4.0-1]*/ 3527 else if reserved_word.key = 27 3528 then END_WORD = 13; /* rewrite */ 3529 /*[4.0-1]*/ 3530 else if reserved_word.key = 56 3531 then END_WORD = 15; /* start */ 3532 /*[4.0-1]*/ 3533 else if reserved_word.key = 22 3534 then END_WORD = 4; /* delete */ 3535 3536 /*[4.0-1]*/ 3537 call NL; 3538 go to ret; 3539 3540 3541 /* count operands to be computed for compute verb */ 3542 /* save item add 1 to operand count in format 1 of multiply verb */ 3543 3544 3545 action (45): 3546 substr (sav_ptr -> itemsize, 1, header.size) = substr (addr_record -> itemsize, 1, header.size); 3547 end_stmt.e = end_stmt.e + 1; 3548 cssavebit = data_name.constant_section; 3549 3550 /*[4.1-7]*/ 3551 prev_diag.line_num = header.line; /*[4.1-7]*/ 3552 prev_diag.column_num = header.column; 3553 go to ret; /* output saved item 3554* save current item 3555* add 1 to operand count in format 1 of multiply verb */ 3556 action (46): 3557 arg_1 = savitmptr; 3558 code_option = 33; 3559 if ^ST.skip_ind (nest_lev) 3560 then call cobol_pd_code$code; 3561 3562 substr (sav_ptr -> itemsize, 1, header.size) = substr (addr_record -> itemsize, 1, header.size); 3563 go to ret; 3564 3565 /* count REPLACINGS for insPECT verb */ 3566 /* set format 2 */ 3567 3568 action (47): 3569 end_stmt.a = "001"b; 3570 end_stmt.h = end_stmt.h + 1; 3571 if repcsbit 3572 then call DIAG (248); 3573 go to ret; 3574 3575 /* set a to format 4 or format 5 for divide verb 3576* and ioutput saved item */ 3577 action (48): 3578 arg_1 = savitmptr; 3579 code_option = 34; 3580 if ^ST.skip_ind (nest_lev) 3581 then call cobol_pd_code$code; 3582 go to ret; 3583 3584 /* output a generated procedure name reference and then an eos */ 3585 3586 action (49): 3587 call act49; 3588 go to ret; 3589 3590 act49: 3591 proc; 3592 arg_1 = dpnptr; 3593 code_option = 35; 3594 if ^ST.skip_ind (nest_lev) 3595 then call cobol_pd_code$code; 3596 end; 3597 3598 action (50): /*[4.0-4]*/ 3599 if reserved_word.key = 20 /* perform */ 3600 /*[4.0-4]*/ 3601 then do; 3602 END_WORD = 9; /*[4.0-4]*/ 3603 end_stmt.d, end_stmt.f = "00"b; /*[4.0-4]*/ 3604 end; /*[4.0-1]*/ 3605 else if reserved_word.key = 26 3606 then END_WORD = 14; /* search */ 3607 /*[4.0-1]*/ 3608 else if reserved_word.key = 23 3609 then END_WORD = 11; /* receive */ 3610 /*[4.0-1]*/ 3611 else if reserved_word.key = 500 3612 then END_WORD = 6; /* evaluate */ 3613 3614 /*[4.0-1]*/ 3615 call NL; 3616 go to ret; 3617 3618 save_skip_ind: 3619 proc; /*[5.3-2]*/ 3620 ST.save_skip_ind (nest_lev) = ST.skip_ind (nest_lev); 3621 /*[5.3-2]*/ 3622 ST.skip_ind (nest_lev) = "1"b; 3623 end; 3624 3625 action (52): /*[5.3-2]*/ 3626 ST.skip_ind (nest_lev) = ST.save_skip_ind (nest_lev); 3627 go to ret; 3628 3629 action (53): /*NOT USED*/ 3630 go to ret; 3631 3632 /* puts missing period diagnostic on correct line */ 3633 3634 action (54): /*[4.1-7]*/ 3635 call DIAG_PREV_TOKEN (7); 3636 go to ret; 3637 3638 action (55): 3639 action (56): 3640 action (57): 3641 action (58): 3642 action (59): 3643 action (60): 3644 action (61): /*NOT USED*/ 3645 go to ret; 3646 3647 /* set a to format 1 and output saved item */ 3648 3649 action (62): 3650 arg_1 = savitmptr; 3651 code_option = 36; 3652 if ^ST.skip_ind (nest_lev) 3653 then call cobol_pd_code$code; 3654 go to ret; 3655 3656 /* format 4 in perform verb */ 3657 3658 action (63): 3659 end_stmt.a = "011"b; 3660 go to ret; 3661 3662 /* day in accept verb */ 3663 3664 action (64): 3665 end_stmt.e = end_stmt.e + 1; 3666 go to ret; 3667 3668 action (65): /*NOT USED*/ 3669 go to ret; 3670 3671 /* output a generated then */ 3672 3673 action (66): 3674 code_option = 15; 3675 if ^ST.skip_ind (nest_lev) 3676 then call cobol_pd_code$code; 3677 go to ret; 3678 3679 /* esi in send verb */ 3680 action (67): 3681 end_stmt.d = "01"b; 3682 go to ret; /* emi in send verb */ 3683 action (68): 3684 end_stmt.d = "10"b; 3685 go to ret; /* eti in send verb */ 3686 action (69): 3687 end_stmt.d = "11"b; 3688 go to ret; 3689 3690 action (70): /*NOT USED*/ 3691 go to ret; 3692 3693 /* format 2 and before in send verb */ 3694 3695 action (71): 3696 end_stmt.a = "001"b; 3697 end_stmt.f = "01"b; 3698 go to ret; 3699 3700 /* format 2 and after in send verb */ 3701 3702 action (72): 3703 end_stmt.a = "001"b; 3704 end_stmt.f = "10"b; 3705 go to ret; 3706 3707 /* set ascending ascending bit in item 3708* add 1 to data item count for sort verb */ 3709 /* compute offset from beginning of record and put it in operand */ 3710 3711 action (74): 3712 key_count = key_count + 1; 3713 data_name.ad_bit = end_stmt.b; 3714 data_name.linkage_section = "1"b; /* set for generator */ 3715 data_name.compare_argument = "1"b; /* set for generator */ 3716 linkage = 1; /* argument no set for generator */ 3717 end_stmt.e = end_stmt.e + 1; /* count operands */ 3718 3719 if data_name.seg_num = 0 3720 then go to ret; /* locate mode all done */ 3721 3722 file_number = data_name.file_num; 3723 call cobol_read_ft_ (file_number, ft_ptr); 3724 3725 /* above gets pointer to filetable */ 3726 data_name.offset = data_name.offset - cra_offset; 3727 go to ret; 3728 3729 /* format 2 and output saved item in subtract verb */ 3730 3731 action (75): 3732 end_stmt.a = "001"b; 3733 call act32; 3734 go to ret; 3735 3736 action (76): 3737 action (77): /*NOT USED*/ 3738 go to ret; 3739 3740 /* count REPLACINGS in INSPECT verb */ 3741 /* count of operands after into for unstring verb */ 3742 /* count of file names after USING in SORT verb */ 3743 3744 action (78): 3745 end_stmt.h = end_stmt.h + 1; 3746 go to ret; 3747 3748 action (79): 3749 action (80): 3750 action (81): 3751 action (82): 3752 action (83): /*NOT USED*/ 3753 go to ret; 3754 3755 /* set diagno to 1 */ 3756 action (84): 3757 diagno = 1; 3758 go to ret; 3759 3760 action (85): /*[5.3-2]*/ 3761 ST.cond (nest_lev) = "1"b; 3762 go to ret; 3763 3764 /* reset and clear diagnostic switch */ 3765 3766 action (86): 3767 diagno = 0; 3768 go to ret; /* clear eos, moven token to eos */ 3769 3770 action (87): 3771 call act87; 3772 go to ret; 3773 3774 act87: 3775 proc; 3776 end_stmt_bits = "0"b; 3777 end_stmt.verb = reserved_word.key; 3778 end; 3779 3780 /* program has declaratives section */ 3781 /* set switch to indicate we are processing inside declarative section */ 3782 3783 action (88): 3784 decswitch = 1; 3785 go to ret; 3786 3787 /* program contains sections */ 3788 3789 action (89): 3790 secswitch = 1; 3791 go to ret; 3792 3793 /* save eos for write and compute and error verb */ 3794 3795 action (90): 3796 saveos = end_stmt_chars; 3797 go to ret; 3798 3799 action (91): /*[5.3-2]*/ 3800 call inc_nest_lev; 3801 go to ret; 3802 3803 action (92): /*NOT USED*/ 3804 go to ret; 3805 3806 action (93): /*[5.3-2]*/ 3807 call dec_nest_lev; 3808 go to ret; 3809 3810 /* turn on debug switch because use for debugging is present */ 3811 3812 action (94): 3813 debugsw = 1; 3814 go to ret; 3815 3816 /* set all bit in data name for use verb */ 3817 3818 action (95): 3819 data_name.debug_all = "1"b; 3820 go to ret; 3821 3822 /* the end declaratives has been reached */ 3823 3824 action (96): 3825 decswitch = 2; 3826 go to ret; 3827 3828 /*[4.4-5]*/ 3829 declare first bit (1); 3830 3831 action (97): /*NOT USED*/ 3832 go to ret; 3833 3834 pop_perf: 3835 proc; 3836 3837 /*[5.3-2]*/ 3838 if ST.e (nest_lev) ^= 0 3839 then call emit_eos_perf; 3840 3841 end; 3842 3843 pop_if: 3844 proc; 3845 3846 /*[5.3-2]*/ 3847 if ST.option (nest_lev) /*[5.3-2]*/ 3848 then call DEF (ST.h (nest_lev)); /*[5.3-2]*/ 3849 else if cssub ^= 0 /*[5.3-2]*/ 3850 then call DEF (cstack.false (cssub)); /*[5.3-2]*/ 3851 else ; 3852 3853 end; 3854 3855 pop_other: 3856 proc; 3857 3858 /*[5.3-2]*/ 3859 end_stmt.a = "0"b; 3860 3861 /*[5.3-2]*/ 3862 if ST.option (nest_lev) 3863 then call emit_eos; 3864 3865 end; 3866 3867 pop_state: 3868 proc; 3869 3870 /*[5.3-2]*/ 3871 END_WORD = ST.end_wd (nest_lev); 3872 3873 /*[5.3-2]*/ 3874 if END_WORD = 7 /*[5.3-2]*/ 3875 then call pop_if; /*[5.3-2]*/ 3876 else if END_WORD = 9 /*[5.3-2]*/ 3877 then call pop_perf; /*[5.3-2]*/ 3878 else call pop_other; 3879 3880 end; 3881 3882 emit_eos: 3883 proc; 3884 3885 /*[4.0-4]*/ 3886 end_stmt.verb = 3; /*[4.0-4]*/ 3887 end_stmt.b = "0"b; /*[4.0-4]*/ 3888 end_stmt.e, end_stmt.h, end_stmt.i = 0; /*[4.0-4]*/ 3889 call seqputeos; 3890 3891 end; 3892 3893 /* for accept set device to default or console and output eos */ 3894 3895 action (98): 3896 end_stmt.e = 9; 3897 call seqputeos; 3898 go to ret; 3899 3900 /* device 2 or card-reader in accept verband output eos */ 3901 3902 action (99): 3903 end_stmt.e = 10; 3904 call seqputeos; 3905 go to ret; 3906 3907 /* device 3 in accept verb and output eos */ 3908 3909 action (100): 3910 end_stmt.e = 11; 3911 call seqputeos; 3912 go to ret; 3913 3914 /* time in accept verb */ 3915 3916 action (101): 3917 end_stmt.e = 2; 3918 go to ret; /* output saved item and output eos */ 3919 3920 action (102): 3921 arg_1 = savitmptr; 3922 code_option = 37; 3923 if ^ST.skip_ind (nest_lev) 3924 then call cobol_pd_code$code; 3925 go to ret; 3926 3927 /* size error follows --output saved item--output eos for add verb */ 3928 3929 action (103): 3930 arg_1 = savitmptr; 3931 code_option = 38; 3932 if ^ST.skip_ind (nest_lev) 3933 then call cobol_pd_code$code; 3934 go to ret; 3935 3936 /* output a generaTED ALTER FOR ALTER VERB */ 3937 3938 action (104): 3939 code_option = 5; 3940 if ^ST.skip_ind (nest_lev) 3941 then call cobol_pd_code$code; 3942 go to ret; /* output a generated cancel and an eos for cancel verb */ 3943 action (105): 3944 code_option = 6; 3945 if ^ST.skip_ind (nest_lev) 3946 then call cobol_pd_code$code; 3947 go to ret; 3948 3949 /*set chain bit for close verb 3950* put out eos */ 3951 /* output a generated close for the close verb */ 3952 3953 action (106): 3954 code_option = 8; 3955 if ^ST.skip_ind (nest_lev) 3956 then call cobol_pd_code$code; 3957 go to ret; 3958 3959 action (107): /*NOT USED*/ 3960 go to ret; 3961 3962 /* restore eos for compute verb */ 3963 3964 action (108): 3965 end_stmt_chars = saveos; 3966 go to ret; 3967 3968 /* device no 2 or printer for display verb and output eos*/ 3969 3970 action (109): 3971 call act109; 3972 go to ret; 3973 3974 act109: 3975 proc; 3976 end_stmt.a = "001"b; 3977 call seqputeos; 3978 end; 3979 3980 action (110): /*[5.3-2]*/ 3981 ST.option (nest_lev) = "1"b; /*[5.3-2]*/ 3982 EW = ST.end_wd (nest_lev); 3983 3984 /*[5.3-2]*/ 3985 if EW = 10 /* read */ 3986 /*[5.3-2]*/ 3987 then end_stmt.a = "010"b; /*[5.3-2]*/ 3988 else end_stmt.b = "1"b; 3989 3990 /*[5.3-2]*/ 3991 call seqputeos; /*[5.3-2]*/ 3992 end_stmt_bits = "0"b; /*[5.3-2]*/ 3993 end_stmt.verb = 3; 3994 go to ret; 3995 3996 /* output a generated initiate for initiate verb */ 3997 3998 action (111): /*[4.4-5]*/ 3999 call cobol_swf_put (cobol_pdofp, st, rw_perform_ptr, rw_perform_size); 4000 4001 go to ret; 4002 4003 action (112): /*[5.3-2]*/ 4004 if reserved_word.type = 1 /*[5.3-2]*/ 4005 then if reserved_word.key < 70 /*[5.3-2]*/ 4006 then current_line = reserved_word.key; /*[5.3-2]*/ 4007 else current_line = 29; /* evaluate */ 4008 /*[5.3-2]*/ 4009 else current_line = 57; /* suppress */ 4010 4011 go to new_inst; 4012 4013 /* save item inside saveident */ 4014 /* save offset for occurs extension */ 4015 /* compute address of occurs extension */ 4016 /* clear the subscript type bits */ 4017 4018 action (113): 4019 call act113; 4020 go to ret; 4021 4022 act113: 4023 proc; 4024 substr (addr (saveident) -> itemsize, 1, header.size) = substr (head_ptr -> itemsize, 1, header.size); 4025 savoccptr = data_name.occurs_ptr; 4026 occptr = addr (savidptr -> exten (savoccptr)); 4027 data_name_bit, index_name_bit = "0"b; /*[4.4-6]*/ 4028 call set_op_loc; 4029 end; 4030 4031 /* set bit to indicate this literal is a subscript */ 4032 4033 action (114): 4034 numeric_lit.subscript = "1"b; 4035 go to ret; 4036 4037 action (115): 4038 action (116): 4039 action (117): /*NOT USED*/ 4040 go to ret; 4041 4042 4043 /* restore item from saveident to its window position */ 4044 4045 4046 action (118): 4047 substr (addr_record -> savidsize, 1, saveident.size) = 4048 substr (addr (saveident) -> savidsize, 1, saveident.size); 4049 4050 /*[4.0-3]*/ 4051 if err ^= 0 4052 then call diag (err); 4053 4054 call test_subs; 4055 4056 if res 4057 then call diag (269); 4058 4059 go to ret; 4060 4061 test_subs: 4062 proc; 4063 4064 declare (i, val) fixed bin; 4065 4066 occptr = addr (addr_record -> exten (data_name.occurs_ptr)); 4067 4068 do i = 1 by 1 to occurs.dimensions; 4069 4070 val = subs (i); 4071 4072 if val = 0 | /*[4.2-2]*/ (val > 0 & val > occurs.level.max (i)) 4073 then do; 4074 res = "1"b; 4075 return; 4076 end; 4077 end; 4078 4079 res = "0"b; 4080 end; 4081 4082 /* output eos-- output a generated open-clear eos-set eos to type open for open verb */ 4083 /* set chain bit for OPEN verb */ 4084 4085 action (119): 4086 call act119; 4087 go to ret; 4088 act119: 4089 proc; 4090 go to OM (op_mode); 4091 OM (1): 4092 code_option = 9; 4093 go to OM1; /* input */ 4094 4095 OM (2): 4096 code_option = 10; 4097 go to OM1; /* output */ 4098 4099 OM (3): 4100 code_option = 11; 4101 go to OM1; /* io */ 4102 4103 OM (4): 4104 code_option = 12; 4105 go to OM1; /* extend */ 4106 4107 OM1: 4108 if ^ST.skip_ind (nest_lev) 4109 then call cobol_pd_code$code; 4110 4111 end; 4112 4113 action (120): 4114 end_stmt.d = "10"b; 4115 go to ret; 4116 4117 action (121): 4118 end_stmt.d = "01"b; 4119 go to ret; 4120 4121 action (122): 4122 end_stmt.d = "11"b; 4123 go to ret; 4124 4125 /* output eos -- output a generated suspend --clear eos */ 4126 /* set eos to suspend type for suspend verb */ 4127 4128 4129 action (123): 4130 code_option = 13; 4131 if ^ST.skip_ind (nest_lev) 4132 then call cobol_pd_code$code; 4133 go to ret; 4134 4135 /* output a generate terminate for terminate veb */ 4136 4137 action (124): /*[4.4-5]*/ 4138 call cobol_swf_put (cobol_pdofp, st, eos_perform_ptr, eos_perform_size); 4139 go to ret; 4140 4141 /* reset subscript counter to zero */ 4142 4143 action (125): 4144 subcnt = 0; 4145 subs (1), subs (2), subs (3) = -1; 4146 go to ret; 4147 4148 /* add 1 to subscript counter */ 4149 4150 action (126): 4151 subcnt = subcnt + 1; 4152 go to ret; 4153 4154 /* clear eos set eos to procedure */ 4155 4156 action (127): 4157 end_stmt_bits = "0"b; 4158 4159 end_stmt.verb = 52; 4160 go to ret; 4161 4162 /* clear eos set type to section header and build entry for perform alter range table for use */ 4163 4164 action (128): /*[4.4-2]*/ 4165 if ^LTP 4166 then call DIAG_PREV_TOKEN (279); 4167 4168 if decswitch ^= 0 4169 then do; 4170 perfcode = 0; 4171 perfprocnum = proc_def.proc_num; 4172 perfprio = fixed (unspec (proc_def.priority)); 4173 end; 4174 4175 shprio = fixed (unspec (proc_def.priority)); 4176 4177 end_stmt_bits = "0"b; 4178 4179 end_stmt.verb = 54; 4180 cursecnum = proc_def.section_num; /* save the current section number */ 4181 addr (stat.procdef) -> bit9 = addr (proc_def.sort_range) -> bit9; 4182 go to ret; 4183 4184 /* clear eos set type to paragraph header */ 4185 4186 action (129): /*[4.4-2]*/ 4187 if ^LTP 4188 then call DIAG_PREV_TOKEN (279); 4189 4190 end_stmt_bits = "0"b; 4191 4192 end_stmt.verb = 55; 4193 go to ret; 4194 4195 /* reset subroutine stack pointer to zero and also nested if counter */ 4196 /* reset imp switch to show we are no longer looking for an imperative verb */ 4197 /* reset conditional stack pointer to zero */ 4198 /* reset eos verb type to 0 */ 4199 4200 action (130): 4201 nest_lev = 1; 4202 i1, cssub, end_stmt.verb = 0; /*[5.3-2]*/ 4203 call reset_st; 4204 4205 go to ret; 4206 4207 /* set bit to indicate this data name is a subscript */ 4208 4209 action (131): 4210 data_name.used_as_sub = "1"b; 4211 go to ret; 4212 4213 /* set bit to indicate this index is a subscript */ 4214 4215 action (132): 4216 index_name.subscript = "1"b; 4217 go to ret; 4218 4219 /* clear eos set eos to declaratives */ 4220 4221 action (133): 4222 end_stmt_bits = "0"b; /*[5.2-1]*/ 4223 end_decl_bit = "0"b; 4224 end_stmt.verb = 53; 4225 go to ret; 4226 4227 /* add 1 to nested if statement counter */ 4228 4229 action (134): /*NOT USED*/ 4230 go to ret; 4231 4232 /* index name is predent as a subscript */ 4233 4234 action (135): 4235 index_name_bit = "1"b; 4236 go to ret; 4237 4238 /* data name is present as a subscript */ 4239 4240 action (136): 4241 data_name_bit = "1"b; 4242 data_name.used_as_sub = "1"b; 4243 go to ret; 4244 4245 /* overlap between sending and receiving item */ 4246 4247 4248 action (137): 4249 data_name.overlap = "1"b; 4250 go to ret; 4251 4252 /* end of job when end cobol is encountered */ 4253 4254 action (138): 4255 endjob: 4256 go to endint; 4257 4258 /* set bit to show we are processing a search verb */ 4259 4260 action (139): /*[4.4-5]*/ 4261 ST.option (nest_lev) = "1"b; 4262 go to ret; 4263 4264 /* output a then eos */ 4265 4266 action (140): 4267 end_stmt.verb = 64; 4268 call seqputeos; 4269 go to ret; 4270 4271 /* output a search eos 4272* show we are no longer processing a search verb 4273* show we are not looking for a imperative verb */ 4274 4275 action (141): 4276 srchfm2bit = "0"b; /* no longer in format 2 */ 4277 end_stmt.verb = 26; 4278 call seqputeos; 4279 go to ret; 4280 4281 /* set bit to indicate we are processing format 2 of the search verb */ 4282 action (142): 4283 srchfm2bit = "1"b; 4284 UB_ind = "0"b; /*[3.0-9]*/ 4285 go to ret; 4286 4287 /* build an entry for the perform alter range table */ 4288 4289 action (143): 4290 perfcode = 0; /* end of perform range */ 4291 call act143; 4292 go to ret; 4293 4294 act143: 4295 proc; 4296 4297 perfprocnum = proc_def.proc_num; 4298 perfprio = fixed (unspec (proc_def.priority), 16); 4299 call act145; 4300 end; 4301 4302 /* build an entry for the perform alter range table */ 4303 4304 action (144): 4305 perfprocnum = savitmptr -> proc_def.proc_num; 4306 perfcode = 0; 4307 perfprio = fixed (unspec (savitmptr -> proc_def.priority), 16); 4308 call act145; 4309 go to ret; 4310 4311 /* write the perform entry and update the old entry **/ 4312 4313 action (145): 4314 call act145; 4315 go to ret; 4316 4317 act145: 4318 proc; 4319 perform_range_key = perf_alter_info; 4320 4321 do while (perform_range_key ^= "00000"); 4322 varrecaddr = perform_range_key; 4323 call vardget; 4324 jkpfm_ptr = seqvarptr; 4325 4326 if (perfprocnum = jkperfprocnum) & (perfcode = jkperfcode) 4327 then go to ret; 4328 if jkperflink = "00000" 4329 then do; 4330 call act145b; 4331 return; 4332 end; 4333 perform_range_key = jkperflink; 4334 end; 4335 call act145b; 4336 end; 4337 4338 act145b: 4339 proc; 4340 4341 call cobol_vdwf_sput (cobol_cmfp, st, addr (perfrange), fb26, common_key); 4342 4343 if substr (st, 17, 16) ^= "0"b 4344 then go to write_error; 4345 4346 if perf_alter_info = "00000" 4347 then do; 4348 perf_alter_info = common_key; 4349 addr (saveperfrange) -> c26 = addr (perfrange) -> c26; 4350 savlaskey = common_key; 4351 end; 4352 else do; 4353 sperlin = common_key; 4354 varrecaddr = savlaskey; 4355 call vardget; 4356 junk_ptr = seqvarptr; 4357 seqvarptr = addr (saveperfrange); 4358 seqvarleng = fb26; 4359 varrecaddr = savlaskey; 4360 call vardput; 4361 addr (saveperfrange) -> c26 = addr (perfrange) -> c26; 4362 savlaskey = common_key; 4363 end; 4364 end; 4365 4366 /* set argument no for sort and merge verb for generatotr */ 4367 4368 action (146): 4369 linkage = 2; /* argument no */ 4370 go to ret; 4371 4372 /* build entry for perform alter table */ 4373 4374 action (147): 4375 declprocbit = proc_def.declarative_proc; 4376 perfcode = 1; /* alter procedure name */ 4377 4378 call act143; /* continue building */ 4379 go to ret; 4380 4381 action (148): /* output a go 4382* output a proc name 4383* output a proc name */ 4384 gotodep = "0"b; /* clear the switch */ 4385 4386 arg_1 = addr (store_label_1); 4387 arg_2 = addr (store_label_2); 4388 4389 code_option = 16; 4390 if ^ST.skip_ind (nest_lev) 4391 then call cobol_pd_code$code; 4392 go to ret; 4393 4394 /* set all bit in literal */ 4395 4396 action (149): 4397 alphanum_lit.all_lit = "1"b; 4398 go to ret; 4399 4400 /* set numeric condition bit in common area */ 4401 4402 action (150): /*[4.4-12]*/ 4403 num_cond = "1"b; 4404 is_not_rel = "1"b; 4405 SUBJ_REQ = "1"b; /*[5.3-1]*/ 4406 if cssub > 0 4407 then cstack.c.logical (cssub - 1) = "1"b; 4408 go to ret; 4409 4410 /* set alphabetic bit in common area */ 4411 4412 action (151): /*[4.4-12]*/ 4413 alpha_cond = "1"b; 4414 is_not_rel = "1"b; 4415 SUBJ_REQ = "1"b; /*[5.3-1]*/ 4416 if cssub > 0 4417 then cstack.c.logical (cssub - 1) = "1"b; 4418 go to ret; 4419 4420 /* set delete bit in file table */ 4421 4422 action (152): 4423 delete = "1"b; 4424 go to ret; 4425 4426 /* if we are processing a format 1 use statement put the error rroutine address 4427* in the associated file table - table already in core from check (172) */ 4428 4429 action (153): 4430 error_exit = cursecnum; 4431 seqvarptr = ft_ptr; 4432 seqvarleng = common_recsize; 4433 file_number = fd_token.file_no; 4434 call cobol_read_ft_ (file_number, ft_ptr); 4435 ft_ptr = seqvarptr; 4436 go to ret; 4437 4438 /* reset a bit to indicate that the EXIT verb 4439* was not preceded by a procedure definition */ 4440 4441 4442 action (154): 4443 preospn_bit = "0"b; 4444 go to ret; 4445 4446 /* set a bit to indicate that the EXIT verb 4447* was preceeded by a procedure definition */ 4448 4449 action (155): 4450 preospn_bit = "1"b; 4451 go to ret; 4452 4453 /* get collating sequence from common 4454* and put it into EOS for sort verb*/ 4455 4456 action (156): 4457 end_stmt.i = prog_coll_seq; 4458 end_stmt.d = "00"b; 4459 go to ret; 4460 4461 /* save the FILE after GIVING or USING in SORT statement */ 4462 4463 action (157): 4464 substr (addr (sv_usfil) -> itemsize, 1, header.size) = substr (addr_record -> itemsize, 1, header.size); 4465 go to ret; 4466 4467 /* output a OPEN, FILENAM, EOS, PROCDEF, RETURN, FILENAM, */ 4468 /* RECORDNAM, EOS, GOTOPROC, EOSATEND, WRITE, RECORDNAM, EOS, */ 4469 /* GOTOPROC, PROCDEF, CLOSE, FILENAM, EOS, EOS90 */ 4470 4471 action (158): 4472 spec_tag_counter = spec_tag_counter + 2; 4473 save_gentag = spec_tag_counter - 1; 4474 4475 arg_1 = addr (sv_usfil); 4476 arg_2 = addr (spec_tag_counter); 4477 arg_3 = savitmptr; 4478 arg_4 = addr_record; 4479 4480 code_option = 1; 4481 if ^ST.skip_ind (nest_lev) 4482 then call cobol_pd_code$code; 4483 go to ret; 4484 4485 /* output a OPEN, FILENAM, EOS, PROCDEF, READ, FILENAM, */ 4486 /* EOS, GOTOPROC, EOSATEND, RELEASE, SORTREC, FILEREC, */ 4487 /* EOS, GOTOPROC, PROCDEF, CLOSE, FILENAM, EOS, */ 4488 4489 action (159): 4490 spec_tag_counter = spec_tag_counter + 2; 4491 save_gentag = spec_tag_counter - 1; 4492 4493 arg_1 = addr (sv_usfil); 4494 arg_2 = addr (spec_tag_counter); 4495 arg_3 = addr (sv_srtfil_rec); 4496 arg_4 = addr_record; 4497 4498 code_option = 2; 4499 if ^ST.skip_ind (nest_lev) 4500 then call cobol_pd_code$code; 4501 go to ret; 4502 4503 /* set e to proper INPUT DEVICE */ 4504 4505 action (160): 4506 if mnemonic_name.iw_key = 3 4507 then end_stmt.e = 9; /*[3.0-4]*/ 4508 else end_stmt.e = 10; 4509 go to ret; 4510 4511 /* set DAYOFWEEK for ACCEPT */ 4512 4513 action (161): 4514 end_stmt.e = 3; 4515 go to ret; 4516 4517 /* output an EOS91 for the SORT statement */ 4518 4519 action (162): 4520 code_option = 18; 4521 if ^ST.skip_ind (nest_lev) 4522 then call cobol_pd_code$code; 4523 go to ret; 4524 4525 4526 /* set a to proper OUTPUT DEVICRE */ 4527 4528 action (163): 4529 if mnemonic_name.iw_key = 3 4530 then end_stmt.a = "000"b; /*[3.0-4]*/ 4531 else end_stmt.a = "001"b; 4532 go to ret; 4533 4534 /* do out_operator with param =1*/ 4535 /* output EOS3 ffor SEARCH */ 4536 /* declare all true and false labels */ 4537 4538 action (164): 4539 call TEST (act_log.false, "1001"b); 4540 4541 code_option = 19; 4542 if ^ST.skip_ind (nest_lev) 4543 then call cobol_pd_code$code; 4544 4545 UB_ind = "0"b; /*[3.0-9]*/ 4546 call act200; 4547 go to ret; 4548 4549 /* save procedure definition in SORT statement */ 4550 4551 action (165): 4552 substr (addr (sv_proc_def) -> itemsize, 1, header.size) = substr (addr_record -> itemsize, 1, header.size); 4553 perfcode = 2; 4554 perfprocnum = proc_def.proc_num; 4555 perfprio = fixed (unspec (proc_def.priority), 16); 4556 go to ret; 4557 4558 /* output a PERFORM, sec-nm, sec-nm2, performeos, EOS91 */ 4559 4560 action (166): 4561 call PERF (3); 4562 call act145; 4563 go to ret; 4564 4565 /* output a PERFORM, PROCNAMR, procname, PERFORMeos, EOS91 */ 4566 4567 action (167): 4568 arg_1 = addr (sv_proc_def); 4569 4570 code_option = 4; 4571 if ^ST.skip_ind (nest_lev) 4572 then call cobol_pd_code$code; 4573 call act145; 4574 go to ret; 4575 4576 /* output a PERFORM, PROCNAM, PROCNAM, EOSperform, EOS90 */ 4577 4578 action (168): 4579 call PERF (39); 4580 call act145; 4581 go to ret; 4582 4583 PERF: 4584 proc (val); 4585 4586 declare val fixed bin; 4587 4588 arg_1 = addr (sv_proc_def); 4589 arg_2 = addr_record; 4590 4591 code_option = val; 4592 if ^ST.skip_ind (nest_lev) 4593 then call cobol_pd_code$code; 4594 4595 perfprocnum = proc_def.proc_num; 4596 perfprio = fixed (unspec (proc_def.priority), 16); 4597 perfcode = 2; 4598 4599 end; 4600 4601 /* output a PERFORM, PROCNAM, PROCNAM, PERFORMeos, EOS90 */ 4602 4603 action (169): 4604 arg_1 = addr (sv_proc_def); 4605 code_option = 40; 4606 if ^ST.skip_ind (nest_lev) 4607 then call cobol_pd_code$code; 4608 call act145; 4609 go to ret; 4610 4611 /* save the SORTFILE RECORD */ 4612 4613 action (170): 4614 substr (addr (sv_srtfil_rec) -> itemsize, 1, header.size) = substr (addr_record -> itemsize, 1, header.size); 4615 go to ret; 4616 4617 /*output EOS4 for SEARCH */ 4618 4619 action (171): 4620 code_option = 20; 4621 if ^ST.skip_ind (nest_lev) 4622 then call cobol_pd_code$code; 4623 call setabit; 4624 code_option = 24; 4625 if ^ST.skip_ind (nest_lev) 4626 then call cobol_pd_code$code; 4627 4628 /* output EOS4 for SEARCH verb */ 4629 4630 action (172): 4631 code_option = 21; 4632 if ^ST.skip_ind (nest_lev) 4633 then call cobol_pd_code$code; 4634 go to ret; 4635 4636 /* output EOS2 for SEARCH */ 4637 4638 action (173): 4639 call setabit; 4640 code_option = 22; 4641 if ^ST.skip_ind (nest_lev) 4642 then call cobol_pd_code$code; 4643 go to ret; 4644 4645 /* output final EOS2 for SEARCH */ 4646 4647 action (174): 4648 call act174; 4649 go to ret; 4650 4651 act174: 4652 proc; 4653 if ^srchfm2bit 4654 then end_stmt.a = "000"b; 4655 code_option = 23; 4656 if ^ST.skip_ind (nest_lev) 4657 then call cobol_pd_code$code; 4658 srchfm2bit = "0"b; 4659 end; 4660 4661 action (175): /*NOT USED*/ 4662 go to ret; 4663 4664 /* output EOS3 for SEARCH */ 4665 4666 action (176): 4667 code_option = 25; 4668 if ^ST.skip_ind (nest_lev) 4669 then call cobol_pd_code$code; 4670 call act174; 4671 go to ret; 4672 4673 /* output EOS3 for SEARCH */ 4674 4675 action (177): 4676 code_option = 26; 4677 if ^ST.skip_ind (nest_lev) 4678 then call cobol_pd_code$code; 4679 go to ret; 4680 4681 /* output final EOS2 for SEARCH */ 4682 4683 action (178): 4684 call setabit; 4685 code_option = 27; 4686 if ^ST.skip_ind (nest_lev) 4687 then call cobol_pd_code$code; 4688 srchfm2bit = "0"b; 4689 go to ret; 4690 4691 setabit: 4692 proc; 4693 4694 if srchfm2bit 4695 then end_stmt.a = "001"b; 4696 else end_stmt.a = "000"b; 4697 4698 end; 4699 4700 /* set HISTORY bits in file tables */ 4701 4702 action (179): 4703 call act179; 4704 go to ret; 4705 4706 act179: 4707 proc; 4708 if fd_token.file_no = 0 4709 then return; 4710 file_number = fd_token.file_no; 4711 call cobol_read_ft_ (file_number, ft_ptr); 4712 go to subact (histno); 4713 4714 subact (1): 4715 close = "1"b; 4716 return; 4717 4718 subact (2): 4719 open_ext = "1"b; 4720 return; 4721 4722 subact (3): 4723 open_in = "1"b; 4724 return; 4725 4726 subact (4): 4727 open_out = "1"b; 4728 return; 4729 4730 subact (5): 4731 open_io = "1"b; 4732 end; 4733 4734 /* set CLOSE history bit in file table */ 4735 4736 action (180): 4737 histno = 1; 4738 call act179; 4739 go to ret; 4740 4741 /* set OPEN_EX history bit in file table */ 4742 4743 action (181): 4744 histno = 2; 4745 call act179; 4746 go to ret; 4747 4748 /* set OPEN_IN history bit in file table */ 4749 4750 action (182): 4751 histno = 3; 4752 call act179; 4753 go to ret; 4754 4755 /* set OPEN OUT history bit in file table */ 4756 4757 action (183): 4758 histno = 4; 4759 call act179; 4760 go to ret; 4761 4762 /* set OPEN_IO history bit in file table */ 4763 4764 action (184): 4765 histno = 5; 4766 call act179; 4767 go to ret; 4768 4769 action (185): 4770 file_count = 0; 4771 4772 go to ret; 4773 4774 action (186): 4775 file_count = file_count + 1; 4776 go to ret; 4777 4778 action (187): 4779 arg_1 = addr_record; 4780 arg_2 = addr (sv_usfil); 4781 code_option = 42; 4782 if ^ST.skip_ind (nest_lev) 4783 then call cobol_pd_code$code; 4784 go to ret; 4785 4786 action (188): 4787 file_count, key_count = 0; 4788 call act28; 4789 go to ret; 4790 4791 action (189): 4792 arg_1 = addr (key_count); 4793 arg_2 = addr (file_count); 4794 code_option = 41; 4795 if ^ST.skip_ind (nest_lev) 4796 then call cobol_pd_code$code; 4797 go to ret; 4798 4799 action (190): 4800 arg_1 = addr (sv_proc_def); 4801 4802 code_option = 43; 4803 if ^ST.skip_ind (nest_lev) 4804 then call cobol_pd_code$code; 4805 call act145; 4806 go to ret; 4807 4808 action (191): 4809 substr (end_stmt.f, 1, 1) = stat.procdef.mrg_range; 4810 substr (end_stmt.f, 2, 1) = stat.procdef.srt_range; 4811 call act28; 4812 go to ret; 4813 4814 action (192): 4815 UB_ind = "1"b; 4816 go to ret; 4817 4818 action (193): 4819 UB_ind = "1"b; 4820 call seqputeos; 4821 go to ret; 4822 4823 action (194): 4824 UB_ind = "1"b; 4825 call act37; 4826 go to ret; 4827 4828 action (195): 4829 UB_ind = "0"b; 4830 go to ret; 4831 4832 action (196): 4833 action (197): 4834 action (198): 4835 action (199): /*NOT USED*/ 4836 go to ret; 4837 4838 /* do an out_operator with parameter = 1 4839* set dumprocname.searched and true bit for PERFORM verb 4840* do an DEFlaration with parameter = to true of active 4841* clear the bits 4842* put active on stack*/ 4843 /* declare all true and false labels for the PERFORM verb */ 4844 4845 4846 action (200): 4847 call TEST (act_log.false, "1001"b); 4848 call act200; 4849 go to ret; 4850 4851 act200: 4852 proc; 4853 dumprocname.searched = "1"b; 4854 dumprocname.duplicate = "1"b; 4855 if act_log.true ^= 0 4856 then call DEF (act_log.true); 4857 dumprocname.duplicate = "0"b; 4858 if act_log.false ^= 0 4859 then call DEF (act_log.false); 4860 dumprocname.searched = "0"b; 4861 end; 4862 4863 /* put unary - on arithmetic stack */ 4864 4865 action (201): 4866 assub = assub + 1; 4867 SAE = "0"b; /*[3.0-10]*/ 4868 /* AS(assub) = 0 */ 4869 4870 astack_ptr = addr (astack (assub)); 4871 astack_bits = "0"b; 4872 4873 astack.unmin (assub) = "1"b; 4874 astack.key (assub) = 187; 4875 go to ret; 4876 4877 /* put left parenthesis on arithmetic stack */ 4878 4879 action (202): /*[4.2-3]*/ 4880 if reserved_word.column ^= 0 4881 then do; 4882 expind = "1"b; /*[4.4-1]*/ 4883 arith_op = "1"b; 4884 SAE = "0"b; 4885 end; 4886 4887 assub = assub + 1; /* AS(assub) = 0 */ 4888 4889 astack_ptr = addr (astack (assub)); 4890 astack_bits = "0"b; 4891 4892 astack.lefpar (assub) = "1"b; 4893 go to ret; 4894 4895 /* if the priority of the operator being processed 4896* id greater than hthe priority of operator 4897* on arithmetic stack put operator being 4898* processed on stack otherwise output one 4899* stack item and go back to beginning. */ 4900 4901 action (203): 4902 expind = "1"b; 4903 SAE = "0"b; /*[3.0-10]*/ 4904 /*[4.4-1]*/ 4905 arith_op = "1"b; 4906 4907 do while ("1"b); 4908 4909 if (reserved_word.key = 185) | (reserved_word.key = 183) 4910 then tempkey = reserved_word.key - 1; 4911 else tempkey = reserved_word.key; 4912 4913 if tempkey > astack.key (assub) 4914 then do; 4915 assub = assub + 1; /*AS(assub) = 0 */ 4916 4917 astack_ptr = addr (astack (assub)); 4918 astack_bits = "0"b; 4919 4920 astack.key (assub) = reserved_word.key; 4921 go to ret; 4922 end; 4923 else do; 4924 opeos.verb = 28; /* arithmetic operatotr */ 4925 opeos.e = astack.key (assub); /* actual operation */ 4926 seqvarptr = opeosptr; 4927 seqvarleng = opeos.size; 4928 call seqput; 4929 assub = assub - 1; 4930 end; 4931 end; 4932 4933 /* output the arithmetic stack elements 4934* al long as they belong to class 1 */ 4935 4936 action (204): 4937 do while ("1"b); 4938 4939 if assub = 0 4940 then go to ret; 4941 4942 if astack.key (assub) = 0 4943 then go to ret; 4944 4945 opeos.verb = 28; /* arithmetic operation */ 4946 opeos.e = astack.key (assub); /* specific operation */ 4947 seqvarptr = opeosptr; 4948 seqvarleng = opeos.size; 4949 call seqput; 4950 assub = assub - 1; 4951 end; 4952 4953 /* pop the arithmetic stack */ 4954 4955 action (205): /*[4.2-6]*/ 4956 if reserved_word.column ^= 0 4957 then expind = "1"b; 4958 assub = assub - 1; /*[4.4-1]*/ 4959 arith_op = "1"b; 4960 go to ret; 4961 4962 /* pop the logical stack and set lognot 4963* equal to not field from item that was judt 4964* popped */ 4965 4966 action (206): /*[4.2-6]*/ 4967 if reserved_word.column ^= 0 4968 then expind = "1"b; 4969 lognot = cstack.not (cssub); 4970 cssub = cssub - 1; /*[4.4-1]*/ 4971 arith_op = "1"b; /*[4.4-12]*/ 4972 SUBJ_REQ = cstack.subj_req (cssub); 4973 go to ret; 4974 4975 /* put zero on arithmetic stack */ 4976 4977 action (207): 4978 expind = "0"b; 4979 assub = 1; 4980 SAE = "1"b; /*[3.0-10]*/ 4981 /*[4.4-1]*/ 4982 arith_op = "0"b; 4983 4984 /*[4.0-1]*/ 4985 ae.line = header.line; /*[4.0-1]*/ 4986 ae.column = header.column; /* AS(assub) = 0 */ 4987 4988 astack_ptr = addr (astack (assub)); 4989 astack_bits = "0"b; 4990 4991 op.op_lit = "1"b; 4992 go to ret; 4993 4994 action (208): /*[4.4-1]*/ 4995 arith_op = "1"b; 4996 go to ret; 4997 4998 action (209): /*[4.4-1]*/ 4999 arith_op = "0"b; 5000 go to ret; 5001 5002 action (210): /*[4.4-12]*/ 5003 SUBJ_REQ = "0"b; /*[4.4-1]*/ 5004 if arith_op /*[4.4-1]*/ 5005 then do; 5006 call ae_diag (13); /* ae in rel cond */ 5007 /*[4.4-1]*/ 5008 arith_op = "0"b; /*[4.4-1]*/ 5009 end; 5010 go to ret; 5011 5012 ae_diag: 5013 proc (dn); 5014 5015 /*[4.4-1]*/ 5016 declare dn fixed bin; 5017 5018 /*[4.4-1]*/ 5019 if fixed_common.comp_level < "3" /*[4.4-1]*/ 5020 then if arith_op /*[4.4-1]*/ 5021 then call LEV_DIAG (dn, ae.line, ae.column); 5022 5023 end; 5024 5025 /* put the item on conditional stack */ 5026 5027 action (211): /*[4.4-6]*/ 5028 call act211; /*[4.4-6]*/ 5029 op.loc = mptr; 5030 go to ret; 5031 5032 act211: 5033 proc; 5034 cssub = cssub + 1; 5035 cstack_ptr = addr (cstack (cssub)); 5036 cstack_bits = "0"b; 5037 cstack.true (cssub) = header.type; 5038 cstack.operand (cssub) = "1"b; 5039 5040 call TOK_TYPE; /*[3.0-10]*/ 5041 end; 5042 5043 TOK_TYPE: 5044 proc; /*[3.0-10]*/ 5045 5046 5047 5048 /*[4.4-6]*/ 5049 string (op.descr) = "0"b; 5050 5051 5052 /*[4.0-6]*/ 5053 op.line = header.line; 5054 op.col = header.column; 5055 5056 if reserved_word.type > 10 5057 then return; /*[3.0-10]*/ 5058 5059 go to CS (reserved_word.type); /*[3.0-10]*/ 5060 5061 CS (1): /* reserved word */ 5062 op.op_lit = "1"b; 5063 5064 if reserved_word.key = 180 /* zero */ 5065 then do; 5066 op.numeric = "1"b; /*[3.0-10]*/ 5067 op.integer = "1"b; /*[3.0-10]*/ 5068 end; /*[3.0-10]*/ 5069 else op.non_numeric = "1"b; /*[3.0-10]*/ 5070 5071 return; 5072 5073 CS (2): /* numeric literal */ 5074 op.op_lit = "1"b; 5075 op.numeric = "1"b; /*[3.0-10]*/ 5076 if numeric_lit.places_right = 0 5077 then op.integer = "1"b; /*[3.0-10]*/ 5078 5079 op.length = op.length + numeric_lit.places_right + numeric_lit.places_left; 5080 /*[3.0-10]*/ 5081 5082 /*[4.0-1]*/ 5083 op.length = 0; 5084 5085 return; /*[3.0-10]*/ 5086 5087 CS (3): /* alphanumeric literal */ 5088 op.op_lit = "1"b; 5089 op.non_numeric = "1"b; /*[3.0-10]*/ 5090 5091 op.length = alphanum_lit.lit_size; /*[3.0-10]*/ 5092 5093 return; /*[3.0-10]*/ 5094 5095 CS (9): /* data name */ 5096 op.op_lit = "0"b; 5097 if data_name.usage_index /*[3.0-10]*/ 5098 then op.index = "1"b; /*[3.0-10]*/ 5099 else /*[3.0-10]*/ 5100 if data_name.non_elementary /*[3.0-10]*/ 5101 then op.non_numeric = "1"b; /*[3.0-10]*/ 5102 else if data_name.numeric | data_name.numeric_edited 5103 /*[3.0-10]*/ 5104 then do; 5105 op.numeric = "1"b; /*[3.0-10]*/ 5106 if data_name.places_right = 0 /*[3.0-10]*/ 5107 then op.integer = "1"b; /*[3.0-10]*/ 5108 end; /*[3.0-10]*/ 5109 else op.non_numeric = "1"b; /*[3.0-10]*/ 5110 5111 5112 if fixed_common.comp_level < "5" 5113 then do; 5114 call field_length; /*[3.0-1]*/ 5115 op.length = L; 5116 end; 5117 5118 return; /*[3.0-10]*/ 5119 5120 CS (10): /*[3.0-10]*/ 5121 op.index = "1"b; /*[3.0-10]*/ 5122 5123 5124 CS (4): 5125 CS (5): 5126 CS (6): 5127 CS (7): 5128 CS (8): 5129 end; 5130 5131 field_length: 5132 proc; 5133 5134 L = 0; 5135 5136 if data_name.non_elementary 5137 then L = data_name.item_length; 5138 else if data_name.numeric | data_name.numeric_edited 5139 then do; 5140 if data_name.item_signed 5141 then L = 1; 5142 5143 L = L + data_name.places_left + data_name.places_right; 5144 end; 5145 else if data_name.alphabetic | data_name.alphanum_edited | data_name.alphanum 5146 then L = data_name.item_length; 5147 5148 end; 5149 5150 /* put the arithmetic expression symbol on stack */ 5151 5152 action (212): 5153 cssub = cssub + 1; /* CS(cssub) = 0 */ 5154 5155 cstack_ptr = addr (cstack (cssub)); 5156 cstack_bits = "0"b; 5157 5158 /*[5.3-1]*/ 5159 if SAE 5160 then go to ret; 5161 5162 /*[3.0-10]*/ 5163 op_bits = "0"b; /*[3.0-10]*/ 5164 op.numeric = "1"b; 5165 op.loc = null (); 5166 5167 go to ret; 5168 5169 /* pop the stack */ 5170 5171 action (213): 5172 cssub = cssub - 1; 5173 go to ret; 5174 5175 action (214): 5176 if fixed_common.comp_level < "3" 5177 then do; 5178 if (header.type = 3 & alphanum_lit.lit_size ^= 1) | (header.type = 9 & data_name.item_length ^= 1) 5179 then call lev_diag (124); 5180 5181 end; 5182 5183 go to ret; 5184 5185 action (215): /*[5.2-1]*/ 5186 call cobol_swf_put (cobol_pdofp, st, rw_move_ptr, rw_move_size); 5187 /*[5.2-1]*/ 5188 call cobol_swf_put (cobol_pdofp, st, supp_lit_ptr, supp_lit_size); 5189 /*[5.2-1]*/ 5190 call cobol_swf_put (cobol_pdofp, st, ss_tok_ptr, ss_tok_size); 5191 /*[5.2-1]*/ 5192 call cobol_swf_put (cobol_pdofp, st, eos_move_ptr, eos_move_size); 5193 5194 go to ret; 5195 5196 /*[5.2-1]*/ 5197 dcl ss_tok_ptr ptr, 5198 ss_tok_size fixed bin; 5199 5200 action (216): /*[5.2-1]*/ 5201 ss_tok_ptr = mptr; /*[5.2-1]*/ 5202 ss_tok_size = data_name.size; /*[5.2-1]*/ 5203 data_name.type = 9; 5204 5205 go to ret; 5206 5207 action (217): 5208 action (218): /*NOT USED*/ 5209 go to ret; 5210 5211 /* unknown at this time */ 5212 5213 action (219): /* SUB = 0 */ 5214 subject_bits = "0"b; 5215 subject.true = 17; 5216 cstack.logical (cssub) = "1"b; 5217 coperator.comp = "0"b; 5218 coperator.op = 17; 5219 cssub = cssub + 1; /*[4.4-12]*/ 5220 SUBJ_REQ = "1"b; /* CS(cssub) = 0 */ 5221 cstack_ptr = addr (cstack (cssub)); 5222 cstack_bits = "0"b; /*[4.4-3]*/ 5223 is_not_rel = "1"b; 5224 5225 cstack.true (cssub) = 17; 5226 cstack.operand (cssub) = "1"b; 5227 soperator.op = coperator.op; 5228 soperator.not = coperator.not; 5229 5230 go to ret; /* initialize all conditions 5231* put an initialized item on condition stack 5232* clear log not switch 5233* clear the condition operator clear subject */ 5234 5235 action (220): 5236 lev_save = cssub; 5237 cssub = cssub + 1; 5238 SUBJ_REQ = "1"b; /* CS(cssub) = 0 */ 5239 5240 cstack_ptr = addr (cstack (cssub)); 5241 cstack_bits, lognot, coperator_bits, subject_bits = "0"b; 5242 /*[5.3-2]*/ 5243 iscond = "0"b; 5244 5245 go to ret; /* put on stack the following item 5246* ( logical not true false 5247* within this item set not = log_not 5248* set logical true false = 0 5249* set log_not = 0 */ 5250 5251 action (221): /*[4.4-12]*/ 5252 cstack.subj_req (cssub) = SUBJ_REQ; 5253 cssub = cssub + 1; 5254 SUBJ_REQ = "1"b; 5255 5256 cstack_ptr = addr (cstack (cssub)); 5257 cstack_bits = "0"b; 5258 5259 cstack.leftpar (cssub) = "1"b; 5260 cstack.not (cssub) = lognot; 5261 cstack.parity (cssub) = bool (cstack.parity (cssub - 1), lognot, "0110"b); 5262 5263 lognot = "0"b; 5264 go to ret; 5265 5266 /* set log_not = to 1 */ 5267 5268 action (222): 5269 lognot = "1"b; 5270 go to ret; 5271 5272 /* set not field in operation = to 1 */ 5273 5274 action (223): 5275 coperator.not = "1"b; 5276 go to ret; 5277 5278 /* move operation type from item in window to condition operator */ 5279 5280 action (224): 5281 coperator.op = reserved_word.key; 5282 go to ret; 5283 5284 /* pop stack to subject 5285* set bit logical on cstack to 1 5286* set bit compare on type inside coperator to 0 normal compare 5287* move operation type from window to cop*/ 5288 5289 action (225): /* SUB = CS(cssub) */ 5290 cstack_ptr = addr (cstack (cssub)); 5291 subject_bits = cstack_bits; /*[4.4-3]*/ 5292 is_not_rel = "0"b; 5293 5294 cssub = cssub - 1; 5295 cstack.logical (cssub) = "1"b; 5296 coperator.comp = "0"b; 5297 5298 go to ret; 5299 5300 /* set bit compare type to 1 ( abbreviated relation ) */ 5301 5302 action (226): 5303 coperator.comp = "1"b; 5304 5305 /*[4.4-3]*/ 5306 if is_not_rel /*[4.4-3]*/ 5307 then call diag (274); /*[4.4-3]*/ 5308 else /*[4.2-6]*/ 5309 if fixed_common.comp_level <= "2" 5310 then call lev_diag (18); /* abbrev rel cond */ 5311 go to ret; 5312 5313 /* clear the subject */ 5314 5315 action (227): /* SUB = 0 */ 5316 subject_bits = "0"b; 5317 5318 go to ret; 5319 5320 /* move stored_operation to cop fields 5321* and set bit compare type to 1 for abbreviation */ 5322 5323 action (228): 5324 coperator.op = soperator.op; 5325 coperator.not = soperator.not; 5326 coperator.comp = "1"b; 5327 5328 /*[4.2-6]*/ 5329 if fixed_common.comp_level <= "2" 5330 then call LEV_DIAG (18, oploc.line, oploc.col); /* abbrev rel cond */ 5331 go to ret; 5332 5333 /* move cop and coperator.not fields from coperation to soperation */ 5334 5335 action (229): 5336 if fixed_common.comp_level < "3" /*[4.2-4]*/ 5337 then do; 5338 if op.non_numeric | left.non_numeric /*[4.2-4]*/ 5339 then /*[4.2-4]*/ 5340 if op.length ^= 0 & left.length ^= 0 /*[4.2-4]*/ & /*[4.2-4]*/ op.length ^= left.length 5341 /*[4.0-6]*/ 5342 then call LEV_DIAG (11, left.line, left.col); 5343 /* unequal size operands */ 5344 end; 5345 5346 if fixed_common.comp_level < "5" 5347 then call type_comp; /*[3.0-10]*/ 5348 5349 /*[4.4-1]*/ 5350 if arith_op /*[4.4-1]*/ 5351 then do; 5352 call ae_diag (13); /* ae in rel cond */ 5353 /*[4.4-1]*/ 5354 arith_op = "0"b; /*[4.4-1]*/ 5355 end; 5356 5357 soperator.op = coperator.op; 5358 soperator.not = coperator.not; 5359 go to ret; 5360 5361 /*[3.0-10]*/ 5362 type_comp: 5363 proc; 5364 5365 /*[]*/ 5366 if left.index /*[]*/ 5367 then if op.index /*[]*/ 5368 then return; /*[]*/ 5369 else if op.numeric /*[]*/ 5370 then if op.integer /*[]*/ 5371 then return; /*[]*/ 5372 else call lev_diag (171); /*[]*/ 5373 else call lev_diag (170); /*[]*/ 5374 else /*[]*/ 5375 if op.index /*[]*/ 5376 then if left.numeric /*[]*/ 5377 then if left.integer /*[]*/ 5378 then return; /*[]*/ 5379 else call lev_diag (171); /*[]*/ 5380 else call lev_diag (170); /*[]*/ 5381 else /*[]*/ 5382 if left.numeric /*[]*/ 5383 then if op.numeric /*[]*/ 5384 then return; /*[]*/ 5385 else if left.integer /*[]*/ 5386 then return; /*[]*/ 5387 else call lev_diag (171); /*[]*/ 5388 else /*[]*/ 5389 if op.numeric /*[]*/ 5390 then if op.integer /*[]*/ 5391 then return; /*[]*/ 5392 else call lev_diag (171); /*[]*/ 5393 /*[]*/ 5394 return; 5395 5396 end; 5397 5398 /*[3.0-10]*/ 5399 /* pop condition stack by one 5400* move stack ite m to active logical */ 5401 action (230): /*[4.0-6]*/ 5402 if lognot /*[4.0-6]*/ 5403 then if fixed_common.comp_level <= "2" /*[4.0-6]*/ 5404 then call LEV_DIAG (16, not.line, not.col); /*negated simple condition */ 5405 5406 cssub = cssub - 1; 5407 5408 /* AL = CS(cssub) */ 5409 5410 cstack_ptr = addr (cstack (cssub)); 5411 act_log_bits = cstack_bits; 5412 5413 cssub = cssub - 1; 5414 go to ret; 5415 5416 /* if not field in active logical = 1 , 5417* exchange true and false tag fields, 5418* and reverse the log_not switch*/ 5419 /* then set not in active logical to */ 5420 5421 action (231): 5422 if act_log.not 5423 then do; /* act_log.true == act_log.false */ 5424 holdatrue = act_log.true; 5425 act_log.true = act_log.false; 5426 act_log.false = holdatrue; 5427 lognot = ^lognot; 5428 act_log.not = "0"b; 5429 end; 5430 go to ret; 5431 5432 /* pop stack to work. 5433* if bit not in work = 1 5434* then exchange true and false in work . 5435* output equivalince ( true of work, tuue of active). 5436* output equivalince (false of work, false of active ) */ 5437 5438 action (232): /* WK = CS(cssub) */ 5439 cstack_ptr = addr (cstack (cssub)); 5440 work_bits = cstack_bits; 5441 5442 cssub = cssub - 1; 5443 5444 /*[5.1-1]*/ 5445 call EQ (work.true, act_log.true); 5446 5447 /*[5.1-1]*/ 5448 call EQ (work.false, act_log.false); 5449 5450 /*[5.1-1]*/ 5451 if work.not /* work.true == work.false */ 5452 /*[5.1-1]*/ 5453 then do; 5454 holdatrue = act_log.true; /*[5.1-1]*/ 5455 act_log.true = act_log.false; /*[5.1-1]*/ 5456 act_log.false = holdatrue; /*[5.1-1]*/ 5457 lognot = ^lognot; /*[5.1-1]*/ 5458 end; 5459 5460 go to ret; 5461 5462 /* do an out_operator with param = 1 5463* put active logical on stack */ 5464 5465 action (233): /*[4.2-6]*/ 5466 andor.line = reserved_word.line; 5467 andor.col = reserved_word.column; /* save loc of ANDOR */ 5468 5469 call TEST (act_log.false, "1001"b); 5470 cssub = cssub + 1; /* CS(cssub) = AL */ 5471 5472 cstack_ptr = addr (cstack (cssub)); 5473 cstack_bits = act_log_bits; 5474 5475 go to ret; /* do an out_operator with parameter = 0 . 5476* do an out_odeclatation with paramerer = false of active. 5477* put active logical on stack */ 5478 action (234): /*[4.2-6]*/ 5479 andor.line = reserved_word.line; 5480 andor.col = reserved_word.column; /* save loc of ANDOR */ 5481 5482 call TEST (act_log.true, "0110"b); 5483 if act_log.false ^= 0 5484 then call DEF (act_log.false); 5485 cssub = cssub + 1; /* CS(cssub) = AL */ 5486 5487 cstack_ptr = addr (cstack (cssub)); 5488 cstack_bits = act_log_bits; 5489 5490 go to ret; 5491 5492 /* do an out_operator with parameter = 1. 5493* do an out_equivalence with parameter = false of active and false of stack. 5494* do an out declatation with paramiter = 5495* true of acteve */ 5496 5497 action (235): /*[4.2-6]*/ 5498 andor.line = reserved_word.line; 5499 andor.col = reserved_word.column; /* save loc of ANDOR */ 5500 5501 call TEST (act_log.false, "1001"b); 5502 5503 /*[4.4-5]*/ 5504 call EQ (act_log.false, cstack.false (cssub)); 5505 5506 5507 5508 5509 if act_log.true ^= 0 5510 then call DEF (act_log.true); 5511 go to ret; 5512 5513 /* exchange active with top of stack. */ 5514 5515 action (236): /* AL == CS(cssub) */ 5516 cstack_ptr = addr (cstack (cssub)); 5517 work_bits = act_log_bits; 5518 act_log_bits = cstack_bits; 5519 cstack_bits = work_bits; 5520 5521 go to ret; /* do an out operator with parameter = 1 */ 5522 /* do an out declaration with parameter = true of active 5523* put active on stack*/ 5524 action (237): 5525 call TEST (act_log.false, "1001"b); 5526 5527 if act_log.true ^= 0 5528 then call DEF (act_log.true); 5529 cssub = cssub + 1; /* CS(cssub) = AL */ 5530 cstack_ptr = addr (cstack (cssub)); 5531 cstack_bits = act_log_bits; 5532 go to ret; 5533 5534 dcl EOF fixed bin; 5535 5536 action (238): /*[4.4-5]*/ 5537 call emit_type_13 (63, EOF); 5538 5539 /*[4.4-5]*/ 5540 call def_false; 5541 5542 5543 5544 go to ret; /* pop stack to active */ 5545 action (239): /* AL = CS(cssub) */ 5546 /*[5.3-2]*/ 5547 ST.option (nest_lev) = "1"b; /*[5.3-2]*/ 5548 if EOF ^= 0 5549 then call out_equiv (EOF, ST.h (nest_lev)); /*[5.3-2]*/ 5550 EOF = ST.h (nest_lev); 5551 cstack_ptr = addr (cstack (cssub)); 5552 act_log_bits = cstack_bits; 5553 cssub = cssub - 1; 5554 UB_ind = "0"b; 5555 go to ret; 5556 5557 /* do an out declaration with param = false of active 5558* put active logical on stack and sub 1 from nested if statenent counter */ 5559 5560 action (240): /*[4.4-5]*/ 5561 call def_false; 5562 5563 5564 5565 go to ret; 5566 5567 /* move window item to store _label_1. */ 5568 5569 action (241): 5570 substr (addr (store_label_1) -> itemsize, 1, header.size) = substr (head_ptr -> itemsize, 1, header.size); 5571 go to ret; 5572 5573 /* move window item to store_label_2. 5574* move special operator go depending to window. not done noow 5575* note the go depending is recognized 5576* by verv subroutine and appropriate 5577* processing takes paace to deal 5578* with stored label_1 and label_2 . *?*/ 5579 5580 action (242): 5581 substr (addr (store_label_2) -> itemsize, 1, header.size) = substr (head_ptr -> itemsize, 1, header.size); 5582 header.type = 1; 5583 reserved_word.verb = "1"b; 5584 reserved_word.imper_verb = "1"b; 5585 reserved_word.key = 14; 5586 gotodep = "1"b; 5587 go to ret; /* do an out_operator with parameter = 0. 5588* do an out_equivalence with paaramiter = 5589* true of active and stored_lavel_1. 5590* move zero to true of active . */ 5591 5592 action (243): 5593 call TEST (act_log.true, "0110"b); 5594 5595 /*[4.4-5]*/ 5596 call EQ (act_log.true, store_label_1.proc_num); 5597 5598 5599 5600 5601 act_log.true = 0; 5602 go to ret; /* do an out operator with param = 0 */ 5603 action (244): 5604 call TEST (act_log.true, "0110"b); 5605 5606 ST.h (nest_lev) = 0; 5607 5608 call EQ (act_log.true, next_sent_label); 5609 5610 5611 5612 5613 act_log.true = 0; 5614 go to ret; 5615 5616 /* pop stack to logical active 5617* do an out declaration with param = false of active 5618* do an out declaration with param = true of active 5619* and reset nested if statement counter*/ 5620 5621 action (245): /*NOT USED */ 5622 /*[4.4-5]*/ 5623 call act245; 5624 go to ret; 5625 5626 act245: 5627 proc; 5628 5629 5630 5631 /* AL = CS(cssub) */ 5632 cstack_ptr = addr (cstack (cssub)); 5633 act_log_bits = cstack_bits; 5634 5635 cssub = cssub - 1; 5636 5637 5638 if act_log.false ^= 0 5639 then call DEF (act_log.false); 5640 if act_log.true ^= 0 5641 then call DEF (act_log.true); 5642 5643 5644 5645 end; /* output an unconditional branch to use(true of stack) */ 5646 action (246): 5647 if cssub = 0 5648 then go to ret; 5649 5650 TAG = cstack.true (cssub); 5651 5652 if TAG = 0 5653 then cstack.true (cssub), opeos.h = assign_value (); 5654 5655 5656 else opeos.h = TAG; 5657 5658 opeos.verb = 13; 5659 opeos.e = 63; 5660 seqvarptr = opeosptr; 5661 seqvarleng = opeos.size; 5662 call seqput; 5663 go to ret; 5664 5665 /* declare all true and false labels for the PERFORM verb*/ 5666 5667 action (247): 5668 dumprocname.searched = "1"b; 5669 dumprocname.duplicate = "1"b; 5670 5671 if next_sent_label ^= 0 5672 then call DEF (next_sent_label); 5673 5674 if cssub ^= 0 5675 then do; /* AL = CS(cssub) */ 5676 5677 cstack_ptr = addr (cstack (cssub)); 5678 act_log_bits = cstack_bits; 5679 5680 cssub = cssub - 1; 5681 if act_log.true ^= 0 5682 then call DEF (act_log.true); 5683 dumprocname.duplicate = "0"b; 5684 if act_log.false ^= 0 5685 then call DEF (act_log.false); 5686 5687 end; 5688 5689 dumprocname.searched = "0"b; 5690 5691 go to ret; 5692 5693 action (248): /* default device for accept */ 5694 code_option = 29; 5695 if ^ST.skip_ind (nest_lev) 5696 then call cobol_pd_code$code; 5697 go to ret; 5698 5699 action (249): /* default device for display */ 5700 code_option = 30; 5701 if ^ST.skip_ind (nest_lev) 5702 then call cobol_pd_code$code; 5703 go to ret; 5704 5705 /* compiler error */ 5706 action (250): 5707 return; 5708 5709 action (251): 5710 if fatal_no ^= 0 5711 then go to endint; 5712 else go to ret; 5713 5714 /* save smallest range -- used for set verb */ 5715 action (252): 5716 if savitmptr -> index_name.max ^> index_name.max 5717 then go to ret; 5718 call act28; 5719 go to ret; /* set input_error_exit for use procedure */ 5720 5721 action (253): 5722 input_error_exit = cursecnum; 5723 go to ret; 5724 5725 /* set output_error_exit for use procedure */ 5726 5727 action (254): 5728 output_error_exit = cursecnum; 5729 go to ret; 5730 5731 /* set i_o_error_exit for use procedure */ 5732 5733 action (255): 5734 i_o_error_exit = cursecnum; 5735 go to ret; 5736 5737 /* set extend_error_exit for use procedure */ 5738 5739 action (256): 5740 extend_error_exit = cursecnum; 5741 go to ret; 5742 5743 /* set read bit in file_table - in core from check (89) */ 5744 5745 action (257): 5746 file_table.read = "1"b; 5747 go to ret; 5748 5749 /* set read_next bit in file_table - in core from check (23) */ 5750 5751 action (258): /*[5.3-2]*/ 5752 iscond = "1"b; 5753 go to ret; 5754 5755 /* set read_key bit in file_table - in core from check (20) */ 5756 5757 action (259): 5758 file_table.read_key = "1"b; 5759 go to ret; 5760 5761 /* set rewrite bit in file_table - in core from check (70) */ 5762 5763 action (260): 5764 file_table.rewrite = "1"b; 5765 call act28; 5766 go to ret; /* set write bit in file_table - in core from check (70) */ 5767 5768 action (261): 5769 file_table.write = "1"b; 5770 call act28; 5771 go to ret; /* set start bit in file_table - in core from check (155) */ 5772 5773 action (262): 5774 file_table.start = "1"b; 5775 go to ret; 5776 5777 /* set open_in bit in file_table - not in core */ 5778 5779 action (263): 5780 if fd_token.file_no = 0 5781 then go to ret; 5782 5783 call cobol_read_ft_ (fd_token.file_no, ft_ptr); 5784 5785 go to SM (op_mode); 5786 5787 SM (1): 5788 open_in = "1"b; 5789 go to SM1; /* input */ 5790 5791 SM (2): 5792 open_out = "1"b; 5793 go to SM1; /* output */ 5794 5795 SM (3): 5796 open_io = "1"b; 5797 go to SM1; /* io */ 5798 5799 SM (4): 5800 open_ext = "1"b; 5801 go to SM1; /* extend */ 5802 5803 SM1: 5804 go to action (28); 5805 5806 action (264): 5807 left_bits = op_bits; 5808 5809 go to ret; 5810 5811 action (265): /*[4.4-6]*/ 5812 call set_op_loc; 5813 5814 go to ret; 5815 5816 action (266): /*[5.3-2]*/ 5817 ST.cond (nest_lev) = "0"b; /*[5.3-2]*/ 5818 if ST.end_wd (nest_lev) = 14 5819 then if ST.ns (nest_lev) 5820 then call diag (316); 5821 else ; 5822 else call pop_state; 5823 5824 go to ret; /* set rounded bit in saved item --- output saved item */ 5825 action (267): 5826 savitmptr -> data_name.rounded = "1"b; 5827 seqvarptr = savitmptr; 5828 seqvarleng = saveitem.size; 5829 call seqput; 5830 go to ret; /* output saved item */ 5831 5832 action (268): 5833 seqvarptr = savitmptr; 5834 seqvarleng = saveitem.size; 5835 call seqput; 5836 go to ret; /* add 1 to operand count 5837* save current item for add verb*/ 5838 action (269): 5839 end_stmt.h = end_stmt.h + 1; 5840 substr (sav_ptr -> itemsize, 1, header.size) = substr (addr_record -> itemsize, 1, header.size); 5841 go to ret; 5842 5843 action (270): /*[5.3-2]*/ 5844 ST.option (nest_lev) = "1"b; /*[5.3-2]*/ 5845 end_stmt.b = "1"b; /*[5.3-2]*/ 5846 call seqputeos; /*[5.3-2]*/ 5847 if ST.end_wd (nest_lev) = 2 5848 then call save_skip_ind; /* CALL */ 5849 5850 5851 go to ret; 5852 5853 /* add 1 to operand count in format 1 of multiply verb 5854* save current item */ 5855 5856 action (271): 5857 end_stmt.e = end_stmt.e + 1; 5858 substr (sav_ptr -> itemsize, 1, header.size) = substr (addr_record -> itemsize, 1, header.size); 5859 cssavebit = data_name.constant_section; 5860 go to ret; 5861 5862 action (272): 5863 if decswitch = 1 & ^proc_def.declarative_proc 5864 then call diag (263); 5865 go to ret; 5866 5867 end_sent: 5868 proc; 5869 5870 /*[5.1-2]*/ 5871 LTP, last_wd_per = "1"b; 5872 5873 /*[4.4-8]*/ 5874 sav_bit = "0"b; 5875 5876 /*[4.4-5]*/ 5877 if next_sent_label ^= 0 5878 then call DEF (next_sent_label); 5879 5880 /*[4.4-5]*/ 5881 do while (cssub > 0); 5882 call act245; 5883 end; 5884 5885 end; 5886 5887 action (273): /*[4.4-1]*/ 5888 call end_sent; 5889 go to ret; 5890 5891 action (274): /*[4.4-1]*/ 5892 call end_sent; 5893 call seqputeos; 5894 go to ret; 5895 5896 action (275): 5897 call act275; 5898 go to ret; 5899 act275: 5900 proc; 5901 5902 /*[5.3-2]*/ 5903 nest_lev = 1; 5904 call reset_st; 5905 call act49; 5906 end; 5907 5908 action (276): 5909 coperator.not = "0"b; 5910 go to ret; 5911 5912 action (277): 5913 end_stmt.d = "01"b; 5914 go to ret; 5915 5916 action (278): /*[4.1-7]*/ 5917 call DIAG (248); /* Item declared in CONSTANT section */ 5918 go to ret; 5919 5920 action (279): /*[4.4-6]*/ 5921 sub_loc = 0; 5922 call set_op_loc; 5923 call act113; 5924 go to ret; 5925 5926 action (280): 5927 sub_loc = sub_loc + 1; 5928 5929 subs (sub_loc) = fixed (numeric_lit.literal); 5930 numeric_lit.subscript = "1"b; 5931 go to ret; 5932 5933 action (281): 5934 key = fixed (numeric_lit.literal); 5935 5936 if key < min_index | key > max_index 5937 then call diag (270); /* DIAG(270) */ 5938 5939 go to ret; 5940 5941 action (282): 5942 min_index = 0; 5943 max_index = 99999; 5944 5945 addr (set_sop) -> set_sop_mask = "0"b; 5946 5947 go to ret; 5948 5949 action (283): /*[5.3-2]*/ 5950 if ST.nif (nest_lev) > 1 /*[5.3-2]*/ 5951 then if fixed_common.comp_level < "3" /*[5.3-2]*/ 5952 then call lev_diag (12); 5953 5954 5955 5956 5957 5958 go to action (42); 5959 5960 action (284): 5961 SAE = "0"b; 5962 5963 go to ret; 5964 5965 action (285): /*[3.0-10]*/ 5966 call set_op_loc; /*[4.4-6]*/ 5967 5968 go to ret; /*[3.0-10]*/ 5969 5970 action (286): /*[3.0-12] issue leveling diag 169 */ 5971 if fixed_common.comp_level < "5" 5972 then call lev_diag (169); 5973 5974 call end_sent; 5975 call seqputeos; 5976 go to ret; 5977 action (287): /*[3.0-13] issue leveling diag 172 */ 5978 if data_name.level ^= 1 5979 then if data_name.level ^= 77 /*[4.4-10]*/ 5980 then do; 5981 if fixed_common.comp_level < "5" 5982 then call lev_diag (172); 5983 5984 /*[4.4-10]*/ 5985 if mod (data_name.offset, 4) ^= 0 5986 then call diag (30); 5987 5988 /*[4.4-10]*/ 5989 end; 5990 5991 end_stmt.e = end_stmt.e + 1; 5992 go to ret; 5993 5994 5995 action (288): /*[3.0-15] Set vfile_ key in opeos.e for start and read statements */ 5996 if header.type = 12 5997 then end_stmt.e = 511; 5998 else end_stmt.e = vfile_key; 5999 6000 go to ret; 6001 6002 action (289): /* in-line perform */ 6003 /*[4.0-4]*/ 6004 end_stmt.d = "01"b; 6005 6006 /*[4.4-5]*/ 6007 ST.e (nest_lev) = assign_value (); /*[4.4-5]*/ 6008 ST.h (nest_lev) = assign_value (); 6009 6010 6011 6012 /*[4.0-4]*/ 6013 call emit_pn (ST.e (nest_lev)); /*[4.0-4]*/ 6014 call emit_pn (ST.h (nest_lev)); 6015 6016 go to ret; 6017 6018 emit_pn: 6019 proc (tagno); 6020 6021 /*[4.0-4]*/ 6022 declare tagno fixed bin; 6023 6024 /*[4.0-4]*/ 6025 dumprocname.type = 18; /*[4.0-4]*/ 6026 dumprocname.proc_num = tagno; 6027 6028 /*[4.0-4]*/ 6029 seqvarptr = dpnptr; /*[4.0-4]*/ 6030 seqvarleng = dumprocname.size; 6031 6032 /*[4.0-4]*/ 6033 call seqput; 6034 6035 end; 6036 6037 action (290): /*[5.3-2]*/ 6038 if nest_lev > 1 6039 then call test_stack; 6040 6041 /*[5.3-2]*/ 6042 nest_lev = 1; /*[5.3-2]*/ 6043 call reset_st; 6044 6045 go to ret; 6046 6047 test_stack: 6048 proc; 6049 6050 /*[5.3-2]*/ 6051 dcl i fixed bin, 6052 res bit (1); 6053 6054 /*[5.3-2]*/ 6055 i = nest_lev; /*[5.3-2]*/ 6056 EW = ST.end_wd (i); 6057 6058 /*[5.3-2]*/ 6059 if EW ^= 7 /* if */ 6060 /*[5.3-2]*/ 6061 then do; 6062 i = i - 1; /*[5.3-2]*/ 6063 EW = ST.end_wd (i); /*[5.3-2]*/ 6064 end; 6065 6066 /*[5.3-2]*/ 6067 res = "0"b; 6068 6069 /*[5.3-2]*/ 6070 do i = i by -1 to 1 while (res = "0"b); /*[5.3-2]*/ 6071 if ST.end_wd (nest_lev) ^= 7 6072 then res = "1"b; /*[5.3-2]*/ 6073 end; 6074 6075 /*[5.3-2]*/ 6076 if res 6077 then call diag (145); 6078 6079 end; 6080 6081 emit_eos_perf: 6082 proc; 6083 6084 /*[4.0-4]*/ 6085 end_stmt.verb = 20; /*[4.0-4]*/ 6086 if ST.a (nest_lev) = "000"b 6087 then end_stmt.a = "000"b; 6088 else end_stmt.a = "110"b; /*[4.0-4]*/ 6089 end_stmt.e = ST.e (nest_lev); /* L1 */ 6090 /*[4.0-4]*/ 6091 end_stmt.h = ST.h (nest_lev); /* L3 */ 6092 6093 /*[4.0-4]*/ 6094 call seqputeos; 6095 6096 end; 6097 6098 action (291): /* dispatch on end word */ 6099 go to ret; 6100 6101 /*[4.0-4]*/ 6102 6103 action (292): /* not form of an option */ 6104 /*[5.3-2]*/ 6105 ST.not_opt (nest_lev) = "1"b; /*[4.0-4]*/ 6106 end_stmt.f = "01"b; 6107 go to ret; 6108 6109 action (293): /* option code terminator, type=19, vt=3 */ 6110 /*[5.3-2]*/ 6111 call a294 ("00"b); 6112 6113 go to ret; 6114 6115 6116 6117 6118 6119 6120 action (294): /* option code terminator, type=19, vt=3 */ 6121 call a294 ("01"b); 6122 go to ret; 6123 6124 a294: 6125 proc (f); /*[5.3-2]*/ 6126 dcl f bit (2); /*[5.3-2]*/ 6127 end_stmt_chars = saveos; /*[5.3-2]*/ 6128 end_stmt.verb = 3; /*[4.0-4]*/ 6129 end_stmt.b = "1"b; /* option code follows */ 6130 /*[5.3-2]*/ 6131 end_stmt.f = f; /*[4.0-4]*/ 6132 call seqputeos; 6133 end; 6134 6135 action (295): /*[4.0-4]*/ 6136 string (ST.desc (nest_lev)) = addr (end_stmt.a) -> bit16; 6137 go to ret; 6138 6139 action (296): /*[4.0-4]*/ 6140 addr (end_stmt.a) -> bit16 = string (ST.desc (nest_lev)); 6141 go to ret; 6142 6143 action (297): /*[4.2-6]*/ 6144 not.line = reserved_word.line; /*[4.2-6]*/ 6145 not.col = reserved_word.column; /* save loc of NOT */ 6146 6147 go to ret; 6148 6149 action (298): /*[4.2-6]*/ 6150 if fixed_common.comp_level <= "2" /*[4.2-6]*/ 6151 then do; 6152 if reserved_word.section_header /*[4.2-6]*/ 6153 then call LEV_DIAG (16, not.line, not.col); 6154 /* negated simple condition */ 6155 /*[4.2-6]*/ 6156 else call LEV_DIAG (215, not.line, not.col); 6157 /* negated combined condition */ 6158 /*[4.2-6]*/ 6159 end; 6160 go to ret; 6161 6162 action (299): /*[4.4-3]*/ 6163 is_not_rel = "1"b; 6164 6165 /*[5.3-1]*/ 6166 if cssub > 0 6167 then cstack.c.logical (cssub - 1) = "1"b; 6168 6169 /*[4.4-1]*/ 6170 if arith_op /*[4.4-1]*/ 6171 then do; 6172 call ae_diag (177); /* ae in rel cond */ 6173 /*[4.4-1]*/ 6174 arith_op = "0"b; /*[4.4-1]*/ 6175 end; /*[4.4-1]*/ 6176 go to action (224); 6177 6178 action (300): /*[4.4-2]*/ 6179 if ^LTP 6180 then call DIAG_PREV_TOKEN (279); /* missing period */ 6181 call act87; 6182 go to ret; 6183 6184 action (301): /*[5.3-2]*/ 6185 ST.option (nest_lev) = "1"b; 6186 call act37; 6187 go to ret; 6188 6189 action (302): /*[5.3-2]*/ 6190 ST.option (nest_lev) = "1"b; 6191 end_stmt.a = "001"b; 6192 call act109; 6193 go to ret; 6194 6195 action (303): /*[5.3-2]*/ 6196 ST.option (nest_lev) = "1"b; 6197 end_stmt.b = "1"b; 6198 call seqputeos; 6199 go to ret; 6200 action (304): /*[5.3-2]*/ 6201 ST.option (nest_lev) = "1"b; 6202 end_stmt.b = "1"b; 6203 go to ret; 6204 6205 action (305): /*[5.3-2]*/ 6206 ST.cond (nest_lev - 1) = "0"b; 6207 6208 /*[5.3-2]*/ 6209 if ST.e (nest_lev) ^= 0 6210 then call emit_eos_perf; 6211 go to ret; 6212 6213 6214 action (306): /*[4.4-5]*/ 6215 ST.option (nest_lev) = "0"b; /* else has not occurred */ 6216 /*[5.3-2]*/ 6217 ST.nif (nest_lev) = ST.nif (nest_lev) + 1; /*[4.4-5]*/ 6218 ST.h (nest_lev) = assign_value (); /*[4.4-5]*/ 6219 EOF = 0; 6220 go to ret; 6221 6222 set_op_loc: 6223 proc; /*[4.4-6]*/ 6224 call TOK_TYPE; /*[4.4-6]*/ 6225 op.loc = mptr; 6226 end; 6227 6228 action (307): /*[4.4-6]*/ 6229 call act211; 6230 go to ret; 6231 6232 emit_type_13: 6233 proc (op, tag); 6234 6235 declare (op, tag) fixed bin; 6236 6237 opeos.verb = 13; 6238 opeos.e = op; 6239 opeos.h = tag; 6240 seqvarptr = opeosptr; 6241 seqvarleng = opeos.size; 6242 6243 call seqput; 6244 6245 end; 6246 6247 action (308): /*[5.1-3]*/ 6248 ST.h (nest_lev) = assign_value (); /*[5.3-2]*/ 6249 ST.option (nest_lev) = "1"b; /*[4.4-5]*/ 6250 if act_log.false ^= 0 6251 then call DEF (act_log.false); 6252 6253 /*[4.4-5]*/ 6254 UB_ind = "0"b; 6255 6256 go to ret; 6257 6258 def_false: 6259 proc; 6260 6261 /*[4.4-5]*/ 6262 if act_log.false ^= 0 6263 then call DEF (act_log.false); /*[4.4-5]*/ 6264 UB_ind = "0"b; 6265 6266 end; 6267 6268 action (309): /*[4.4-6]*/ 6269 call set_op_loc; 6270 go to ret; 6271 6272 6273 action (310): /*[5.3-2]*/ 6274 end_stmt_bits = "0"b; 6275 end_stmt.verb = 3; 6276 call seqputeos; 6277 go to ret; 6278 6279 assign_value: 6280 proc returns (fixed bin); 6281 6282 spec_tag_counter = spec_tag_counter + 1; 6283 6284 return (spec_tag_counter); 6285 6286 end; 6287 6288 action (311): 6289 if next_sent_label = 0 6290 then next_sent_label = assign_value (); 6291 6292 go to ret; 6293 6294 action (312): /*[5.3-2]*/ 6295 ST.cond (nest_lev) = "0"b; 6296 6297 go to ret; 6298 6299 action (313): 6300 call def_false; 6301 call DEF (ST.h (nest_lev)); 6302 go to ret; 6303 6304 action (314): /*NOT USED*/ 6305 go to ret; 6306 6307 action (315): /*[5.3-2]*/ 6308 ST.not_opt (nest_lev) = "1"b; 6309 end_stmt.f = "01"b; 6310 ST.option (nest_lev) = "1"b; 6311 call act37; 6312 go to ret; 6313 6314 action (316): /*NOT USED*/ 6315 go to ret; 6316 6317 action (317): 6318 call a294 ("01"b); 6319 UB_ind = "0"b; 6320 go to ret; 6321 6322 action (318): /*[4.4-8]*/ 6323 call sav_lin_col; 6324 call act87; 6325 go to ret; 6326 6327 sav_lin_col: 6328 proc; 6329 6330 /*[4.4-8]*/ 6331 sav.line = header.line; 6332 sav.column = header.column; /*[4.4-8]*/ 6333 sav_bit = "1"b; 6334 6335 end; 6336 6337 action (319): /*[4.4-8]*/ 6338 sav_bit = "0"b; 6339 go to ret; 6340 6341 action (320): /*[4.4-8]*/ 6342 call sav_lin_col; 6343 call act119; 6344 go to ret; 6345 6346 action (321): /*[4.4-8]*/ 6347 call sav_lin_col; 6348 go to ret; 6349 6350 inc_nest_lev: 6351 proc; 6352 6353 /*[5.3-2]*/ 6354 ST.srchfm2bit (nest_lev) = srchfm2bit; /*[5.3-2]*/ 6355 nest_lev = nest_lev + 1; /*[5.3-2]*/ 6356 call reset_st; /*[5.3-2]*/ 6357 ST.nif (nest_lev) = ST.nif (nest_lev - 1); /*[5.3-2]*/ 6358 ST.skip_ind (nest_lev) = ST.skip_ind (nest_lev - 1); 6359 end; 6360 6361 dec_nest_lev: 6362 proc; 6363 6364 /*[5.3-2]*/ 6365 nest_lev = nest_lev - 1; /*[5.3-2]*/ 6366 ST.ns (nest_lev) = bool (ST.ns (nest_lev), ST.ns (nest_lev + 1), "0111"b); 6367 /*[5.3-2]*/ 6368 if ST.end_wd (nest_lev) = 7 6369 then if ST.option (nest_lev) 6370 then call DEF (ST.h (nest_lev)); /*[5.3-2]*/ 6371 srchfm2bit = ST.srchfm2bit (nest_lev); 6372 end; 6373 6374 reset_st: 6375 proc; 6376 6377 /*[5.3-2]*/ 6378 addr (ST (nest_lev)) -> bit180 = "0"b; 6379 6380 6381 6382 end; 6383 6384 action (322): /*[4.4-8]*/ 6385 sort_count = sort_count + 1; /*[4.4-8]*/ 6386 if fixed_common.comp_level < "4" /*[4.4-8]*/ 6387 then if sort_count > 1 /*[4.4-8]*/ 6388 then call lev_diag (165); 6389 6390 go to ret; 6391 6392 action (323): /*[4.4-9]*/ 6393 end_stmt.a = "000"b; 6394 go to action (3); 6395 6396 action (324): /* STOP RUN */ 6397 /*[4.4-11]*/ 6398 if fixed_common.init_cd 6399 then end_stmt.a = "010"b; 6400 6401 /*[4.4-11]*/ 6402 UB_ind = "1"b; 6403 go to ret; 6404 6405 action (325): /*[4.4-12]*/ 6406 SUBJ_REQ = "1"b; 6407 go to ret; 6408 6409 action (326): /*[4.4-12]*/ 6410 SUBJ_REQ = cstack.subj_req (cssub); 6411 go to ret; 6412 6413 action (327): /*[4.4-12]*/ 6414 SUBJ_REQ = "0"b; 6415 go to ret; 6416 6417 action (328): /*[4.4-2]*/ 6418 call DIAG_PREV_TOKEN (279); 6419 call end_sent; 6420 call seqputeos; 6421 go to ret; 6422 6423 action (329): /*[4.4-2]*/ 6424 call DIAG_PREV_TOKEN (279); 6425 go to ret; 6426 6427 action (330): /*[4.4-2]*/ 6428 call DIAG_PREV_TOKEN (279); 6429 call act275; 6430 go to ret; 6431 6432 action (331): /*[4.4-2]*/ 6433 call DIAG_PREV_TOKEN (279); 6434 call seqputeos; 6435 go to ret; 6436 6437 /*[5.0-1]*/ 6438 dcl cobol_idedsyn$get_seg_limit 6439 entry returns (fixed bin); 6440 6441 /*[5.0-1]*/ 6442 dcl seg_limit fixed bin; 6443 6444 action (332): /*[5.0-1]*/ 6445 if seg_limit = 0 /*[5.0-1]*/ 6446 then call ESD ("2", 7, 79); /* 1SEG, LI */ 6447 /*[5.0-1]*/ 6448 else if seg_num ^= 0 /*[5.0-1]*/ 6449 then if seg_num < seg_limit /*[5.0-1]*/ 6450 then call ESD ("2", 7, 79); /* 1SEG, LI */ 6451 /*[5.0-1]*/ 6452 else call ESD ("4", 8, 222); /* 2SEG, H */ 6453 6454 /*[5.0-1]*/ 6455 go to ret; 6456 6457 action (333): /*[5.3-2]*/ 6458 ST.ns (nest_lev) = "1"b; 6459 go to ret; 6460 6461 action (334): /*[5.3-2]*/ 6462 if ST.ns (nest_lev) /*[5.1-3]*/ 6463 then do; 6464 call diag (304); /*[5.1-3]*/ 6465 ns_found = "0"b; /*[5.1-3]*/ 6466 end; /*[5.3-2]*/ 6467 ST.cond (nest_lev) = "0"b; /*[5.3-2]*/ 6468 call pop_if; 6469 go to ret; 6470 6471 ESD: 6472 proc (cl, md_num, dg_num); 6473 6474 /*[5.0-1]*/ 6475 dcl cl char (1), 6476 (md_num, dg_num) fixed bin; 6477 6478 /*[5.0-1]*/ 6479 if fixed_common.comp_level < cl /*[5.0-1]*/ 6480 then do; 6481 mod_num = md_num; /*[5.0-1]*/ 6482 call lev_diag (dg_num); /*[5.0-1]*/ 6483 end; 6484 6485 end; 6486 6487 6488 declare (key, min_index, max_index) 6489 fixed bin; 6490 6491 6492 /* source card entry to print routine */ 6493 6494 read_error: 6495 go to endint; 6496 6497 write_error: 6498 go to endint; 6499 6500 endint: /* check all files for mismatches on history bits */ 6501 /*[5.1-5]*/ 6502 /* These diags were never issued and dont make much sense 6503* 6504* diag_item.line=0; 6505* diag_item.column=0; 6506* fi_ct=0; 6507*nxtfilchk: 6508* fi_ct=fi_ct+1; 6509* 6510* if fi_ct > fixed_common.file_count then go to endhist; 6511* 6512* call cobol_read_ft_(fi_ct , ft_ptr); 6513* 6514* if file_table.external then go to nxtfilchk; 6515* 6516* if close & ( open_in | open_out |open_io | open_ext ) 6517* then go to nxtfilchk; 6518* 6519* diag_item.number=192; 6520* if close then go to nxtdiag; 6521* 6522* diag_item.number=193; 6523* if (open_in | open_out | open_io | open_ext ) then go to nxtdiag; 6524* 6525* diag_item.number=194; 6526* if delete then go to nxtdiag; 6527* diag_item.number=195; 6528* if read then go to nxtdiag; 6529* diag_item.number=196; 6530* if rewrite then go to nxtdiag; 6531* diag_item.number=197; 6532* if write then go to nxtdiag; 6533* diag_item.number=198; 6534* if read_next then go to nxtdiag; 6535* diag_item.number=199; 6536* if read_key then go to nxtdiag; 6537* diag_item.number=200; 6538* if file_table.start then go to nxtdiag; 6539* 6540*go to nxtfilchk; 6541* 6542*nxtdiag: 6543* call cobol_c_list(dg_ptr); 6544*go to nxtfilchk; 6545* 6546**/ /*[5.1-5]*/ 6547 endhist: 6548 diag_item.column = header.column; 6549 diag_item.line = header.line; 6550 call cobol_c_list (null ()); 6551 return; 6552 6553 6554 declare (addr, fixed, null, substr, unspec, min, max, bool, string, abs, mod) 6555 builtin; 6556 6557 declare (sav_ptr, head_ptr) ptr; 6558 6559 /* The following pointers are used to overlay structures as bit strings */ 6560 6561 declare (act_log_ptr, work_ptr, subject_ptr, soperator_ptr, es_ptr) 6562 ptr; 6563 declare (coperator_ptr, cstack_ptr, astack_ptr, end_stmt_ptr) 6564 ptr; 6565 6566 /* the following bit strings are used to overlay structures */ 6567 6568 declare act_log_bits bit (124) based (act_log_ptr); 6569 declare work_bits bit (124) based (work_ptr); 6570 declare subject_bits bit (124) based (subject_ptr); 6571 declare soperator_bits bit (124) based (soperator_ptr); 6572 declare coperator_bits bit (124) based (coperator_ptr); 6573 declare cstack_bits bit (124) based (cstack_ptr); 6574 declare astack_bits bit (88) based (astack_ptr); 6575 declare end_stmt_bits bit (197) based (end_stmt_ptr); 6576 declare op_bits bit (185) based (op_ptr); 6577 declare left_bits bit (185) based (left_ptr); 6578 6579 /*[5.3-2]*/ 6580 dcl bit180 bit (180) based; /*[5.3-2]*/ 6581 dcl bit16 bit (16) based; /*[5.3-2]*/ 6582 dcl iscond bit (1); /*[5.3-2]*/ 6583 dcl ky fixed bin; 6584 6585 declare (file_org, seg_num, op_mode, mod_num, act_num, EW) 6586 fixed bin; 6587 declare last_seg_num fixed bin init (1000); /*[3.0-10]*/ 6588 /*[]*/ 6589 declare (op_ptr, left_ptr) ptr; /*[]*/ 6590 declare bit5 bit (5) based; /*[]*/ 6591 /*[]*/ 6592 declare 1 op, /*[]*/ 6593 2 loc ptr, /*[]*/ 6594 2 length fixed bin, /*[]*/ 6595 2 line fixed bin, /*[]*/ 6596 2 col fixed bin, /*[]*/ 6597 2 descr, /*[]*/ 6598 3 index bit (1), /*[]*/ 6599 3 numeric bit (1), /*[]*/ 6600 3 non_numeric bit (1), /*[]*/ 6601 3 integer bit (1), /*[]*/ 6602 3 op_lit bit (1); /*[]*/ 6603 /*[]*/ 6604 declare 1 left, /*[]*/ 6605 2 loc ptr, /*[]*/ 6606 2 length fixed bin, /*[]*/ 6607 2 line fixed bin, /*[]*/ 6608 2 col fixed bin, /*[]*/ 6609 2 descr, /*[]*/ 6610 3 index bit (1), /*[]*/ 6611 3 numeric bit (1), /*[]*/ 6612 3 non_numeric bit (1), /*[]*/ 6613 3 integer bit (1), /*[]*/ 6614 3 left_lit bit (1); /*[3.0-10]*/ 6615 6616 /*[4.2-6]*/ 6617 declare 1 not, /*[4.2-6]*/ 6618 2 line fixed bin, /*[4.2-6]*/ 6619 2 col fixed bin; 6620 6621 /*[4.2-6]*/ 6622 declare 1 andor, /*[4.2-6]*/ 6623 2 line fixed bin, /*[4.2-6]*/ 6624 2 col fixed bin; 6625 6626 6627 declare sort_count fixed bin; 6628 6629 6630 /*[4.2-6]*/ 6631 declare 1 oploc, /*[4.2-6]*/ 6632 2 line fixed bin, /*[4.2-6]*/ 6633 2 col fixed bin; 6634 6635 declare seg_usage (0:99) bit (1) based (seg_usage_ptr); 6636 6637 declare seg_usage_string bit (100) init ("0"b); 6638 declare seg_usage_ptr ptr; 6639 6640 declare expind bit (1); 6641 6642 /*[4.0-1]*/ 6643 declare 1 ae, /*[4.0-1]*/ 6644 2 line fixed bin, /*[4.0-1]*/ 6645 2 column fixed bin; 6646 6647 declare 1 set_sop, 6648 2 int_lit bit (1), 6649 2 int_data bit (1), 6650 2 ind_data bit (1); 6651 6652 declare set_sop_mask bit (3) based; 6653 6654 declare pigz_res fixed bin; 6655 6656 /*[4.0-4]*/ 6657 dcl (KEY, END_WORD, nest_lev) 6658 fixed bin; 6659 6660 6661 6662 /*[4.0-4]*/ 6663 declare 1 ST (0:255), /*[4.0-4]*/ 6664 2 end_wd fixed bin, /*[4.0-4]*/ 6665 2 desc, /*[4.0-4]*/ 6666 3 a bit (3), /*[4.0-4]*/ 6667 3 b bit (1), /*[4.0-4]*/ 6668 3 c bit (1), /*[4.0-4]*/ 6669 3 d bit (2), /*[4.0-4]*/ 6670 3 f bit (2), /*[4.0-4]*/ 6671 3 g bit (2), /*[4.0-4]*/ 6672 3 k bit (5), /*[4.4-5]*/ 6673 2 option bit (1), /*[5.3-2]*/ 6674 2 not_opt bit (1), /*[5.3-2]*/ 6675 2 cond bit (1), /*[5.3-2]*/ 6676 2 ns bit (1), /*[5.3-2]*/ 6677 2 skip_ind bit (1), /*[5.3-2]*/ 6678 2 save_skip_ind bit (1), /*[5.3-2]*/ 6679 2 srchfm2bit bit (1), /*[5.3-2]*/ 6680 2 nif fixed bin, /*[4.0-4]*/ 6681 2 e fixed bin, /*[4.0-4]*/ 6682 2 h fixed bin; 6683 6684 6685 /* The following structure is used when look-ahead is needed to determine if the current symbol is in error */ 6686 /* It will contain the column and line number of the current symbol */ 6687 /* USED in: MULTIPLY - if identifier-2 followed by GIVING */ 6688 /* DIVIDE - if identifier-2 followed by GIVING */ 6689 /* INSPECT - if REPLACING is used */ 6690 /*[4.1-7]*/ 6691 declare 01 prev_diag, /*[4.1-7]*/ 6692 02 line_num fixed bin, /*[4.1-7]*/ 6693 02 column_num fixed bin; 6694 6695 /* This pointer points to the previous token. It is used when you need some */ 6696 /* information on the previous token. */ 6697 /* USED in: procedure DIAG_PREV_TOKEN */ 6698 6699 /*[4.1-7]*/ 6700 declare prev_token_ptr pointer; 6701 declare cobol_syntax_trace_$trace 6702 entry (ptr, fixed bin (24)); 6703 declare cobol_syntax_trace_$initialize_phase 6704 entry (ptr, fixed bin (24)); 6705 declare (DIAG_NUM, message_ind) 6706 fixed bin; 6707 declare tm1 fixed bin (24) init (1), 6708 tm2 fixed bin (24) init (2), 6709 tm3 fixed bin (24) init (3), 6710 tm4 fixed bin (24) init (4), 6711 tm5 fixed bin (24) init (5); 6712 declare declprocbit bit (1); 6713 declare fi_ct fixed bin; 6714 6715 /*[3.0-15]*/ 6716 dcl vfile_key fixed bin; /*[3.0-15]*/ 6717 dcl kc fixed bin; 6718 6719 declare lev_save fixed bin (24); 6720 declare subs (3) fixed bin; 6721 declare sub_loc fixed bin; 6722 6723 6724 declare 1 indicators, 6725 2 tbit bit (1), 6726 2 res bit (1), 6727 2 SAE bit (1), /*[3.0-10]*/ 6728 2 UB_ind bit (1) init ("0"b), /*[4.4-3]*/ 6729 2 is_not_rel bit (1), 6730 2 SUBJ_REQ bit (1), 6731 2 ns_found bit (1); 6732 6733 dcl cobol_swf_get entry (ptr, bit (32), ptr, fixed bin) ext; 6734 dcl st bit (32); 6735 dcl tln fixed bin; 6736 dcl cobol_vdwf_dget entry (ptr, bit (32), ptr, fixed bin, char (5)) ext; 6737 dcl cobol_swf_put entry (ptr, bit (32), ptr, fixed bin) ext; 6738 dcl cobol_vdwf_sput entry (ptr, bit (32), ptr, fixed bin, char (5)) ext; 6739 dcl cobol_vdwf_dput entry (ptr, bit (32), ptr, fixed bin, char (5)) ext; 6740 6741 /* common area */ 6742 dcl comsrtrngptr ptr static; /* points to sort range entry */ 6743 /* the following is a description of common*/ 6744 declare (O1_ptr, O2_ptr) ptr; 6745 6746 declare 1 O1, 6747 2 o1 fixed bin, 6748 2 l1 fixed bin; 6749 6750 declare 1 O2, 6751 2 o2 fixed bin, 6752 2 l2 fixed bin; 6753 6754 declare cobol_read_ft_ entry (fixed bin, ptr); 6755 declare cobol_pd_code$initialize 6756 entry (ptr); 6757 declare cobol_pd_code$code entry; 6758 6759 declare code_env_ptr ptr; 6760 6761 declare code_option fixed bin; 6762 6763 declare 1 code_env, 6764 2 arg_1 ptr, 6765 2 arg_2 ptr, 6766 2 arg_3 ptr, 6767 2 arg_4 ptr, 6768 2 arg_5 ptr, 6769 2 arg_6 ptr; 6770 6771 declare 1 DATA, 6772 2 ptr (100) ptr, 6773 2 code_area (5000) fixed bin (35); 6774 6775 declare file_number fixed bin; 6776 6777 6778 dcl filtabptr ptr; /* used to base the file table above */ 6779 dcl ft_ptr ptr; 6780 6781 /* the following is a layout of the FILE KEY record in COMMON */ 6782 6783 dcl 1 file_key based (fkey_ptr), 6784 2 fknext char (5), 6785 2 fknext_alt char (5), 6786 2 fkqual char (5), 6787 2 fkinfo bit (8), 6788 2 fkfile_no fixed bin, 6789 2 fkey_type fixed bin, 6790 2 fkline fixed bin, 6791 2 fkcolumn fixed bin, 6792 2 fb_seg fixed bin, 6793 2 fb_offset fixed bin (24), 6794 2 fklinkage fixed bin, 6795 2 fkfilenum fixed bin, 6796 2 fksize_rtn fixed bin, 6797 2 fklength fixed bin (24), 6798 2 fkplacesleft fixed bin, 6799 2 fkplacesright fixed bin, 6800 2 fkdescription bit (36), 6801 2 fkdescriptiona bit (36), 6802 2 fkseg_num fixed bin, 6803 2 fkoffset fixed bin (24), 6804 2 fkname_size fixed bin, 6805 2 fkname char (30); 6806 6807 dcl fkey_ptr ptr; /*[4.0-3]*/ 6808 dcl (err, format) fixed bin; /* work area */ 6809 6810 dcl sort_key char (5); /* used for sort in common */ 6811 6812 declare 1 stat static internal, 6813 2 procdef, 6814 3 srt_range bit (1), /* sort */ 6815 3 sv_isrbit bit (1), /* input range */ 6816 3 sv_osrbit bit (1), /* output range */ 6817 3 mrg_range bit (1); /* merge */ 6818 6819 declare bit9 bit (9) based; 6820 6821 dcl fi fixed bin; /* file index used by history check routine */ 6822 dcl next_sent_label fixed bin static; /* uset to store tag number of next sentence after if */ 6823 6824 dcl gotodep bit (1) static; /* for go to depending verb found in an if statement */ 6825 6826 dcl preospn_bit bit (1) static; /* used by EXIT verb */ 6827 dcl (dg_ptr, lev_dg_ptr) 6828 ptr; /* pointer to diag item passed to print routine*/ 6829 /* type 5 structure used to construct diagnostics issued by pdsyntax */ 6830 dcl 1 diag_item, 6831 2 size fixed bin, 6832 2 line fixed bin, 6833 2 column fixed bin, 6834 2 type fixed bin, 6835 2 run fixed bin, 6836 2 number fixed bin, 6837 2 info bit (8), 6838 2 multics char (3); 6839 6840 declare 1 lev_diag_item, 6841 2 size fixed bin, 6842 2 line fixed bin, 6843 2 column fixed bin, 6844 2 type fixed bin, 6845 2 run fixed bin, 6846 2 number fixed bin, 6847 2 module fixed bin; 6848 6849 dcl 01 jkperfrng based (jkpfm_ptr), 6850 02 jkperfprocnum fixed bin, 6851 02 jkperfcode fixed bin, 6852 02 jkperflink char (5), 6853 02 jkperflink1 char (5), 6854 02 jkperfprio fixed bin, 6855 02 jkperfext fixed bin; 6856 dcl jkpfm_ptr ptr; /*pointer to junk perform range structure*/ 6857 dcl perform_range_key char (5); /*[4.4-1]*/ 6858 dcl (sav_bit, arith_op) bit (1); /*[5.2-1]*/ 6859 dcl end_decl_bit bit (1); /*[4.4-1]*/ 6860 declare 1 sav, /*[4.4-1]*/ 6861 2 line fixed bin, /*[4.4-1]*/ 6862 2 column fixed bin; /* entry for perform alter range table */ 6863 dcl 01 perfrange static, 6864 02 perfprocnum fixed bin, 6865 02 perfcode fixed bin, 6866 02 perflink char (5), 6867 02 perflink1 char (5), 6868 02 perfprio fixed bin, 6869 02 perfext fixed bin; 6870 6871 6872 declare cssavebit bit (1); 6873 dcl 01 saveperfrange, 6874 02 sperpronum fixed bin, 6875 02 spercod fixed bin, 6876 02 sperlin char (5), 6877 02 sperlin1 char (5), 6878 02 sperpri fixed bin, 6879 02 sperext fixed bin; 6880 6881 dcl savlaskey char (5); /* save last key of perform ranfe entry */ 6882 dcl junk_ptr ptr; /* used to store ptr from dummy reads */ 6883 dcl shprio fixed bin; 6884 dcl prio1 fixed bin; 6885 dcl prio2 fixed bin; 6886 dcl srchfm2bit bit (1) static; /* format 2 of search verb */ 6887 dcl data_name_bit bit (1); /* used by subscript routine */ 6888 dcl index_name_bit bit (1); /* used by subscript routine */ 6889 dcl fircar bit (1) static; /* firdt card switch for print routine */ 6890 dcl dbp fixed bin static; /* diagnostic buffer pointer */ 6891 dcl drc fixed bin (9) static; /* diagnostic reference counter */ 6892 dcl common_key char (5); /* record no of common file just read or to be read */ 6893 dcl common_recsize fixed bin; /* size of record just read from common file */ 6894 dcl common_eof bit (1) static; /* set on if eof encountered on read of common */ 6895 6896 /* needed for function call */ 6897 /* parmeter used for action 233 */ 6898 dcl param bit (1); /* active logical */ 6899 /* arithmetic stack */ 6900 declare 1 astack (25), 6901 2 key fixed bin, 6902 2 filler fixed bin, 6903 2 a, 6904 3 unmin bit (1), /* unary minus */ 6905 3 lefpar bit (1), /* left paren */ 6906 3 filler bit (14); 6907 6908 /* conditional stack */ 6909 6910 declare 1 cstack (75), 6911 2 true fixed bin, 6912 2 false fixed bin, 6913 2 length fixed bin, 6914 2 c, 6915 3 logical bit (1), 6916 3 not bit (1), 6917 3 numerical bit (1), 6918 3 operand bit (1), 6919 3 alphabetic bit (1), 6920 3 arithexp bit (1), 6921 3 leftpar bit (1), 6922 3 parity bit (1), 6923 3 data_name bit (1), 6924 3 subj_req bit (1), 6925 3 filler bit (5); 6926 6927 /* active logical */ 6928 6929 declare 1 act_log, 6930 2 true fixed bin, 6931 2 false fixed bin, 6932 2 length fixed bin, 6933 2 a, 6934 3 logical bit (1), 6935 3 not bit (1), 6936 3 numerical bit (1), 6937 3 operand bit (1), 6938 3 alphabetic bit (1), 6939 3 arithexp bit (1), 6940 3 leftpar bit (1), 6941 3 parity bit (1), 6942 3 filler1 bit (8); 6943 6944 /* work area */ 6945 6946 declare 1 work, 6947 2 true fixed bin, 6948 2 false fixed bin, 6949 2 length fixed bin, 6950 2 w, 6951 3 logical bit (1), 6952 3 not bit (1), 6953 3 filler1 bit (5), 6954 3 parity bit (1), 6955 3 filler bit (8); 6956 6957 /* subject of relation */ 6958 6959 declare 1 subject, 6960 2 true fixed bin, 6961 2 false fixed bin, 6962 2 length fixed bin, 6963 2 s, 6964 3 logical bit (1), 6965 3 not bit (1), 6966 3 filler1 bit (5), 6967 3 parity bit (1), 6968 3 filler bit (8); 6969 6970 /* stored operator */ 6971 6972 declare 1 soperator, 6973 2 op fixed bin, 6974 2 filler fixed bin, 6975 2 length fixed bin, 6976 2 s, 6977 3 logical bit (1), 6978 3 not bit (1), 6979 3 filler1 bit (5), 6980 3 parity bit (1), 6981 3 filler bit (8); 6982 6983 /* condition operator */ 6984 6985 declare 1 coperator, 6986 2 op fixed bin, 6987 2 tag fixed bin, 6988 2 length fixed bin, 6989 2 c, 6990 3 logical bit (1), 6991 3 not bit (1), 6992 3 comp bit (1), 6993 3 filler1 bit (4), 6994 3 parity bit (1), 6995 3 filler2 bit (8); 6996 6997 declare lang_num fixed bin; 6998 declare (L, LL, L1, L2) fixed bin; 6999 7000 declare cobol_imp_word$lang_name 7001 entry (ptr) returns (fixed bin); 7002 7003 /* used for transposing */ 7004 dcl holdatrue fixed bin; /* used for conditional stack */ 7005 declare cop_c_bits bit (16) based (c_ptr); 7006 7007 /* arithemetic stack */ 7008 7009 dcl cssub fixed bin static; /* conditional stack subscript */ 7010 dcl TAG fixed bin; 7011 dcl c_ptr ptr; /*[4.4-2]*/ 7012 dcl (lognot, last_wd_per, LTP) 7013 bit (1); 7014 dcl assub fixed bin static; /* arithemetic stack subscript */ 7015 dcl tempkey fixed bin; /* used to hold res word key */ 7016 dcl itemsize1 char (512) based; /*length in bytes of based current record*/ 7017 dcl savidsize char (512) based; /* length in bytes of saved identifier record */ 7018 dcl opeosptr ptr; /* pointer for operation eos */ 7019 dcl litcnt fixed bin; /* used for size of numeric literal */ 7020 dcl daptr ptr; /* pointer for dummy alter verb */ 7021 dcl saveos char (44); /* used to save eos record */ 7022 dcl end_stmt_chars char (44) based (es_ptr); /* used for eos record */ 7023 dcl savoccptr fixed bin; /* used to save offset of occurs extension */ 7024 /* used to save the subscript count */ 7025 dcl subcnt fixed bin; 7026 dcl decswitch fixed bin static; /* if prog has sectons */ 7027 dcl secswitch fixed bin static; /* used for sections */ 7028 /* used for debugging sections */ 7029 dcl debugsw fixed bin static; 7030 dcl curmax fixed bin; /* upper bound of current type 9 item */ 7031 dcl savmax fixed bin; /* upper bound plus one of saved type 9 item */ 7032 /* above used for overlapping */ 7033 /* used for diagnostics in note routine */ 7034 dcl diagno fixed bin static; 7035 dcl srtrngptr ptr; /* used for sort range chain */ 7036 /* an entry in sor range chain*/ 7037 dcl 01 srtrng based (srtrngptr), 7038 02 sptr char (5), /* points to next entry */ 7039 02 sstart fixed bin, /* start section number of sort range */ 7040 02 s_start char (30), 7041 02 sstop fixed bin, /* stop section number of sort range */ 7042 02 s_stop char (30), 7043 02 savsecnum fixed bin, /* save current section number */ 7044 02 srtfilno fixed bin, /* associated sort file number */ 7045 02 s_srtfilename char (30), 7046 02 sio bit (1), /* input output indicator 0=in 1=out */ 7047 02 srel bit (1), /* release fond within range */ 7048 02 sret bit (1); /* return found within range */ 7049 7050 dcl cursecnum fixed bin static; /* save current section number */ 7051 /* this routine is the interpreter for the pd syntax */ 7052 /* label arrays */ 7053 7054 7055 /* syntax line work area */ 7056 dcl cobol_c_list entry (ptr) ext; /* cal.led to print sources and diags */ 7057 dcl (pp, id_loc) ptr; 7058 dcl x bit (8) based; /* length of one line in syntax table */ 7059 dcl bit18 bit (18) based; /* used for eos record */ 7060 7061 declare 1 interp, 7062 2 current_line fixed bin (24), 7063 2 phase fixed bin (24), 7064 2 addr_record ptr, 7065 2 pointer_to_internal 7066 ptr, 7067 2 directory_ptr ptr, 7068 2 source_ptr ptr; 7069 7070 /* the following dcls are used in conjunction with the syntax table subroutines */ 7071 /* the current nested limit is 75 */ 7072 declare intrp_stack (75) fixed bin (24), /* used for syntax subroutine */ 7073 i1 fixed bin static; /* syntax table */ 7074 dcl p ptr; 7075 declare trace_ptr ptr; 7076 dcl dumfix fixed bin; 7077 dcl tempchar1 char (1); 7078 7079 declare 1 syntax_table (0:10000) based (pointer_to_internal), 7080 2 b1 fixed bin, 7081 2 b2 fixed bin, 7082 2 b3 fixed bin, 7083 2 b4 fixed bin, 7084 2 b5 fixed bin; 7085 7086 declare 1 syntax_line based (syntax_line_ptr), 7087 2 s_bit char (1), 7088 2 o_bit char (1), 7089 2 t_type fixed bin, 7090 2 t_field fixed bin, 7091 2 s_exit fixed bin, 7092 2 a_num fixed bin; 7093 7094 declare syntax_line_ptr ptr; 7095 7096 declare 1 sline, 7097 2 s_bit char (1), 7098 2 o_bit char (1), 7099 2 t_type fixed bin, 7100 2 t_field fixed bin, 7101 2 s_exit fixed bin, 7102 2 a_num fixed bin; 7103 7104 /*[5.3-2]*/ 7105 declare (ii, key_count, file_count) 7106 fixed bin; 7107 7108 7109 declare 1 header, 7110 2 size fixed bin, 7111 2 line fixed bin, 7112 2 column fixed bin, 7113 2 type fixed bin, 7114 2 body char (2000); 7115 7116 dcl 1 message based (addr_record), /* 2 header */ 7117 02 size fixed bin, 7118 02 line fixed bin, 7119 02 column fixed bin, 7120 02 type fixed bin, 7121 02 run fixed bin, /* phase no issuing diagnostic for pd it is */ 7122 /* 2 body */ 7123 02 number fixed bin, 7124 02 info bit (15), /* bit1 means parameter to be inserted */ 7125 02 rep_bit bit (15), /* bit2 maans token has been replaced */ 7126 02 infoa bit (6), 7127 02 length fixed bin, 7128 02 body char (message.length); 7129 7130 7131 dcl 01 source based (addr_record), /* 2 header */ 7132 02 size fixed bin, 7133 02 line fixed bin, 7134 02 column fixed bin, 7135 02 type fixed bin, /* 2 body */ 7136 02 info bit (8), 7137 02 length fixed bin, 7138 02 image char (source.length); 7139 7140 dcl 01 satoken based (addr_record), /* 2 header */ 7141 03 size fixed bin, 7142 02 line fixed bin, 7143 02 column fixed bin, 7144 02 type fixed bin, /* 2 body */ 7145 02 stringptr ptr, 7146 02 defline fixed bin, 7147 02 address bit (32), 7148 02 sanum fixed bin, 7149 02 numrecs fixed bin, 7150 02 minchars fixed bin, 7151 02 maxchars fixed bin, 7152 02 namesize fixed bin, 7153 02 name char (30); 7154 7155 declare eosptr ptr; 7156 7157 /* based area to get pointer */ 7158 dcl 01 headerb based (mptr), 7159 02 size fixed bin, 7160 02 line fixed bin, 7161 02 column fixed bin, 7162 02 type fixed bin, 7163 02 body char (header.size - 16); /* general form of internal record */ 7164 /* current word buffer */ 7165 /* used for i-o operations */ 7166 dcl seq fixed bin static; 7167 dcl mptr ptr; /* points to record of input minpral file */ 7168 dcl input fixed bin static; 7169 dcl rewind fixed bin static; 7170 dcl output fixed bin static; 7171 7172 dcl itemsize char (512) based; /*length in bytes of current record */ 7173 dcl savitmptr ptr; /* a dummy procedure name reference type 18 used for go to action 49 */ 7174 /* pointer for dummy procedure name */ 7175 dcl dpnptr ptr; /* pointer for dummy procedure name */ 7176 /* used to save the item for ident subrouttines */ 7177 7178 declare 1 saveident static internal, 7179 2 size fixed bin, 7180 2 line fixed bin, 7181 2 column fixed bin, 7182 2 type fixed bin, 7183 2 body char (430); 7184 7185 dcl savidptr ptr; /* pointer for saved identifier */ 7186 /* used to reference the extensions of type 9 records */ 7187 dcl exten (430) char (1) based; 7188 dcl occptr ptr; /* used to reference the subscript extension of type 9 */ 7189 7190 /* save the SORTFILE RECORD here */ 7191 7192 dcl 01 sv_srtfil_rec static internal, /* header */ 7193 2 size fixed bin, 7194 2 body char (300); 7195 7196 /* temp patch*/ 7197 dcl convtemp fixed bin; 7198 dcl histno fixed bin; /* used for IO verbs */ 7199 7200 /* save procedure definition from sort statement here */ 7201 7202 dcl 01 sv_proc_def static internal, 7203 2 size fixed bin, 7204 2 body char (300); 7205 7206 /* save the FILE after USING or GIVING in SORT statement here */ 7207 7208 dcl 01 sv_usfil static internal, /* header */ 7209 2 size fixed bin, 7210 2 body char (300); 7211 7212 /* save the generated tag number here */ 7213 7214 dcl save_gentag fixed bin; 7215 dcl seqvarptr ptr; 7216 dcl seqvarleng fixed bin; 7217 dcl varrecaddr char (5); 7218 declare repcsbit bit (1); 7219 7220 declare cobol_pdst entry (ptr, fixed bin) ext; 7221 7222 7223 7224 dcl c26 char (28) based; /* used to move perform range entry */ 7225 7226 dcl fb26 fixed bin static init (28); /* used to write perform range entry */ 7227 7228 dcl convalue fixed bin static init (48); /* used for range check in set verb */ 7229 7230 7231 dcl 01 line static internal, 7232 02 scan_bit char (1), 7233 02 output_bit char (1), 7234 02 test_type fixed bin, 7235 02 test_field fixed bin, 7236 02 success_exit fixed bin, 7237 02 action_number fixed bin; 7238 7239 declare 1 saveitem static internal, 7240 2 size fixed bin, 7241 2 line fixed bin, 7242 2 column fixed bin, 7243 2 type fixed bin, 7244 2 boby char (512); 7245 7246 /*[4.4-5]*/ 7247 declare eos_perform_ptr ptr, 7248 eos_perform_size fixed bin init (40); 7249 7250 /*[4.4-5]*/ 7251 declare 1 eos_perform, /*[4.4-5]*/ 7252 2 size fixed bin init (40), /*[4.4-5]*/ 7253 2 line fixed bin init (0), /*[4.4-5]*/ 7254 2 column fixed bin init (0), /*[4.4-5]*/ 7255 2 type fixed bin init (19), /*[4.4-5]*/ 7256 2 verb fixed bin init (20), /*[4.4-5]*/ 7257 2 e fixed bin init (0), /*[4.4-5]*/ 7258 2 h fixed bin init (0), /*[4.4-5]*/ 7259 2 i fixed bin init (0), /*[4.4-5]*/ 7260 2 j fixed bin init (0), /*[4.4-5]*/ 7261 2 status bit (36) init ("0"b); 7262 7263 /*[4.4-5]*/ 7264 declare rw_perform_ptr ptr, 7265 rw_perform_size fixed bin init (28); 7266 7267 /*[4.4-5]*/ 7268 declare 1 rw_perform, /*[4.4-5]*/ 7269 2 size fixed bin init (28), /*[4.4-5]*/ 7270 2 line fixed bin init (0), /*[4.4-5]*/ 7271 2 column fixed bin init (0), /*[4.4-5]*/ 7272 2 type fixed bin init (1), /*[4.4-5]*/ 7273 2 key fixed bin init (20), /*[4.4-5]*/ 7274 2 status bit (36) init ("10010010000000001"b), 7275 /*[4.4-5]*/ 7276 2 jmp_ndx fixed bin init (0); 7277 7278 /*[5.2-1]*/ 7279 dcl rw_move_ptr ptr, 7280 rw_move_size fixed bin init (28); 7281 7282 /*[5.2-1]*/ 7283 dcl 1 rw_move, /*[5.2-1]*/ 7284 2 size fixed bin init (28), /*[5.2-1]*/ 7285 2 line fixed bin init (0), /*[5.2-1]*/ 7286 2 column fixed bin init (0), /*[5.2-1]*/ 7287 2 type fixed bin init (1), /*[5.2-1]*/ 7288 2 key fixed bin init (18), /*[5.2-1]*/ 7289 2 status bit (36) init ("10010010000000001"b), 7290 /*[5.2-1]*/ 7291 2 jmp_ndx fixed bin init (0); 7292 7293 /*[5.2-1]*/ 7294 dcl supp_lit_ptr ptr, 7295 supp_lit_size fixed bin init (37); 7296 7297 /*[5.2-1]*/ 7298 dcl 1 supp_lit, /*[5.2-1]*/ 7299 2 size fixed bin init (37), /*[5.2-1]*/ 7300 2 line fixed bin init (0), /*[5.2-1]*/ 7301 2 column fixed bin init (0), /*[5.2-1]*/ 7302 2 type fixed bin init (2), /*[5.2-1]*/ 7303 2 lit_type bit (36) init ("1000000000001000000001"b), 7304 /*[5.2-1]*/ 7305 2 exp_places fixed bin init (0), /*[5.2-1]*/ 7306 2 places_left fixed bin init (1), /*[5.2-1]*/ 7307 2 places_right fixed bin init (0), /*[5.2-1]*/ 7308 2 places fixed bin init (1), /*[5.2-1]*/ 7309 2 literal char (1) init ("1"); 7310 7311 /*[5.2-1]*/ 7312 dcl eos_move_ptr ptr, 7313 eos_move_size fixed bin init (40); 7314 7315 /*[5.2-1]*/ 7316 dcl 1 eos_move, /*[5.2-1]*/ 7317 2 size fixed bin init (40), /*[5.2-1]*/ 7318 2 line fixed bin init (0), /*[5.2-1]*/ 7319 2 column fixed bin init (0), /*[5.2-1]*/ 7320 2 type fixed bin init (19), /*[5.2-1]*/ 7321 2 verb fixed bin init (18), /*[5.2-1]*/ 7322 2 e fixed bin init (0), /*[5.2-1]*/ 7323 2 h fixed bin init (0), /*[5.2-1]*/ 7324 2 i fixed bin init (0), /*[5.2-1]*/ 7325 2 j fixed bin init (0), /*[5.2-1]*/ 7326 2 status bit (36) init ("0"b); 7327 1 1 1 2 /* BEGIN INCLUDE FILE ... cobol_ext_.incl.pl1 */ 1 3 /* Last modified on 06/17/76 by ORN */ 1 4 /* Last modified on 12/28/76 by FCH */ 1 5 /* Last modified on 12/01/80 by FCH */ 1 6 1 7 /* <<< SHARED EXTERNALS INCLUDE FILE >>> */ 1 8 1 9 1 10 dcl cobol_ext_$cobol_afp ptr ext; 1 11 dcl cobol_afp ptr defined ( cobol_ext_$cobol_afp); 1 12 dcl cobol_ext_$cobol_analin_fileno ptr ext; 1 13 dcl cobol_analin_fileno ptr defined ( cobol_ext_$cobol_analin_fileno); 1 14 dcl cobol_ext_$report_first_token ptr ext; 1 15 dcl report_first_token ptr defined( cobol_ext_$report_first_token); 1 16 dcl cobol_ext_$report_last_token ptr ext; 1 17 dcl report_last_token ptr defined ( cobol_ext_$report_last_token); 1 18 dcl cobol_ext_$cobol_eltp ptr ext; 1 19 dcl cobol_eltp ptr defined ( cobol_ext_$cobol_eltp); 1 20 dcl cobol_ext_$cobol_cmfp ptr ext; 1 21 dcl cobol_cmfp ptr defined ( cobol_ext_$cobol_cmfp); 1 22 dcl cobol_ext_$cobol_com_fileno ptr ext; 1 23 dcl cobol_com_fileno ptr defined ( cobol_ext_$cobol_com_fileno); 1 24 dcl cobol_ext_$cobol_com_ptr ptr ext; 1 25 dcl cobol_com_ptr ptr defined ( cobol_ext_$cobol_com_ptr); 1 26 dcl cobol_ext_$cobol_dfp ptr ext; 1 27 dcl cobol_dfp ptr defined ( cobol_ext_$cobol_dfp); 1 28 dcl cobol_ext_$cobol_hfp ptr ext; 1 29 dcl cobol_hfp ptr defined ( cobol_ext_$cobol_hfp); 1 30 dcl cobol_ext_$cobol_m1fp ptr ext; 1 31 dcl cobol_m1fp ptr defined ( cobol_ext_$cobol_m1fp); 1 32 dcl cobol_ext_$cobol_m2fp ptr ext; 1 33 dcl cobol_m2fp ptr defined ( cobol_ext_$cobol_m2fp); 1 34 dcl cobol_ext_$cobol_min1_fileno ptr ext; 1 35 dcl cobol_min1_fileno ptr defined ( cobol_ext_$cobol_min1_fileno); 1 36 dcl cobol_ext_$cobol_min2_fileno_ptr ptr ext; 1 37 dcl cobol_min2_fileno_ptr ptr defined ( cobol_ext_$cobol_min2_fileno_ptr); 1 38 dcl cobol_ext_$cobol_name_fileno ptr ext; 1 39 dcl cobol_name_fileno ptr defined ( cobol_ext_$cobol_name_fileno); 1 40 dcl cobol_ext_$cobol_name_fileno_ptr ptr ext; 1 41 dcl cobol_name_fileno_ptr ptr defined ( cobol_ext_$cobol_name_fileno_ptr); 1 42 dcl cobol_ext_$cobol_ntfp ptr ext; 1 43 dcl cobol_ntfp ptr defined ( cobol_ext_$cobol_ntfp); 1 44 dcl cobol_ext_$cobol_pdofp ptr ext; 1 45 dcl cobol_pdofp ptr defined ( cobol_ext_$cobol_pdofp); 1 46 dcl cobol_ext_$cobol_pfp ptr ext; 1 47 dcl cobol_pfp ptr defined ( cobol_ext_$cobol_pfp); 1 48 dcl cobol_ext_$cobol_rm2fp ptr ext; 1 49 dcl cobol_rm2fp ptr defined ( cobol_ext_$cobol_rm2fp); 1 50 dcl cobol_ext_$cobol_rmin2fp ptr ext; 1 51 dcl cobol_rmin2fp ptr defined ( cobol_ext_$cobol_rmin2fp); 1 52 dcl cobol_ext_$cobol_curr_in ptr ext; 1 53 dcl cobol_curr_in ptr defined ( cobol_ext_$cobol_curr_in); 1 54 dcl cobol_ext_$cobol_curr_out ptr ext; 1 55 dcl cobol_curr_out ptr defined ( cobol_ext_$cobol_curr_out); 1 56 dcl cobol_ext_$cobol_sfp ptr ext; 1 57 dcl cobol_sfp ptr defined ( cobol_ext_$cobol_sfp); 1 58 dcl cobol_ext_$cobol_w1p ptr ext; 1 59 dcl cobol_w1p ptr defined ( cobol_ext_$cobol_w1p); 1 60 dcl cobol_ext_$cobol_w2p ptr ext; 1 61 dcl cobol_w2p ptr defined ( cobol_ext_$cobol_w2p); 1 62 dcl cobol_ext_$cobol_w3p ptr ext; 1 63 dcl cobol_w3p ptr defined ( cobol_ext_$cobol_w3p); 1 64 dcl cobol_ext_$cobol_w5p ptr ext; 1 65 dcl cobol_w5p ptr defined ( cobol_ext_$cobol_w5p); 1 66 dcl cobol_ext_$cobol_w6p ptr ext; 1 67 dcl cobol_w6p ptr defined ( cobol_ext_$cobol_w6p); 1 68 dcl cobol_ext_$cobol_w7p ptr ext; 1 69 dcl cobol_w7p ptr defined ( cobol_ext_$cobol_w7p); 1 70 dcl cobol_ext_$cobol_x3fp ptr ext; 1 71 dcl cobol_x3fp ptr defined ( cobol_ext_$cobol_x3fp); 1 72 dcl cobol_ext_$cobol_rwdd ptr ext; 1 73 dcl cobol_rwdd ptr defined(cobol_ext_$cobol_rwdd); 1 74 dcl cobol_ext_$cobol_rwpd ptr ext; 1 75 dcl cobol_rwpd ptr defined(cobol_ext_$cobol_rwpd); 1 76 1 77 1 78 dcl cobol_ext_$cobol_fileno1 fixed bin(24)ext; 1 79 dcl cobol_fileno1 fixed bin(24)defined ( cobol_ext_$cobol_fileno1); 1 80 dcl cobol_ext_$cobol_options_len fixed bin(24)ext; 1 81 dcl cobol_options_len fixed bin(24)defined ( cobol_ext_$cobol_options_len); 1 82 dcl cobol_ext_$cobol_pdout_fileno fixed bin(24)ext; 1 83 dcl cobol_pdout_fileno fixed bin(24)defined ( cobol_ext_$cobol_pdout_fileno); 1 84 dcl cobol_ext_$cobol_print_fileno fixed bin(24)ext; 1 85 dcl cobol_print_fileno fixed bin(24)defined ( cobol_ext_$cobol_print_fileno); 1 86 dcl cobol_ext_$cobol_rmin2_fileno fixed bin(24)ext; 1 87 dcl cobol_rmin2_fileno fixed bin(24)defined ( cobol_ext_$cobol_rmin2_fileno); 1 88 dcl cobol_ext_$cobol_x1_fileno fixed bin(24)ext; 1 89 dcl cobol_x1_fileno fixed bin(24)defined ( cobol_ext_$cobol_x1_fileno); 1 90 dcl cobol_ext_$cobol_x2_fileno fixed bin(24)ext; 1 91 dcl cobol_x2_fileno fixed bin(24)defined ( cobol_ext_$cobol_x2_fileno); 1 92 dcl cobol_ext_$cobol_x3_fileno fixed bin(24)ext; 1 93 dcl cobol_x3_fileno fixed bin(24)defined ( cobol_ext_$cobol_x3_fileno); 1 94 1 95 dcl cobol_ext_$cobol_lpr char (5) ext; 1 96 dcl cobol_lpr char (5) defined ( cobol_ext_$cobol_lpr); /* -2- */ 1 97 dcl cobol_ext_$cobol_options char (120) ext; 1 98 dcl cobol_options char (120) defined ( cobol_ext_$cobol_options); /* -30- */ 1 99 1 100 dcl cobol_ext_$cobol_xlast8 bit (1) ext; 1 101 dcl cobol_xlast8 bit (1) defined ( cobol_ext_$cobol_xlast8); /* -1- */ 1 102 dcl cobol_ext_$report_exists bit (1) ext; 1 103 dcl report_exists bit (1) defined ( cobol_ext_$report_exists); 1 104 1 105 1 106 /* <<< END OF SHARED EXTERNALS INCLUDE FILE >>> */ 1 107 /* END INCLUDE FILE ... cobol_ext_.incl.pl1 */ 1 108 7328 7329 7330 7331 /* the following is a description of common*/ 7332 2 1 2 2 /* BEGIN INCLUDE FILE ... cobol_fixed_common.incl.pl1 */ 2 3 /* Modified on 10/27/82 by FCH, [5.1-1], cobol_cln added to save last line num, BUG543(phx13643) */ 2 4 /* Modified on 07/31/80 by FCH, [4.3-1], use_reporting field added for Report Writer */ 2 5 /* Modified on 03/30/79 by FCH, [4.1-1], -card option added */ 2 6 /* Modified on 03/30/79 by FCH, [4.0-2], -svNM option added */ 2 7 /* Modified on 03/02/79 by FCH, [4.0-1], -levNM option added */ 2 8 /* Modified by RAL on 10/13/78, [4.0-0], Added option exp from fil2. */ 2 9 /* Modified by BC on 06/20/77, descriptor added. */ 2 10 /* Modified by BC on 06/02/77, init_cd_seg, init_cd_offset added. */ 2 11 /* Modified by BC on 1/21/77, options.profile added. */ 2 12 /* Modified by FCH on 7/6/76, sysin_fno & sysout_fno deleted, accept_device & display_device added */ 2 13 /* Modified by FCH on 5/20/77, comp_level added */ 2 14 2 15 2 16 /* THE SIZE OF THIS STRUCTURE IN BYTES, (EXCLUDING VARIABLE 2 17* LENGTH ENTITIES), FOR EACH HARDWARE IMPLEMENTATION IS: 2 18* 2 19* HARDWARE | SIZE (BYTES) 2 20* --------------------------------- 2 21* 645/6180 | 464 2 22* P7 | 396 2 23* --------------------------------- 2 24* */ 2 25 2 26 dcl 1 fixed_common based ( cobol_com_ptr), 2 27 2 prog_name char (30), 2 28 2 compiler_rev_no char (25), 2 29 2 phase_name char (6), 2 30 2 currency char (1), 2 31 2 fatal_no fixed bin, 2 32 2 warn_no fixed bin, 2 33 2 proc_counter fixed bin, 2 34 2 spec_tag_counter fixed bin, 2 35 2 file_count fixed bin, 2 36 2 filedescr_offsets (20) char (5), 2 37 2 perf_alter_info char (5), 2 38 2 another_perform_info char (5), 2 39 2 sort_in_info char (5), 2 40 2 odo_info char (5), 2 41 2 size_seg fixed bin, 2 42 2 size_offset fixed bin(24), 2 43 2 size_perform_info char (5), 2 44 2 rename_info char (5), 2 45 2 report_names char (5), 2 46 2 rw_buf_seg fixed bin, 2 47 2 rw_buf_offset fixed bin(24), 2 48 2 rw_buf_length fixed bin(24), 2 49 2 file_keys char (5), 2 50 2 search_keys char (5), 2 51 2 dd_seg_size fixed bin(24), 2 52 2 pd_seg_size fixed bin(24), 2 53 2 seg_limit fixed bin , 2 54 2 number_of_dd_segs fixed bin, 2 55 2 seg_info char (5), 2 56 2 number_of_ls_pointers fixed bin, 2 57 2 link_sec_seg fixed bin, 2 58 2 link_sec_offset fixed bin(24), 2 59 2 sra_clauses fixed bin, 2 60 2 fix_up_info char (5), 2 61 2 linage_info char (5), 2 62 2 first_dd_item char (5), 2 63 2 sort_out_info char (5), 2 64 2 db_info char (5), 2 65 2 realm_info char (5), 2 66 2 rc_realm_info char (5), 2 67 2 last_file_key char (5), 2 68 2 prog_coll_seq fixed bin, 2 69 2 init_cd_seg fixed bin, 2 70 2 init_cd_offset fixed bin(24), 2 71 2 input_error_exit fixed bin, 2 72 2 output_error_exit fixed bin, 2 73 2 i_o_error_exit fixed bin, 2 74 2 extend_error_exit fixed bin, 2 75 2 dummy15 fixed bin, 2 76 2 options, 2 77 3 cu bit (1), 2 78 3 st bit (1), 2 79 3 wn bit (1), 2 80 3 obs bit (1), 2 81 3 dm bit (1), 2 82 3 xrl bit (1), 2 83 3 xrn bit (1), 2 84 3 src bit (1), 2 85 3 obj bit (1), 2 86 3 exs bit (1), 2 87 3 sck bit (1), 2 88 3 rno bit (1), 2 89 3 u_l bit (1), 2 90 3 cnv bit (1), 2 91 3 cos bit (1), 2 92 3 fmt bit (1), 2 93 3 profile bit(1), 2 94 3 nw bit (1), 2 95 3 exp bit (1), /* [4.0-0] */ 2 96 3 card bit (1), /*[4.1-1]*/ 2 97 3 fil2 bit (5), 2 98 3 m_map bit (1), 2 99 3 m_bf bit (1), 2 100 3 m_fat bit (1), 2 101 3 m_wn bit (1), 2 102 3 m_obs bit(1), 2 103 3 pd bit(1), 2 104 3 oc bit(1), 2 105 2 supervisor bit (1), 2 106 2 dec_comma bit (1), 2 107 2 init_cd bit (1), 2 108 2 corr bit (1), 2 109 2 initl bit (1), 2 110 2 debug bit (1), 2 111 2 report bit (1), 2 112 2 sync_in_prog bit (1), 2 113 2 pd_section bit (1), 2 114 2 list_switch bit (1), 2 115 2 alpha_cond bit (1), 2 116 2 num_cond bit (1), 2 117 2 spec_sysin bit (1), 2 118 2 spec_sysout bit (1), 2 119 2 cpl_files bit (1), 2 120 2 obj_dec_comma bit (1), 2 121 2 default_sign_type bit (3), 2 122 2 use_debug bit(1), 2 123 2 syntax_trace bit(1), 2 124 2 comp_defaults, 2 125 3 comp bit(1), 2 126 3 comp_1 bit(1), 2 127 3 comp_2 bit(1), 2 128 3 comp_3 bit(1), 2 129 3 comp_4 bit(1), 2 130 3 comp_5 bit(1), 2 131 3 comp_6 bit(1), 2 132 3 comp_7 bit(1), 2 133 3 comp_8 bit(1), 2 134 2 disp_defaults, 2 135 3 disp bit(1), 2 136 3 disp_1 bit(1), 2 137 3 disp_2 bit(1), 2 138 3 disp_3 bit(1), 2 139 3 disp_4 bit(1), 2 140 3 disp_5 bit(1), 2 141 3 disp_6 bit(1), 2 142 3 disp_7 bit(1), 2 143 2 descriptor bit(2), 2 144 2 levsv bit(3), /*[4.0-1]*/ 2 145 2 use_reporting bit(1), /*[4.3-1]*/ 2 146 2 cd bit(1), /*[4.4-1]*/ 2 147 2 dummy17 bit(3), 2 148 2 lvl_rstr bit(32), 2 149 2 inst_rstr bit(32), 2 150 2 comp_level char(1), 2 151 2 dummy18 char(30), 2 152 2 object_sign char (1), 2 153 2 last_print_rec char (5), 2 154 2 coll_seq_info char (5), 2 155 2 sys_status_seg fixed bin, 2 156 2 sys_status_offset fixed bin(24), 2 157 2 compiler_id fixed bin, 2 158 2 date_comp_ln fixed bin, 2 159 2 compile_mode bit(36), 2 160 2 default_temp fixed bin, 2 161 2 accept_device fixed bin, 2 162 2 display_device fixed bin, 2 163 2 cobol_cln fixed bin, /*[5.1-1]*/ 2 164 2 alphabet_offset fixed bin; 2 165 2 166 2 167 2 168 /* END INCLUDE FILE ... cobol_fixed_common.incl.pl1 */ 2 169 7333 7334 7335 7336 /* the layout of a file table */ 7337 7338 3 1 3 2 /* BEGIN INCLUDE FILE ... cobol_file_table.incl.pl1 */ 3 3 /* <<< INCLUDE FILE FOR FILE TABLE IN COMMON >>> */ 3 4 3 5 /* Modified on 09/30/80 by FCH, [4.4-1], density is 6250 is supported */ 3 6 /* Modified on 12/05/78 by RAL, [3.0-3], added dupl_alt from dummy102 */ 3 7 /* Modified on 11/21/78 by RAL, [3.0-2], added space for abs_record_offset from filler */ 3 8 /* Modified on 10/26/78 by RAL, [3.0-1], added space for file_desc_1 table offset from filler */ 3 9 /* <<< LAST MODIFIED ON 06-02-77 by GM >>> */ 3 10 /* <<< LAST MODIFIED ON 05-31-77 by GM >>> */ 3 11 /* <<< LAST MODIFIED ON 06-30-76 by GM >>> */ 3 12 /* <<< LAST MODIFIED ON 06-07-76 by GM >>> */ 3 13 /* <<< LAST MODIFIED ON 11-29-74 by orn >>> */ 3 14 3 15 /* 3 16*A file table is created in variable common for each file selected in the 3 17*environment division. The fields of a given file table provide information 3 18*about the specific file for which the file table is generated. The 3 19*addresses which may be contained in the various "info" fields of the file 3 20*table are addresses in variable common. 3 21**/ 3 22 3 23 /* THE FILE TABLE STRUCTURE */ 3 24 3 25 dcl 1 file_table based (ft_ptr), 3 26 2 next char (5), 3 27 2 ifn char (16), 3 28 2 attach_options_info char(5), /*06/02/77*/ 3 29 2 replacement_info char(5), /*06/02/77*/ 3 30 2 file_id_info char(5), /*05/31/77*/ 3 31 2 retention_info char(5), /*05/31/77*/ 3 32 2 filler0 char (3) , /* [3.0-1] */ 3 33 2 file_desc_1_offset fixed bin (24), /* [3.0-1] */ 3 34 2 abs_record_offset fixed bin (24), /* [3.-02] */ 3 35 2 filler char(5), /* this area is available.*/ 3 36 2 padding_char char (1), 3 37 2 banner_char char (1), 3 38 2 file_status_info char (5), 3 39 2 extra_status_info char (5), 3 40 2 cat_id_info char (5), 3 41 2 r_key_info char (5), 3 42 2 alt_key_info char (5), 3 43 2 rec_do_info char (5), 3 44 2 label_info char (5), 3 45 2 data_info char (5), 3 46 2 report_info char (5), 3 47 2 linage_info char (5), 3 48 2 optional bit (1), /*06/07/76*/ 3 49 2 external bit (1), 3 50 2 file_status bit (1), 3 51 2 extra_status bit (1), 3 52 2 sysin bit (1), 3 53 2 sysout bit (1), 3 54 2 move_mode bit (1), 3 55 2 locate_mode bit (1), 3 56 2 fixed_recs bit (1), 3 57 2 variable_recs bit (1), 3 58 2 spanned_recs bit (1), /*06/07/76*/ 3 59 2 interchange bit (1), /*06/07/76*/ 3 60 2 relative_key bit (1), 3 61 2 record_key bit (1), 3 62 2 even_parity bit (1), 3 63 2 odd_parity bit (1), 3 64 2 padding bit (1), 3 65 2 banner bit (1), 3 66 2 random bit (1), 3 67 2 no_file_lockout bit (1), 3 68 2 no_write_check bit (1), 3 69 2 no_resident_index bit (1), 3 70 2 same_file bit (1), 3 71 2 sort_file bit (1), 3 72 2 rec_do bit (1), 3 73 2 linage bit (1), 3 74 2 code_set_clause bit (1), 3 75 /* history */ 3 76 2 close bit (1), 3 77 2 delete bit (1), 3 78 2 open_in bit (1), 3 79 2 open_out bit (1), 3 80 2 open_io bit (1), 3 81 2 open_ext bit (1), 3 82 2 read bit (1), 3 83 2 release bit (1), 3 84 2 return_bit bit (1), 3 85 2 rewrite bit (1), 3 86 2 sort bit (1), 3 87 2 start bit (1), 3 88 2 use_error bit (1), 3 89 2 write bit (1), 3 90 2 read_next bit (1), 3 91 2 read_key bit (1), 3 92 2 accept bit (1), 3 93 2 display bit (1), 3 94 2 unequal_recs bit (1), 3 95 2 dummy_sysin bit (1), 3 96 2 dummy_sysout bit (1), 3 97 2 file_no fixed bin, 3 98 2 uca_offset fixed bin(24), 3 99 2 cra_seg fixed bin, 3 100 2 cra_offset fixed bin(24), 3 101 2 max_cra_size fixed bin(24), 3 102 2 catalogued fixed bin, 3 103 2 organization fixed bin, 3 104 2 org_qual fixed bin, 3 105 2 access fixed bin, 3 106 2 buffers fixed bin, 3 107 2 device fixed bin, 3 108 2 record_prefix fixed bin, /*06/07/76*/ 3 109 2 alternate_keys fixed bin, 3 110 2 record_format fixed bin, 3 111 2 label_format fixed bin, 3 112 2 key_location fixed bin, 3 113 2 key_size fixed bin, 3 114 2 temporary fixed bin, 3 115 2 address_format fixed bin, 3 116 2 same_area_clause fixed bin, 3 117 2 same_rec_clause fixed bin, 3 118 2 same_sort_clause fixed bin, 3 119 2 mult_clause_no fixed bin, 3 120 2 mult_position_no fixed bin, 3 121 2 block_desc fixed bin, 3 122 2 block_min fixed bin(24), 3 123 2 block_max fixed bin(24), 3 124 2 rec_min fixed bin(24), 3 125 2 rec_max fixed bin(24), 3 126 2 label_count fixed bin, 3 127 2 ifn_size fixed bin, 3 128 2 data_count fixed bin, 3 129 2 report_count fixed bin, 3 130 2 code_set fixed bin, 3 131 2 error_exit fixed bin, 3 132 2 prefix_size fixed bin, 3 133 2 blocked bit (1), 3 134 2 variable bit (1), 3 135 2 unbannered bit (1), 3 136 2 prefix_clause bit (1), 3 137 2 symbolic bit (1), 3 138 2 address_format_bit bit (1), 3 139 2 bsn bit(1), /*06/07/76*/ 3 140 2 process_area bit(1), /*06/07/76*/ 3 141 2 dupl_alt bit (1), /* [3.0-3] */ 3 142 2 dummy102 bit (23), 3 143 2 name_size fixed bin, 3 144 2 name char(32), 3 145 2 id char(32), 3 146 2 temp bit(1) , 3 147 2 perm bit(1) , 3 148 2 attach bit(1) , 3 149 2 detach bit(1) , 3 150 2 fsb , /* file state block */ 3 151 3 seg fixed bin(24), /* internal addr */ 3 152 3 off fixed bin(24), 3 153 2 tape, 3 154 3 density bit(1) , /* 0-hi 1-lo */ 3 155 3 retain bit(1), /* 0 not retained across attachment, 1 retained */ 3 156 3 force bit(1), /* 0 check retention date, 1 no check */ 3 157 3 protect bit(1) , /* 0-no 1-yes */ 3 158 3 den_6250 bit(1), /* 0-no 1-yes */ /*[4.4-1]*/ 3 159 2 cat_nm char(200), 3 160 2 ao_len fixed bin(24), /* attach options */ 3 161 2 ao_string char(256), 3 162 2 output_mode fixed bin, /* 0 not specified 3 163* 1 generation 3 164* 2 modification 3 165* 3 replacement literal 3 166* 4 replacement dataname */ 3 167 2 om_len fixed bin, /* length of output mode */ 3 168 2 om_string char(17), 3 169 2 tape_device fixed bin, /* 0 not specified 3 170* 1 integer 3 171* 2 dataname */ 3 172 2 tape_device_num fixed bin, 3 173 2 tape_device_key char(5), 3 174 2 add_cat_key char(5); 3 175 3 176 3 177 /* END INCLUDE FILE ... cobol_file_table.incl.pl1 */ 3 178 7339 4 1 4 2 /* BEGIN INCLUDE FILE ... cobol_diag_file.incl.pl1 */ 4 3 /* Last modified on 06/18/76 by ORN */ 4 4 4 5 /* This include file serves as a template for the file 4 6* (segment) containg MCOBOL diagnostic messages: 4 7* cobol_diag_table_$cobol_diag_table_ */ 4 8 4 9 dcl 1 diag_file based(cobol_$diag_ptr), 4 10 2 r_t_size fixed bin, 4 11 2 d_t_size fixed bin, 4 12 2 d_s_size fixed bin, 4 13 2 run_table (11), 4 14 3 base fixed bin, 4 15 3 size fixed bin, 4 16 2 diag_table(0 refer(diag_file.d_t_size)), 4 17 3 d_start fixed bin, 4 18 3 d_len fixed bin, 4 19 3 d_type fixed bin, 4 20 3 d_param fixed bin; 4 21 4 22 /* END INCLUDE FILE ... cobol_diag_file.incl.pl1 */ 4 23 7340 5 1 5 2 /* BEGIN INCLUDE FILE ... cobol_.incl.pl1 */ 5 3 /* last modified Feb 4, 1977 by ORN */ 5 4 5 5 /* This file defines all external data used in the generator phase of Multics Cobol */ 5 6 5 7 /* POINTERS */ 5 8 dcl cobol_$text_base_ptr ptr ext; 5 9 dcl text_base_ptr ptr defined (cobol_$text_base_ptr); 5 10 dcl cobol_$con_end_ptr ptr ext; 5 11 dcl con_end_ptr ptr defined (cobol_$con_end_ptr); 5 12 dcl cobol_$def_base_ptr ptr ext; 5 13 dcl def_base_ptr ptr defined (cobol_$def_base_ptr); 5 14 dcl cobol_$link_base_ptr ptr ext; 5 15 dcl link_base_ptr ptr defined (cobol_$link_base_ptr); 5 16 dcl cobol_$sym_base_ptr ptr ext; 5 17 dcl sym_base_ptr ptr defined (cobol_$sym_base_ptr); 5 18 dcl cobol_$reloc_text_base_ptr ptr ext; 5 19 dcl reloc_text_base_ptr ptr defined (cobol_$reloc_text_base_ptr); 5 20 dcl cobol_$reloc_def_base_ptr ptr ext; 5 21 dcl reloc_def_base_ptr ptr defined (cobol_$reloc_def_base_ptr); 5 22 dcl cobol_$reloc_link_base_ptr ptr ext; 5 23 dcl reloc_link_base_ptr ptr defined (cobol_$reloc_link_base_ptr); 5 24 dcl cobol_$reloc_sym_base_ptr ptr ext; 5 25 dcl reloc_sym_base_ptr ptr defined (cobol_$reloc_sym_base_ptr); 5 26 dcl cobol_$reloc_work_base_ptr ptr ext; 5 27 dcl reloc_work_base_ptr ptr defined (cobol_$reloc_work_base_ptr); 5 28 dcl cobol_$pd_map_ptr ptr ext; 5 29 dcl pd_map_ptr ptr defined (cobol_$pd_map_ptr); 5 30 dcl cobol_$fixup_ptr ptr ext; 5 31 dcl fixup_ptr ptr defined (cobol_$fixup_ptr); 5 32 dcl cobol_$initval_base_ptr ptr ext; 5 33 dcl initval_base_ptr ptr defined (cobol_$initval_base_ptr); 5 34 dcl cobol_$initval_file_ptr ptr ext; 5 35 dcl initval_file_ptr ptr defined (cobol_$initval_file_ptr); 5 36 dcl cobol_$perform_list_ptr ptr ext; 5 37 dcl perform_list_ptr ptr defined (cobol_$perform_list_ptr); 5 38 dcl cobol_$alter_list_ptr ptr ext; 5 39 dcl alter_list_ptr ptr defined (cobol_$alter_list_ptr); 5 40 dcl cobol_$seg_init_list_ptr ptr ext; 5 41 dcl seg_init_list_ptr ptr defined (cobol_$seg_init_list_ptr); 5 42 dcl cobol_$temp_token_area_ptr ptr ext; 5 43 dcl temp_token_area_ptr ptr defined (cobol_$temp_token_area_ptr); 5 44 dcl cobol_$temp_token_ptr ptr ext; 5 45 dcl temp_token_ptr ptr defined (cobol_$temp_token_ptr); 5 46 dcl cobol_$token_block1_ptr ptr ext; 5 47 dcl token_block1_ptr ptr defined (cobol_$token_block1_ptr); 5 48 dcl cobol_$token_block2_ptr ptr ext; 5 49 dcl token_block2_ptr ptr defined (cobol_$token_block2_ptr); 5 50 dcl cobol_$minpral5_ptr ptr ext; 5 51 dcl minpral5_ptr ptr defined (cobol_$minpral5_ptr); 5 52 dcl cobol_$tag_table_ptr ptr ext; 5 53 dcl tag_table_ptr ptr defined (cobol_$tag_table_ptr); 5 54 dcl cobol_$map_data_ptr ptr ext; 5 55 dcl map_data_ptr ptr defined (cobol_$map_data_ptr); 5 56 dcl cobol_$ptr_status_ptr ptr ext; 5 57 dcl ptr_status_ptr ptr defined (cobol_$ptr_status_ptr); 5 58 dcl cobol_$reg_status_ptr ptr ext; 5 59 dcl reg_status_ptr ptr defined (cobol_$reg_status_ptr); 5 60 dcl cobol_$misc_base_ptr ptr ext; 5 61 dcl misc_base_ptr ptr defined (cobol_$misc_base_ptr); 5 62 dcl cobol_$misc_end_ptr ptr ext; 5 63 dcl misc_end_ptr ptr defined (cobol_$misc_end_ptr); 5 64 dcl cobol_$list_ptr ptr ext; 5 65 dcl list_ptr ptr defined (cobol_$list_ptr); 5 66 dcl cobol_$allo1_ptr ptr ext; 5 67 dcl allo1_ptr ptr defined (cobol_$allo1_ptr); 5 68 dcl cobol_$eln_ptr ptr ext; 5 69 dcl eln_ptr ptr defined (cobol_$eln_ptr); 5 70 dcl cobol_$diag_ptr ptr ext; 5 71 dcl diag_ptr ptr defined (cobol_$diag_ptr); 5 72 dcl cobol_$xref_token_ptr ptr ext; 5 73 dcl xref_token_ptr ptr defined (cobol_$xref_token_ptr); 5 74 dcl cobol_$xref_chain_ptr ptr ext; 5 75 dcl xref_chain_ptr ptr defined (cobol_$xref_chain_ptr); 5 76 dcl cobol_$statement_info_ptr ptr ext; 5 77 dcl statement_info_ptr ptr defined (cobol_$statement_info_ptr); 5 78 dcl cobol_$reswd_ptr ptr ext; 5 79 dcl reswd_ptr ptr defined (cobol_$reswd_ptr); 5 80 dcl cobol_$op_con_ptr ptr ext; 5 81 dcl op_con_ptr ptr defined (cobol_$op_con_ptr); 5 82 dcl cobol_$ntbuf_ptr ptr ext; 5 83 dcl ntbuf_ptr ptr defined (cobol_$ntbuf_ptr); 5 84 dcl cobol_$main_pcs_ptr ptr ext; 5 85 dcl main_pcs_ptr ptr defined (cobol_$main_pcs_ptr); 5 86 dcl cobol_$include_info_ptr ptr ext; 5 87 dcl include_info_ptr ptr defined (cobol_$include_info_ptr); 5 88 5 89 /* FIXED BIN */ 5 90 dcl cobol_$text_wd_off fixed bin ext; 5 91 dcl text_wd_off fixed bin defined (cobol_$text_wd_off); 5 92 dcl cobol_$con_wd_off fixed bin ext; 5 93 dcl con_wd_off fixed bin defined (cobol_$con_wd_off); 5 94 dcl cobol_$def_wd_off fixed bin ext; 5 95 dcl def_wd_off fixed bin defined (cobol_$def_wd_off); 5 96 dcl cobol_$def_max fixed bin ext; 5 97 dcl def_max fixed bin defined (cobol_$def_max); 5 98 dcl cobol_$link_wd_off fixed bin ext; 5 99 dcl link_wd_off fixed bin defined (cobol_$link_wd_off); 5 100 dcl cobol_$link_max fixed bin ext; 5 101 dcl link_max fixed bin defined (cobol_$link_max); 5 102 dcl cobol_$sym_wd_off fixed bin ext; 5 103 dcl sym_wd_off fixed bin defined (cobol_$sym_wd_off); 5 104 dcl cobol_$sym_max fixed bin ext; 5 105 dcl sym_max fixed bin defined (cobol_$sym_max); 5 106 dcl cobol_$reloc_text_max fixed bin(24) ext; 5 107 dcl reloc_text_max fixed bin(24) defined (cobol_$reloc_text_max); 5 108 dcl cobol_$reloc_def_max fixed bin(24) ext; 5 109 dcl reloc_def_max fixed bin(24) defined (cobol_$reloc_def_max); 5 110 dcl cobol_$reloc_link_max fixed bin(24) ext; 5 111 dcl reloc_link_max fixed bin(24) defined (cobol_$reloc_link_max); 5 112 dcl cobol_$reloc_sym_max fixed bin(24) ext; 5 113 dcl reloc_sym_max fixed bin(24) defined (cobol_$reloc_sym_max); 5 114 dcl cobol_$reloc_work_max fixed bin(24) ext; 5 115 dcl reloc_work_max fixed bin(24) defined (cobol_$reloc_work_max); 5 116 dcl cobol_$pd_map_index fixed bin ext; 5 117 dcl pd_map_index fixed bin defined (cobol_$pd_map_index); 5 118 dcl cobol_$cobol_data_wd_off fixed bin ext; 5 119 dcl cobol_data_wd_off fixed bin defined (cobol_$cobol_data_wd_off); 5 120 dcl cobol_$stack_off fixed bin ext; 5 121 dcl stack_off fixed bin defined (cobol_$stack_off); 5 122 dcl cobol_$max_stack_off fixed bin ext; 5 123 dcl max_stack_off fixed bin defined (cobol_$max_stack_off); 5 124 dcl cobol_$init_stack_off fixed bin ext; 5 125 dcl init_stack_off fixed bin defined (cobol_$init_stack_off); 5 126 dcl cobol_$pd_map_sw fixed bin ext; 5 127 dcl pd_map_sw fixed bin defined (cobol_$pd_map_sw); 5 128 dcl cobol_$next_tag fixed bin ext; 5 129 dcl next_tag fixed bin defined (cobol_$next_tag); 5 130 dcl cobol_$data_init_flag fixed bin ext; 5 131 dcl data_init_flag fixed bin defined (cobol_$data_init_flag); 5 132 dcl cobol_$seg_init_flag fixed bin ext; 5 133 dcl seg_init_flag fixed bin defined (cobol_$seg_init_flag); 5 134 dcl cobol_$alter_flag fixed bin ext; 5 135 dcl alter_flag fixed bin defined (cobol_$alter_flag); 5 136 dcl cobol_$sect_eop_flag fixed bin ext; 5 137 dcl sect_eop_flag fixed bin defined (cobol_$sect_eop_flag); 5 138 dcl cobol_$para_eop_flag fixed bin ext; 5 139 dcl para_eop_flag fixed bin defined (cobol_$para_eop_flag); 5 140 dcl cobol_$priority_no fixed bin ext; 5 141 dcl priority_no fixed bin defined (cobol_$priority_no); 5 142 dcl cobol_$compile_count fixed bin ext; 5 143 dcl compile_count fixed bin defined (cobol_$compile_count); 5 144 dcl cobol_$ptr_assumption_ind fixed bin ext; 5 145 dcl ptr_assumption_ind fixed bin defined (cobol_$ptr_assumption_ind); 5 146 dcl cobol_$reg_assumption_ind fixed bin ext; 5 147 dcl reg_assumption_ind fixed bin defined (cobol_$reg_assumption_ind); 5 148 dcl cobol_$perform_para_index fixed bin ext; 5 149 dcl perform_para_index fixed bin defined (cobol_$perform_para_index); 5 150 dcl cobol_$perform_sect_index fixed bin ext; 5 151 dcl perform_sect_index fixed bin defined (cobol_$perform_sect_index); 5 152 dcl cobol_$alter_index fixed bin ext; 5 153 dcl alter_index fixed bin defined (cobol_$alter_index); 5 154 dcl cobol_$list_off fixed bin ext; 5 155 dcl list_off fixed bin defined (cobol_$list_off); 5 156 dcl cobol_$constant_offset fixed bin ext; 5 157 dcl constant_offset fixed bin defined (cobol_$constant_offset); 5 158 dcl cobol_$misc_max fixed bin ext; 5 159 dcl misc_max fixed bin defined (cobol_$misc_max); 5 160 dcl cobol_$pd_map_max fixed bin ext; 5 161 dcl pd_map_max fixed bin defined (cobol_$pd_map_max); 5 162 dcl cobol_$map_data_max fixed bin ext; 5 163 dcl map_data_max fixed bin defined (cobol_$map_data_max); 5 164 dcl cobol_$fixup_max fixed bin ext; 5 165 dcl fixup_max fixed bin defined (cobol_$fixup_max); 5 166 dcl cobol_$tag_table_max fixed bin ext; 5 167 dcl tag_table_max fixed bin defined (cobol_$tag_table_max); 5 168 dcl cobol_$temp_token_max fixed bin ext; 5 169 dcl temp_token_max fixed bin defined (cobol_$temp_token_max); 5 170 dcl cobol_$allo1_max fixed bin ext; 5 171 dcl allo1_max fixed bin defined (cobol_$allo1_max); 5 172 dcl cobol_$eln_max fixed bin ext; 5 173 dcl eln_max fixed bin defined (cobol_$eln_max); 5 174 dcl cobol_$debug_enable fixed bin ext; 5 175 dcl debug_enable fixed bin defined (cobol_$debug_enable); 5 176 dcl cobol_$non_source_offset fixed bin ext; 5 177 dcl non_source_offset fixed bin defined (cobol_$non_source_offset); 5 178 dcl cobol_$initval_flag fixed bin ext; 5 179 dcl initval_flag fixed bin defined (cobol_$initval_flag); 5 180 dcl cobol_$date_compiled_sw fixed bin ext; 5 181 dcl date_compiled_sw fixed bin defined (cobol_$date_compiled_sw); 5 182 dcl cobol_$include_cnt fixed bin ext; 5 183 dcl include_cnt fixed bin defined (cobol_$include_cnt); 5 184 dcl cobol_$fs_charcnt fixed bin ext; 5 185 dcl fs_charcnt fixed bin defined (cobol_$fs_charcnt); 5 186 dcl cobol_$ws_charcnt fixed bin ext; 5 187 dcl ws_charcnt fixed bin defined (cobol_$ws_charcnt); 5 188 dcl cobol_$coms_charcnt fixed bin ext; 5 189 dcl coms_charcnt fixed bin defined (cobol_$coms_charcnt); 5 190 dcl cobol_$ls_charcnt fixed bin ext; 5 191 dcl ls_charcnt fixed bin defined (cobol_$ls_charcnt); 5 192 dcl cobol_$cons_charcnt fixed bin ext; 5 193 dcl cons_charcnt fixed bin defined (cobol_$cons_charcnt); 5 194 dcl cobol_$value_cnt fixed bin ext; 5 195 dcl value_cnt fixed bin defined (cobol_$value_cnt); 5 196 dcl cobol_$cd_cnt fixed bin ext; 5 197 dcl cd_cnt fixed bin defined (cobol_$cd_cnt); 5 198 dcl cobol_$fs_wdoff fixed bin ext; 5 199 dcl fs_wdoff fixed bin defined (cobol_$fs_wdoff); 5 200 dcl cobol_$ws_wdoff fixed bin ext; 5 201 dcl ws_wdoff fixed bin defined (cobol_$ws_wdoff); 5 202 dcl cobol_$coms_wdoff fixed bin ext; 5 203 dcl coms_wdoff fixed bin defined (cobol_$coms_wdoff); 5 204 5 205 /* CHARACTER */ 5 206 dcl cobol_$scratch_dir char (168) aligned ext; 5 207 dcl scratch_dir char (168) aligned defined (cobol_$scratch_dir); /* -42- */ 5 208 dcl cobol_$obj_seg_name char (32) aligned ext; 5 209 dcl obj_seg_name char (32) aligned defined (cobol_$obj_seg_name); /* -8- */ 5 210 5 211 /* BIT */ 5 212 dcl cobol_$xref_bypass bit(1) aligned ext; 5 213 dcl xref_bypass bit(1) aligned defined (cobol_$xref_bypass); /* -1- */ 5 214 dcl cobol_$same_sort_merge_proc bit(1) aligned ext; 5 215 dcl same_sort_merge_proc bit(1) aligned defined (cobol_$same_sort_merge_proc); /* -1- */ 5 216 5 217 5 218 /* END INCLUDE FILE ... cobol_incl.pl1*/ 5 219 5 220 7341 7342 7343 declare 1 alphabet_name based (addr_record), 6 1 6 2 /* begin include file ... cobol_TYPE40.incl.pl1 */ 6 3 /* Last modified on 11/17/76 by ORN */ 6 4 6 5 /* header */ 6 6 2 size fixed bin, 6 7 2 line fixed bin, 6 8 2 column fixed bin, 6 9 2 type fixed bin, 6 10 /* body */ 6 11 2 string_ptr ptr, 6 12 2 prev_rec ptr, 6 13 2 info, 6 14 3 repl bit(8), 6 15 3 one_one bit(1), 6 16 3 onto bit(1), 6 17 2 hival_char char(1), 6 18 2 loval_char char(1), 6 19 2 iw_key fixed bin, 6 20 2 def_line fixed bin, 6 21 2 char_size fixed bin, 6 22 2 hi_value char(1), 6 23 2 segno fixed bin, 6 24 2 offset fixed bin, 6 25 2 dn_offset fixed bin, 6 26 2 table char(512), 6 27 2 name_size fixed bin, 6 28 2 name char(0 refer(alphabet_name.name_size)); 6 29 6 30 /* end include file ... cobol_TYPE40.incl.pl1 */ 6 31 7344 7345 7346 7347 dcl 1 reserved_word based (addr_record), 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 7348 7349 7350 dcl 1 numeric_lit based (addr_record), 8 1 8 2 /* begin include file ... cobol_TYPE2.incl.pl1 */ 8 3 /* Last modified on 12/28/76 by FCH */ 8 4 8 5 /* header */ 8 6 2 size fixed bin, 8 7 2 line fixed bin, 8 8 2 column fixed bin, 8 9 2 type fixed bin, 8 10 /* body */ 8 11 2 integral bit(1), 8 12 2 floating bit(1), 8 13 2 seg_range bit(1), 8 14 2 filler1 bit(4), 8 15 2 subscript bit(1), 8 16 2 sign char(1), 8 17 2 exp_sign char(1), 8 18 2 exp_places fixed bin, 8 19 2 places_left fixed bin, 8 20 2 places_right fixed bin, 8 21 2 places fixed bin, 8 22 2 literal char(0 refer(numeric_lit.places)); 8 23 8 24 8 25 8 26 /* end include file ... cobol_TYPE2.incl.pl1 */ 8 27 7351 7352 7353 dcl 1 alphanum_lit based (addr_record), 9 1 9 2 /* begin include file ... cobol_TYPE3.incl.pl1 */ 9 3 /* Last modified on 11/17/76 by ORN */ 9 4 /* Last modified on 12/28/76 by FCH */ 9 5 9 6 /* header */ 9 7 2 size fixed bin, 9 8 2 line fixed bin, 9 9 2 column fixed bin, 9 10 2 type fixed bin, 9 11 /* body */ 9 12 2 lit_type bit (1), 9 13 2 all_lit bit (1), 9 14 2 filler1 bit (6), 9 15 2 lit_size fixed bin, 9 16 2 string char(0 refer(alphanum_lit.lit_size)); 9 17 9 18 9 19 9 20 /* end include file ... cobol_TYPE3.incl.pl1 */ 9 21 7354 7355 7356 7357 dcl 1 proc_def based (addr_record), 10 1 10 2 /* begin include file ... cobol_TYPE7.incl.pl1 */ 10 3 /* Last modified on 11/17/76 by ORN */ 10 4 /* Last modified on 12/28/76 by FCH */ 10 5 10 6 /* header */ 10 7 2 size fixed bin, 10 8 2 line fixed bin, 10 9 2 column fixed bin, 10 10 2 type fixed bin, 10 11 /* body */ 10 12 2 string_ptr ptr, 10 13 2 prev_rec ptr, 10 14 2 searched bit (1), 10 15 2 duplicate bit (1), 10 16 2 filler1 bit (1), 10 17 2 debug_ind bit (1), 10 18 2 section_name bit (1), 10 19 2 declarative_proc bit (1), 10 20 2 filler2 bit (1), 10 21 2 alterable bit (1), 10 22 2 priority char (2), 10 23 2 sort_range bit (1), 10 24 2 input_range bit (1), 10 25 2 output_range bit (1), 10 26 2 merge_range bit(1), 10 27 2 filler3 bit (5), 10 28 2 section_num fixed bin, 10 29 2 proc_num fixed bin, 10 30 2 def_line fixed bin, 10 31 2 name_size fixed bin, 10 32 2 name char(0 refer(proc_def.name_size)); 10 33 10 34 10 35 10 36 /* end include file ... cobol_TYPE7.incl.pl1 */ 10 37 7358 7359 7360 dcl 1 data_name based (addr_record), 11 1 11 2 /* begin include file ... cobol_TYPE9.incl.pl1 */ 11 3 /* Last modified on 06/19/77 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 string_ptr ptr, 11 13 2 prev_rec ptr, 11 14 2 searched bit (1), 11 15 2 duplicate bit (1), 11 16 2 saved bit (1), 11 17 2 debug_ind bit (1), 11 18 2 filler2 bit (3), 11 19 2 used_as_sub bit (1), 11 20 2 def_line fixed bin, 11 21 2 level fixed bin, 11 22 2 linkage fixed bin, 11 23 2 file_num fixed bin, 11 24 2 size_rtn fixed bin, 11 25 2 item_length fixed bin(24), 11 26 2 places_left fixed bin, 11 27 2 places_right fixed bin, 11 28 /* description */ 11 29 2 file_section bit (1), 11 30 2 working_storage bit (1), 11 31 2 constant_section bit (1), 11 32 2 linkage_section bit (1), 11 33 2 communication_section bit (1), 11 34 2 report_section bit (1), 11 35 2 level_77 bit (1), 11 36 2 level_01 bit (1), 11 37 2 non_elementary bit (1), 11 38 2 elementary bit (1), 11 39 2 filler_item bit (1), 11 40 2 s_of_rdf bit (1), 11 41 2 o_of_rdf bit (1), 11 42 2 bin_18 bit (1), 11 43 2 bin_36 bit (1), 11 44 2 pic_has_l bit (1), 11 45 2 pic_is_do bit (1), 11 46 2 numeric bit (1), 11 47 2 numeric_edited bit (1), 11 48 2 alphanum bit (1), 11 49 2 alphanum_edited bit (1), 11 50 2 alphabetic bit (1), 11 51 2 alphabetic_edited bit (1), 11 52 2 pic_has_p bit (1), 11 53 2 pic_has_ast bit (1), 11 54 2 item_signed bit(1), 11 55 2 sign_separate bit (1), 11 56 2 display bit (1), 11 57 2 comp bit (1), 11 58 2 ascii_packed_dec_h bit (1), /* as of 8/16/76 this field used for comp8. */ 11 59 2 ascii_packed_dec bit (1), 11 60 2 ebcdic_packed_dec bit (1), 11 61 2 bin_16 bit (1), 11 62 2 bin_32 bit (1), 11 63 2 usage_index bit (1), 11 64 2 just_right bit (1), 11 65 2 compare_argument bit (1), 11 66 2 sync bit (1), 11 67 2 temporary bit (1), 11 68 2 bwz bit (1), 11 69 2 variable_length bit (1), 11 70 2 subscripted bit (1), 11 71 2 occurs_do bit (1), 11 72 2 key_a bit (1), 11 73 2 key_d bit (1), 11 74 2 indexed_by bit (1), 11 75 2 value_numeric bit (1), 11 76 2 value_non_numeric bit (1), 11 77 2 value_signed bit (1), 11 78 2 sign_type bit (3), 11 79 2 pic_integer bit (1), 11 80 2 ast_when_zero bit (1), 11 81 2 label_record bit (1), 11 82 2 sign_clause_occurred bit (1), 11 83 2 okey_dn bit (1), 11 84 2 subject_of_keyis bit (1), 11 85 2 exp_redefining bit (1), 11 86 2 sync_in_rec bit (1), 11 87 2 rounded bit (1), 11 88 2 ad_bit bit (1), 11 89 2 debug_all bit (1), 11 90 2 overlap bit (1), 11 91 2 sum_counter bit (1), 11 92 2 exp_occurs bit (1), 11 93 2 linage_counter bit (1), 11 94 2 rnm_01 bit (1), 11 95 2 aligned bit (1), 11 96 2 not_user_writable bit (1), 11 97 2 database_key bit (1), 11 98 2 database_data_item bit (1), 11 99 2 seg_num fixed bin, 11 100 2 offset fixed bin(24), 11 101 2 initial_ptr fixed bin, 11 102 2 edit_ptr fixed bin, 11 103 2 occurs_ptr fixed bin, 11 104 2 do_rec char(5), 11 105 2 bitt bit (1), 11 106 2 byte bit (1), 11 107 2 half_word bit (1), 11 108 2 word bit (1), 11 109 2 double_word bit (1), 11 110 2 half_byte bit (1), 11 111 2 filler5 bit (1), 11 112 2 bit_offset bit (4), 11 113 2 son_cnt bit (16), 11 114 2 max_red_size fixed bin(24), 11 115 2 name_size fixed bin, 11 116 2 name char(0 refer(data_name.name_size)); 11 117 11 118 11 119 11 120 /* end include file ... cobol_TYPE9.incl.pl1 */ 11 121 7361 7362 7363 dcl 1 occurs based (occptr), 12 1 12 2 /* begin include file ... cobol_OCCURS.incl.pl1 */ 12 3 /* Last modified on 12/28/76 by FCH */ 12 4 12 5 2 keyed fixed bin, 12 6 2 key_number fixed bin, 12 7 2 dimensions fixed bin, 12 8 2 level (3), 12 9 3 indexedno fixed bin, 12 10 3 min fixed bin, 12 11 3 max fixed bin, 12 12 3 struclength fixed bin, 12 13 3 cswdx fixed bin, 12 14 3 cswd fixed bin(24); 12 15 12 16 /* end include file ... cobol_OCCURS.incl.pl1 */ 12 17 7364 7365 7366 dcl 1 index_name based (addr_record), 13 1 13 2 /* begin include file ... cobol_TYPE10.incl.pl1 13 3*/* Last modified on 01/25/77 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 searched bit(1), 13 14 2 duplicate bit(1), 13 15 2 saved bit(1), 13 16 2 debug_ind bit(1), 13 17 2 filler1 bit(3), 13 18 2 subscript bit(1), 13 19 2 def_line fixed bin, 13 20 2 level fixed bin, 13 21 2 seg_num fixed bin, 13 22 2 offset fixed bin(24), 13 23 2 index_no fixed bin, 13 24 2 min fixed bin, 13 25 2 max fixed bin, 13 26 2 struc_length fixed bin, 13 27 2 cswd_seg fixed bin, 13 28 2 cswd_offset fixed bin(24), 13 29 2 name_size fixed bin, 13 30 2 name char(0 refer(index_name.name_size)); 13 31 13 32 13 33 13 34 /* end include file ... cobol_TYPE10.incl.pl1 */ 13 35 7367 7368 7369 dcl 1 fd_token based (addr_record), 14 1 14 2 /* begin include file ... cobol_TYPE12.incl.pl1 */ 14 3 /* Last modified on 11/17/76 by ORN */ 14 4 14 5 /* header */ 14 6 2 size fixed bin, 14 7 2 line fixed bin, 14 8 2 column fixed bin, 14 9 2 type fixed bin, 14 10 /* body */ 14 11 2 string_ptr ptr, 14 12 2 prev_rec ptr, 14 13 2 info bit (8), 14 14 2 def_line fixed bin, 14 15 2 file_no fixed bin, 14 16 2 name_size fixed bin, 14 17 2 name char(0 refer(fd_token.name_size)); 14 18 14 19 /* end include file ... cobol_TYPE12.incl.pl1 */ 14 20 7370 7371 7372 15 1 15 2 /* BEGIN INCLUDE FILE ... cobol_type13.incl.pl1 */ 15 3 /* Last modified on 11/19/76 by ORN */ 15 4 15 5 dcl cdtoken_ptr ptr; 15 6 15 7 /* BEGIN DECLARATION OF TYPE13 (CD NAME) TOKEN */ 15 8 dcl 1 cdtoken based(cdtoken_ptr), 16 1 16 2 /* begin include file ... cobol_TYPE13.incl.pl1 16 3*/* Last modified on 11/18/76 by ORN */ 16 4 16 5 /* header */ 16 6 2 size fixed bin, 16 7 2 line fixed bin, 16 8 2 column fixed bin, 16 9 2 type fixed bin, /* cd = 13 */ 16 10 /* body */ 16 11 2 string_ptr ptr, 16 12 2 prev_rec ptr, 16 13 2 info, 16 14 3 searched bit(1), 16 15 3 duplicate bit(1), 16 16 3 filler1 bit(6), 16 17 2 options, 16 18 3 input bit(1), 16 19 3 output bit(1), 16 20 3 initial bit(1), 16 21 2 def_line fixed bin, 16 22 2 cd_num fixed bin, 16 23 2 cd_seg fixed bin, 16 24 2 cd_off fixed bin(24), 16 25 2 max_redef fixed bin, 16 26 2 mdest fixed bin, 16 27 2 name_size fixed bin, 16 28 2 name char(0 refer(cdtoken.name_size)); 16 29 16 30 /* end include file ... cobol_TYPE13.incl.pl1 */ 16 31 15 9 15 10 /* END DECLARATION OF TYPE13 (CD NAME) TOKEN */ 15 11 15 12 15 13 /* END INCLUDE FILE ... cobol_type13.incl.pl1 */ 15 14 7373 7374 7375 dcl 1 mnemonic_name based (addr_record), 17 1 17 2 /* begin include file ... cobol_TYPE17.incl.pl1 */ 17 3 /* Last modified on 11/17/76 by ORN */ 17 4 17 5 /* header */ 17 6 2 size fixed bin, 17 7 2 line fixed bin, 17 8 2 column fixed bin, 17 9 2 type fixed bin, 17 10 /* body */ 17 11 2 string_ptr ptr, 17 12 2 prev_rec ptr, 17 13 2 info bit(8), 17 14 2 class, 17 15 3 switch_condition bit(1), 17 16 3 switch_name bit(1), 17 17 3 accept_device bit(1), 17 18 3 display_device bit(1), 17 19 3 printer_control bit(1), 17 20 3 alphabet_name bit(1), 17 21 2 on_status bit(1), 17 22 2 off_status bit(1), 17 23 2 def_line fixed bin, 17 24 2 iw_key fixed bin, 17 25 2 reserved bit(36), 17 26 2 alphabet_offset fixed bin, 17 27 2 name_size fixed bin, 17 28 2 name char(0 refer (mnemonic_name.name_size)); 17 29 17 30 17 31 /* end include file ... cobol_TYPE17.incl.pl1 */ 17 32 7376 7377 7378 7379 dcl 1 end_stmt static, 18 1 18 2 /* begin include file ... cobol_TYPE19.incl.pl1 */ 18 3 /* Last modified on 11/17/76 by ORN */ 18 4 18 5 /* header */ 18 6 2 size fixed bin, 18 7 2 line fixed bin, 18 8 2 column fixed bin, 18 9 2 type fixed bin, 18 10 /* body */ 18 11 2 verb fixed bin, 18 12 2 e fixed bin, 18 13 2 h fixed bin, 18 14 2 i fixed bin, 18 15 2 j fixed bin, 18 16 2 a bit (3), 18 17 2 b bit (1), 18 18 2 c bit (1), 18 19 2 d bit (2), 18 20 2 f bit (2), 18 21 2 g bit (2), 18 22 2 k bit (5), 18 23 2 always_an bit (1); 18 24 18 25 /* end include file ... cobol_TYPE19.incl.pl1 */ 18 26 7380 7381 7382 7383 7384 /* a dummy procedure name reference type 18 used for go to action 49 */ 7385 dcl 01 dumprocname static, 19 1 19 2 /* begin include file ... cobol_TYPE18.incl.pl1 */ 19 3 /* Last modified on 11/7/76 by ORN */ 19 4 19 5 /* header */ 19 6 2 size fixed bin, 19 7 2 line fixed bin, 19 8 2 column fixed bin, 19 9 2 type fixed bin, 19 10 /* body */ 19 11 2 string_ptr ptr, 19 12 2 prev_rec ptr, 19 13 2 searched bit (1), 19 14 2 duplicate bit (1), 19 15 2 filler1 bit (1), 19 16 2 debug_ind bit (1), 19 17 2 section_name bit (1), 19 18 2 declarative_proc bit (1), 19 19 2 filler2 bit (1), 19 20 2 alterable bit (1), 19 21 2 priority char (2), 19 22 2 sort_range bit (1), 19 23 2 input_range bit (1), 19 24 2 output_range bit (1), 19 25 2 merge_range bit(1), 19 26 2 filler3 bit (5), 19 27 2 section_num fixed bin, 19 28 2 proc_num fixed bin, 19 29 2 def_line fixed bin, 19 30 2 name_size fixed bin, 19 31 2 name char (30); 19 32 19 33 /* end include file ... cobol_TYPE18.incl.pl1 */ 19 34 7386 7387 7388 dcl 01 opeos static, 20 1 20 2 /* begin include file ... cobol_TYPE19.incl.pl1 */ 20 3 /* Last modified on 11/17/76 by ORN */ 20 4 20 5 /* header */ 20 6 2 size fixed bin, 20 7 2 line fixed bin, 20 8 2 column fixed bin, 20 9 2 type fixed bin, 20 10 /* body */ 20 11 2 verb fixed bin, 20 12 2 e fixed bin, 20 13 2 h fixed bin, 20 14 2 i fixed bin, 20 15 2 j fixed bin, 20 16 2 a bit (3), 20 17 2 b bit (1), 20 18 2 c bit (1), 20 19 2 d bit (2), 20 20 2 f bit (2), 20 21 2 g bit (2), 20 22 2 k bit (5), 20 23 2 always_an bit (1); 20 24 20 25 /* end include file ... cobol_TYPE19.incl.pl1 */ 20 26 7389 7390 /* dummy open verb for acton 119 */ 7391 /* type18 procedure name stored here for go to depending */ 7392 dcl 01 store_label_1 static internal, 21 1 21 2 /* begin include file ... cobol_TYPE18.incl.pl1 */ 21 3 /* Last modified on 11/7/76 by ORN */ 21 4 21 5 /* header */ 21 6 2 size fixed bin, 21 7 2 line fixed bin, 21 8 2 column fixed bin, 21 9 2 type fixed bin, 21 10 /* body */ 21 11 2 string_ptr ptr, 21 12 2 prev_rec ptr, 21 13 2 searched bit (1), 21 14 2 duplicate bit (1), 21 15 2 filler1 bit (1), 21 16 2 debug_ind bit (1), 21 17 2 section_name bit (1), 21 18 2 declarative_proc bit (1), 21 19 2 filler2 bit (1), 21 20 2 alterable bit (1), 21 21 2 priority char (2), 21 22 2 sort_range bit (1), 21 23 2 input_range bit (1), 21 24 2 output_range bit (1), 21 25 2 merge_range bit(1), 21 26 2 filler3 bit (5), 21 27 2 section_num fixed bin, 21 28 2 proc_num fixed bin, 21 29 2 def_line fixed bin, 21 30 2 name_size fixed bin, 21 31 2 name char (30); 21 32 21 33 /* end include file ... cobol_TYPE18.incl.pl1 */ 21 34 7393 7394 /* store type 18 for go dependig */ 7395 dcl 01 store_label_2 static internal, 22 1 22 2 /* begin include file ... cobol_TYPE18.incl.pl1 */ 22 3 /* Last modified on 11/7/76 by ORN */ 22 4 22 5 /* header */ 22 6 2 size fixed bin, 22 7 2 line fixed bin, 22 8 2 column fixed bin, 22 9 2 type fixed bin, 22 10 /* body */ 22 11 2 string_ptr ptr, 22 12 2 prev_rec ptr, 22 13 2 searched bit (1), 22 14 2 duplicate bit (1), 22 15 2 filler1 bit (1), 22 16 2 debug_ind bit (1), 22 17 2 section_name bit (1), 22 18 2 declarative_proc bit (1), 22 19 2 filler2 bit (1), 22 20 2 alterable bit (1), 22 21 2 priority char (2), 22 22 2 sort_range bit (1), 22 23 2 input_range bit (1), 22 24 2 output_range bit (1), 22 25 2 merge_range bit(1), 22 26 2 filler3 bit (5), 22 27 2 section_num fixed bin, 22 28 2 proc_num fixed bin, 22 29 2 def_line fixed bin, 22 30 2 name_size fixed bin, 22 31 2 name char (30); 22 32 22 33 /* end include file ... cobol_TYPE18.incl.pl1 */ 22 34 7396 23 1 /* BEGIN INCLUDE FILE ... cobol_file_desc_1.incl.pl1 */ 23 2 /* Last Modified on Oct. 14, 1978 by FCH */ 23 3 23 4 dcl file_desc_1_type fixed bin static init(1) options(constant); 23 5 dcl file_desc_1_ptr ptr; 23 6 23 7 dcl 1 file_desc_1 based(file_desc_1_ptr), 23 8 2 type fixed bin, 23 9 2 alt_key_count fixed bin, 23 10 2 prime_key, 23 11 3 offset fixed bin, 23 12 3 size fixed bin, 23 13 2 alt_key(0 refer(file_desc_1.alt_key_count)), 23 14 3 offset fixed bin, 23 15 3 size fixed bin; 23 16 23 17 /* 23 18* 23 19*FIELD CONTENTS 23 20* 23 21*type file type 23 22*alt_key_count alternate_key_count 23 23*prime key prime record key 23 24*alt_key alternate record keys 23 25*offset offset (in bytes) of key field in record 23 26*size size (in bytes) of key field in record 23 27* negative if duplicates legal 23 28* 23 29**/ 23 30 23 31 /* END INCLUDE FILE ... cobol_file_desc_1.incl.pl1 */ 7397 7398 7399 end cobol_pdstax; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/00 1139.2 cobol_pdstax.pl1 >udd>sm>ds>w>ml>cobol_pdstax.pl1 7328 1 03/27/82 0531.3 cobol_ext_.incl.pl1 >ldd>incl>cobol_ext_.incl.pl1 7333 2 11/11/82 1812.8 cobol_fixed_common.incl.pl1 >ldd>incl>cobol_fixed_common.incl.pl1 7339 3 11/11/82 1812.7 cobol_file_table.incl.pl1 >ldd>incl>cobol_file_table.incl.pl1 7340 4 03/27/82 0539.7 cobol_diag_file.incl.pl1 >ldd>incl>cobol_diag_file.incl.pl1 7341 5 11/11/82 1812.7 cobol_.incl.pl1 >ldd>incl>cobol_.incl.pl1 7344 6 11/11/82 1812.8 cobol_TYPE40.incl.pl1 >ldd>incl>cobol_TYPE40.incl.pl1 7348 7 11/11/82 1812.8 cobol_TYPE1.incl.pl1 >ldd>incl>cobol_TYPE1.incl.pl1 7351 8 11/11/82 1812.8 cobol_TYPE2.incl.pl1 >ldd>incl>cobol_TYPE2.incl.pl1 7354 9 11/11/82 1812.8 cobol_TYPE3.incl.pl1 >ldd>incl>cobol_TYPE3.incl.pl1 7358 10 11/11/82 1812.7 cobol_TYPE7.incl.pl1 >ldd>incl>cobol_TYPE7.incl.pl1 7361 11 11/11/82 1812.7 cobol_TYPE9.incl.pl1 >ldd>incl>cobol_TYPE9.incl.pl1 7364 12 03/27/82 0539.6 cobol_OCCURS.incl.pl1 >ldd>incl>cobol_OCCURS.incl.pl1 7367 13 11/11/82 1812.7 cobol_TYPE10.incl.pl1 >ldd>incl>cobol_TYPE10.incl.pl1 7370 14 03/27/82 0539.6 cobol_TYPE12.incl.pl1 >ldd>incl>cobol_TYPE12.incl.pl1 7373 15 11/11/82 1812.8 cobol_type13.incl.pl1 >ldd>incl>cobol_type13.incl.pl1 15-9 16 03/27/82 0539.6 cobol_TYPE13.incl.pl1 >ldd>incl>cobol_TYPE13.incl.pl1 7376 17 11/11/82 1812.8 cobol_TYPE17.incl.pl1 >ldd>incl>cobol_TYPE17.incl.pl1 7380 18 03/27/82 0539.6 cobol_TYPE19.incl.pl1 >ldd>incl>cobol_TYPE19.incl.pl1 7386 19 03/27/82 0539.6 cobol_TYPE18.incl.pl1 >ldd>incl>cobol_TYPE18.incl.pl1 7389 20 03/27/82 0539.6 cobol_TYPE19.incl.pl1 >ldd>incl>cobol_TYPE19.incl.pl1 7393 21 03/27/82 0539.6 cobol_TYPE18.incl.pl1 >ldd>incl>cobol_TYPE18.incl.pl1 7396 22 03/27/82 0539.6 cobol_TYPE18.incl.pl1 >ldd>incl>cobol_TYPE18.incl.pl1 7397 23 03/27/82 0539.4 cobol_file_desc_1.incl.pl1 >ldd>incl>cobol_file_desc_1.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. DATA 002674 automatic structure level 1 unaligned dcl 6771 set ref 164 DIAG_NUM 002622 automatic fixed bin(17,0) dcl 6705 set ref 198* 264* 276* 279* 283* 306 310* 313* 314* END_WORD 000214 automatic fixed bin(17,0) dcl 6657 set ref 3324* 3328* 3331* 3334* 3337* 3346 3494* 3498* 3501* 3504* 3507* 3520* 3524* 3527* 3530* 3533* 3602* 3605* 3608* 3611* 3871* 3874 3876 EOF 000103 automatic fixed bin(17,0) dcl 5534 set ref 5536* 5548 5548* 5550* 6219* EW 000145 automatic fixed bin(17,0) dcl 6585 set ref 3982* 3985 6056* 6059 6063* L 015723 automatic fixed bin(17,0) dcl 6998 set ref 812 823 829 832 849 863* 867* 5115 5134* 5136* 5140* 5143* 5143 5145* LL 015724 automatic fixed bin(17,0) dcl 6998 set ref 800* 804 812 829* 832 LTP 015734 automatic bit(1) packed unaligned dcl 7012 set ref 367* 2987* 4164 4186 5871* 6178 O based structure level 1 unaligned dcl 1679 O1 002650 automatic structure level 1 unaligned dcl 6746 set ref 96 O1_ptr 002644 automatic pointer dcl 6744 set ref 96* 1667* O2 002652 automatic structure level 1 unaligned dcl 6750 set ref 97 O2_ptr 002646 automatic pointer dcl 6744 set ref 97* 1668* SAE 0(02) 002641 automatic bit(1) level 2 packed packed unaligned dcl 6724 set ref 4867* 4884* 4903* 4980* 5159 5960* ST 000216 automatic structure array level 1 unaligned dcl 6663 set ref 117 6378 SUBJ_REQ 0(05) 002641 automatic bit(1) level 2 packed packed unaligned dcl 6724 set ref 2011 4405* 4415* 4972* 5002* 5220* 5238* 5251 5254* 6405* 6409* 6413* TAG 015726 automatic fixed bin(17,0) dcl 7010 set ref 5650* 5652 5656 UB_ind 0(03) 002641 automatic bit(1) initial level 2 packed packed unaligned dcl 6724 set ref 597 600* 4284* 4545* 4814* 4818* 4823* 4828* 5554* 6254* 6264* 6319* 6402* 6724* a 1 000216 automatic bit(3) array level 3 in structure "ST" packed packed unaligned dcl 6663 in procedure "cobol_pdstax" set ref 6086 a 3 015676 automatic structure level 2 in structure "act_log" packed packed unaligned dcl 6929 in procedure "cobol_pdstax" a 11 000777 internal static bit(3) level 2 in structure "end_stmt" packed packed unaligned dcl 7379 in procedure "cobol_pdstax" set ref 574 2514 2759* 3239* 3268* 3283* 3289* 3296* 3306* 3312* 3320* 3568* 3658* 3695* 3702* 3731* 3859* 3976* 3985* 4528* 4531* 4653* 4694* 4696* 6086* 6088* 6135 6139 6191* 6392* 6396* a 2 015107 automatic structure array level 2 in structure "astack" packed packed unaligned dcl 6900 in procedure "cobol_pdstax" a_num 4 based fixed bin(17,0) level 2 dcl 7086 set ref 245* 248* 259 266 273 abs_offset parameter fixed bin(24,0) dcl 2346 ref 2342 2349 abs_record_offset 14 based fixed bin(24,0) level 2 dcl 3-25 ref 2349 accept_device 10(10) based bit(1) level 3 packed packed unaligned dcl 7375 ref 2763 access 45 based fixed bin(17,0) level 2 dcl 3-25 ref 765 765 874 1033 1146 1452 1452 1534 2269 2269 act_log 015676 automatic structure level 1 unaligned dcl 6929 set ref 115 act_log_bits based bit(124) packed unaligned dcl 6568 set ref 5411* 5473 5488 5517 5518* 5531 5552* 5633* 5678* act_log_ptr 000114 automatic pointer dcl 6561 set ref 115* 116 5411 5473 5488 5517 5518 5531 5552 5633 5678 act_num 000144 automatic fixed bin(17,0) dcl 6585 set ref 266* 284* 291 ad_bit 22(25) based bit(1) level 2 packed packed unaligned dcl 7360 set ref 3713* addr builtin function dcl 6554 ref 94 96 97 100 115 117 123 142 144 145 147 148 149 150 151 152 155 157 158 159 160 161 162 164 167 169 170 174 175 176 177 181 185 186 187 188 189 190 199 222 334 3358 3363 3382 4024 4026 4046 4066 4181 4181 4341 4341 4349 4349 4357 4361 4361 4386 4387 4463 4475 4476 4493 4494 4495 4551 4567 4588 4603 4613 4780 4791 4793 4799 4870 4889 4917 4988 5035 5155 5221 5240 5256 5289 5410 5438 5472 5487 5515 5530 5551 5569 5580 5632 5677 5945 6135 6139 6378 addr_record 2 015760 automatic pointer level 2 dcl 7061 set ref 167* 168 227 231 375 379* 381 384 384 389* 393 393 403 540 540 540 550 558 563 584 593 606 606 606 619 644 676 676 676 676 676 676 676 687 692 741 743 749 781 781 804 810* 823 830* 841 847* 917 933 943 943 951 955 965 972 977 982 982 985 1009 1015 1051 1086 1093 1093 1098 1098 1103 1103 1113 1118 1130 1130 1130 1167 1167 1176 1176 1187 1187 1202 1208 1208 1208 1213 1213 1219 1219 1219 1219 1219 1225 1225 1225 1233 1233 1246 1246 1259 1259 1259 1264 1297 1297 1305 1305 1354 1373 1373 1376 1379 1394 1394 1399 1404 1404 1409 1412 1415 1415 1419 1424 1439 1439 1439 1466 1472 1493 1540 1540 1540 1540 1546 1557 1557 1561 1569 1569 1586 1586 1586 1594 1594 1594 1599 1599 1599 1599 1599 1599 1608 1608 1612 1612 1612 1612 1617 1617 1617 1617 1617 1617 1634 1640 1640 1648 1651 1654 1667* 1708 1708 1708 1713 1716 1716 1716 1720 1720 1723 1723 1723 1733 1733 1733 1745 1758 1764 1768 1787 1787 1809 1809 1888 1892 1901 1905 1914 1918 1922 1922 1932 1932 1941 1946 1946 1946 1951 1956 1956 1962 1962 1962 1962 1969 1974 1974 1979 1984 1992 1994 2001 2006 2006 2006 2098 2098 2124 2124 2154 2160 2164 2178 2186 2194 2204 2204 2204 2204 2204 2216 2216 2222 2242 2242 2250 2250 2260 2264 2297 2297 2297 2297 2318 2321 2329 2354 2354 2371 2371 2371 2371 2371 2389 2390 2403 2404 2424 2432 2437 2437 2455 2483 2486 2497 2514 2519 2605 2621 2634 2637 2651 2656 2673 2673 2673 2673 2673 2683 2689 2689 2695 2695 2695 2707 2719 2722 2725 2735 2739 2746 2751 2763 2763 2770 2770 2777 2777 2784* 2799 2815 2827 2852 2859 2863 2865 2867 2869 2893 2897 2900 2911 2964 2980 2998 2998 2998 3009 3009 3009 3009 3031 3031 3044 3044 3044 3044 3324 3328 3331 3334 3337 3407 3407 3409 3409 3415 3415 3417 3417 3429 3450 3466 3469 3470 3471 3473 3494 3498 3501 3504 3507 3520 3524 3527 3530 3533 3545 3548 3562 3598 3605 3608 3611 3713 3714 3715 3716 3719 3722 3726 3726 3777 3818 4003 4003 4003 4025 4033 4046 4066 4066 4171 4172 4175 4180 4181 4209 4215 4242 4248 4297 4298 4368 4374 4396 4433 4463 4478 4496 4505 4528 4551 4554 4555 4589 4595 4596 4613 4708 4710 4778 4879 4909 4909 4909 4911 4920 4955 4966 5056 5059 5064 5076 5079 5079 5091 5097 5099 5102 5102 5106 5136 5136 5138 5138 5140 5143 5143 5145 5145 5145 5145 5178 5178 5202 5203 5280 5465 5467 5478 5480 5497 5499 5583 5584 5585 5715 5779 5783 5840 5858 5859 5862 5929 5930 5933 5977 5977 5985 6143 6145 6152 ae 000210 automatic structure level 1 unaligned dcl 6643 all_lit 4(01) based bit(1) level 2 packed packed unaligned dcl 7353 set ref 3471* 4396* alpha_cond 134(06) based bit(1) level 2 packed packed unaligned dcl 2-26 set ref 4412* alphabet_name based structure level 1 unaligned dcl 7343 alphabetic 21(21) based bit(1) level 2 packed packed unaligned dcl 7360 ref 1608 1713 1733 1809 1847 1974 2068 2204 2371 5145 alphabetic_edited 21(22) based bit(1) level 2 packed packed unaligned dcl 7360 ref 1219 1809 alphanum 21(19) based bit(1) level 2 packed packed unaligned dcl 7360 ref 611 1246 1594 1708 1716 1723 1733 1733 1787 1880 1974 2186 2204 2371 5145 alphanum_edited 21(20) based bit(1) level 2 packed packed unaligned dcl 7360 ref 1219 1246 1594 1708 1716 1723 1733 1733 1787 1854 2194 5145 alphanum_lit based structure level 1 unaligned dcl 7353 alt_key 4 based structure array level 2 unaligned dcl 23-7 alt_key_info 23(27) based char(5) level 2 packed packed unaligned dcl 3-25 ref 2312 alterable 10(07) based bit(1) level 2 packed packed unaligned dcl 7357 ref 644 alternate_keys 51 based fixed bin(17,0) level 2 dcl 3-25 ref 2306 2318 2328 andor 000172 automatic structure level 1 unaligned dcl 6622 arg_1 002660 automatic pointer level 2 dcl 6763 set ref 158* 3377* 3393* 3445* 3556* 3577* 3592* 3649* 3920* 3929* 4386* 4475* 4493* 4567* 4588* 4603* 4778* 4791* 4799* arg_2 2 002660 automatic pointer level 2 dcl 6763 set ref 159* 4387* 4476* 4494* 4589* 4780* 4793* arg_3 4 002660 automatic pointer level 2 dcl 6763 set ref 160* 4477* 4495* arg_4 6 002660 automatic pointer level 2 dcl 6763 set ref 161* 4478* 4496* arg_5 10 002660 automatic pointer level 2 dcl 6763 set ref 162* arg_6 12 002660 automatic pointer level 2 dcl 6763 set ref 164* arith_op 5(01) based bit(1) level 2 in structure "reserved_word" packed packed unaligned dcl 7347 in procedure "cobol_pdstax" ref 1399 1979 arith_op 015055 automatic bit(1) packed unaligned dcl 6858 in procedure "cobol_pdstax" set ref 153* 4883* 4905* 4959* 4971* 4982* 4994* 4998* 5004 5008* 5019 5350 5354* 6170 6174* ascii_packed_dec_h 21(29) based bit(1) level 2 packed packed unaligned dcl 7360 ref 1686 assub 000033 internal static fixed bin(17,0) dcl 7014 set ref 120* 2073 2073 2078 2082 4865* 4865 4870 4873 4874 4887* 4887 4889 4892 4913 4915* 4915 4917 4920 4925 4929* 4929 4939 4942 4946 4950* 4950 4958* 4958 4979* 4988 astack 015107 automatic structure array level 1 unaligned dcl 6900 set ref 4870 4889 4917 4988 astack_bits based bit(88) packed unaligned dcl 6574 set ref 4871* 4890* 4918* 4989* astack_ptr 000132 automatic pointer dcl 6563 set ref 4870* 4871 4889* 4890 4917* 4918 4988* 4989 b 11(03) 000777 internal static bit(1) level 2 packed packed unaligned dcl 7379 set ref 3168* 3201* 3462* 3713 3887* 3988* 5845* 6129* 6197* 6202* base 3 based fixed bin(17,0) array level 3 dcl 4-9 ref 384 bit16 based bit(16) packed unaligned dcl 6581 set ref 116* 6135 6139* bit180 based bit(180) packed unaligned dcl 6580 set ref 117* 6378* bit9 based bit(9) packed unaligned dcl 6819 set ref 100* 4181* 4181 bit_offset 31(16) based bit(4) level 2 packed packed unaligned dcl 7360 ref 1688 bool builtin function dcl 6554 ref 3085 5261 6366 bool_fcn parameter bit(4) packed unaligned dcl 3081 ref 3077 3085 c 11(04) 000777 internal static bit(1) level 2 in structure "end_stmt" packed packed unaligned dcl 7379 in procedure "cobol_pdstax" set ref 2753* 2755* 3241* 3275* 3314* c 3 015716 automatic structure level 2 in structure "coperator" packed packed unaligned dcl 6985 in procedure "cobol_pdstax" set ref 155 c 3 015222 automatic structure array level 2 in structure "cstack" packed packed unaligned dcl 6910 in procedure "cobol_pdstax" c26 based char(28) packed unaligned dcl 7224 set ref 4349* 4349 4361* 4361 c_ptr 015730 automatic pointer dcl 7011 set ref 155* 3093 cdtoken based structure level 1 unaligned dcl 15-8 cdtoken_ptr 017242 automatic pointer dcl 15-5 set ref 168* 699 706 706 cl parameter char(1) packed unaligned dcl 6475 ref 6471 6479 class 10(08) based structure level 2 packed packed unaligned dcl 7375 close 34 based bit(1) level 2 packed packed unaligned dcl 3-25 set ref 4714* cobol_$con_end_ptr 001172 external static pointer dcl 5-10 ref 2315 cobol_$diag_ptr 001174 external static pointer dcl 5-70 ref 384 384 cobol_c_list 001156 constant entry external dcl 7056 ref 354 379 389 419 433 451 468 487 6550 cobol_cmfp defined pointer dcl 1-21 set ref 510* 517* 4341* cobol_com_ptr defined pointer dcl 1-25 ref 200 242 271 530 545 625 668 737 1041 1076 1457 1988 2531 2539 2547 2555 2567 2569 2571 2573 2583 2585 2595 2597 2599 2613 2873 2902 2976 2976 2980 2988 2998 4319 4346 4348 4402 4412 4456 4471 4471 4473 4476 4489 4489 4491 4494 5019 5112 5175 5308 5329 5335 5346 5401 5709 5721 5727 5733 5739 5949 5970 5981 6149 6282 6282 6284 6386 6396 6479 cobol_ext_$cobol_cmfp 001162 external static pointer dcl 1-20 ref 510 510 517 517 4341 4341 cobol_ext_$cobol_com_ptr 001164 external static pointer dcl 1-24 ref 200 200 242 242 271 271 530 530 545 545 625 625 668 668 737 737 1041 1041 1076 1076 1457 1457 1988 1988 2531 2531 2539 2539 2547 2547 2555 2555 2567 2567 2569 2569 2571 2571 2573 2573 2583 2583 2585 2585 2595 2595 2597 2597 2599 2599 2613 2613 2873 2873 2902 2902 2976 2976 2976 2976 2980 2980 2988 2988 2998 2998 4319 4319 4346 4346 4348 4348 4402 4402 4412 4412 4456 4456 4471 4471 4471 4471 4473 4473 4476 4476 4489 4489 4489 4489 4491 4491 4494 4494 5019 5019 5112 5112 5175 5175 5308 5308 5329 5329 5335 5335 5346 5346 5401 5401 5709 5709 5721 5721 5727 5727 5733 5733 5739 5739 5949 5949 5970 5970 5981 5981 6149 6149 6282 6282 6282 6282 6284 6284 6386 6386 6396 6396 6479 6479 cobol_ext_$cobol_pdofp 001166 external static pointer dcl 1-44 ref 494 494 502 502 3998 3998 4137 4137 5185 5185 5188 5188 5190 5190 5192 5192 cobol_ext_$cobol_rm2fp 001170 external static pointer dcl 1-48 ref 370 370 cobol_idedsyn$get_seg_limit 001126 constant entry external dcl 6438 ref 118 cobol_imp_word$lang_name 001154 constant entry external dcl 7000 ref 2784 cobol_pd_code$code 001152 constant entry external dcl 6757 ref 3380 3395 3448 3559 3580 3594 3652 3675 3923 3932 3940 3945 3955 4107 4131 4390 4481 4499 4521 4542 4571 4592 4606 4621 4625 4632 4641 4656 4668 4677 4686 4782 4795 4803 5695 5701 cobol_pd_code$initialize 001150 constant entry external dcl 6755 ref 165 cobol_pdofp defined pointer dcl 1-45 set ref 494* 502* 3998* 4137* 5185* 5188* 5190* 5192* cobol_pdst 001160 constant entry external dcl 7220 ref 180 cobol_read_ft_ 001146 constant entry external dcl 6754 ref 563 692 722 763 889 956 1002 1029 1119 1144 1266 1509 1532 2165 2265 2520 2638 2657 2938 2956 3723 4434 4711 5783 cobol_rm2fp defined pointer dcl 1-49 set ref 370* cobol_swf_get 001134 constant entry external dcl 6733 ref 370 cobol_swf_put 001140 constant entry external dcl 6737 ref 494 502 3998 4137 5185 5188 5190 5192 cobol_syntax_trace_$initialize_phase 001132 constant entry external dcl 6703 ref 202 cobol_syntax_trace_$trace 001130 constant entry external dcl 6701 ref 215 234 288 295 331 342 cobol_vdwf_dget 001136 constant entry external dcl 6736 ref 510 cobol_vdwf_dput 001144 constant entry external dcl 6739 ref 517 cobol_vdwf_sput 001142 constant entry external dcl 6738 ref 4341 code_env 002660 automatic structure level 1 unaligned dcl 6763 set ref 157 161 code_env_ptr 002654 automatic pointer dcl 6759 set ref 157* 165* code_option 002656 automatic fixed bin(17,0) dcl 6761 set ref 162 3379* 3394* 3447* 3558* 3579* 3593* 3651* 3673* 3922* 3931* 3938* 3943* 3953* 4091* 4095* 4099* 4103* 4129* 4389* 4480* 4498* 4519* 4541* 4570* 4591* 4605* 4619* 4624* 4630* 4640* 4655* 4666* 4675* 4685* 4781* 4794* 4802* 5693* 5699* col 1 000176 automatic fixed bin(17,0) level 2 in structure "oploc" dcl 6631 in procedure "cobol_pdstax" set ref 2722* 5329* col 4 000154 automatic fixed bin(17,0) level 2 in structure "op" dcl 6592 in procedure "cobol_pdstax" set ref 5054* col 1 000172 automatic fixed bin(17,0) level 2 in structure "andor" dcl 6622 in procedure "cobol_pdstax" set ref 5467* 5480* 5499* col 4 000162 automatic fixed bin(17,0) level 2 in structure "left" dcl 6604 in procedure "cobol_pdstax" set ref 5338* col 1 000170 automatic fixed bin(17,0) level 2 in structure "not" dcl 6617 in procedure "cobol_pdstax" set ref 5401* 6145* 6152* 6156* col_num parameter fixed bin(17,0) dcl 477 ref 473 482 column 2 based fixed bin(17,0) level 2 in structure "reserved_word" dcl 7347 in procedure "cobol_pdstax" ref 2722 2980 4879 4955 4966 5467 5480 5499 6145 column 1 000210 automatic fixed bin(17,0) level 2 in structure "ae" dcl 6643 in procedure "cobol_pdstax" set ref 4986* 5019* column 2 015032 automatic fixed bin(17,0) level 2 in structure "diag_item" dcl 6830 in procedure "cobol_pdstax" set ref 351* 417* 449* 466* 6500* column 2 017147 automatic fixed bin(17,0) initial level 2 in structure "eos_perform" dcl 7251 in procedure "cobol_pdstax" set ref 7251* column 2 016124 automatic fixed bin(17,0) level 2 in structure "header" dcl 7109 in procedure "cobol_pdstax" set ref 351 417 429 1563 2793 3433 3552 4986 5054 6332 6500 column 2 017177 automatic fixed bin(17,0) initial level 2 in structure "rw_move" dcl 7283 in procedure "cobol_pdstax" set ref 7283* column 2 001012 internal static fixed bin(17,0) level 2 in structure "dumprocname" dcl 7385 in procedure "cobol_pdstax" set ref 137* column 2 017165 automatic fixed bin(17,0) initial level 2 in structure "rw_perform" dcl 7268 in procedure "cobol_pdstax" set ref 7268* column 2 015041 automatic fixed bin(17,0) level 2 in structure "lev_diag_item" dcl 6840 in procedure "cobol_pdstax" set ref 429* 482* column 2 000777 internal static fixed bin(17,0) level 2 in structure "end_stmt" dcl 7379 in procedure "cobol_pdstax" set ref 128* column 1 015060 automatic fixed bin(17,0) level 2 in structure "sav" dcl 6860 in procedure "cobol_pdstax" set ref 245* 276* 6332* column 2 017211 automatic fixed bin(17,0) initial level 2 in structure "supp_lit" dcl 7298 in procedure "cobol_pdstax" set ref 7298* column 2 017227 automatic fixed bin(17,0) initial level 2 in structure "eos_move" dcl 7316 in procedure "cobol_pdstax" set ref 7316* column 2 based fixed bin(17,0) level 2 in structure "source" dcl 7131 in procedure "cobol_pdstax" ref 449 column_num 1 002616 automatic fixed bin(17,0) level 2 dcl 6691 set ref 466 1563* 3433* 3552* common_eof 000031 internal static bit(1) packed unaligned dcl 6894 set ref 113* common_key 015104 automatic char(5) packed unaligned dcl 6892 set ref 4341* 4348 4350 4353 4362 common_recsize 015106 automatic fixed bin(17,0) dcl 6893 set ref 510* 4432 communication_section 21(04) based bit(1) level 2 packed packed unaligned dcl 7360 ref 676 comp 3(02) 015716 automatic bit(1) level 3 packed packed unaligned dcl 6985 set ref 5217* 5296* 5302* 5326* comp_level 137 based char(1) level 2 packed packed unaligned dcl 2-26 ref 242 271 625 668 737 1988 2873 2902 2998 5019 5112 5175 5308 5329 5335 5346 5401 5949 5970 5981 6149 6386 6479 compare_argument 22 based bit(1) level 2 packed packed unaligned dcl 7360 set ref 3715* compiler_id 154 based fixed bin(17,0) level 2 dcl 2-26 ref 2613 comsrtrngptr 000010 internal static pointer dcl 6742 set ref 99* cond 1(18) 000216 automatic bit(1) array level 2 packed packed unaligned dcl 6663 set ref 2129 3760* 5816* 6205* 6294* 6467* constant_section 21(02) based bit(1) level 2 packed packed unaligned dcl 7360 ref 676 1540 1561 1941 1946 1962 2683 3429 3548 5859 convalue constant fixed bin(17,0) initial dcl 7228 ref 2391 2405 convtemp 017130 automatic fixed bin(17,0) dcl 7197 set ref 2385* 2391* 2391 2394 2399* 2405* 2405 2408 cop_c_bits based bit(16) packed unaligned dcl 7005 ref 3093 coperator 015716 automatic structure level 1 unaligned dcl 6985 set ref 150 coperator_bits based bit(124) packed unaligned dcl 6572 set ref 3097* 5241* coperator_ptr 000126 automatic pointer dcl 6563 set ref 150* 3097 5241 cra_offset 40 based fixed bin(24,0) level 2 dcl 3-25 ref 3726 cssavebit 015062 automatic bit(1) packed unaligned dcl 6872 set ref 2701 3429* 3548* 5859* cssub 000032 internal static fixed bin(17,0) dcl 7009 set ref 120* 2085 2090 2090 2093 2116 2713 3849 3849 4202* 4406 4406 4416 4416 4969 4970* 4970 4972 5034* 5034 5035 5037 5038 5152* 5152 5155 5171* 5171 5216 5219* 5219 5221 5225 5226 5235 5237* 5237 5240 5251 5253* 5253 5256 5259 5260 5261 5261 5289 5294* 5294 5295 5406* 5406 5410 5413* 5413 5438 5442* 5442 5470* 5470 5472 5485* 5485 5487 5504 5515 5529* 5529 5530 5551 5553* 5553 5632 5635* 5635 5646 5650 5652 5674 5677 5680* 5680 5881 6166 6166 6409 cstack 015222 automatic structure array level 1 unaligned dcl 6910 set ref 5035 5155 5221 5240 5256 5289 5410 5438 5472 5487 5515 5530 5551 5632 5677 cstack_bits based bit(124) packed unaligned dcl 6573 set ref 5036* 5156* 5222* 5241* 5257* 5291 5411 5440 5473* 5488* 5518 5519* 5531* 5552 5633 5678 cstack_ptr 000130 automatic pointer dcl 6563 set ref 5035* 5036 5155* 5156 5221* 5222 5240* 5241 5256* 5257 5289* 5291 5410* 5411 5438* 5440 5472* 5473 5487* 5488 5515* 5518 5519 5530* 5531 5551* 5552 5632* 5633 5677* 5678 current_line 015760 automatic fixed bin(24,0) level 2 dcl 7061 set ref 207* 219* 219 222 301 302* 324* 328* 334 339* 3227* 3227 3232* 3232 4003* 4007* 4009* cursecnum 000040 internal static fixed bin(17,0) dcl 7050 set ref 120* 1051 1051 1086 1086 4180* 4429 5721 5727 5733 5739 d 11(05) 000777 internal static bit(2) level 2 packed packed unaligned dcl 7379 set ref 1523 2740* 2970 3184* 3211* 3215* 3219* 3223* 3488* 3603* 3680* 3683* 3686* 4113* 4117* 4121* 4458* 5912* 6002* d_type 33 based fixed bin(17,0) array level 3 dcl 4-9 ref 384 data_name based structure level 1 unaligned dcl 7360 data_name_bit 015101 automatic bit(1) packed unaligned dcl 6887 set ref 2136 4027* 4240* dbp 000027 internal static fixed bin(17,0) dcl 6890 set ref 112* debug 134(01) based bit(1) level 2 packed packed unaligned dcl 2-26 ref 2976 debug_all 22(26) based bit(1) level 2 packed packed unaligned dcl 7360 set ref 3818* debugsw 000036 internal static fixed bin(17,0) dcl 7029 set ref 120* 1483 3812* declarative_proc 10(05) based bit(1) level 2 packed packed unaligned dcl 7357 ref 781 2222 2432 2432 2437 2437 2707 4374 5862 declprocbit 002631 automatic bit(1) packed unaligned dcl 6712 set ref 2707 4374* decswitch 000034 internal static fixed bin(17,0) dcl 7026 set ref 120* 195* 1515 2222 3783* 3824* 4168 5862 def_line 11 based fixed bin(17,0) level 2 dcl 7360 ref 1640 1640 delete 34(01) based bit(1) level 2 packed packed unaligned dcl 3-25 set ref 4422* desc 1 000216 automatic structure array level 2 packed packed unaligned dcl 6663 set ref 6135* 6139 descr 5 000162 automatic structure level 2 in structure "left" packed packed unaligned dcl 6604 in procedure "cobol_pdstax" descr 5 000154 automatic structure level 2 in structure "op" packed packed unaligned dcl 6592 in procedure "cobol_pdstax" set ref 5049* device 47 based fixed bin(17,0) level 2 dcl 3-25 ref 2940 dg_num parameter fixed bin(17,0) dcl 6475 set ref 6471 6482* dg_ptr 015026 automatic pointer dcl 6827 set ref 181* 354* 419* 451* 468* diag_file based structure level 1 unaligned dcl 4-9 diag_item 015032 automatic structure level 1 unaligned dcl 6830 set ref 181 diag_num parameter fixed bin(17,0) dcl 477 in procedure "LEV_DIAG" ref 473 483 diag_num parameter fixed bin(17,0) dcl 426 in procedure "lev_diag" ref 423 430 diag_num parameter fixed bin(17,0) dcl 411 in procedure "diag" ref 408 416 diag_num parameter fixed bin(17,0) dcl 463 in procedure "DIAG" ref 456 465 diag_num parameter fixed bin(17,0) dcl 446 in procedure "DIAG_PREV_TOKEN" ref 440 448 diag_table 31 based structure array level 2 unaligned dcl 4-9 diagno 000037 internal static fixed bin(17,0) dcl 7034 set ref 120* 3756* 3766* dimensions 2 based fixed bin(17,0) level 2 dcl 7363 ref 1342 4068 display 21(27) based bit(1) level 2 packed packed unaligned dcl 7360 ref 1208 1213 1219 1404 1557 1569 2047 2065 display_device 10(11) based bit(1) level 3 packed packed unaligned dcl 7375 ref 2770 dn parameter fixed bin(17,0) dcl 5016 set ref 5012 5019* dpnptr 017122 automatic pointer dcl 7175 set ref 142* 3117 3592 6029 drc 000030 internal static fixed bin(9,0) dcl 6891 set ref 112* dumfix 016110 automatic fixed bin(17,0) dcl 7076 set ref 180* dumprocname 001012 internal static structure level 1 unaligned dcl 7385 set ref 142 160 duplicate 10(01) 001012 internal static bit(1) level 2 packed packed unaligned dcl 7385 set ref 140* 4854* 4857* 5669* 5683* e 3 000216 automatic fixed bin(17,0) array level 2 in structure "ST" dcl 6663 in procedure "cobol_pdstax" set ref 3838 6007* 6013* 6089 6209 e 5 017227 automatic fixed bin(17,0) initial level 2 in structure "eos_move" dcl 7316 in procedure "cobol_pdstax" set ref 7316* e 5 001037 internal static fixed bin(17,0) level 2 in structure "opeos" dcl 7388 in procedure "cobol_pdstax" set ref 3145* 4925* 4946* 5659* 6238* e 5 017147 automatic fixed bin(17,0) initial level 2 in structure "eos_perform" dcl 7251 in procedure "cobol_pdstax" set ref 7251* e 5 000777 internal static fixed bin(17,0) level 2 in structure "end_stmt" dcl 7379 in procedure "cobol_pdstax" set ref 545 924 1251 3186* 3186 3195* 3195 3298* 3421* 3421 3547* 3547 3664* 3664 3717* 3717 3888* 3895* 3902* 3909* 3916* 4505* 4508* 4513* 5856* 5856 5991* 5991 5995* 5998* 6089* elementary 21(09) based bit(1) level 2 packed packed unaligned dcl 7360 ref 1167 1176 1208 1219 1225 1233 1439 1540 1569 1599 1612 1617 1617 1946 1956 1962 2047 2065 2204 2673 2689 2695 2799 end_cobol 5(07) based bit(1) level 2 packed packed unaligned dcl 7347 ref 965 end_dec 5(04) based bit(1) level 2 packed packed unaligned dcl 7347 ref 743 1932 1994 2998 end_decl_bit 015056 automatic bit(1) packed unaligned dcl 6859 set ref 143* 393 1936* 4223* end_stmt 000777 internal static structure level 1 unaligned dcl 7379 set ref 152 158 177 end_stmt_bits based bit(197) packed unaligned dcl 6575 set ref 3174* 3776* 3992* 4156* 4177* 4190* 4221* 6273* end_stmt_chars based char(44) packed unaligned dcl 7022 set ref 3795 3964* 6127* end_stmt_ptr 000134 automatic pointer dcl 6563 set ref 151* 3174 3776 3992 4156 4177 4190 4221 6273 end_wd 000216 automatic fixed bin(17,0) array level 2 dcl 6663 set ref 3346* 3871 3982 5818 5847 6056 6063 6071 6368 eos_move 017227 automatic structure level 1 unaligned dcl 7316 set ref 189 eos_move_ptr 017224 automatic pointer dcl 7312 set ref 189* 5192* eos_move_size 017226 automatic fixed bin(17,0) initial dcl 7312 set ref 5192* 7312* eos_perform 017147 automatic structure level 1 unaligned dcl 7251 set ref 185 eos_perform_ptr 017144 automatic pointer dcl 7247 set ref 185* 4137* eos_perform_size 017146 automatic fixed bin(17,0) initial dcl 7247 set ref 4137* 7247* eosptr 017114 automatic pointer dcl 7155 set ref 177* 502* err 015022 automatic fixed bin(17,0) dcl 6808 set ref 1321* 1332* 1336* 4051 4051* error_exit 77 based fixed bin(17,0) level 2 dcl 3-25 set ref 905 2522 2563 2579 2591 4429* es_ptr 000124 automatic pointer dcl 6561 set ref 152* 3795 3964 6127 exp_places 5 017211 automatic fixed bin(17,0) initial level 2 dcl 7298 set ref 7298* exp_redefining 22(22) based bit(1) level 2 packed packed unaligned dcl 7360 ref 943 expind 000206 automatic bit(1) packed unaligned dcl 6640 set ref 4882* 4901* 4955* 4966* 4977* exten based char(1) array packed unaligned dcl 7187 set ref 4026 4066 extend_error_exit 131 based fixed bin(17,0) level 2 dcl 2-26 set ref 2555 2573 2599 5739* f 11(07) 000777 internal static bit(2) level 2 in structure "end_stmt" packed packed unaligned dcl 7379 in procedure "cobol_pdstax" set ref 3247* 3261* 3515* 3603* 3697* 3704* 4808* 4810* 6106* 6131* 6309* f parameter bit(2) packed unaligned dcl 6126 in procedure "a294" ref 6124 6131 false 1 015676 automatic fixed bin(17,0) level 2 in structure "act_log" dcl 6929 in procedure "cobol_pdstax" set ref 4538* 4846* 4858 4858* 5425 5426* 5448* 5455 5456* 5469* 5483 5483* 5501* 5504* 5524* 5638 5638* 5684 5684* 6250 6250* 6262 6262* false 1 015222 automatic fixed bin(17,0) array level 2 in structure "cstack" dcl 6910 in procedure "cobol_pdstax" set ref 3849* 5504* false 1 015702 automatic fixed bin(17,0) level 2 in structure "work" dcl 6946 in procedure "cobol_pdstax" set ref 5448* fatal_no 20 based fixed bin(17,0) level 2 dcl 2-26 ref 5709 fb26 000572 internal static fixed bin(17,0) initial dcl 7226 set ref 4341* 4358 fd_token based structure level 1 unaligned dcl 7369 figcon 5(02) based bit(1) level 2 packed packed unaligned dcl 7347 ref 741 749 1409 1608 1708 file_count 016123 automatic fixed bin(17,0) dcl 7105 set ref 3490* 4769* 4774* 4774 4786* 4793 file_desc_1 based structure level 1 unaligned dcl 23-7 file_desc_1_offset 13 based fixed bin(24,0) level 2 dcl 3-25 ref 2315 file_desc_1_ptr 017244 automatic pointer dcl 23-5 set ref 2315* 2321 2329 file_key based structure level 1 unaligned dcl 6783 file_no 35 based fixed bin(17,0) level 2 in structure "file_table" dcl 3-25 in procedure "cobol_pdstax" ref 2318 file_no 12 based fixed bin(17,0) level 2 in structure "fd_token" dcl 7369 in procedure "cobol_pdstax" set ref 558 563* 687 692* 716 721 757 762 884 888 951 955 996 1001 1015 1021 1028 1086 1113 1118 1202 1503 1508 1528 1531 2260 2264 2514 2519 2634 2637 2651 2656 4433 4708 4710 5779 5783* file_num 14 based fixed bin(17,0) level 2 dcl 7360 ref 1009 1009 1015 1051 1138 1143 1159 1202 1259 1264 1447 1969 1969 2154 2154 2160 2164 2318 2932 2937 2950 2955 3722 file_number 015014 automatic fixed bin(17,0) dcl 6775 set ref 721* 722* 762* 763* 888* 889* 955* 956* 1001* 1002* 1028* 1029* 1118* 1119* 1143* 1144* 1264* 1266* 1508* 1509* 1531* 1532* 2164* 2165* 2264* 2265* 2519* 2520* 2637* 2638* 2656* 2657* 2937* 2938* 2955* 2956* 3722* 3723* 4433* 4434* 4710* 4711* file_org 000140 automatic fixed bin(17,0) dcl 6585 set ref 565* 693* 1268* 3232 file_section 21 based bit(1) level 2 packed packed unaligned dcl 7360 ref 676 1259 file_table based structure level 1 unaligned dcl 3-25 fircar 000026 internal static bit(1) packed unaligned dcl 6889 set ref 111* fixed builtin function dcl 6554 ref 619 2391 2405 2450 2455 4172 4175 4298 4307 4555 4596 5929 5933 fixed_common based structure level 1 unaligned dcl 2-26 fkey_ptr 015020 automatic pointer dcl 6807 set ref 2295* 2297 2297 2297 2297 fkname 25 based char(30) level 2 packed packed unaligned dcl 6783 ref 2297 fkname_size 24 based fixed bin(17,0) level 2 dcl 6783 ref 2297 fkoffset 23 based fixed bin(24,0) level 2 dcl 6783 ref 2297 fkseg_num 22 based fixed bin(17,0) level 2 dcl 6783 ref 2297 format 015023 automatic fixed bin(17,0) dcl 6808 set ref 1316* 1318* 1320* 1324 1329* 1331* 1332 ft_ptr 015016 automatic pointer dcl 6779 set ref 563* 565 692* 693 722* 724 763* 765 765 874 889* 893 905 956* 960 960 1002* 1004 1029* 1033 1119* 1122 1122 1144* 1146 1146 1146 1266* 1268 1270 1274 1286 1286 1452 1452 1452 1452 1509* 1532* 1534 2165* 2169 2265* 2269 2269 2269 2269 2269 2278 2288 2293 2306 2306 2312 2315 2318 2318 2328 2349 2414 2414 2520* 2522 2563 2579 2591 2638* 2640 2657* 2659 2665 2938* 2940 2956* 2958 2958 3723* 3726 4422 4429 4431 4434* 4435* 4711* 4714 4718 4722 4726 4730 5745 5757 5763 5768 5773 5783* 5787 5791 5795 5799 g 11(09) 000777 internal static bit(2) level 2 packed packed unaligned dcl 7379 set ref 3251* 3254* 3257* gotodep 000014 internal static bit(1) packed unaligned dcl 6824 set ref 104* 2173 4381* 5586* h 4 000216 automatic fixed bin(17,0) array level 2 in structure "ST" dcl 6663 in procedure "cobol_pdstax" set ref 3847* 5548* 5550 5606* 6008* 6014* 6091 6218* 6247* 6301* 6368* h 6 017227 automatic fixed bin(17,0) initial level 2 in structure "eos_move" dcl 7316 in procedure "cobol_pdstax" set ref 7316* h 6 017147 automatic fixed bin(17,0) initial level 2 in structure "eos_perform" dcl 7251 in procedure "cobol_pdstax" set ref 7251* h 6 001037 internal static fixed bin(17,0) level 2 in structure "opeos" dcl 7388 in procedure "cobol_pdstax" set ref 3146* 5652* 5656* 6239* h 6 000777 internal static fixed bin(17,0) level 2 in structure "end_stmt" dcl 7379 in procedure "cobol_pdstax" set ref 3291* 3291 3300* 3365* 3365 3427* 3427 3570* 3570 3744* 3744 3888* 5838* 5838 6091* head_ptr 000112 automatic pointer dcl 6557 set ref 145* 3358 3363 3382 4024 5569 5580 header 016124 automatic structure level 1 unaligned dcl 7109 set ref 145 167 headerb based structure level 1 unaligned dcl 7158 histno 017131 automatic fixed bin(17,0) dcl 7198 set ref 4712 4736* 4743* 4750* 4757* 4764* holdatrue 015725 automatic fixed bin(17,0) dcl 7004 set ref 5424* 5426 5454* 5456 i 017764 automatic fixed bin(17,0) dcl 6051 in procedure "test_stack" set ref 6055* 6056 6062* 6062 6063 6070* 6070* i 7 001037 internal static fixed bin(17,0) level 2 in structure "opeos" dcl 7388 in procedure "cobol_pdstax" set ref 3093* i 7 017147 automatic fixed bin(17,0) initial level 2 in structure "eos_perform" dcl 7251 in procedure "cobol_pdstax" set ref 7251* i 7 017227 automatic fixed bin(17,0) initial level 2 in structure "eos_move" dcl 7316 in procedure "cobol_pdstax" set ref 7316* i 7 000777 internal static fixed bin(17,0) level 2 in structure "end_stmt" dcl 7379 in procedure "cobol_pdstax" set ref 2739* 3407 3407* 3415 3415* 3888* 4456* i 017576 automatic fixed bin(17,0) dcl 4064 in procedure "test_subs" set ref 4068* 4070 4072* i1 000041 internal static fixed bin(17,0) dcl 7072 set ref 122* 293* 293 298 301 328 335* 335 339 345* 345 4202* i_o_error_exit 130 based fixed bin(17,0) level 2 dcl 2-26 set ref 2547 2571 2585 2597 5733* ii 016121 automatic fixed bin(17,0) dcl 7105 set ref 2389* 2390* 2403* 2404* imper_verb 5(06) based bit(1) level 2 packed packed unaligned dcl 7347 set ref 972 5584* ind_data 0(02) 000212 automatic bit(1) level 2 packed packed unaligned dcl 6647 set ref 1180* 2819 index 5 000162 automatic bit(1) level 3 in structure "left" packed packed unaligned dcl 6604 in procedure "cobol_pdstax" set ref 5366 index 5 000154 automatic bit(1) level 3 in structure "op" packed packed unaligned dcl 6592 in procedure "cobol_pdstax" set ref 5097* 5120* 5366 5374 index_name based structure level 1 unaligned dcl 7366 index_name_bit 015102 automatic bit(1) packed unaligned dcl 6888 set ref 2136 4027* 4234* index_no 15 based fixed bin(17,0) level 2 dcl 7366 ref 1354 indexed_by 22(09) based bit(1) level 2 packed packed unaligned dcl 7360 ref 1093 indexedno 3 based fixed bin(17,0) array level 3 dcl 7363 ref 1345 1354 indicators 002641 automatic structure level 1 packed packed unaligned dcl 6724 info 6 015032 automatic bit(8) level 2 packed packed unaligned dcl 6830 set ref 196* init_cd 133(34) based bit(1) level 2 packed packed unaligned dcl 2-26 ref 530 6396 input 10(08) based bit(1) level 3 in structure "cdtoken" packed packed unaligned dcl 15-8 in procedure "cobol_pdstax" ref 699 input 000043 internal static fixed bin(17,0) dcl 7168 in procedure "cobol_pdstax" set ref 132* input_error_exit 126 based fixed bin(17,0) level 2 dcl 2-26 set ref 2531 2567 2583 5721* int_data 0(01) 000212 automatic bit(1) level 2 packed packed unaligned dcl 6647 set ref 1172* 1179* 2829 int_lit 000212 automatic bit(1) level 2 packed packed unaligned dcl 6647 set ref 1171* 1178* 2842 integer 5(03) 000162 automatic bit(1) level 3 in structure "left" packed packed unaligned dcl 6604 in procedure "cobol_pdstax" set ref 5374 5385 integer 5(03) 000154 automatic bit(1) level 3 in structure "op" packed packed unaligned dcl 6592 in procedure "cobol_pdstax" set ref 5067* 5076* 5106* 5369 5388 integral 4 based bit(1) level 2 packed packed unaligned dcl 7350 ref 606 1187 1373 1394 1594 1794 1951 2497 2893 interp 015760 automatic structure level 1 unaligned dcl 7061 set ref 199 intrp_stack 015772 automatic fixed bin(24,0) array dcl 7072 set ref 301* 328 339 is_not_rel 0(04) 002641 automatic bit(1) level 2 packed packed unaligned dcl 6724 set ref 4404* 4414* 5223* 5292* 5306 6162* iscond 000136 automatic bit(1) packed unaligned dcl 6582 set ref 3025 5243* 5751* item_length 16 based fixed bin(24,0) level 2 dcl 7360 ref 867 1130 1404 1697 1716 1720 1723 1723 1733 1733 1758 1764 1768 1768 1922 5136 5145 5178 item_signed 21(25) based bit(1) level 2 packed packed unaligned dcl 7360 ref 1130 1599 1599 1617 1617 1617 1617 1693 1802 1914 1914 1918 5140 itemsize based char(512) packed unaligned dcl 7172 set ref 3358* 3358 3363* 3363 3382* 3382 3450* 3450 3545* 3545 3562* 3562 4024* 4024 4463* 4463 4551* 4551 4613* 4613 5569* 5569 5580* 5580 5840* 5840 5858* 5858 itemsize1 based char(512) packed unaligned dcl 7016 set ref 375* 375 iw_key 11 based fixed bin(17,0) level 2 in structure "alphabet_name" dcl 7343 in procedure "cobol_pdstax" ref 2739 iw_key 12 based fixed bin(17,0) level 2 in structure "mnemonic_name" dcl 7375 in procedure "cobol_pdstax" ref 2242 2242 2250 2250 4505 4528 j 10 017147 automatic fixed bin(17,0) initial level 2 in structure "eos_perform" dcl 7251 in procedure "cobol_pdstax" set ref 7251* j 10 017227 automatic fixed bin(17,0) initial level 2 in structure "eos_move" dcl 7316 in procedure "cobol_pdstax" set ref 7316* j 10 000777 internal static fixed bin(17,0) level 2 in structure "end_stmt" dcl 7379 in procedure "cobol_pdstax" set ref 3409 3409* 3417 3417* jkperfcode 1 based fixed bin(17,0) level 2 dcl 6849 ref 4326 jkperflink 2 based char(5) level 2 packed packed unaligned dcl 6849 ref 4328 4333 jkperfprocnum based fixed bin(17,0) level 2 dcl 6849 ref 4326 jkperfrng based structure level 1 unaligned dcl 6849 jkpfm_ptr 015050 automatic pointer dcl 6856 set ref 4324* 4326 4326 4328 4333 jmp_ndx 6 017165 automatic fixed bin(17,0) initial level 2 in structure "rw_perform" dcl 7268 in procedure "cobol_pdstax" set ref 7268* jmp_ndx 6 017177 automatic fixed bin(17,0) initial level 2 in structure "rw_move" dcl 7283 in procedure "cobol_pdstax" set ref 7283* jump_index 6 based fixed bin(17,0) level 2 dcl 7347 ref 1424 junk_ptr 015074 automatic pointer dcl 6882 set ref 4356* just_right 21(35) based bit(1) level 2 packed packed unaligned dcl 7360 ref 2178 kc 002633 automatic fixed bin(17,0) dcl 6717 set ref 2328* 2329 2332* key 000105 automatic fixed bin(17,0) dcl 6488 in procedure "cobol_pdstax" set ref 2751* 2753 2755 5933* 5936 5936 key 4 017165 automatic fixed bin(17,0) initial level 2 in structure "rw_perform" dcl 7268 in procedure "cobol_pdstax" set ref 7268* key 015107 automatic fixed bin(17,0) array level 2 in structure "astack" dcl 6900 in procedure "cobol_pdstax" set ref 4874* 4913 4920* 4925 4942 4946 key 4 017177 automatic fixed bin(17,0) initial level 2 in structure "rw_move" dcl 7283 in procedure "cobol_pdstax" set ref 7283* key 4 based fixed bin(17,0) level 2 in structure "reserved_word" dcl 7347 in procedure "cobol_pdstax" set ref 231 985 1472 1605 1711 1932 1984 2006 2006 2006 2751 2863 2865 2867 2869 2998 3009 3009 3009 3031 3044 3044 3044 3324 3328 3331 3334 3337 3494 3498 3501 3504 3507 3520 3524 3527 3530 3533 3598 3605 3608 3611 3777 4003 4003 4909 4909 4909 4911 4920 5064 5280 5585* key_a 22(07) based bit(1) level 2 packed packed unaligned dcl 7360 ref 1103 key_count 016122 automatic fixed bin(17,0) dcl 7105 set ref 3490* 3711* 3711 4786* 4791 key_d 22(08) based bit(1) level 2 packed packed unaligned dcl 7360 ref 1103 ky 000137 automatic fixed bin(17,0) dcl 6583 set ref 1472* 1473 1473 1473 1473 1473 1473 1473 1473 1473 l 1 based fixed bin(17,0) level 2 dcl 1679 set ref 1691* 1693* 1693 1697* 1698* 1698 1698 l1 1 002650 automatic fixed bin(17,0) level 2 dcl 6746 set ref 1670 l2 1 002652 automatic fixed bin(17,0) level 2 dcl 6750 set ref 1670 lang_num 015722 automatic fixed bin(17,0) dcl 6997 set ref 769 2361 2784* 2788 3300 last_seg_num 000146 automatic fixed bin(17,0) initial dcl 6587 set ref 627 629 634* 6587* last_wd_per 015733 automatic bit(1) packed unaligned dcl 7012 set ref 367 368* 2987* 3037* 5871* lefpar 2(01) 015107 automatic bit(1) array level 3 packed packed unaligned dcl 6900 set ref 2082 4892* left 000162 automatic structure level 1 unaligned dcl 6604 set ref 170 left_bits based bit(185) packed unaligned dcl 6577 set ref 5806* left_ptr 000152 automatic pointer dcl 6589 set ref 170* 5806 leftpar 3(06) 015222 automatic bit(1) array level 3 in structure "cstack" packed packed unaligned dcl 6910 in procedure "cobol_pdstax" set ref 2090 2093 2116 5259* leftpar 3(06) 015676 automatic bit(1) level 3 in structure "act_log" packed packed unaligned dcl 6929 in procedure "cobol_pdstax" set ref 2111 length 2 000154 automatic fixed bin(17,0) level 2 in structure "op" dcl 6592 in procedure "cobol_pdstax" set ref 5079* 5079 5083* 5091* 5115* 5338 5338 length 2 000162 automatic fixed bin(17,0) level 2 in structure "left" dcl 6604 in procedure "cobol_pdstax" set ref 5338 5338 lev_dg_ptr 015030 automatic pointer dcl 6827 set ref 190* 433* 487* lev_diag_item 015041 automatic structure level 1 unaligned dcl 6840 set ref 190 lev_save 002634 automatic fixed bin(24,0) dcl 6719 set ref 2713 5235* level 12 based fixed bin(17,0) level 2 in structure "data_name" dcl 7360 in procedure "cobol_pdstax" ref 540 540 676 676 5977 5977 level 3 based structure array level 2 in structure "occurs" unaligned dcl 7363 in procedure "cobol_pdstax" level_01 21(07) based bit(1) level 2 packed packed unaligned dcl 7360 ref 943 1259 linage 33(34) based bit(1) level 2 packed packed unaligned dcl 3-25 ref 1274 line 1 015041 automatic fixed bin(17,0) level 2 in structure "lev_diag_item" dcl 6840 in procedure "cobol_pdstax" set ref 428* 481* line 1 017165 automatic fixed bin(17,0) initial level 2 in structure "rw_perform" dcl 7268 in procedure "cobol_pdstax" set ref 7268* line 1 000777 internal static fixed bin(17,0) level 2 in structure "end_stmt" dcl 7379 in procedure "cobol_pdstax" set ref 127* line 1 015032 automatic fixed bin(17,0) level 2 in structure "diag_item" dcl 6830 in procedure "cobol_pdstax" set ref 352* 418* 450* 467* 6549* line 1 017177 automatic fixed bin(17,0) initial level 2 in structure "rw_move" dcl 7283 in procedure "cobol_pdstax" set ref 7283* line 1 017147 automatic fixed bin(17,0) initial level 2 in structure "eos_perform" dcl 7251 in procedure "cobol_pdstax" set ref 7251* line 1 based fixed bin(17,0) level 2 in structure "reserved_word" dcl 7347 in procedure "cobol_pdstax" ref 2719 5465 5478 5497 6143 line 015060 automatic fixed bin(17,0) level 2 in structure "sav" dcl 6860 in procedure "cobol_pdstax" set ref 245* 276* 6331* line 1 017211 automatic fixed bin(17,0) initial level 2 in structure "supp_lit" dcl 7298 in procedure "cobol_pdstax" set ref 7298* line 000210 automatic fixed bin(17,0) level 2 in structure "ae" dcl 6643 in procedure "cobol_pdstax" set ref 4985* 5019* line 1 001012 internal static fixed bin(17,0) level 2 in structure "dumprocname" dcl 7385 in procedure "cobol_pdstax" set ref 136* line 000176 automatic fixed bin(17,0) level 2 in structure "oploc" dcl 6631 in procedure "cobol_pdstax" set ref 2719* 5329* line 000170 automatic fixed bin(17,0) level 2 in structure "not" dcl 6617 in procedure "cobol_pdstax" set ref 5401* 6143* 6152* 6156* line 3 000154 automatic fixed bin(17,0) level 2 in structure "op" dcl 6592 in procedure "cobol_pdstax" set ref 5053* line 1 017227 automatic fixed bin(17,0) initial level 2 in structure "eos_move" dcl 7316 in procedure "cobol_pdstax" set ref 7316* line 000172 automatic fixed bin(17,0) level 2 in structure "andor" dcl 6622 in procedure "cobol_pdstax" set ref 5465* 5478* 5497* line 1 based fixed bin(17,0) level 2 in structure "source" dcl 7131 in procedure "cobol_pdstax" ref 450 line 1 016124 automatic fixed bin(17,0) level 2 in structure "header" dcl 7109 in procedure "cobol_pdstax" set ref 310 352 418 428 1562 3432 3551 4985 5053 6331 6549 line 3 000162 automatic fixed bin(17,0) level 2 in structure "left" dcl 6604 in procedure "cobol_pdstax" set ref 5338* line_num parameter fixed bin(17,0) dcl 477 in procedure "LEV_DIAG" ref 473 481 line_num 002616 automatic fixed bin(17,0) level 2 in structure "prev_diag" dcl 6691 in procedure "cobol_pdstax" set ref 467 1562* 3432* 3551* linkage 13 based fixed bin(17,0) level 2 dcl 7360 set ref 1654 1654 3716* 4368* linkage_section 21(03) based bit(1) level 2 packed packed unaligned dcl 7360 set ref 540 676 1648 1648 1651 1651 3714* lit_size 5 based fixed bin(17,0) level 2 dcl 7353 ref 800 804 823 841 1412 1612 1716 1720 1764 1922 2424 2605 2621 5091 5178 lit_type 4 017211 automatic bit(36) initial level 2 in structure "supp_lit" packed packed unaligned dcl 7298 in procedure "cobol_pdstax" set ref 7298* lit_type 4 based bit(1) level 2 in structure "alphanum_lit" packed packed unaligned dcl 7353 in procedure "cobol_pdstax" set ref 3470* litcnt 015740 automatic fixed bin(17,0) dcl 7019 set ref 1371* 1376 1379 1385* 1385 2479* 2483 2486 2489* 2489 2889* 2897 2911 2914* 2914 literal 11 based char level 2 in structure "numeric_lit" packed packed unaligned dcl 7350 in procedure "cobol_pdstax" ref 619 1376 2390 2404 2483 2897 5929 5933 literal 11 017211 automatic char(1) initial level 2 in structure "supp_lit" packed packed unaligned dcl 7298 in procedure "cobol_pdstax" set ref 7298* loc 000154 automatic pointer level 2 dcl 6592 set ref 2018 2024 2028 2032 2037 2043 2047 2047 2050 2055 2061 2065 2065 2068 5029* 5165* 6225* logical 3 015222 automatic bit(1) array level 3 packed packed unaligned dcl 6910 set ref 2090 4406* 4416* 5216* 5295* 6166* lognot 015732 automatic bit(1) packed unaligned dcl 7012 set ref 3085 3092* 4969* 5241* 5260 5261 5263* 5268* 5401 5427* 5427 5457* 5457 max 5 based fixed bin(17,0) array level 3 in structure "occurs" dcl 7363 in procedure "cobol_pdstax" ref 4072 max builtin function dcl 6554 in procedure "cobol_pdstax" ref 916 max 17 based fixed bin(17,0) level 2 in structure "index_name" dcl 7366 in procedure "cobol_pdstax" ref 917 2394 2408 5715 5715 max_index 000107 automatic fixed bin(17,0) dcl 6488 set ref 917* 917 5936 5943* md_num parameter fixed bin(17,0) dcl 6475 ref 6471 6481 message based structure level 1 unaligned dcl 7116 message_ind 002623 automatic fixed bin(17,0) dcl 6705 set ref 98* 310 314* 381* min builtin function dcl 6554 ref 917 min_index 000106 automatic fixed bin(17,0) dcl 6488 set ref 916* 916 5936 5941* mnemonic_name based structure level 1 unaligned dcl 7375 mod builtin function dcl 6554 ref 5985 mod_num 000143 automatic fixed bin(17,0) dcl 6585 set ref 120* 273* 431 435* 484 6481* module 6 015041 automatic fixed bin(17,0) level 2 dcl 6840 set ref 431* 484* mptr 017116 automatic pointer dcl 7167 set ref 93* 364 370* 375 375 5029 5200 6225 mrg_range 0(03) 000012 internal static bit(1) level 3 packed packed unaligned dcl 6812 set ref 4808 name 34 based char level 2 packed packed unaligned dcl 7360 ref 393 2297 name_size 33 based fixed bin(17,0) level 2 dcl 7360 ref 393 2297 2297 nest_lev 000215 automatic fixed bin(17,0) dcl 6657 set ref 108* 317 494 502 517 2129 2992 3344 3344 3346 3380 3395 3448 3559 3580 3594 3620 3620 3622 3625 3625 3652 3675 3760 3838 3847 3847 3862 3871 3923 3932 3940 3945 3955 3980 3982 4107 4131 4200* 4260 4390 4481 4499 4521 4542 4571 4592 4606 4621 4625 4632 4641 4656 4668 4677 4686 4782 4795 4803 5545 5548 5550 5606 5695 5701 5816 5818 5818 5843 5847 5903* 5949 6007 6008 6013 6014 6037 6042* 6055 6071 6086 6089 6091 6103 6135 6139 6184 6189 6195 6200 6205 6209 6214 6217 6217 6218 6247 6249 6294 6301 6307 6310 6354 6355* 6355 6357 6357 6358 6358 6365* 6365 6366 6366 6366 6368 6368 6368 6371 6378 6457 6461 6467 next_sent_label 000013 internal static fixed bin(17,0) dcl 6822 set ref 101* 5608* 5671 5671* 5877 5877* 6288 6288* nif 2 000216 automatic fixed bin(17,0) array level 2 dcl 6663 set ref 5949 6217* 6217 6357* 6357 non_elementary 21(08) based bit(1) level 2 packed packed unaligned dcl 7360 ref 1208 1557 1708 1720 1745 1753 2028 2204 5099 5136 non_numeric 5(02) 000154 automatic bit(1) level 3 in structure "op" packed packed unaligned dcl 6592 in procedure "cobol_pdstax" set ref 5069* 5089* 5099* 5109* 5338 non_numeric 5(02) 000162 automatic bit(1) level 3 in structure "left" packed packed unaligned dcl 6604 in procedure "cobol_pdstax" set ref 5338 not 3(01) 015702 automatic bit(1) level 3 in structure "work" packed packed unaligned dcl 6946 in procedure "cobol_pdstax" set ref 5451 not 3(01) 015712 automatic bit(1) level 3 in structure "soperator" packed packed unaligned dcl 6972 in procedure "cobol_pdstax" set ref 5228* 5325 5358* not 3(01) 015716 automatic bit(1) level 3 in structure "coperator" packed packed unaligned dcl 6985 in procedure "cobol_pdstax" set ref 3085* 3085 5228 5274* 5325* 5358 5908* not 3(01) 015222 automatic bit(1) array level 3 in structure "cstack" packed packed unaligned dcl 6910 in procedure "cobol_pdstax" set ref 4969 5260* not 3(01) 015676 automatic bit(1) level 3 in structure "act_log" packed packed unaligned dcl 6929 in procedure "cobol_pdstax" set ref 5421 5428* not 000170 automatic structure level 1 unaligned dcl 6617 in procedure "cobol_pdstax" not_opt 1(17) 000216 automatic bit(1) array level 2 packed packed unaligned dcl 6663 set ref 2992 3344* 6103* 6307* ns 1(19) 000216 automatic bit(1) array level 2 packed packed unaligned dcl 6663 set ref 5818 6366* 6366 6366 6457* 6461 ns_found 0(06) 002641 automatic bit(1) level 2 packed packed unaligned dcl 6724 set ref 104* 6465* null builtin function dcl 6554 ref 92 93 99 2018 2037 2055 5165 6550 6550 num_cond 134(07) based bit(1) level 2 packed packed unaligned dcl 2-26 set ref 4402* number 5 015041 automatic fixed bin(17,0) level 2 in structure "lev_diag_item" dcl 6840 in procedure "cobol_pdstax" set ref 430* 483* number 5 based fixed bin(17,0) level 2 in structure "message" dcl 7116 in procedure "cobol_pdstax" ref 384 number 5 015032 automatic fixed bin(17,0) level 2 in structure "diag_item" dcl 6830 in procedure "cobol_pdstax" set ref 349* 416* 448* 465* number_of_ls_pointers 105 based fixed bin(17,0) level 2 dcl 2-26 ref 545 numeric 21(17) based bit(1) level 2 in structure "data_name" packed packed unaligned dcl 7360 in procedure "cobol_pdstax" ref 611 863 1225 1233 1419 1419 1424 1429 1434 1540 1599 1608 1612 1617 1617 1820 1946 1962 2032 2050 2371 2673 2689 2695 5102 5138 numeric 5(01) 000162 automatic bit(1) level 3 in structure "left" packed packed unaligned dcl 6604 in procedure "cobol_pdstax" set ref 5374 5381 numeric 5(01) 000154 automatic bit(1) level 3 in structure "op" packed packed unaligned dcl 6592 in procedure "cobol_pdstax" set ref 5066* 5075* 5105* 5164* 5369 5381 5388 numeric_edited 21(18) based bit(1) level 2 packed packed unaligned dcl 7360 ref 611 863 1219 1586 1612 1723 1794 1827 1869 1962 2204 2695 5102 5138 numeric_lit based structure level 1 unaligned dcl 7350 o based fixed bin(17,0) level 2 dcl 1679 set ref 1683* 1684* 1684 1684 1688* 1688 o1 002650 automatic fixed bin(17,0) level 2 dcl 6746 set ref 1670 1670 1670 o2 002652 automatic fixed bin(17,0) level 2 dcl 6750 set ref 1670 1670 1670 o_bit 0(09) based char(1) level 2 packed packed unaligned dcl 7086 ref 238 238 242 268 268 271 317 o_of_rdf 21(12) based bit(1) level 2 packed packed unaligned dcl 7360 ref 1439 occptr 017126 automatic pointer dcl 7188 set ref 1342 1345 1354 4026* 4066* 4068 4072 occurs based structure level 1 unaligned dcl 7363 occurs_ptr 27 based fixed bin(17,0) level 2 dcl 7360 ref 4025 4066 offset 2 based fixed bin(17,0) level 3 in structure "file_desc_1" dcl 23-7 in procedure "cobol_pdstax" ref 2321 offset 24 based fixed bin(24,0) level 2 in structure "data_name" dcl 7360 in procedure "cobol_pdstax" set ref 1683 2297 2321* 2329* 3726* 3726 5985 offset 4 based fixed bin(17,0) array level 3 in structure "file_desc_1" dcl 23-7 in procedure "cobol_pdstax" ref 2329 op 015716 automatic fixed bin(17,0) level 2 in structure "coperator" dcl 6985 in procedure "cobol_pdstax" set ref 3095* 5218* 5227 5280* 5323* 5357 op 015712 automatic fixed bin(17,0) level 2 in structure "soperator" dcl 6972 in procedure "cobol_pdstax" set ref 5227* 5323 5357* op parameter fixed bin(17,0) dcl 6235 in procedure "emit_type_13" ref 6232 6238 op 000154 automatic structure level 1 unaligned dcl 6592 in procedure "cobol_pdstax" set ref 169 op_bits based bit(185) packed unaligned dcl 6576 set ref 5163* 5806 op_lit 5(04) 000154 automatic bit(1) level 3 packed packed unaligned dcl 6592 set ref 4991* 5061* 5073* 5087* 5095* op_mode 000142 automatic fixed bin(17,0) dcl 6585 set ref 2863* 2865* 2867* 2872* 3208 3227 4090 5785 op_ptr 000150 automatic pointer dcl 6589 set ref 169* 5163 5806 open_ext 34(05) based bit(1) level 2 packed packed unaligned dcl 3-25 set ref 4718* 5799* open_in 34(02) based bit(1) level 2 packed packed unaligned dcl 3-25 set ref 4722* 5787* open_io 34(04) based bit(1) level 2 packed packed unaligned dcl 3-25 set ref 4730* 5795* open_out 34(03) based bit(1) level 2 packed packed unaligned dcl 3-25 set ref 4726* 5791* opeos 001037 internal static structure level 1 unaligned dcl 7388 set ref 159 175 opeosptr 015736 automatic pointer dcl 7018 set ref 175* 3148 4926 4947 5660 6240 operand 3(03) 015222 automatic bit(1) array level 3 packed packed unaligned dcl 6910 set ref 5038* 5226* oploc 000176 automatic structure level 1 unaligned dcl 6631 option 1(16) 000216 automatic bit(1) array level 2 packed packed unaligned dcl 6663 set ref 3344* 3847 3862 3980* 4260* 5545* 5843* 6184* 6189* 6195* 6200* 6214* 6249* 6310* 6368 options 10(08) based structure level 2 packed packed unaligned dcl 15-8 organization 43 based fixed bin(17,0) level 2 dcl 3-25 ref 565 693 724 893 960 960 1122 1122 1146 1146 1268 1286 1286 1452 1452 2169 2269 2269 2278 2640 2659 2665 2958 2958 output 10(09) based bit(1) level 3 in structure "cdtoken" packed packed unaligned dcl 15-8 in procedure "cobol_pdstax" ref 706 output 000045 internal static fixed bin(17,0) dcl 7170 in procedure "cobol_pdstax" set ref 133* output_error_exit 127 based fixed bin(17,0) level 2 dcl 2-26 set ref 2539 2569 2595 5727* overlap 22(27) based bit(1) level 2 packed packed unaligned dcl 7360 set ref 4248* p parameter pointer dcl 1677 in procedure "get_pos" ref 1674 1683 1686 1688 1691 1691 1693 1697 p parameter pointer dcl 861 in procedure "sizedn" ref 857 863 863 863 863 867 param parameter fixed bin(17,0) dcl 3109 set ref 3105 3111 3116 3122* param1 parameter fixed bin(17,0) dcl 3135 ref 3132 3139 3142 3145 param2 parameter fixed bin(17,0) dcl 3136 ref 3132 3139 3142 3146 parity 3(07) 015222 automatic bit(1) array level 3 packed packed unaligned dcl 6910 set ref 5261* 5261 perf_alter_info 56 based char(5) level 2 packed packed unaligned dcl 2-26 set ref 4319 4346 4348* perfcode 1 000016 internal static fixed bin(17,0) level 2 dcl 6863 set ref 4170* 4289* 4306* 4326 4376* 4553* 4597* perfext 6 000016 internal static fixed bin(17,0) level 2 dcl 6863 set ref 103* perflink 2 000016 internal static char(5) level 2 packed packed unaligned dcl 6863 set ref 102* perflink1 3(09) 000016 internal static char(5) level 2 packed packed unaligned dcl 6863 set ref 102* perform_range_key 015052 automatic char(5) packed unaligned dcl 6857 set ref 4319* 4321 4322 4333* perfprio 5 000016 internal static fixed bin(17,0) level 2 dcl 6863 set ref 2506 4172* 4298* 4307* 4555* 4596* perfprocnum 000016 internal static fixed bin(17,0) level 2 dcl 6863 set ref 4171* 4297* 4304* 4326 4554* 4595* perfrange 000016 internal static structure level 1 unaligned dcl 6863 set ref 4341 4341 4349 4361 pic_integer 22(16) based bit(1) level 2 packed packed unaligned dcl 7360 ref 1098 1130 1176 1225 1956 2673 2827 pigz_res 000213 automatic fixed bin(17,0) dcl 6654 set ref 1363 1370* 1381* 1389* 2810 places 10 017211 automatic fixed bin(17,0) initial level 2 in structure "supp_lit" dcl 7298 in procedure "cobol_pdstax" set ref 7298* places 10 based fixed bin(17,0) level 2 in structure "numeric_lit" dcl 7350 in procedure "cobol_pdstax" ref 619 1376 1379 1415 1758 2389 2390 2403 2404 2483 2486 2897 2911 5929 5933 places_left 17 based fixed bin(17,0) level 2 in structure "data_name" dcl 7360 in procedure "cobol_pdstax" ref 863 1586 1594 1599 1612 1617 1617 1691 1901 1901 1905 1922 1922 2371 3415 3415 5143 places_left 6 based fixed bin(17,0) level 2 in structure "numeric_lit" dcl 7350 in procedure "cobol_pdstax" ref 1586 1594 1599 1905 3407 3407 5079 places_left 6 017211 automatic fixed bin(17,0) initial level 2 in structure "supp_lit" dcl 7298 in procedure "cobol_pdstax" set ref 7298* places_right 7 based fixed bin(17,0) level 2 in structure "numeric_lit" dcl 7350 in procedure "cobol_pdstax" ref 1586 1599 1892 3409 3409 5076 5079 places_right 7 017211 automatic fixed bin(17,0) initial level 2 in structure "supp_lit" dcl 7298 in procedure "cobol_pdstax" set ref 7298* places_right 20 based fixed bin(17,0) level 2 in structure "data_name" dcl 7360 in procedure "cobol_pdstax" ref 863 1586 1599 1617 1617 1691 1794 1888 1888 1892 2371 3417 3417 5106 5143 pointer_to_internal 4 015760 automatic pointer level 2 dcl 7061 set ref 180* 222 334 preospn_bit 000015 internal static bit(1) packed unaligned dcl 6826 set ref 104* 2232 4442* 4449* prev_diag 002616 automatic structure level 1 unaligned dcl 6691 prev_token_ptr 002620 automatic pointer dcl 6700 set ref 92* 364* 449 450 prime_key 2 based structure level 2 unaligned dcl 23-7 printer_control 10(12) based bit(1) level 3 packed packed unaligned dcl 7375 ref 2777 prio1 015077 automatic fixed bin(17,0) dcl 6884 set ref 2450* 2452 2461 2463 2466 2470 2470 prio2 015100 automatic fixed bin(17,0) dcl 6885 set ref 2455* 2457 2461 2463 2466 2470 priority 10(09) based char(2) level 2 packed packed unaligned dcl 7357 ref 2450 2455 4172 4175 4298 4307 4555 4596 proc_def based structure level 1 unaligned dcl 7357 proc_num 12 001012 internal static fixed bin(17,0) level 2 in structure "dumprocname" dcl 7385 in procedure "cobol_pdstax" set ref 3116* 6026* proc_num 12 001052 internal static fixed bin(17,0) level 2 in structure "store_label_1" dcl 7392 in procedure "cobol_pdstax" set ref 5596* proc_num 12 based fixed bin(17,0) level 2 in structure "proc_def" dcl 7357 in procedure "cobol_pdstax" ref 4171 4297 4304 4554 4595 procdef 000012 internal static structure level 2 packed packed unaligned dcl 6812 set ref 100 4181 prog_coll_seq 123 based fixed bin(17,0) level 2 dcl 2-26 ref 4456 q parameter pointer dcl 1677 ref 1674 1683 1684 1684 1684 1688 1688 1691 1693 1693 1697 1698 1698 1698 r_key_info 22(18) based char(5) level 2 packed packed unaligned dcl 3-25 ref 2288 2293 2306 read 34(06) based bit(1) level 2 packed packed unaligned dcl 3-25 set ref 5745* read_key 34(15) based bit(1) level 2 packed packed unaligned dcl 3-25 set ref 5757* record_prefix 50 based fixed bin(17,0) level 2 dcl 3-25 ref 2414 2414 rel_offset 017412 automatic fixed bin(24,0) dcl 2347 set ref 2349* 2351 rel_op 5(05) based bit(1) level 2 packed packed unaligned dcl 7347 ref 1992 2001 relative_key 33(21) based bit(1) level 2 packed packed unaligned dcl 3-25 ref 2269 rep_bit 6(15) based bit(15) level 2 packed packed unaligned dcl 7116 ref 381 repcsbit 017142 automatic bit(1) packed unaligned dcl 7218 set ref 1561* 3292 3571 report 134(02) based bit(1) level 2 packed packed unaligned dcl 2-26 ref 1457 2988 report_section 21(05) based bit(1) level 2 packed packed unaligned dcl 7360 ref 1493 res 0(01) 002641 automatic bit(1) level 2 in structure "indicators" packed packed unaligned dcl 6724 in procedure "cobol_pdstax" set ref 1625 1636* 1642* 1657* 1662* 1670* 1672* 1728 1738 1780 4056 4074* 4079* res 017765 automatic bit(1) packed unaligned dcl 6051 in procedure "test_stack" set ref 6067* 6070 6071* 6076 reserved_word based structure level 1 unaligned dcl 7347 rewind 000044 internal static fixed bin(17,0) dcl 7169 set ref 132* rewrite 34(09) based bit(1) level 2 packed packed unaligned dcl 3-25 set ref 5763* rounded 22(24) based bit(1) level 2 packed packed unaligned dcl 7360 set ref 3370* 3439* 5825* run 4 015032 automatic fixed bin(17,0) level 2 in structure "diag_item" dcl 6830 in procedure "cobol_pdstax" set ref 184* run 4 015041 automatic fixed bin(17,0) level 2 in structure "lev_diag_item" dcl 6840 in procedure "cobol_pdstax" set ref 193* run 4 based fixed bin(17,0) level 2 in structure "message" dcl 7116 in procedure "cobol_pdstax" ref 384 run_table 3 based structure array level 2 unaligned dcl 4-9 rw_move 017177 automatic structure level 1 unaligned dcl 7283 set ref 187 rw_move_ptr 017174 automatic pointer dcl 7279 set ref 187* 5185* rw_move_size 017176 automatic fixed bin(17,0) initial dcl 7279 set ref 5185* 7279* rw_perform 017165 automatic structure level 1 unaligned dcl 7268 set ref 186 rw_perform_ptr 017162 automatic pointer dcl 7264 set ref 186* 3998* rw_perform_size 017164 automatic fixed bin(17,0) initial dcl 7264 set ref 3998* 7264* s 3 015712 automatic structure level 2 packed packed unaligned dcl 6972 s_bit based char(1) level 2 packed packed unaligned dcl 7086 ref 321 s_exit 3 016114 automatic fixed bin(17,0) level 2 in structure "sline" dcl 7096 in procedure "cobol_pdstax" set ref 124* s_exit 3 based fixed bin(17,0) level 2 in structure "syntax_line" dcl 7086 in procedure "cobol_pdstax" ref 207 324 s_of_rdf 21(11) based bit(1) level 2 packed packed unaligned dcl 7360 ref 1439 sav 015060 automatic structure level 1 unaligned dcl 6860 sav_bit 015054 automatic bit(1) packed unaligned dcl 6858 set ref 153* 245 254* 276 285* 5874* 6333* 6337* sav_ptr 000110 automatic pointer dcl 6557 set ref 144* 3450 3545 3562 5840 5858 save_gentag 017132 automatic fixed bin(17,0) dcl 7214 set ref 4473* 4491* save_skip_ind 1(21) 000216 automatic bit(1) array level 2 packed packed unaligned dcl 6663 set ref 3620* 3625 saveident 000046 internal static structure level 1 unaligned dcl 7178 set ref 174 4024 4046 saveitem 000573 internal static structure level 1 unaligned dcl 7239 set ref 144 176 3358 3363 3382 saveos 015741 automatic char(44) packed unaligned dcl 7021 set ref 3795* 3964 6127 saveperfrange 015063 automatic structure level 1 unaligned dcl 6873 set ref 4349 4357 4361 savidptr 017124 automatic pointer dcl 7185 set ref 174* 4026 savidsize based char(512) packed unaligned dcl 7017 set ref 4046* 4046 savitmptr 017120 automatic pointer dcl 7173 set ref 176* 611 611 611 716 721 757 762 800 819* 884 888 996 1001 1009 1015 1021 1028 1138 1143 1159 1202 1419 1424 1429 1434 1447 1503 1508 1528 1531 1586 1586 1594 1594 1594 1599 1599 1599 1605 1608 1612 1617 1617 1617 1617 1617 1617 1640 1640 1648 1651 1654 1668* 1708 1711 1716 1720 1723 1723 1733 1733 1733 1733 1753 1758 1764 1768 1794 1794 1794 1802 1820 1827 1847 1854 1869 1880 1888 1892 1901 1905 1914 1918 1922 1922 1969 2154 2394 2408 2432 2437 2437 2450 2932 2937 2950 2955 3370 3377 3393 3439 3445 3556 3577 3649 3920 3929 4304 4307 4477 5715 5825 5827 5832 savlaskey 015072 automatic char(5) packed unaligned dcl 6881 set ref 4350* 4354 4359 4362* savoccptr 015754 automatic fixed bin(17,0) dcl 7023 set ref 4025* 4026 searched 10 001012 internal static bit(1) level 2 packed packed unaligned dcl 7385 set ref 139* 4853* 4860* 5667* 5689* secswitch 000035 internal static fixed bin(17,0) dcl 7027 set ref 120* 1461 2443 3789* section_header 5(08) based bit(1) level 2 packed packed unaligned dcl 7347 ref 2964 6152 section_name 10(04) based bit(1) level 2 packed packed unaligned dcl 7357 ref 550 584 781 933 section_num 11 based fixed bin(17,0) level 2 dcl 7357 ref 2437 2437 4180 seg_limit 000104 automatic fixed bin(17,0) dcl 6442 set ref 118* 6444 6448 seg_num 000141 automatic fixed bin(17,0) dcl 6585 in procedure "cobol_pdstax" set ref 619* 623* 629 629 634 635 6448 6448 seg_num 23 based fixed bin(17,0) level 2 in structure "data_name" dcl 7360 in procedure "cobol_pdstax" ref 1640 1640 2297 3719 seg_range 4(02) based bit(1) level 2 packed packed unaligned dcl 7350 ref 606 seg_usage based bit(1) array packed unaligned dcl 6635 set ref 629 635* seg_usage_ptr 000204 automatic pointer dcl 6638 set ref 94* 629 635 seg_usage_string 000200 automatic bit(100) initial packed unaligned dcl 6637 set ref 94 6637* seq 000042 internal static fixed bin(17,0) dcl 7166 set ref 132* seqvarleng 017136 automatic fixed bin(17,0) dcl 7216 set ref 404* 494* 517* 3118* 3149* 4358* 4432* 4927* 4948* 5661* 5828* 5834* 6030* 6241* seqvarptr 017134 automatic pointer dcl 7215 set ref 403* 494* 510* 517* 1049 1084 2295 3117* 3148* 4324 4356 4357* 4431* 4435 4926* 4947* 5660* 5827* 5832* 6029* 6240* set_sop 000212 automatic structure level 1 packed packed unaligned dcl 6647 set ref 5945 set_sop_mask based bit(3) packed unaligned dcl 6652 set ref 5945* shprio 015076 automatic fixed bin(17,0) dcl 6883 set ref 2447 2459 2470 4175* sign 4(09) based char(1) level 2 packed packed unaligned dcl 7350 ref 606 1187 1373 1394 1415 1594 1599 1918 2900 size 000573 internal static fixed bin(17,0) level 2 in structure "saveitem" dcl 7239 in procedure "cobol_pdstax" set ref 5828 5834 size 015032 automatic fixed bin(17,0) level 2 in structure "diag_item" dcl 6830 in procedure "cobol_pdstax" set ref 182* size 015041 automatic fixed bin(17,0) level 2 in structure "lev_diag_item" dcl 6840 in procedure "cobol_pdstax" set ref 191* size 016124 automatic fixed bin(17,0) level 2 in structure "header" dcl 7109 in procedure "cobol_pdstax" set ref 404 3358 3358 3363 3363 3382 3382 3450 3450 3545 3545 3562 3562 4024 4024 4463 4463 4551 4551 4613 4613 5569 5569 5580 5580 5840 5840 5858 5858 size 000777 internal static fixed bin(17,0) level 2 in structure "end_stmt" dcl 7379 in procedure "cobol_pdstax" set ref 126* 502* size 017177 automatic fixed bin(17,0) initial level 2 in structure "rw_move" dcl 7283 in procedure "cobol_pdstax" set ref 7283* size based fixed bin(17,0) level 2 in structure "data_name" dcl 7360 in procedure "cobol_pdstax" ref 5202 size 017211 automatic fixed bin(17,0) initial level 2 in structure "supp_lit" dcl 7298 in procedure "cobol_pdstax" set ref 7298* size 001012 internal static fixed bin(17,0) level 2 in structure "dumprocname" dcl 7385 in procedure "cobol_pdstax" set ref 135* 3118 6030 size 017165 automatic fixed bin(17,0) initial level 2 in structure "rw_perform" dcl 7268 in procedure "cobol_pdstax" set ref 7268* size 017227 automatic fixed bin(17,0) initial level 2 in structure "eos_move" dcl 7316 in procedure "cobol_pdstax" set ref 7316* size 001037 internal static fixed bin(17,0) level 2 in structure "opeos" dcl 7388 in procedure "cobol_pdstax" set ref 3149 4927 4948 5661 6241 size 017147 automatic fixed bin(17,0) initial level 2 in structure "eos_perform" dcl 7251 in procedure "cobol_pdstax" set ref 7251* size based fixed bin(17,0) level 2 in structure "headerb" dcl 7158 in procedure "cobol_pdstax" ref 375 size 000046 internal static fixed bin(17,0) level 2 in structure "saveident" dcl 7178 in procedure "cobol_pdstax" set ref 4046 4046 skip_ind 1(20) 000216 automatic bit(1) array level 2 packed packed unaligned dcl 6663 set ref 317 494 502 517 3380 3395 3448 3559 3580 3594 3620 3622* 3625* 3652 3675 3923 3932 3940 3945 3955 4107 4131 4390 4481 4499 4521 4542 4571 4592 4606 4621 4625 4632 4641 4656 4668 4677 4686 4782 4795 4803 5695 5701 6358* 6358 sline 016114 automatic structure level 1 unaligned dcl 7096 set ref 123 soperator 015712 automatic structure level 1 unaligned dcl 6972 set ref 149 soperator_ptr 000122 automatic pointer dcl 6561 set ref 149* sort_count 000174 automatic fixed bin(17,0) dcl 6627 set ref 95* 6384* 6384 6386 sort_file 33(32) based bit(1) level 2 packed packed unaligned dcl 3-25 ref 1270 sort_in_info 60(18) based char(5) level 2 packed packed unaligned dcl 2-26 ref 1041 sort_key 015024 automatic char(5) packed unaligned dcl 6810 set ref 1041* 1044 1047 1051* 1076* 1079 1082 1086* sort_out_info 114(27) based char(5) level 2 packed packed unaligned dcl 2-26 ref 1076 sort_range 10(27) based bit(1) level 2 packed packed unaligned dcl 7357 set ref 4181 source based structure level 1 unaligned dcl 7131 spec_tag_counter 23 based fixed bin(17,0) level 2 dcl 2-26 set ref 4471* 4471 4473 4476 4489* 4489 4491 4494 6282* 6282 6284 sperlin 2 015063 automatic char(5) level 2 packed packed unaligned dcl 6873 set ref 4353* sptr based char(5) level 2 packed packed unaligned dcl 7037 ref 1051 1086 srchfm2bit 1(22) 000216 automatic bit(1) array level 2 in structure "ST" packed packed unaligned dcl 6663 in procedure "cobol_pdstax" set ref 6354* 6371 srchfm2bit 000025 internal static bit(1) packed unaligned dcl 6886 in procedure "cobol_pdstax" set ref 104* 4275* 4282* 4653 4658* 4688* 4694 6354 6371* srt_range 000012 internal static bit(1) level 3 packed packed unaligned dcl 6812 set ref 4810 srtfilno 25 based fixed bin(17,0) level 2 dcl 7037 ref 1051 1086 srtrng based structure level 1 unaligned dcl 7037 srtrngptr 015756 automatic pointer dcl 7035 set ref 1049* 1051 1051 1051 1051 1084* 1086 1086 1086 1086 ss_tok_ptr 000100 automatic pointer dcl 5197 set ref 5190* 5200* ss_tok_size 000102 automatic fixed bin(17,0) dcl 5197 set ref 5190* 5202* sstart 2 based fixed bin(17,0) level 2 dcl 7037 ref 1051 1086 sstop 13 based fixed bin(17,0) level 2 dcl 7037 ref 1051 1086 st 002642 automatic bit(32) packed unaligned dcl 6734 set ref 370* 372 494* 502* 510* 517* 3998* 4137* 4341* 4343 5185* 5188* 5190* 5192* start 34(11) based bit(1) level 2 packed packed unaligned dcl 3-25 set ref 5773* stat 000012 internal static structure level 1 packed packed unaligned dcl 6812 status 5 017165 automatic bit(36) initial level 2 in structure "rw_perform" packed packed unaligned dcl 7268 in procedure "cobol_pdstax" set ref 7268* status 11 017147 automatic bit(36) initial level 2 in structure "eos_perform" packed packed unaligned dcl 7251 in procedure "cobol_pdstax" set ref 7251* status 11 017227 automatic bit(36) initial level 2 in structure "eos_move" packed packed unaligned dcl 7316 in procedure "cobol_pdstax" set ref 7316* status 5 017177 automatic bit(36) initial level 2 in structure "rw_move" packed packed unaligned dcl 7283 in procedure "cobol_pdstax" set ref 7283* store_label_1 001052 internal static structure level 1 unaligned dcl 7392 set ref 4386 5569 store_label_2 001100 internal static structure level 1 unaligned dcl 7395 set ref 4387 5580 string builtin function dcl 6554 set ref 5049* 6135* 6139 sub_loc 002640 automatic fixed bin(17,0) dcl 6721 set ref 1349* 1349 2678* 2678 5920* 5926* 5926 5929 subcnt 015755 automatic fixed bin(17,0) dcl 7025 set ref 1312 1342 1345 1354 4143* 4150* 4150 subj_req 3(09) 015222 automatic bit(1) array level 3 packed packed unaligned dcl 6910 set ref 4972 5251* 6409 subject 015706 automatic structure level 1 unaligned dcl 6959 set ref 148 subject_bits based bit(124) packed unaligned dcl 6570 set ref 5213* 5241* 5291* 5315* subject_ptr 000120 automatic pointer dcl 6561 set ref 148* 5213 5241 5291 5315 subs 002635 automatic fixed bin(17,0) array dcl 6720 set ref 4070 4145* 4145* 4145* 5929* subscript 4(07) based bit(1) level 2 in structure "numeric_lit" packed packed unaligned dcl 7350 in procedure "cobol_pdstax" set ref 4033* 5930* subscript 10(07) based bit(1) level 2 in structure "index_name" packed packed unaligned dcl 7366 in procedure "cobol_pdstax" set ref 4215* subscripted 22(05) based bit(1) level 2 packed packed unaligned dcl 7360 ref 1093 1297 1305 1540 2124 2216 2673 substr builtin function dcl 6554 set ref 372 375* 393 1376 2297 2297 2390 2404 2483 2897 3358* 3358 3363* 3363 3382* 3382 3450* 3450 3545* 3545 3562* 3562 4024* 4024 4046* 4046 4343 4463* 4463 4551* 4551 4613* 4613 4808* 4810* 5569* 5569 5580* 5580 5840* 5840 5858* 5858 supp_lit 017211 automatic structure level 1 unaligned dcl 7298 set ref 188 supp_lit_ptr 017206 automatic pointer dcl 7294 set ref 188* 5188* supp_lit_size 017210 automatic fixed bin(17,0) initial dcl 7294 set ref 5188* 7294* sv_isrbit 0(01) 000012 internal static bit(1) level 3 packed packed unaligned dcl 6812 set ref 1057 sv_osrbit 0(02) 000012 internal static bit(1) level 3 packed packed unaligned dcl 6812 set ref 1064 sv_proc_def 000342 internal static structure level 1 unaligned dcl 7202 set ref 4551 4567 4588 4603 4799 sv_srtfil_rec 000226 internal static structure level 1 unaligned dcl 7192 set ref 4495 4613 sv_usfil 000456 internal static structure level 1 unaligned dcl 7208 set ref 4463 4475 4493 4780 switch_condition 10(08) based bit(1) level 3 packed packed unaligned dcl 7375 ref 2098 switch_name 10(09) based bit(1) level 3 packed packed unaligned dcl 7375 ref 2354 syntax_line based structure level 1 unaligned dcl 7086 syntax_line_ptr 016112 automatic pointer dcl 7094 set ref 123* 207 222* 225 231 238 238 242 245 248 259 261 264 266 268 268 271 273 302 317 321 324 334* 413 413 syntax_table based structure array level 1 unaligned dcl 7079 set ref 222 334 syntax_trace 134(16) based bit(1) level 2 packed packed unaligned dcl 2-26 ref 200 t_field 2 based fixed bin(17,0) level 2 dcl 7086 ref 231 261 264 302 413 413 t_type 1 based fixed bin(17,0) level 2 dcl 7086 ref 225 tag parameter fixed bin(17,0) dcl 6235 in procedure "emit_type_13" ref 6232 6239 tag parameter fixed bin(17,0) dcl 3081 in procedure "TEST" set ref 3077 3088 3088* 3090 tag 1 015716 automatic fixed bin(17,0) level 2 in structure "coperator" dcl 6985 in procedure "cobol_pdstax" set ref 3088* 3090* 3095* tag1 parameter fixed bin(17,0) dcl 3063 set ref 3059 3066 3070 3073* tag2 parameter fixed bin(17,0) dcl 3063 set ref 3059 3068 3070* 3073* tagno parameter fixed bin(17,0) dcl 6022 ref 6018 6026 tbit 002641 automatic bit(1) level 2 packed packed unaligned dcl 6724 set ref 200* 202 215 234 288 295 331 342 tempchar1 016111 automatic char(1) packed unaligned dcl 7077 set ref 2390* 2391 2404* 2405 tempkey 015735 automatic fixed bin(17,0) dcl 7015 set ref 4909* 4911* 4913 terminator 5(03) based bit(1) level 2 packed packed unaligned dcl 7347 ref 1546 tln 002643 automatic fixed bin(17,0) dcl 6735 set ref 370* tm1 002624 automatic fixed bin(24,0) initial dcl 6707 set ref 234* 288* 6707* tm2 002625 automatic fixed bin(24,0) initial dcl 6707 set ref 215* 6707* tm3 002626 automatic fixed bin(24,0) initial dcl 6707 set ref 295* 6707* tm4 002627 automatic fixed bin(24,0) initial dcl 6707 set ref 331* 6707* tm5 002630 automatic fixed bin(24,0) initial dcl 6707 set ref 342* 6707* trace_ptr 016106 automatic pointer dcl 7075 set ref 199* 202* 215* 234* 288* 295* 331* 342* true 015676 automatic fixed bin(17,0) level 2 in structure "act_log" dcl 6929 in procedure "cobol_pdstax" set ref 4855 4855* 5424 5425* 5445* 5454 5455* 5482* 5509 5509* 5527 5527* 5592* 5596* 5601* 5603* 5608* 5613* 5640 5640* 5681 5681* true 015702 automatic fixed bin(17,0) level 2 in structure "work" dcl 6946 in procedure "cobol_pdstax" set ref 5445* true 015706 automatic fixed bin(17,0) level 2 in structure "subject" dcl 6959 in procedure "cobol_pdstax" set ref 5215* true 015222 automatic fixed bin(17,0) array level 2 in structure "cstack" dcl 6910 in procedure "cobol_pdstax" set ref 5037* 5225* 5650 5652* type 3 based fixed bin(17,0) level 2 in structure "data_name" dcl 7360 in procedure "cobol_pdstax" set ref 393* 977 1634 2024 2043 2061 2852 5203* type 3 015041 automatic fixed bin(17,0) level 2 in structure "lev_diag_item" dcl 6840 in procedure "cobol_pdstax" set ref 192* type 3 based fixed bin(17,0) level 2 in structure "mnemonic_name" dcl 7375 in procedure "cobol_pdstax" ref 2098 2354 2763 2770 2777 type 3 017227 automatic fixed bin(17,0) initial level 2 in structure "eos_move" dcl 7316 in procedure "cobol_pdstax" set ref 7316* type 3 017177 automatic fixed bin(17,0) initial level 2 in structure "rw_move" dcl 7283 in procedure "cobol_pdstax" set ref 7283* type 3 000777 internal static fixed bin(17,0) level 2 in structure "end_stmt" dcl 7379 in procedure "cobol_pdstax" set ref 129* type 3 017211 automatic fixed bin(17,0) initial level 2 in structure "supp_lit" dcl 7298 in procedure "cobol_pdstax" set ref 7298* type 3 based fixed bin(17,0) level 2 in structure "alphabet_name" dcl 7343 in procedure "cobol_pdstax" ref 2735 type 3 001012 internal static fixed bin(17,0) level 2 in structure "dumprocname" dcl 7385 in procedure "cobol_pdstax" set ref 138* 3114* 6025* type 3 015032 automatic fixed bin(17,0) level 2 in structure "diag_item" dcl 6830 in procedure "cobol_pdstax" set ref 183* type 3 017165 automatic fixed bin(17,0) initial level 2 in structure "rw_perform" dcl 7268 in procedure "cobol_pdstax" set ref 7268* type 3 000573 internal static fixed bin(17,0) level 2 in structure "saveitem" dcl 7239 in procedure "cobol_pdstax" set ref 798 816 836 1586 1605 1608 1612 1634 1704 1708 1716 1750 1753 1758 1764 1774 1774 1794 1794 1802 1816 1838 1838 1847 1847 1847 1854 1854 1861 1866 1872 1877 1883 1896 1909 1922 1922 type 3 based fixed bin(17,0) level 2 in structure "cdtoken" dcl 15-8 in procedure "cobol_pdstax" ref 706 type 3 017147 automatic fixed bin(17,0) initial level 2 in structure "eos_perform" dcl 7251 in procedure "cobol_pdstax" set ref 7251* type 3 based fixed bin(17,0) level 2 in structure "alphanum_lit" dcl 7353 in procedure "cobol_pdstax" set ref 3466 3469* 3473* type 3 001037 internal static fixed bin(17,0) level 2 in structure "opeos" dcl 7388 in procedure "cobol_pdstax" set ref 3147* 3153* type 3 016124 automatic fixed bin(17,0) level 2 in structure "header" dcl 7109 in procedure "cobol_pdstax" set ref 377 389 393 413 540 550 558 579 584 593 593 606 619 639 644 651 656 663 663 674 687 699 732 732 741 749 776 781 786 791 802 807 821 826 839 844 896 912 933 938 943 965 1009 1036 1071 1093 1098 1151 1167 1176 1187 1195 1202 1233 1241 1241 1259 1297 1305 1316 1318 1324 1324 1329 1332 1336 1336 1373 1394 1399 1404 1409 1412 1415 1488 1493 1540 1546 1551 1557 1569 1932 1941 1946 1951 1956 1962 1979 1984 1992 2001 2006 2124 2186 2204 2216 2318 2366 2378 2424 2475 2629 2673 2689 2695 2729 2799 2882 2893 3401 3404 5037 5178 5178 5582* 5995 type 3 based fixed bin(17,0) level 2 in structure "reserved_word" dcl 7347 in procedure "cobol_pdstax" ref 227 982 1466 2725 2746 2859 2998 3009 3031 3044 4003 5056 5059 unmin 2 015107 automatic bit(1) array level 3 packed packed unaligned dcl 6900 set ref 4873* unspec builtin function dcl 6554 set ref 2391 2405 2450 2455 3093* 4172 4175 4298 4307 4555 4596 usage_index 21(34) based bit(1) level 2 packed packed unaligned dcl 7360 ref 1098 1167 1297 1305 2124 2216 2673 2815 5097 use_debug 134(15) based bit(1) level 2 packed packed unaligned dcl 2-26 ref 2976 use_reporting 135(03) based bit(1) level 2 packed packed unaligned dcl 2-26 ref 2980 used_as_sub 10(07) based bit(1) level 2 packed packed unaligned dcl 7360 set ref 4209* 4242* val parameter fixed bin(17,0) dcl 4586 in procedure "PERF" ref 4583 4591 val 017577 automatic fixed bin(17,0) dcl 4064 in procedure "test_subs" set ref 4070* 4072 4072 4072 variable 101(01) based bit(1) level 2 packed packed unaligned dcl 3-25 ref 1004 variable_length 22(04) based bit(1) level 2 packed packed unaligned dcl 7360 ref 1213 varrecaddr 017140 automatic char(5) packed unaligned dcl 7217 set ref 510* 517* 1047* 1082* 2293* 4322* 4354* 4359* verb 4 000777 internal static fixed bin(17,0) level 2 in structure "end_stmt" dcl 7379 in procedure "cobol_pdstax" set ref 130* 151 972 1577 3176* 3299* 3777* 3886* 3993* 4159* 4179* 4192* 4202* 4224* 4266* 4277* 6085* 6128* 6275* verb 4 001037 internal static fixed bin(17,0) level 2 in structure "opeos" dcl 7388 in procedure "cobol_pdstax" set ref 4924* 4945* 5658* 6237* verb 5 based bit(1) level 2 in structure "reserved_word" packed packed unaligned dcl 7347 in procedure "cobol_pdstax" set ref 593 982 5583* verb 4 017147 automatic fixed bin(17,0) initial level 2 in structure "eos_perform" dcl 7251 in procedure "cobol_pdstax" set ref 7251* verb 4 017227 automatic fixed bin(17,0) initial level 2 in structure "eos_move" dcl 7316 in procedure "cobol_pdstax" set ref 7316* vfile_key 002632 automatic fixed bin(17,0) dcl 6716 set ref 2324* 2332* 5998 w 3 015702 automatic structure level 2 packed packed unaligned dcl 6946 work 015702 automatic structure level 1 unaligned dcl 6946 set ref 147 work_bits based bit(124) packed unaligned dcl 6569 set ref 5440* 5517* 5519 work_ptr 000116 automatic pointer dcl 6561 set ref 147* 5440 5517 5519 working_storage 21(01) based bit(1) level 2 packed packed unaligned dcl 7360 ref 676 write 34(13) based bit(1) level 2 packed packed unaligned dcl 3-25 set ref 5768* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. KEY automatic fixed bin(17,0) dcl 6657 L1 automatic fixed bin(17,0) dcl 6998 L2 automatic fixed bin(17,0) dcl 6998 abs builtin function dcl 6554 allo1_max defined fixed bin(17,0) dcl 5-171 allo1_ptr defined pointer dcl 5-67 alter_flag defined fixed bin(17,0) dcl 5-135 alter_index defined fixed bin(17,0) dcl 5-153 alter_list_ptr defined pointer dcl 5-39 bit18 based bit(18) packed unaligned dcl 7059 bit5 based bit(5) packed unaligned dcl 6590 cd_cnt defined fixed bin(17,0) dcl 5-197 cobol_$allo1_max external static fixed bin(17,0) dcl 5-170 cobol_$allo1_ptr external static pointer dcl 5-66 cobol_$alter_flag external static fixed bin(17,0) dcl 5-134 cobol_$alter_index external static fixed bin(17,0) dcl 5-152 cobol_$alter_list_ptr external static pointer dcl 5-38 cobol_$cd_cnt external static fixed bin(17,0) dcl 5-196 cobol_$cobol_data_wd_off external static fixed bin(17,0) dcl 5-118 cobol_$compile_count external static fixed bin(17,0) dcl 5-142 cobol_$coms_charcnt external static fixed bin(17,0) dcl 5-188 cobol_$coms_wdoff external static fixed bin(17,0) dcl 5-202 cobol_$con_wd_off external static fixed bin(17,0) dcl 5-92 cobol_$cons_charcnt external static fixed bin(17,0) dcl 5-192 cobol_$constant_offset external static fixed bin(17,0) dcl 5-156 cobol_$data_init_flag external static fixed bin(17,0) dcl 5-130 cobol_$date_compiled_sw external static fixed bin(17,0) dcl 5-180 cobol_$debug_enable external static fixed bin(17,0) dcl 5-174 cobol_$def_base_ptr external static pointer dcl 5-12 cobol_$def_max external static fixed bin(17,0) dcl 5-96 cobol_$def_wd_off external static fixed bin(17,0) dcl 5-94 cobol_$eln_max external static fixed bin(17,0) dcl 5-172 cobol_$eln_ptr external static pointer dcl 5-68 cobol_$fixup_max external static fixed bin(17,0) dcl 5-164 cobol_$fixup_ptr external static pointer dcl 5-30 cobol_$fs_charcnt external static fixed bin(17,0) dcl 5-184 cobol_$fs_wdoff external static fixed bin(17,0) dcl 5-198 cobol_$include_cnt external static fixed bin(17,0) dcl 5-182 cobol_$include_info_ptr external static pointer dcl 5-86 cobol_$init_stack_off external static fixed bin(17,0) dcl 5-124 cobol_$initval_base_ptr external static pointer dcl 5-32 cobol_$initval_file_ptr external static pointer dcl 5-34 cobol_$initval_flag external static fixed bin(17,0) dcl 5-178 cobol_$link_base_ptr external static pointer dcl 5-14 cobol_$link_max external static fixed bin(17,0) dcl 5-100 cobol_$link_wd_off external static fixed bin(17,0) dcl 5-98 cobol_$list_off external static fixed bin(17,0) dcl 5-154 cobol_$list_ptr external static pointer dcl 5-64 cobol_$ls_charcnt external static fixed bin(17,0) dcl 5-190 cobol_$main_pcs_ptr external static pointer dcl 5-84 cobol_$map_data_max external static fixed bin(17,0) dcl 5-162 cobol_$map_data_ptr external static pointer dcl 5-54 cobol_$max_stack_off external static fixed bin(17,0) dcl 5-122 cobol_$minpral5_ptr external static pointer dcl 5-50 cobol_$misc_base_ptr external static pointer dcl 5-60 cobol_$misc_end_ptr external static pointer dcl 5-62 cobol_$misc_max external static fixed bin(17,0) dcl 5-158 cobol_$next_tag external static fixed bin(17,0) dcl 5-128 cobol_$non_source_offset external static fixed bin(17,0) dcl 5-176 cobol_$ntbuf_ptr external static pointer dcl 5-82 cobol_$obj_seg_name external static char(32) dcl 5-208 cobol_$op_con_ptr external static pointer dcl 5-80 cobol_$para_eop_flag external static fixed bin(17,0) dcl 5-138 cobol_$pd_map_index external static fixed bin(17,0) dcl 5-116 cobol_$pd_map_max external static fixed bin(17,0) dcl 5-160 cobol_$pd_map_ptr external static pointer dcl 5-28 cobol_$pd_map_sw external static fixed bin(17,0) dcl 5-126 cobol_$perform_list_ptr external static pointer dcl 5-36 cobol_$perform_para_index external static fixed bin(17,0) dcl 5-148 cobol_$perform_sect_index external static fixed bin(17,0) dcl 5-150 cobol_$priority_no external static fixed bin(17,0) dcl 5-140 cobol_$ptr_assumption_ind external static fixed bin(17,0) dcl 5-144 cobol_$ptr_status_ptr external static pointer dcl 5-56 cobol_$reg_assumption_ind external static fixed bin(17,0) dcl 5-146 cobol_$reg_status_ptr external static pointer dcl 5-58 cobol_$reloc_def_base_ptr external static pointer dcl 5-20 cobol_$reloc_def_max external static fixed bin(24,0) dcl 5-108 cobol_$reloc_link_base_ptr external static pointer dcl 5-22 cobol_$reloc_link_max external static fixed bin(24,0) dcl 5-110 cobol_$reloc_sym_base_ptr external static pointer dcl 5-24 cobol_$reloc_sym_max external static fixed bin(24,0) dcl 5-112 cobol_$reloc_text_base_ptr external static pointer dcl 5-18 cobol_$reloc_text_max external static fixed bin(24,0) dcl 5-106 cobol_$reloc_work_base_ptr external static pointer dcl 5-26 cobol_$reloc_work_max external static fixed bin(24,0) dcl 5-114 cobol_$reswd_ptr external static pointer dcl 5-78 cobol_$same_sort_merge_proc external static bit(1) dcl 5-214 cobol_$scratch_dir external static char(168) dcl 5-206 cobol_$sect_eop_flag external static fixed bin(17,0) dcl 5-136 cobol_$seg_init_flag external static fixed bin(17,0) dcl 5-132 cobol_$seg_init_list_ptr external static pointer dcl 5-40 cobol_$stack_off external static fixed bin(17,0) dcl 5-120 cobol_$statement_info_ptr external static pointer dcl 5-76 cobol_$sym_base_ptr external static pointer dcl 5-16 cobol_$sym_max external static fixed bin(17,0) dcl 5-104 cobol_$sym_wd_off external static fixed bin(17,0) dcl 5-102 cobol_$tag_table_max external static fixed bin(17,0) dcl 5-166 cobol_$tag_table_ptr external static pointer dcl 5-52 cobol_$temp_token_area_ptr external static pointer dcl 5-42 cobol_$temp_token_max external static fixed bin(17,0) dcl 5-168 cobol_$temp_token_ptr external static pointer dcl 5-44 cobol_$text_base_ptr external static pointer dcl 5-8 cobol_$text_wd_off external static fixed bin(17,0) dcl 5-90 cobol_$token_block1_ptr external static pointer dcl 5-46 cobol_$token_block2_ptr external static pointer dcl 5-48 cobol_$value_cnt external static fixed bin(17,0) dcl 5-194 cobol_$ws_charcnt external static fixed bin(17,0) dcl 5-186 cobol_$ws_wdoff external static fixed bin(17,0) dcl 5-200 cobol_$xref_bypass external static bit(1) dcl 5-212 cobol_$xref_chain_ptr external static pointer dcl 5-74 cobol_$xref_token_ptr external static pointer dcl 5-72 cobol_afp defined pointer dcl 1-11 cobol_analin_fileno defined pointer dcl 1-13 cobol_com_fileno defined pointer dcl 1-23 cobol_curr_in defined pointer dcl 1-53 cobol_curr_out defined pointer dcl 1-55 cobol_data_wd_off defined fixed bin(17,0) dcl 5-119 cobol_dfp defined pointer dcl 1-27 cobol_eltp defined pointer dcl 1-19 cobol_ext_$cobol_afp external static pointer dcl 1-10 cobol_ext_$cobol_analin_fileno external static pointer dcl 1-12 cobol_ext_$cobol_com_fileno external static pointer dcl 1-22 cobol_ext_$cobol_curr_in external static pointer dcl 1-52 cobol_ext_$cobol_curr_out external static pointer dcl 1-54 cobol_ext_$cobol_dfp external static pointer dcl 1-26 cobol_ext_$cobol_eltp external static pointer dcl 1-18 cobol_ext_$cobol_fileno1 external static fixed bin(24,0) dcl 1-78 cobol_ext_$cobol_hfp external static pointer dcl 1-28 cobol_ext_$cobol_lpr external static char(5) packed unaligned dcl 1-95 cobol_ext_$cobol_m1fp external static pointer dcl 1-30 cobol_ext_$cobol_m2fp external static pointer dcl 1-32 cobol_ext_$cobol_min1_fileno external static pointer dcl 1-34 cobol_ext_$cobol_min2_fileno_ptr external static pointer dcl 1-36 cobol_ext_$cobol_name_fileno external static pointer dcl 1-38 cobol_ext_$cobol_name_fileno_ptr external static pointer dcl 1-40 cobol_ext_$cobol_ntfp external static pointer dcl 1-42 cobol_ext_$cobol_options external static char(120) packed unaligned dcl 1-97 cobol_ext_$cobol_options_len external static fixed bin(24,0) dcl 1-80 cobol_ext_$cobol_pdout_fileno external static fixed bin(24,0) dcl 1-82 cobol_ext_$cobol_pfp external static pointer dcl 1-46 cobol_ext_$cobol_print_fileno external static fixed bin(24,0) dcl 1-84 cobol_ext_$cobol_rmin2_fileno external static fixed bin(24,0) dcl 1-86 cobol_ext_$cobol_rmin2fp external static pointer dcl 1-50 cobol_ext_$cobol_rwdd external static pointer dcl 1-72 cobol_ext_$cobol_rwpd external static pointer dcl 1-74 cobol_ext_$cobol_sfp external static pointer dcl 1-56 cobol_ext_$cobol_w1p external static pointer dcl 1-58 cobol_ext_$cobol_w2p external static pointer dcl 1-60 cobol_ext_$cobol_w3p external static pointer dcl 1-62 cobol_ext_$cobol_w5p external static pointer dcl 1-64 cobol_ext_$cobol_w6p external static pointer dcl 1-66 cobol_ext_$cobol_w7p external static pointer dcl 1-68 cobol_ext_$cobol_x1_fileno external static fixed bin(24,0) dcl 1-88 cobol_ext_$cobol_x2_fileno external static fixed bin(24,0) dcl 1-90 cobol_ext_$cobol_x3_fileno external static fixed bin(24,0) dcl 1-92 cobol_ext_$cobol_x3fp external static pointer dcl 1-70 cobol_ext_$cobol_xlast8 external static bit(1) packed unaligned dcl 1-100 cobol_ext_$report_exists external static bit(1) packed unaligned dcl 1-102 cobol_ext_$report_first_token external static pointer dcl 1-14 cobol_ext_$report_last_token external static pointer dcl 1-16 cobol_fileno1 defined fixed bin(24,0) dcl 1-79 cobol_hfp defined pointer dcl 1-29 cobol_lpr defined char(5) packed unaligned dcl 1-96 cobol_m1fp defined pointer dcl 1-31 cobol_m2fp defined pointer dcl 1-33 cobol_min1_fileno defined pointer dcl 1-35 cobol_min2_fileno_ptr defined pointer dcl 1-37 cobol_name_fileno defined pointer dcl 1-39 cobol_name_fileno_ptr defined pointer dcl 1-41 cobol_ntfp defined pointer dcl 1-43 cobol_options defined char(120) packed unaligned dcl 1-98 cobol_options_len defined fixed bin(24,0) dcl 1-81 cobol_pdout_fileno defined fixed bin(24,0) dcl 1-83 cobol_pfp defined pointer dcl 1-47 cobol_print_fileno defined fixed bin(24,0) dcl 1-85 cobol_rmin2_fileno defined fixed bin(24,0) dcl 1-87 cobol_rmin2fp defined pointer dcl 1-51 cobol_rwdd defined pointer dcl 1-73 cobol_rwpd defined pointer dcl 1-75 cobol_sfp defined pointer dcl 1-57 cobol_w1p defined pointer dcl 1-59 cobol_w2p defined pointer dcl 1-61 cobol_w3p defined pointer dcl 1-63 cobol_w5p defined pointer dcl 1-65 cobol_w6p defined pointer dcl 1-67 cobol_w7p defined pointer dcl 1-69 cobol_x1_fileno defined fixed bin(24,0) dcl 1-89 cobol_x2_fileno defined fixed bin(24,0) dcl 1-91 cobol_x3_fileno defined fixed bin(24,0) dcl 1-93 cobol_x3fp defined pointer dcl 1-71 cobol_xlast8 defined bit(1) packed unaligned dcl 1-101 compile_count defined fixed bin(17,0) dcl 5-143 coms_charcnt defined fixed bin(17,0) dcl 5-189 coms_wdoff defined fixed bin(17,0) dcl 5-203 con_end_ptr defined pointer dcl 5-11 con_wd_off defined fixed bin(17,0) dcl 5-93 cons_charcnt defined fixed bin(17,0) dcl 5-193 constant_offset defined fixed bin(17,0) dcl 5-157 curmax automatic fixed bin(17,0) dcl 7030 daptr automatic pointer dcl 7020 data_init_flag defined fixed bin(17,0) dcl 5-131 date_compiled_sw defined fixed bin(17,0) dcl 5-181 debug_enable defined fixed bin(17,0) dcl 5-175 def_base_ptr defined pointer dcl 5-13 def_max defined fixed bin(17,0) dcl 5-97 def_wd_off defined fixed bin(17,0) dcl 5-95 diag_ptr defined pointer dcl 5-71 eln_max defined fixed bin(17,0) dcl 5-173 eln_ptr defined pointer dcl 5-69 fi automatic fixed bin(17,0) dcl 6821 fi_ct automatic fixed bin(17,0) dcl 6713 file_desc_1_type internal static fixed bin(17,0) initial dcl 23-4 filtabptr automatic pointer dcl 6778 first automatic bit(1) packed unaligned dcl 3829 fixup_max defined fixed bin(17,0) dcl 5-165 fixup_ptr defined pointer dcl 5-31 fs_charcnt defined fixed bin(17,0) dcl 5-185 fs_wdoff defined fixed bin(17,0) dcl 5-199 id_loc automatic pointer dcl 7057 include_cnt defined fixed bin(17,0) dcl 5-183 include_info_ptr defined pointer dcl 5-87 init_stack_off defined fixed bin(17,0) dcl 5-125 initval_base_ptr defined pointer dcl 5-33 initval_file_ptr defined pointer dcl 5-35 initval_flag defined fixed bin(17,0) dcl 5-179 line internal static structure level 1 unaligned dcl 7231 link_base_ptr defined pointer dcl 5-15 link_max defined fixed bin(17,0) dcl 5-101 link_wd_off defined fixed bin(17,0) dcl 5-99 list_off defined fixed bin(17,0) dcl 5-155 list_ptr defined pointer dcl 5-65 ls_charcnt defined fixed bin(17,0) dcl 5-191 main_pcs_ptr defined pointer dcl 5-85 map_data_max defined fixed bin(17,0) dcl 5-163 map_data_ptr defined pointer dcl 5-55 max_stack_off defined fixed bin(17,0) dcl 5-123 minpral5_ptr defined pointer dcl 5-51 misc_base_ptr defined pointer dcl 5-61 misc_end_ptr defined pointer dcl 5-63 misc_max defined fixed bin(17,0) dcl 5-159 next_tag defined fixed bin(17,0) dcl 5-129 non_source_offset defined fixed bin(17,0) dcl 5-177 ntbuf_ptr defined pointer dcl 5-83 obj_seg_name defined char(32) dcl 5-209 op_con_ptr defined pointer dcl 5-81 p automatic pointer dcl 7074 para_eop_flag defined fixed bin(17,0) dcl 5-139 param automatic bit(1) packed unaligned dcl 6898 pd_map_index defined fixed bin(17,0) dcl 5-117 pd_map_max defined fixed bin(17,0) dcl 5-161 pd_map_ptr defined pointer dcl 5-29 pd_map_sw defined fixed bin(17,0) dcl 5-127 perform_list_ptr defined pointer dcl 5-37 perform_para_index defined fixed bin(17,0) dcl 5-149 perform_sect_index defined fixed bin(17,0) dcl 5-151 pp automatic pointer dcl 7057 priority_no defined fixed bin(17,0) dcl 5-141 ptr_assumption_ind defined fixed bin(17,0) dcl 5-145 ptr_status_ptr defined pointer dcl 5-57 reg_assumption_ind defined fixed bin(17,0) dcl 5-147 reg_status_ptr defined pointer dcl 5-59 reloc_def_base_ptr defined pointer dcl 5-21 reloc_def_max defined fixed bin(24,0) dcl 5-109 reloc_link_base_ptr defined pointer dcl 5-23 reloc_link_max defined fixed bin(24,0) dcl 5-111 reloc_sym_base_ptr defined pointer dcl 5-25 reloc_sym_max defined fixed bin(24,0) dcl 5-113 reloc_text_base_ptr defined pointer dcl 5-19 reloc_text_max defined fixed bin(24,0) dcl 5-107 reloc_work_base_ptr defined pointer dcl 5-27 reloc_work_max defined fixed bin(24,0) dcl 5-115 report_exists defined bit(1) packed unaligned dcl 1-103 report_first_token defined pointer dcl 1-15 report_last_token defined pointer dcl 1-17 reswd_ptr defined pointer dcl 5-79 same_sort_merge_proc defined bit(1) dcl 5-215 satoken based structure level 1 unaligned dcl 7140 savmax automatic fixed bin(17,0) dcl 7031 scratch_dir defined char(168) dcl 5-207 sect_eop_flag defined fixed bin(17,0) dcl 5-137 seg_init_flag defined fixed bin(17,0) dcl 5-133 seg_init_list_ptr defined pointer dcl 5-41 soperator_bits based bit(124) packed unaligned dcl 6571 stack_off defined fixed bin(17,0) dcl 5-121 statement_info_ptr defined pointer dcl 5-77 sym_base_ptr defined pointer dcl 5-17 sym_max defined fixed bin(17,0) dcl 5-105 sym_wd_off defined fixed bin(17,0) dcl 5-103 tag_table_max defined fixed bin(17,0) dcl 5-167 tag_table_ptr defined pointer dcl 5-53 temp_token_area_ptr defined pointer dcl 5-43 temp_token_max defined fixed bin(17,0) dcl 5-169 temp_token_ptr defined pointer dcl 5-45 text_base_ptr defined pointer dcl 5-9 text_wd_off defined fixed bin(17,0) dcl 5-91 token_block1_ptr defined pointer dcl 5-47 token_block2_ptr defined pointer dcl 5-49 value_cnt defined fixed bin(17,0) dcl 5-195 ws_charcnt defined fixed bin(17,0) dcl 5-187 ws_wdoff defined fixed bin(17,0) dcl 5-201 x based bit(8) packed unaligned dcl 7058 xref_bypass defined bit(1) dcl 5-213 xref_chain_ptr defined pointer dcl 5-75 xref_token_ptr defined pointer dcl 5-73 NAMES DECLARED BY EXPLICIT CONTEXT. CS 001100 constant label array(10) dcl 5061 ref 5059 DEF 017222 constant entry internal dcl 3105 ref 3847 3849 4855 4858 5483 5509 5527 5638 5640 5671 5681 5684 5877 6250 6262 6301 6368 DIAG 016506 constant entry internal dcl 456 ref 3292 3571 5916 DIAG_PREV_TOKEN 016465 constant entry internal dcl 440 ref 313 3634 4164 4186 6178 6417 6423 6427 6432 EQ 017122 constant entry internal dcl 3059 ref 5445 5448 5504 5596 5608 ESD 021200 constant entry internal dcl 6471 ref 6444 6448 6452 IOM 001057 constant label array(4) dcl 3211 ref 3208 LEV_DIAG 016526 constant entry internal dcl 473 ref 245 276 5019 5329 5338 5401 6152 6156 NL 017277 constant entry internal dcl 3342 ref 3339 3511 3537 3615 OM 001067 constant label array(4) dcl 4091 ref 4090 OM1 017643 constant label dcl 4107 ref 4093 4097 4101 4105 PERF 020040 constant entry internal dcl 4583 ref 3483 4560 4578 SCAN 016261 constant entry internal dcl 358 ref 205 321 2983 SM 001063 constant label array(4) dcl 5787 ref 5785 SM1 015027 constant label dcl 5803 ref 5789 5793 5797 5801 TEST 017146 constant entry internal dcl 3077 ref 4538 4846 5469 5482 5501 5524 5592 5603 TOK_TYPE 020300 constant entry internal dcl 5043 ref 5040 6224 a294 020767 constant entry internal dcl 6124 ref 6109 6120 6317 acc_dev 007365 constant label dcl 2763 act109 017530 constant entry internal dcl 3974 ref 3970 6192 act113 017540 constant entry internal dcl 4022 ref 4018 5923 act119 017624 constant entry internal dcl 4088 ref 4085 6343 act143 017657 constant entry internal dcl 4294 ref 4291 4378 act145 017672 constant entry internal dcl 4317 ref 3485 4299 4308 4313 4562 4573 4580 4608 4805 act145b 017737 constant entry internal dcl 4338 ref 4330 4335 act174 020076 constant entry internal dcl 4651 ref 4647 4670 act179 020137 constant entry internal dcl 4706 ref 4702 4738 4745 4752 4759 4766 act200 020204 constant entry internal dcl 4851 ref 4546 4848 act211 020257 constant entry internal dcl 5032 ref 5027 6228 act245 020573 constant entry internal dcl 5626 ref 5621 5882 act275 020644 constant entry internal dcl 5899 ref 5896 6429 act28 017316 constant entry internal dcl 3356 ref 3352 3435 3491 4788 4811 5718 5765 5770 act32 017326 constant entry internal dcl 3391 ref 3387 3733 act37 017347 constant entry internal dcl 3460 ref 3456 4825 6186 6311 act49 017355 constant entry internal dcl 3590 ref 3586 5905 act87 017411 constant entry internal dcl 3774 ref 3349 3770 6181 6324 action 000004 constant label array(0:334) dcl 306 ref 259 291 3301 5803 5958 6176 6394 actloglp 006041 constant label dcl 2111 adrisadr 006342 constant label dcl 2306 ae_diag 020231 constant entry internal dcl 5012 ref 5006 5352 6172 alelnuitm 005505 constant label dcl 1946 alph 005221 constant label dcl 1809 alphnm 007323 constant label dcl 2735 alphoral 005576 constant label dcl 1974 altlegal 007272 constant label dcl 2707 altprnm 002436 constant label dcl 644 altst 007243 constant label dcl 2689 amarg 007431 constant label dcl 2793 an 005162 constant label dcl 1787 andait 003737 constant label dcl 1246 anes 004771 constant label dcl 1704 argscomp 006040 constant label dcl 2108 arop 004177 constant label dcl 1399 aroprp 005603 constant label dcl 1979 asfil 003362 constant label dcl 1071 assign_value 021044 constant entry internal dcl 6279 ref 3088 5652 6007 6008 6218 6247 6288 cdname 004403 constant label dcl 1488 check 000523 constant label array(220) dcl 530 ref 261 check111a 005355 constant label dcl 1892 ref 1883 check112a 005375 constant label dcl 1905 ref 1896 check113a 005420 constant label dcl 1918 ref 1909 check168a 006720 constant label dcl 2466 ref 2459 check70a 003765 constant label dcl 1264 ref 1259 check81a 004253 constant label dcl 1419 ref 1404 check81b 004266 constant label dcl 1424 ref 1409 check81c 004276 constant label dcl 1429 ref 1415 check81d 004303 constant label dcl 1434 ref 1412 ckdecpn 006632 constant label dcl 2432 ckdsegnum 006763 constant label dcl 2506 ckerrex 006770 constant label dcl 2514 ckextend 007037 constant label dcl 2555 ckinput 007015 constant label dcl 2531 ckintbit 006756 constant label dcl 2497 ckio 007031 constant label dcl 2547 cklit 006622 constant label dcl 2424 cklit1 007114 constant label dcl 2605 cklit2 007130 constant label dcl 2621 ckoutput 007023 constant label dcl 2539 ckprpnbit 006224 constant label dcl 2232 ckrcpref 006613 constant label dcl 2414 ckrng1 006520 constant label dcl 2385 ckrng2 006555 constant label dcl 2399 cksegm 006657 constant label dcl 2443 cktp25 006514 constant label dcl 2378 cobol_pdstax 001127 constant entry external dcl 88 comp_error 002147 constant label dcl 349 ref 298 cond_name 007713 constant label dcl 2964 csstst 007267 constant label dcl 2701 cstst 007236 constant label dcl 2683 daib 006076 constant label dcl 2136 dana 004407 constant label dcl 1493 debug 007725 constant label dcl 2976 dec_nest_lev 021115 constant entry internal dcl 6361 ref 3806 decnondec 006213 constant label dcl 2222 def_false 021034 constant entry internal dcl 6258 ref 5540 5560 6299 descnm 002704 constant label dcl 781 descnmra 003107 constant label dcl 933 deswon 004435 constant label dcl 1515 deswz 004377 constant label dcl 1483 devptr 007645 constant label dcl 2932 diag 016410 constant entry internal dcl 408 ref 310 597 1822 1829 1842 2821 2831 2838 2846 4051 4056 5306 5818 5862 5936 5985 6076 6464 disp_dev 007375 constant label dcl 2770 dninfl 003644 constant label dcl 1202 ecnt 003102 constant label dcl 924 edalelnue 005552 constant label dcl 1962 edalit 005475 constant label dcl 1941 edaltst 007254 constant label dcl 2695 edick 006500 constant label dcl 2371 egrze 003744 constant label dcl 1251 elaanne 006162 constant label dcl 2204 eldis 004543 constant label dcl 1569 elemred 004310 constant label dcl 1439 elneds 003676 constant label dcl 1219 elnudnint 005537 constant label dcl 1956 elnuindi 003707 constant label dcl 1225 elnuint 005527 constant label dcl 1951 elnuit 003720 constant label dcl 1233 emit_eos 017515 constant entry internal dcl 3882 ref 3862 emit_eos_perf 020737 constant entry internal dcl 6081 ref 3838 6209 emit_pn 020652 constant entry internal dcl 6018 ref 6013 6014 emit_type_13 021015 constant entry internal dcl 6232 ref 3095 5536 end_sent 020620 constant entry internal dcl 5867 ref 5887 5891 5974 6419 endcob 003162 constant label dcl 965 enddec 005455 constant label dcl 1932 endhist 016243 constant label dcl 6500 endint 016243 constant label dcl 6500 ref 372 4254 5709 6494 6497 endjob 012013 constant label dcl 4254 examlitid 004207 constant label dcl 1404 fail 001606 constant label dcl 215 ref 227 231 534 544 549 554 569 578 583 589 603 610 616 641 648 655 660 682 696 703 710 716 726 736 753 757 767 774 780 785 790 854 878 884 895 900 909 920 928 937 942 947 951 962 969 976 990 996 1006 1014 1017 1021 1035 1036 1044 1061 1068 1071 1079 1097 1102 1107 1113 1124 1134 1138 1148 1155 1159 1183 1191 1199 1206 1212 1217 1224 1229 1237 1245 1250 1255 1263 1272 1279 1291 1301 1309 1344 1352 1358 1365 1398 1403 1417 1422 1424 1432 1437 1443 1447 1454 1463 1466 1479 1487 1492 1497 1503 1519 1528 1536 1545 1553 1566 1573 1581 1593 1598 1604 1605 1611 1616 1627 1629 1704 1711 1715 1722 1723 1730 1740 1742 1750 1755 1763 1767 1770 1782 1791 1799 1806 1813 1823 1830 1844 1851 1858 1871 1872 1882 1890 1895 1903 1908 1916 1921 1927 1939 1945 1950 1955 1960 1967 1973 1978 1986 2005 2010 2011 2024 2028 2032 2037 2043 2047 2050 2055 2061 2065 2068 2077 2078 2084 2085 2092 2097 2103 2115 2120 2128 2129 2140 2143 2148 2158 2160 2171 2177 2182 2190 2198 2210 2220 2226 2236 2246 2254 2260 2272 2282 2288 2300 2306 2312 2339 2359 2361 2369 2376 2382 2396 2410 2418 2428 2440 2447 2452 2457 2465 2472 2486 2494 2501 2510 2524 2527 2535 2543 2551 2559 2575 2587 2601 2609 2617 2625 2642 2647 2651 2661 2669 2681 2687 2693 2699 2705 2711 2717 2727 2733 2735 2746 2755 2768 2775 2782 2788 2797 2804 2813 2822 2832 2840 2847 2857 2869 2880 2887 2911 2918 2932 2943 2950 2961 2968 2974 2990 2996 2998 3009 3015 3029 3042 3051 field_length 020426 constant entry internal dcl 5131 ref 5114 figconall 002611 constant label dcl 737 figzero 007766 constant label dcl 2998 file 003731 constant label dcl 1241 filenm 002231 constant label dcl 558 fileno 003245 constant label dcl 1009 filnefil 006104 constant label dcl 2154 filno 005570 constant label dcl 1969 flusisds 003666 constant label dcl 1213 formtlb 002255 constant label dcl 574 get_pos 017055 constant entry internal dcl 1674 ref 1667 1668 get_rel_offset 017112 constant entry internal dcl 2342 ref 2321 2329 gotod 006134 constant label dcl 2173 group 005100 constant label dcl 1745 ieqlvl 004050 constant label dcl 1312 impvrb 003205 constant label dcl 977 inbit 002164 constant label dcl 530 inc_nest_lev 021065 constant entry internal dcl 6350 ref 3799 incdnm 002541 constant label dcl 699 indeqind 004145 constant label dcl 1354 indev 006230 constant label dcl 2242 indexed 004135 constant label dcl 1345 indxfile 006112 constant label dcl 2160 inrng 003350 constant label dcl 1057 is_cobol 002674 constant label dcl 769 is_cond 010030 constant label dcl 3025 is_imp 006067 constant label dcl 2129 is_lang 007415 constant label dcl 2784 is_rel 004346 constant label dcl 1466 is_rout 006471 constant label dcl 2361 is_sub_opt 005700 constant label dcl 2011 is_user_word 007520 constant label dcl 2852 ixfil 002561 constant label dcl 716 ixrlrady 004315 constant label dcl 1447 ixrlsqdy 006246 constant label dcl 2260 keyiskey 006307 constant label dcl 2288 keylbl 003447 constant label dcl 1103 lefdep 005363 constant label dcl 1896 lefparstk 005776 constant label dcl 2078 lev_diag 016442 constant entry internal dcl 423 ref 248 279 629 668 743 1994 2873 2902 2998 5178 5308 5372 5373 5379 5380 5387 5392 5949 5970 5981 6386 6482 lev_test 007301 constant label dcl 2713 lident 002173 constant label dcl 540 linage 004006 constant label dcl 1274 linktot 002210 constant label dcl 545 lit 002603 constant label dcl 732 logbitstk 006006 constant label dcl 2085 logstk 006021 constant label dcl 2093 lptopstk 006045 constant label dcl 2116 mcobol 007121 constant label dcl 2613 mnenm 003542 constant label dcl 1151 msfile 004013 constant label dcl 1286 msfilnm 003052 constant label dcl 896 nae 010046 constant label dcl 3044 new_inst 001623 constant label dcl 222 set ref 209 304 326 3230 3235 4011 next_inst 001622 constant label dcl 219 ref 347 njustr 006140 constant label dcl 2178 nlit 007572 constant label dcl 2882 nomsss 003030 constant label dcl 884 nonumdn 006145 constant label dcl 2186 nonumlit 002454 constant label dcl 656 noo 010014 constant label dcl 3009 not_opt 007760 constant label dcl 2992 notalpstk 005745 constant label dcl 2055 notnumstk 005723 constant label dcl 2037 notseqac 003023 constant label dcl 874 notseqfl 003136 constant label dcl 951 nsfilnm 002515 constant label dcl 687 nsrecnm 003750 constant label dcl 1259 nstorg 007205 constant label dcl 2665 nstream 007135 constant label dcl 2629 nues 004561 constant label dcl 1586 numlit 002355 constant label dcl 619 numstak 005704 constant label dcl 2018 nznumlit 006734 constant label dcl 2475 on_off 007337 constant label dcl 2746 onechnosn 003500 constant label dcl 1130 open_mode 007525 constant label dcl 2859 out_equiv 017244 constant entry internal dcl 3132 ref 3073 5548 outcdnm 002551 constant label dcl 706 outdev 006237 constant label dcl 2250 outrng 003355 constant label dcl 1064 overlap 016752 constant entry internal dcl 1631 ref 1624 1727 1737 1779 paranm 002267 constant label dcl 584 period 010033 constant label dcl 3031 pigz 004156 constant label dcl 1359 pigz_by 007576 constant label dcl 2889 pigz_sub 016710 constant entry internal dcl 1367 ref 1359 2806 pn_pres 007720 constant label dcl 2970 pnz 005662 constant label dcl 2006 pop_if 017432 constant entry internal dcl 3843 ref 3874 6468 pop_other 017463 constant entry internal dcl 3855 ref 3878 pop_perf 017423 constant entry internal dcl 3834 ref 3876 pop_state 017476 constant entry internal dcl 3867 ref 5822 posint 003622 constant label dcl 1187 prdef 002267 constant label dcl 584 preosp 003174 constant label dcl 972 preospn 004554 constant label dcl 1577 prnm 002450 constant label dcl 651 prnum 002325 constant label dcl 606 prt_con 007405 constant label dcl 2777 put 016401 constant entry internal dcl 401 ref 317 rae 006155 constant label dcl 2194 rafl 003264 constant label dcl 1021 read_error 016241 constant label dcl 6494 recnm 003306 constant label dcl 1036 relfile 006302 constant label dcl 2278 relop 005623 constant label dcl 1988 repnm 002715 constant label dcl 786 reset_st 021167 constant entry internal dcl 6374 ref 109 4203 5904 6043 6356 resword 007306 constant label dcl 2719 ret 002034 constant label dcl 306 ref 256 3161 3170 3177 3179 3187 3197 3203 3213 3217 3221 3225 3242 3249 3253 3256 3259 3263 3270 3277 3285 3294 3308 3315 3322 3340 3354 3366 3372 3383 3389 3423 3436 3441 3451 3458 3475 3481 3486 3492 3512 3518 3538 3553 3563 3573 3582 3588 3616 3627 3629 3636 3638 3654 3660 3666 3668 3677 3682 3685 3688 3690 3698 3705 3719 3727 3734 3736 3746 3748 3758 3762 3768 3772 3785 3791 3797 3801 3803 3808 3814 3820 3826 3831 3898 3905 3912 3918 3925 3934 3942 3947 3957 3959 3966 3972 3994 4001 4020 4035 4037 4059 4087 4115 4119 4123 4133 4139 4146 4152 4160 4182 4193 4205 4211 4217 4225 4229 4236 4243 4250 4262 4269 4279 4285 4292 4309 4315 4326 4370 4379 4392 4398 4408 4418 4424 4436 4444 4451 4459 4465 4483 4501 4509 4515 4523 4532 4547 4556 4563 4574 4581 4609 4615 4634 4643 4649 4661 4671 4679 4689 4704 4739 4746 4753 4760 4767 4772 4776 4784 4789 4797 4806 4812 4816 4821 4826 4830 4832 4849 4875 4893 4921 4939 4942 4960 4973 4992 4996 5000 5010 5030 5159 5167 5173 5183 5194 5205 5207 5230 5245 5264 5270 5276 5282 5298 5311 5318 5331 5359 5414 5430 5460 5475 5490 5511 5521 5532 5544 5555 5565 5571 5587 5602 5614 5624 5646 5663 5691 5697 5703 5712 5715 5719 5723 5729 5735 5741 5747 5753 5759 5766 5771 5775 5779 5809 5814 5824 5830 5836 5841 5851 5860 5865 5889 5894 5898 5910 5914 5918 5924 5931 5939 5947 5963 5968 5976 5992 6000 6016 6045 6098 6107 6113 6122 6137 6141 6147 6160 6182 6187 6193 6199 6203 6211 6220 6230 6256 6270 6277 6292 6297 6302 6304 6312 6314 6320 6325 6339 6344 6348 6390 6403 6407 6411 6415 6421 6425 6430 6435 6455 6459 6469 rident 002263 constant label dcl 579 ritdep 005343 constant label dcl 1883 rpid 002700 constant label dcl 776 saanm 003117 constant label dcl 938 said 003123 constant label dcl 943 san 005330 constant label dcl 1872 sav_lin_col 021055 constant entry internal dcl 6327 ref 3345 6322 6341 6346 save_skip_ind 017376 constant entry internal dcl 3618 ref 5847 sechdr 002217 constant label dcl 550 secsw 004334 constant label dcl 1457 seqfil 003454 constant label dcl 1113 seqnext 004442 constant label dcl 1523 seqput 016550 constant entry internal dcl 491 ref 405 3120 3151 4928 4949 5662 5829 5835 6033 6243 seqputeos 016575 constant entry internal dcl 499 ref 3159 3463 3479 3517 3889 3897 3904 3911 3977 3991 4268 4278 4820 5846 5893 5975 6094 6132 6198 6276 6420 6434 seqstmfil 007667 constant label dcl 2950 set_op_loc 021010 constant entry internal dcl 6222 ref 4028 5811 5922 5965 6268 set_pigz 007445 constant label dcl 2806 set_xint 007435 constant label dcl 2799 setabit 020123 constant entry internal dcl 4691 ref 4623 4638 4683 sina 002350 constant label dcl 611 sizedn 016672 constant entry internal dcl 857 ref 810 819 830 847 sizlit 002721 constant label dcl 791 slelef 005433 constant label dcl 1922 sler 005117 constant label dcl 1758 snae 005302 constant label dcl 1854 snal 005265 constant label dcl 1847 sndrdp 005167 constant label dcl 1794 snne 005315 constant label dcl 1861 snon 005226 constant label dcl 1816 snor 005147 constant label dcl 1774 snos 005210 constant label dcl 1802 sqacdyac 002650 constant label dcl 757 sqfl 003264 constant label dcl 1021 sqrlsqac 003513 constant label dcl 1138 srchid 003423 constant label dcl 1093 srtfil 003640 constant label dcl 1195 sscondnm 006030 constant label dcl 2098 ssnm 006461 constant label dcl 2354 sterm 004510 constant label dcl 1546 stream 007163 constant label dcl 2651 stun 005403 constant label dcl 1909 subact 001073 constant label array(5) dcl 4714 ref 4712 success 001640 constant label dcl 234 ref 530 540 545 550 566 574 579 584 601 606 611 639 644 651 656 671 676 694 699 706 724 732 745 749 765 769 776 781 786 791 804 812 823 832 841 849 874 893 896 905 918 924 933 938 943 960 965 972 977 982 985 1004 1009 1015 1033 1051 1057 1064 1086 1093 1098 1103 1122 1130 1146 1151 1173 1181 1187 1195 1202 1208 1213 1219 1225 1233 1241 1246 1251 1270 1274 1286 1297 1305 1342 1350 1354 1363 1394 1399 1419 1427 1429 1434 1439 1452 1457 1461 1473 1483 1488 1493 1515 1523 1534 1540 1546 1551 1564 1569 1577 1586 1594 1599 1608 1612 1625 1708 1713 1716 1720 1728 1738 1745 1753 1758 1764 1768 1774 1780 1787 1794 1802 1809 1834 1838 1847 1854 1861 1866 1869 1877 1880 1888 1892 1901 1905 1914 1918 1922 1937 1941 1946 1951 1956 1962 1969 1974 1979 1984 1996 2001 2006 2015 2018 2036 2054 2072 2073 2082 2090 2093 2098 2108 2111 2116 2124 2133 2136 2154 2169 2173 2178 2186 2194 2204 2216 2222 2232 2242 2250 2269 2278 2297 2326 2333 2354 2366 2371 2378 2394 2408 2414 2424 2432 2437 2443 2461 2463 2466 2470 2483 2497 2506 2522 2531 2539 2547 2555 2563 2567 2569 2571 2573 2579 2583 2585 2591 2595 2597 2599 2605 2613 2621 2640 2659 2665 2679 2683 2689 2695 2701 2707 2713 2725 2729 2744 2761 2763 2770 2777 2791 2793 2799 2810 2824 2835 2850 2852 2877 2882 2908 2940 2958 2964 2970 2976 2988 2992 3007 3009 3025 3040 3044 sudana 004035 constant label dcl 1305 suxdnm 006200 constant label dcl 2216 test 000000 constant label array(0:3) dcl 227 ref 225 test_stack 020667 constant entry internal dcl 6047 ref 6037 test_subs 017563 constant entry internal dcl 4061 ref 4054 tst_pigz 007507 constant label dcl 2842 tst_xint 007451 constant label dcl 2815 type9 007317 constant label dcl 2729 type_comp 020462 constant entry internal dcl 5362 ref 5346 ucon 001654 constant label dcl 238 ref 337 udneli 007212 constant label dcl 2673 undana 004022 constant label dcl 1297 unelnudn 004467 constant label dcl 1540 unsint 004162 constant label dcl 1394 unxdnm 006054 constant label dcl 2124 usagid 004522 constant label dcl 1557 useform1 003056 constant label dcl 905 ref 1163 1511 useform1a 003546 constant label dcl 1159 useform1b 004417 constant label dcl 1503 useformds 007045 constant label dcl 2563 useformr 007064 constant label dcl 2579 useformrw 007077 constant label dcl 2591 useid 002460 constant label dcl 663 usisds 003655 constant label dcl 1208 usornm 003434 constant label dcl 1098 vardget 016622 constant entry internal dcl 507 ref 1048 1083 2294 4323 4355 vardput 016643 constant entry internal dcl 514 ref 4360 varsiz 003223 constant label dcl 996 verb 002277 constant label dcl 593 write_error 016242 constant label dcl 6497 ref 4343 xint 003552 constant label dcl 1167 xnm 003062 constant label dcl 912 zerstk 005767 constant label dcl 2073 NAME DECLARED BY CONTEXT OR IMPLICATION. addrel builtin function ref 2315 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 21760 23156 21504 21770 Length 24376 21504 1176 1204 254 1116 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_pdstax 8612 external procedure is an external procedure. SCAN internal procedure shares stack frame of external procedure cobol_pdstax. put internal procedure shares stack frame of external procedure cobol_pdstax. diag internal procedure shares stack frame of external procedure cobol_pdstax. lev_diag internal procedure shares stack frame of external procedure cobol_pdstax. DIAG_PREV_TOKEN internal procedure shares stack frame of external procedure cobol_pdstax. DIAG internal procedure shares stack frame of external procedure cobol_pdstax. LEV_DIAG internal procedure shares stack frame of external procedure cobol_pdstax. seqput internal procedure shares stack frame of external procedure cobol_pdstax. seqputeos internal procedure shares stack frame of external procedure cobol_pdstax. vardget internal procedure shares stack frame of external procedure cobol_pdstax. vardput internal procedure shares stack frame of external procedure cobol_pdstax. sizedn internal procedure shares stack frame of external procedure cobol_pdstax. pigz_sub internal procedure shares stack frame of external procedure cobol_pdstax. overlap internal procedure shares stack frame of external procedure cobol_pdstax. get_pos internal procedure shares stack frame of external procedure cobol_pdstax. get_rel_offset internal procedure shares stack frame of external procedure cobol_pdstax. EQ internal procedure shares stack frame of external procedure cobol_pdstax. TEST internal procedure shares stack frame of external procedure cobol_pdstax. DEF internal procedure shares stack frame of external procedure cobol_pdstax. out_equiv internal procedure shares stack frame of external procedure cobol_pdstax. NL internal procedure shares stack frame of external procedure cobol_pdstax. act28 internal procedure shares stack frame of external procedure cobol_pdstax. act32 internal procedure shares stack frame of external procedure cobol_pdstax. act37 internal procedure shares stack frame of external procedure cobol_pdstax. act49 internal procedure shares stack frame of external procedure cobol_pdstax. save_skip_ind internal procedure shares stack frame of external procedure cobol_pdstax. act87 internal procedure shares stack frame of external procedure cobol_pdstax. pop_perf internal procedure shares stack frame of external procedure cobol_pdstax. pop_if internal procedure shares stack frame of external procedure cobol_pdstax. pop_other internal procedure shares stack frame of external procedure cobol_pdstax. pop_state internal procedure shares stack frame of external procedure cobol_pdstax. emit_eos internal procedure shares stack frame of external procedure cobol_pdstax. act109 internal procedure shares stack frame of external procedure cobol_pdstax. act113 internal procedure shares stack frame of external procedure cobol_pdstax. test_subs internal procedure shares stack frame of external procedure cobol_pdstax. act119 internal procedure shares stack frame of external procedure cobol_pdstax. act143 internal procedure shares stack frame of external procedure cobol_pdstax. act145 internal procedure shares stack frame of external procedure cobol_pdstax. act145b internal procedure shares stack frame of external procedure cobol_pdstax. PERF internal procedure shares stack frame of external procedure cobol_pdstax. act174 internal procedure shares stack frame of external procedure cobol_pdstax. setabit internal procedure shares stack frame of external procedure cobol_pdstax. act179 internal procedure shares stack frame of external procedure cobol_pdstax. act200 internal procedure shares stack frame of external procedure cobol_pdstax. ae_diag internal procedure shares stack frame of external procedure cobol_pdstax. act211 internal procedure shares stack frame of external procedure cobol_pdstax. TOK_TYPE internal procedure shares stack frame of external procedure cobol_pdstax. field_length internal procedure shares stack frame of external procedure cobol_pdstax. type_comp internal procedure shares stack frame of external procedure cobol_pdstax. act245 internal procedure shares stack frame of external procedure cobol_pdstax. end_sent internal procedure shares stack frame of external procedure cobol_pdstax. act275 internal procedure shares stack frame of external procedure cobol_pdstax. emit_pn internal procedure shares stack frame of external procedure cobol_pdstax. test_stack internal procedure shares stack frame of external procedure cobol_pdstax. emit_eos_perf internal procedure shares stack frame of external procedure cobol_pdstax. a294 internal procedure shares stack frame of external procedure cobol_pdstax. set_op_loc internal procedure shares stack frame of external procedure cobol_pdstax. emit_type_13 internal procedure shares stack frame of external procedure cobol_pdstax. def_false internal procedure shares stack frame of external procedure cobol_pdstax. assign_value internal procedure shares stack frame of external procedure cobol_pdstax. sav_lin_col internal procedure shares stack frame of external procedure cobol_pdstax. inc_nest_lev internal procedure shares stack frame of external procedure cobol_pdstax. dec_nest_lev internal procedure shares stack frame of external procedure cobol_pdstax. reset_st internal procedure shares stack frame of external procedure cobol_pdstax. ESD internal procedure shares stack frame of external procedure cobol_pdstax. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 comsrtrngptr cobol_pdstax 000012 stat cobol_pdstax 000013 next_sent_label cobol_pdstax 000014 gotodep cobol_pdstax 000015 preospn_bit cobol_pdstax 000016 perfrange cobol_pdstax 000025 srchfm2bit cobol_pdstax 000026 fircar cobol_pdstax 000027 dbp cobol_pdstax 000030 drc cobol_pdstax 000031 common_eof cobol_pdstax 000032 cssub cobol_pdstax 000033 assub cobol_pdstax 000034 decswitch cobol_pdstax 000035 secswitch cobol_pdstax 000036 debugsw cobol_pdstax 000037 diagno cobol_pdstax 000040 cursecnum cobol_pdstax 000041 i1 cobol_pdstax 000042 seq cobol_pdstax 000043 input cobol_pdstax 000044 rewind cobol_pdstax 000045 output cobol_pdstax 000046 saveident cobol_pdstax 000226 sv_srtfil_rec cobol_pdstax 000342 sv_proc_def cobol_pdstax 000456 sv_usfil cobol_pdstax 000572 fb26 cobol_pdstax 000573 saveitem cobol_pdstax 000777 end_stmt cobol_pdstax 001012 dumprocname cobol_pdstax 001037 opeos cobol_pdstax 001052 store_label_1 cobol_pdstax 001100 store_label_2 cobol_pdstax STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_pdstax 000100 ss_tok_ptr cobol_pdstax 000102 ss_tok_size cobol_pdstax 000103 EOF cobol_pdstax 000104 seg_limit cobol_pdstax 000105 key cobol_pdstax 000106 min_index cobol_pdstax 000107 max_index cobol_pdstax 000110 sav_ptr cobol_pdstax 000112 head_ptr cobol_pdstax 000114 act_log_ptr cobol_pdstax 000116 work_ptr cobol_pdstax 000120 subject_ptr cobol_pdstax 000122 soperator_ptr cobol_pdstax 000124 es_ptr cobol_pdstax 000126 coperator_ptr cobol_pdstax 000130 cstack_ptr cobol_pdstax 000132 astack_ptr cobol_pdstax 000134 end_stmt_ptr cobol_pdstax 000136 iscond cobol_pdstax 000137 ky cobol_pdstax 000140 file_org cobol_pdstax 000141 seg_num cobol_pdstax 000142 op_mode cobol_pdstax 000143 mod_num cobol_pdstax 000144 act_num cobol_pdstax 000145 EW cobol_pdstax 000146 last_seg_num cobol_pdstax 000150 op_ptr cobol_pdstax 000152 left_ptr cobol_pdstax 000154 op cobol_pdstax 000162 left cobol_pdstax 000170 not cobol_pdstax 000172 andor cobol_pdstax 000174 sort_count cobol_pdstax 000176 oploc cobol_pdstax 000200 seg_usage_string cobol_pdstax 000204 seg_usage_ptr cobol_pdstax 000206 expind cobol_pdstax 000210 ae cobol_pdstax 000212 set_sop cobol_pdstax 000213 pigz_res cobol_pdstax 000214 END_WORD cobol_pdstax 000215 nest_lev cobol_pdstax 000216 ST cobol_pdstax 002616 prev_diag cobol_pdstax 002620 prev_token_ptr cobol_pdstax 002622 DIAG_NUM cobol_pdstax 002623 message_ind cobol_pdstax 002624 tm1 cobol_pdstax 002625 tm2 cobol_pdstax 002626 tm3 cobol_pdstax 002627 tm4 cobol_pdstax 002630 tm5 cobol_pdstax 002631 declprocbit cobol_pdstax 002632 vfile_key cobol_pdstax 002633 kc cobol_pdstax 002634 lev_save cobol_pdstax 002635 subs cobol_pdstax 002640 sub_loc cobol_pdstax 002641 indicators cobol_pdstax 002642 st cobol_pdstax 002643 tln cobol_pdstax 002644 O1_ptr cobol_pdstax 002646 O2_ptr cobol_pdstax 002650 O1 cobol_pdstax 002652 O2 cobol_pdstax 002654 code_env_ptr cobol_pdstax 002656 code_option cobol_pdstax 002660 code_env cobol_pdstax 002674 DATA cobol_pdstax 015014 file_number cobol_pdstax 015016 ft_ptr cobol_pdstax 015020 fkey_ptr cobol_pdstax 015022 err cobol_pdstax 015023 format cobol_pdstax 015024 sort_key cobol_pdstax 015026 dg_ptr cobol_pdstax 015030 lev_dg_ptr cobol_pdstax 015032 diag_item cobol_pdstax 015041 lev_diag_item cobol_pdstax 015050 jkpfm_ptr cobol_pdstax 015052 perform_range_key cobol_pdstax 015054 sav_bit cobol_pdstax 015055 arith_op cobol_pdstax 015056 end_decl_bit cobol_pdstax 015060 sav cobol_pdstax 015062 cssavebit cobol_pdstax 015063 saveperfrange cobol_pdstax 015072 savlaskey cobol_pdstax 015074 junk_ptr cobol_pdstax 015076 shprio cobol_pdstax 015077 prio1 cobol_pdstax 015100 prio2 cobol_pdstax 015101 data_name_bit cobol_pdstax 015102 index_name_bit cobol_pdstax 015104 common_key cobol_pdstax 015106 common_recsize cobol_pdstax 015107 astack cobol_pdstax 015222 cstack cobol_pdstax 015676 act_log cobol_pdstax 015702 work cobol_pdstax 015706 subject cobol_pdstax 015712 soperator cobol_pdstax 015716 coperator cobol_pdstax 015722 lang_num cobol_pdstax 015723 L cobol_pdstax 015724 LL cobol_pdstax 015725 holdatrue cobol_pdstax 015726 TAG cobol_pdstax 015730 c_ptr cobol_pdstax 015732 lognot cobol_pdstax 015733 last_wd_per cobol_pdstax 015734 LTP cobol_pdstax 015735 tempkey cobol_pdstax 015736 opeosptr cobol_pdstax 015740 litcnt cobol_pdstax 015741 saveos cobol_pdstax 015754 savoccptr cobol_pdstax 015755 subcnt cobol_pdstax 015756 srtrngptr cobol_pdstax 015760 interp cobol_pdstax 015772 intrp_stack cobol_pdstax 016106 trace_ptr cobol_pdstax 016110 dumfix cobol_pdstax 016111 tempchar1 cobol_pdstax 016112 syntax_line_ptr cobol_pdstax 016114 sline cobol_pdstax 016121 ii cobol_pdstax 016122 key_count cobol_pdstax 016123 file_count cobol_pdstax 016124 header cobol_pdstax 017114 eosptr cobol_pdstax 017116 mptr cobol_pdstax 017120 savitmptr cobol_pdstax 017122 dpnptr cobol_pdstax 017124 savidptr cobol_pdstax 017126 occptr cobol_pdstax 017130 convtemp cobol_pdstax 017131 histno cobol_pdstax 017132 save_gentag cobol_pdstax 017134 seqvarptr cobol_pdstax 017136 seqvarleng cobol_pdstax 017140 varrecaddr cobol_pdstax 017142 repcsbit cobol_pdstax 017144 eos_perform_ptr cobol_pdstax 017146 eos_perform_size cobol_pdstax 017147 eos_perform cobol_pdstax 017162 rw_perform_ptr cobol_pdstax 017164 rw_perform_size cobol_pdstax 017165 rw_perform cobol_pdstax 017174 rw_move_ptr cobol_pdstax 017176 rw_move_size cobol_pdstax 017177 rw_move cobol_pdstax 017206 supp_lit_ptr cobol_pdstax 017210 supp_lit_size cobol_pdstax 017211 supp_lit cobol_pdstax 017224 eos_move_ptr cobol_pdstax 017226 eos_move_size cobol_pdstax 017227 eos_move cobol_pdstax 017242 cdtoken_ptr cobol_pdstax 017244 file_desc_1_ptr cobol_pdstax 017412 rel_offset get_rel_offset 017576 i test_subs 017577 val test_subs 017764 i test_stack 017765 res test_stack THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as r_ge_a call_ext_out return_mac mdfx1 ext_entry any_to_any_truncate_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cobol_c_list cobol_idedsyn$get_seg_limit cobol_imp_word$lang_name cobol_pd_code$code cobol_pd_code$initialize cobol_pdst cobol_read_ft_ cobol_swf_get cobol_swf_put 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_$con_end_ptr cobol_$diag_ptr cobol_ext_$cobol_cmfp cobol_ext_$cobol_com_ptr cobol_ext_$cobol_pdofp cobol_ext_$cobol_rm2fp LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 88 001126 6587 001134 6637 001136 6707 001141 6724 001153 7247 001155 7251 001157 7264 001173 7268 001175 7279 001207 7283 001211 7294 001222 7298 001224 7312 001242 7316 001244 92 001260 93 001262 94 001263 95 001265 96 001266 97 001270 98 001272 99 001273 100 001274 101 001276 102 001277 103 001305 104 001306 108 001313 109 001315 111 001316 112 001321 113 001325 115 001326 116 001330 117 001333 118 001336 120 001344 122 001355 123 001356 124 001360 126 001362 127 001364 128 001365 129 001366 130 001370 132 001371 133 001375 135 001377 136 001401 137 001402 138 001403 139 001405 140 001407 142 001411 143 001413 144 001415 145 001417 147 001421 148 001423 149 001425 150 001427 151 001431 152 001433 153 001435 155 001437 157 001441 158 001443 159 001445 160 001447 161 001451 162 001453 164 001455 165 001457 167 001465 168 001467 169 001470 170 001472 174 001474 175 001477 176 001501 177 001503 180 001505 181 001515 182 001517 183 001521 184 001523 185 001524 186 001526 187 001530 188 001532 189 001534 190 001536 191 001540 192 001542 193 001544 195 001546 196 001550 198 001552 199 001553 200 001555 202 001564 205 001601 207 001602 209 001605 215 001606 219 001622 222 001623 225 001627 227 001631 231 001635 234 001640 238 001654 242 001664 245 001673 248 001711 254 001720 256 001721 259 001722 261 001725 264 001727 266 001731 268 001733 271 001742 273 001752 276 001754 279 001761 283 001763 284 001764 285 001765 288 001766 291 002002 293 002004 295 002006 298 002021 301 002025 302 002030 304 002033 306 002034 310 002036 313 002045 314 002047 317 002051 321 002064 324 002071 326 002074 328 002075 331 002101 334 002114 335 002120 337 002123 339 002124 342 002130 345 002143 347 002146 349 002147 351 002151 352 002153 354 002155 356 002163 530 002164 534 002172 540 002173 544 002207 545 002210 549 002216 550 002217 554 002230 558 002231 563 002237 565 002250 566 002253 569 002254 574 002255 578 002262 579 002263 583 002266 584 002267 589 002276 593 002277 597 002312 600 002321 601 002323 603 002324 606 002325 610 002347 611 002350 616 002354 619 002355 623 002375 625 002376 627 002405 629 002410 634 002424 635 002426 639 002432 641 002435 644 002436 648 002447 651 002450 655 002453 656 002454 660 002457 663 002460 668 002465 671 002500 674 002501 676 002503 682 002514 687 002515 692 002523 693 002534 694 002537 696 002540 699 002541 703 002550 706 002551 710 002560 716 002561 721 002564 722 002565 724 002576 726 002602 732 002603 736 002610 737 002611 741 002620 743 002627 745 002636 747 002637 749 002640 753 002647 757 002650 762 002653 763 002654 765 002665 767 002673 769 002674 774 002677 776 002700 780 002703 781 002704 785 002714 786 002715 790 002720 791 002721 798 002724 800 002730 802 002733 804 002736 806 002742 807 002743 810 002745 812 002747 815 002752 816 002753 819 002755 821 002757 823 002762 825 002766 826 002767 829 002771 830 002773 832 002775 835 003000 836 003001 839 003003 841 003006 843 003012 844 003013 847 003015 849 003017 854 003022 874 003023 878 003027 884 003030 888 003033 889 003034 893 003045 895 003051 896 003052 900 003055 905 003056 909 003061 912 003062 916 003065 917 003072 918 003100 920 003101 924 003102 928 003106 933 003107 937 003116 938 003117 942 003122 943 003123 947 003135 951 003136 955 003141 956 003142 960 003153 962 003161 965 003162 969 003173 972 003174 976 003204 977 003205 982 003211 985 003217 990 003222 996 003223 1001 003226 1002 003227 1004 003240 1006 003244 1009 003245 1014 003255 1015 003256 1017 003263 1021 003264 1028 003267 1029 003270 1033 003301 1035 003305 1036 003306 1041 003311 1043 003321 1044 003322 1047 003325 1048 003326 1049 003327 1051 003331 1054 003347 1057 003350 1061 003354 1064 003355 1068 003361 1071 003362 1076 003365 1079 003374 1082 003377 1083 003401 1084 003402 1086 003404 1089 003422 1093 003423 1097 003433 1098 003434 1102 003446 1103 003447 1107 003453 1113 003454 1118 003457 1119 003460 1122 003471 1124 003477 1130 003500 1134 003512 1138 003513 1143 003516 1144 003517 1146 003530 1148 003541 1151 003542 1155 003545 1159 003546 1163 003551 1167 003552 1171 003573 1172 003575 1173 003577 1176 003600 1178 003612 1179 003614 1180 003616 1181 003620 1183 003621 1187 003622 1191 003637 1195 003640 1199 003643 1202 003644 1206 003654 1208 003655 1212 003665 1213 003666 1217 003675 1219 003676 1224 003706 1225 003707 1229 003717 1233 003720 1237 003730 1241 003731 1245 003736 1246 003737 1250 003743 1251 003744 1255 003747 1259 003750 1263 003764 1264 003765 1266 003766 1268 003777 1270 004002 1272 004005 1274 004006 1279 004012 1286 004013 1291 004021 1297 004022 1301 004034 1305 004035 1309 004047 1312 004050 1316 004052 1318 004057 1320 004064 1321 004066 1322 004067 1324 004070 1329 004101 1331 004106 1332 004111 1335 004120 1336 004121 1342 004130 1344 004134 1345 004135 1349 004142 1350 004143 1352 004144 1354 004145 1358 004155 1359 004156 1363 004157 1365 004161 1394 004162 1398 004176 1399 004177 1403 004206 1404 004207 1409 004221 1412 004230 1415 004236 1417 004252 1419 004253 1422 004265 1424 004266 1427 004275 1429 004276 1432 004302 1434 004303 1437 004307 1439 004310 1443 004314 1447 004315 1452 004320 1454 004333 1457 004334 1461 004342 1463 004345 1466 004346 1472 004352 1473 004354 1479 004376 1483 004377 1487 004402 1488 004403 1492 004406 1493 004407 1497 004416 1503 004417 1508 004422 1509 004423 1511 004434 1515 004435 1519 004441 1523 004442 1528 004446 1531 004451 1532 004452 1534 004462 1536 004466 1540 004467 1545 004507 1546 004510 1551 004517 1553 004521 1557 004522 1561 004531 1562 004535 1563 004537 1564 004541 1566 004542 1569 004543 1573 004553 1577 004554 1581 004560 1586 004561 1593 004600 1594 004601 1598 004620 1599 004621 1604 004651 1605 004652 1608 004662 1611 004677 1612 004700 1616 004716 1617 004717 1624 004763 1625 004764 1627 004767 1629 004770 1704 004771 1708 004775 1711 005007 1713 005012 1715 005015 1716 005016 1720 005032 1722 005037 1723 005040 1727 005053 1728 005054 1730 005057 1733 005060 1737 005072 1738 005073 1740 005076 1742 005077 1745 005100 1750 005104 1753 005110 1755 005116 1758 005117 1763 005130 1764 005131 1767 005140 1768 005141 1770 005146 1774 005147 1779 005155 1780 005156 1782 005161 1787 005162 1791 005166 1794 005167 1799 005207 1802 005210 1806 005220 1809 005221 1813 005225 1816 005226 1820 005232 1822 005236 1823 005242 1827 005243 1829 005246 1830 005252 1834 005253 1838 005254 1842 005260 1844 005264 1847 005265 1851 005301 1854 005302 1858 005314 1861 005315 1866 005321 1869 005323 1871 005327 1872 005330 1877 005334 1880 005336 1882 005342 1883 005343 1888 005347 1890 005354 1892 005355 1895 005362 1896 005363 1901 005367 1903 005374 1905 005375 1908 005402 1909 005403 1914 005407 1916 005417 1918 005420 1921 005432 1922 005433 1927 005454 1932 005455 1936 005471 1937 005473 1939 005474 1941 005475 1945 005504 1946 005505 1950 005526 1951 005527 1955 005536 1956 005537 1960 005551 1962 005552 1967 005567 1969 005570 1973 005575 1974 005576 1978 005602 1979 005603 1984 005614 1986 005622 1988 005623 1992 005632 1994 005641 1996 005650 1999 005651 2001 005652 2005 005661 2006 005662 2010 005677 2011 005700 2015 005703 2018 005704 2024 005710 2028 005714 2032 005717 2036 005722 2037 005723 2043 005727 2047 005733 2050 005741 2054 005744 2055 005745 2061 005751 2065 005755 2068 005763 2072 005766 2073 005767 2077 005775 2078 005776 2082 006001 2084 006005 2085 006006 2090 006011 2092 006020 2093 006021 2097 006027 2098 006030 2103 006037 2108 006040 2111 006041 2115 006044 2116 006045 2120 006053 2124 006054 2128 006066 2129 006067 2133 006075 2136 006076 2140 006101 2143 006102 2148 006103 2154 006104 2158 006111 2160 006112 2164 006115 2165 006116 2169 006127 2171 006133 2173 006134 2177 006137 2178 006140 2182 006144 2186 006145 2190 006154 2194 006155 2198 006161 2204 006162 2210 006177 2216 006200 2220 006212 2222 006213 2226 006223 2232 006224 2236 006227 2242 006230 2246 006236 2250 006237 2254 006245 2260 006246 2264 006251 2265 006252 2269 006263 2272 006301 2278 006302 2282 006306 2288 006307 2293 006316 2294 006320 2295 006321 2297 006323 2300 006341 2306 006342 2311 006353 2312 006354 2315 006361 2318 006372 2321 006403 2324 006417 2326 006421 2328 006422 2329 006433 2332 006453 2333 006455 2335 006456 2339 006460 2354 006461 2359 006470 2361 006471 2366 006474 2369 006477 2371 006500 2376 006513 2378 006514 2382 006517 2385 006520 2389 006521 2390 006531 2391 006536 2392 006546 2394 006550 2396 006554 2399 006555 2403 006556 2404 006567 2405 006574 2406 006604 2408 006606 2410 006612 2414 006613 2418 006621 2424 006622 2428 006631 2432 006632 2437 006647 2440 006656 2443 006657 2447 006662 2450 006665 2452 006672 2455 006674 2457 006701 2459 006703 2461 006706 2463 006714 2465 006717 2466 006720 2470 006726 2472 006733 2475 006734 2479 006737 2481 006741 2483 006742 2486 006750 2489 006753 2491 006754 2494 006755 2497 006756 2501 006762 2506 006763 2510 006767 2514 006770 2519 006777 2520 007000 2522 007010 2524 007013 2527 007014 2531 007015 2535 007022 2539 007023 2543 007030 2547 007031 2551 007036 2555 007037 2559 007044 2563 007045 2567 007050 2569 007055 2571 007057 2573 007061 2575 007063 2579 007064 2583 007067 2585 007074 2587 007076 2591 007077 2595 007102 2597 007107 2599 007111 2601 007113 2605 007114 2609 007120 2613 007121 2617 007127 2621 007130 2625 007134 2629 007135 2634 007140 2637 007143 2638 007144 2640 007155 2642 007161 2647 007162 2651 007163 2656 007166 2657 007167 2659 007200 2661 007204 2665 007205 2669 007211 2673 007212 2678 007233 2679 007234 2681 007235 2683 007236 2687 007242 2689 007243 2693 007253 2695 007254 2699 007266 2701 007267 2705 007271 2707 007272 2711 007300 2713 007301 2717 007305 2719 007306 2722 007311 2725 007313 2727 007316 2729 007317 2733 007322 2735 007323 2739 007327 2740 007332 2744 007336 2746 007337 2751 007343 2753 007345 2755 007353 2759 007360 2761 007364 2763 007365 2768 007374 2770 007375 2775 007404 2777 007405 2782 007414 2784 007415 2788 007426 2791 007430 2793 007431 2797 007434 2799 007435 2804 007444 2806 007445 2810 007446 2813 007450 2815 007451 2819 007455 2821 007460 2822 007464 2824 007465 2827 007466 2829 007471 2831 007474 2832 007500 2835 007501 2838 007502 2840 007506 2842 007507 2846 007512 2847 007516 2850 007517 2852 007520 2857 007524 2859 007525 2863 007531 2865 007537 2867 007544 2869 007551 2872 007553 2873 007555 2877 007570 2880 007571 2882 007572 2887 007575 2889 007576 2893 007600 2897 007610 2900 007616 2902 007623 2908 007636 2911 007637 2914 007642 2916 007643 2918 007644 2932 007645 2937 007650 2938 007651 2940 007662 2943 007666 2950 007667 2955 007672 2956 007673 2958 007704 2961 007712 2964 007713 2968 007717 2970 007720 2974 007724 2976 007725 2980 007734 2983 007744 2984 007745 2987 007746 2988 007751 2990 007757 2992 007760 2996 007765 2998 007766 3007 010013 3009 010014 3015 010027 3025 010030 3029 010032 3031 010033 3037 010042 3040 010044 3042 010045 3044 010046 3051 010061 3159 010062 3161 010063 3168 010064 3170 010067 3174 010070 3176 010074 3177 010077 3179 010100 3184 010101 3186 010104 3187 010105 3195 010106 3197 010110 3201 010111 3203 010114 3208 010115 3211 010117 3213 010122 3215 010123 3217 010130 3219 010131 3221 010136 3223 010137 3225 010142 3227 010143 3230 010147 3232 010150 3235 010154 3239 010155 3241 010162 3242 010164 3247 010165 3249 010172 3251 010173 3253 010200 3254 010201 3256 010206 3257 010207 3259 010212 3261 010213 3263 010220 3268 010221 3270 010226 3275 010227 3277 010232 3283 010233 3285 010240 3289 010241 3291 010246 3292 010247 3294 010255 3296 010256 3298 010261 3299 010262 3300 010264 3301 010266 3306 010267 3308 010274 3312 010275 3314 010302 3315 010304 3320 010305 3322 010312 3324 010313 3328 010322 3331 010327 3334 010334 3337 010341 3339 010345 3340 010346 3352 010347 3354 010350 3363 010351 3365 010357 3366 010360 3370 010361 3372 010364 3377 010365 3379 010367 3380 010371 3382 010404 3383 010412 3387 010413 3389 010414 3401 010415 3404 010421 3407 010423 3409 010431 3412 010435 3415 010436 3417 010444 3421 010450 3423 010452 3427 010453 3429 010455 3432 010462 3433 010464 3435 010466 3436 010467 3439 010470 3441 010473 3445 010474 3447 010476 3448 010500 3450 010513 3451 010521 3456 010522 3458 010523 3466 010524 3469 010530 3470 010532 3471 010534 3472 010536 3473 010537 3475 010541 3479 010542 3481 010543 3483 010544 3485 010550 3486 010551 3488 010552 3490 010557 3491 010561 3492 010562 3494 010563 3498 010572 3501 010577 3504 010604 3507 010611 3511 010615 3512 010616 3515 010617 3517 010624 3518 010625 3520 010626 3524 010635 3527 010642 3530 010647 3533 010654 3537 010660 3538 010661 3545 010662 3547 010670 3548 010672 3551 010676 3552 010700 3553 010702 3556 010703 3558 010705 3559 010707 3562 010722 3563 010730 3568 010731 3570 010736 3571 010737 3573 010745 3577 010746 3579 010750 3580 010752 3582 010764 3586 010765 3588 010766 3598 010767 3602 010773 3603 010775 3604 011002 3605 011003 3608 011010 3611 011015 3615 011021 3616 011022 3625 011023 3627 011032 3629 011033 3634 011034 3636 011040 3638 011041 3649 011042 3651 011044 3652 011046 3654 011060 3658 011061 3660 011066 3664 011067 3666 011071 3668 011072 3673 011073 3675 011075 3677 011107 3680 011110 3682 011115 3683 011116 3685 011123 3686 011124 3688 011127 3690 011130 3695 011131 3697 011136 3698 011142 3702 011143 3704 011150 3705 011154 3711 011155 3713 011156 3714 011165 3715 011167 3716 011171 3717 011173 3719 011174 3722 011176 3723 011200 3726 011210 3727 011214 3731 011215 3733 011222 3734 011223 3736 011224 3744 011225 3746 011227 3748 011230 3756 011231 3758 011234 3760 011235 3762 011241 3766 011242 3768 011244 3770 011245 3772 011246 3783 011247 3785 011252 3789 011253 3791 011256 3795 011257 3797 011263 3799 011264 3801 011265 3803 011266 3806 011267 3808 011270 3812 011271 3814 011274 3818 011275 3820 011300 3824 011301 3826 011304 3831 011305 3895 011306 3897 011311 3898 011312 3902 011313 3904 011316 3905 011317 3909 011320 3911 011323 3912 011324 3916 011325 3918 011330 3920 011331 3922 011333 3923 011335 3925 011347 3929 011350 3931 011352 3932 011354 3934 011366 3938 011367 3940 011371 3942 011403 3943 011404 3945 011406 3947 011420 3953 011421 3955 011423 3957 011435 3959 011436 3964 011437 3966 011443 3970 011444 3972 011445 3980 011446 3982 011452 3985 011454 3988 011464 3991 011467 3992 011470 3993 011474 3994 011477 3998 011500 4001 011515 4003 011516 4007 011527 4009 011532 4011 011534 4018 011535 4020 011536 4033 011537 4035 011542 4037 011543 4046 011544 4051 011552 4054 011556 4056 011557 4059 011566 4085 011567 4087 011570 4113 011571 4115 011576 4117 011577 4119 011604 4121 011605 4123 011610 4129 011611 4131 011613 4133 011625 4137 011626 4139 011643 4143 011644 4145 011645 4146 011651 4150 011652 4152 011653 4156 011654 4159 011660 4160 011663 4164 011664 4168 011672 4170 011675 4171 011676 4172 011701 4175 011705 4177 011712 4179 011716 4180 011720 4181 011722 4182 011725 4186 011726 4190 011734 4192 011740 4193 011743 4200 011744 4202 011746 4203 011752 4205 011753 4209 011754 4211 011757 4215 011760 4217 011763 4221 011764 4223 011770 4224 011771 4225 011774 4229 011775 4234 011776 4236 012000 4240 012001 4242 012003 4243 012006 4248 012007 4250 012012 4254 012013 4260 012014 4262 012020 4266 012021 4268 012024 4269 012025 4275 012026 4277 012030 4278 012032 4279 012033 4282 012034 4284 012037 4285 012041 4289 012042 4291 012044 4292 012045 4304 012046 4306 012052 4307 012053 4308 012057 4309 012060 4313 012061 4315 012062 4368 012063 4370 012066 4374 012067 4376 012074 4378 012077 4379 012100 4381 012101 4386 012103 4387 012105 4389 012107 4390 012111 4392 012122 4396 012123 4398 012126 4402 012127 4404 012134 4405 012136 4406 012140 4408 012145 4412 012146 4414 012153 4415 012155 4416 012157 4418 012164 4422 012165 4424 012170 4429 012171 4431 012175 4432 012176 4433 012200 4434 012203 4435 012213 4436 012215 4442 012216 4444 012220 4449 012221 4451 012224 4456 012225 4458 012232 4459 012234 4463 012235 4465 012243 4471 012244 4473 012251 4475 012254 4476 012256 4477 012262 4478 012264 4480 012266 4481 012270 4483 012301 4489 012302 4491 012307 4493 012312 4494 012314 4495 012320 4496 012322 4498 012324 4499 012326 4501 012337 4505 012340 4508 012350 4509 012353 4513 012354 4515 012357 4519 012360 4521 012362 4523 012374 4528 012375 4531 012405 4532 012412 4538 012413 4541 012417 4542 012421 4545 012434 4546 012436 4547 012437 4551 012440 4553 012446 4554 012450 4555 012452 4556 012456 4560 012457 4562 012463 4563 012464 4567 012465 4570 012470 4571 012472 4573 012504 4574 012505 4578 012506 4580 012512 4581 012513 4603 012514 4605 012517 4606 012521 4608 012533 4609 012534 4613 012535 4615 012543 4619 012544 4621 012546 4623 012561 4624 012562 4625 012564 4630 012577 4632 012601 4634 012613 4638 012614 4640 012615 4641 012617 4643 012631 4647 012632 4649 012633 4661 012634 4666 012635 4668 012637 4670 012652 4671 012653 4675 012654 4677 012656 4679 012670 4683 012671 4685 012672 4686 012674 4688 012707 4689 012711 4702 012712 4704 012713 4736 012714 4738 012716 4739 012717 4743 012720 4745 012722 4746 012723 4750 012724 4752 012726 4753 012727 4757 012730 4759 012732 4760 012733 4764 012734 4766 012736 4767 012737 4769 012740 4772 012741 4774 012742 4776 012743 4778 012744 4780 012746 4781 012751 4782 012753 4784 012764 4786 012765 4788 012767 4789 012770 4791 012771 4793 012773 4794 012775 4795 012777 4797 013011 4799 013012 4802 013015 4803 013017 4805 013031 4806 013032 4808 013033 4810 013041 4811 013046 4812 013047 4814 013050 4816 013052 4818 013053 4820 013055 4821 013056 4823 013057 4825 013061 4826 013062 4828 013063 4830 013065 4832 013066 4846 013067 4848 013073 4849 013074 4865 013075 4867 013077 4870 013101 4871 013105 4873 013110 4874 013112 4875 013115 4879 013116 4882 013121 4883 013123 4884 013124 4887 013126 4889 013130 4890 013134 4892 013137 4893 013141 4901 013142 4903 013144 4905 013146 4909 013150 4911 013161 4913 013162 4915 013172 4917 013173 4918 013177 4920 013202 4921 013205 4924 013206 4925 013210 4926 013212 4927 013214 4928 013216 4929 013217 4931 013222 4936 013223 4939 013224 4942 013227 4945 013233 4946 013235 4947 013237 4948 013241 4949 013243 4950 013244 4951 013247 4955 013250 4958 013255 4959 013260 4960 013262 4966 013263 4969 013270 4970 013277 4971 013301 4972 013303 4973 013312 4977 013313 4979 013314 4980 013317 4982 013321 4985 013322 4986 013324 4988 013326 4989 013332 4991 013335 4992 013337 4994 013340 4996 013342 4998 013343 5000 013344 5002 013345 5004 013347 5006 013351 5008 013355 5010 013356 5027 013357 5029 013360 5030 013362 5152 013363 5155 013365 5156 013371 5159 013374 5163 013377 5164 013403 5165 013405 5167 013407 5171 013410 5173 013413 5175 013414 5178 013423 5183 013445 5185 013446 5188 013463 5190 013500 5192 013515 5194 013532 5200 013533 5202 013535 5203 013537 5205 013542 5207 013543 5213 013544 5215 013550 5216 013552 5217 013557 5218 013561 5219 013563 5220 013564 5221 013566 5222 013572 5223 013575 5225 013577 5226 013602 5227 013604 5228 013606 5230 013612 5235 013613 5237 013616 5238 013617 5240 013621 5241 013625 5243 013641 5245 013642 5251 013643 5253 013653 5254 013654 5256 013656 5257 013662 5259 013665 5260 013667 5261 013674 5263 013710 5264 013711 5268 013712 5270 013714 5274 013715 5276 013717 5280 013720 5282 013723 5289 013724 5291 013731 5292 013735 5294 013737 5295 013741 5296 013745 5298 013747 5302 013750 5306 013752 5308 013762 5311 013776 5315 013777 5318 014003 5323 014004 5325 014006 5326 014012 5329 014014 5331 014030 5335 014031 5338 014040 5346 014060 5350 014070 5352 014072 5354 014076 5357 014077 5358 014101 5359 014105 5401 014106 5406 014124 5410 014127 5411 014133 5413 014137 5414 014141 5421 014142 5424 014145 5425 014147 5426 014151 5427 014153 5428 014156 5430 014160 5438 014161 5440 014166 5442 014172 5445 014174 5448 014176 5451 014200 5454 014203 5455 014205 5456 014207 5457 014211 5460 014214 5465 014215 5467 014220 5469 014222 5470 014226 5472 014230 5473 014234 5475 014240 5478 014241 5480 014244 5482 014246 5483 014252 5485 014256 5487 014260 5488 014264 5490 014270 5497 014271 5499 014274 5501 014276 5504 014302 5509 014315 5511 014321 5515 014322 5517 014327 5518 014334 5519 014337 5521 014342 5524 014343 5527 014347 5529 014353 5530 014355 5531 014361 5532 014365 5536 014366 5540 014372 5544 014373 5545 014374 5548 014400 5550 014414 5551 014420 5552 014425 5553 014431 5554 014433 5555 014435 5560 014436 5565 014437 5569 014440 5571 014446 5580 014447 5582 014455 5583 014457 5584 014462 5585 014464 5586 014466 5587 014470 5592 014471 5596 014475 5601 014506 5602 014507 5603 014510 5606 014514 5608 014517 5613 014530 5614 014531 5621 014532 5624 014533 5646 014534 5650 014537 5652 014542 5656 014555 5658 014556 5659 014560 5660 014562 5661 014564 5662 014566 5663 014567 5667 014570 5669 014573 5671 014575 5674 014605 5677 014610 5678 014613 5680 014617 5681 014621 5683 014625 5684 014630 5689 014634 5691 014637 5693 014640 5695 014642 5697 014654 5699 014655 5701 014657 5703 014671 5706 014672 5709 014673 5712 014700 5715 014701 5718 014706 5719 014707 5721 014710 5723 014715 5727 014716 5729 014723 5733 014724 5735 014731 5739 014732 5741 014737 5745 014740 5747 014743 5751 014744 5753 014746 5757 014747 5759 014752 5763 014753 5765 014756 5766 014757 5768 014760 5770 014763 5771 014764 5773 014765 5775 014770 5779 014771 5783 014774 5785 015005 5787 015007 5789 015012 5791 015013 5793 015016 5795 015017 5797 015022 5799 015023 5801 015026 5803 015027 5806 015030 5809 015035 5811 015036 5814 015037 5816 015040 5818 015044 5821 015060 5822 015061 5824 015062 5825 015063 5827 015066 5828 015067 5829 015072 5830 015073 5832 015074 5834 015076 5835 015101 5836 015102 5838 015103 5840 015105 5841 015113 5843 015114 5845 015120 5846 015123 5847 015124 5851 015132 5856 015133 5858 015135 5859 015143 5860 015147 5862 015150 5865 015164 5887 015165 5889 015166 5891 015167 5893 015170 5894 015171 5896 015172 5898 015173 5908 015174 5910 015176 5912 015177 5914 015204 5916 015205 5918 015211 5920 015212 5922 015213 5923 015214 5924 015215 5926 015216 5929 015217 5930 015235 5931 015240 5933 015241 5936 015255 5939 015266 5941 015267 5943 015270 5945 015272 5947 015274 5949 015275 5958 015315 5960 015316 5963 015320 5965 015321 5968 015322 5970 015323 5974 015336 5975 015337 5976 015340 5977 015341 5981 015347 5985 015362 5991 015373 5992 015375 5995 015376 5998 015405 6000 015410 6002 015411 6007 015416 6008 015427 6013 015436 6014 015445 6016 015455 6037 015456 6042 015462 6043 015464 6045 015465 6098 015466 6103 015467 6106 015473 6107 015500 6109 015501 6113 015505 6120 015506 6122 015512 6135 015513 6137 015522 6139 015523 6141 015532 6143 015533 6145 015536 6147 015540 6149 015541 6152 015551 6156 015562 6160 015566 6162 015567 6166 015571 6170 015577 6172 015601 6174 015605 6176 015606 6178 015607 6181 015615 6182 015616 6184 015617 6186 015623 6187 015624 6189 015625 6191 015631 6192 015636 6193 015637 6195 015640 6197 015644 6198 015647 6199 015650 6200 015651 6202 015655 6203 015660 6205 015661 6209 015666 6211 015673 6214 015674 6217 015700 6218 015701 6219 015707 6220 015710 6228 015711 6230 015712 6247 015713 6249 015724 6250 015727 6254 015733 6256 015735 6268 015736 6270 015737 6273 015740 6275 015744 6276 015747 6277 015750 6288 015751 6292 015762 6294 015763 6297 015767 6299 015770 6301 015771 6302 016001 6304 016002 6307 016003 6309 016007 6310 016014 6311 016016 6312 016017 6314 016020 6317 016021 6319 016025 6320 016027 6322 016030 6324 016031 6325 016032 6337 016033 6339 016034 6341 016035 6343 016036 6344 016037 6346 016040 6348 016041 6384 016042 6386 016043 6390 016061 6392 016062 6394 016065 6396 016066 6402 016100 6403 016102 6405 016103 6407 016105 6409 016106 6411 016116 6413 016117 6415 016121 6417 016122 6419 016126 6420 016127 6421 016130 6423 016131 6425 016135 6427 016136 6429 016142 6430 016143 6432 016144 6434 016150 6435 016151 6444 016152 6448 016165 6452 016202 6455 016212 6457 016213 6459 016217 6461 016220 6464 016225 6465 016231 6467 016233 6468 016237 6469 016240 6494 016241 6497 016242 6500 016243 6549 016245 6550 016247 6551 016260 358 016261 364 016262 367 016264 368 016266 370 016267 372 016304 375 016307 377 016315 379 016320 381 016327 384 016336 387 016352 389 016353 393 016365 396 016377 399 016400 401 016401 403 016402 404 016404 405 016406 406 016407 408 016410 413 016412 416 016424 417 016426 418 016430 419 016432 421 016441 423 016442 428 016444 429 016446 430 016450 431 016452 433 016454 435 016463 437 016464 440 016465 448 016467 449 016471 450 016474 451 016476 453 016505 456 016506 465 016510 466 016512 467 016514 468 016516 470 016525 473 016526 481 016530 482 016532 483 016534 484 016536 487 016540 489 016547 491 016550 494 016551 497 016574 499 016575 502 016576 505 016621 507 016622 510 016623 512 016642 514 016643 517 016644 520 016671 857 016672 863 016674 867 016705 869 016707 1367 016710 1370 016711 1371 016712 1373 016714 1376 016730 1379 016737 1381 016742 1382 016744 1385 016745 1387 016746 1389 016747 1391 016751 1631 016752 1634 016753 1636 016763 1637 016765 1640 016766 1642 016775 1643 016777 1648 017000 1651 017013 1654 017017 1657 017022 1658 017024 1660 017025 1662 017026 1663 017030 1667 017031 1668 017033 1670 017035 1672 017052 1701 017054 1674 017055 1683 017057 1684 017064 1686 017065 1688 017070 1691 017074 1693 017100 1695 017104 1697 017105 1698 017110 1700 017111 2342 017112 2349 017114 2351 017120 3059 017122 3066 017124 3068 017127 3070 017131 3071 017133 3073 017134 3075 017145 3077 017146 3085 017150 3088 017173 3090 017204 3092 017205 3093 017206 3095 017213 3097 017215 3099 017221 3105 017222 3111 017224 3114 017227 3116 017232 3117 017234 3118 017236 3120 017240 3122 017241 3124 017243 3132 017244 3139 017246 3142 017252 3145 017257 3146 017262 3147 017264 3148 017266 3149 017270 3151 017272 3153 017273 3155 017276 3342 017277 3344 017300 3345 017306 3346 017307 3349 017314 3350 017315 3356 017316 3358 017317 3359 017325 3391 017326 3393 017327 3394 017331 3395 017333 3397 017346 3460 017347 3462 017350 3463 017353 3464 017354 3590 017355 3592 017356 3593 017360 3594 017362 3596 017375 3618 017376 3620 017377 3622 017406 3623 017410 3774 017411 3776 017412 3777 017416 3778 017422 3834 017423 3838 017424 3841 017431 3843 017432 3847 017433 3849 017450 3853 017462 3855 017463 3859 017464 3862 017467 3865 017475 3867 017476 3871 017477 3874 017503 3876 017507 3878 017513 3880 017514 3882 017515 3886 017516 3887 017521 3888 017523 3889 017526 3891 017527 3974 017530 3976 017531 3977 017536 3978 017537 4022 017540 4024 017541 4025 017547 4026 017552 4027 017557 4028 017561 4029 017562 4061 017563 4066 017564 4068 017572 4070 017601 4072 017603 4074 017614 4075 017616 4077 017617 4079 017621 4080 017623 4088 017624 4090 017625 4091 017627 4093 017631 4095 017632 4097 017634 4099 017635 4101 017637 4103 017640 4105 017642 4107 017643 4111 017656 4294 017657 4297 017660 4298 017664 4299 017670 4300 017671 4317 017672 4319 017673 4321 017702 4322 017705 4323 017707 4324 017710 4326 017712 4328 017722 4330 017731 4331 017732 4333 017733 4334 017734 4335 017735 4336 017736 4338 017737 4341 017740 4343 017761 4346 017764 4348 017774 4349 017777 4350 020002 4351 020005 4353 020006 4354 020011 4355 020014 4356 020015 4357 020017 4358 020021 4359 020024 4360 020027 4361 020030 4362 020034 4364 020037 4583 020040 4588 020042 4589 020045 4591 020047 4592 020051 4595 020063 4596 020067 4597 020073 4599 020075 4651 020076 4653 020077 4655 020104 4656 020106 4658 020120 4659 020122 4691 020123 4694 020124 4696 020134 4698 020136 4706 020137 4708 020140 4710 020144 4711 020145 4712 020156 4714 020160 4716 020163 4718 020164 4720 020167 4722 020170 4724 020173 4726 020174 4728 020177 4730 020200 4732 020203 4851 020204 4853 020205 4854 020210 4855 020212 4857 020216 4858 020221 4860 020225 4861 020230 5012 020231 5019 020233 5023 020256 5032 020257 5034 020260 5035 020262 5036 020266 5037 020271 5038 020274 5040 020276 5041 020277 5043 020300 5049 020301 5053 020303 5054 020305 5056 020307 5059 020314 5061 020315 5064 020317 5066 020322 5067 020324 5068 020326 5069 020327 5071 020331 5073 020332 5075 020334 5076 020336 5079 020342 5083 020345 5085 020346 5087 020347 5089 020351 5091 020353 5093 020355 5095 020356 5097 020360 5099 020366 5102 020374 5105 020377 5106 020401 5108 020405 5109 020406 5112 020410 5114 020417 5115 020420 5118 020422 5120 020423 5124 020425 5131 020426 5134 020427 5136 020430 5138 020437 5140 020442 5143 020447 5144 020453 5145 020454 5148 020461 5362 020462 5366 020463 5369 020472 5372 020501 5373 020506 5374 020513 5379 020525 5380 020532 5381 020537 5385 020546 5387 020552 5388 020557 5392 020566 5394 020572 5626 020573 5632 020574 5633 020601 5635 020605 5638 020607 5640 020613 5645 020617 5867 020620 5871 020621 5874 020624 5877 020625 5881 020636 5882 020641 5883 020642 5885 020643 5899 020644 5903 020645 5904 020647 5905 020650 5906 020651 6018 020652 6025 020654 6026 020657 6029 020661 6030 020663 6033 020665 6035 020666 6047 020667 6055 020670 6056 020672 6059 020675 6062 020677 6063 020701 6067 020705 6070 020706 6071 020715 6073 020725 6076 020730 6079 020736 6081 020737 6085 020740 6086 020743 6088 020754 6089 020760 6091 020762 6094 020765 6096 020766 6124 020767 6127 020771 6128 020775 6129 021000 6131 021002 6132 021006 6133 021007 6222 021010 6224 021011 6225 021012 6226 021014 6232 021015 6237 021017 6238 021022 6239 021024 6240 021026 6241 021030 6243 021032 6245 021033 6258 021034 6262 021035 6264 021041 6266 021043 6279 021044 6282 021046 6284 021052 6327 021055 6331 021056 6332 021060 6333 021062 6335 021064 6350 021065 6354 021066 6355 021076 6356 021077 6357 021100 6358 021105 6359 021114 6361 021115 6365 021116 6366 021120 6368 021143 6371 021157 6372 021166 6374 021167 6378 021170 6382 021176 6471 021200 6479 021202 6481 021212 6482 021214 6485 021222 ----------------------------------------------------------- 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