COMPILATION LISTING OF SEGMENT cobol_compute_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 0936.4 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_compute_gen.pl1 Added Trace statements. 19* END HISTORY COMMENTS */ 20 21 22 /* Modified on 10/19/84 by FCH, [4.3-1], BUG563(phx18381), new cobol_addr_tokens.incl.pl1 */ 23 /* Modified on 04/18/80 by FCH, new include file cobol_arith_util, fix not option */ 24 /* Modified on 06/28/79 by FCH, [4.0-1], not option added for debug */ 25 /* Modified since Version 4.0 */ 26 27 /*{*/ 28 /* format: style3 */ 29 cobol_compute_gen: 30 proc (in_token_ptr, next_stmt_tag); 31 32 /* The compute generator: cobol_compute_gen 33* 34*FUNCTION 35* 36*The function of this procedure is to generate code that 37* 1. performs the of the arithmetic 38* expression to be computed. 39* 2. assigns the result of the computation into the data 40* items to receive the result. 41* 3. checks for size errors during the evaluation of the 42* arithmetic expression. 43* 4. checks for size errors during the assigning of the 44* result to the receiving data items. 45* 46**/ 47 48 /* DEFINITION OF THE PARAMETERS */ 49 50 /* dcl in_token_ptr ptr; */ 51 dcl next_stmt_tag fixed bin; 52 53 /* DESCRIPTION OF THE PARAMETERS */ 54 55 /* 56* 57*PARAMETER DESCRIPTION 58* 59* 60*in_token_ptr Points to the in_token structure, which 61* contains information describing the compute 62* statement for which code is to be generated. 63* (input) See description below under INPUT for details. 64* NOTE: This parameter is actually declared in 65* an include file following the executable 66* statements of this procedure. 67*next_stmt_tag Contains a compiler generated tag number (label) 68* to be associated with the Cobol statement 69* following the compute statement for which 70* this procedure was called. (output) 71* See discussion below under OUTPUT for details. 72* 73* 74*INPUT 75* 76*The input to this procedure is a structure, which is defined by a 77*declaration of the following format: 78* 79*dcl 1 in_token based (in_token_ptr), 80* 2 n fixed bin, 81* 2 code fixed bin, 82* 2 token_ptr ( 0 refer (in_token.n)) ptr; 83* 84* where: 85* 86* in_token.n contains the number of entries in the 87* token_ptr array. 88* 89* token_ptr(1) contains a pointer to a reserved word token 90* (type 1) for the reserved word COMPUTE. This pointer is 91* not used by this procedure. 92* 93*token_ptr(n) contains a pointer to an EOS (type 19) token. The 94* type 19 token contains some information that is very 95* meaningful to this procedure. 96* 97* 1. end_stmt.verb contains the code for the 98* reserved word COMPUTE. 99* 100* 2. end_stmt.e contains a count of the number 101* of data items that are to receive the result of the 102* computation. 103* 104* 3. end_stmt.b is set to "1"b if the compute 105* statement contained an ON SIZE ERROR 106* clause. 107* 108* token_ptr(2) through token_ptr(n-1) point to tokens 109* that describe: 110* 111* 1. the data items that are to receive the 112* result of the computation. (all are data name 113* (type 9) tokens) 114* 115* 2. the tokens for the operands to be used in 116* evaluating the arithmetic expression. These 117* tokens can be data name (type 9) tokens, numeric 118* literal (type 2) tokens, or the figurative 119* constant ZERO (type 1) token. 120* 121* 3. the tokens that describe the arithmetic 122* operators to be used in evaluating the 123* arithmetic expression. These tokens are EOS 124* tokens (type 19). The contents of the field 125* end_stme.e in these type 19 tokens specifies 126* the operator. 127* 128* 129* end_stmt.e | operator 130* --------------------------------------------- 131* 182 | + (binary plus) 132* 183 | - (binary minus) 133* 184 | * (multiply) 134* 185 | / (divide) 135* 186 | ** (exponentiate) 136* 187 | - (unary minus) 137* 138* 139*The data name tokens, and EOS tokens that specify operators, 140*are arranged in trailing polish notation in the token_ptr 141*array. That is, each operator follows the operand (for unary operators) 142*or the two operands (for binary operators) to which it applies. 143* 144*OUTPUT 145* 146*The second parameter passed to cobol_compute_gen is an output para- 147*meter. A value is returned to the calling program 148*(cobol_gen_driver_) only for those compute statements that have on 149*size error clauses. 150* 151*If an on size error clause is specified, then, in addition to 152*the code that evaluates the arithmetic expression, and assigns 153*it to the receiving data items, cobol_compute_gen must also generate 154*code that checks for size error conditions. If a size error is 155*detected by the execution of the generated code, then the 156*imperative statement in the COMPUTE statement is executed, otherwise 157*the imperative statement is skipped. The cobol_compute_gen 158*generator, however, when generating code to skip over the imperative 159*statmeent to the next statement, does not know anything about 160*the next statement. This situation is handled as follows: 161* 162* 1. cobol_compute_gen reserves a tag for the next Cobol 163* statement. 164* 2. any transfers to the next statement reference 165* the tag reserved by cobol_compute_gen. This tag is not yet 166* defined. (associated with an instruction location in 167* the text segment) 168* 3. after generation of code for a compute statement is 169* completed, cobol_compute_gen passes the next statement tag 170* back to its caller, cobol_gen_driver_, in the second 171* parameter. 172* 4. when cobol_gen_driver_ detects the end of the imperative 173* statement, the tag, reserved by cobol_compute_gen, is 174* defined. 175* 176* 177*IMPLEMENTATION DETAILS 178* 179*1. Computing the Result of the Arithmetic Expression 180* 181*The input structure contains, in its array of pointers, pointers 182*to tokens that represent the compute statement. The first meaningful 183*pointer is contained in token_ptr(2) (because token_ptr(1) points to the 184*reserved word token for compute), and the last meaningful pointer is 185*contained in token_ptr(n-1) (because token_ptr(n) points to an 186*EOS token). Processing to evaluate the result of the 187*expression is done as follows. 188* 189* 1. Starting at the token pointed at by token_ptr(2) , and 190* proceeding through token_ptr(n-1), the tokens pointed at are scanned. 191* 192* 2. Each token that is not an EOS token has a pointer to 193* it pushed into a LIFO stack, referred to here as the 194* operand stack. 195* 196* 3. Each time an EOS token is detected, it is an operator, 197* and code is generated. The type of processing done 198* to generate code depends on the operator: 199* 200* a. For a unary operator, the code is generated 201* to perform the operation using the token pointed 202* at by the top entry of the operand stack. A 203* pointer to the data name token that describes 204* the result of the operation replaces the top 205* entry of the operand stack. 206* 207* b. For a binary operator, code is generated 208* to perform the operation on the two tokens 209* pointed at by the two top entries on the 210* operand stack. The top entry on the operand stack 211* is then removed (popped!), and a pointer to 212* the data name token that describes the result 213* of the operation replaces the current top 214* entry of the operand stack. 215* 216*Generation of code is accomplished by calls to arithmetic subgenerators. 217*The subgenerators called for each operation are given in the 218*following table: 219* 220* ---------------------------------------------- 221* operation | subgenerator called 222* --------------------------------------------- 223* unary minus | cobol_arithop_gen 224* addition | cobol_add3 225* subtraction | cobol_add3 226* multiplication | cobol_mpy3 227* division | cobol_mpy3 228* exponentiation | cobol_exp3 229* 230*At the completion of the scan of all of the tokens, the top 231*entry on the operand stack points to a token that describes the 232*result of the evaluation of the expression. The other entries 233*in the operand stack point to the tokens that describe the 234*receiving data items. 235* 236* 237*2. Assigning the Result of the Computation to the Receiving 238*Data Items. 239* 240*If no on size error checking was requested, then the move generator 241*is called to move the result to the receiving data items. 242* 243*If on size error checking was requested, processing is more 244*complicated. The data name (type 9) token for the result of the 245*computation contains the following information about the resultant value: 246* 247* 1. total length of the result, in digits. 248* 2 number of places to the left of the decimal point. 249* 3. number of places to the right of the decimal point. 250* 251*The data name tokens for the receiving data items contain the 252*same information. Therefore, it is possible , at compilation 253*time, to determine whether an overflow condition could occur when 254*assigning a result to a receiving data item. Processing for 255*assigning the result when on size error checking was requested 256*consists of the following sequence: 257* 258* 1. determine which receiving fields can contain the 259* result with no possibility of a size error. 260* 261* 2. call the move generator to move the result to all 262* receiving fields for which no on size error can occur. 263* 3. for each receiving field for which an on size error 264* could occur, the follwoing processing is done: 265* 266* a. generate code to move the current contents 267* of the receiving field to temporary storage 268* by calling the move generator. 269* b. generate code to move the result to the 270* receiving field. 271* c. generate code to test for an overflow 272* d. generate code which is executed only if 273* an overflow occurs. This code restores the 274* original value to the receiving field, and 275* sets a size error flag that indicates that 276* an overflow occurred. 277* 278* 4. After all code to move the result to receiving fields 279* has been generated, and if any overflow checking 280* code was generated, then generate a test of the size 281* error flag to determine if an overflow occurred, and 282* generate a transfer to the next cobol statement 283* if the size error flag is off. 284* 285**/ 286 287 288 /* DECLARATION OF EXTERNAL ENTRIES */ 289 290 291 292 dcl cobol_fofl_mask$on ext entry; 293 dcl cobol_fofl_mask$off ext entry; 294 dcl cobol_alloc$stack ext entry (fixed bin, fixed bin, fixed bin); 295 dcl cobol_emit ext entry (ptr, ptr, fixed bin); 296 dcl cobol_addr ext entry (ptr, ptr, ptr); 297 dcl cobol_make_type9$copy 298 ext entry (ptr, ptr); 299 dcl cobol_make_tagref ext entry (fixed bin, fixed bin, ptr); 300 dcl cobol_define_tag ext entry (fixed bin); 301 dcl ioa_$ioa_stream ext entry options (variable); 302 dcl cobol_add3 ext entry (ptr, ptr, ptr, fixed bin); 303 dcl cobol_mpy3 ext entry (ptr, ptr, ptr, fixed bin); 304 dcl cobol_exp3 ext entry (ptr, ptr, ptr, fixed bin); 305 dcl cobol_build_resop ext entry (ptr, ptr, fixed bin, ptr, bit (1), fixed bin, bit (1)); 306 dcl cobol_arithop_gen ext entry (ptr); 307 dcl cobol_arith_move_gen 308 ext entry (ptr); 309 dcl cobol_move_gen ext entry (ptr); 310 dcl cobol_compare_gen ext entry (ptr); 311 dcl cobol_register$load ext entry (ptr); 312 dcl cobol_make_type9$fixed_bin_35 313 ext entry (ptr, fixed bin, fixed bin); 314 dcl cobol_binary_check$compute 315 ext entry (ptr, bit (1), fixed bin, fixed bin); 316 dcl cobol_compute_bin_gen 317 ext entry (ptr, fixed bin, fixed bin, fixed bin); 318 319 /* DECLARATION OF INTERNAL STATIC VARIABLES */ 320 321 /* Declaration of internal static initialized variables that define opcodes used in code generated by this proc */ 322 323 324 dcl stz_op bit (10) int static init ("1001010000"b /*450(0)*/); 325 dcl tov_op bit (10) int static init ("1100011110"b /*617(0)*/); 326 dcl tra_op bit (10) int static init ("1110010000"b /*710(0)*/); 327 dcl aos_op bit (10) int static init ("0001011000"b /*054(0)*/); 328 dcl lda_op bit (10) int static init ("0100111010"b /*235(0)*/); 329 dcl ldq_op bit (10) int static init ("0100111100"b /*236(0)*/); 330 dcl tze_op bit (10) int static init ("1100000000"b /*600(0)*/); 331 332 /* Internal static variables used to define codes for operators that appear in the EOS tokens. */ 333 334 dcl plus_op fixed bin int static init (182); 335 dcl minus_op fixed bin int static init (183); 336 dcl multiply_op fixed bin int static init (184); 337 dcl divide_op fixed bin int static init (185); 338 dcl exponentiate_op fixed bin int static init (186); 339 dcl unary_minus_op fixed bin int static init (187); 340 341 /* Declaration of an initialized variable that defines the first meaningful subscript of the 342* in_token.token_ptr array from the point of view of this procedure. */ 343 344 dcl first_meaningful_ptr_index 345 fixed bin int static init (2); 346 347 /* Declaration of an EOS token used in calls to the move generator */ 348 349 dcl 1 move_eos int static, 350 2 size fixed bin (15) init (38), 351 2 line fixed bin (15) init (0), 352 2 column fixed bin init (0), 353 2 type fixed bin (15) init (19), 354 2 verb fixed bin (15) init (18), /* MOVE */ 355 2 e fixed bin (15) init (0), 356 2 h fixed bin (15) init (0), 357 2 i fixed bin (15) init (0), 358 2 j fixed bin (15) init (0), 359 2 a bit (16) init ("0"b); 360 361 362 363 /* DECLARATION OF AN IMAGE OF A NUMERIC LITERAL ZERO */ 364 365 dcl 1 numeric_zero internal static, 366 2 size fixed bin (15) init (37), 367 2 line fixed bin (15) init (0), 368 2 column fixed bin (15) init (0), 369 2 type fixed bin (15) init (2), 370 2 integral bit (1) init ("1"b), 371 2 floating bit (1) init ("0"b), 372 2 filler1 bit (5) init ("00000"b), 373 2 sign char (1) init (" "), 374 2 exp_sign char (1) init (" "), 375 2 exp_places fixed bin (15) init (0), 376 2 places_left fixed bin (15) init (1), 377 2 places_right fixed bin (15) init (0), 378 2 places fixed bin (15) init (1), 379 2 literal char (1) init ("0"); 380 381 382 /* Declaration of an EOS token used in calls to the compare generator */ 383 384 dcl 1 compare_eos int static, 385 2 size fixed bin (15) init (38), 386 2 line fixed bin (15) init (0), 387 2 column fixed bin (15) init (0), 388 2 type fixed bin (15) init (19), /* EOS */ 389 2 verb fixed bin (15) init (0), 390 2 e fixed bin (15) init (102), /* EQUAL COMPARE */ 391 2 h fixed bin (15) init (0), 392 2 i fixed bin (15) init (0), 393 2 j fixed bin (15) init (0), 394 2 a bit (16) init ("0"b); 395 396 397 /* DECLARATION OF INTERNAL AUTOMATIC VARIABLES */ 398 399 /* Structure used to communicate with the cobol_register procedure. */ 400 401 dcl 1 register_struc, 402 2 what_reg fixed bin, 403 2 reg_no bit (4), 404 2 lock fixed bin, 405 2 already_there fixed bin, 406 2 contains fixed bin, 407 2 dname_ptr ptr, 408 2 literal bit (36); 409 410 411 dcl operand_stack (1:100) ptr; /* the operand stack */ 412 413 dcl move_eos_ptr ptr; 414 dcl compare_eos_ptr ptr; 415 dcl top fixed bin; 416 417 418 dcl work_buff (1:100) ptr; 419 dcl work_ptr ptr; 420 421 dcl ix fixed bin; 422 dcl operand1_ptr ptr; 423 dcl operand2_ptr ptr; 424 dcl rdmax_flag bit (1); 425 dcl rdmax_value fixed bin; 426 dcl possible_ovfl_flag bit (1); 427 dcl gen_code fixed bin; 428 dcl resultant_operand_ptr 429 ptr; 430 431 dcl move_in_token (1:100) ptr; 432 dcl receive_count fixed bin; 433 dcl ose_flag bit (1); 434 dcl rdtemp fixed bin; 435 dcl iy fixed bin; 436 dcl save_in_token_ptr ptr; 437 dcl imperative_stmt_tag fixed bin; 438 439 dcl resod_ld fixed bin; 440 dcl multiple_move_count fixed bin; 441 dcl ret_offset fixed bin; 442 443 dcl size_error_inst_word 444 bit (36); 445 dcl size_error_inst_ptr ptr; 446 dcl size_error_flag_ptr ptr; 447 448 dcl temp_save_ptr ptr; 449 dcl temp_inst_word bit (36); 450 dcl temp_inst_ptr ptr; 451 dcl no_overflow_tag fixed bin; 452 dcl input_buffer (1:20) fixed bin; 453 dcl reloc_buffer (1:10) bit (10) aligned; 454 dcl inst_buffer (1:10) fixed bin; 455 dcl overflow_possible bit (1); 456 dcl save_locno fixed bin; 457 dcl size_error_inst bit (36); 458 dcl size_error_token_ptr 459 ptr; 460 dcl stored_token_ptr ptr; 461 462 dcl receiving_is_not_stored 463 bit (1); 464 dcl (binary_ok, not_bit) 465 bit (1); 466 dcl target_code fixed bin; 467 dcl source_code fixed bin; 468 469 dcl dn_ptr ptr; 470 471 472 /*}*/ 473 474 475 /**************************************************/ 476 start: /* Check to see if binary arithmetic can be done for this compute statement. */ 477 call cobol_binary_check$compute (in_token_ptr, binary_ok, target_code, source_code); 478 479 /* This code is used only to clean the warning message */ 480 if "0"b 481 then if not_dec_operand (null ()) 482 then ; 483 484 if binary_ok 485 then do; /* Binary airthmetic can be done. */ 486 call cobol_compute_bin_gen (in_token_ptr, next_stmt_tag, target_code, source_code); 487 return; 488 end; /* Binary arithmetic can be done. */ 489 490 491 /* Save the input pointer */ 492 493 save_in_token_ptr = in_token_ptr; 494 495 top = 0; 496 work_ptr = addr (work_buff (1)); 497 498 499 500 /* Determine the number of receiving operands */ 501 eos_ptr = in_token.token_ptr (in_token.n); 502 receive_count = end_stmt.e; 503 504 /* Get the on size error flag */ 505 ose_flag = end_stmt.b; 506 if ose_flag 507 then do; /* Reserve two tags for on size error processing. */ 508 imperative_stmt_tag = cobol_$next_tag; 509 next_stmt_tag = cobol_$next_tag + 1; 510 cobol_$next_tag = cobol_$next_tag + 2; 511 512 513 end; /* Reserve two tags for on size error processing */ 514 else imperative_stmt_tag = 0; /* No on size error clause present in the compute statement. */ 515 516 /* Determine the maximum number of right digits required for any receiving operand */ 517 518 rdmax_value = 0; 519 rdmax_flag = "1"b; 520 521 do ix = first_meaningful_ptr_index to first_meaningful_ptr_index + receive_count - 1; 522 523 rdtemp = in_token.token_ptr (ix) -> data_name.places_right; 524 525 if in_token.token_ptr (ix) -> data_name.rounded 526 then rdtemp = rdtemp + 1; /* ROUNDED */ 527 528 if rdtemp > rdmax_value 529 then rdmax_value = rdtemp; 530 531 end; /* Get maximum rdmax value */ 532 do ix = first_meaningful_ptr_index to in_token.n - 1; 533 /* compute the result */ 534 535 eos_ptr = in_token.token_ptr (ix); 536 537 if end_stmt.type ^= rtc_eos 538 then do; /* Not an operator, must be an operand */ 539 540 /* Stack the pointer to the operand in the operand stack */ 541 top = top + 1; 542 operand_stack (top) = eos_ptr; 543 544 end; /* Not an operator, must be an operand */ 545 546 else do; /* An operator, perform a computation */ 547 548 if end_stmt.e = unary_minus_op 549 then do; /* Unary minus */ 550 work_ptr -> in_token.n = 2; 551 work_ptr -> in_token.code = 0; 552 work_ptr -> in_token.token_ptr (1) = operand_stack (top); 553 /* operand */ 554 work_ptr -> in_token.token_ptr (2) = eos_ptr; 555 /* Unary minus */ 556 call cobol_arithop_gen (work_ptr); 557 /* Perform negation */ 558 559 /* Replace the top operand entry on the operand stack with the 560* resultant operand */ 561 562 563 operand_stack (top) = work_ptr -> in_token.token_ptr (work_ptr -> in_token.code); 564 565 566 end; /* Unary minus */ 567 568 else do; /* Binary operator */ 569 570 operand1_ptr = operand_stack (top - 1); 571 /* left operand */ 572 operand2_ptr = operand_stack (top); 573 /* right operand */ 574 575 /* Build the resultant operand for the computation */ 576 call cobol_build_resop (operand1_ptr, operand2_ptr, bin (end_stmt.e, 17), 577 resultant_operand_ptr, rdmax_flag, rdmax_value, possible_ovfl_flag); 578 579 580 top = top - 1; /* Set subscript of resultant operand after computation */ 581 if end_stmt.e = plus_op | end_stmt.e = minus_op 582 then do; /* plus or minus operator */ 583 584 if end_stmt.e = plus_op 585 then call cobol_add3 (operand1_ptr, operand2_ptr, resultant_operand_ptr, 586 1 /*add*/); 587 588 else call cobol_add3 (operand2_ptr, operand1_ptr, resultant_operand_ptr, 589 2 /*subtract*/); 590 591 end; /* plus or minus operator */ 592 593 else if end_stmt.e = multiply_op | end_stmt.e = divide_op 594 then do; /* multiply or divide operator */ 595 596 if end_stmt.e = multiply_op 597 then gen_code = 1; 598 /* multiply */ 599 else do; /* divide */ 600 gen_code = 2; 601 if ose_flag 602 then call divide_check; 603 /* generate code 604* to test whether divisor is zero */ 605 end; /* divide */ 606 /* Here, reverse the operands, since for division, operand2_ptr 607* points to the divisor, and operand1_ptr points to the dividend. 608* Reversing the operands for multiplication has no effect, since 609* multiplication is commutative. */ 610 611 612 613 call cobol_mpy3 (operand2_ptr, operand1_ptr, resultant_operand_ptr, gen_code) 614 ; 615 end; /* multiply or divide operator */ 616 617 else /* ASSUME EXPONENTIATE */ 618 call cobol_exp3 (operand1_ptr, operand2_ptr, resultant_operand_ptr, 619 imperative_stmt_tag); 620 621 622 /* Replace the top operand entry on the operand stack with the 623* resultant operand */ 624 625 operand_stack (top) = resultant_operand_ptr; 626 627 end; /* Binary operator */ 628 629 630 631 632 end; /* An operator, perform a computation */ 633 634 end; /* compute the result */ 635 636 /* At this point, the following coonditions are true: 637* 638* 1. The top entry in the operand stack points to a token that describes the result of 639* the computation. 640* 2. All other entries in the operand stack point to tokens for receiving fields, 641* into which the result must be moved. 642* 3. The field end_stmt.e of the EOS token for compute (end_stmt.verb = 40) 643* contains the number of receiving field. 644**/ 645 646 647 648 if ^ose_flag 649 then do; /* No on size error checking, generate code to move the result to 650* the receiving field(s). */ 651 652 /* Base in_token template on the move in_token buffer */ 653 in_token_ptr = addr (move_in_token); 654 655 /* Set in_token.token_ptr(1) to point to the type 1 token for COMPUTE. This 656* is necessary to provide line number and column number for the compute stmt 657* to the MOVE generator procedure. */ 658 659 in_token.token_ptr (1) = save_in_token_ptr -> in_token.token_ptr (1); 660 661 662 in_token.n = 4; 663 664 665 /* Set the number of receiving fields into the move EOS. */ 666 move_eos_ptr = addr (move_eos); 667 move_eos_ptr -> end_stmt.e = 1; 668 in_token.token_ptr (4) = move_eos_ptr; 669 670 iy = 1; 671 672 do ix = 1 to receive_count; /* Generate code to move the result to each receiving field. */ 673 674 675 in_token.token_ptr (2) = operand_stack (top); 676 /* Result of computation. */ 677 in_token.token_ptr (3) = operand_stack (iy); 678 iy = iy + 1; 679 680 /* Call the arithmetic move generator to do a brute force move in an attempt 681* to force fixedoverflow. */ 682 call cobol_arith_move_gen (in_token_ptr); 683 684 /* On return from cobol_arith_move_gen, if the receiving field was a numeric 685* edited, then the result has been stored into a numeric in an attempt to 686* force fixedoverflow, and the in_token structure has been modified so that 687* if cobol_move_gen is now called, the temp value will be moved into the 688* numeric edited field. */ 689 690 if in_token.code ^= 0 /* Receiving field is numeric edited. */ 691 then call cobol_move_gen (in_token_ptr); 692 693 end; /* Generate code to move the result to each receiving field. */ 694 695 end; /* no on size error checking, generate code to move the result to 696* the receiving field(s) */ 697 698 699 else do; /* On size error checking requested, do it and move result to receiving */ 700 701 resultant_operand_ptr = operand_stack (top); 702 overflow_possible = "0"b; 703 704 in_token_ptr = addr (move_in_token); 705 in_token.n = first_meaningful_ptr_index + receive_count + 1; 706 707 708 /* Set in_token.token_ptr(1) to point to the type 1 token for COMPUTE. This 709* is necessary to provide line number and column number for the compute stmt 710* to the MOVE generator procedure. */ 711 712 in_token.token_ptr (1) = save_in_token_ptr -> in_token.token_ptr (1); 713 714 multiple_move_count = 0; 715 iy = first_meaningful_ptr_index + 1; /* Subscript of the element of in_token.token_ptr 716* array to receive the pointer to first receiving field */ 717 718 if (resultant_operand_ptr -> data_name.type ^= rtc_dataname) 719 | (resultant_operand_ptr -> data_name.type = rtc_dataname 720 & resultant_operand_ptr -> data_name.sign_type ^= "111"b /* FLOATING DECIMAL */) 721 then do; /* Result is not dataname (must be constant or ZERO) 722* or if dataname is not floating decimal. (If floating decimal, then 723* must unconditionally check for overflow!!) */ 724 /* That means that we must check to see if overflow can occur for any 725* of the receiving fields. */ 726 727 728 if resultant_operand_ptr -> data_name.type = rtc_dataname 729 then resod_ld = resultant_operand_ptr -> data_name.places_left; 730 731 else if resultant_operand_ptr -> data_name.type = rtc_numlit 732 then resod_ld = resultant_operand_ptr -> numeric_lit.places_left; 733 else resod_ld = 1; /* Result is fig const ZERO */ 734 735 736 do ix = 1 to receive_count; /* Check to see if on size error checking is necessary 737* for any receiving fields. */ 738 739 if operand_stack (ix) -> data_name.places_left >= resod_ld 740 then do; /* Receving field can hold the result of the computation 741* with no possibility of overflow. */ 742 743 multiple_move_count = multiple_move_count + 1; 744 745 /* Move pointer to the receivnig field into in_token array */ 746 in_token.token_ptr (iy) = operand_stack (ix); 747 iy = iy + 1; 748 749 /* set operand stack entry to null(), to indicate that it needs 750* no on size error checking */ 751 operand_stack (ix) = null (); 752 753 end; /* Receiving field can hold the result of the computation 754* with no possibility of overflow. */ 755 end; /* Check to see if on size error checking is necessary 756* for any receiving fields. */ 757 758 if multiple_move_count ^= 0 759 then do; /* A move with no on size error checking can be generated */ 760 761 /* Set pointer to receiving operand into the in_token structure. */ 762 in_token.token_ptr (first_meaningful_ptr_index) = resultant_operand_ptr; 763 764 /* Adjust in_token.n to its correct value for the (possibly multiple 765* moves. */ 766 in_token.n = first_meaningful_ptr_index + multiple_move_count + 1; 767 768 /* Set the number of receiving fields into the move EOS */ 769 770 move_eos_ptr = addr (move_eos); 771 move_eos_ptr -> end_stmt.e = multiple_move_count; 772 773 /* Set the last entry in the move in_token structure to point 774* to the move EOS token */ 775 in_token.token_ptr (in_token.n) = move_eos_ptr; 776 777 /* Call the move generator to generate (possibly multiple) moves 778* to those receiving fields for which no overflow can occur. */ 779 call cobol_move_gen (in_token_ptr); 780 781 782 783 end; /* A move with no on size error checking can be generated. */ 784 785 end; /* Result is not dataname or if dataname, is not floating decimal. */ 786 787 788 /* At this point in processing, move code has been generated to 789* 790* move the result to all recieving fields which can hold the result of the 791* computation without possibility of overflow. Now we must generate code 792* to move the result to those receiving fields for which the possibility of 793* overflow does exist. The following conditions are now true: 794* 795* 1. receive_count contains the number of receiving fields. 796* 2. operand_stack(1) through operand_stack(receive_count) contain 797* pointers to the receiving fields for which the possibility 798* of overflow exists, or the null() pointer value. (null() 799* was set into those operand_stack entries for which no 800* possibility of overflow existed, above.) 801* 3. multiple_move_count contains the count of the receiving fields 802* for which moves without on size error checking have been generated. 803* 804* */ 805 806 if multiple_move_count ^= receive_count 807 then do; /* On size error checking must be done for some receiving fields */ 808 809 810 overflow_possible = "1"b; /* Generate code to enable the Cobol fixedoverflow handler. */ 811 812 813 /* Allocate a size error flag in the stack and initialize it to zero. */ 814 size_error_inst_ptr = addr (size_error_inst); 815 call get_size_error_flag (size_error_token_ptr, size_error_inst_ptr); 816 817 818 819 do ix = 1 to receive_count; /* Generate moves with test for 820* on size errors */ 821 822 if operand_stack (ix) ^= null () 823 then do; /* This receiving operand could possibly overflow */ 824 825 receiving_is_not_stored = "0"b; 826 827 /* Store the receiving field in a temporary, if the receiving field 828* is not numeric edated. */ 829 830 831 832 if operand_stack (ix) 833 -> data_name.numeric_edited /* Receiving is numeric edited. */ 834 | (operand_stack (ix) -> data_name.display 835 & operand_stack (ix) -> data_name.item_signed 836 & operand_stack (ix) -> data_name.sign_separate = "0"b) 837 /* overpunch sign */ 838 then receiving_is_not_stored = "1"b; 839 else call receiving_field (operand_stack (ix), stored_token_ptr, 1); 840 /* Store receiving */ 841 842 /* Reserve a tag to which to transfer if no overflow occurs. */ 843 no_overflow_tag = cobol_$next_tag; 844 cobol_$next_tag = cobol_$next_tag + 1; 845 846 call cobol_fofl_mask$on; 847 848 /* Generate code to move the result of the computation to 849* the receiving field. */ 850 851 /* Set up the in_token structure for the move generator. */ 852 in_token.n = 4; 853 in_token.token_ptr (1) = null (); 854 in_token.token_ptr (2) = resultant_operand_ptr; 855 /* result */ 856 in_token.token_ptr (3) = operand_stack (ix); 857 /* Receiving field */ 858 859 move_eos_ptr = addr (move_eos); 860 move_eos_ptr -> end_stmt.e = 1; 861 /* One receiving field. */ 862 in_token.token_ptr (4) = move_eos_ptr; 863 864 call cobol_arith_move_gen (in_token_ptr); 865 866 /* Generate code to test for overflow, */ 867 call test_for_overflow (no_overflow_tag, size_error_inst_ptr, in_token_ptr); 868 869 /* If the receiving field has been stored in a temporary, then restore it. */ 870 if receiving_is_not_stored = "0"b 871 then call receiving_field (operand_stack (ix), stored_token_ptr, 872 2 /*RESTORE*/); 873 874 /* Define the no_overflow_tag at the next instruction location. */ 875 call cobol_define_tag (no_overflow_tag); 876 877 878 /* Generate code to turn OFF the overflow mask indicator bit. */ 879 call cobol_fofl_mask$off; 880 881 end; /* This operand could possibly overflow */ 882 end; /* Generate moves with test for on size errors */ 883 884 /* At this point in processing, one or more moves with checking for on 885* size error have been generated */ 886 887 888 889 890 end; /* On size error checking must be done for some receiving fields */ 891 /* Generate code to test the size error flag (if on ssize error checking was necessary) 892* or to transfer unconditionally to the next statement (if no overflow checking was done). */ 893 /*[4.0-1]*/ 894 if end_stmt.f = "01"b 895 then not_bit = "1"b; 896 else not_bit = "0"b; 897 898 /*[4.0-1]*/ 899 call test_size_error (size_error_token_ptr, size_error_inst_ptr, next_stmt_tag, overflow_possible, 900 not_bit); 901 902 end; /* On size error checking requested, do it and move result to receiving */ 903 904 905 /* Define the imperative statement at the next available word in 906* the text segment. */ 907 if ose_flag 908 then call cobol_define_tag (imperative_stmt_tag); /* NOTE: The imperative stmt tag is 909* defined whether it is referenced or not in the code generated for the 910* compute statement. */ 911 912 /* Restore in_token_ptr */ 913 914 in_token_ptr = save_in_token_ptr; 915 916 exit: 917 return; 918 919 920 /*************************************/ 921 divide_check: 922 proc; 923 924 925 /* This internal procedure generates code that compares the 926*divisor of a division operation to zero, and transfers to the 927*imperative statement (on size error ...) if the divisor is in fact, 928*zero. */ 929 930 931 /* Set the imperative statement tag into the EOS for compare */ 932 compare_eos_ptr = addr (compare_eos); 933 compare_eos_ptr -> end_stmt.h = imperative_stmt_tag; 934 935 936 /* Build an in_token structure to pass to cobol_compare_gen */ 937 work_ptr = addr (work_buff (1)); 938 work_ptr -> in_token.n = 3; 939 work_ptr -> in_token.code = 0; 940 work_ptr -> in_token.token_ptr (1) = operand2_ptr;/* divisor */ 941 work_ptr -> in_token.token_ptr (2) = addr (numeric_zero); 942 /* numeric zero token */ 943 work_ptr -> in_token.token_ptr (3) = compare_eos_ptr; 944 945 /* Call cobol_compare_gen to perform the code generation */ 946 947 call cobol_compare_gen (work_ptr); 948 949 950 951 end divide_check; 952 953 954 955 /***** Declaration for builtin function *****/ 956 957 dcl (substr, mod, binary, fixed, addr, addrel, rel, length, string, unspec, null, index) 958 builtin; 959 960 /***** End of declaration for builtin function *****/ 961 962 /* INCLUDE FILES USED BY THIS PROCEDURE */ 963 1 1 1 2 /* BEGIN INCLUDE FILE ... cobol_arith_util.incl.pl1 */ 1 3 /* <<< LAST MODIFIED ON 9-08-76 by bc >>> */ 1 4 /* <<< LAST MODIFIED ON 9-23-75 by tlf >>> */ 1 5 /* <<< NAME OF INCLUDE FILE: cobol_arith_util.incl.pl1 >>> */ 1 6 1 7 1 8 /**************************************************/ 1 9 /* INTERNAL PROCEDURE */ 1 10 /* get_size_error_flag */ 1 11 /**************************************************/ 1 12 1 13 get_size_error_flag:proc(size_error_token_ptr,size_error_inst_ptr); 1 14 1 15 /* 1 16*FUNCTION 1 17* 1 18*The function of this procedure is to: 1 19* 1 20* 1. allocate a fixed bin (35) variable in the COBOL 1 21* program's run-time stack. 1 22* 2. build a data name token for the fixed binary variable. 1 23* 3. Emit code that stores zero into the fixed binary. 1 24* 4. Return a pointer to the data name token for the fixed 1 25* binary variable. 1 26* 5. Return a 36 bit non-eis instruction word that 1 27* contains the address of the fixed binary variable. 1 28* 1 29**/ 1 30 1 31 /* DECLARATION OF THE PARAMETERS */ 1 32 1 33 dcl size_error_token_ptr ptr; 1 34 dcl size_error_inst_ptr ptr; 1 35 1 36 /* DESCRIPTION OF THE PARAMETERS */ 1 37 1 38 /* 1 39*PARAMETER DESCRIPTION 1 40* 1 41*size_error_token_ptr Points to the data name token 1 42* that describes the fixed binary 1 43* in the stack. (output) 1 44*size_error_inst_ptr Points to a 36 bit field in which 1 45* the non-eix address is constructed. 1 46* (output) 1 47* 1 48**/ 1 49 1 50 /* DECLARATION OF INTERNAL STATIC VARIABLES */ 1 51 1 52 dcl stz_op bit (10) int static init ("1001010000"b /*450(0)*/); 1 53 1 54 /* DECLARATION OF INTERNAL VARIABLES */ 1 55 1 56 dcl ret_offset fixed bin; 1 57 dcl size_error_inst_word bit (36) based (size_error_inst_ptr); 1 58 dcl input_buffer (1:10) fixed bin; 1 59 dcl reloc_buffer (1:10) bit (5) aligned; 1 60 1 61 1 62 1 63 /*************************************************/ 1 64 /* START OF EXECUTION */ 1 65 /* INTERNAL PROCEDURE get_size_error_flag */ 1 66 /**************************************************/ 1 67 1 68 /* Allocate a 4 byte fixed binary number on a word boundary in the stack */ 1 69 call cobol_alloc$stack(4,0,ret_offset); 1 70 1 71 /* Make a data name token for the fixed binary number. */ 1 72 size_error_token_ptr = null(); /* The utility will provide the buffer. */ 1 73 call cobol_make_type9$fixed_bin_35(size_error_token_ptr,1000 /*STACK*/,ret_offset); 1 74 1 75 /* Generate code to store zero in the stack temporary */ 1 76 input_ptr = addr(input_buffer(1)); 1 77 reloc_ptr = addr(reloc_buffer(1)); 1 78 1 79 input_struc_basic.type = 1; 1 80 input_struc_basic.operand_no = 0; 1 81 input_struc_basic.lock = 0; 1 82 input_struc_basic.segno = 1000; /* STACK */ 1 83 input_struc_basic.char_offset = ret_offset; /* From cobol_alloc$stack */ 1 84 1 85 size_error_inst_word = "0"b; 1 86 1 87 /* Get the non-eis instruction */ 1 88 call cobol_addr(input_ptr,size_error_inst_ptr,reloc_ptr); 1 89 1 90 /* Set the STZ opcode into the instruction word */ 1 91 size_error_inst_ptr -> inst_struc_basic.fill1_op = stz_op; 1 92 1 93 /* Emit the stz instruction */ 1 94 call cobol_emit(size_error_inst_ptr,reloc_ptr,1); 1 95 1 96 /* Set the opcode in the non-eis instruction to "0"b */ 1 97 size_error_inst_ptr -> inst_struc_basic.fill1_op = "0"b; 1 98 1 99 end get_size_error_flag; 1 100 1 101 1 102 /**************************************************/ 1 103 /* INTERNAL PROCEDURE */ 1 104 /* receiving_field */ 1 105 /**************************************************/ 1 106 1 107 receiving_field:proc(receiving_token_ptr,stored_token_ptr,function_code); 1 108 1 109 /* THIS IS NOT A VALID ENTRY POINT */ 1 110 1 111 /* DECLARATION OF THE PARAMETERS */ 1 112 1 113 dcl receiving_token_ptr ptr; 1 114 dcl stored_token_ptr ptr; 1 115 dcl function_code fixed bin; 1 116 1 117 /* DESCRIPTION OF THE PARAMETERS */ 1 118 1 119 /* 1 120*PARAMETER DESCRIPTION 1 121* 1 122*receiving_token_ptr Points to the data name token of the receiving 1 123* operand to be stored. (input) 1 124*stored_token_ptr Points to the data name token of the 1 125* temporary in which the receiving operand 1 126* is to be stored. (output) 1 127*function_code Code that indicates the function to perform 1 128* 1 129* value | function 1 130* ============================= 1 131* 1 | store 1 132* 2 | restore 1 133* 1 134**/ 1 135 1 136 /* DECLARATION OF INTERNAL STATIC VARIABLES */ 1 137 1 138 /* Definition of an EOS token used in calls to cobol_arith_move_gen */ 1 139 1 140 dcl 1 move_eos int static, 1 141 2 size fixed bin (15) init (32), 1 142 2 line fixed bin (15) init (0), 1 143 2 column fixed bin (15) init (0), 1 144 2 type fixed bin (15) init (19), /* EOS */ 1 145 2 verb fixed bin (15) init (18), /* MOVE */ 1 146 2 e fixed bin (15) init (0), 1 147 2 h fixed bin (15) init (0), 1 148 2 i fixed bin (15) init (0), 1 149 2 j fixed bin (15) init (0), 1 150 2 a bit (16) init ("0"b); 1 151 dcl always_an bit (1) static init ("0"b); 1 152 1 153 /* DECLARATIONS OF INTERNAL AUTOMATIC VARIABLES */ 1 154 1 155 dcl temp_in_token (1:10) ptr; 1 156 dcl move_eos_ptr ptr; 1 157 dcl tin_ptr ptr; 1 158 dcl temp_save_ptr ptr; 1 159 dcl ret_offset fixed bin; 1 160 1 161 if function_code = 1 then call store; 1 162 else call restore; 1 163 1 164 1 165 1 166 /*************************************************/ 1 167 /* STORE ENTRY POINT */ 1 168 /***************************************************/ 1 169 1 170 store:proc; 1 171 1 172 /* This entry point is used to generate code that stores the 1 173*contents of a receiving operand into a temporary. */ 1 174 1 175 /* Modify the token for the receiving variable that is being stored, so that it 1 176* looks like an alphanumeric instead of a numeric. This is done so that the move 1 177* generator generates an alphanumeric (MLR) move to store the data. */ 1 178 if receiving_token_ptr->data_name.ascii_packed_dec_h="0"b then do; 1 179 receiving_token_ptr -> data_name.numeric = "0"b; 1 180 receiving_token_ptr -> data_name.alphanum = "1"b; 1 181 end; 1 182 else always_an="1"b; 1 183 1 184 temp_save_ptr = null(); /* Utility will provide the buffer for data name token */ 1 185 call cobol_make_type9$copy(temp_save_ptr,receiving_token_ptr); 1 186 1 187 /* Allocate space on the stack to hold the contents of the receiving field */ 1 188 call cobol_alloc$stack(fixed(temp_save_ptr -> data_name.item_length,17),0,ret_offset); 1 189 1 190 /* Update the data name for the temporary */ 1 191 temp_save_ptr -> data_name.seg_num = 1000; /* Stack */ 1 192 temp_save_ptr -> data_name.offset = ret_offset; /* From cobol_alloc$stack */ 1 193 temp_save_ptr -> data_name.subscripted = "0"b; 1 194 temp_save_ptr -> data_name.variable_length = "0"b; 1 195 temp_save_ptr -> data_name.occurs_ptr = 0; 1 196 1 197 /* Build the in_token structure for calling the move generator */ 1 198 1 199 tin_ptr = addr(temp_in_token(1)); 1 200 move_eos_ptr = addr(move_eos); 1 201 stored_token_ptr = temp_save_ptr; 1 202 1 203 tin_ptr -> in_token.n = 4; 1 204 tin_ptr -> in_token.token_ptr(1) = null(); 1 205 tin_ptr -> in_token.token_ptr(2) = receiving_token_ptr; /* operand to be stored */ 1 206 tin_ptr -> in_token.token_ptr(3) = stored_token_ptr; /* Temp in which to store */ 1 207 tin_ptr -> in_token.token_ptr(4) = move_eos_ptr; 1 208 1 209 1 210 if always_an="1"b then move_eos_ptr->end_stmt.e=10001; 1 211 else 1 212 move_eos_ptr -> end_stmt.e = 1; /* Set the number of receiving operands into the EOS */ 1 213 1 214 /* Call the move generator to move the contents */ 1 215 call cobol_move_gen(tin_ptr); 1 216 1 217 /* Reset the token for the variable being stored. */ 1 218 receiving_token_ptr -> data_name.numeric = "1"b; 1 219 receiving_token_ptr -> data_name.alphanum = "0"b; 1 220 always_an="0"b; 1 221 1 222 end store; 1 223 1 224 1 225 1 226 /**************************************************/ 1 227 /* RESTORE ENTRY POIENT */ 1 228 /**************************************************/ 1 229 1 230 restore:proc; 1 231 1 232 /* This entry point is used to restore the contents of a 1 233*receiving operand from the contents of a temporary. */ 1 234 1 235 /* Set up the in_token structure for calling the move generator */ 1 236 1 237 tin_ptr = addr(temp_in_token(1)); 1 238 move_eos_ptr = addr(move_eos); 1 239 1 240 tin_ptr -> in_token.n = 4; 1 241 tin_ptr -> in_token.token_ptr(1) = null(); 1 242 tin_ptr -> in_token.token_ptr(2) = stored_token_ptr; /* source */ 1 243 tin_ptr -> in_token.token_ptr (3) = receiving_token_ptr; /* Receiving field */ 1 244 tin_ptr -> in_token.token_ptr(4) = move_eos_ptr; /* move EOS token */ 1 245 1 246 /* Set the number of receiving fields into the move EOS */ 1 247 move_eos_ptr -> end_stmt.e = 1; 1 248 1 249 /* Modify the token for the receiving variable that is being stored, so that it 1 250* looks like an alphanumeric instead of a numeric. This is done so that the move 1 251* generator generates an alphanumeric (MLR) move to store the data. */ 1 252 if receiving_token_ptr->data_name.ascii_packed_dec_h="0"b then do; 1 253 receiving_token_ptr -> data_name.numeric = "0"b; 1 254 receiving_token_ptr -> data_name.alphanum = "1"b; 1 255 end; 1 256 1 257 /* Call the move generator */ 1 258 1 259 call cobol_move_gen(tin_ptr); 1 260 1 261 /* Reset the token for the variable being stored. */ 1 262 receiving_token_ptr -> data_name.numeric = "1"b; 1 263 receiving_token_ptr -> data_name.alphanum = "0"b; 1 264 1 265 end restore; 1 266 1 267 end receiving_field; 1 268 1 269 /**************************************************/ 1 270 /* INTERNAL PROCEDURE */ 1 271 /* test_for_overflow */ 1 272 /**************************************************/ 1 273 1 274 test_for_overflow:proc(no_overflow_tag,size_error_inst_ptr,move_in_token_ptr); 1 275 1 276 /* 1 277*FUNCTION 1 278*The function of this procedure is to generate the following 1 279*sequence of code: 1 280* 1 281* tov 2,ic 1 282* tra no_overflow_tag 1 283* aos size_error_flag 1 284**/ 1 285 1 286 /* DECLARATION OF THE PARAMETERS */ 1 287 1 288 dcl no_overflow_tag fixed bin; 1 289 dcl size_error_inst_ptr ptr; 1 290 dcl move_in_token_ptr ptr; 1 291 1 292 /* DESCRIPTION OF THE PARAMETERS */ 1 293 1 294 /* 1 295*PARAMETER DESCRIPTION 1 296* 1 297*no_overflow_tag Contains the compiler generated tag to which 1 298* to transfer if there is no overflow. (input) 1 299*size_error_inst_ptr Points to a 36 bit field that contains a 1 300* non-eis instruction, which contains the address 1 301* of the size error flag. (input) 1 302* 1 303**/ 1 304 1 305 /* DECLARATIONS OF INTERNAL STATIC VARIABLES */ 1 306 1 307 dcl tov_op bit (10) int static init ("1100011110"b /*617(0)*/); 1 308 dcl tra_op bit (10) int static init ("1110010000"b /*710(0)*/); 1 309 dcl aos_op bit (10) int static init ("0001011000"b /*054(0)*/); 1 310 1 311 /* DECLARATIONS OF INTERNAL AUTOMATIC VARIABLES. */ 1 312 1 313 dcl temp_inst_word bit (36); 1 314 dcl temp_inst_ptr ptr; 1 315 1 316 dcl reloc_buffer (1:10) bit (5) aligned; 1 317 dcl reloc_ptr ptr; 1 318 1 319 dcl save_locno fixed bin; 1 320 dcl overflow_tag fixed bin; 1 321 1 322 /**************************************************/ 1 323 /* START OF EXECUTION */ 1 324 /* test_for_overflow */ 1 325 /**************************************************/ 1 326 1 327 1 328 temp_inst_word = "0"b; 1 329 temp_inst_ptr = addr(temp_inst_word); 1 330 1 331 /* Insert tov opcode */ 1 332 temp_inst_ptr -> inst_struc_basic.fill1_op = tov_op; 1 333 1 334 /* Reserve a tag to which to transfer if overflow occurs. */ 1 335 overflow_tag = cobol_$next_tag; 1 336 1 337 cobol_$next_tag = cobol_$next_tag + 1; 1 338 1 339 1 340 reloc_ptr = addr(reloc_buffer(1)); 1 341 reloc_buffer(1) = "0"b; 1 342 reloc_buffer(2) = "0"b; 1 343 1 344 /* Emit the instruction */ 1 345 call cobol_emit(temp_inst_ptr,reloc_ptr,1); 1 346 1 347 /* Make a tagref to the overflow tag at the instruction just emitted. */ 1 348 call cobol_make_tagref(overflow_tag, cobol_$text_wd_off - 1,null()); 1 349 1 350 1 351 if move_in_token_ptr ^= null() then 1 352 if move_in_token_ptr -> in_token.code ^= 0 1 353 then call cobol_move_gen(move_in_token_ptr); /* Move a temp result into a numeric edited. */ 1 354 1 355 1 356 /* Generate the tra to no_overflow_tag */ 1 357 temp_inst_word = "0"b; 1 358 temp_inst_ptr -> inst_struc_basic.fill1_op = tra_op; 1 359 1 360 save_locno = cobol_$text_wd_off; 1 361 1 362 /* Emit the tra instruction */ 1 363 call cobol_emit(temp_inst_ptr,reloc_ptr,1); 1 364 1 365 /* Make a tagref to the no_overflow_tag at the tra instruction just emitted. */ 1 366 call cobol_make_tagref(no_overflow_tag,save_locno,null()); 1 367 1 368 /* Generate aos instruction which increments the size error flag */ 1 369 /* Define the overflow_tag at the aos instruction */ 1 370 call cobol_define_tag(overflow_tag); 1 371 size_error_inst_ptr -> inst_struc_basic.fill1_op = aos_op; 1 372 1 373 /* Emit the instruction */ 1 374 call cobol_emit(size_error_inst_ptr,reloc_ptr,1); 1 375 1 376 /* Reset the opcode field of the non-eis instruction */ 1 377 size_error_inst_ptr -> inst_struc_basic.fill1_op = "0"b; 1 378 1 379 1 380 end test_for_overflow; 1 381 1 382 /**************************************************/ 1 383 /* INTERNAL PROCEDURE */ 1 384 /* test_size_error */ 1 385 /**************************************************/ 1 386 1 387 1 388 test_size_error:proc(size_error_token_ptr,size_error_inst_ptr,next_stmt_tag,overflow_code_generated,not_bit); 1 389 1 390 /* 1 391* 1 392*FUNCTION 1 393* 1 394*This internal procedure performs the following functions: 1 395* 1 396* If the overflow_code generated flag is "1"b then 1 397* the following functions are performed: 1 398* 1. Gets the A of Q register 1 399* 2. Generates two instructions. 1 400* a. LDA or LDQ with the contents of the size error flag 1 401* b. TZE to the next_stmt_tag 1 402* If the overflow_code_generated flag is "0"b, then 1 403* the following instruction is generated: 1 404* TRA to the next_stmt_tag 1 405* 1 406* 1 407**/ 1 408 1 409 /* DECLARATION OF THE PARAMETERS */ 1 410 1 411 dcl size_error_token_ptr ptr; 1 412 dcl size_error_inst_ptr ptr; 1 413 dcl next_stmt_tag fixed bin; 1 414 dcl (overflow_code_generated,not_bit) bit (1); 1 415 1 416 /* DESCRIPTION OF THE PARAMETERS */ 1 417 1 418 /* 1 419*PARAMETER DESCRIPTION 1 420* 1 421*size_error_token_ptr Points to a data name token 1 422* for the size error flag. (input) 1 423* 1 424*size_error_inst_ptr Points to a 36 bit field that contains 1 425* the non-eis address of the size 1 426* error flag in the run-time stack. 1 427* (input) 1 428*next_stmt_tag Contains a compiler generated tag 1 429* to be associated with the next 1 430* Cobol statement. (input) 1 431*overflow_code_generated Contains a one bit indicator that 1 432* is "1"b if overflow testing 1 433* code was generated for this statement. 1 434* (input) 1 435*not_bit "1"b if NOT option follows 1 436**/ 1 437 1 438 /* DECLARATION OF INTERNAL STATIC VARIABLES. */ 1 439 1 440 dcl lda_op bit (10) int static init ("0100111010"b /*235(0)*/); 1 441 dcl ldq_op bit (10) int static init ("0100111100"b /*236(0)*/); 1 442 dcl tze_op bit (10) int static init ("1100000000"b /*600(0)*/); 1 443 dcl tnz_op bit (10) int static init ("1100000010"b /*601(0)*/); /*[4.0-1]*/ 1 444 dcl tra_op bit (10) int static init ("1110010000"b /*710(0)*/); 1 445 1 446 1 447 /* DECLARATIONS OF INTERNAL AUTOMATIC VARIABLES */ 1 448 1 449 /* Structure used to communicate with the register$load procedure. */ 1 450 1 451 dcl 1 register_struc, 1 452 2 what_reg fixed bin, 1 453 2 reg_no bit (4), 1 454 2 lock fixed bin, 1 455 2 already_there fixed bin, 1 456 2 contains fixed bin, 1 457 2 dname_ptr ptr, 1 458 2 literal bit (36); 1 459 1 460 dcl temp_inst_word bit (36); 1 461 dcl temp_inst_ptr ptr; 1 462 1 463 dcl save_locno fixed bin; 1 464 dcl reloc_buffer (1:10) bit (5) aligned; 1 465 dcl reloc_ptr ptr; 1 466 dcl size_error_inst bit (36) based (size_error_inst_ptr); 1 467 1 468 1 469 /**************************************************/ 1 470 /* START OF EXECUTION */ 1 471 /* test_size_error */ 1 472 /**************************************************/ 1 473 reloc_ptr = addr(reloc_buffer(1)); 1 474 reloc_buffer(1) = "0"b; 1 475 reloc_buffer(2) = "0"b; 1 476 1 477 1 478 if overflow_code_generated 1 479 then do; /* overflow code was generated, must load the size error flag and test it */ 1 480 1 481 size_error_inst_ptr = addr(size_error_inst); 1 482 1 483 /* Get the A or Q register */ 1 484 register_struc.what_reg = 0; /* A or Q */ 1 485 register_struc.lock = 0; /* No change to locks */ 1 486 register_struc.contains = 1; /* Register will contain a data item */ 1 487 register_struc.dname_ptr = size_error_token_ptr; 1 488 1 489 call cobol_register$load(addr(register_struc)); 1 490 1 491 /* Build the LDA or LDQ instruction */ 1 492 1 493 if register_struc.reg_no = "0001"b 1 494 then size_error_inst_ptr -> inst_struc_basic.fill1_op = lda_op; /* A reg */ 1 495 else size_error_inst_ptr -> inst_struc_basic.fill1_op = ldq_op; /* Q reg */ 1 496 1 497 1 498 /* Emit the LDA or LDQ instruction */ 1 499 1 500 call cobol_emit(size_error_inst_ptr,reloc_ptr,1); 1 501 end; /* overflow code was generated, must load the size error flag and test it */ 1 502 1 503 1 504 /* Generate a TZE or TRA instruction */ 1 505 temp_inst_word = "0"b; 1 506 temp_inst_ptr = addr(temp_inst_word); 1 507 if overflow_code_generated 1 508 /*[4.2-1]*/ then if not_bit 1 509 /*[4.2-1]*/ then temp_inst_ptr -> inst_struc_basic.fill1_op = tnz_op; 1 510 /*[4.2-1]*/ else temp_inst_ptr -> inst_struc_basic.fill1_op = tze_op; 1 511 else temp_inst_ptr -> inst_struc_basic.fill1_op = tra_op; 1 512 1 513 /* Save the text word offset at which the tze is to be emitted */ 1 514 save_locno = cobol_$text_wd_off; 1 515 1 516 /* Emit the instruction */ 1 517 call cobol_emit(temp_inst_ptr,reloc_ptr,1); 1 518 1 519 /* Generate a tagref to the next cobol statement at the TZE or TRA just emitted */ 1 520 call cobol_make_tagref(next_stmt_tag,save_locno,null()); 1 521 1 522 1 523 end test_size_error; 1 524 1 525 1 526 1 527 1 528 not_dec_operand:proc(token_ptr) returns (bit (1)); 1 529 1 530 /* This function procedure determines whether an input data 1 531*name token represents a data item that is not decimal, 1 532*namely short fixed binary, long fixed binary, or overpunch 1 533*sign. If the token represents a fixed binary or overpunch 1 534*sign data item, then "1"b is returned. Otherwise "0"b is 1 535*returned. */ 1 536 1 537 dcl token_ptr ptr; 1 538 1 539 if token_ptr -> data_name.bin_18 1 540 | token_ptr -> data_name.bin_36 1 541 | token_ptr -> data_name.sign_type = "010"b /* leading not separate */ 1 542 | token_ptr -> data_name.sign_type = "001"b /* trailing, not separate */ 1 543 | (token_ptr -> data_name.display & token_ptr -> data_name.item_signed 1 544 & token_ptr -> data_name.sign_separate = "0"b) /* Default overpunch. */ 1 545 then return ("1"b); 1 546 else return ("0"b); 1 547 1 548 end not_dec_operand; 1 549 1 550 /* END INCLUDE FILE ... cobol_arith_util.incl.pl1 */ 1 551 964 2 1 2 2 /* BEGIN INCLUDE FILE ... cobol_type9.incl.pl1 */ 2 3 /* Last modified on 11/19/76 by ORN */ 2 4 2 5 /* 2 6*A type 9 data name token is entered into the name table by the data 2 7*division syntax phase for each data name described in the data division. 2 8*The replacement phase subsequently replaces type 8 user word references 2 9*to data names in the procedure division minpral file with the corresponding 2 10*type 9 tokens from the name table. 2 11**/ 2 12 2 13 /* dcl dn_ptr ptr; */ 2 14 2 15 /* BEGIN DECLARATION OF TYPE9 (DATA NAME) TOKEN */ 2 16 dcl 1 data_name based (dn_ptr), 3 1 3 2 /* begin include file ... cobol_TYPE9.incl.pl1 */ 3 3 /* Last modified on 06/19/77 by ORN */ 3 4 /* Last modified on 12/28/76 by FCH */ 3 5 3 6 /* header */ 3 7 2 size fixed bin, 3 8 2 line fixed bin, 3 9 2 column fixed bin, 3 10 2 type fixed bin, 3 11 /* body */ 3 12 2 string_ptr ptr, 3 13 2 prev_rec ptr, 3 14 2 searched bit (1), 3 15 2 duplicate bit (1), 3 16 2 saved bit (1), 3 17 2 debug_ind bit (1), 3 18 2 filler2 bit (3), 3 19 2 used_as_sub bit (1), 3 20 2 def_line fixed bin, 3 21 2 level fixed bin, 3 22 2 linkage fixed bin, 3 23 2 file_num fixed bin, 3 24 2 size_rtn fixed bin, 3 25 2 item_length fixed bin(24), 3 26 2 places_left fixed bin, 3 27 2 places_right fixed bin, 3 28 /* description */ 3 29 2 file_section bit (1), 3 30 2 working_storage bit (1), 3 31 2 constant_section bit (1), 3 32 2 linkage_section bit (1), 3 33 2 communication_section bit (1), 3 34 2 report_section bit (1), 3 35 2 level_77 bit (1), 3 36 2 level_01 bit (1), 3 37 2 non_elementary bit (1), 3 38 2 elementary bit (1), 3 39 2 filler_item bit (1), 3 40 2 s_of_rdf bit (1), 3 41 2 o_of_rdf bit (1), 3 42 2 bin_18 bit (1), 3 43 2 bin_36 bit (1), 3 44 2 pic_has_l bit (1), 3 45 2 pic_is_do bit (1), 3 46 2 numeric bit (1), 3 47 2 numeric_edited bit (1), 3 48 2 alphanum bit (1), 3 49 2 alphanum_edited bit (1), 3 50 2 alphabetic bit (1), 3 51 2 alphabetic_edited bit (1), 3 52 2 pic_has_p bit (1), 3 53 2 pic_has_ast bit (1), 3 54 2 item_signed bit(1), 3 55 2 sign_separate bit (1), 3 56 2 display bit (1), 3 57 2 comp bit (1), 3 58 2 ascii_packed_dec_h bit (1), /* as of 8/16/76 this field used for comp8. */ 3 59 2 ascii_packed_dec bit (1), 3 60 2 ebcdic_packed_dec bit (1), 3 61 2 bin_16 bit (1), 3 62 2 bin_32 bit (1), 3 63 2 usage_index bit (1), 3 64 2 just_right bit (1), 3 65 2 compare_argument bit (1), 3 66 2 sync bit (1), 3 67 2 temporary bit (1), 3 68 2 bwz bit (1), 3 69 2 variable_length bit (1), 3 70 2 subscripted bit (1), 3 71 2 occurs_do bit (1), 3 72 2 key_a bit (1), 3 73 2 key_d bit (1), 3 74 2 indexed_by bit (1), 3 75 2 value_numeric bit (1), 3 76 2 value_non_numeric bit (1), 3 77 2 value_signed bit (1), 3 78 2 sign_type bit (3), 3 79 2 pic_integer bit (1), 3 80 2 ast_when_zero bit (1), 3 81 2 label_record bit (1), 3 82 2 sign_clause_occurred bit (1), 3 83 2 okey_dn bit (1), 3 84 2 subject_of_keyis bit (1), 3 85 2 exp_redefining bit (1), 3 86 2 sync_in_rec bit (1), 3 87 2 rounded bit (1), 3 88 2 ad_bit bit (1), 3 89 2 debug_all bit (1), 3 90 2 overlap bit (1), 3 91 2 sum_counter bit (1), 3 92 2 exp_occurs bit (1), 3 93 2 linage_counter bit (1), 3 94 2 rnm_01 bit (1), 3 95 2 aligned bit (1), 3 96 2 not_user_writable bit (1), 3 97 2 database_key bit (1), 3 98 2 database_data_item bit (1), 3 99 2 seg_num fixed bin, 3 100 2 offset fixed bin(24), 3 101 2 initial_ptr fixed bin, 3 102 2 edit_ptr fixed bin, 3 103 2 occurs_ptr fixed bin, 3 104 2 do_rec char(5), 3 105 2 bitt bit (1), 3 106 2 byte bit (1), 3 107 2 half_word bit (1), 3 108 2 word bit (1), 3 109 2 double_word bit (1), 3 110 2 half_byte bit (1), 3 111 2 filler5 bit (1), 3 112 2 bit_offset bit (4), 3 113 2 son_cnt bit (16), 3 114 2 max_red_size fixed bin(24), 3 115 2 name_size fixed bin, 3 116 2 name char(0 refer(data_name.name_size)); 3 117 3 118 3 119 3 120 /* end include file ... cobol_TYPE9.incl.pl1 */ 3 121 2 17 2 18 /* END DECLARATION OF TYPE9 (DATA NAME) TOKEN */ 2 19 2 20 /* END INCLUDE FILE ... cobol_type9.incl.pl1 */ 2 21 965 4 1 4 2 /* BEGIN INCLUDE FILE ... cobol_record_types.incl.pl1 */ 4 3 /* <<< LAST MODIFIED ON 09-09-75 by tlf >>> */ 4 4 4 5 dcl rtc_resword fixed bin (15) int static init(1); 4 6 dcl rtc_numlit fixed bin (15) int static init(2); 4 7 dcl rtc_alphalit fixed bin (15) int static init(3); 4 8 dcl rtc_picstring fixed bin (15) int static init(4); 4 9 dcl rtc_diag fixed bin (15) int static init(5); 4 10 dcl rtc_source fixed bin (15) int static init(6); 4 11 dcl rtc_procdef fixed bin (15) int static init(7); 4 12 dcl rtc_userwd fixed bin (15) int static init(8); 4 13 dcl rtc_dataname fixed bin (15) int static init(9); 4 14 dcl rtc_indexname fixed bin (15) int static init(10); 4 15 dcl rtc_condname fixed bin (15) int static init(11); 4 16 dcl rtc_filedef fixed bin (15) int static init(12); 4 17 dcl rtc_commdesc fixed bin (15) int static init(13); 4 18 dcl rtc_debugitems fixed bin (15) int static init(14); 4 19 dcl rtc_savedarea fixed bin (15) int static init(15); 4 20 dcl rtc_sortmerge fixed bin (15) int static init(16); 4 21 dcl rtc_mnemonic fixed bin (15) int static init(17); 4 22 dcl rtc_pararef fixed bin (15) int static init(18); 4 23 dcl rtc_eos fixed bin (15) int static init(19); 4 24 dcl rtc_reportname fixed bin (15) int static init(20); 4 25 dcl rtc_groupname fixed bin (15) int static init(21); 4 26 dcl rtc_reportentry fixed bin (15) int static init(22); 4 27 dcl rtc_unknown1 fixed bin (15) int static init(23); 4 28 dcl rtc_debugenable fixed bin (15) int static init(24); 4 29 dcl rtc_unknown2 fixed bin (15) int static init(25); 4 30 dcl rtc_unknown3 fixed bin (15) int static init(26); 4 31 dcl rtc_unknown4 fixed bin (15) int static init(27); 4 32 dcl rtc_unknown5 fixed bin (15) int static init(28); 4 33 dcl rtc_unknown6 fixed bin (15) int static init(29); 4 34 dcl rtc_internal_tag fixed bin (15) int static init(30); 4 35 dcl rtc_equate_tag fixed bin (15) int static init(31); 4 36 dcl rtc_register fixed bin (15) int static init(100); 4 37 dcl rtc_fdec_temp fixed bin (15) int static init(101); 4 38 dcl rtc_immed_const fixed bin (15) int static init(102); 4 39 4 40 /* END INCLUDE FILE ... cobol_record_types.incl.pl1 */ 4 41 966 5 1 5 2 /* BEGIN INCLUDE FILE ... cobol_in_token.incl.pl1 */ 5 3 5 4 /* Last modified August 22, 1974 by AEG */ 5 5 5 6 5 7 declare in_token_ptr ptr; 5 8 5 9 declare 1 in_token aligned based(in_token_ptr), 5 10 2 n fixed bin aligned, 5 11 2 code fixed bin aligned, 5 12 2 token_ptr(0 refer(in_token.n)) ptr aligned; 5 13 5 14 5 15 /* END INCLUDE FILE ... cobol_in_token.incl.pl1 */ 5 16 967 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 968 8 1 8 2 /* BEGIN INCLUDE FILE ... cobol_.incl.pl1 */ 8 3 /* last modified Feb 4, 1977 by ORN */ 8 4 8 5 /* This file defines all external data used in the generator phase of Multics Cobol */ 8 6 8 7 /* POINTERS */ 8 8 dcl cobol_$text_base_ptr ptr ext; 8 9 dcl text_base_ptr ptr defined (cobol_$text_base_ptr); 8 10 dcl cobol_$con_end_ptr ptr ext; 8 11 dcl con_end_ptr ptr defined (cobol_$con_end_ptr); 8 12 dcl cobol_$def_base_ptr ptr ext; 8 13 dcl def_base_ptr ptr defined (cobol_$def_base_ptr); 8 14 dcl cobol_$link_base_ptr ptr ext; 8 15 dcl link_base_ptr ptr defined (cobol_$link_base_ptr); 8 16 dcl cobol_$sym_base_ptr ptr ext; 8 17 dcl sym_base_ptr ptr defined (cobol_$sym_base_ptr); 8 18 dcl cobol_$reloc_text_base_ptr ptr ext; 8 19 dcl reloc_text_base_ptr ptr defined (cobol_$reloc_text_base_ptr); 8 20 dcl cobol_$reloc_def_base_ptr ptr ext; 8 21 dcl reloc_def_base_ptr ptr defined (cobol_$reloc_def_base_ptr); 8 22 dcl cobol_$reloc_link_base_ptr ptr ext; 8 23 dcl reloc_link_base_ptr ptr defined (cobol_$reloc_link_base_ptr); 8 24 dcl cobol_$reloc_sym_base_ptr ptr ext; 8 25 dcl reloc_sym_base_ptr ptr defined (cobol_$reloc_sym_base_ptr); 8 26 dcl cobol_$reloc_work_base_ptr ptr ext; 8 27 dcl reloc_work_base_ptr ptr defined (cobol_$reloc_work_base_ptr); 8 28 dcl cobol_$pd_map_ptr ptr ext; 8 29 dcl pd_map_ptr ptr defined (cobol_$pd_map_ptr); 8 30 dcl cobol_$fixup_ptr ptr ext; 8 31 dcl fixup_ptr ptr defined (cobol_$fixup_ptr); 8 32 dcl cobol_$initval_base_ptr ptr ext; 8 33 dcl initval_base_ptr ptr defined (cobol_$initval_base_ptr); 8 34 dcl cobol_$initval_file_ptr ptr ext; 8 35 dcl initval_file_ptr ptr defined (cobol_$initval_file_ptr); 8 36 dcl cobol_$perform_list_ptr ptr ext; 8 37 dcl perform_list_ptr ptr defined (cobol_$perform_list_ptr); 8 38 dcl cobol_$alter_list_ptr ptr ext; 8 39 dcl alter_list_ptr ptr defined (cobol_$alter_list_ptr); 8 40 dcl cobol_$seg_init_list_ptr ptr ext; 8 41 dcl seg_init_list_ptr ptr defined (cobol_$seg_init_list_ptr); 8 42 dcl cobol_$temp_token_area_ptr ptr ext; 8 43 dcl temp_token_area_ptr ptr defined (cobol_$temp_token_area_ptr); 8 44 dcl cobol_$temp_token_ptr ptr ext; 8 45 dcl temp_token_ptr ptr defined (cobol_$temp_token_ptr); 8 46 dcl cobol_$token_block1_ptr ptr ext; 8 47 dcl token_block1_ptr ptr defined (cobol_$token_block1_ptr); 8 48 dcl cobol_$token_block2_ptr ptr ext; 8 49 dcl token_block2_ptr ptr defined (cobol_$token_block2_ptr); 8 50 dcl cobol_$minpral5_ptr ptr ext; 8 51 dcl minpral5_ptr ptr defined (cobol_$minpral5_ptr); 8 52 dcl cobol_$tag_table_ptr ptr ext; 8 53 dcl tag_table_ptr ptr defined (cobol_$tag_table_ptr); 8 54 dcl cobol_$map_data_ptr ptr ext; 8 55 dcl map_data_ptr ptr defined (cobol_$map_data_ptr); 8 56 dcl cobol_$ptr_status_ptr ptr ext; 8 57 dcl ptr_status_ptr ptr defined (cobol_$ptr_status_ptr); 8 58 dcl cobol_$reg_status_ptr ptr ext; 8 59 dcl reg_status_ptr ptr defined (cobol_$reg_status_ptr); 8 60 dcl cobol_$misc_base_ptr ptr ext; 8 61 dcl misc_base_ptr ptr defined (cobol_$misc_base_ptr); 8 62 dcl cobol_$misc_end_ptr ptr ext; 8 63 dcl misc_end_ptr ptr defined (cobol_$misc_end_ptr); 8 64 dcl cobol_$list_ptr ptr ext; 8 65 dcl list_ptr ptr defined (cobol_$list_ptr); 8 66 dcl cobol_$allo1_ptr ptr ext; 8 67 dcl allo1_ptr ptr defined (cobol_$allo1_ptr); 8 68 dcl cobol_$eln_ptr ptr ext; 8 69 dcl eln_ptr ptr defined (cobol_$eln_ptr); 8 70 dcl cobol_$diag_ptr ptr ext; 8 71 dcl diag_ptr ptr defined (cobol_$diag_ptr); 8 72 dcl cobol_$xref_token_ptr ptr ext; 8 73 dcl xref_token_ptr ptr defined (cobol_$xref_token_ptr); 8 74 dcl cobol_$xref_chain_ptr ptr ext; 8 75 dcl xref_chain_ptr ptr defined (cobol_$xref_chain_ptr); 8 76 dcl cobol_$statement_info_ptr ptr ext; 8 77 dcl statement_info_ptr ptr defined (cobol_$statement_info_ptr); 8 78 dcl cobol_$reswd_ptr ptr ext; 8 79 dcl reswd_ptr ptr defined (cobol_$reswd_ptr); 8 80 dcl cobol_$op_con_ptr ptr ext; 8 81 dcl op_con_ptr ptr defined (cobol_$op_con_ptr); 8 82 dcl cobol_$ntbuf_ptr ptr ext; 8 83 dcl ntbuf_ptr ptr defined (cobol_$ntbuf_ptr); 8 84 dcl cobol_$main_pcs_ptr ptr ext; 8 85 dcl main_pcs_ptr ptr defined (cobol_$main_pcs_ptr); 8 86 dcl cobol_$include_info_ptr ptr ext; 8 87 dcl include_info_ptr ptr defined (cobol_$include_info_ptr); 8 88 8 89 /* FIXED BIN */ 8 90 dcl cobol_$text_wd_off fixed bin ext; 8 91 dcl text_wd_off fixed bin defined (cobol_$text_wd_off); 8 92 dcl cobol_$con_wd_off fixed bin ext; 8 93 dcl con_wd_off fixed bin defined (cobol_$con_wd_off); 8 94 dcl cobol_$def_wd_off fixed bin ext; 8 95 dcl def_wd_off fixed bin defined (cobol_$def_wd_off); 8 96 dcl cobol_$def_max fixed bin ext; 8 97 dcl def_max fixed bin defined (cobol_$def_max); 8 98 dcl cobol_$link_wd_off fixed bin ext; 8 99 dcl link_wd_off fixed bin defined (cobol_$link_wd_off); 8 100 dcl cobol_$link_max fixed bin ext; 8 101 dcl link_max fixed bin defined (cobol_$link_max); 8 102 dcl cobol_$sym_wd_off fixed bin ext; 8 103 dcl sym_wd_off fixed bin defined (cobol_$sym_wd_off); 8 104 dcl cobol_$sym_max fixed bin ext; 8 105 dcl sym_max fixed bin defined (cobol_$sym_max); 8 106 dcl cobol_$reloc_text_max fixed bin(24) ext; 8 107 dcl reloc_text_max fixed bin(24) defined (cobol_$reloc_text_max); 8 108 dcl cobol_$reloc_def_max fixed bin(24) ext; 8 109 dcl reloc_def_max fixed bin(24) defined (cobol_$reloc_def_max); 8 110 dcl cobol_$reloc_link_max fixed bin(24) ext; 8 111 dcl reloc_link_max fixed bin(24) defined (cobol_$reloc_link_max); 8 112 dcl cobol_$reloc_sym_max fixed bin(24) ext; 8 113 dcl reloc_sym_max fixed bin(24) defined (cobol_$reloc_sym_max); 8 114 dcl cobol_$reloc_work_max fixed bin(24) ext; 8 115 dcl reloc_work_max fixed bin(24) defined (cobol_$reloc_work_max); 8 116 dcl cobol_$pd_map_index fixed bin ext; 8 117 dcl pd_map_index fixed bin defined (cobol_$pd_map_index); 8 118 dcl cobol_$cobol_data_wd_off fixed bin ext; 8 119 dcl cobol_data_wd_off fixed bin defined (cobol_$cobol_data_wd_off); 8 120 dcl cobol_$stack_off fixed bin ext; 8 121 dcl stack_off fixed bin defined (cobol_$stack_off); 8 122 dcl cobol_$max_stack_off fixed bin ext; 8 123 dcl max_stack_off fixed bin defined (cobol_$max_stack_off); 8 124 dcl cobol_$init_stack_off fixed bin ext; 8 125 dcl init_stack_off fixed bin defined (cobol_$init_stack_off); 8 126 dcl cobol_$pd_map_sw fixed bin ext; 8 127 dcl pd_map_sw fixed bin defined (cobol_$pd_map_sw); 8 128 dcl cobol_$next_tag fixed bin ext; 8 129 dcl next_tag fixed bin defined (cobol_$next_tag); 8 130 dcl cobol_$data_init_flag fixed bin ext; 8 131 dcl data_init_flag fixed bin defined (cobol_$data_init_flag); 8 132 dcl cobol_$seg_init_flag fixed bin ext; 8 133 dcl seg_init_flag fixed bin defined (cobol_$seg_init_flag); 8 134 dcl cobol_$alter_flag fixed bin ext; 8 135 dcl alter_flag fixed bin defined (cobol_$alter_flag); 8 136 dcl cobol_$sect_eop_flag fixed bin ext; 8 137 dcl sect_eop_flag fixed bin defined (cobol_$sect_eop_flag); 8 138 dcl cobol_$para_eop_flag fixed bin ext; 8 139 dcl para_eop_flag fixed bin defined (cobol_$para_eop_flag); 8 140 dcl cobol_$priority_no fixed bin ext; 8 141 dcl priority_no fixed bin defined (cobol_$priority_no); 8 142 dcl cobol_$compile_count fixed bin ext; 8 143 dcl compile_count fixed bin defined (cobol_$compile_count); 8 144 dcl cobol_$ptr_assumption_ind fixed bin ext; 8 145 dcl ptr_assumption_ind fixed bin defined (cobol_$ptr_assumption_ind); 8 146 dcl cobol_$reg_assumption_ind fixed bin ext; 8 147 dcl reg_assumption_ind fixed bin defined (cobol_$reg_assumption_ind); 8 148 dcl cobol_$perform_para_index fixed bin ext; 8 149 dcl perform_para_index fixed bin defined (cobol_$perform_para_index); 8 150 dcl cobol_$perform_sect_index fixed bin ext; 8 151 dcl perform_sect_index fixed bin defined (cobol_$perform_sect_index); 8 152 dcl cobol_$alter_index fixed bin ext; 8 153 dcl alter_index fixed bin defined (cobol_$alter_index); 8 154 dcl cobol_$list_off fixed bin ext; 8 155 dcl list_off fixed bin defined (cobol_$list_off); 8 156 dcl cobol_$constant_offset fixed bin ext; 8 157 dcl constant_offset fixed bin defined (cobol_$constant_offset); 8 158 dcl cobol_$misc_max fixed bin ext; 8 159 dcl misc_max fixed bin defined (cobol_$misc_max); 8 160 dcl cobol_$pd_map_max fixed bin ext; 8 161 dcl pd_map_max fixed bin defined (cobol_$pd_map_max); 8 162 dcl cobol_$map_data_max fixed bin ext; 8 163 dcl map_data_max fixed bin defined (cobol_$map_data_max); 8 164 dcl cobol_$fixup_max fixed bin ext; 8 165 dcl fixup_max fixed bin defined (cobol_$fixup_max); 8 166 dcl cobol_$tag_table_max fixed bin ext; 8 167 dcl tag_table_max fixed bin defined (cobol_$tag_table_max); 8 168 dcl cobol_$temp_token_max fixed bin ext; 8 169 dcl temp_token_max fixed bin defined (cobol_$temp_token_max); 8 170 dcl cobol_$allo1_max fixed bin ext; 8 171 dcl allo1_max fixed bin defined (cobol_$allo1_max); 8 172 dcl cobol_$eln_max fixed bin ext; 8 173 dcl eln_max fixed bin defined (cobol_$eln_max); 8 174 dcl cobol_$debug_enable fixed bin ext; 8 175 dcl debug_enable fixed bin defined (cobol_$debug_enable); 8 176 dcl cobol_$non_source_offset fixed bin ext; 8 177 dcl non_source_offset fixed bin defined (cobol_$non_source_offset); 8 178 dcl cobol_$initval_flag fixed bin ext; 8 179 dcl initval_flag fixed bin defined (cobol_$initval_flag); 8 180 dcl cobol_$date_compiled_sw fixed bin ext; 8 181 dcl date_compiled_sw fixed bin defined (cobol_$date_compiled_sw); 8 182 dcl cobol_$include_cnt fixed bin ext; 8 183 dcl include_cnt fixed bin defined (cobol_$include_cnt); 8 184 dcl cobol_$fs_charcnt fixed bin ext; 8 185 dcl fs_charcnt fixed bin defined (cobol_$fs_charcnt); 8 186 dcl cobol_$ws_charcnt fixed bin ext; 8 187 dcl ws_charcnt fixed bin defined (cobol_$ws_charcnt); 8 188 dcl cobol_$coms_charcnt fixed bin ext; 8 189 dcl coms_charcnt fixed bin defined (cobol_$coms_charcnt); 8 190 dcl cobol_$ls_charcnt fixed bin ext; 8 191 dcl ls_charcnt fixed bin defined (cobol_$ls_charcnt); 8 192 dcl cobol_$cons_charcnt fixed bin ext; 8 193 dcl cons_charcnt fixed bin defined (cobol_$cons_charcnt); 8 194 dcl cobol_$value_cnt fixed bin ext; 8 195 dcl value_cnt fixed bin defined (cobol_$value_cnt); 8 196 dcl cobol_$cd_cnt fixed bin ext; 8 197 dcl cd_cnt fixed bin defined (cobol_$cd_cnt); 8 198 dcl cobol_$fs_wdoff fixed bin ext; 8 199 dcl fs_wdoff fixed bin defined (cobol_$fs_wdoff); 8 200 dcl cobol_$ws_wdoff fixed bin ext; 8 201 dcl ws_wdoff fixed bin defined (cobol_$ws_wdoff); 8 202 dcl cobol_$coms_wdoff fixed bin ext; 8 203 dcl coms_wdoff fixed bin defined (cobol_$coms_wdoff); 8 204 8 205 /* CHARACTER */ 8 206 dcl cobol_$scratch_dir char (168) aligned ext; 8 207 dcl scratch_dir char (168) aligned defined (cobol_$scratch_dir); /* -42- */ 8 208 dcl cobol_$obj_seg_name char (32) aligned ext; 8 209 dcl obj_seg_name char (32) aligned defined (cobol_$obj_seg_name); /* -8- */ 8 210 8 211 /* BIT */ 8 212 dcl cobol_$xref_bypass bit(1) aligned ext; 8 213 dcl xref_bypass bit(1) aligned defined (cobol_$xref_bypass); /* -1- */ 8 214 dcl cobol_$same_sort_merge_proc bit(1) aligned ext; 8 215 dcl same_sort_merge_proc bit(1) aligned defined (cobol_$same_sort_merge_proc); /* -1- */ 8 216 8 217 8 218 /* END INCLUDE FILE ... cobol_incl.pl1*/ 8 219 8 220 969 9 1 9 2 /* BEGIN INCLUDE FILE ... cobol_addr_tokens.incl.pl1 */ 9 3 9 4 9 5 /****^ HISTORY COMMENTS: 9 6* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8058), 9 7* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 9 8* MCR8058 cobol_addr_tokens.incl.pl1 Change array extents to refer to 9 9* constants rather than variables. 9 10* END HISTORY COMMENTS */ 9 11 9 12 9 13 /* Last modified on 10/1/74 by tg */ 9 14 9 15 9 16 /* parameter list */ 9 17 9 18 dcl (input_ptr, inst_ptr, reloc_ptr) ptr; 9 19 9 20 9 21 /* input_struc_basic is used for type 1 addressing */ 9 22 9 23 dcl 1 input_struc_basic based (input_ptr), 9 24 2 type fixed bin, 9 25 2 operand_no fixed bin, 9 26 2 lock fixed bin, 9 27 2 segno fixed bin, 9 28 2 char_offset fixed bin (24), 9 29 2 send_receive fixed bin; 9 30 9 31 9 32 dcl 1 input_struc based (input_ptr), 9 33 2 type fixed bin, 9 34 2 operand_no fixed bin, 9 35 2 lock fixed bin, 9 36 2 operand (0 refer (input_struc.operand_no)), 9 37 3 token_ptr ptr, 9 38 3 send_receive fixed bin, 9 39 3 ic_mod fixed bin, 9 40 3 size_sw fixed bin; 9 41 9 42 /* reloc_struc is used for all types of addressing * all types */ 9 43 9 44 dcl 1 reloc_struc (input_struc.operand_no + 1) based (reloc_ptr), 9 45 2 left_wd bit (5) aligned, 9 46 2 right_wd bit (5) aligned; 9 47 9 48 /* Instruction format for 1 word instruction */ 9 49 9 50 9 51 dcl 1 inst_struc_basic based (inst_ptr) aligned, 9 52 2 y unaligned, 9 53 3 pr bit (3) unaligned, 9 54 3 wd_offset bit (15) unaligned, 9 55 2 fill1_op bit (10) unaligned, 9 56 2 zero1 bit (1) unaligned, 9 57 2 pr_spec bit (1) unaligned, 9 58 2 tm bit (2) unaligned, 9 59 2 td bit (4) unaligned; 9 60 9 61 9 62 /* The detailed definitions of the fields in this structure 9 63* can be found in the GMAP manual section 8 */ 9 64 /* EIS instruction format for 2_4 word instructions */ 9 65 9 66 dcl 1 inst_struc based (inst_ptr) aligned, 9 67 2 inst unaligned, 9 68 3 zero1 bit (2) unaligned, 9 69 3 mf3 unaligned, 9 70 4 pr_spec bit (1) unaligned, 9 71 4 reg_or_length bit (1) unaligned, 9 72 4 zero2 bit (1) unaligned, 9 73 4 reg_mod bit (4) unaligned, 9 74 3 zero3 bit (2) unaligned, 9 75 3 mf2 unaligned, 9 76 4 pr_spec bit (1) unaligned, 9 77 4 reg_or_length bit (1) unaligned, 9 78 4 zero4 bit (1) unaligned, 9 79 4 reg_mod bit (4) unaligned, 9 80 3 fill1_op bit (10) unaligned, 9 81 3 zero5 bit (1) unaligned, 9 82 3 mf1 unaligned, 9 83 4 pr_spec bit (1) unaligned, 9 84 4 reg_or_length bit (1) unaligned, 9 85 4 zero6 bit (1) unaligned, 9 86 4 reg_mod bit (4) unaligned, 9 87 2 desc_ext unaligned, 9 88 3 desc (512) unaligned, 9 89 4 desc_od bit (36) unaligned; 9 90 9 91 /* The detailed definitions of the fields in this structure 9 92* can be found in the GMAP manual section 8. 9 93* The desc_ext is the descriptor extension of this eis 9 94* instruction. The number of descriptors associated with 9 95* this instruction is equavalent to the operand number. 9 96* Depending on operand data type, the descriptor 9 97* can be alphanumeric or numeric. The structures of the 9 98* alphanumeric and the numeric descriptors are defined 9 99* below. */ 9 100 9 101 /* alphanumeric descriptor format */ 9 102 9 103 dcl 1 desc_an based (desc_an_ptr) unaligned, 9 104 2 desc_f (512) unaligned, 9 105 3 y unaligned, 9 106 4 pr bit (3) unaligned, 9 107 4 wd_offset bit (15) unaligned, 9 108 3 char_n bit (3) unaligned, 9 109 3 zero1 bit (1) unaligned, 9 110 3 ta bit (2), 9 111 3 n bit (12) unaligned; 9 112 9 113 9 114 /* The detailed definitions of the fields in this structure can 9 115* be found in the GMAP manual section 8. */ 9 116 /* numeric descriptor format */ 9 117 9 118 dcl desc_nn_ptr ptr; 9 119 dcl desc_an_ptr ptr; 9 120 9 121 9 122 dcl 1 desc_nn based (desc_nn_ptr) unaligned, 9 123 2 desc_f (512) unaligned, 9 124 3 y unaligned, 9 125 4 pr bit (3) unaligned, 9 126 4 wd_offset bit (15) unaligned, 9 127 3 digit_n bit (3) unaligned, 9 128 3 tn bit (1) unaligned, 9 129 3 sign_type bit (2) unaligned, 9 130 3 scal bit (6) unaligned, 9 131 3 n bit (6) unaligned; 9 132 9 133 9 134 /* The detailed definitions of fields in this structure can 9 135* be found in the GMAP manual section 8. */ 9 136 /* END INCLUDE FILE ... cobol_addr_tokens.incl.pl1 */ 9 137 970 10 1 10 2 /* BEGIN INCLUDE FILE ... cobol_type2.incl.pl1 */ 10 3 /* Last modified on 11/19/76 by ORN */ 10 4 10 5 /* 10 6*A type 2 numeric literal token is entered into the minpral file by the 10 7*lexical analysis phase for each numeric literal encountered in the source 10 8*program. 10 9**/ 10 10 10 11 dcl nlit_ptr ptr; 10 12 10 13 /* BEGIN DECLARATION OF TYPE2 (NUMERIC LITERAL) TOKEN */ 10 14 dcl 1 numeric_lit based (nlit_ptr), 11 1 11 2 /* begin include file ... cobol_TYPE2.incl.pl1 */ 11 3 /* Last modified on 12/28/76 by FCH */ 11 4 11 5 /* header */ 11 6 2 size fixed bin, 11 7 2 line fixed bin, 11 8 2 column fixed bin, 11 9 2 type fixed bin, 11 10 /* body */ 11 11 2 integral bit(1), 11 12 2 floating bit(1), 11 13 2 seg_range bit(1), 11 14 2 filler1 bit(4), 11 15 2 subscript bit(1), 11 16 2 sign char(1), 11 17 2 exp_sign char(1), 11 18 2 exp_places fixed bin, 11 19 2 places_left fixed bin, 11 20 2 places_right fixed bin, 11 21 2 places fixed bin, 11 22 2 literal char(0 refer(numeric_lit.places)); 11 23 11 24 11 25 11 26 /* end include file ... cobol_TYPE2.incl.pl1 */ 11 27 10 15 10 16 /* END DECLARATION OF TYPE2 (NUMERIC LITERAL) TOKEN */ 10 17 10 18 /* END INCLUDE FILE ... cobol_type2.incl.pl1 */ 10 19 971 972 973 end cobol_compute_gen; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0830.2 cobol_compute_gen.pl1 >spec>install>MR12.3-1048>cobol_compute_gen.pl1 964 1 03/27/82 0437.8 cobol_arith_util.incl.pl1 >ldd>include>cobol_arith_util.incl.pl1 965 2 03/27/82 0439.9 cobol_type9.incl.pl1 >ldd>include>cobol_type9.incl.pl1 2-17 3 11/11/82 1712.7 cobol_TYPE9.incl.pl1 >ldd>include>cobol_TYPE9.incl.pl1 966 4 03/27/82 0439.8 cobol_record_types.incl.pl1 >ldd>include>cobol_record_types.incl.pl1 967 5 11/11/82 1712.7 cobol_in_token.incl.pl1 >ldd>include>cobol_in_token.incl.pl1 968 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 969 8 11/11/82 1712.7 cobol_.incl.pl1 >ldd>include>cobol_.incl.pl1 970 9 05/24/89 0811.7 cobol_addr_tokens.incl.pl1 >spec>install>MR12.3-1048>cobol_addr_tokens.incl.pl1 971 10 03/27/82 0439.8 cobol_type2.incl.pl1 >ldd>include>cobol_type2.incl.pl1 10-15 11 11/11/82 1712.8 cobol_TYPE2.incl.pl1 >ldd>include>cobol_TYPE2.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. addr builtin function dcl 957 ref 496 653 666 704 770 814 859 932 937 941 1-76 1-77 1-199 1-200 1-237 1-238 1-329 1-340 1-473 1-481 1-489 1-489 1-506 alphanum 21(19) based bit(1) level 2 packed packed unaligned dcl 2-16 set ref 1-180* 1-219* 1-254* 1-263* always_an 000060 internal static bit(1) initial packed unaligned dcl 1-151 set ref 1-182* 1-210 1-220* aos_op constant bit(10) initial packed unaligned dcl 1-309 ref 1-371 ascii_packed_dec_h 21(29) based bit(1) level 2 packed packed unaligned dcl 2-16 ref 1-178 1-252 b 11(03) based bit(1) level 2 packed packed unaligned dcl 6-16 ref 505 bin_18 21(13) based bit(1) level 2 packed packed unaligned dcl 2-16 ref 1-539 bin_36 21(14) based bit(1) level 2 packed packed unaligned dcl 2-16 ref 1-539 binary_ok 001301 automatic bit(1) packed unaligned dcl 464 set ref 476* 484 char_offset 4 based fixed bin(24,0) level 2 dcl 9-23 set ref 1-83* cobol_$next_tag 000134 external static fixed bin(17,0) dcl 8-128 set ref 508 509 510* 510 843 844* 844 1-335 1-337* 1-337 cobol_$text_wd_off 000132 external static fixed bin(17,0) dcl 8-90 ref 1-348 1-360 1-514 cobol_add3 000102 constant entry external dcl 302 ref 584 588 cobol_addr 000072 constant entry external dcl 296 ref 1-88 cobol_alloc$stack 000066 constant entry external dcl 294 ref 1-69 1-188 cobol_arith_move_gen 000114 constant entry external dcl 307 ref 682 864 cobol_arithop_gen 000112 constant entry external dcl 306 ref 556 cobol_binary_check$compute 000126 constant entry external dcl 314 ref 476 cobol_build_resop 000110 constant entry external dcl 305 ref 576 cobol_compare_gen 000120 constant entry external dcl 310 ref 947 cobol_compute_bin_gen 000130 constant entry external dcl 316 ref 486 cobol_define_tag 000100 constant entry external dcl 300 ref 875 907 1-370 cobol_emit 000070 constant entry external dcl 295 ref 1-94 1-345 1-363 1-374 1-500 1-517 cobol_exp3 000106 constant entry external dcl 304 ref 617 cobol_fofl_mask$off 000064 constant entry external dcl 293 ref 879 cobol_fofl_mask$on 000062 constant entry external dcl 292 ref 846 cobol_make_tagref 000076 constant entry external dcl 299 ref 1-348 1-366 1-520 cobol_make_type9$copy 000074 constant entry external dcl 297 ref 1-185 cobol_make_type9$fixed_bin_35 000124 constant entry external dcl 312 ref 1-73 cobol_move_gen 000116 constant entry external dcl 309 ref 690 779 1-215 1-259 1-351 cobol_mpy3 000104 constant entry external dcl 303 ref 613 cobol_register$load 000122 constant entry external dcl 311 ref 1-489 code 1 based fixed bin(17,0) level 2 dcl 5-9 set ref 551* 563 690 939* 1-351 compare_eos 000034 internal static structure level 1 unaligned dcl 384 set ref 932 compare_eos_ptr 000412 automatic pointer dcl 414 set ref 932* 933 943 contains 4 001500 automatic fixed bin(17,0) level 2 dcl 1-451 set ref 1-486* data_name based structure level 1 unaligned dcl 2-16 display 21(27) based bit(1) level 2 packed packed unaligned dcl 2-16 ref 832 1-539 divide_op constant fixed bin(17,0) initial dcl 337 ref 593 dname_ptr 6 001500 automatic pointer level 2 dcl 1-451 set ref 1-487* e 5 based fixed bin(17,0) level 2 dcl 6-16 set ref 502 548 576 576 581 581 584 593 593 596 667* 771* 860* 1-210* 1-211* 1-247* end_stmt based structure level 1 unaligned dcl 6-16 eos_ptr 001306 automatic pointer dcl 6-13 set ref 501* 502 505 535* 537 542 548 554 576 576 581 581 584 593 593 596 894 f 11(07) based bit(2) level 2 packed packed unaligned dcl 6-16 ref 894 fill1_op 0(18) based bit(10) level 2 packed packed unaligned dcl 9-51 set ref 1-91* 1-97* 1-332* 1-358* 1-371* 1-377* 1-493* 1-495* 1-507* 1-510* 1-511* first_meaningful_ptr_index constant fixed bin(17,0) initial dcl 344 ref 521 521 532 705 715 762 766 fixed builtin function dcl 957 ref 1-188 1-188 function_code parameter fixed bin(17,0) dcl 1-115 ref 1-107 1-161 gen_code 000741 automatic fixed bin(17,0) dcl 427 set ref 596* 600* 613* h 6 based fixed bin(17,0) level 2 dcl 6-16 set ref 933* imperative_stmt_tag 001262 automatic fixed bin(17,0) dcl 437 set ref 508* 514* 617* 907* 933 in_token based structure level 1 dcl 5-9 in_token_ptr parameter pointer dcl 5-7 set ref 29 476* 486* 493 501 501 523 525 532 535 653* 659 662 668 675 677 682* 690 690* 704* 705 712 746 762 766 775 775 779* 852 853 854 856 862 864* 867* 914* input_buffer 001337 automatic fixed bin(17,0) array dcl 1-58 set ref 1-76 input_ptr 001310 automatic pointer dcl 9-18 set ref 1-76* 1-79 1-80 1-81 1-82 1-83 1-88* input_struc_basic based structure level 1 unaligned dcl 9-23 inst_struc_basic based structure level 1 dcl 9-51 item_length 16 based fixed bin(24,0) level 2 dcl 2-16 ref 1-188 1-188 item_signed 21(25) based bit(1) level 2 packed packed unaligned dcl 2-16 ref 832 1-539 ix 000730 automatic fixed bin(17,0) dcl 421 set ref 521* 523 525* 532* 535* 672* 736* 739 746 751* 819* 822 832 832 832 832 839 856 870* iy 001257 automatic fixed bin(17,0) dcl 435 set ref 670* 677 678* 678 715* 746 747* 747 lda_op constant bit(10) initial packed unaligned dcl 1-440 ref 1-493 ldq_op constant bit(10) initial packed unaligned dcl 1-441 ref 1-495 lock 2 001500 automatic fixed bin(17,0) level 2 in structure "register_struc" dcl 1-451 in procedure "test_size_error" set ref 1-485* lock 2 based fixed bin(17,0) level 2 in structure "input_struc_basic" dcl 9-23 in procedure "cobol_compute_gen" set ref 1-81* minus_op constant fixed bin(17,0) initial dcl 335 ref 581 move_eos 000010 internal static structure level 1 unaligned dcl 349 in procedure "cobol_compute_gen" set ref 666 770 859 move_eos 000046 internal static structure level 1 unaligned dcl 1-140 in procedure "receiving_field" set ref 1-200 1-238 move_eos_ptr 000410 automatic pointer dcl 413 in procedure "cobol_compute_gen" set ref 666* 667 668 770* 771 775 859* 860 862 move_eos_ptr 001416 automatic pointer dcl 1-156 in procedure "receiving_field" set ref 1-200* 1-207 1-210 1-211 1-238* 1-244 1-247 move_in_token 000744 automatic pointer array dcl 431 set ref 653 704 move_in_token_ptr parameter pointer dcl 1-290 set ref 1-274 1-351 1-351 1-351* multiple_move_count 001264 automatic fixed bin(17,0) dcl 440 set ref 714* 743* 743 758 766 771 806 multiply_op constant fixed bin(17,0) initial dcl 336 ref 593 596 n based fixed bin(17,0) level 2 dcl 5-9 set ref 501 532 550* 662* 705* 766* 775 852* 938* 1-203* 1-240* next_stmt_tag parameter fixed bin(17,0) dcl 51 in procedure "cobol_compute_gen" set ref 29 486* 509* 899* next_stmt_tag parameter fixed bin(17,0) dcl 1-413 in procedure "test_size_error" set ref 1-388 1-520* no_overflow_tag 001270 automatic fixed bin(17,0) dcl 451 in procedure "cobol_compute_gen" set ref 843* 867* 875* no_overflow_tag parameter fixed bin(17,0) dcl 1-288 in procedure "test_for_overflow" set ref 1-274 1-366* not_bit 001302 automatic bit(1) packed unaligned dcl 464 in procedure "cobol_compute_gen" set ref 894* 896* 899* not_bit parameter bit(1) packed unaligned dcl 1-414 in procedure "test_size_error" ref 1-388 1-507 null builtin function dcl 957 ref 480 480 751 822 853 1-72 1-184 1-204 1-241 1-348 1-348 1-351 1-366 1-366 1-520 1-520 numeric 21(17) based bit(1) level 2 packed packed unaligned dcl 2-16 set ref 1-179* 1-218* 1-253* 1-262* numeric_edited 21(18) based bit(1) level 2 packed packed unaligned dcl 2-16 ref 832 numeric_lit based structure level 1 unaligned dcl 10-14 numeric_zero 000022 internal static structure level 1 unaligned dcl 365 set ref 941 occurs_ptr 27 based fixed bin(17,0) level 2 dcl 2-16 set ref 1-195* offset 24 based fixed bin(24,0) level 2 dcl 2-16 set ref 1-192* operand1_ptr 000732 automatic pointer dcl 422 set ref 570* 576* 584* 588* 613* 617* operand2_ptr 000734 automatic pointer dcl 423 set ref 572* 576* 584* 588* 613* 617* 940 operand_no 1 based fixed bin(17,0) level 2 dcl 9-23 set ref 1-80* operand_stack 000100 automatic pointer array dcl 411 set ref 542* 552 563* 570 572 625* 675 677 701 739 746 751* 822 832 832 832 832 839* 856 870* ose_flag 001255 automatic bit(1) packed unaligned dcl 433 set ref 505* 506 601 648 907 overflow_code_generated parameter bit(1) packed unaligned dcl 1-414 ref 1-388 1-478 1-507 overflow_possible 001271 automatic bit(1) packed unaligned dcl 455 set ref 702* 810* 899* overflow_tag 001471 automatic fixed bin(17,0) dcl 1-320 set ref 1-335* 1-348* 1-370* places_left 17 based fixed bin(17,0) level 2 in structure "data_name" dcl 2-16 in procedure "cobol_compute_gen" ref 728 739 places_left 6 based fixed bin(17,0) level 2 in structure "numeric_lit" dcl 10-14 in procedure "cobol_compute_gen" ref 731 places_right 20 based fixed bin(17,0) level 2 dcl 2-16 ref 523 plus_op constant fixed bin(17,0) initial dcl 334 ref 581 584 possible_ovfl_flag 000740 automatic bit(1) packed unaligned dcl 426 set ref 576* rdmax_flag 000736 automatic bit(1) packed unaligned dcl 424 set ref 519* 576* rdmax_value 000737 automatic fixed bin(17,0) dcl 425 set ref 518* 528 528* 576* rdtemp 001256 automatic fixed bin(17,0) dcl 434 set ref 523* 525* 525 528 528 receive_count 001254 automatic fixed bin(17,0) dcl 432 set ref 502* 521 672 705 736 806 819 receiving_is_not_stored 001300 automatic bit(1) packed unaligned dcl 462 set ref 825* 832* 870 receiving_token_ptr parameter pointer dcl 1-113 set ref 1-107 1-178 1-179 1-180 1-185* 1-205 1-218 1-219 1-243 1-252 1-253 1-254 1-262 1-263 reg_no 1 001500 automatic bit(4) level 2 packed packed unaligned dcl 1-451 set ref 1-493 register_struc 001500 automatic structure level 1 unaligned dcl 1-451 set ref 1-489 1-489 reloc_buffer 001351 automatic bit(5) array dcl 1-59 in procedure "get_size_error_flag" set ref 1-77 reloc_buffer 001515 automatic bit(5) array dcl 1-464 in procedure "test_size_error" set ref 1-473 1-474* 1-475* reloc_buffer 001454 automatic bit(5) array dcl 1-316 in procedure "test_for_overflow" set ref 1-340 1-341* 1-342* reloc_ptr 001312 automatic pointer dcl 9-18 in procedure "cobol_compute_gen" set ref 1-77* 1-88* 1-94* reloc_ptr 001466 automatic pointer dcl 1-317 in procedure "test_for_overflow" set ref 1-340* 1-345* 1-363* 1-374* reloc_ptr 001530 automatic pointer dcl 1-465 in procedure "test_size_error" set ref 1-473* 1-500* 1-517* resod_ld 001263 automatic fixed bin(17,0) dcl 439 set ref 728* 731* 733* 739 resultant_operand_ptr 000742 automatic pointer dcl 428 set ref 576* 584* 588* 613* 617* 625 701* 718 718 718 728 728 731 731 762 854 ret_offset 001336 automatic fixed bin(17,0) dcl 1-56 in procedure "get_size_error_flag" set ref 1-69* 1-73* 1-83 ret_offset 001424 automatic fixed bin(17,0) dcl 1-159 in procedure "receiving_field" set ref 1-188* 1-192 rounded 22(24) based bit(1) level 2 packed packed unaligned dcl 2-16 ref 525 rtc_dataname constant fixed bin(15,0) initial dcl 4-13 ref 718 718 728 rtc_eos constant fixed bin(15,0) initial dcl 4-23 ref 537 rtc_numlit constant fixed bin(15,0) initial dcl 4-6 ref 731 save_in_token_ptr 001260 automatic pointer dcl 436 set ref 493* 659 712 914 save_locno 001470 automatic fixed bin(17,0) dcl 1-319 in procedure "test_for_overflow" set ref 1-360* 1-366* save_locno 001514 automatic fixed bin(17,0) dcl 1-463 in procedure "test_size_error" set ref 1-514* 1-520* seg_num 23 based fixed bin(17,0) level 2 dcl 2-16 set ref 1-191* segno 3 based fixed bin(17,0) level 2 dcl 9-23 set ref 1-82* sign_separate 21(26) based bit(1) level 2 packed packed unaligned dcl 2-16 ref 832 1-539 sign_type 22(13) based bit(3) level 2 packed packed unaligned dcl 2-16 ref 718 1-539 1-539 size_error_inst 001272 automatic bit(36) packed unaligned dcl 457 in procedure "cobol_compute_gen" set ref 814 size_error_inst based bit(36) packed unaligned dcl 1-466 in procedure "test_size_error" set ref 1-481 size_error_inst_ptr parameter pointer dcl 1-412 in procedure "test_size_error" set ref 1-388 1-481* 1-481 1-493 1-495 1-500* size_error_inst_ptr parameter pointer dcl 1-34 in procedure "get_size_error_flag" set ref 1-13 1-85 1-88* 1-91 1-94* 1-97 size_error_inst_ptr 001266 automatic pointer dcl 445 in procedure "cobol_compute_gen" set ref 814* 815* 867* 899* size_error_inst_ptr parameter pointer dcl 1-289 in procedure "test_for_overflow" set ref 1-274 1-371 1-374* 1-377 size_error_inst_word based bit(36) packed unaligned dcl 1-57 set ref 1-85* size_error_token_ptr parameter pointer dcl 1-33 in procedure "get_size_error_flag" set ref 1-13 1-72* 1-73* size_error_token_ptr parameter pointer dcl 1-411 in procedure "test_size_error" ref 1-388 1-487 size_error_token_ptr 001274 automatic pointer dcl 458 in procedure "cobol_compute_gen" set ref 815* 899* source_code 001304 automatic fixed bin(17,0) dcl 467 set ref 476* 486* stored_token_ptr 001276 automatic pointer dcl 460 in procedure "cobol_compute_gen" set ref 839* 870* stored_token_ptr parameter pointer dcl 1-114 in procedure "receiving_field" set ref 1-107 1-201* 1-206 1-242 stz_op constant bit(10) initial packed unaligned dcl 1-52 ref 1-91 subscripted 22(05) based bit(1) level 2 packed packed unaligned dcl 2-16 set ref 1-193* target_code 001303 automatic fixed bin(17,0) dcl 466 set ref 476* 486* temp_in_token 001372 automatic pointer array dcl 1-155 set ref 1-199 1-237 temp_inst_ptr 001452 automatic pointer dcl 1-314 in procedure "test_for_overflow" set ref 1-329* 1-332 1-345* 1-358 1-363* temp_inst_ptr 001512 automatic pointer dcl 1-461 in procedure "test_size_error" set ref 1-506* 1-507 1-510 1-511 1-517* temp_inst_word 001511 automatic bit(36) packed unaligned dcl 1-460 in procedure "test_size_error" set ref 1-505* 1-506 temp_inst_word 001450 automatic bit(36) packed unaligned dcl 1-313 in procedure "test_for_overflow" set ref 1-328* 1-329 1-357* temp_save_ptr 001422 automatic pointer dcl 1-158 set ref 1-184* 1-185* 1-188 1-188 1-191 1-192 1-193 1-194 1-195 1-201 tin_ptr 001420 automatic pointer dcl 1-157 set ref 1-199* 1-203 1-204 1-205 1-206 1-207 1-215* 1-237* 1-240 1-241 1-242 1-243 1-244 1-259* tnz_op constant bit(10) initial packed unaligned dcl 1-443 ref 1-507 token_ptr parameter pointer dcl 1-537 in procedure "not_dec_operand" ref 1-528 1-539 1-539 1-539 1-539 1-539 1-539 1-539 token_ptr 2 based pointer array level 2 in structure "in_token" dcl 5-9 in procedure "cobol_compute_gen" set ref 501 523 525 535 552* 554* 563 659* 659 668* 675* 677* 712* 712 746* 762* 775* 853* 854* 856* 862* 940* 941* 943* 1-204* 1-205* 1-206* 1-207* 1-241* 1-242* 1-243* 1-244* top 000414 automatic fixed bin(17,0) dcl 415 set ref 495* 541* 541 542 552 563 570 572 580* 580 625 675 701 tov_op constant bit(10) initial packed unaligned dcl 1-307 ref 1-332 tra_op constant bit(10) initial packed unaligned dcl 1-308 in procedure "test_for_overflow" ref 1-358 tra_op constant bit(10) initial packed unaligned dcl 1-444 in procedure "test_size_error" ref 1-511 type based fixed bin(17,0) level 2 in structure "input_struc_basic" dcl 9-23 in procedure "cobol_compute_gen" set ref 1-79* type 3 based fixed bin(17,0) level 2 in structure "end_stmt" dcl 6-16 in procedure "cobol_compute_gen" ref 537 type 3 based fixed bin(17,0) level 2 in structure "data_name" dcl 2-16 in procedure "cobol_compute_gen" ref 718 718 728 731 tze_op constant bit(10) initial packed unaligned dcl 1-442 ref 1-510 unary_minus_op constant fixed bin(17,0) initial dcl 339 ref 548 variable_length 22(04) based bit(1) level 2 packed packed unaligned dcl 2-16 set ref 1-194* what_reg 001500 automatic fixed bin(17,0) level 2 dcl 1-451 set ref 1-484* work_buff 000416 automatic pointer array dcl 418 set ref 496 937 work_ptr 000726 automatic pointer dcl 419 set ref 496* 550 551 552 554 556* 563 563 937* 938 939 940 941 943 947* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. addrel builtin function dcl 957 allo1_max defined fixed bin(17,0) dcl 8-171 allo1_ptr defined pointer dcl 8-67 alter_flag defined fixed bin(17,0) dcl 8-135 alter_index defined fixed bin(17,0) dcl 8-153 alter_list_ptr defined pointer dcl 8-39 aos_op internal static bit(10) initial packed unaligned dcl 327 binary builtin function dcl 957 cd_cnt defined fixed bin(17,0) dcl 8-197 cobol_$allo1_max external static fixed bin(17,0) dcl 8-170 cobol_$allo1_ptr external static pointer dcl 8-66 cobol_$alter_flag external static fixed bin(17,0) dcl 8-134 cobol_$alter_index external static fixed bin(17,0) dcl 8-152 cobol_$alter_list_ptr external static pointer dcl 8-38 cobol_$cd_cnt external static fixed bin(17,0) dcl 8-196 cobol_$cobol_data_wd_off external static fixed bin(17,0) dcl 8-118 cobol_$compile_count external static fixed bin(17,0) dcl 8-142 cobol_$coms_charcnt external static fixed bin(17,0) dcl 8-188 cobol_$coms_wdoff external static fixed bin(17,0) dcl 8-202 cobol_$con_end_ptr external static pointer dcl 8-10 cobol_$con_wd_off external static fixed bin(17,0) dcl 8-92 cobol_$cons_charcnt external static fixed bin(17,0) dcl 8-192 cobol_$constant_offset external static fixed bin(17,0) dcl 8-156 cobol_$data_init_flag external static fixed bin(17,0) dcl 8-130 cobol_$date_compiled_sw external static fixed bin(17,0) dcl 8-180 cobol_$debug_enable external static fixed bin(17,0) dcl 8-174 cobol_$def_base_ptr external static pointer dcl 8-12 cobol_$def_max external static fixed bin(17,0) dcl 8-96 cobol_$def_wd_off external static fixed bin(17,0) dcl 8-94 cobol_$diag_ptr external static pointer dcl 8-70 cobol_$eln_max external static fixed bin(17,0) dcl 8-172 cobol_$eln_ptr external static pointer dcl 8-68 cobol_$fixup_max external static fixed bin(17,0) dcl 8-164 cobol_$fixup_ptr external static pointer dcl 8-30 cobol_$fs_charcnt external static fixed bin(17,0) dcl 8-184 cobol_$fs_wdoff external static fixed bin(17,0) dcl 8-198 cobol_$include_cnt external static fixed bin(17,0) dcl 8-182 cobol_$include_info_ptr external static pointer dcl 8-86 cobol_$init_stack_off external static fixed bin(17,0) dcl 8-124 cobol_$initval_base_ptr external static pointer dcl 8-32 cobol_$initval_file_ptr external static pointer dcl 8-34 cobol_$initval_flag external static fixed bin(17,0) dcl 8-178 cobol_$link_base_ptr external static pointer dcl 8-14 cobol_$link_max external static fixed bin(17,0) dcl 8-100 cobol_$link_wd_off external static fixed bin(17,0) dcl 8-98 cobol_$list_off external static fixed bin(17,0) dcl 8-154 cobol_$list_ptr external static pointer dcl 8-64 cobol_$ls_charcnt external static fixed bin(17,0) dcl 8-190 cobol_$main_pcs_ptr external static pointer dcl 8-84 cobol_$map_data_max external static fixed bin(17,0) dcl 8-162 cobol_$map_data_ptr external static pointer dcl 8-54 cobol_$max_stack_off external static fixed bin(17,0) dcl 8-122 cobol_$minpral5_ptr external static pointer dcl 8-50 cobol_$misc_base_ptr external static pointer dcl 8-60 cobol_$misc_end_ptr external static pointer dcl 8-62 cobol_$misc_max external static fixed bin(17,0) dcl 8-158 cobol_$non_source_offset external static fixed bin(17,0) dcl 8-176 cobol_$ntbuf_ptr external static pointer dcl 8-82 cobol_$obj_seg_name external static char(32) dcl 8-208 cobol_$op_con_ptr external static pointer dcl 8-80 cobol_$para_eop_flag external static fixed bin(17,0) dcl 8-138 cobol_$pd_map_index external static fixed bin(17,0) dcl 8-116 cobol_$pd_map_max external static fixed bin(17,0) dcl 8-160 cobol_$pd_map_ptr external static pointer dcl 8-28 cobol_$pd_map_sw external static fixed bin(17,0) dcl 8-126 cobol_$perform_list_ptr external static pointer dcl 8-36 cobol_$perform_para_index external static fixed bin(17,0) dcl 8-148 cobol_$perform_sect_index external static fixed bin(17,0) dcl 8-150 cobol_$priority_no external static fixed bin(17,0) dcl 8-140 cobol_$ptr_assumption_ind external static fixed bin(17,0) dcl 8-144 cobol_$ptr_status_ptr external static pointer dcl 8-56 cobol_$reg_assumption_ind external static fixed bin(17,0) dcl 8-146 cobol_$reg_status_ptr external static pointer dcl 8-58 cobol_$reloc_def_base_ptr external static pointer dcl 8-20 cobol_$reloc_def_max external static fixed bin(24,0) dcl 8-108 cobol_$reloc_link_base_ptr external static pointer dcl 8-22 cobol_$reloc_link_max external static fixed bin(24,0) dcl 8-110 cobol_$reloc_sym_base_ptr external static pointer dcl 8-24 cobol_$reloc_sym_max external static fixed bin(24,0) dcl 8-112 cobol_$reloc_text_base_ptr external static pointer dcl 8-18 cobol_$reloc_text_max external static fixed bin(24,0) dcl 8-106 cobol_$reloc_work_base_ptr external static pointer dcl 8-26 cobol_$reloc_work_max external static fixed bin(24,0) dcl 8-114 cobol_$reswd_ptr external static pointer dcl 8-78 cobol_$same_sort_merge_proc external static bit(1) dcl 8-214 cobol_$scratch_dir external static char(168) dcl 8-206 cobol_$sect_eop_flag external static fixed bin(17,0) dcl 8-136 cobol_$seg_init_flag external static fixed bin(17,0) dcl 8-132 cobol_$seg_init_list_ptr external static pointer dcl 8-40 cobol_$stack_off external static fixed bin(17,0) dcl 8-120 cobol_$statement_info_ptr external static pointer dcl 8-76 cobol_$sym_base_ptr external static pointer dcl 8-16 cobol_$sym_max external static fixed bin(17,0) dcl 8-104 cobol_$sym_wd_off external static fixed bin(17,0) dcl 8-102 cobol_$tag_table_max external static fixed bin(17,0) dcl 8-166 cobol_$tag_table_ptr external static pointer dcl 8-52 cobol_$temp_token_area_ptr external static pointer dcl 8-42 cobol_$temp_token_max external static fixed bin(17,0) dcl 8-168 cobol_$temp_token_ptr external static pointer dcl 8-44 cobol_$text_base_ptr external static pointer dcl 8-8 cobol_$token_block1_ptr external static pointer dcl 8-46 cobol_$token_block2_ptr external static pointer dcl 8-48 cobol_$value_cnt external static fixed bin(17,0) dcl 8-194 cobol_$ws_charcnt external static fixed bin(17,0) dcl 8-186 cobol_$ws_wdoff external static fixed bin(17,0) dcl 8-200 cobol_$xref_bypass external static bit(1) dcl 8-212 cobol_$xref_chain_ptr external static pointer dcl 8-74 cobol_$xref_token_ptr external static pointer dcl 8-72 cobol_data_wd_off defined fixed bin(17,0) dcl 8-119 compile_count defined fixed bin(17,0) dcl 8-143 coms_charcnt defined fixed bin(17,0) dcl 8-189 coms_wdoff defined fixed bin(17,0) dcl 8-203 con_end_ptr defined pointer dcl 8-11 con_wd_off defined fixed bin(17,0) dcl 8-93 cons_charcnt defined fixed bin(17,0) dcl 8-193 constant_offset defined fixed bin(17,0) dcl 8-157 data_init_flag defined fixed bin(17,0) dcl 8-131 date_compiled_sw defined fixed bin(17,0) dcl 8-181 debug_enable defined fixed bin(17,0) dcl 8-175 def_base_ptr defined pointer dcl 8-13 def_max defined fixed bin(17,0) dcl 8-97 def_wd_off defined fixed bin(17,0) dcl 8-95 desc_an based structure level 1 packed packed unaligned dcl 9-103 desc_an_ptr automatic pointer dcl 9-119 desc_nn based structure level 1 packed packed unaligned dcl 9-122 desc_nn_ptr automatic pointer dcl 9-118 diag_ptr defined pointer dcl 8-71 dn_ptr automatic pointer dcl 469 eln_max defined fixed bin(17,0) dcl 8-173 eln_ptr defined pointer dcl 8-69 exponentiate_op internal static fixed bin(17,0) initial dcl 338 fixup_max defined fixed bin(17,0) dcl 8-165 fixup_ptr defined pointer dcl 8-31 fs_charcnt defined fixed bin(17,0) dcl 8-185 fs_wdoff defined fixed bin(17,0) dcl 8-199 include_cnt defined fixed bin(17,0) dcl 8-183 include_info_ptr defined pointer dcl 8-87 index builtin function dcl 957 init_stack_off defined fixed bin(17,0) dcl 8-125 initval_base_ptr defined pointer dcl 8-33 initval_file_ptr defined pointer dcl 8-35 initval_flag defined fixed bin(17,0) dcl 8-179 input_buffer automatic fixed bin(17,0) array dcl 452 input_struc based structure level 1 unaligned dcl 9-32 inst_buffer automatic fixed bin(17,0) array dcl 454 inst_ptr automatic pointer dcl 9-18 inst_struc based structure level 1 dcl 9-66 ioa_$ioa_stream 000000 constant entry external dcl 301 lda_op internal static bit(10) initial packed unaligned dcl 328 ldq_op internal static bit(10) initial packed unaligned dcl 329 length builtin function dcl 957 link_base_ptr defined pointer dcl 8-15 link_max defined fixed bin(17,0) dcl 8-101 link_wd_off defined fixed bin(17,0) dcl 8-99 list_off defined fixed bin(17,0) dcl 8-155 list_ptr defined pointer dcl 8-65 ls_charcnt defined fixed bin(17,0) dcl 8-191 main_pcs_ptr defined pointer dcl 8-85 map_data_max defined fixed bin(17,0) dcl 8-163 map_data_ptr defined pointer dcl 8-55 max_stack_off defined fixed bin(17,0) dcl 8-123 minpral5_ptr defined pointer dcl 8-51 misc_base_ptr defined pointer dcl 8-61 misc_end_ptr defined pointer dcl 8-63 misc_max defined fixed bin(17,0) dcl 8-159 mod builtin function dcl 957 next_tag defined fixed bin(17,0) dcl 8-129 nlit_ptr automatic pointer dcl 10-11 non_source_offset defined fixed bin(17,0) dcl 8-177 ntbuf_ptr defined pointer dcl 8-83 obj_seg_name defined char(32) dcl 8-209 op_con_ptr defined pointer dcl 8-81 para_eop_flag defined fixed bin(17,0) dcl 8-139 pd_map_index defined fixed bin(17,0) dcl 8-117 pd_map_max defined fixed bin(17,0) dcl 8-161 pd_map_ptr defined pointer dcl 8-29 pd_map_sw defined fixed bin(17,0) dcl 8-127 perform_list_ptr defined pointer dcl 8-37 perform_para_index defined fixed bin(17,0) dcl 8-149 perform_sect_index defined fixed bin(17,0) dcl 8-151 priority_no defined fixed bin(17,0) dcl 8-141 ptr_assumption_ind defined fixed bin(17,0) dcl 8-145 ptr_status_ptr defined pointer dcl 8-57 reg_assumption_ind defined fixed bin(17,0) dcl 8-147 reg_status_ptr defined pointer dcl 8-59 register_struc automatic structure level 1 unaligned dcl 401 rel builtin function dcl 957 reloc_buffer automatic bit(10) array dcl 453 reloc_def_base_ptr defined pointer dcl 8-21 reloc_def_max defined fixed bin(24,0) dcl 8-109 reloc_link_base_ptr defined pointer dcl 8-23 reloc_link_max defined fixed bin(24,0) dcl 8-111 reloc_struc based structure array level 1 unaligned dcl 9-44 reloc_sym_base_ptr defined pointer dcl 8-25 reloc_sym_max defined fixed bin(24,0) dcl 8-113 reloc_text_base_ptr defined pointer dcl 8-19 reloc_text_max defined fixed bin(24,0) dcl 8-107 reloc_work_base_ptr defined pointer dcl 8-27 reloc_work_max defined fixed bin(24,0) dcl 8-115 reswd_ptr defined pointer dcl 8-79 ret_offset automatic fixed bin(17,0) dcl 441 rtc_alphalit internal static fixed bin(15,0) initial dcl 4-7 rtc_commdesc internal static fixed bin(15,0) initial dcl 4-17 rtc_condname internal static fixed bin(15,0) initial dcl 4-15 rtc_debugenable internal static fixed bin(15,0) initial dcl 4-28 rtc_debugitems internal static fixed bin(15,0) initial dcl 4-18 rtc_diag internal static fixed bin(15,0) initial dcl 4-9 rtc_equate_tag internal static fixed bin(15,0) initial dcl 4-35 rtc_fdec_temp internal static fixed bin(15,0) initial dcl 4-37 rtc_filedef internal static fixed bin(15,0) initial dcl 4-16 rtc_groupname internal static fixed bin(15,0) initial dcl 4-25 rtc_immed_const internal static fixed bin(15,0) initial dcl 4-38 rtc_indexname internal static fixed bin(15,0) initial dcl 4-14 rtc_internal_tag internal static fixed bin(15,0) initial dcl 4-34 rtc_mnemonic internal static fixed bin(15,0) initial dcl 4-21 rtc_pararef internal static fixed bin(15,0) initial dcl 4-22 rtc_picstring internal static fixed bin(15,0) initial dcl 4-8 rtc_procdef internal static fixed bin(15,0) initial dcl 4-11 rtc_register internal static fixed bin(15,0) initial dcl 4-36 rtc_reportentry internal static fixed bin(15,0) initial dcl 4-26 rtc_reportname internal static fixed bin(15,0) initial dcl 4-24 rtc_resword internal static fixed bin(15,0) initial dcl 4-5 rtc_savedarea internal static fixed bin(15,0) initial dcl 4-19 rtc_sortmerge internal static fixed bin(15,0) initial dcl 4-20 rtc_source internal static fixed bin(15,0) initial dcl 4-10 rtc_unknown1 internal static fixed bin(15,0) initial dcl 4-27 rtc_unknown2 internal static fixed bin(15,0) initial dcl 4-29 rtc_unknown3 internal static fixed bin(15,0) initial dcl 4-30 rtc_unknown4 internal static fixed bin(15,0) initial dcl 4-31 rtc_unknown5 internal static fixed bin(15,0) initial dcl 4-32 rtc_unknown6 internal static fixed bin(15,0) initial dcl 4-33 rtc_userwd internal static fixed bin(15,0) initial dcl 4-12 same_sort_merge_proc defined bit(1) dcl 8-215 save_locno automatic fixed bin(17,0) dcl 456 scratch_dir defined char(168) dcl 8-207 sect_eop_flag defined fixed bin(17,0) dcl 8-137 seg_init_flag defined fixed bin(17,0) dcl 8-133 seg_init_list_ptr defined pointer dcl 8-41 size_error_flag_ptr automatic pointer dcl 446 size_error_inst_word automatic bit(36) packed unaligned dcl 443 stack_off defined fixed bin(17,0) dcl 8-121 statement_info_ptr defined pointer dcl 8-77 string builtin function dcl 957 stz_op internal static bit(10) initial packed unaligned dcl 324 substr builtin function dcl 957 sym_base_ptr defined pointer dcl 8-17 sym_max defined fixed bin(17,0) dcl 8-105 sym_wd_off defined fixed bin(17,0) dcl 8-103 tag_table_max defined fixed bin(17,0) dcl 8-167 tag_table_ptr defined pointer dcl 8-53 temp_inst_ptr automatic pointer dcl 450 temp_inst_word automatic bit(36) packed unaligned dcl 449 temp_save_ptr automatic pointer dcl 448 temp_token_area_ptr defined pointer dcl 8-43 temp_token_max defined fixed bin(17,0) dcl 8-169 temp_token_ptr defined pointer dcl 8-45 text_base_ptr defined pointer dcl 8-9 text_wd_off defined fixed bin(17,0) dcl 8-91 token_block1_ptr defined pointer dcl 8-47 token_block2_ptr defined pointer dcl 8-49 tov_op internal static bit(10) initial packed unaligned dcl 325 tra_op internal static bit(10) initial packed unaligned dcl 326 tze_op internal static bit(10) initial packed unaligned dcl 330 unspec builtin function dcl 957 value_cnt defined fixed bin(17,0) dcl 8-195 ws_charcnt defined fixed bin(17,0) dcl 8-187 ws_wdoff defined fixed bin(17,0) dcl 8-201 xref_bypass defined bit(1) dcl 8-213 xref_chain_ptr defined pointer dcl 8-75 xref_token_ptr defined pointer dcl 8-73 NAMES DECLARED BY EXPLICIT CONTEXT. cobol_compute_gen 000012 constant entry external dcl 29 divide_check 001135 constant entry internal dcl 921 ref 601 exit 001134 constant label dcl 916 get_size_error_flag 001166 constant entry internal dcl 1-13 ref 815 not_dec_operand 002131 constant entry internal dcl 1-528 ref 480 receiving_field 001314 constant entry internal dcl 1-107 ref 839 870 restore 001467 constant entry internal dcl 1-230 ref 1-162 start 000017 constant label dcl 476 store 001325 constant entry internal dcl 1-170 ref 1-161 test_for_overflow 001545 constant entry internal dcl 1-274 ref 867 test_size_error 001743 constant entry internal dcl 1-388 ref 899 NAME DECLARED BY CONTEXT OR IMPLICATION. bin builtin function ref 576 576 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2510 2646 2214 2520 Length 3322 2214 136 440 273 52 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_compute_gen 957 external procedure is an external procedure. divide_check internal procedure shares stack frame of external procedure cobol_compute_gen. get_size_error_flag internal procedure shares stack frame of external procedure cobol_compute_gen. receiving_field internal procedure shares stack frame of external procedure cobol_compute_gen. store internal procedure shares stack frame of external procedure cobol_compute_gen. restore internal procedure shares stack frame of external procedure cobol_compute_gen. test_for_overflow internal procedure shares stack frame of external procedure cobol_compute_gen. test_size_error internal procedure shares stack frame of external procedure cobol_compute_gen. not_dec_operand internal procedure shares stack frame of external procedure cobol_compute_gen. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 move_eos cobol_compute_gen 000022 numeric_zero cobol_compute_gen 000034 compare_eos cobol_compute_gen 000046 move_eos receiving_field 000060 always_an receiving_field STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_compute_gen 000100 operand_stack cobol_compute_gen 000410 move_eos_ptr cobol_compute_gen 000412 compare_eos_ptr cobol_compute_gen 000414 top cobol_compute_gen 000416 work_buff cobol_compute_gen 000726 work_ptr cobol_compute_gen 000730 ix cobol_compute_gen 000732 operand1_ptr cobol_compute_gen 000734 operand2_ptr cobol_compute_gen 000736 rdmax_flag cobol_compute_gen 000737 rdmax_value cobol_compute_gen 000740 possible_ovfl_flag cobol_compute_gen 000741 gen_code cobol_compute_gen 000742 resultant_operand_ptr cobol_compute_gen 000744 move_in_token cobol_compute_gen 001254 receive_count cobol_compute_gen 001255 ose_flag cobol_compute_gen 001256 rdtemp cobol_compute_gen 001257 iy cobol_compute_gen 001260 save_in_token_ptr cobol_compute_gen 001262 imperative_stmt_tag cobol_compute_gen 001263 resod_ld cobol_compute_gen 001264 multiple_move_count cobol_compute_gen 001266 size_error_inst_ptr cobol_compute_gen 001270 no_overflow_tag cobol_compute_gen 001271 overflow_possible cobol_compute_gen 001272 size_error_inst cobol_compute_gen 001274 size_error_token_ptr cobol_compute_gen 001276 stored_token_ptr cobol_compute_gen 001300 receiving_is_not_stored cobol_compute_gen 001301 binary_ok cobol_compute_gen 001302 not_bit cobol_compute_gen 001303 target_code cobol_compute_gen 001304 source_code cobol_compute_gen 001306 eos_ptr cobol_compute_gen 001310 input_ptr cobol_compute_gen 001312 reloc_ptr cobol_compute_gen 001336 ret_offset get_size_error_flag 001337 input_buffer get_size_error_flag 001351 reloc_buffer get_size_error_flag 001372 temp_in_token receiving_field 001416 move_eos_ptr receiving_field 001420 tin_ptr receiving_field 001422 temp_save_ptr receiving_field 001424 ret_offset receiving_field 001450 temp_inst_word test_for_overflow 001452 temp_inst_ptr test_for_overflow 001454 reloc_buffer test_for_overflow 001466 reloc_ptr test_for_overflow 001470 save_locno test_for_overflow 001471 overflow_tag test_for_overflow 001500 register_struc test_size_error 001511 temp_inst_word test_size_error 001512 temp_inst_ptr test_size_error 001514 save_locno test_size_error 001515 reloc_buffer test_size_error 001530 reloc_ptr test_size_error THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out return_mac ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cobol_add3 cobol_addr cobol_alloc$stack cobol_arith_move_gen cobol_arithop_gen cobol_binary_check$compute cobol_build_resop cobol_compare_gen cobol_compute_bin_gen cobol_define_tag cobol_emit cobol_exp3 cobol_fofl_mask$off cobol_fofl_mask$on cobol_make_tagref cobol_make_type9$copy cobol_make_type9$fixed_bin_35 cobol_move_gen cobol_mpy3 cobol_register$load THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cobol_$next_tag cobol_$text_wd_off LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 29 000006 476 000017 480 000034 484 000045 486 000050 487 000066 493 000067 495 000073 496 000074 501 000076 502 000102 505 000104 506 000110 508 000111 509 000114 510 000116 513 000120 514 000121 518 000122 519 000123 521 000125 523 000137 525 000147 528 000153 531 000157 532 000161 535 000173 537 000201 541 000204 542 000205 544 000210 548 000211 550 000214 551 000216 552 000220 554 000224 556 000225 563 000235 566 000243 570 000244 572 000250 576 000252 580 000277 581 000301 584 000307 588 000331 591 000350 593 000351 596 000355 600 000362 601 000364 613 000367 615 000404 617 000405 625 000422 634 000426 648 000430 653 000432 659 000435 662 000440 666 000443 667 000446 668 000450 670 000452 672 000453 675 000463 677 000472 678 000500 682 000501 690 000510 693 000524 695 000526 701 000527 702 000533 704 000534 705 000537 712 000543 714 000546 715 000547 718 000551 728 000562 731 000570 733 000575 736 000577 739 000607 743 000615 746 000616 747 000623 751 000624 755 000627 758 000631 762 000633 766 000640 770 000645 771 000650 775 000652 779 000655 806 000663 810 000666 814 000670 815 000672 819 000674 822 000703 825 000711 832 000712 839 000731 843 000745 844 000750 846 000751 852 000755 853 000761 854 000764 856 000770 859 000776 860 001001 862 001003 864 001006 867 001014 870 001027 875 001050 879 001057 882 001064 894 001066 896 001077 899 001101 907 001120 914 001131 916 001134 921 001135 932 001136 933 001141 937 001143 938 001145 939 001147 940 001150 941 001152 943 001155 947 001157 951 001165 1 13 001166 1 69 001170 1 72 001206 1 73 001211 1 76 001226 1 77 001230 1 79 001232 1 80 001234 1 81 001236 1 82 001237 1 83 001241 1 85 001243 1 88 001251 1 91 001264 1 94 001272 1 97 001307 1 99 001313 1 107 001314 1 161 001316 1 162 001323 1 267 001324 1 170 001325 1 178 001326 1 179 001334 1 180 001336 1 181 001340 1 182 001341 1 184 001344 1 185 001346 1 188 001357 1 191 001376 1 192 001401 1 193 001403 1 194 001405 1 195 001407 1 199 001410 1 200 001412 1 201 001415 1 203 001420 1 204 001422 1 205 001425 1 206 001431 1 207 001435 1 210 001437 1 211 001445 1 215 001447 1 218 001455 1 219 001462 1 220 001464 1 222 001466 1 230 001467 1 237 001470 1 238 001472 1 240 001475 1 241 001477 1 242 001501 1 243 001506 1 244 001512 1 247 001514 1 252 001516 1 253 001523 1 254 001525 1 259 001527 1 262 001535 1 263 001542 1 265 001544 1 274 001545 1 328 001547 1 329 001550 1 332 001552 1 335 001556 1 337 001561 1 340 001562 1 341 001564 1 342 001565 1 345 001566 1 348 001602 1 351 001622 1 357 001642 1 358 001643 1 360 001647 1 363 001652 1 366 001666 1 370 001704 1 371 001713 1 374 001721 1 377 001736 1 380 001742 1 388 001743 1 473 001745 1 474 001747 1 475 001750 1 478 001751 1 481 001756 1 484 001762 1 485 001763 1 486 001764 1 487 001766 1 489 001771 1 493 002002 1 495 002014 1 500 002022 1 505 002037 1 506 002040 1 507 002042 1 510 002062 1 511 002067 1 514 002073 1 517 002076 1 520 002112 1 523 002130 1 528 002131 1 539 002133 1 546 002165 ----------------------------------------------------------- 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