COMPILATION LISTING OF SEGMENT cobol_perform_gen Compiled by: Multics PL/I Compiler, Release 31b, of April 24, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 05/24/89 0959.6 mst Wed Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 15 /****^ HISTORY COMMENTS: 16* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060), 17* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 18* MCR8060 cobol_perform_gen.pl1 Reformatted code to new Cobol standard. 19* END HISTORY COMMENTS */ 20 21 22 /* Modified on 06/20/80 by FCH, [4.2-1], dont call cobol_addr if in-line perform */ 23 /* Modified on 06/20/79 by FCH, [4.0-1], in-line performs added for debug */ 24 /* Modified since Version 4.0 */ 25 26 /* format: style3 */ 27 cobol_perform_gen: 28 proc (in_token_ptr); 29 30 31 declare bit_18 bit (18) based, /* 18-bit temp used to address id_10_fb*/ 32 code_ptr ptr, /* Working pointer used to locate */ 33 /* appropriate position in code seq. */ 34 con_tag (3) fixed bin, /* Tags associated with first inst of */ 35 /* Format 4 condition code sequences. */ 36 eop_proc_no fixed bin, /* Procedure no of procedure at end of */ 37 /* perform range. */ 38 er_loc fixed bin, /* Location of first inst of call to */ 39 /* cobol_error_. */ 40 false_tag fixed bin, /* Tag associated with condition false.*/ 41 format_no fixed bin, /* Format no of PERFORM statement being*/ 42 /* processed. */ 43 i_tag fixed bin, /* Tag to be associated with loc_i in */ 44 /* Formats 3 and 4. */ 45 id_tok_no (4) fixed bin, /* Token no of Format 4 varying ids. */ 46 /* id_tok_no(varying_ids) containg no */ 47 /* of tokens in perform statement + 1. */ 48 index fixed bin, /* Do loop index. */ 49 init_req_flag fixed bin, /* Set to 1 if seg initialization not */ 50 /* required; to 2, if it is. */ 51 init_tag fixed bin, /* Tag associated with first instruc- */ 52 /* tion of code generated to initial- */ 53 /* ize alterable GO's in COBOL segment */ 54 /* containing procedure-name-1. */ 55 integer fixed bin, /* If non-zero, fixed bin value of */ 56 /* integer-1. */ 57 jndex fixed bin, /* Do loop index. */ 58 lit_ptr ptr, /* Working ptr used in determining */ 59 /* value of integer-1. */ 60 lit_str (30) bit (9) /* Bit string array used in determin- */ unaligned based, 61 /* ing value of integer-1. */ 62 lo_lim fixed bin, /* From - to limits of do loop index */ 63 hi_lim fixed bin, /* used in processing conditions. */ 64 next_stmt_tag fixed bin, /* Tag associated with next executable */ 65 /* statement following procedure at */ 66 /* end of perform range. */ 67 no_inst fixed bin, /* No instructions to be emitted. */ 68 no_tokens fixed bin, /* No of tokens in statement. */ 69 p_token_ptr ptr, /* Pointer to area currently being used*/ 70 /* for building in_token structure */ 71 /* passed to cobol_arithop_gen and/or */ 72 /* cobol_compare_gen. */ 73 p1_token_ptr ptr, /* Pointers to areas reserved for */ 74 p2_token_ptr ptr, /* building in_token structure passed */ 75 /* to cobol_arithop_gen and/or */ 76 /* to cobol_compare_gen. */ 77 s_tag fixed bin, /* Utility tag. */ 78 space_req fixed bin, /* Approximate space required for */ 79 /* in_token structure containing input */ 80 /* for cobol_arithop_gen and/or */ 81 /* cobol_compare_gen. */ 82 stackoff fixed bin, /* Offset of wd allocated in stack. */ 83 temp fixed bin, /* Temporary used for calculations. */ 84 pn1_no fixed bin, /* Procedure no of procedure at */ 85 /* beginning of perform range. */ 86 pn1_priority fixed bin, /* COBOL segment no of seg containing */ 87 /* procedure-name-1. */ 88 temp_chars fixed bin (24), /* Number of characters in COBOL data */ 89 /* segment required for temporaries. */ 90 type fixed bin, /* Token type. */ 91 varying_ids fixed bin, /* No of identifiers varied in Format 4*/ 92 wk_ptr ptr; /* Ptr to token of current interest. */ 93 94 dcl temp_wk_ptr ptr; 95 dcl move_token_ptr ptr; 96 dcl dn_ptr ptr; 97 dcl keep_scanning bit (1); /*[4.0-1]*/ 98 declare (L1, L2, L3) fixed bin, 99 out_line bit (1); 100 101 102 /* Functions common to all formats */ 103 104 /* Determine format number of statement being processed. */ 105 106 start: 107 no_tokens = in_token.n; /*[4.0-1]*/ 108 eos_ptr = in_token.token_ptr (no_tokens); /*[4.0-1]*/ 109 format_no = binary (eos_ptr -> end_stmt.a, 17) + 1; 110 111 /*[4.0-1]*/ 112 if end_stmt.d = "00"b 113 then out_line = "1"b; 114 else out_line = "0"b; 115 116 /* Is segment initialization required? */ 117 118 init_req_flag = 1; 119 120 /*[4.0-1]*/ 121 if out_line /*[4.0-1]*/ 122 then do; 123 if cobol_$seg_init_list_ptr ^= null () 124 then do; 125 pn1_priority = binary (unspec (in_token.token_ptr (2) -> proc_ref.priority), 17); 126 if cobol_$priority_no ^= pn1_priority 127 then if pn1_priority > 49 128 then do index = 1 to seg_init_list.n; 129 if seg_init_list.seg.priority (index) = pn1_priority 130 then do; 131 init_req_flag = 2; 132 init_tag = seg_init_list.seg.int_tag_no (index); 133 goto next_step; 134 end; 135 136 end; 137 138 end; 139 140 /*[4.0-1]*/ 141 end; 142 143 next_step: /* Extract beginning-of-perform range procedure number from */ 144 /* second token. */ 145 /*[4.0-1]*/ 146 L1, pn1_no = in_token.token_ptr (2) -> proc_ref.proc_num; 147 148 /* Extract end_of_perform range procedure number from third */ 149 /* token, locate this procedure number in perform_list and */ 150 /* extract target_a_PN2 segno and char offset, and the tag */ 151 /* associated with the "next executable statement". */ 152 153 /*[4.0-1]*/ 154 L3, eop_proc_no = in_token.token_ptr (3) -> proc_ref.proc_num; 155 156 /*[4.0-1]*/ 157 if out_line /*[4.0-1]*/ 158 then do index = 1 to perform_list.n; 159 if perform_list.perf.proc_num (index) = eop_proc_no 160 then do; 161 if in_token.token_ptr (no_tokens) -> end_stmt.h = 1 162 then if perform_list.perf.proc_num (index + 1) = eop_proc_no 163 then index = index + 1; 164 165 target.segno = perform_list.perf.target_a_segno (index); 166 target.char_offset = perform_list.perf.target_a_offset (index); 167 next_stmt_tag = abs (perform_list.perf.int_tag_no (index)); 168 goto format (format_no); 169 end; 170 171 end; 172 173 /*[4.0-1]*/ 174 else go to format (format_no); 175 176 /* End of Common Functions */ 177 178 /* Process Format 1 PERFORM statements */ 179 180 format (1): /*[4.0-1]*/ 181 if ^out_line 182 then return; 183 184 call cobol_register$load (addr (register_request)); 185 186 if init_req_flag = 1 187 then code_ptr = addr (seq2 (3)); 188 189 else code_ptr = addr (seq2i (3)); 190 191 /*[4.2-1]*/ 192 if out_line 193 then call cobol_addr (addr (target), addrel (code_ptr, 1), null ()); 194 call cobol_emit (code_ptr, null (), init_req_flag + 2); 195 call cobol_make_tagref (pn1_no, cobol_$text_wd_off - init_req_flag, null ()); 196 197 if init_req_flag = 2 198 then call cobol_make_tagref (init_tag, cobol_$text_wd_off - 1, null ()); 199 200 call cobol_reset_r$in_line; 201 call cobol_register$load (addr (register_request)); 202 /*[4.2-1]*/ 203 if out_line 204 then call cobol_addr (addr (target), addr (seq3 (13)), null ()); 205 call cobol_emit (addr (seq3 (11)), null (), 2); 206 call cobol_make_tagref (next_stmt_tag, cobol_$text_wd_off - 2, null ()); 207 call cobol_reset_r$in_line; 208 209 return; 210 211 /* Process Format 2 PERFORM statements */ 212 213 format (2): 214 if in_token.token_ptr (4) -> numeric_lit.type = 2 215 then do; 216 integer = 0; 217 lit_ptr = addr (in_token.token_ptr (4) -> numeric_lit.literal); 218 219 do index = 1 to in_token.token_ptr (4) -> numeric_lit.places while (integer < 131072); 220 integer = integer * 10 + binary (substr (lit_ptr -> lit_str (index), 6, 4), 17); 221 end; 222 223 temp_chars = 4; 224 end; 225 226 else temp_chars = 8; 227 228 call cobol_alloc$cobol_data (temp_chars, 2, count.char_offset); 229 call cobol_register$load (addr (register_request)); 230 231 if init_req_flag = 1 232 then code_ptr = addr (seq2); 233 234 else code_ptr = addr (seq2i); 235 236 count.char_offset = count.char_offset * 4; 237 238 call cobol_addr (addr (count), code_ptr, null ());/*[4.2-1]*/ 239 if out_line 240 then call cobol_addr (addr (target), addrel (code_ptr, 2), null ()); 241 242 if temp_chars = 8 243 then do; 244 if (in_token.token_ptr (4) -> data_name.bin_36 | in_token.token_ptr (4) -> data_name.bin_18) 245 then do; /* Identifier specifying number of times to PERFORM is long or short binary. */ 246 247 /* Make a data name token for the temporary to receive the long or short binary. */ 248 temp_wk_ptr = null (); 249 call cobol_make_type9$long_bin (temp_wk_ptr, 2 /*cobol data */, count.char_offset + 4); 250 251 move_token_ptr = addr (move_in_token (1)); 252 253 if move_data_init ^= cobol_$compile_count 254 then do; /* Initialize structure used in calls to the move generator. */ 255 256 move_token_ptr -> in_token.token_ptr (1) = null (); 257 move_token_ptr -> in_token.token_ptr (4) = addr (move_eos); 258 move_token_ptr -> in_token.n = 4; 259 move_data_init = cobol_$compile_count; 260 end; /* Initialize structure used in calls to the move geerator. */ 261 262 move_token_ptr -> in_token.token_ptr (2) = in_token.token_ptr (4); 263 /* long or short bin item */ 264 move_token_ptr -> in_token.token_ptr (3) = temp_wk_ptr; 265 /* temporary in cobol data */ 266 267 call cobol_move_gen (move_token_ptr); 268 269 /* Emit code to set indicators from storage (the value just moved to cobol data) 270* and transfer to error routine if zero or negative. */ 271 272 szn_seq (1) = code_ptr -> bit_18; 273 temp = binary (substr (szn_seq (1), 4, 15)) + 1; 274 /* address portion */ 275 substr (szn_seq (1), 4, 15) = substr (unspec (temp), 22, 15); 276 call cobol_emit (addr (szn_seq (1)), null (), 1); 277 /* SZN from temp */ 278 279 call cobol_emit (addr (seq1 (7)), null (), 1); 280 /* tmoz */ 281 282 seq3 (7) = szn_seq (1); 283 284 end; /* Identifier specifying the number of times to perform is long or short binary. */ 285 286 else do; /* Identifier is unpacked or packed decimal, or overpunch sign data */ 287 288 if (in_token.token_ptr (4) -> data_name.item_signed 289 & in_token.token_ptr (4) -> data_name.sign_separate = "0"b) 290 then do; /* Overpunch sign data. */ 291 292 input_struc.token_ptr = null (); 293 call cobol_num_to_udts (in_token.token_ptr (4), input_struc.token_ptr); 294 295 end; /* Overpunch sign data. */ 296 297 else input_struc.token_ptr = in_token.token_ptr (4); 298 299 call cobol_addr (addr (input_struc), addr (seq1), null ()); 300 seq1 (1) = "000000000001000000"b; 301 seq1 (5) = code_ptr -> bit_18; 302 temp = binary (substr (seq1 (5), 4, 15), 17) + 1; 303 substr (seq1 (5), 4, 15) = substr (unspec (temp), 22, 15); 304 305 call cobol_emit (addr (seq1), null (), 4); 306 307 seq3 (7) = seq1 (5); 308 309 end; /* Identifier is unpacked or packed decimal, or overpunch sign data. */ 310 311 seq3 (8) = cmpq_id_10; 312 313 /*[4.0-1]*/ 314 if out_line /*[4.0-1]*/ 315 then call cobol_make_tagref (cobol_$next_tag, cobol_$text_wd_off - 1, null ()); 316 /*[4.0-1]*/ 317 else call cobol_make_tagref (eop_proc_no, cobol_$text_wd_off - 1, null ()); 318 319 end; 320 321 else do; 322 seq3 (7) = substr (unspec (integer), 19, 18); 323 seq3 (8) = cmpq_int_1; 324 end; 325 326 /*[4.0-1]*/ 327 if out_line /*[4.0-1]*/ 328 then do; 329 330 call cobol_emit (code_ptr, null (), init_req_flag + 3); 331 call cobol_make_tagref (pn1_no, cobol_$text_wd_off - init_req_flag, null ()); 332 333 /*[4.0-1]*/ 334 end; /*[4.0-1]*/ 335 else do; 336 L2 = cobol_$next_tag; /*[4.0-1]*/ 337 cobol_$next_tag = cobol_$next_tag + 1; 338 339 /*[4.0-1]*/ 340 call cobol_emit (addr (seq2 (1)), null (), 1); 341 /*[4.0-1]*/ 342 call cobol_emit (addr (seq2 (7)), null (), 1); 343 /*[4.0-1]*/ 344 call cobol_make_tagref (L2, cobol_$text_wd_off - 1, null ()); 345 /*[4.0-1]*/ 346 call cobol_define_tag_nc (L1, cobol_$text_wd_off); 347 /*[4.0-1]*/ 348 end; 349 350 if init_req_flag = 2 351 then call cobol_make_tagref (init_tag, cobol_$text_wd_off - 1, null ()); 352 353 call cobol_reset_r$in_line; 354 call cobol_register$load (addr (register_request)); 355 call cobol_addr (addr (count), addr (seq3 (1)), null ()); 356 seq3 (5) = seq3 (1); /*[4.2-1]*/ 357 if out_line 358 then call cobol_addr (addr (target), addr (seq3 (13)), null ()); 359 360 /*[4.0-1]*/ 361 if out_line /*[4.0-1]*/ 362 then do; 363 364 call cobol_emit (addr (seq3), null (), 7); 365 call cobol_make_tagref (pn1_no, cobol_$text_wd_off - 3, null ()); 366 call cobol_make_tagref (next_stmt_tag, cobol_$text_wd_off - 2, null ()); 367 368 /*[4.0-1]*/ 369 end; /*[4.0-1]*/ 370 else do; 371 call cobol_emit (addr (seq3), null (), 5); 372 call cobol_make_tagref (L2, cobol_$text_wd_off - 1, null ()); 373 /*[4.0-1]*/ 374 call def_L2; /*[4.0-1]*/ 375 end; 376 377 call cobol_reset_r$in_line; 378 379 if temp_chars = 8 380 then /*[4.0-1]*/ 381 if out_line 382 then do; 383 call cobol_define_tag_nc (cobol_$next_tag, cobol_$text_wd_off); 384 cobol_$next_tag = cobol_$next_tag + 1; 385 end; 386 387 return; 388 389 set_false_tag: 390 proc; 391 392 /*[4.0-1]*/ 393 if out_line /*[4.0-1]*/ 394 then false_tag = pn1_no; /*[4.0-1]*/ 395 else do; 396 false_tag, L2 = cobol_$next_tag; /*[4.0-1]*/ 397 cobol_$next_tag = cobol_$next_tag + 1; /*[4.0-1]*/ 398 end; 399 400 end; 401 402 format (3): /* Set alterable GO at end of PN2. */ 403 seq4 (3) = "000000000000000010"b; 404 call cobol_register$load (addr (register_request)); 405 if init_req_flag = 1 406 then do; 407 code_ptr = addr (seq4 (3)); 408 409 /*[4.0-1]*/ 410 call set_false_tag; 411 412 end; 413 414 else do; 415 code_ptr = addr (seq4); 416 i_tag = cobol_$next_tag; 417 false_tag = i_tag; 418 cobol_$next_tag = cobol_$next_tag + 1; 419 call cobol_alloc$cobol_data (4, 2, count.char_offset); 420 count.char_offset = count.char_offset * 4; 421 422 call cobol_addr (addr (count), code_ptr, null ()); 423 424 end; 425 426 /*[4.2-1]*/ 427 if out_line 428 then call cobol_addr (addr (target), addr (seq4 (5)), null ()); 429 430 /*[4.0-1]*/ 431 if out_line /*[4.0-1]*/ 432 then call cobol_emit (code_ptr, null (), init_req_flag + 1); 433 /*[4.0-1]*/ 434 else call cobol_define_tag_nc (L1, cobol_$text_wd_off); 435 436 call cobol_reset_r$in_line; 437 438 /* Get space for token structure. */ 439 440 space_req = no_tokens * 2 - 6; 441 call get_token_space; 442 443 /* Process condition-1. */ 444 445 lo_lim = 4; 446 hi_lim = no_tokens - 1; 447 448 call process_condition; 449 450 /* Reset alterable GO at end of PN2. */ 451 452 call reset_f_3_4; 453 454 /*[4.0-1]*/ 455 if ^out_line 456 then call def_L2; 457 458 return; 459 460 def_L2: 461 proc; 462 463 /*[4.0-1]*/ 464 call cobol_emit (addr (seq2 (7)), null (), 1); /*[4.0-1]*/ 465 call cobol_make_tagref (L3, cobol_$text_wd_off - 1, null ()); 466 /*[4.0-1]*/ 467 call cobol_define_tag_nc (L2, cobol_$text_wd_off); 468 469 end; 470 format (4): /* Get token numbers of pointers to varying identifiers and */ 471 /* compute space required for token structure to be passed */ 472 /* to generators. */ 473 varying_ids = in_token.token_ptr (no_tokens) -> end_stmt.e; 474 475 476 index = 1; 477 jndex = 4; 478 id_tok_no (index) = jndex; 479 if index = varying_ids 480 then keep_scanning = "0"b; 481 else do; 482 keep_scanning = "1"b; 483 index = index + 1; 484 jndex = jndex + 3; 485 end; 486 487 do while (keep_scanning); /* Scan to find all varying identifiers. */ 488 if (in_token.token_ptr (jndex) -> end_stmt.type = 1 489 & in_token.token_ptr (jndex) -> reserved_word.key = 72 /* AFTER */) 490 then do; /* Found reserved word AFTER. */ 491 /* Next token is the VARYING identifier. */ 492 id_tok_no (index) = jndex + 1; 493 if index = varying_ids 494 then keep_scanning = "0"b; 495 else do; 496 index = index + 1; 497 jndex = jndex + 3; 498 end; 499 end; /* Found reserved word AFTER. */ 500 else jndex = jndex + 1; 501 end; /* Scan to find all varying identifiers. */ 502 503 id_tok_no (varying_ids + 1) = no_tokens + 1; 504 space_req = 0; 505 506 do index = varying_ids to 1 by -1; 507 if (id_tok_no (index + 1) - id_tok_no (index)) * 2 - 6 > space_req 508 then space_req = (id_tok_no (index + 1) - id_tok_no (index)) * 2 - 6; 509 510 end; 511 512 call get_token_space; 513 514 /* Generate call to cobol_error. */ 515 516 do index = 1 to varying_ids; 517 if in_token.token_ptr (id_tok_no (index) + 2) -> end_stmt.type = 9 518 then do; 519 call cobol_alloc$stack (4, 1, stackoff); 520 substr (ret_inst (1), 4, 15) = substr (unspec (stackoff), 22, 15); 521 tra_inst (3) = ret_inst (1); 522 s_tag = cobol_$next_tag; 523 cobol_$next_tag = cobol_$next_tag + 1; 524 525 call cobol_pointer_register$get (addr (ptr_register_request)); 526 call cobol_emit (addr (tra_inst), null (), 3); 527 call cobol_make_tagref (s_tag, cobol_$text_wd_off - 1, null ()); 528 529 er_loc = cobol_$text_wd_off; 530 531 call cobol_process_error (44, in_token.token_ptr (1) -> end_stmt.line, 0); 532 call cobol_emit (addr (ret_inst), null (), 1); 533 call cobol_define_tag (s_tag); 534 535 goto end_loop; 536 end; 537 538 end; 539 540 end_loop: /* Initialize varying identifiers. */ 541 p_token_ptr -> in_token.n = 4; 542 p_token_ptr -> in_token.code = 0; 543 p_token_ptr -> in_token.token_ptr (1) = in_token.token_ptr (1); 544 p_token_ptr -> in_token.token_ptr (4) = addr (eos_token); 545 eos_token.e = 1; 546 547 do index = 1 to varying_ids; 548 call init_var_id; 549 end; 550 551 /* Get tags to be associated with first instruction of */ 552 /* condition code sequences. */ 553 554 do index = 1 to varying_ids; 555 con_tag (index) = cobol_$next_tag; 556 cobol_$next_tag = cobol_$next_tag + 1; 557 end; 558 559 /* Set alterable GO at end of PN2. */ 560 561 seq4 (3) = "000000000000000011"b; 562 call cobol_register$load (addr (register_request)); 563 if init_req_flag = 1 564 then do; 565 code_ptr = addr (seq4 (3)); 566 567 /*[4.0-1]*/ 568 call set_false_tag; 569 570 end; 571 572 else do; 573 code_ptr = addr (seq4); 574 i_tag = cobol_$next_tag; 575 false_tag = i_tag; 576 cobol_$next_tag = cobol_$next_tag + 1; 577 call cobol_alloc$cobol_data (4, 2, count.char_offset); 578 count.char_offset = count.char_offset * 4; 579 call cobol_addr (addr (count), code_ptr, null ()); 580 end; 581 582 /*[4.2-1]*/ 583 if out_line 584 then call cobol_addr (addr (target), addr (seq4 (5)), null ()); 585 586 /*[4.0-1]*/ 587 if out_line /*[4.0-1]*/ 588 then call cobol_emit (code_ptr, null (), init_req_flag + 2); 589 /*[4.0-1]*/ 590 else call cobol_emit (addr (seq4 (7)), null (), 1); 591 592 call cobol_make_tagref (con_tag (1), cobol_$text_wd_off - 1, null ()); 593 594 /*[4.0-1]*/ 595 if ^out_line 596 then call cobol_define_tag_nc (L1, cobol_$text_wd_off); 597 598 call cobol_reset_r$in_line; 599 600 /* BY identifier zero? */ 601 602 do index = varying_ids to 1 by -1; 603 if in_token.token_ptr (id_tok_no (index) + 2) -> end_stmt.type = 9 604 then do; 605 p_token_ptr -> in_token.n = 2; 606 p_token_ptr -> in_token.code = 0; 607 p_token_ptr -> in_token.token_ptr (1) = in_token.token_ptr (id_tok_no (index) + 2); 608 p_token_ptr -> in_token.token_ptr (2) = addr (eos_token); 609 s_tag = cobol_$next_tag; 610 eos_token.h = s_tag; 611 eos_token.verb = 13; 612 eos_token.e = 180; 613 unspec (eos_token.i) = "010000000000000000000000000000000000"b; 614 cobol_$next_tag = cobol_$next_tag + 1; 615 616 call cobol_compare_gen (p_token_ptr); 617 618 temp = stackoff + 1; 619 substr (seq6 (1), 4, 15) = substr (unspec (temp), 22, 15); 620 temp = er_loc - cobol_$text_wd_off - 1; 621 seq6 (3) = substr (unspec (temp), 19, 18); 622 623 call cobol_emit (addr (seq6), null (), 2); 624 call cobol_define_tag_nc (s_tag, cobol_$text_wd_off); 625 626 end; 627 628 /* Increment varying identifier. */ 629 630 p_token_ptr -> in_token.n = 4; 631 p_token_ptr -> in_token.code = 0; 632 p_token_ptr -> in_token.token_ptr (1) = in_token.token_ptr (1); 633 p_token_ptr -> in_token.token_ptr (4) = addr (eos_token); 634 eos_token.e = 1; 635 eos_token.b = "0"b; 636 if in_token.token_ptr (id_tok_no (index)) -> end_stmt.type = 9 637 then do; 638 p_token_ptr -> in_token.token_ptr (2) = in_token.token_ptr (id_tok_no (index) + 2); 639 p_token_ptr -> in_token.token_ptr (3) = in_token.token_ptr (id_tok_no (index)); 640 eos_token.a = "000"b; 641 eos_token.h = 1; 642 eos_token.verb = 2; 643 644 call cobol_add_gen (p_token_ptr, s_tag); 645 646 end; 647 648 else do; 649 ind_ptr = in_token.token_ptr (id_tok_no (index)); 650 p_token_ptr -> in_token.token_ptr (2) = ind_ptr; 651 index_name.max = index_name.max + 1; 652 p_token_ptr -> in_token.token_ptr (3) = in_token.token_ptr (id_tok_no (index) + 2); 653 eos_token.a = "001"b; 654 eos_token.verb = 31; 655 656 call cobol_set_gen (p_token_ptr); 657 658 end; 659 660 /* Process condition. */ 661 662 call cobol_define_tag (con_tag (index)); 663 lo_lim = id_tok_no (index) + 3; 664 hi_lim = id_tok_no (index + 1) - 2; 665 666 call process_condition; 667 668 /* Set false tag for next pass and initialize varying id. */ 669 670 if index > 1 671 then do; 672 false_tag = con_tag (index); 673 p_token_ptr -> in_token.n = 4; 674 p_token_ptr -> in_token.code = 0; 675 p_token_ptr -> in_token.token_ptr (1) = in_token.token_ptr (1); 676 p_token_ptr -> in_token.token_ptr (4) = addr (eos_token); 677 eos_token.e = 1; 678 679 call init_var_id; 680 681 end; 682 683 end; 684 685 /* Reset alterable GO at end of PN2. */ 686 687 call reset_f_3_4; 688 689 /*[4.0-1]*/ 690 if ^out_line 691 then call def_L2; 692 693 return; 694 695 format (7): /*[4.0-1]*/ 696 call cobol_emit (addr (seq2 (7)), null (), 1); /*[4.0-1]*/ 697 call cobol_make_tagref (end_stmt.e, cobol_$text_wd_off - 1, null ()); 698 /*[4.0-1]*/ 699 call cobol_define_tag_nc (end_stmt.h, cobol_$text_wd_off); 700 701 /*[4.0-1]*/ 702 return; 703 704 format (8): /*[4.2-1]*/ 705 if out_line 706 then call cobol_addr (addr (target), addr (seq8 (3)), null ()); 707 call cobol_emit (addr (seq8), null (), 3); 708 call cobol_make_tagref (pn1_no, cobol_$text_wd_off - 1, null ()); 709 710 return; 711 712 get_token_space: 713 proc; 714 715 if binary (rel (temp_token_ptr), 17) + space_req * 2 > 262143 716 then do; 717 signal_ovfl_error: 718 call signal_ ("command_abort_", null (), addr (seg_ovfl_error)); 719 goto signal_ovfl_error; 720 end; 721 722 if substr (rel (temp_token_ptr), 18, 1) = "1"b 723 then temp_token_ptr = addrel (temp_token_ptr, 1); 724 725 p1_token_ptr = temp_token_ptr; 726 temp_token_ptr = addrel (temp_token_ptr, space_req); 727 p2_token_ptr = temp_token_ptr; 728 temp_token_ptr = addrel (temp_token_ptr, space_req); 729 p_token_ptr = p1_token_ptr; 730 731 return; 732 733 end get_token_space; 734 735 init_var_id: 736 proc; 737 738 if in_token.token_ptr (id_tok_no (index)) -> end_stmt.type = 9 739 & in_token.token_ptr (id_tok_no (index) + 1) -> end_stmt.type ^= 10 740 then do; 741 p_token_ptr -> in_token.token_ptr (2) = in_token.token_ptr (id_tok_no (index) + 1); 742 p_token_ptr -> in_token.token_ptr (3) = in_token.token_ptr (id_tok_no (index)); 743 eos_token.verb = 18; 744 call cobol_move_gen (p_token_ptr); 745 end; 746 747 else do; 748 p_token_ptr -> in_token.token_ptr (2) = in_token.token_ptr (id_tok_no (index)); 749 p_token_ptr -> in_token.token_ptr (3) = in_token.token_ptr (id_tok_no (index) + 1); 750 eos_token.verb = 31; 751 eos_token.a = "000"b; 752 call cobol_set_gen (p_token_ptr); 753 end; 754 755 return; 756 757 end init_var_id; 758 759 reset_f_3_4: 760 proc; 761 762 call cobol_register$load (addr (register_request)); 763 if init_req_flag = 1 764 then no_inst = 2; 765 766 else do; 767 no_inst = 8; 768 call cobol_addr (addr (count), addr (seq5 (7)), null ()); 769 seq5 (11) = seq5 (7); 770 end; 771 772 /*[4.2-1]*/ 773 if out_line /*[4.2-1]*/ 774 then do; 775 call cobol_addr (addr (target), addr (seq5 (3)), null ()); 776 /*[4.2-1]*/ 777 call cobol_emit (addr (seq5), null (), no_inst); 778 779 780 781 782 /*[4.2-1]*/ 783 call cobol_make_tagref (next_stmt_tag, cobol_$text_wd_off - no_inst, null ()); 784 /*[4.2-1]*/ 785 end; 786 787 if init_req_flag = 2 788 then do; 789 call cobol_make_tagref (pn1_no, cobol_$text_wd_off - 4, null ()); 790 call cobol_make_tagref (pn1_no, cobol_$text_wd_off - 2, null ()); 791 call cobol_make_tagref (init_tag, cobol_$text_wd_off - 1, null ()); 792 call cobol_define_tag_nc (i_tag, cobol_$text_wd_off - 5); 793 end; 794 795 call cobol_pointer_register$priority (4, 4, "000"b); 796 797 return; 798 799 end reset_f_3_4; 800 801 process_condition: 802 proc; 803 804 p_token_ptr -> in_token.n = 0; 805 p_token_ptr -> in_token.code = 0; 806 807 do jndex = lo_lim to hi_lim; 808 wk_ptr = in_token.token_ptr (jndex); 809 type = wk_ptr -> end_stmt.type; 810 if type = 30 811 then if wk_ptr -> int_tag.perform_bit = "1"b & wk_ptr -> int_tag.true_path = "0"b 812 then do; 813 equate_tag.equated_tag = wk_ptr -> int_tag.proc_num; 814 equate_tag.true_tag = false_tag; 815 call cobol_equate_tag (addr (equate_tag)); 816 end; 817 818 else call cobol_define_tag_nc (binary (wk_ptr -> int_tag.proc_num, 17), cobol_$text_wd_off); 819 820 else do; 821 p_token_ptr -> in_token.n = p_token_ptr -> in_token.n + 1; 822 p_token_ptr -> in_token.token_ptr (p_token_ptr -> in_token.n) = wk_ptr; 823 if type = 19 824 then do; 825 if wk_ptr -> end_stmt.verb = 13 826 then call cobol_compare_gen (p_token_ptr); 827 828 else call cobol_arithop_gen (p_token_ptr); 829 830 if p_token_ptr -> in_token.code > 0 831 then p_token_ptr -> in_token.n = p_token_ptr -> in_token.code; 832 833 else do; 834 if p_token_ptr -> in_token.code = -1 835 then if p_token_ptr -> in_token.code = -1 836 then if p_token_ptr = p1_token_ptr 837 then p_token_ptr = p2_token_ptr; 838 839 else p_token_ptr = p1_token_ptr; 840 841 p_token_ptr -> in_token.n = 0; 842 end; 843 844 p_token_ptr -> in_token.code = 0; 845 end; 846 847 end; 848 849 end; 850 851 return; 852 853 end process_condition; 854 1 1 1 2 /* 1 3*The procedure cobol_perform_gen generates the code necessary to im- 1 4*plement the COBOL PERFORM statement. The general format of the 1 5*PERFORM statement is as follows: 1 6* 1 7*Format 1 - 1 8* 1 9* P_E_R_F_O_R_M_ procedure-name-1 [{T_H_R_U_|T_H_R_O_U_G_H_} procedure-name-2] 1 10* 1 11*Format 2 - 1 12* 1 13* P_E_R_F_O_R_M_ procedure-name-1 [{T_H_R_U_|T_H_R_O_U_G_H_} procedure-name-2] 1 14* 1 15* {identifier-10|integer-1} T_I_M_E_S_ 1 16* 1 17*Format 3 - 1 18* 1 19* P_E_R_F_O_R_M_ procedure-name-1 [{T_H_R_U_|T_H_R_O_U_G_H_} procedure-name-2] 1 20* 1 21* U_N_T_I_L_ condition-1 1 22* 1 23*Format 4 - 1 24* 1 25* P_E_R_F_O_R_M_ procedure-name-1 [{T_H_R_U_|T_H_R_O_U_G_H_} procedure-name-2] 1 26* 1 27* V_A_R_Y_I_N_G_ {identifier-1|index-name-1} 1 28* 1 29* F_R_O_M_ {identifier-2|index-name-2|literal-1} 1 30* 1 31* B_Y_ {identifier-3|literal-2} U_N_T_I_L_ condition-1 1 32* 1 33* [A_F_T_E__R_ {identifier-4|index-name-3} 1 34* 1 35* F_R_O_M_ {identifier-5|index-name-4|literal-3} 1 36* 1 37* B_Y_ {identifier-6|literal-4} U_N_T_I_L_ condition-2 1 38* 1 39* [A_F_T_E_R_ {identifier-7|index-name-5} 1 40* 1 41* F_R_O_M_ {identifier-8|index-name-6|literal-5} 1 42* 1 43* B_Y_ {identifier-9|literal-6} U_N_T_I_L_ condition-3]] 1 44* 1 45* 1 46*In all formats, the beginning of the PERFORM range is defined as 1 47*the first statement of the procedure named procedure-name-1 or, 1 48*in terms of executable code, the first instruction generated to 1 49*implement the first statement of procedure-name-1. Similarly, in 1 50*all formats, the end of the PERFORM range is defined as the last 1 51*statement of the procedure named procedure-name-2, if the THROUGH 1 52*phrase is present, or the last statement of the procedure named 1 53*procedure-name-1, if it is not. In terms of executable code, 1 54*this corresponds to the last instruction generated to implement 1 55*the last statement of the appropriate procedure. If procedure- 1 56*name-1 (or -2) is a paragraph-name, then the last statement in 1 57*the PERFORM range is the last statement of the paragraph. If 1 58*procedure-name-1 (or -2) is a section-name, then the last state- 1 59*ment in the PERFORM range is the last statement of the last para- 1 60*graph of the section. 1 61*If, as a consequence of executing a PERFORM statement, a transfer 1 62*of control is indicated, the transfer is made to the first in- 1 63*struction in the PERFORM range. This transfer of control occurs 1 64*only once for each execution of a PERFORM statement. A subse- 1 65*quent transfer of control following the execution of the last in- 1 66*struction in the PERFORM range to the next executable statement 1 67*following the PERFORM statement is implied and must be explicitly 1 68*implemented. If, however, control passes to a procedure which 1 69*has been named as containing the last statement in a PERFORM 1 70*range by means other than a PERFORM statement, then control must 1 71*pass through the last statement of the procedure to the next ex- 1 72*ecutable statement as if no PERFORM statement mentioned the pro- 1 73*cedure. In this connection, it should be noted that there is no 1 74*next executable statement following: 1 75* 1 76* 1. The last statement in a Declarative Section when the para- 1 77* graph in which it appears is not being executed under the 1 78* control of some other COBOL statement. 1 79* 1 80* 2. The last statement in a program when the paragraph in which 1 81* it appears is not being executed under the control of some 1 82* other COBOL statement. 1 83* 1 84* 3. The last statement in a size procedure when the procedure 1 85* is not being executed under the control of some other COBOL 1 86* statement. (Size procedures and control statements which 1 87* execute then are compiler sefined.) 1 88* 1 89*This modifiable program flow is implemented by inserting an al- 1 90*terable GO after the last instruction of each PERFORM range de- 1 91*fined in the program. These end-of-perform range alterable GO's 1 92*are initialized, upon first entry into the program as part of the 1 93*current run-unit, to pass control to the next executable state- 1 94*ment except for those cases defined above for which there is no 1 95*next executable statement. For these exceptional cases, the al- 1 96*terable GO's are initialized to transfer control to a sequence of 1 97*instructions which calls a procedure (signal_) to signal an ap- 1 98*propriate error to the user. The setting of the end-of-perform 1 99*range alterable GO's is otherwise controlled by code generated to 1 100*implement the PERFORM statements. In programs conforming to the 1 101*rules of COBOL, the end-of-perform range alterable GO's are al- 1 102*ways reset at the completion of the PERFORM statement to pass 1 103*control to the next executable statement or to an error signal- 1 104*ling routine, as appropriate, regardless of any modifications 1 105*that may have been made to implement the PERFORM statement. If 1 106*the rules regarding PERFORM statements are not followed, the al- 1 107*terable GO's at the end of involved PERFORM ranges may not be 1 108*properly reset and unspecified alteration of control flow will 1 109*occur. 1 110*The instructions necessary for implementing end-of-perform range 1 111*alterable GO's are generated in-line immediately after the gener- 1 112*ation of the last instruction of each procedure which is at the 1 113*end of a PERFORM range (see cobol_paragraph_gen, cobol_section_gen, and 1 114*cobol_end_gen). The instructions necessary for initializing the 1 115*end-of-perform range alterable GO's are generated (by cobol_seginit_ 1 116*gen) after the processing of Minpral5 and the initial value min- 1 117*pral file. 1 118* 1 119*This procedure also generates the code necessary to "perform" 1 120*size routines used in "addressing" identifiers defined with the 1 121*occurs depending clause. The call is made as it would be for a 1 122*Format 1 PERFORM statement except that the format number in the 1 123*end_stmt token is set to seven. 1 124* 1 125*U__s_a_g_e:_ 1 126* 1 127* declare cobol_perform_gen entry (ptr); 1 128* 1 129* call cobol_perform_gen (in_token_ptr); 1 130* 1 131* */ 1 132 1 133 1 134 /* 1 135*G__e_n_e_r_a_t_e_d_C__o_d_e:_ 1 136* 1 137*The code generated to implement the PERFORM statement is a func- 1 138*tion of format and segment initialization requirements. Segment 1 139*initializtion is required when procedure-name-1 is in a segment 1 140*different from that containing the PERFORM statement and this 1 141*segment is an independent segment containing explicit alterable 1 142*GO's (GO statements referenced by ALTER statements). 1 143* 1 144*Format 1 - 1 145* 1 146* No Intializaation Required 1 147* 1 148* eaxn loc_a_relp,ic Set alterable GO at end of PNn to 1 149* sxln target_a_PNn return control to inst at loc_a 1 150* 1 151* tra PN1_relp,ic Transfer to PN1 1 152* 1 153*loc_a eaxn t_relp,ic Reset alterable GO at end 1 154* sxln target_a_PNn of PNn 1 155* 1 156* Initialization Required 1 157* 1 158* eaxn loc_a_relp Set alterable GO at end of PNn to 1 159* sxln target_a_PNn return control inst at loc_a 1 160* 1 161* eaa PN1_relp,ic Load addr PN1 in a-reg bits 0-17 1 162* tra i_segm_relp,ic Transfer to init code for seg 1 163* containing PN1 1 164* 1 165*loc_a eaxn t_relp,ic Reset alterable GO at end 1 166* sxln target_a_PNn of PNn 1 167* 1 168*Format 2 - 1 169* 1 170* No Initialization Required 1 171* 1 172* Convert identifier-10 to fixed binary. 1 173* This code is generated by the move generator if the 1 174* identifier is long or short binary. The code generated 1 175* by the MOVE generator is not shown here. 1 176* 1 177* If the identifier is packed or unpacked decimal, then the 1 178* following code sequence is generated: 1 179* 1 180* dtb (ar),(ar) 1 181* ndsc9 id_10,l 1 182* ndsc9 id_10_fb,4 1 183* 1 184* If the identifier is overpunch sign data, then it is first 1 185* converted to an unpacked decimal trailing sign temporary. 1 186* This temporary is then converted to a binary by generating 1 187* the same instructions shown above for packed or unpacked 1 188* decimal. 1 189* 1 190* 1 191* tmoz loc_b_relp,ic Tra to inst at loc_b if 0 or neg 1 192* 1 193* [The preceding instructions are not generated if integer-1 1 194* is used instead of identifier-10 ] 1 195* 1 196* stz count Store 0 in temp used to count times 1 197* performed 1 198* 1 199* eaxn loc_a_relp Set alterable GO at end of PNn to 1 200* sxln target_a_PNn return control inst at loc_a 1 201* 1 202* tra PN1_relp1,ic Transfer to PN1 1 203* 1 204*loc_a ldq count Add one to count of times performed 1 205* adq 1,dl and compare to number of times 1 206* stq count specified in PERFORM 1 207* cmpq id_10_fb statement 1 208* 1 209* [If integer-1 is used instead of identifier-10, then 1 210* cmpq id_10_fb becomes cmpq integer-1,dl ] 1 211* 1 212* tnz PN1_relp2,ic Tra to PN1 if not performed times 1 213* required 1 214* 1 215* eaxn t_relp,ic Reset alterable GO at end 1 216* sxln target_a_PNn of PNn 1 217*loc_b 1 218* 1 219* Initialization Required 1 220* 1 221* 1 222* Convert identifier-10 to fixed binary. 1 223* This code is generated by the move generator if the 1 224* identifier is long or short binary. The code generated 1 225* by the MOVE generator is not shown here. 1 226* 1 227* If the identifier is packed or unpacked decimal, then the 1 228* following code sequence is generated: 1 229* 1 230* dtb (ar),(ar) 1 231* ndsc9 id_10,l 1 232* ndsc9 id_10_fb,4 1 233* 1 234* If the identifier is overpunch sign data, then it is first 1 235* converted to an unpacked decimal trailing sign temporary. 1 236* This temporary is then converted to a binary by generating 1 237* the same instructions shown above for packed or unpacked 1 238* decimal. 1 239* tmoz loc_b_relp,ic Tra to inst at loc_b if 0 or neg 1 240* 1 241* [The preceding instructions are not generated if integer-1 1 242* is used instead of identifier-10 ] 1 243* 1 244* stz count Store 0 in temp used to count times 1 245* performed 1 246* 1 247* eaxn loc_a_relp Set alterable GO at end of PNn to 1 248* sxln target_a_PNn return control inst at loc_a 1 249* 1 250* eaa PN1_relp1,ic Load addr of PN1 in a-reg bits 0-17 1 251* 1 252* tra i_segm_relp,ic Transfer to init code for seg 1 253* containing PN1 1 254* 1 255*loc_a ldq count Add one to count of times performed 1 256* adq 1,dl and compare to number of times 1 257* stq count specified in PERFORM 1 258* cmpq id_10_fb statement 1 259* 1 260* [If integer-1 is used instead of identifier-10, then 1 261* cmpq id_10_fb becomes cmpq integer-1,dl ] 1 262* 1 263* tnz PN1_relp2,ic Tra to PN1 if not performed times 1 264* required 1 265* 1 266* eaxn t_relp,ic Reset alterable GO at end 1 267* sxln target_a_PNn of PNn 1 268*loc_b 1 269* 1 270*Format 3 - 1 271* 1 272* No Initialization Required 1 273* 1 274* eaxn loc_a_relp,ic Set alterable GO at end of PNn to 1 275* sxln target_a_PNn return control to inst at loc_a 1 276* 1 277*loc_a[Instructions generated by cobol_arithop_gen and/or cobol_compare] 1 278* [_gen to implement condition-1. Tags created by PD Syntax ] 1 279* [for "condition true" are equated to loc_b and for "condi- ] 1 280* [tion false" are equated to PN1. ] 1 281* 1 282*loc_b eaxn t_relp,ic Reset alterable GO at end 1 283* sxln target_a_PNn of PNn 1 284* 1 285* Initialization Required 1 286* 1 287* stz count Store 0 in count to indicate init 1 288* required 1 289* eaxn loc_a_relp,ic Set alterable GO at end of PNn to 1 290* sxln target_a_PNn return control to inst at loc_a 1 291* 1 292*loc_a[Instructions generated by cobol_arithop_gen and/or cobol_compare] 1 293* [_gen to implement condition-1. Tags created by PD Syntax ] 1 294* [for "condition true" are equated to loc_b and for "condi- ] 1 295* [tion false" are equated to loc_i. ] 1 296* 1 297*loc_b eaxn t_relp,ic Reset alterable GO at end 1 298* sxln target_a_PNn of PNn 1 299* tra loc_d_relp,ic Transfer to loc_d 1 300*loc_i ldq count Examine count and transfer 1 301* tnz PN1_relp1,ic to PN1 if it is not 0 1 302* aos count Otherwise add 1 to count 1 303* eaa PN1_relp2,ic Load addr of PN1 in a-reg bits 0-17 1 304* 1 305* tra i_segm_relp,ic Transfer to init code for segment 1 306* containing PN1 1 307*loc_d 1 308* 1 309*Format 4 - 1 310* 1 311*The sequence of instructions given below is for the most complex 1 312*form of Format 4. Code generated for the less complex forms can 1 313*be deduced from it, however. 1 314* 1 315* epbp2 0,ic Store ptr to base of Text 1 316* spri2 pr6|M Segment in pr6|M 1 317* tra loc_s_relp,ic Transfer to inst at loc_s 1 318* 1 319*loc_e[Call to cobol_error_ generated by cobol_process_error to ] 1 320* [report "BY" identifier equal to zero. ] 1 321* 1 322* rtcd pr6|M Transfer to addr stored in pr6|M 1 323* 1 324*loc_s[Instructions generated by cobol_move_gen or cobol_set_gen to ] 1 325* [initialize identifier-1 or index-name-1 to identifier-2, ] 1 326* [index-name-2, or literal-1; identifier-4 or index-name-3 ] 1 327* [to identifier-5, index-name-4, or literal-3; and identi- ] 1 328* [fier-7 or index-name-5 to identifier-8, index-name-6, or ] 1 329* [literal-5. ] 1 330* 1 331* {stz count Store 0 in count to indicate init 1 332* required. } 1 333* eaxn loc_a_relp,ic Set alterable GO at end of PNn to 1 334* sxln target_a_PNn return control to inst at loc_a 1 335* tra con_1_relp,ic and transfer to inst at con_1 1 336* 1 337*loc_a[Instructions generated by cobol_compare_gen to implement ] 1 338* [equivalent COBOL statement "if identifier-9 is not zero ] 1 339* [go to inc_3.". Omitted if literal-6 is specified. ] 1 340* 1 341* stc2 pr6|M Store addr inc_3 in pr6|M and 1 342* tra loc_e_relp,ic transfer to loc_e. These inst are 1 343* omitted if literal-6 is specified. 1 344* 1 345*inc_3[Instructions generated by cobol_add_gen or cobol_set_gen to in- ] 1 346* [crement identifier-7 or index-name-5 by identifier-9 or ] 1 347* [literal-6. ] 1 348* 1 349*con_3[Instructions generated by cobol_arithop_gen and/or cobol_compare] 1 350* [_gen to implement condition-3. Tags created by PD Syntax ] 1 351* [for "condition true" are equated to tru_3 and for "condi- ] 1 352* [tion false" are equated to loc_i if initialization is re- ] 1 353* [quired and to PN1 if initialization is not required. ] 1 354* 1 355*tru_3[Instructions generated by cobol_move_gen or cobol_set_gen to ] 1 356* [initialize identifier-7 or index-name-5 to identifier-8, ] 1 357* [index-name-6, or literal-5. ] 1 358* 1 359* [Instructions generated by cobol_compare_gen to implement ] 1 360* [equivalent COBOL statement "if identifier-6 is not zero ] 1 361* [go to inc_2.". Omitted if literal-4 is specified. ] 1 362* 1 363* stc2 pr6|M Store addr inc_2 in pr6|M and 1 364* tra loc_e_relp,ic transfer to loc_e. These inst are 1 365* omitted if literal-4 is specified. 1 366* 1 367*inc_2[Instructions generated by cobol_add_gen or cobol_set_gen to in- ] 1 368* [crement identifier-4 or index-name-3 by identifier-6 or ] 1 369* [literal-4. ] 1 370* 1 371*con_2[Instructions generated by cobol_arithop_gen and/or cobol_compare] 1 372* [_gen to implement condition-2. Tags created by PD Syntax ] 1 373* [for "condition true" are equated to tru_2 and for "condi- ] 1 374* [tion false" are equated to con_3. ] 1 375* 1 376*tru_2[Instructions generated by cobol_move_gen or cobol_set_gen to ] 1 377* [initialize identifier-4 or index-name-3 to identifier-5, ] 1 378* [index-name-4, or literal-3. ] 1 379* 1 380* [Instructions generated by cobol_compare_gen to implement ] 1 381* [equivalent COBOL statement "if identifier-3 is not zero ] 1 382* [go to inc_1.". Omitted if literal-2 is specified. ] 1 383* 1 384* stc1 pr6|M Store addr inc_1 in pr6|M and 1 385* tra loc_e_relp,ic transfer to loc_e. These inst are 1 386* omitted if literal-2 is specified. 1 387* 1 388*inc_1[Instructions generated by cobol_add_gen or cobol_set_gen to in- ] 1 389* [crement identifier-1 or index-name-1 by identifier-3 or ] 1 390* [literal-2. ] 1 391* 1 392*con_1[Instructions generated by cobol_arithop_gen and/or cobol_compare] 1 393* [_gen to implement condition-1. Tags created by PD Syntax ] 1 394* [for "condition true" are equated to tru_1 and for "condi- ] 1 395* [tion false" are equated to con_2. ] 1 396* 1 397*tru_1 eaxn t_relp,ic Reset alterable GO at end 1 398* sxln target_a_PNn of PNn 1 399* {tra loc_n_relp,ic Transfer to loc_n 1 400*loc_i ldq count Examine count and transfer 1 401* tnz PN1_relp1,ic to PN1 if it is not 0 1 402* aos count Otherwise add 1 to count 1 403* eaa PN1_relp2,ic Load addr of PN1 in a-reg bits 0-17 1 404* 1 405* tra i_segm_relp,ic Transfer to init code for segment 1 406* containing PN1 } 1 407*loc_n 1 408* 1 409*Instructions in {} are included only if segment initialization is 1 410*required. 1 411* 1 412*In initializing the "varying" or "after" identifiers to their 1 413*current "from" values, cobol_move_gen is employed only if the ident- 1 414*ifier is a numeric data item and the "from" operand is not an 1 415*index-name. In all other cases, cobol_set_gen is employed. To in- 1 416*crement the "varying" or "after" identifiers, cobol_add_gen is em- 1 417*ployed if the identifier is a numeric data item and cobol_set_gen 1 418*is employed if it is an index-name. 1 419* 1 420* 1 421*where: 1 422*PNn is procedure-name-n for n = 1 or 2. 1 423* 1 424*target-a-PNn is a 36-bit variable allocated in the program's 1 425* COBOL data segment. It is uniquely associated with 1 426* procedure-name-n (n = 1 or 2). 1 427* 1 428*PN1_relp is the offset, relative to the instruction in which 1 429*PN1_relp1 the symbol is used, of the first instruction gener- 1 430*PN1_relp2 ated to implement procedure-name-1. 1 431* 1 432*t_relp is the offset, relative to the instruction in which 1 433* it appears, of an instruction defined by a tag uni- 1 434* quely associated with target_a_PNn. (Usually, this 1 435* is the instruction immediately following the end-of- 1 436* perform range alterable GO at the end of procedure- 1 437* name-1.) 1 438* 1 439*id_10 is identifier-10. 1 440* 1 441*id_10_fb designates a location in the COBOL data segment 1 442* where id_10 is stored as a fixed bin quantity. 1 443* 1 444*count designates a location in the COBOL data segment 1 445* where a count is kept of the number of times that 1 446* the procedures in the PERFORM range have been per- 1 447* formed for Format 2 statements. For Formats 3 and 1 448* 4 when segment initialization is required, count = 0 1 449* indicates that the initial transfer of control has 1 450* not yet been made and count = 1, that it has. 1 451* 1 452*loc_x_relp is the offset, relative to the instruction in which 1 453* it appears, of the instruction whose address is 1 454* loc_x for x = a, b, c, ..... 1 455* 1 456*con_n_relp is the offset, relative to the instruction in which 1 457* it appears, of the instruction whose address is 1 458* con_n for n = 1, 2, or 3. 1 459* 1 460*i_segm_relp is the offset, relative to the instruction in which 1 461* it appears, of the first instruction of the code 1 462* generated to initialize segm (the segment contain- 1 463* ing procedure PN1). 1 464* 1 465*M is the word offset of a word in the stack in which 1 466* the return address is stored prior to calling 1 467* cobol_error_ in Format 4 statements. 1 468* 1 469* 1 470*D__i_s_c_u_s_s_i_o_n:_ 1 471* 1 472*The number and nature of the tokens pointed to by the array 1 473*in_token.token_ptr depends upon the format of the PERFORM state- 1 474*ment which they describe. The following list indicates what may 1 475*be expected for each format: 1 476* 1 477*Format 1 - tokens for 1 478* PERFORM PN1 PN2 EOS 1 479* 1 480*Format 2 - tokens for 1 481* PERFORM PN1 PN2 ID EOS 1 482* 1 483*Format 3 - tokens for 1 484* PERFORM PN1 PN2 condition EOS 1 485* 1 486*Format 4 - tokens for 1 487* PERFORM PN1 PN2 ID1 ID2 ID3 condition [AFTER ID4 ID5 ID6 1 488* condition AFTER ID7 ID8 ID9 condition] EOS 1 489* 1 490*Where the tokens for --- 1 491* PERFORM and AFTER are type-1 Reserved Word. 1 492* PN1 and PN2 are type-18 Procedure Reference. PN2 equals PN1 if 1 493* no THROUGH phrase is present in the original statement. 1 494* condition comprises a sequence of tokens representing the condi- 1 495* tional expression or expressions that are present in Formats 3 1 496* and 4. These tokens may be of the following types: 1 497* 9 Data Definition 1 498* 1 Reserved word (for FIGURATIVE CONSTANT ZERO) 1 499* 2 Numeric Literal 1 500* 3 Alphanumeric Literal 1 501* 10 Index-Name 1 502* 31 Tag Equivalence 1 503* 30 Internal Tag Definition 1 504* 19 EOS with 13 (branch) or 28 (arithmetic operator) in the 1 505* verb field 1 506* ID is a type-9 Data Definition or a type-2 Numeric Literal. 1 507* ID1, ID4, and ID7 may individually be either a type-9 Data Defini- 1 508* tion or a type-10 Index-Name. 1 509* ID2, ID5, and ID8 may individually be a type-9 Data Defintion, a 1 510* type-10 Index-Name, or a type-2 Numeric Literal, 1 511* or a type-1 token for the reserved word ZERO. 1 512* ID3, ID6, and ID9 may individually be either a type-9 Data Defini- 1 513* tion or a type-2 Numeric Literal. 1 514* EOS represents a type-19 token. 1 515*D__a_t_a:_ 1 516* 1 517* 1 518* Items in cobol_$incl.pl1 used (u) and/or set (s) by 1 519* cobol_perform_gen: 1 520* 1 521* cobol_ptr (u) 1 522* next_tag (u/s) 1 523* perform_list_ptr (u) 1 524* priority_no (u) 1 525* seg_init_list_ptr (u) 1 526* temp_token_ptr (u/s) 1 527* text_wd_off (u) 1 528* 1 529* */ 1 530 855 2 1 2 2 /* Input structure for cobol_register$load */ 2 3 2 4 declare 1 register_request aligned static, 2 5 2 requested_reg fixed bin aligned init(12), 2 6 2 assigned_reg bit(4) aligned, 2 7 2 lock fixed bin aligned init(1), 2 8 2 reg_set_now fixed bin aligned, 2 9 2 use_code fixed bin aligned init(0), 2 10 2 adjust_ptr_addr fixed bin aligned init(0), 2 11 2 content_ptr ptr aligned init(null), 2 12 2 literal_content bit(36) aligned init((36)"0"b); 2 13 2 14 /* 2 15*requested_reg is a code designating the register requested; 2 16* 0 - a- or q- or any index-register 2 17* 1 - a-register 2 18* 2 - q-register 2 19* 3 - a- and q-register 2 20* 4 - a- or q-register 2 21* 5 - any index-register 2 22* 1n - index-register n 2 23* 2 24*assigned_reg is a code designating the register assigned. It 2 25* has no significance if a specific register is 2 26* requested. 2 27* 2 28*lock indicates locking requirements; 1 requests that 2 29* the register be locked. 2 30* 2 31*reg_set_now not applicable for use_code = 0. 2 32* 2 33*use_code specifies how the register is to be used by the 2 34* requester; 0 signifies that such information is 2 35* not meaningful for register optimization. 2 36* 2 37*adjust_ptr_addr inserted to make evident that since all pointers 2 38* must be allocated on even word boundaries, the 2 39* pl1 compiler will allocate structures containing 2 40* pointers and all pointers therein on even word 2 41* boundaries leaving "gaps" where necessary. 2 42* 2 43*content_ptr not applicable for use_code = 0. 2 44* 2 45*literal_content not applicable for use_code = 0. 2 46* */ 2 47 2 48 /* Input structures for cobol_addr */ 2 49 2 50 declare 1 target aligned static, 2 51 2 type fixed bin aligned init(1), 2 52 2 operand_no fixed bin aligned init(0), 2 53 2 lock fixed bin aligned init(0), 2 54 2 segno fixed bin aligned, 2 55 2 char_offset fixed bin(24) aligned, 2 56 2 send_receive fixed bin aligned init(0); 2 57 2 58 declare 1 count aligned static, 2 59 2 type fixed bin aligned init(1), 2 60 2 operand_no fixed bin aligned init(0), 2 61 2 lock fixed bin aligned init(1), 2 62 2 segno fixed bin aligned init(2), 2 63 2 char_offset fixed bin(24) aligned, 2 64 2 send_receive fixed bin aligned init(0); 2 65 2 66 /* 2 67*type indicates type of addressing requested. Type 1 2 68* indicates basic; i.e., data to be addressed is 2 69* specified by segno and char_offset. 2 70* 2 71*operand_no not applicable to type 1. 2 72* 2 73*lock indicates lock requirements for registers used in 2 74* addressing; 2 75* 0 - do not lock registers used. 2 76* 1 - lock registers used. 2 77* 2 78*segno is the compiler designation of the segment in which 2 79* the data to be addressed is located. 2 80* 2 81*char_offset is the character offset within segno of the data to 2 82* be addressed. 2 83* 2 84*send_receive indicates whether the data being addressed is a 2 85* sending or receiving field for the instruction whose 2 86* address field is being set; 0 indicates sending. 2 87* */ 2 88 2 89 declare 1 input_struc aligned static, 2 90 2 type fixed bin aligned init(4), 2 91 2 operand_no fixed bin aligned init(1), 2 92 2 lock fixed bin aligned init(0), 2 93 2 operand, 2 94 3 token_ptr ptr aligned init(null), 2 95 3 send_receive fixed bin aligned init(0), 2 96 3 ic_mod fixed bin aligned, 2 97 3 size_sw fixed bin aligned init(0); 2 98 2 99 /* 2 100*type indicates type of addressing requested. 2 101* 1 - no operand, 1 wd, basic 2 102* 2 - 1 operand, 1 wd, non-EIS 2 103* 3 - 1 operand, 1 wd, EIS 2 104* 4 - 1 operand, 1 desc, 2wd, EIS 2 105* 5 - 2 operands, 2 desc, 3 wd, EIS 2 106* 6 - 3 operands, 3 desc, 4 wd, EIS 2 107* 2 108*operand_no number of operands associated with requested type. 2 109* 2 110*lock indicates lock requirements for registers used in 2 111* addressing. 2 112* 0 - do not lock registers used 2 113* 1 - lock registers used 2 114* 2 - unlock all registers 2 115* 2 116*token_ptr is a pointer to the operand token. 2 117* 2 118*send_receive indicates whether the operand being addressed is a 2 119* sending or receiving field for the instruction. 2 120* 0 - sending operand 2 121* 1 - receiving operand 2 122* 2 123*ic_mod indicates whether ic modification is specified in 2 124* the mf field of this operand (set by cobol_addr). 2 125* 0 - no ic modification 2 126* 1 - ic modification 2 127* 2 128*size_sw indicates size (length) handlhlng requirements to 2 129* cobol_addr. 2 130* 0 - cobol_addr may store the operand size in a 2 131* register or in the instruction 2 132* 1 - cobol_addr need not be concerned with size 2 133* */ 2 134 2 135 /* Input structure for cobol_pointer_register$get */ 2 136 2 137 declare 1 ptr_register_request aligned static, 2 138 2 what_pointer fixed bin aligned init(2), 2 139 2 assigned_ptr fixed bin aligned, 2 140 2 lock fixed bin aligned init(1), 2 141 2 switch fixed bin aligned init(0), 2 142 2 segno fixed bin aligned init(0), 2 143 2 offset fixed bin aligned init(0), 2 144 2 reset fixed bin aligned; 2 145 2 146 /* 2 147*where: 2 148* 2 149*what_pointer is the number of the desired pointer register. 2 150* (Input) 2 151* 2 152*assigned_ptr is the number of the register assigned. (Output) 2 153* 2 154*lock specifies locking requirements. (0 - do not lock 2 155* requested register). (Input) 2 156* 2 157*switch specifies the significance of segno and offset. 2 158* (0 - segno and word offset are not supplied). 2 159* (Input) 2 160* 2 161*segno is the segment number that the pointer register is 2 162* to contain. (Input) 2 163* 2 164*offset is the word or character offset that the pointer 2 165* reginter is to contain. (Input) 2 166* 2 167* */ 2 168 2 169 /* Static Data */ 2 170 2 171 declare 1 equate_tag aligned static, 2 172 2 size fixed bin aligned init(0), 2 173 2 line fixed bin aligned init(0), 2 174 2 column fixed bin aligned init(0), 2 175 2 type fixed bin aligned init(31), 2 176 2 filler1 fixed bin aligned init(0), 2 177 2 equated_tag fixed bin aligned init(0), 2 178 2 true_tag fixed bin aligned init(0), 2 179 2 filler2 fixed bin aligned init(0), 2 180 2 filler3 fixed bin aligned init(0), 2 181 2 filler4 bit(16) aligned init((16)"0"b); 2 182 2 183 declare 1 eos_token aligned static, 2 184 2 size fixed bin init(0), 2 185 2 line fixed bin init(0), 2 186 2 column fixed bin init(0), 2 187 2 type fixed bin init(19), 2 188 2 verb fixed bin init(0), 2 189 2 e fixed bin init(0), 2 190 2 h fixed bin init(0), 2 191 2 i fixed bin init(0), 2 192 2 j fixed bin init(0), 2 193 2 a bit(3) init("000"b), 2 194 2 b bit(1) init("0"b), 2 195 2 c bit(1) init("0"b), 2 196 2 d bit(2) init("00"b), 2 197 2 f bit(2) init("00"b), 2 198 2 g bit(2) init("00"b), 2 199 2 k bit(5) init("00000"b); 2 200 2 201 declare 1 seg_ovfl_error aligned static, 2 202 2 my_name char(32) init("cobol_perform_gen"), 2 203 2 message_len fixed bin init(32), 2 204 2 message char(32) init 2 205 ("Temp_token_area length exceeded!"); 2 206 2 207 /* Declarations for instruction sequences */ 2 208 dcl seq1(8) bit(18) unaligned static init 2 209 ("000000000001000000"b, "011000101101000000"b, /* dtb (ar),(ar) */ 2 210 "000000000000000000"b, "000000000000000000"b, /* ndsc9 id_10,l */ 2 211 "000000000000000000"b, "000000000000000100"b, /* ndsc9 id10_fb,4 */ 2 212 "000000000000000000"b, "110000100100000100"b); /* tmoz loc_b_relp,ic */ 2 213 2 214 dcl seq2(8) bit(18) unaligned static init 2 215 ("000000000000000000"b, "100101000001000000"b, /* stz count */ 2 216 "000000000000000011"b, "110010010000000100"b, /* eax2 3,ic */ 2 217 "000000000000000000"b, "100100010001000000"b, /* sxl2 target_a_PN2 */ 2 218 "000000000000000000"b, "111001000000000100"b); /* tra PN1_relp1,ic */ 2 219 2 220 dcl seq2i(10) bit(18) unaligned static init 2 221 ("000000000000000000"b, "100101000001000000"b, /* stz count */ 2 222 "000000000000000100"b, "110010010000000100"b, /* eax2 4,ic */ 2 223 "000000000000000000"b, "100100010001000000"b, /* sxl2 target_a_PN2 */ 2 224 "000000000000000000"b, "110011101000000100"b, /* eaa PN1_relp1,ic */ 2 225 "000000000000000000"b, "111001000000000100"b); /* tra i_segm_relp,ic */ 2 226 2 227 dcl seq3(14) bit(18) unaligned static init 2 228 ("000000000000000000"b, "010011110001000000"b, /* ldq count */ 2 229 "000000000000000001"b, "000111110000000111"b, /* adq 1,dl */ 2 230 "000000000000000000"b, "111101110001000000"b, /* stq count */ 2 231 "000000000000000000"b, "000000000000000000"b, /* cmpq id_10_fb or */ 2 232 /* int_1,dl */ 2 233 "000000000000000000"b, "110000001000000100"b, /* tnz PN1_relp2,ic */ 2 234 "000000000000000000"b, "110010010000000100"b, /* eax2 t_relp,ic */ 2 235 "000000000000000000"b, "100100010001000000"b); /* sxl2 target_a_PN2 */ 2 236 2 237 dcl cmpq_id_10 bit(18) static init ("001001110001000000"b); 2 238 2 239 dcl cmpq_int_1 bit(18) static init ("001001110000000111"b); 2 240 2 241 dcl seq4(8) bit(18) unaligned static init 2 242 ("000000000000000000"b, "100101000001000000"b, /* stz count */ 2 243 "000000000000000000"b, "110010010000000100"b, /* eax2 loc_a_relp,ic */ 2 244 "000000000000000000"b, "100100010001000000"b, /* sxl2 target_a_PN2 */ 2 245 "000000000000000000"b, "111001000000000100"b); /* tra con_1_relp,ic */ 2 246 2 247 dcl seq5(16) bit(18) unaligned static init 2 248 ("000000000000000000"b, "110010010000000100"b, /* eax2 t_relp,ic */ 2 249 "000000000000000000"b, "100100010001000000"b, /* sxl2 target_a_PN2 */ 2 250 "000000000000000110"b, "111001000000000100"b, /* tra 6,ic */ 2 251 "000000000000000000"b, "010011110001000000"b, /* ldq count */ 2 252 "000000000000000000"b, "110000001000000100"b, /* tnz PN1_relp1,ic */ 2 253 "000000000000000000"b, "000101100001000000"b, /* aos count */ 2 254 "000000000000000000"b, "110011101000000100"b, /* eaa PN1_relp2,ic */ 2 255 "000000000000000000"b, "111001000000000100"b); /* tra i_segm_relp,ic */ 2 256 2 257 dcl tra_inst(6) bit(18) unaligned static init 2 258 ("000000000000000000"b, "011101010100000100"b, /* epbp2 0,ic */ 2 259 "110000000000000000"b, "010101010001000000"b, /* spri2 pr6|M */ 2 260 "000000000000000000"b, "111001000000000100"b); /* tra loc_s_relp,ic */ 2 261 2 262 dcl ret_inst(2) bit(18) unaligned static init 2 263 ("110000000000000000"b, "110001000001000000"b); /* rtcd pr6|M */ 2 264 2 265 dcl seq6(4) bit(18) unaligned static init 2 266 ("110000000000000000"b, "111101000001000000"b, /* stc2 pr6|M+1 */ 2 267 "000000000000000000"b, "111001000000000100"b); /* tra loc_e_relp,ic */ 2 268 2 269 dcl seq8(6) bit(18) unaligned static init 2 270 ("000000000000000011"b, "110010111000000100"b, /* eax7 3,ic */ 2 271 "000000000000000000"b, "100100111001000000"b, /* sxl7 target_a_PN2 */ 2 272 "000000000000000000"b, "111001000000000100"b); /* tra PN1_relp1,ic */ 2 273 2 274 dcl move_in_token (1:10) ptr int static; 2 275 dcl move_data_init fixed bin int static init (0); 2 276 2 277 dcl 1 move_eos int static, 2 278 2 size fixed bin (15), 2 279 2 line fixed bin (15), 2 280 2 column fixed bin (15), 2 281 2 type fixed bin (15) init (19), 2 282 2 verb fixed bin (15) init (18), 2 283 2 e fixed bin (15) init (1); 2 284 2 285 dcl szn_seq (2) bit (18) int static init 2 286 ( "000000000000000000"b, "010011100001000000"b); /* szn 0 */ 2 287 2 288 2 289 /* 2 290*P__r_o_c_e_d_u_r_e_s_C__a_l_l_e_d:_ 2 291* */ 2 292 2 293 dcl cobol_add_gen entry (ptr, fixed bin), 2 294 cobol_addr entry (ptr, ptr, ptr), 2 295 cobol_alloc$cobol_data entry (fixed bin(24), fixed bin, fixed bin(24)), 2 296 cobol_alloc$stack entry (fixed bin, fixed bin, fixed bin), 2 297 cobol_arithop_gen entry (ptr), 2 298 cobol_compare_gen entry (ptr), 2 299 cobol_define_tag entry (fixed bin), 2 300 cobol_define_tag_nc entry (fixed bin, fixed bin), 2 301 cobol_emit entry (ptr, ptr, fixed bin), 2 302 cobol_equate_tag entry (ptr), 2 303 cobol_make_tagref entry (fixed bin, fixed bin, ptr), 2 304 cobol_move_gen entry (ptr), 2 305 cobol_pointer_register$get entry (ptr), 2 306 cobol_pointer_register$priority entry (fixed bin, fixed bin, bit(3)), 2 307 cobol_process_error entry (fixed bin, fixed bin, fixed bin), 2 308 cobol_register$load entry (ptr), 2 309 cobol_reset_r$in_line entry, 2 310 cobol_set_gen entry (ptr), 2 311 signal_ entry (char(*), ptr, ptr); 2 312 dcl cobol_make_type9$long_bin ext entry (ptr,fixed bin,fixed bin); 2 313 dcl cobol_num_to_udts ext entry (ptr,ptr); 2 314 2 315 2 316 /* 2 317*B__u_i_l_t-__i_n_F__u_n_c_t_i_o_n_s_U__s_e_d:_ 2 318* */ 2 319 2 320 dcl abs builtin, 2 321 addr builtin, 2 322 addrel builtin, 2 323 binary builtin, 2 324 null builtin, 2 325 rel builtin, 2 326 substr builtin, 2 327 unspec builtin; 2 328 3 1 3 2 /* BEGIN INCLUDE FILE ... cobol_seg_init_list.incl.pl1 */ 3 3 3 4 /* Last modified July 17, 1974 by AEG */ 3 5 3 6 3 7 declare 1 seg_init_list aligned based( cobol_$seg_init_list_ptr), 3 8 2 n fixed bin aligned, 3 9 2 extra fixed bin aligned, 3 10 2 seg (0 refer(seg_init_list.n)) aligned, 3 11 3 priority fixed bin aligned, 3 12 3 int_tag_no fixed bin aligned, 3 13 3 no_gos fixed bin aligned, 3 14 3 next_init_no fixed bin aligned, 3 15 3 init_ptr ptr aligned; 3 16 3 17 3 18 /* 3 19*seg_init_list_ptr is a pointer upon which the structure 3 20* seg_init_list is based. It is declared in 3 21* cobol_.incl.pl1 3 22* 3 23*n is the number of COBOL segments containing 3 24* alterable GO's. All fixed segments are counted 3 25* as one segment and assigned segment number 0. 3 26* 3 27*extra available for future use. 3 28* 3 29*seg is an array of seg_init_list.n structures which 3 30* contain information about the segments contain- 3 31* ing alterable GO's. seg(1) always conatins 3 32* information about fixed segments if there are 3 33* any in the procedure. 3 34* 3 35*priority is the COBOL segment number associated with 3 36* the "alterable" segment. 3 37* 3 38*int_tag_no is an internal tag number associated with the 3 39* first instruction of the code sequence generat- 3 40* ed to initialize the alterable GO's in the seg- 3 41* ment whose segment number is priority. For 3 42* priority = 0, int_tag_no = 0 since initializa- 3 43* tion of alterable GO's in fixed segments is 3 44* accomplished by cobol_prologue_gen. 3 45* 3 46*no_gos is the number of alterable GO's in the segment 3 47* whose segment number is priority. 3 48* 3 49*next_init_no is the number of the next alterable GO in the 3 50* segment whose segment number is priority for 3 51* which initialization data entries are to be 3 52* made in an area reserved for that purpose. The 3 53* base of this area is located by init_ptr. 3 54* 1<_next_init_no<_no_gos. 3 55* 3 56*init_ptr is a pointer to a block of 3 times no_gos words 3 57* reserved for the storage of initialization data 3 58* for the alterable GO's in the segment whose 3 59* segment number is priority. 3 60* 3 61* 3 62* */ 3 63 /* END INCLUDE FILE ... cobol_seg_init_list.incl.pl1 */ 3 64 2 329 4 1 4 2 /* BEGIN INCLUDE FILE ... cobol_type10.incl.pl1 */ 4 3 /* Last modified on 11/19/76 by ORN */ 4 4 /* 4 5*A type 10 index name token is entered into the name table by the data 4 6*division syntax phase for each index name appearing in the data division. 4 7*An index name is declared in the indexed by phrase of an occurs clause. 4 8*maintain the binary byte offset, within the array, corresponding to the 4 9*current setting of the index name. The right-most two bytes contain the 4 10*binary occurrence number to which the index name is set. 4 11*When the replacement phase processes the procedure division minpral file, 4 12*each reference to an index name is replaced with the type 10 token created 4 13*for that index name. 4 14**/ 4 15 4 16 dcl ind_ptr ptr; 4 17 4 18 /* BEGIN DECLARATION OF TYPE10 (INDEX NAME) TOKEN */ 4 19 dcl 1 index_name based (ind_ptr), 5 1 5 2 /* begin include file ... cobol_TYPE10.incl.pl1 5 3*/* Last modified on 01/25/77 by ORN */ 5 4 5 5 /* header */ 5 6 2 size fixed bin, 5 7 2 line fixed bin, 5 8 2 column fixed bin, 5 9 2 type fixed bin, 5 10 /* body */ 5 11 2 string_ptr ptr, 5 12 2 prev_rec ptr, 5 13 2 searched bit(1), 5 14 2 duplicate bit(1), 5 15 2 saved bit(1), 5 16 2 debug_ind bit(1), 5 17 2 filler1 bit(3), 5 18 2 subscript bit(1), 5 19 2 def_line fixed bin, 5 20 2 level fixed bin, 5 21 2 seg_num fixed bin, 5 22 2 offset fixed bin(24), 5 23 2 index_no fixed bin, 5 24 2 min fixed bin, 5 25 2 max fixed bin, 5 26 2 struc_length fixed bin, 5 27 2 cswd_seg fixed bin, 5 28 2 cswd_offset fixed bin(24), 5 29 2 name_size fixed bin, 5 30 2 name char(0 refer(index_name.name_size)); 5 31 5 32 5 33 5 34 /* end include file ... cobol_TYPE10.incl.pl1 */ 5 35 4 20 4 21 /* END DECLARATION OF TYPE10 (INDEX NAME) TOKEN */ 4 22 4 23 /* END INCLUDE FILE ... cobol_type10.incl.pl1 */ 4 24 2 330 6 1 6 2 /* BEGIN INCLUDE FILE ... cobol_type19.incl.pl1 */ 6 3 /* last modified on 11/19/76 by ORN */ 6 4 6 5 /* 6 6*A type 19 end of statement token is created in the procedure division 6 7*minpral file at the end of each minpral statement generated by the 6 8*procedure division syntax phase. A minpral statement may be a complete or 6 9*partial source language statement. A type 19 token contains information 6 10*describing the statement which it delimits. 6 11**/ 6 12 6 13 dcl eos_ptr ptr; 6 14 6 15 /* BEGIN DECLARATION OF TYPE19 (END STATEMENT) TOKEN */ 6 16 dcl 1 end_stmt based (eos_ptr), 7 1 7 2 /* begin include file ... cobol_TYPE19.incl.pl1 */ 7 3 /* Last modified on 11/17/76 by ORN */ 7 4 7 5 /* header */ 7 6 2 size fixed bin, 7 7 2 line fixed bin, 7 8 2 column fixed bin, 7 9 2 type fixed bin, 7 10 /* body */ 7 11 2 verb fixed bin, 7 12 2 e fixed bin, 7 13 2 h fixed bin, 7 14 2 i fixed bin, 7 15 2 j fixed bin, 7 16 2 a bit (3), 7 17 2 b bit (1), 7 18 2 c bit (1), 7 19 2 d bit (2), 7 20 2 f bit (2), 7 21 2 g bit (2), 7 22 2 k bit (5), 7 23 2 always_an bit (1); 7 24 7 25 /* end include file ... cobol_TYPE19.incl.pl1 */ 7 26 6 17 6 18 /* END DECLARATION OF TYPE19 (END STATEMENT) TOKEN */ 6 19 6 20 /* 6 21*FIELD CONTENTS 6 22* 6 23*size The total size in bytes of this end of statement token. 6 24*line 0 6 25*column 0 6 26*type 19 6 27*verb A value indicating the verb in this statement 6 28* 1 = accept 6 29* 2 = add 6 30* 3 = on size error 6 31* 4 = alter 6 32* 5 = call 6 33* 7 = cancel 6 34* 8 = close 6 35* 9 = divide 6 36* 10 = multiply 6 37* 11 = subtract 6 38* 12 = exit 6 39* 14 = go 6 40* 15 = merge 6 41* 16 = initiate 6 42* 17 = inspect 6 43* 18 = move 6 44* 19 = open 6 45* 20 = perform 6 46* 21 = read 6 47* 23 = receive 6 48* 24 = release 6 49* 25 = return 6 50* 26 = search 6 51* 27 = rewrite 6 52* 29 = seek 6 53* 30 = send 6 54* 31 = set 6 55* 33 = stop 6 56* 34 = string 6 57* 35 = suspend 6 58* 36 = terminate 6 59* 37 = unstring 6 60* 38 = write 6 61* 39 = use 6 62* 40 = compute 6 63* 41 = disable 6 64* 42 = display 6 65* 43 = enable 6 66* 45 = generate 6 67* 46 = hold 6 68* 48 = process 6 69* 49 = sort 6 70* 52 = procedure 6 71* 53 = declaratives 6 72* 54 = section name 6 73* 55 = paragraph name 6 74* 98 = end 6 75*e,h,i,j The significance of these fields differs with each 6 76* statement. These fields are normally used as counters. 6 77*a,b,c,d,f,g,k The significance of these fields differs with each 6 78* statement. These fields are normally used as indicators. 6 79**/ 6 80 6 81 /* END INCLUDE FILE ... cobol_type19.incl.pl1 */ 6 82 2 331 2 332 8 1 8 2 /* BEGIN INCLUDE FILE ... cobol_type1.incl.pl1 */ 8 3 /* Last modified on 11/19/76 by ORN */ 8 4 8 5 /* 8 6*A reserved word token is created in the minpral files for each occurrence 8 7*of a reserved word in the source program. The value of the key field 8 8*indicates the specific reserved word which a type 1 token represents. 8 9**/ 8 10 8 11 dcl rw_ptr ptr; 8 12 8 13 /* BEGIN DECLARATION OF TYPE1 (RESERVED WORD) TOKEN */ 8 14 dcl 1 reserved_word based (rw_ptr), 9 1 9 2 /* begin include file ... cobol_TYPE1.incl.pl1 */ 9 3 /* Last modified on 11/17/76 by ORN */ 9 4 /* Last modified on 12/28/76 by FCH */ 9 5 /* Last modified on 12/16/80 by FCH */ 9 6 9 7 /* header */ 9 8 2 size fixed bin, 9 9 2 line fixed bin, 9 10 2 column fixed bin, 9 11 2 type fixed bin, 9 12 /* body */ 9 13 2 key fixed bin, 9 14 /* procedure division class bits */ 9 15 2 verb bit (1), 9 16 2 arith_op bit (1), 9 17 2 figcon bit (1), 9 18 2 terminator bit (1), 9 19 2 end_dec bit (1), 9 20 2 rel_op bit (1), 9 21 2 imper_verb bit (1), 9 22 2 end_cobol bit (1), 9 23 /* data division class bits */ 9 24 2 section_header bit (1), 9 25 2 fs_ind bit (1), 9 26 2 fd_clause bit (1), 9 27 2 dd_clause bit (1), 9 28 2 cd_input bit (1), 9 29 2 cd_output bit (1), 9 30 2 cset_name bit (1), 9 31 2 ss_division bit (1), 9 32 2 repl_jump_ind bit (4), 9 33 2 ided_recovery bit (1), 9 34 2 report_writer bit (5), 9 35 2 ss_desc_entry bit (1), 9 36 2 jump_index fixed bin, 9 37 2 length fixed bin, 9 38 2 name char(0 refer(reserved_word.length)); 9 39 9 40 9 41 9 42 /* end include file ... cobol_TYPE1.incl.pl1 */ 9 43 8 15 8 16 /* END DECLARATION OF TYPE1 (RESERVED WORD) TOKEN */ 8 17 8 18 /* END INCLUDE FILE ... cobol_type1.incl.pl1 */ 8 19 2 333 2 334 10 1 10 2 /* BEGIN INCLUDE FILE ... cobol_type9.incl.pl1 */ 10 3 /* Last modified on 11/19/76 by ORN */ 10 4 10 5 /* 10 6*A type 9 data name token is entered into the name table by the data 10 7*division syntax phase for each data name described in the data division. 10 8*The replacement phase subsequently replaces type 8 user word references 10 9*to data names in the procedure division minpral file with the corresponding 10 10*type 9 tokens from the name table. 10 11**/ 10 12 10 13 /* dcl dn_ptr ptr; */ 10 14 10 15 /* BEGIN DECLARATION OF TYPE9 (DATA NAME) TOKEN */ 10 16 dcl 1 data_name based (dn_ptr), 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 10 17 10 18 /* END DECLARATION OF TYPE9 (DATA NAME) TOKEN */ 10 19 10 20 /* END INCLUDE FILE ... cobol_type9.incl.pl1 */ 10 21 2 335 2 336 12 1 12 2 /* BEGIN INCLUDE FILE ... cobol_in_token.incl.pl1 */ 12 3 12 4 /* Last modified August 22, 1974 by AEG */ 12 5 12 6 12 7 declare in_token_ptr ptr; 12 8 12 9 declare 1 in_token aligned based(in_token_ptr), 12 10 2 n fixed bin aligned, 12 11 2 code fixed bin aligned, 12 12 2 token_ptr(0 refer(in_token.n)) ptr aligned; 12 13 12 14 12 15 /* END INCLUDE FILE ... cobol_in_token.incl.pl1 */ 12 16 2 337 2 338 13 1 13 2 /* BEGIN INCLUDE FILE ... cobol_perform_list.incl.pl1 */ 13 3 /* Last modified July 17, 1974 by AEG */ 13 4 13 5 13 6 declare 1 perform_list aligned based( cobol_$perform_list_ptr), 13 7 2 n fixed bin aligned, 13 8 2 perf (0 refer(perform_list.n)) aligned, 13 9 3 proc_num fixed bin aligned, 13 10 3 priority fixed bin aligned, 13 11 3 target_a_segno fixed bin aligned, 13 12 3 target_a_offset fixed bin(24) aligned, 13 13 3 int_tag_no fixed bin aligned; 13 14 13 15 13 16 /* 13 17*perform_list_ptr is a pointer upon which the structure 13 18* perform_list is based. It is declared in 13 19* cobol_.incl.pl1. 13 20* 13 21*n is the number of COBOL procedures which 13 22* terminate perform ranges. 13 23* 13 24*perf is an array of perform_list.n structures which 13 25* contain information about end of perform range 13 26* procedures. 13 27* 13 28*proc_num is a tag number by which the end of perform 13 29* range procedure is identified. 13 30* 13 31*priority is the COBOL segment number of the section con- 13 32* taining COBOL procedure proc_num. 13 33* 13 34*target_a_segno and target_a_offset are the artificial MCOBOL seg- 13 35* ment number and character offset, respectively, 13 36* of a 36-bit variable, allocated in the COBOL 13 37* data segment on a word boundary, which contains 13 38* transfer address information for the alterable 13 39* GO contained in COBOL procedure proc_num. 13 40* 13 41*int_tag_no is an internal tag number assigned to the in- 13 42* struction to which control is transferred by the 13 43* end of perform range alterable GO when the pro- 13 44* cedure which it terminates is not being performed. 13 45* 13 46* 13 47* */ 13 48 /* END INCLUDE FILE ... cobol_perform_list.incl.pl1 */ 13 49 2 339 2 340 14 1 14 2 /* BEGIN INCLUDE FILE ... cobol_type2.incl.pl1 */ 14 3 /* Last modified on 11/19/76 by ORN */ 14 4 14 5 /* 14 6*A type 2 numeric literal token is entered into the minpral file by the 14 7*lexical analysis phase for each numeric literal encountered in the source 14 8*program. 14 9**/ 14 10 14 11 dcl nlit_ptr ptr; 14 12 14 13 /* BEGIN DECLARATION OF TYPE2 (NUMERIC LITERAL) TOKEN */ 14 14 dcl 1 numeric_lit based (nlit_ptr), 15 1 15 2 /* begin include file ... cobol_TYPE2.incl.pl1 */ 15 3 /* Last modified on 12/28/76 by FCH */ 15 4 15 5 /* header */ 15 6 2 size fixed bin, 15 7 2 line fixed bin, 15 8 2 column fixed bin, 15 9 2 type fixed bin, 15 10 /* body */ 15 11 2 integral bit(1), 15 12 2 floating bit(1), 15 13 2 seg_range bit(1), 15 14 2 filler1 bit(4), 15 15 2 subscript bit(1), 15 16 2 sign char(1), 15 17 2 exp_sign char(1), 15 18 2 exp_places fixed bin, 15 19 2 places_left fixed bin, 15 20 2 places_right fixed bin, 15 21 2 places fixed bin, 15 22 2 literal char(0 refer(numeric_lit.places)); 15 23 15 24 15 25 15 26 /* end include file ... cobol_TYPE2.incl.pl1 */ 15 27 14 15 14 16 /* END DECLARATION OF TYPE2 (NUMERIC LITERAL) TOKEN */ 14 17 14 18 /* END INCLUDE FILE ... cobol_type2.incl.pl1 */ 14 19 2 341 2 342 16 1 16 2 /* BEGIN INCLUDE FILE ... cobol_type18.incl.pl1 */ 16 3 /* Last modified on 11/19/76 by ORN */ 16 4 16 5 /* 16 6*A type 18 procedure reference token is entered into the procedure division 16 7*minpral file by the replacement phase to replace each type 8 user word 16 8*reference to a procedure name. A type 18 token is constructed by changing 16 9*the type field of the appropriate type 7 procedure definition token from 16 10*the name table to 18. 16 11**/ 16 12 16 13 dcl proc_ref_ptr ptr; 16 14 16 15 /* BEGIN DECLARATION OF TYPE18 (PROCEDURE REFERENCE) TOKEN */ 16 16 dcl 1 proc_ref based (proc_ref_ptr), 17 1 17 2 /* begin include file ... cobol_TYPE18.incl.pl1 */ 17 3 /* Last modified on 11/7/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 searched bit (1), 17 14 2 duplicate bit (1), 17 15 2 filler1 bit (1), 17 16 2 debug_ind bit (1), 17 17 2 section_name bit (1), 17 18 2 declarative_proc bit (1), 17 19 2 filler2 bit (1), 17 20 2 alterable bit (1), 17 21 2 priority char (2), 17 22 2 sort_range bit (1), 17 23 2 input_range bit (1), 17 24 2 output_range bit (1), 17 25 2 merge_range bit(1), 17 26 2 filler3 bit (5), 17 27 2 section_num fixed bin, 17 28 2 proc_num fixed bin, 17 29 2 def_line fixed bin, 17 30 2 name_size fixed bin, 17 31 2 name char (30); 17 32 17 33 /* end include file ... cobol_TYPE18.incl.pl1 */ 17 34 16 17 16 18 /* END DECLARATION OF TYPE18 (PROCEDURE REFERENCE) TOKEN */ 16 19 16 20 /* END INCLUDE FILE ... cobol_type18.incl.pl1 */ 16 21 2 343 2 344 18 1 18 2 /* BEGIN INCLUDE FILE ... cobol_type30.incl.pl1 */ 18 3 /* Last modified on 11/19/76 by ORN */ 18 4 18 5 /* 18 6*An internal tag token is created in the procedure division minpral file by 18 7*the procedure division syntax phase whenever the introduction of a 18 8*compiler-generated procedure definition is required to maintain the proper 18 9*logical flow between minpral statements. A typical usage of type 30 tokens 18 10*is as labels of simple conditions within a compound condition. 18 11**/ 18 12 18 13 dcl tag_ptr ptr; 18 14 18 15 /* BEGIN DECLARATION OF TYPE30 (INTERNAL TAG) TOKEN */ 18 16 dcl 1 int_tag based (tag_ptr), 18 17 /* header */ 18 18 2 size fixed bin (15), 18 19 2 line fixed bin (15), 18 20 2 column fixed bin (15), 18 21 2 type fixed bin (15), 18 22 /* body */ 18 23 2 filler1 ptr, 18 24 2 filler2 ptr, 18 25 2 perform_bit bit (1), 18 26 2 true_path bit (1), 18 27 2 filler3 bit (6), 18 28 2 filler4 char (2), 18 29 2 filler5 bit (8), 18 30 2 filler6 fixed bin (15), 18 31 2 proc_num fixed bin (15), 18 32 2 filler7 fixed bin (15), 18 33 2 filler8 char (1); 18 34 /* END DECLARATION OF TYPE30 (INTERNAL TAG) TOKEN */ 18 35 18 36 /* 18 37*FIELD CONTENTS 18 38* 18 39*size The total size in bytes of this internal tag token. 18 40*line 0 18 41*column 0 18 42*type 30 18 43*filler1 Available for future use. 18 44*filler2 Available for future use. 18 45*perform_bit Set to "1"b when this token is issued at the 18 46* end of a condition in a format #3 or format #4 18 47* perform. 18 48*true_path This field is significant only when perform_bit is 18 49* "1"b. Set to "1"b when this token represents the true 18 50* path of a condition. Set to "0"b when this token 18 51* represents the false path of a condition. 18 52*filler3 Available for future use. 18 53*filler4 Available for future use. 18 54*filler5 Available for future use. 18 55*filler6 Available for future use. 18 56*proc_num The internally generated procedure number of the tag 18 57* defined by this token. 18 58*filler7 Available for future use. 18 59*filler8 Available for future use. 18 60**/ 18 61 18 62 /* END INCLUDE FILE ... cobol_type30.incl.pl1 */ 18 63 2 345 2 346 19 1 19 2 /* BEGIN INCLUDE FILE ... cobol_.incl.pl1 */ 19 3 /* last modified Feb 4, 1977 by ORN */ 19 4 19 5 /* This file defines all external data used in the generator phase of Multics Cobol */ 19 6 19 7 /* POINTERS */ 19 8 dcl cobol_$text_base_ptr ptr ext; 19 9 dcl text_base_ptr ptr defined (cobol_$text_base_ptr); 19 10 dcl cobol_$con_end_ptr ptr ext; 19 11 dcl con_end_ptr ptr defined (cobol_$con_end_ptr); 19 12 dcl cobol_$def_base_ptr ptr ext; 19 13 dcl def_base_ptr ptr defined (cobol_$def_base_ptr); 19 14 dcl cobol_$link_base_ptr ptr ext; 19 15 dcl link_base_ptr ptr defined (cobol_$link_base_ptr); 19 16 dcl cobol_$sym_base_ptr ptr ext; 19 17 dcl sym_base_ptr ptr defined (cobol_$sym_base_ptr); 19 18 dcl cobol_$reloc_text_base_ptr ptr ext; 19 19 dcl reloc_text_base_ptr ptr defined (cobol_$reloc_text_base_ptr); 19 20 dcl cobol_$reloc_def_base_ptr ptr ext; 19 21 dcl reloc_def_base_ptr ptr defined (cobol_$reloc_def_base_ptr); 19 22 dcl cobol_$reloc_link_base_ptr ptr ext; 19 23 dcl reloc_link_base_ptr ptr defined (cobol_$reloc_link_base_ptr); 19 24 dcl cobol_$reloc_sym_base_ptr ptr ext; 19 25 dcl reloc_sym_base_ptr ptr defined (cobol_$reloc_sym_base_ptr); 19 26 dcl cobol_$reloc_work_base_ptr ptr ext; 19 27 dcl reloc_work_base_ptr ptr defined (cobol_$reloc_work_base_ptr); 19 28 dcl cobol_$pd_map_ptr ptr ext; 19 29 dcl pd_map_ptr ptr defined (cobol_$pd_map_ptr); 19 30 dcl cobol_$fixup_ptr ptr ext; 19 31 dcl fixup_ptr ptr defined (cobol_$fixup_ptr); 19 32 dcl cobol_$initval_base_ptr ptr ext; 19 33 dcl initval_base_ptr ptr defined (cobol_$initval_base_ptr); 19 34 dcl cobol_$initval_file_ptr ptr ext; 19 35 dcl initval_file_ptr ptr defined (cobol_$initval_file_ptr); 19 36 dcl cobol_$perform_list_ptr ptr ext; 19 37 dcl perform_list_ptr ptr defined (cobol_$perform_list_ptr); 19 38 dcl cobol_$alter_list_ptr ptr ext; 19 39 dcl alter_list_ptr ptr defined (cobol_$alter_list_ptr); 19 40 dcl cobol_$seg_init_list_ptr ptr ext; 19 41 dcl seg_init_list_ptr ptr defined (cobol_$seg_init_list_ptr); 19 42 dcl cobol_$temp_token_area_ptr ptr ext; 19 43 dcl temp_token_area_ptr ptr defined (cobol_$temp_token_area_ptr); 19 44 dcl cobol_$temp_token_ptr ptr ext; 19 45 dcl temp_token_ptr ptr defined (cobol_$temp_token_ptr); 19 46 dcl cobol_$token_block1_ptr ptr ext; 19 47 dcl token_block1_ptr ptr defined (cobol_$token_block1_ptr); 19 48 dcl cobol_$token_block2_ptr ptr ext; 19 49 dcl token_block2_ptr ptr defined (cobol_$token_block2_ptr); 19 50 dcl cobol_$minpral5_ptr ptr ext; 19 51 dcl minpral5_ptr ptr defined (cobol_$minpral5_ptr); 19 52 dcl cobol_$tag_table_ptr ptr ext; 19 53 dcl tag_table_ptr ptr defined (cobol_$tag_table_ptr); 19 54 dcl cobol_$map_data_ptr ptr ext; 19 55 dcl map_data_ptr ptr defined (cobol_$map_data_ptr); 19 56 dcl cobol_$ptr_status_ptr ptr ext; 19 57 dcl ptr_status_ptr ptr defined (cobol_$ptr_status_ptr); 19 58 dcl cobol_$reg_status_ptr ptr ext; 19 59 dcl reg_status_ptr ptr defined (cobol_$reg_status_ptr); 19 60 dcl cobol_$misc_base_ptr ptr ext; 19 61 dcl misc_base_ptr ptr defined (cobol_$misc_base_ptr); 19 62 dcl cobol_$misc_end_ptr ptr ext; 19 63 dcl misc_end_ptr ptr defined (cobol_$misc_end_ptr); 19 64 dcl cobol_$list_ptr ptr ext; 19 65 dcl list_ptr ptr defined (cobol_$list_ptr); 19 66 dcl cobol_$allo1_ptr ptr ext; 19 67 dcl allo1_ptr ptr defined (cobol_$allo1_ptr); 19 68 dcl cobol_$eln_ptr ptr ext; 19 69 dcl eln_ptr ptr defined (cobol_$eln_ptr); 19 70 dcl cobol_$diag_ptr ptr ext; 19 71 dcl diag_ptr ptr defined (cobol_$diag_ptr); 19 72 dcl cobol_$xref_token_ptr ptr ext; 19 73 dcl xref_token_ptr ptr defined (cobol_$xref_token_ptr); 19 74 dcl cobol_$xref_chain_ptr ptr ext; 19 75 dcl xref_chain_ptr ptr defined (cobol_$xref_chain_ptr); 19 76 dcl cobol_$statement_info_ptr ptr ext; 19 77 dcl statement_info_ptr ptr defined (cobol_$statement_info_ptr); 19 78 dcl cobol_$reswd_ptr ptr ext; 19 79 dcl reswd_ptr ptr defined (cobol_$reswd_ptr); 19 80 dcl cobol_$op_con_ptr ptr ext; 19 81 dcl op_con_ptr ptr defined (cobol_$op_con_ptr); 19 82 dcl cobol_$ntbuf_ptr ptr ext; 19 83 dcl ntbuf_ptr ptr defined (cobol_$ntbuf_ptr); 19 84 dcl cobol_$main_pcs_ptr ptr ext; 19 85 dcl main_pcs_ptr ptr defined (cobol_$main_pcs_ptr); 19 86 dcl cobol_$include_info_ptr ptr ext; 19 87 dcl include_info_ptr ptr defined (cobol_$include_info_ptr); 19 88 19 89 /* FIXED BIN */ 19 90 dcl cobol_$text_wd_off fixed bin ext; 19 91 dcl text_wd_off fixed bin defined (cobol_$text_wd_off); 19 92 dcl cobol_$con_wd_off fixed bin ext; 19 93 dcl con_wd_off fixed bin defined (cobol_$con_wd_off); 19 94 dcl cobol_$def_wd_off fixed bin ext; 19 95 dcl def_wd_off fixed bin defined (cobol_$def_wd_off); 19 96 dcl cobol_$def_max fixed bin ext; 19 97 dcl def_max fixed bin defined (cobol_$def_max); 19 98 dcl cobol_$link_wd_off fixed bin ext; 19 99 dcl link_wd_off fixed bin defined (cobol_$link_wd_off); 19 100 dcl cobol_$link_max fixed bin ext; 19 101 dcl link_max fixed bin defined (cobol_$link_max); 19 102 dcl cobol_$sym_wd_off fixed bin ext; 19 103 dcl sym_wd_off fixed bin defined (cobol_$sym_wd_off); 19 104 dcl cobol_$sym_max fixed bin ext; 19 105 dcl sym_max fixed bin defined (cobol_$sym_max); 19 106 dcl cobol_$reloc_text_max fixed bin(24) ext; 19 107 dcl reloc_text_max fixed bin(24) defined (cobol_$reloc_text_max); 19 108 dcl cobol_$reloc_def_max fixed bin(24) ext; 19 109 dcl reloc_def_max fixed bin(24) defined (cobol_$reloc_def_max); 19 110 dcl cobol_$reloc_link_max fixed bin(24) ext; 19 111 dcl reloc_link_max fixed bin(24) defined (cobol_$reloc_link_max); 19 112 dcl cobol_$reloc_sym_max fixed bin(24) ext; 19 113 dcl reloc_sym_max fixed bin(24) defined (cobol_$reloc_sym_max); 19 114 dcl cobol_$reloc_work_max fixed bin(24) ext; 19 115 dcl reloc_work_max fixed bin(24) defined (cobol_$reloc_work_max); 19 116 dcl cobol_$pd_map_index fixed bin ext; 19 117 dcl pd_map_index fixed bin defined (cobol_$pd_map_index); 19 118 dcl cobol_$cobol_data_wd_off fixed bin ext; 19 119 dcl cobol_data_wd_off fixed bin defined (cobol_$cobol_data_wd_off); 19 120 dcl cobol_$stack_off fixed bin ext; 19 121 dcl stack_off fixed bin defined (cobol_$stack_off); 19 122 dcl cobol_$max_stack_off fixed bin ext; 19 123 dcl max_stack_off fixed bin defined (cobol_$max_stack_off); 19 124 dcl cobol_$init_stack_off fixed bin ext; 19 125 dcl init_stack_off fixed bin defined (cobol_$init_stack_off); 19 126 dcl cobol_$pd_map_sw fixed bin ext; 19 127 dcl pd_map_sw fixed bin defined (cobol_$pd_map_sw); 19 128 dcl cobol_$next_tag fixed bin ext; 19 129 dcl next_tag fixed bin defined (cobol_$next_tag); 19 130 dcl cobol_$data_init_flag fixed bin ext; 19 131 dcl data_init_flag fixed bin defined (cobol_$data_init_flag); 19 132 dcl cobol_$seg_init_flag fixed bin ext; 19 133 dcl seg_init_flag fixed bin defined (cobol_$seg_init_flag); 19 134 dcl cobol_$alter_flag fixed bin ext; 19 135 dcl alter_flag fixed bin defined (cobol_$alter_flag); 19 136 dcl cobol_$sect_eop_flag fixed bin ext; 19 137 dcl sect_eop_flag fixed bin defined (cobol_$sect_eop_flag); 19 138 dcl cobol_$para_eop_flag fixed bin ext; 19 139 dcl para_eop_flag fixed bin defined (cobol_$para_eop_flag); 19 140 dcl cobol_$priority_no fixed bin ext; 19 141 dcl priority_no fixed bin defined (cobol_$priority_no); 19 142 dcl cobol_$compile_count fixed bin ext; 19 143 dcl compile_count fixed bin defined (cobol_$compile_count); 19 144 dcl cobol_$ptr_assumption_ind fixed bin ext; 19 145 dcl ptr_assumption_ind fixed bin defined (cobol_$ptr_assumption_ind); 19 146 dcl cobol_$reg_assumption_ind fixed bin ext; 19 147 dcl reg_assumption_ind fixed bin defined (cobol_$reg_assumption_ind); 19 148 dcl cobol_$perform_para_index fixed bin ext; 19 149 dcl perform_para_index fixed bin defined (cobol_$perform_para_index); 19 150 dcl cobol_$perform_sect_index fixed bin ext; 19 151 dcl perform_sect_index fixed bin defined (cobol_$perform_sect_index); 19 152 dcl cobol_$alter_index fixed bin ext; 19 153 dcl alter_index fixed bin defined (cobol_$alter_index); 19 154 dcl cobol_$list_off fixed bin ext; 19 155 dcl list_off fixed bin defined (cobol_$list_off); 19 156 dcl cobol_$constant_offset fixed bin ext; 19 157 dcl constant_offset fixed bin defined (cobol_$constant_offset); 19 158 dcl cobol_$misc_max fixed bin ext; 19 159 dcl misc_max fixed bin defined (cobol_$misc_max); 19 160 dcl cobol_$pd_map_max fixed bin ext; 19 161 dcl pd_map_max fixed bin defined (cobol_$pd_map_max); 19 162 dcl cobol_$map_data_max fixed bin ext; 19 163 dcl map_data_max fixed bin defined (cobol_$map_data_max); 19 164 dcl cobol_$fixup_max fixed bin ext; 19 165 dcl fixup_max fixed bin defined (cobol_$fixup_max); 19 166 dcl cobol_$tag_table_max fixed bin ext; 19 167 dcl tag_table_max fixed bin defined (cobol_$tag_table_max); 19 168 dcl cobol_$temp_token_max fixed bin ext; 19 169 dcl temp_token_max fixed bin defined (cobol_$temp_token_max); 19 170 dcl cobol_$allo1_max fixed bin ext; 19 171 dcl allo1_max fixed bin defined (cobol_$allo1_max); 19 172 dcl cobol_$eln_max fixed bin ext; 19 173 dcl eln_max fixed bin defined (cobol_$eln_max); 19 174 dcl cobol_$debug_enable fixed bin ext; 19 175 dcl debug_enable fixed bin defined (cobol_$debug_enable); 19 176 dcl cobol_$non_source_offset fixed bin ext; 19 177 dcl non_source_offset fixed bin defined (cobol_$non_source_offset); 19 178 dcl cobol_$initval_flag fixed bin ext; 19 179 dcl initval_flag fixed bin defined (cobol_$initval_flag); 19 180 dcl cobol_$date_compiled_sw fixed bin ext; 19 181 dcl date_compiled_sw fixed bin defined (cobol_$date_compiled_sw); 19 182 dcl cobol_$include_cnt fixed bin ext; 19 183 dcl include_cnt fixed bin defined (cobol_$include_cnt); 19 184 dcl cobol_$fs_charcnt fixed bin ext; 19 185 dcl fs_charcnt fixed bin defined (cobol_$fs_charcnt); 19 186 dcl cobol_$ws_charcnt fixed bin ext; 19 187 dcl ws_charcnt fixed bin defined (cobol_$ws_charcnt); 19 188 dcl cobol_$coms_charcnt fixed bin ext; 19 189 dcl coms_charcnt fixed bin defined (cobol_$coms_charcnt); 19 190 dcl cobol_$ls_charcnt fixed bin ext; 19 191 dcl ls_charcnt fixed bin defined (cobol_$ls_charcnt); 19 192 dcl cobol_$cons_charcnt fixed bin ext; 19 193 dcl cons_charcnt fixed bin defined (cobol_$cons_charcnt); 19 194 dcl cobol_$value_cnt fixed bin ext; 19 195 dcl value_cnt fixed bin defined (cobol_$value_cnt); 19 196 dcl cobol_$cd_cnt fixed bin ext; 19 197 dcl cd_cnt fixed bin defined (cobol_$cd_cnt); 19 198 dcl cobol_$fs_wdoff fixed bin ext; 19 199 dcl fs_wdoff fixed bin defined (cobol_$fs_wdoff); 19 200 dcl cobol_$ws_wdoff fixed bin ext; 19 201 dcl ws_wdoff fixed bin defined (cobol_$ws_wdoff); 19 202 dcl cobol_$coms_wdoff fixed bin ext; 19 203 dcl coms_wdoff fixed bin defined (cobol_$coms_wdoff); 19 204 19 205 /* CHARACTER */ 19 206 dcl cobol_$scratch_dir char (168) aligned ext; 19 207 dcl scratch_dir char (168) aligned defined (cobol_$scratch_dir); /* -42- */ 19 208 dcl cobol_$obj_seg_name char (32) aligned ext; 19 209 dcl obj_seg_name char (32) aligned defined (cobol_$obj_seg_name); /* -8- */ 19 210 19 211 /* BIT */ 19 212 dcl cobol_$xref_bypass bit(1) aligned ext; 19 213 dcl xref_bypass bit(1) aligned defined (cobol_$xref_bypass); /* -1- */ 19 214 dcl cobol_$same_sort_merge_proc bit(1) aligned ext; 19 215 dcl same_sort_merge_proc bit(1) aligned defined (cobol_$same_sort_merge_proc); /* -1- */ 19 216 19 217 19 218 /* END INCLUDE FILE ... cobol_incl.pl1*/ 19 219 19 220 2 347 2 348 856 857 858 end cobol_perform_gen; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0832.7 cobol_perform_gen.pl1 >spec>install>MR12.3-1048>cobol_perform_gen.pl1 855 1 03/27/82 0439.3 cobol_perform_gen_info.incl.pl1 >ldd>include>cobol_perform_gen_info.incl.pl1 856 2 03/27/82 0439.3 cobol_perform_gen_data.incl.pl1 >ldd>include>cobol_perform_gen_data.incl.pl1 2-329 3 03/27/82 0439.8 cobol_seg_init_list.incl.pl1 >ldd>include>cobol_seg_init_list.incl.pl1 2-330 4 03/27/82 0439.8 cobol_type10.incl.pl1 >ldd>include>cobol_type10.incl.pl1 4-20 5 11/11/82 1712.7 cobol_TYPE10.incl.pl1 >ldd>include>cobol_TYPE10.incl.pl1 2-331 6 03/27/82 0439.8 cobol_type19.incl.pl1 >ldd>include>cobol_type19.incl.pl1 6-17 7 03/27/82 0439.6 cobol_TYPE19.incl.pl1 >ldd>include>cobol_TYPE19.incl.pl1 2-333 8 03/27/82 0439.8 cobol_type1.incl.pl1 >ldd>include>cobol_type1.incl.pl1 8-15 9 11/11/82 1712.8 cobol_TYPE1.incl.pl1 >ldd>include>cobol_TYPE1.incl.pl1 2-335 10 03/27/82 0439.9 cobol_type9.incl.pl1 >ldd>include>cobol_type9.incl.pl1 10-17 11 11/11/82 1712.7 cobol_TYPE9.incl.pl1 >ldd>include>cobol_TYPE9.incl.pl1 2-337 12 11/11/82 1712.7 cobol_in_token.incl.pl1 >ldd>include>cobol_in_token.incl.pl1 2-339 13 03/27/82 0439.8 cobol_perform_list.incl.pl1 >ldd>include>cobol_perform_list.incl.pl1 2-341 14 03/27/82 0439.8 cobol_type2.incl.pl1 >ldd>include>cobol_type2.incl.pl1 14-15 15 11/11/82 1712.8 cobol_TYPE2.incl.pl1 >ldd>include>cobol_TYPE2.incl.pl1 2-343 16 11/11/82 1712.8 cobol_type18.incl.pl1 >ldd>include>cobol_type18.incl.pl1 16-17 17 03/27/82 0439.6 cobol_TYPE18.incl.pl1 >ldd>include>cobol_TYPE18.incl.pl1 2-345 18 03/27/82 0439.8 cobol_type30.incl.pl1 >ldd>include>cobol_type30.incl.pl1 2-347 19 11/11/82 1712.7 cobol_.incl.pl1 >ldd>include>cobol_.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. L1 000163 automatic fixed bin(17,0) dcl 98 set ref 143* 346* 434* 595* L2 000164 automatic fixed bin(17,0) dcl 98 set ref 336* 344* 372* 396* 467* L3 000165 automatic fixed bin(17,0) dcl 98 set ref 154* 465* a 11 based bit(3) level 2 in structure "end_stmt" packed packed unaligned dcl 6-16 in procedure "cobol_perform_gen" ref 109 a 11 000070 internal static bit(3) initial level 2 in structure "eos_token" dcl 2-183 in procedure "cobol_perform_gen" set ref 640* 653* 751* abs builtin function dcl 2-320 ref 167 addr builtin function dcl 2-320 ref 184 184 186 189 192 192 201 201 203 203 203 203 205 205 217 229 229 231 234 238 238 239 239 251 257 276 276 279 279 299 299 299 299 305 305 340 340 342 342 354 354 355 355 355 355 357 357 357 357 364 364 371 371 404 404 407 415 422 422 427 427 427 427 464 464 525 525 526 526 532 532 544 562 562 565 573 579 579 583 583 583 583 590 590 608 623 623 633 676 695 695 704 704 704 704 707 707 717 717 762 762 768 768 768 768 775 775 775 775 777 777 815 815 addrel builtin function dcl 2-320 ref 192 192 239 239 722 726 728 b 12 000070 internal static bit(1) initial level 2 dcl 2-183 set ref 635* bin_18 21(13) based bit(1) level 2 packed packed unaligned dcl 10-16 ref 244 bin_36 21(14) based bit(1) level 2 packed packed unaligned dcl 10-16 ref 244 binary builtin function dcl 2-320 ref 109 125 220 273 302 715 818 818 bit_18 based bit(18) packed unaligned dcl 31 ref 272 301 char_offset 4 000021 internal static fixed bin(24,0) level 2 in structure "target" dcl 2-50 in procedure "cobol_perform_gen" set ref 166* char_offset 4 000027 internal static fixed bin(24,0) level 2 in structure "count" dcl 2-58 in procedure "cobol_perform_gen" set ref 228* 236* 236 249 419* 420* 420 577* 578* 578 cmpq_id_10 constant bit(18) initial packed unaligned dcl 2-237 ref 311 cmpq_int_1 constant bit(18) initial packed unaligned dcl 2-239 ref 323 cobol_$compile_count 000326 external static fixed bin(17,0) dcl 19-142 ref 253 259 cobol_$next_tag 000322 external static fixed bin(17,0) dcl 19-128 set ref 314* 336 337* 337 383* 384* 384 396 397* 397 416 418* 418 522 523* 523 555 556* 556 574 576* 576 609 614* 614 cobol_$perform_list_ptr 000312 external static pointer dcl 19-36 ref 157 159 161 165 166 167 cobol_$priority_no 000324 external static fixed bin(17,0) dcl 19-140 ref 126 cobol_$seg_init_list_ptr 000314 external static pointer dcl 19-40 ref 123 126 129 132 cobol_$temp_token_ptr 000316 external static pointer dcl 19-44 set ref 715 715 722 722 722* 722 722 722 725 725 726* 726 726 726 727 727 728* 728 728 728 cobol_$text_wd_off 000320 external static fixed bin(17,0) dcl 19-90 set ref 195 197 206 314 317 331 344 346* 350 365 366 372 383* 434* 465 467* 527 529 592 595* 620 624* 697 699* 708 783 789 790 791 792 818* cobol_add_gen 000240 constant entry external dcl 2-293 ref 644 cobol_addr 000242 constant entry external dcl 2-293 ref 192 203 238 239 299 355 357 422 427 579 583 704 768 775 cobol_alloc$cobol_data 000244 constant entry external dcl 2-293 ref 228 419 577 cobol_alloc$stack 000246 constant entry external dcl 2-293 ref 519 cobol_arithop_gen 000250 constant entry external dcl 2-293 ref 828 cobol_compare_gen 000252 constant entry external dcl 2-293 ref 616 825 cobol_define_tag 000254 constant entry external dcl 2-293 ref 533 662 cobol_define_tag_nc 000256 constant entry external dcl 2-293 ref 346 383 434 467 595 624 699 792 818 cobol_emit 000260 constant entry external dcl 2-293 ref 194 205 276 279 305 330 340 342 364 371 431 464 526 532 587 590 623 695 707 777 cobol_equate_tag 000262 constant entry external dcl 2-293 ref 815 cobol_make_tagref 000264 constant entry external dcl 2-293 ref 195 197 206 314 317 331 344 350 365 366 372 465 527 592 697 708 783 789 790 791 cobol_make_type9$long_bin 000306 constant entry external dcl 2-312 ref 249 cobol_move_gen 000266 constant entry external dcl 2-293 ref 267 744 cobol_num_to_udts 000310 constant entry external dcl 2-313 ref 293 cobol_pointer_register$get 000270 constant entry external dcl 2-293 ref 525 cobol_pointer_register$priority 000272 constant entry external dcl 2-293 ref 795 cobol_process_error 000274 constant entry external dcl 2-293 ref 531 cobol_register$load 000276 constant entry external dcl 2-293 ref 184 201 229 354 404 562 762 cobol_reset_r$in_line 000300 constant entry external dcl 2-293 ref 200 207 353 377 436 598 cobol_set_gen 000302 constant entry external dcl 2-293 ref 656 752 code 1 based fixed bin(17,0) level 2 dcl 12-9 set ref 542* 606* 631* 674* 805* 830 830 834 834 844* code_ptr 000100 automatic pointer dcl 31 set ref 186* 189* 192 192 194* 231* 234* 238* 239 239 272 301 330* 407* 415* 422* 431* 565* 573* 579* 587* con_tag 000102 automatic fixed bin(17,0) array dcl 31 set ref 555* 592* 662* 672 count 000027 internal static structure level 1 dcl 2-58 set ref 238 238 355 355 422 422 579 579 768 768 d 11(05) based bit(2) level 2 packed packed unaligned dcl 6-16 ref 112 data_name based structure level 1 unaligned dcl 10-16 e 5 based fixed bin(17,0) level 2 in structure "end_stmt" dcl 6-16 in procedure "cobol_perform_gen" set ref 470 697* e 5 000070 internal static fixed bin(17,0) initial level 2 in structure "eos_token" dcl 2-183 in procedure "cobol_perform_gen" set ref 545* 612* 634* 677* end_stmt based structure level 1 unaligned dcl 6-16 eop_proc_no 000105 automatic fixed bin(17,0) dcl 31 set ref 154* 159 161 317* eos_ptr 000172 automatic pointer dcl 6-13 set ref 108* 109 112 697 699 eos_token 000070 internal static structure level 1 dcl 2-183 set ref 544 608 633 676 equate_tag 000056 internal static structure level 1 dcl 2-171 set ref 815 815 equated_tag 5 000056 internal static fixed bin(17,0) initial level 2 dcl 2-171 set ref 813* er_loc 000106 automatic fixed bin(17,0) dcl 31 set ref 529* 620 false_tag 000107 automatic fixed bin(17,0) dcl 31 set ref 393* 396* 417* 575* 672* 814 format_no 000110 automatic fixed bin(17,0) dcl 31 set ref 109* 157 168 h 6 000070 internal static fixed bin(17,0) initial level 2 in structure "eos_token" dcl 2-183 in procedure "cobol_perform_gen" set ref 610* 641* h 6 based fixed bin(17,0) level 2 in structure "end_stmt" dcl 6-16 in procedure "cobol_perform_gen" set ref 161 699* hi_lim 000127 automatic fixed bin(17,0) dcl 31 set ref 446* 664* 807 i 7 000070 internal static fixed bin(17,0) initial level 2 dcl 2-183 set ref 613* i_tag 000111 automatic fixed bin(17,0) dcl 31 set ref 416* 417 574* 575 792* id_tok_no 000112 automatic fixed bin(17,0) array dcl 31 set ref 478* 492* 503* 507 507 507 507 517 603 607 636 638 639 649 652 663 664 738 738 741 742 748 749 in_token based structure level 1 dcl 12-9 in_token_ptr parameter pointer dcl 12-7 ref 27 106 108 125 143 154 161 213 217 219 244 244 262 288 288 293 297 470 488 488 517 531 543 603 607 632 636 638 639 649 652 675 738 738 741 742 748 749 808 ind_ptr 000170 automatic pointer dcl 4-16 set ref 649* 650 651 651 index 000116 automatic fixed bin(17,0) dcl 31 set ref 126* 129 132* 157* 159 161 161* 161 165 166 167* 219* 220* 476* 478 479 483* 483 492 493 496* 496 506* 507 507 507 507* 516* 517* 547* 554* 555* 602* 603 607 636 638 639 649 652 662 663 664 670 672* 738 738 741 742 748 749 index_name based structure level 1 unaligned dcl 4-19 init_req_flag 000117 automatic fixed bin(17,0) dcl 31 set ref 118* 131* 186 194 195 197 231 330 331 350 405 431 563 587 763 787 init_tag 000120 automatic fixed bin(17,0) dcl 31 set ref 132* 197* 350* 791* input_struc 000036 internal static structure level 1 dcl 2-89 set ref 299 299 int_tag based structure level 1 unaligned dcl 18-16 int_tag_no 5 based fixed bin(17,0) array level 3 in structure "perform_list" dcl 13-6 in procedure "cobol_perform_gen" ref 167 int_tag_no 3 based fixed bin(17,0) array level 3 in structure "seg_init_list" dcl 3-7 in procedure "cobol_perform_gen" ref 132 integer 000121 automatic fixed bin(17,0) dcl 31 set ref 216* 219 220* 220 322 item_signed 21(25) based bit(1) level 2 packed packed unaligned dcl 10-16 ref 288 jndex 000122 automatic fixed bin(17,0) dcl 31 set ref 477* 478 484* 484 488 488 492 497* 497 500* 500 807* 808* keep_scanning 000162 automatic bit(1) packed unaligned dcl 97 set ref 479* 482* 487 493* key 4 based fixed bin(17,0) level 2 dcl 8-14 ref 488 line 1 based fixed bin(17,0) level 2 dcl 6-16 set ref 531* lit_ptr 000124 automatic pointer dcl 31 set ref 217* 220 lit_str based bit(9) array packed unaligned dcl 31 ref 220 literal 11 based char level 2 packed packed unaligned dcl 14-14 set ref 217 lo_lim 000126 automatic fixed bin(17,0) dcl 31 set ref 445* 663* 807 max 17 based fixed bin(17,0) level 2 dcl 4-19 set ref 651* 651 move_data_init 000230 internal static fixed bin(17,0) initial dcl 2-275 set ref 253 259* move_eos 000231 internal static structure level 1 unaligned dcl 2-277 set ref 257 move_in_token 000204 internal static pointer array dcl 2-274 set ref 251 move_token_ptr 000160 automatic pointer dcl 95 set ref 251* 256 257 258 262 264 267* n based fixed bin(17,0) level 2 in structure "seg_init_list" dcl 3-7 in procedure "cobol_perform_gen" ref 126 n based fixed bin(17,0) level 2 in structure "in_token" dcl 12-9 in procedure "cobol_perform_gen" set ref 106 258* 540* 605* 630* 673* 804* 821* 821 822 830* 841* n based fixed bin(17,0) level 2 in structure "perform_list" dcl 13-6 in procedure "cobol_perform_gen" ref 157 next_stmt_tag 000130 automatic fixed bin(17,0) dcl 31 set ref 167* 206* 366* 783* no_inst 000131 automatic fixed bin(17,0) dcl 31 set ref 763* 767* 777* 783 no_tokens 000132 automatic fixed bin(17,0) dcl 31 set ref 106* 108 161 440 446 470 503 null builtin function dcl 2-320 ref 123 192 192 194 194 195 195 197 197 203 203 205 205 206 206 238 238 239 239 248 256 276 276 279 279 292 299 299 305 305 314 314 317 317 330 330 331 331 340 340 342 342 344 344 350 350 355 355 357 357 364 364 365 365 366 366 371 371 372 372 422 422 427 427 431 431 464 464 465 465 526 526 527 527 532 532 579 579 583 583 587 587 590 590 592 592 623 623 695 695 697 697 704 704 707 707 708 708 717 717 768 768 775 775 777 777 783 783 789 789 790 790 791 791 numeric_lit based structure level 1 unaligned dcl 14-14 operand 4 000036 internal static structure level 2 dcl 2-89 out_line 000166 automatic bit(1) packed unaligned dcl 98 set ref 112* 114* 121 157 180 192 203 239 314 327 357 361 379 393 427 431 455 583 587 595 690 704 773 p1_token_ptr 000136 automatic pointer dcl 31 set ref 725* 729 834 839 p2_token_ptr 000140 automatic pointer dcl 31 set ref 727* 834 p_token_ptr 000134 automatic pointer dcl 31 set ref 540 542 543 544 605 606 607 608 616* 630 631 632 633 638 639 644* 650 652 656* 673 674 675 676 729* 741 742 744* 748 749 752* 804 805 821 821 822 822 825* 828* 830 830 830 834 834 834 834* 839* 841 844 perf 1 based structure array level 2 dcl 13-6 perform_bit 10 based bit(1) level 2 packed packed unaligned dcl 18-16 ref 810 perform_list based structure level 1 dcl 13-6 places 10 based fixed bin(17,0) level 2 dcl 14-14 ref 217 219 pn1_no 000146 automatic fixed bin(17,0) dcl 31 set ref 143* 195* 331* 365* 393 708* 789* 790* pn1_priority 000147 automatic fixed bin(17,0) dcl 31 set ref 125* 126 126 129 priority 10(09) based char(2) level 2 in structure "proc_ref" packed packed unaligned dcl 16-16 in procedure "cobol_perform_gen" ref 125 priority 2 based fixed bin(17,0) array level 3 in structure "seg_init_list" dcl 3-7 in procedure "cobol_perform_gen" ref 129 proc_num 12 based fixed bin(15,0) level 2 in structure "int_tag" dcl 18-16 in procedure "cobol_perform_gen" ref 813 818 818 proc_num 1 based fixed bin(17,0) array level 3 in structure "perform_list" dcl 13-6 in procedure "cobol_perform_gen" ref 159 161 proc_num 12 based fixed bin(17,0) level 2 in structure "proc_ref" dcl 16-16 in procedure "cobol_perform_gen" ref 143 154 proc_ref based structure level 1 unaligned dcl 16-16 ptr_register_request 000047 internal static structure level 1 dcl 2-137 set ref 525 525 register_request 000010 internal static structure level 1 dcl 2-4 set ref 184 184 201 201 229 229 354 354 404 404 562 562 762 762 rel builtin function dcl 2-320 ref 715 722 reserved_word based structure level 1 unaligned dcl 8-14 ret_inst 000174 internal static bit(18) initial array packed unaligned dcl 2-262 set ref 520* 521 532 532 s_tag 000142 automatic fixed bin(17,0) dcl 31 set ref 522* 527* 533* 609* 610 624* 644* seg 2 based structure array level 2 dcl 3-7 seg_init_list based structure level 1 dcl 3-7 seg_ovfl_error 000110 internal static structure level 1 dcl 2-201 set ref 717 717 segno 3 000021 internal static fixed bin(17,0) level 2 dcl 2-50 set ref 165* seq1 000131 internal static bit(18) initial array packed unaligned dcl 2-208 set ref 279 279 299 299 300* 301* 302 303* 305 305 307 seq2 000135 internal static bit(18) initial array packed unaligned dcl 2-214 set ref 186 231 340 340 342 342 464 464 695 695 seq2i 000141 internal static bit(18) initial array packed unaligned dcl 2-220 set ref 189 234 seq3 000146 internal static bit(18) initial array packed unaligned dcl 2-227 set ref 203 203 205 205 282* 307* 311* 322* 323* 355 355 356* 356 357 357 364 364 371 371 seq4 000155 internal static bit(18) initial array packed unaligned dcl 2-241 set ref 402* 407 415 427 427 561* 565 573 583 583 590 590 seq5 000161 internal static bit(18) initial array packed unaligned dcl 2-247 set ref 768 768 769* 769 775 775 777 777 seq6 000176 internal static bit(18) initial array packed unaligned dcl 2-265 set ref 619* 621* 623 623 seq8 000200 internal static bit(18) initial array packed unaligned dcl 2-269 set ref 704 704 707 707 sign_separate 21(26) based bit(1) level 2 packed packed unaligned dcl 10-16 ref 288 signal_ 000304 constant entry external dcl 2-293 ref 717 space_req 000143 automatic fixed bin(17,0) dcl 31 set ref 440* 504* 507 507* 715 726 728 stackoff 000144 automatic fixed bin(17,0) dcl 31 set ref 519* 520 618 substr builtin function dcl 2-320 set ref 220 273 275* 275 302 303* 303 322 520* 520 619* 619 621 722 szn_seq 000237 internal static bit(18) initial array packed unaligned dcl 2-285 set ref 272* 273 275* 276 276 282 target 000021 internal static structure level 1 dcl 2-50 set ref 192 192 203 203 239 239 357 357 427 427 583 583 704 704 775 775 target_a_offset 4 based fixed bin(24,0) array level 3 dcl 13-6 ref 166 target_a_segno 3 based fixed bin(17,0) array level 3 dcl 13-6 ref 165 temp 000145 automatic fixed bin(17,0) dcl 31 set ref 273* 275 302* 303 618* 619 620* 621 temp_chars 000150 automatic fixed bin(24,0) dcl 31 set ref 223* 226* 228* 242 379 temp_token_ptr defined pointer dcl 19-45 set ref 715 722 722* 722 725 726* 726 727 728* 728 temp_wk_ptr 000156 automatic pointer dcl 94 set ref 248* 249* 264 token_ptr 4 000036 internal static pointer initial level 3 in structure "input_struc" dcl 2-89 in procedure "cobol_perform_gen" set ref 292* 293* 297* token_ptr 2 based pointer array level 2 in structure "in_token" dcl 12-9 in procedure "cobol_perform_gen" set ref 108 125 143 154 161 213 217 219 244 244 256* 257* 262* 262 264* 288 288 293* 297 470 488 488 517 531 543* 543 544* 603 607* 607 608* 632* 632 633* 636 638* 638 639* 639 649 650* 652* 652 675* 675 676* 738 738 741* 741 742* 742 748* 748 749* 749 808 822* tra_inst 000171 internal static bit(18) initial array packed unaligned dcl 2-257 set ref 521* 526 526 true_path 10(01) based bit(1) level 2 packed packed unaligned dcl 18-16 ref 810 true_tag 6 000056 internal static fixed bin(17,0) initial level 2 dcl 2-171 set ref 814* type 3 based fixed bin(17,0) level 2 in structure "numeric_lit" dcl 14-14 in procedure "cobol_perform_gen" ref 213 type 000151 automatic fixed bin(17,0) dcl 31 in procedure "cobol_perform_gen" set ref 809* 810 823 type 3 based fixed bin(17,0) level 2 in structure "end_stmt" dcl 6-16 in procedure "cobol_perform_gen" ref 488 517 603 636 738 738 809 unspec builtin function dcl 2-320 set ref 125 275 303 322 520 613* 619 621 varying_ids 000152 automatic fixed bin(17,0) dcl 31 set ref 470* 479 493 503 506 516 547 554 602 verb 4 000070 internal static fixed bin(17,0) initial level 2 in structure "eos_token" dcl 2-183 in procedure "cobol_perform_gen" set ref 611* 642* 654* 743* 750* verb 4 based fixed bin(17,0) level 2 in structure "end_stmt" dcl 6-16 in procedure "cobol_perform_gen" ref 825 wk_ptr 000154 automatic pointer dcl 31 set ref 808* 809 810 810 813 818 818 822 825 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. allo1_max defined fixed bin(17,0) dcl 19-171 allo1_ptr defined pointer dcl 19-67 alter_flag defined fixed bin(17,0) dcl 19-135 alter_index defined fixed bin(17,0) dcl 19-153 alter_list_ptr defined pointer dcl 19-39 cd_cnt defined fixed bin(17,0) dcl 19-197 cobol_$allo1_max external static fixed bin(17,0) dcl 19-170 cobol_$allo1_ptr external static pointer dcl 19-66 cobol_$alter_flag external static fixed bin(17,0) dcl 19-134 cobol_$alter_index external static fixed bin(17,0) dcl 19-152 cobol_$alter_list_ptr external static pointer dcl 19-38 cobol_$cd_cnt external static fixed bin(17,0) dcl 19-196 cobol_$cobol_data_wd_off external static fixed bin(17,0) dcl 19-118 cobol_$coms_charcnt external static fixed bin(17,0) dcl 19-188 cobol_$coms_wdoff external static fixed bin(17,0) dcl 19-202 cobol_$con_end_ptr external static pointer dcl 19-10 cobol_$con_wd_off external static fixed bin(17,0) dcl 19-92 cobol_$cons_charcnt external static fixed bin(17,0) dcl 19-192 cobol_$constant_offset external static fixed bin(17,0) dcl 19-156 cobol_$data_init_flag external static fixed bin(17,0) dcl 19-130 cobol_$date_compiled_sw external static fixed bin(17,0) dcl 19-180 cobol_$debug_enable external static fixed bin(17,0) dcl 19-174 cobol_$def_base_ptr external static pointer dcl 19-12 cobol_$def_max external static fixed bin(17,0) dcl 19-96 cobol_$def_wd_off external static fixed bin(17,0) dcl 19-94 cobol_$diag_ptr external static pointer dcl 19-70 cobol_$eln_max external static fixed bin(17,0) dcl 19-172 cobol_$eln_ptr external static pointer dcl 19-68 cobol_$fixup_max external static fixed bin(17,0) dcl 19-164 cobol_$fixup_ptr external static pointer dcl 19-30 cobol_$fs_charcnt external static fixed bin(17,0) dcl 19-184 cobol_$fs_wdoff external static fixed bin(17,0) dcl 19-198 cobol_$include_cnt external static fixed bin(17,0) dcl 19-182 cobol_$include_info_ptr external static pointer dcl 19-86 cobol_$init_stack_off external static fixed bin(17,0) dcl 19-124 cobol_$initval_base_ptr external static pointer dcl 19-32 cobol_$initval_file_ptr external static pointer dcl 19-34 cobol_$initval_flag external static fixed bin(17,0) dcl 19-178 cobol_$link_base_ptr external static pointer dcl 19-14 cobol_$link_max external static fixed bin(17,0) dcl 19-100 cobol_$link_wd_off external static fixed bin(17,0) dcl 19-98 cobol_$list_off external static fixed bin(17,0) dcl 19-154 cobol_$list_ptr external static pointer dcl 19-64 cobol_$ls_charcnt external static fixed bin(17,0) dcl 19-190 cobol_$main_pcs_ptr external static pointer dcl 19-84 cobol_$map_data_max external static fixed bin(17,0) dcl 19-162 cobol_$map_data_ptr external static pointer dcl 19-54 cobol_$max_stack_off external static fixed bin(17,0) dcl 19-122 cobol_$minpral5_ptr external static pointer dcl 19-50 cobol_$misc_base_ptr external static pointer dcl 19-60 cobol_$misc_end_ptr external static pointer dcl 19-62 cobol_$misc_max external static fixed bin(17,0) dcl 19-158 cobol_$non_source_offset external static fixed bin(17,0) dcl 19-176 cobol_$ntbuf_ptr external static pointer dcl 19-82 cobol_$obj_seg_name external static char(32) dcl 19-208 cobol_$op_con_ptr external static pointer dcl 19-80 cobol_$para_eop_flag external static fixed bin(17,0) dcl 19-138 cobol_$pd_map_index external static fixed bin(17,0) dcl 19-116 cobol_$pd_map_max external static fixed bin(17,0) dcl 19-160 cobol_$pd_map_ptr external static pointer dcl 19-28 cobol_$pd_map_sw external static fixed bin(17,0) dcl 19-126 cobol_$perform_para_index external static fixed bin(17,0) dcl 19-148 cobol_$perform_sect_index external static fixed bin(17,0) dcl 19-150 cobol_$ptr_assumption_ind external static fixed bin(17,0) dcl 19-144 cobol_$ptr_status_ptr external static pointer dcl 19-56 cobol_$reg_assumption_ind external static fixed bin(17,0) dcl 19-146 cobol_$reg_status_ptr external static pointer dcl 19-58 cobol_$reloc_def_base_ptr external static pointer dcl 19-20 cobol_$reloc_def_max external static fixed bin(24,0) dcl 19-108 cobol_$reloc_link_base_ptr external static pointer dcl 19-22 cobol_$reloc_link_max external static fixed bin(24,0) dcl 19-110 cobol_$reloc_sym_base_ptr external static pointer dcl 19-24 cobol_$reloc_sym_max external static fixed bin(24,0) dcl 19-112 cobol_$reloc_text_base_ptr external static pointer dcl 19-18 cobol_$reloc_text_max external static fixed bin(24,0) dcl 19-106 cobol_$reloc_work_base_ptr external static pointer dcl 19-26 cobol_$reloc_work_max external static fixed bin(24,0) dcl 19-114 cobol_$reswd_ptr external static pointer dcl 19-78 cobol_$same_sort_merge_proc external static bit(1) dcl 19-214 cobol_$scratch_dir external static char(168) dcl 19-206 cobol_$sect_eop_flag external static fixed bin(17,0) dcl 19-136 cobol_$seg_init_flag external static fixed bin(17,0) dcl 19-132 cobol_$stack_off external static fixed bin(17,0) dcl 19-120 cobol_$statement_info_ptr external static pointer dcl 19-76 cobol_$sym_base_ptr external static pointer dcl 19-16 cobol_$sym_max external static fixed bin(17,0) dcl 19-104 cobol_$sym_wd_off external static fixed bin(17,0) dcl 19-102 cobol_$tag_table_max external static fixed bin(17,0) dcl 19-166 cobol_$tag_table_ptr external static pointer dcl 19-52 cobol_$temp_token_area_ptr external static pointer dcl 19-42 cobol_$temp_token_max external static fixed bin(17,0) dcl 19-168 cobol_$text_base_ptr external static pointer dcl 19-8 cobol_$token_block1_ptr external static pointer dcl 19-46 cobol_$token_block2_ptr external static pointer dcl 19-48 cobol_$value_cnt external static fixed bin(17,0) dcl 19-194 cobol_$ws_charcnt external static fixed bin(17,0) dcl 19-186 cobol_$ws_wdoff external static fixed bin(17,0) dcl 19-200 cobol_$xref_bypass external static bit(1) dcl 19-212 cobol_$xref_chain_ptr external static pointer dcl 19-74 cobol_$xref_token_ptr external static pointer dcl 19-72 cobol_data_wd_off defined fixed bin(17,0) dcl 19-119 compile_count defined fixed bin(17,0) dcl 19-143 coms_charcnt defined fixed bin(17,0) dcl 19-189 coms_wdoff defined fixed bin(17,0) dcl 19-203 con_end_ptr defined pointer dcl 19-11 con_wd_off defined fixed bin(17,0) dcl 19-93 cons_charcnt defined fixed bin(17,0) dcl 19-193 constant_offset defined fixed bin(17,0) dcl 19-157 data_init_flag defined fixed bin(17,0) dcl 19-131 date_compiled_sw defined fixed bin(17,0) dcl 19-181 debug_enable defined fixed bin(17,0) dcl 19-175 def_base_ptr defined pointer dcl 19-13 def_max defined fixed bin(17,0) dcl 19-97 def_wd_off defined fixed bin(17,0) dcl 19-95 diag_ptr defined pointer dcl 19-71 dn_ptr automatic pointer dcl 96 eln_max defined fixed bin(17,0) dcl 19-173 eln_ptr defined pointer dcl 19-69 fixup_max defined fixed bin(17,0) dcl 19-165 fixup_ptr defined pointer dcl 19-31 fs_charcnt defined fixed bin(17,0) dcl 19-185 fs_wdoff defined fixed bin(17,0) dcl 19-199 include_cnt defined fixed bin(17,0) dcl 19-183 include_info_ptr defined pointer dcl 19-87 init_stack_off defined fixed bin(17,0) dcl 19-125 initval_base_ptr defined pointer dcl 19-33 initval_file_ptr defined pointer dcl 19-35 initval_flag defined fixed bin(17,0) dcl 19-179 link_base_ptr defined pointer dcl 19-15 link_max defined fixed bin(17,0) dcl 19-101 link_wd_off defined fixed bin(17,0) dcl 19-99 list_off defined fixed bin(17,0) dcl 19-155 list_ptr defined pointer dcl 19-65 ls_charcnt defined fixed bin(17,0) dcl 19-191 main_pcs_ptr defined pointer dcl 19-85 map_data_max defined fixed bin(17,0) dcl 19-163 map_data_ptr defined pointer dcl 19-55 max_stack_off defined fixed bin(17,0) dcl 19-123 minpral5_ptr defined pointer dcl 19-51 misc_base_ptr defined pointer dcl 19-61 misc_end_ptr defined pointer dcl 19-63 misc_max defined fixed bin(17,0) dcl 19-159 next_tag defined fixed bin(17,0) dcl 19-129 nlit_ptr automatic pointer dcl 14-11 non_source_offset defined fixed bin(17,0) dcl 19-177 ntbuf_ptr defined pointer dcl 19-83 obj_seg_name defined char(32) dcl 19-209 op_con_ptr defined pointer dcl 19-81 para_eop_flag defined fixed bin(17,0) dcl 19-139 pd_map_index defined fixed bin(17,0) dcl 19-117 pd_map_max defined fixed bin(17,0) dcl 19-161 pd_map_ptr defined pointer dcl 19-29 pd_map_sw defined fixed bin(17,0) dcl 19-127 perform_list_ptr defined pointer dcl 19-37 perform_para_index defined fixed bin(17,0) dcl 19-149 perform_sect_index defined fixed bin(17,0) dcl 19-151 priority_no defined fixed bin(17,0) dcl 19-141 proc_ref_ptr automatic pointer dcl 16-13 ptr_assumption_ind defined fixed bin(17,0) dcl 19-145 ptr_status_ptr defined pointer dcl 19-57 reg_assumption_ind defined fixed bin(17,0) dcl 19-147 reg_status_ptr defined pointer dcl 19-59 reloc_def_base_ptr defined pointer dcl 19-21 reloc_def_max defined fixed bin(24,0) dcl 19-109 reloc_link_base_ptr defined pointer dcl 19-23 reloc_link_max defined fixed bin(24,0) dcl 19-111 reloc_sym_base_ptr defined pointer dcl 19-25 reloc_sym_max defined fixed bin(24,0) dcl 19-113 reloc_text_base_ptr defined pointer dcl 19-19 reloc_text_max defined fixed bin(24,0) dcl 19-107 reloc_work_base_ptr defined pointer dcl 19-27 reloc_work_max defined fixed bin(24,0) dcl 19-115 reswd_ptr defined pointer dcl 19-79 rw_ptr automatic pointer dcl 8-11 same_sort_merge_proc defined bit(1) dcl 19-215 scratch_dir defined char(168) dcl 19-207 sect_eop_flag defined fixed bin(17,0) dcl 19-137 seg_init_flag defined fixed bin(17,0) dcl 19-133 seg_init_list_ptr defined pointer dcl 19-41 stack_off defined fixed bin(17,0) dcl 19-121 statement_info_ptr defined pointer dcl 19-77 sym_base_ptr defined pointer dcl 19-17 sym_max defined fixed bin(17,0) dcl 19-105 sym_wd_off defined fixed bin(17,0) dcl 19-103 tag_ptr automatic pointer dcl 18-13 tag_table_max defined fixed bin(17,0) dcl 19-167 tag_table_ptr defined pointer dcl 19-53 temp_token_area_ptr defined pointer dcl 19-43 temp_token_max defined fixed bin(17,0) dcl 19-169 text_base_ptr defined pointer dcl 19-9 text_wd_off defined fixed bin(17,0) dcl 19-91 token_block1_ptr defined pointer dcl 19-47 token_block2_ptr defined pointer dcl 19-49 value_cnt defined fixed bin(17,0) dcl 19-195 ws_charcnt defined fixed bin(17,0) dcl 19-187 ws_wdoff defined fixed bin(17,0) dcl 19-201 xref_bypass defined bit(1) dcl 19-213 xref_chain_ptr defined pointer dcl 19-75 xref_token_ptr defined pointer dcl 19-73 NAMES DECLARED BY EXPLICIT CONTEXT. cobol_perform_gen 000023 constant entry external dcl 27 def_L2 003312 constant entry internal dcl 460 ref 374 455 690 end_loop 002350 constant label dcl 540 ref 535 format 000000 constant label array(8) dcl 180 ref 157 168 get_token_space 003366 constant entry internal dcl 712 ref 441 512 init_var_id 003461 constant entry internal dcl 735 ref 548 679 next_step 000125 constant label dcl 143 ref 133 process_condition 004021 constant entry internal dcl 801 ref 448 666 reset_f_3_4 003551 constant entry internal dcl 759 ref 452 687 set_false_tag 003276 constant entry internal dcl 389 ref 410 568 signal_ovfl_error 003403 constant label dcl 717 ref 719 start 000030 constant label dcl 106 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 4542 5072 4171 4552 Length 6046 4171 330 740 351 230 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_perform_gen 266 external procedure is an external procedure. set_false_tag internal procedure shares stack frame of external procedure cobol_perform_gen. def_L2 internal procedure shares stack frame of external procedure cobol_perform_gen. get_token_space internal procedure shares stack frame of external procedure cobol_perform_gen. init_var_id internal procedure shares stack frame of external procedure cobol_perform_gen. reset_f_3_4 internal procedure shares stack frame of external procedure cobol_perform_gen. process_condition internal procedure shares stack frame of external procedure cobol_perform_gen. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 register_request cobol_perform_gen 000021 target cobol_perform_gen 000027 count cobol_perform_gen 000036 input_struc cobol_perform_gen 000047 ptr_register_request cobol_perform_gen 000056 equate_tag cobol_perform_gen 000070 eos_token cobol_perform_gen 000110 seg_ovfl_error cobol_perform_gen 000131 seq1 cobol_perform_gen 000135 seq2 cobol_perform_gen 000141 seq2i cobol_perform_gen 000146 seq3 cobol_perform_gen 000155 seq4 cobol_perform_gen 000161 seq5 cobol_perform_gen 000171 tra_inst cobol_perform_gen 000174 ret_inst cobol_perform_gen 000176 seq6 cobol_perform_gen 000200 seq8 cobol_perform_gen 000204 move_in_token cobol_perform_gen 000230 move_data_init cobol_perform_gen 000231 move_eos cobol_perform_gen 000237 szn_seq cobol_perform_gen STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_perform_gen 000100 code_ptr cobol_perform_gen 000102 con_tag cobol_perform_gen 000105 eop_proc_no cobol_perform_gen 000106 er_loc cobol_perform_gen 000107 false_tag cobol_perform_gen 000110 format_no cobol_perform_gen 000111 i_tag cobol_perform_gen 000112 id_tok_no cobol_perform_gen 000116 index cobol_perform_gen 000117 init_req_flag cobol_perform_gen 000120 init_tag cobol_perform_gen 000121 integer cobol_perform_gen 000122 jndex cobol_perform_gen 000124 lit_ptr cobol_perform_gen 000126 lo_lim cobol_perform_gen 000127 hi_lim cobol_perform_gen 000130 next_stmt_tag cobol_perform_gen 000131 no_inst cobol_perform_gen 000132 no_tokens cobol_perform_gen 000134 p_token_ptr cobol_perform_gen 000136 p1_token_ptr cobol_perform_gen 000140 p2_token_ptr cobol_perform_gen 000142 s_tag cobol_perform_gen 000143 space_req cobol_perform_gen 000144 stackoff cobol_perform_gen 000145 temp cobol_perform_gen 000146 pn1_no cobol_perform_gen 000147 pn1_priority cobol_perform_gen 000150 temp_chars cobol_perform_gen 000151 type cobol_perform_gen 000152 varying_ids cobol_perform_gen 000154 wk_ptr cobol_perform_gen 000156 temp_wk_ptr cobol_perform_gen 000160 move_token_ptr cobol_perform_gen 000162 keep_scanning cobol_perform_gen 000163 L1 cobol_perform_gen 000164 L2 cobol_perform_gen 000165 L3 cobol_perform_gen 000166 out_line cobol_perform_gen 000170 ind_ptr cobol_perform_gen 000172 eos_ptr cobol_perform_gen THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return_mac ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cobol_add_gen cobol_addr cobol_alloc$cobol_data cobol_alloc$stack cobol_arithop_gen cobol_compare_gen cobol_define_tag cobol_define_tag_nc cobol_emit cobol_equate_tag cobol_make_tagref cobol_make_type9$long_bin cobol_move_gen cobol_num_to_udts cobol_pointer_register$get cobol_pointer_register$priority cobol_process_error cobol_register$load cobol_reset_r$in_line cobol_set_gen signal_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cobol_$compile_count cobol_$next_tag cobol_$perform_list_ptr cobol_$priority_no cobol_$seg_init_list_ptr cobol_$temp_token_ptr cobol_$text_wd_off LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 27 000020 106 000030 108 000034 109 000040 112 000044 114 000052 118 000053 121 000055 123 000057 125 000063 126 000071 129 000105 131 000115 132 000117 133 000122 136 000123 143 000125 154 000134 157 000140 159 000155 161 000165 165 000203 166 000210 167 000212 168 000217 171 000221 180 000223 184 000225 186 000236 189 000245 192 000250 194 000273 195 000313 197 000333 200 000356 201 000363 203 000374 205 000417 206 000440 207 000460 209 000465 213 000466 216 000475 217 000476 219 000500 220 000512 221 000527 223 000531 224 000533 226 000534 228 000536 229 000553 231 000564 234 000573 236 000576 238 000601 239 000617 242 000643 244 000646 248 000655 249 000657 251 000677 253 000702 256 000705 257 000707 258 000711 259 000713 262 000715 264 000722 267 000724 272 000732 273 000737 275 000744 276 000751 279 000771 282 001012 284 001015 288 001016 292 001024 293 001027 295 001041 297 001042 299 001044 300 001065 301 001070 302 001074 303 001101 305 001106 307 001126 311 001131 314 001133 317 001155 319 001174 322 001175 323 001201 327 001203 330 001205 331 001225 334 001245 336 001246 337 001251 340 001252 342 001272 344 001313 346 001333 350 001344 353 001367 354 001374 355 001405 356 001426 357 001431 361 001453 364 001455 365 001476 366 001516 369 001536 371 001537 372 001560 374 001600 377 001601 379 001606 383 001613 384 001624 387 001626 402 001627 404 001632 405 001642 407 001645 410 001650 412 001651 415 001652 416 001655 417 001657 418 001660 419 001661 420 001677 422 001703 427 001721 431 001744 434 001767 436 002000 440 002005 441 002011 445 002012 446 002014 448 002017 452 002020 455 002021 458 002024 470 002025 476 002035 477 002037 478 002041 479 002043 482 002050 483 002052 484 002053 487 002055 488 002060 492 002075 493 002101 496 002106 497 002107 499 002111 500 002112 501 002113 503 002114 504 002120 506 002121 507 002127 510 002142 512 002145 516 002146 517 002155 519 002166 520 002205 521 002213 522 002215 523 002217 525 002220 526 002230 527 002251 529 002271 531 002274 532 002315 533 002336 535 002345 538 002346 540 002350 542 002352 543 002354 544 002361 545 002364 547 002366 548 002375 549 002376 554 002400 555 002407 556 002413 557 002414 561 002416 562 002421 563 002431 565 002434 568 002437 570 002440 573 002441 574 002444 575 002446 576 002447 577 002450 578 002466 579 002472 583 002510 587 002533 590 002556 592 002577 595 002617 598 002632 602 002637 603 002645 605 002657 606 002661 607 002663 608 002664 609 002667 610 002671 611 002672 612 002674 613 002676 614 002700 616 002701 618 002707 619 002712 620 002720 621 002724 623 002727 624 002747 630 002760 631 002762 632 002764 633 002771 634 002774 635 002776 636 002777 638 003006 639 003012 640 003020 641 003021 642 003023 644 003025 646 003035 649 003036 650 003037 651 003040 652 003041 653 003046 654 003050 656 003052 662 003060 663 003070 664 003074 666 003077 670 003100 672 003103 673 003105 674 003107 675 003111 676 003116 677 003121 679 003123 683 003124 687 003127 690 003130 693 003133 695 003134 697 003155 699 003176 702 003210 704 003211 707 003234 708 003255 710 003275 389 003276 393 003277 396 003304 397 003310 400 003311 460 003312 464 003313 465 003334 467 003354 469 003365 712 003366 715 003367 717 003403 719 003433 722 003434 725 003443 726 003446 727 003451 728 003454 729 003456 731 003460 735 003461 738 003462 741 003503 742 003505 743 003513 744 003516 745 003524 748 003525 749 003527 750 003536 751 003541 752 003542 755 003550 759 003551 762 003552 763 003563 767 003571 768 003573 769 003614 773 003617 775 003621 777 003642 783 003661 787 003701 789 003704 790 003724 791 003744 792 003764 795 004000 797 004020 801 004021 804 004022 805 004023 807 004025 808 004035 809 004043 810 004045 813 004056 814 004061 815 004063 816 004073 818 004074 821 004110 822 004111 823 004114 825 004117 828 004132 830 004141 834 004146 839 004160 841 004162 844 004163 849 004165 851 004167 ----------------------------------------------------------- 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