COMPILATION LISTING OF SEGMENT cobol_divide_gen Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-04-18_1135.19_Tue_mdt Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 15 /****^ HISTORY COMMENTS: 16* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060), 17* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 18* MCR8060 cobol_divide_gen.pl1 Added Trace statements. 19* 2) change(89-04-23,Zimmerman), approve(89-04-23,MCR8074), 20* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 21* MCR8074 cobol_divide_gen.pl1 Fix remainder bug in divide verb. 22* END HISTORY COMMENTS */ 23 24 25 /* Modified on 11/19/84 by FCH, [5.3-2], BUG568(phx16554), if format 4,5 then save isor,idend in temps */ 26 /* Modified on 11/16/84 by FCH, [5.3...], trace added */ 27 /* Modified on 10/19/84 by FCH, [5.3-1], BUG563(phs18381), new cobol_addr_tokens.incl.pl1 */ 28 /* Modified on 04/18/80 by FCH, new include file cobol_arith_util, fix not option */ 29 /* Modified on 06/28/79 by FCH, [4.0-1], not option added for debug */ 30 /* Modified since Version 4.0 */ 31 32 33 34 35 36 37 /* format: style3 */ 38 cobol_divide_gen: 39 proc (in_token_ptr, next_stmt_tag); 40 41 /* 42*The DIVIDE statement generator: cobol_divide_gen 43* 44*FUNCTION 45* 46*The function of this procedure is to generate code for the 47*Cobol DIVIDE statement. 48* 49**/ 50 51 /* DECLARATION OF THE PARAMETERS */ 52 53 /* dcl in_token_ptr ptr; */ 54 /* DECLARED BELOW IN AN INCLUDE FILE */ 55 dcl next_stmt_tag fixed bin; 56 57 /* DESCRIPTION OF THE PARAMETERS */ 58 /* 59* 60*PARAMETER DESCRIPTION 61* 62*in_token_ptr Points to the in_token structure, which 63* contains information describing the DIVIDE 64* statement for which code is to be 65* generated. (input) See the description 66* below under INPUT for the exact contents of 67* the input structure. 68* NOTE: This parameter is declared in an include 69* file following the executable statements 70* of this procedure. 71*next_stmt_tag Contains a compiler generated tag number 72* (label) to be associated by the code 73* generator driver with the Cobol statement 74* that follows the DIVIDE statement for which this 75* procedure was called. (output) See 76* the discussion below under OUTPUT 77* for more details. 78**/ 79 /* 80* 81*INPUT 82* 83*The input to this procedure is a structure, which is defined by a 84*declaration of the following format: 85* 86*dcl 1 in_token based (in_token_ptr), 87* 2 n fixed bin, 88* 2 code fixed bin 89* 2 token_ptr ( 0 refer (in_token.n)) ptr; 90* 91* where: 92* 93* in_token.n contains the number of entries in the 94* token_ptr array. 95* 96* token_ptr(1) contains a pointer to a reserved word token 97* (type 1) for the reserved word DIVIDE. This pointer is 98* not used by this procedure. 99* 100* token_ptr(n) contains a pointer to an EOS (type 19) token. 101* A declaration that describes the contents of the EOS 102* token is given following the executable statements 103* of this procedure in an include file. The type 19 104* token contains the following information that is 105* used by this procedure. 106* 107* 1. end_stmt.verb contains the code for the 108* reserved word DIVIDE. 109* 2. end_stmt.a defines the format of the DIVIDE 110* statement: 111* 112* value of end_stmt.a | divide stmt format 113* ---------------------------------------- 114* "000"b | format 1 115* "001"b | format 2 116* "010"b | format 3 117* "011"b | format 4 118* "100"b | format 5 119* 120* 121* 3. end_stmt.b is "1"b if this DIVIDE statement 122* had an ON SIZE ERROR clause 123* 4. end_stmt.e contains the count of the 124* number of operands to the RIGHT of "INTO" for 125* format 1 DIVIDE statements. 126* 5, end_stmt.h contians the count of the number 127* of operands to the RIGHT of "GIVING" for 128* format 2 and format 3 DIVIDE statements. 129* 130* token_ptr(2) through token_ptr(n-1) point to tokens 131* that describe: 132* 133* 1. the data items to be multiplied together. 134* These tokens can be data name (type 9) tokens 135* numeric literal (type 2) tokens. 136* 2. the data items to receive the result of 137* the addition. These tokens are always data 138* name (type 9) tokens. 139* 140* 141*OUTPUT 142* 143*The second parameter passed to cobol_divide_gen is an output parameter. 144*A value is returned to the calling procedure, cobol_gen_driver_, 145*only for those divide statments that have on size error clauses. 146*If an on size error clause is specified, then, in addition to 147*the code that evaluates the product, and assigns it to the receiving 148*data items, cobol_divide_gen must also generate code that checks for 149*size error conditions. If a size error is detected by the execution 150*of the generated code, then the imperative statement in the DIVIDE 151*statment is executed, otherwise the imperative statement is 152*skipped. The cobol_divide_gen generator, however, when generating 153*code to skip over the imperative statement to the next statement, 154*does not know anything about the next statement. This situation 155*is handled as follows: 156* 157* 1. cobol_divide_gen reserves a tag for the next COBOL 158* statement. 159* 2. any transfers to the next statement reference the 160* tag reserved by cobol_divide_gen. This tag is not yet 161* defined. (associated with an instruction location in 162* the text segment) 163* 3. after generation of code for an multiply statement is 164* completed, cobol_divide_gen passes the next statement tag 165* back to its caller, cobol_gen_driver_, in the second 166* parameter. 167* 4. when cobol_gen_driver_ detects the end of the imperative 168* statement, the tag, reserved by cobol_divide_gen, is 169* defined. 170**/ 171 172 173 /* DECLARATION OF EXTERNAL ENTRIES */ 174 175 dcl cobol_binary_check$divide 176 ext entry (ptr, bit (1), fixed bin, fixed bin); 177 dcl cobol_divide_bin_gen 178 ext entry (ptr, fixed bin); 179 dcl cobol_num_to_udts ext entry (ptr, ptr); 180 dcl cobol_fofl_mask$on ext entry; 181 dcl cobol_fofl_mask$off ext entry; 182 dcl cobol_build_resop ext entry (ptr, ptr, fixed bin, ptr, bit (1), fixed bin, bit (1)); 183 dcl cobol_mpy3 ext entry (ptr, ptr, ptr, fixed bin); 184 dcl cobol_mpy ext entry (ptr, ptr, fixed bin); 185 dcl cobol_add3 ext entry (ptr, ptr, ptr, fixed bin); 186 dcl cobol_define_tag ext entry (fixed bin); 187 dcl cobol_alloc$stack ext entry (fixed bin, fixed bin, fixed bin); 188 dcl cobol_addr ext entry (ptr, ptr, ptr); 189 dcl cobol_emit ext entry (ptr, ptr, fixed bin); 190 dcl cobol_move_gen ext entry (ptr); 191 dcl cobol_arith_move_gen 192 ext entry (ptr); 193 dcl cobol_make_type9$copy 194 ext entry (ptr, ptr); 195 dcl cobol_make_tagref ext entry (fixed bin, fixed bin, ptr); 196 dcl cobol_register$load ext entry (ptr); 197 dcl cobol_make_type9$fixed_bin_35 198 ext entry (ptr, fixed bin, fixed bin); 199 dcl cobol_make_type9$type2_3 200 ext entry (ptr, ptr); 201 dcl cobol_compare_gen ext entry (ptr); 202 203 204 205 /* DECLARATIONS OF BUILTIN FUNCTIONSS */ 206 207 dcl addr builtin; 208 dcl fixed builtin; 209 dcl null builtin; 210 211 /* DECLARATION OF INTERNAL STATIC VARIABLES */ 212 213 dcl first_ix fixed bin int static init (2); 214 215 dcl div_code fixed bin int static init (185); 216 dcl mpy_code fixed bin int static init (184); 217 dcl subtract_code fixed bin int static init (183); 218 219 /* Definition of an internal static buffer in which an EOS token is built for calls to the MOVE gen. */ 220 221 dcl move_eos_buffer (1:10) ptr int static; 222 223 /* Definition of an internal static buffer in which an in_token is built for calls to the MOVE gen. */ 224 225 dcl move_in_token_buffer 226 (1:10) ptr int static; 227 dcl temp_in_token_buffer 228 (1:10) ptr int static; 229 dcl move_data_init fixed bin int static init (0); 230 231 232 dcl 1 numeric_lit_zero int static, 233 2 size fixed bin (15) init (36), 234 2 line fixed bin (15) init (0), 235 2 column fixed bin (15) init (0), 236 2 type fixed bin (15) init (2), /* NUMERIC LITERAL */ 237 2 integral bit (1) init ("1"b), 238 2 floating bit (1) init ("0"b), 239 2 filler1 bit (5) init ("00000"b), 240 2 subscript bit (1) init ("0"b), 241 2 sign char (1) init (" "), 242 2 exp_sign char (1) init (" "), 243 2 exp_places fixed bin (15) init (0), 244 2 places_left fixed bin (15) init (1), 245 2 places_right fixed bin (15) init (0), 246 2 places fixed bin (15) init (1), 247 2 literal char (1) init ("0"); 248 249 250 251 dcl 1 compare_eos_token int static, 252 2 size fixed bin (15) init (38), 253 2 line fixed bin (15) init (0), 254 2 column fixed bin (15) init (0), 255 2 type fixed bin (15) init (19), /* EOS */ 256 2 verb fixed bin (15) init (13), /* BRANCH */ 257 2 e fixed bin (15) init (102), /* EQUAL */ 258 2 h fixed bin (15) init (0), 259 2 i bit (36) init ("000"b); /* TRANSFER IF CONDITION TRUE */ 260 261 262 263 264 /* DECLARATION OF INTERNAL AUTOMATIC VARIABLES */ 265 266 dcl ose_flag bit (1); 267 dcl receive_count fixed bin; 268 269 /*[5.3-2]*/ 270 dcl (fmt1, abit) bit (1); 271 dcl remainder_present bit (1); 272 273 274 275 dcl ix fixed bin; 276 dcl iy fixed bin; 277 dcl move_eos_ptr ptr; 278 dcl move_in_token_ptr ptr; 279 dcl divisor_token_ptr ptr; 280 dcl dividend_token_ptr ptr; 281 dcl resultant_operand_ptr 282 ptr; 283 dcl saved_ptr ptr; 284 dcl product_token_ptr ptr; 285 dcl difference_token_ptr 286 ptr; 287 dcl quotient_token_ptr ptr; 288 289 dcl rdmax_value fixed bin; 290 dcl overflow_code_generated 291 bit (1); 292 dcl possible_ovfl_flag bit (1); 293 dcl receiving_is_not_stored 294 bit (1); 295 dcl size_error_inst bit (36); 296 dcl size_error_inst_ptr ptr; 297 dcl size_error_token_ptr 298 ptr; 299 dcl stored_token_ptr ptr; 300 dcl no_overflow_tag fixed bin; 301 dcl imperative_stmt_tag fixed bin; 302 dcl remainder_code_tag fixed bin; 303 dcl op1_token_ptr ptr; 304 dcl op2_token_ptr ptr; 305 dcl temp_resultant_operand_ptr 306 ptr; 307 dcl (binary_ok, not_bit) 308 bit (1); 309 dcl source_code fixed bin; 310 dcl target_code fixed bin; 311 dcl rounded_flag bit (1); 312 dcl ret_offset fixed bin; 313 dcl temp_save_ptr ptr; 314 315 dcl dn_ptr ptr; 316 317 318 /**************************************************/ 319 start: /***..... if Trace_Bit then call cobol_gen_driver_$Tr_Beg(cdg);/**/ 320 /* Check to see if binary arithmetic (using A and Q) can be done 321* for this divide statement. */ 322 call cobol_binary_check$divide (in_token_ptr, binary_ok, target_code, source_code); 323 324 if binary_ok 325 then do; /* Binary arithmetic can be done. */ 326 call cobol_divide_bin_gen (in_token_ptr, next_stmt_tag); 327 328 go to dvx; 329 330 331 end; /* Binary arithmetic can be done. */ 332 333 /* Extract information from the EOS token. */ 334 eos_ptr = in_token.token_ptr (in_token.n); 335 336 337 /* ON SIZE ERROR flag */ 338 ose_flag = end_stmt.b; 339 340 341 /* Determine divide statement format. */ 342 /*[5.3-2]*/ 343 fmt1, abit = "0"b; 344 remainder_present = "0"b; 345 346 347 if end_stmt.a = "000"b 348 then do; /* FORMAT 1 divide */ 349 fmt1 = "1"b; 350 divisor_token_ptr = in_token.token_ptr (first_ix); 351 dividend_token_ptr = in_token.token_ptr (first_ix + 1); 352 receive_count = end_stmt.e; 353 354 /*[5.3-2]*/ 355 call lit_test (divisor_token_ptr); 356 357 358 end; /* FORMAT 1 divide */ 359 360 /*[5.3-2]*/ 361 else /*[5.3-2]*/ 362 if end_stmt.a = "001"b /* format 2 */ 363 /*[5.3-2]*/ 364 then call f23 (first_ix, first_ix + 1); /*[5.3-2]*/ 365 else /*[5.3-2]*/ 366 if end_stmt.a = "010"b /* format 3 */ 367 /*[5.3-2]*/ 368 then call f23 (first_ix + 1, first_ix); /*[5.3-2]*/ 369 else /*[5.3-2]*/ 370 if end_stmt.a = "011"b /* format 4 */ 371 /*[5.3-2]*/ 372 then call f45 (first_ix, first_ix + 1); /*[5.3-2]*/ 373 else call f45 (first_ix + 1, first_ix); /* format 5 */ 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 /*[5.3-2]*/ 391 abit = "1"b; 392 393 if ose_flag /* On size error clause was present, do processing common to all format divides. */ 394 then do; 395 396 /* Reserve a tag to be associated (by the cobol generator driver) with the next 397* cobol statement. */ 398 next_stmt_tag = cobol_$next_tag; 399 400 /* Reserve a tag to be associated with the imperative statement for the on size error. */ 401 402 imperative_stmt_tag = next_stmt_tag + 1; 403 cobol_$next_tag = cobol_$next_tag + 2; 404 405 406 /* Get a size error flag in the stack, and initialize it to zero. */ 407 408 /* Generate code to compare the divisor to zero. */ 409 410 saved_ptr = in_token_ptr; 411 in_token_ptr = addr (temp_in_token_buffer (1)); 412 413 in_token.n = 3; 414 in_token.token_ptr (1) = divisor_token_ptr; 415 in_token.token_ptr (2) = addr (numeric_lit_zero); 416 in_token.token_ptr (3) = addr (compare_eos_token); 417 418 /* Transfer to the imperative statement if divisor is zero. */ 419 420 compare_eos_token.h = imperative_stmt_tag; 421 422 call cobol_compare_gen (in_token_ptr); 423 424 in_token_ptr = saved_ptr; 425 426 size_error_inst_ptr = addr (size_error_inst); 427 call get_size_error_flag (size_error_token_ptr, size_error_inst_ptr); 428 429 end; /* On size error clause was present, do processing common to all format divides. */ 430 431 if ^fmt1 432 then do; /* NOT FORMAT 1 divide, divide the two operands and store the result in a temporary. */ 433 434 /* Build a resultant operand for the quotient. */ 435 436 call cobol_build_resop (divisor_token_ptr, dividend_token_ptr, div_code, resultant_operand_ptr, "0"b, 437 rdmax_value, possible_ovfl_flag); 438 439 /* Generate code to perform the division. */ 440 441 call cobol_mpy3 (divisor_token_ptr, dividend_token_ptr, resultant_operand_ptr, 2 /* DIVIDE */); 442 443 move_in_token_ptr = addr (move_in_token_buffer (1)); 444 move_eos_ptr = addr (move_eos_buffer (1)); 445 446 if move_data_init ^= cobol_$compile_count 447 then call init_move_data; 448 449 end; /* NOT format 1 divide, divide the two operrands and store the result in a temp. */ 450 451 452 /* Get subscript of pointer in the in_token array that points to first receiving field. */ 453 454 if remainder_present 455 then iy = in_token.n - 2; 456 else iy = in_token.n - receive_count; 457 458 do ix = 1 to receive_count; /* Generate code to get the quotient into the receiving field(s). */ 459 460 receiving_is_not_stored = "0"b; 461 rounded_flag = "0"b; 462 463 /* Generate code to store the contents of the receiving field into a temporary. Note that 464* if the receiving field is numeric edited or overpunch sign then it is not stored. */ 465 466 467 call srf (in_token.token_ptr (iy)); 468 469 /* Generate code to turn the overflow mask indicator bit ON */ 470 if ose_flag 471 then call cobol_fofl_mask$on; 472 473 if fmt1 /* Generate code to divide the first operand into the receiving field value, 474* and store the result into the receiving field. */ 475 then do; 476 477 move_in_token_ptr = null (); 478 479 if not_dec_operand (in_token.token_ptr (iy)) 480 then do; /* The receiving operand is not decimal. Must convert to decimal 481* before performing the division. */ 482 483 op1_token_ptr = divisor_token_ptr; 484 op2_token_ptr = in_token.token_ptr (iy); 485 486 /* Convert the non-decimal operand(s) , and build a temporary 487* into which to store the result of the computation. */ 488 489 call cobol_build_resop (op1_token_ptr, op2_token_ptr, div_code, 490 temp_resultant_operand_ptr, "0"b, rdmax_value, possible_ovfl_flag); 491 492 /* Generate code to divide the two operands, and 493* store the result into a temporary. */ 494 495 call cobol_mpy3 (op1_token_ptr, op2_token_ptr, temp_resultant_operand_ptr, 2); 496 497 /* Generate code to move the result of the add/subtract to 498* the receiving field. */ 499 500 move_in_token_ptr = addr (move_in_token_buffer (1)); 501 move_eos_ptr = addr (move_eos_buffer (1)); 502 503 if move_data_init ^= cobol_$compile_count 504 then call init_move_data; 505 506 move_in_token_ptr -> in_token.token_ptr (2) = temp_resultant_operand_ptr; 507 move_in_token_ptr -> in_token.token_ptr (3) = in_token.token_ptr (iy); 508 509 call cobol_arith_move_gen (move_in_token_ptr); 510 511 if move_in_token_ptr -> in_token.code ^= 0 512 then receiving_is_not_stored = "1"b; 513 514 end; /* The receiving operand is not decimal. Must convert 515* to decimal before performing the divide. */ 516 517 else do; /* Receiving operand is decimal. */ 518 519 if not_dec_operand (divisor_token_ptr) 520 then do; /* Left operand is not decimal--convert to decimal. */ 521 522 op1_token_ptr = divisor_token_ptr; 523 divisor_token_ptr = null (); 524 call cobol_num_to_udts (op1_token_ptr, divisor_token_ptr); 525 526 527 end; /* Left operand is not decimal--convert to decimal. */ 528 529 call cobol_mpy (divisor_token_ptr, in_token.token_ptr (iy), 2); 530 531 end; /* Receiving operand is decimal. */ 532 533 end; /* Generate code to divide the first operand into the receiving field 534* value, and store the result into the receiving field. */ 535 536 else do; /* Generate code to move the quotient already calculated into the receiving field. */ 537 538 move_in_token_ptr -> in_token.token_ptr (move_in_token_ptr -> in_token.n - 2) = 539 resultant_operand_ptr; 540 move_in_token_ptr -> in_token.token_ptr (move_in_token_ptr -> in_token.n - 1) = 541 in_token.token_ptr (iy); 542 543 /* save a pointer to the token to receive the quotient. */ 544 545 quotient_token_ptr = in_token.token_ptr (iy); 546 547 rounded_flag = quotient_token_ptr -> data_name.rounded; 548 call cobol_arith_move_gen (move_in_token_ptr); 549 550 if move_in_token_ptr -> in_token.code ^= 0 551 then receiving_is_not_stored = "1"b; 552 553 end; /* Generate code to move the product already calculated into the receiving 554* fields. */ 555 556 if ose_flag 557 then do; /* Generate code to test for overflow resulting from the divide/store 558* or move. */ 559 560 /* Reserve a tag to which to transfer if no overflow occurs. */ 561 562 no_overflow_tag = cobol_$next_tag; 563 cobol_$next_tag = cobol_$next_tag + 1; 564 565 /* Generate code to test for overflow. */ 566 567 call test_for_overflow (no_overflow_tag, size_error_inst_ptr, move_in_token_ptr); 568 569 /* Generate code to restore the saved receiving field. Note that if the 570* receiving field is numeric edited, no restoring is necessary. */ 571 572 if receiving_is_not_stored = "0"b 573 then call receiving_field (in_token.token_ptr (iy), stored_token_ptr, 2 /* RESTORE*/); 574 575 /* Otherwise, the receiving field is numeric edited, and the numeric 576* representation of the quotient must be pointed at by quotient_token_ptr 577* in case a remainder clause is present. */ 578 579 else quotient_token_ptr = move_in_token_ptr -> in_token.token_ptr (2); 580 581 /* Define the no_overflow_tag at the next instruction in the text segment. */ 582 583 call cobol_define_tag (no_overflow_tag); 584 585 /* Generate code to turn the overflow mask indicator bit OFF */ 586 587 call cobol_fofl_mask$off; 588 589 590 end; /* Generate code to test for overflow resulting from the multiply/store 591* or move. */ 592 593 else if receiving_is_not_stored /* Receiving field is numeric edited. The result has already been moved into 594* a temporary in an attempt to force overflow. Now generate code to move the temp 595* result into the numeric edited field. */ 596 then do; /* Move temp to numeric edited. */ 597 598 call cobol_move_gen (move_in_token_ptr); 599 600 /* set the quotient pointer to point to the temp that contains 601* the numeric representation of the quotient. */ 602 603 quotient_token_ptr = move_in_token_ptr -> in_token.token_ptr (2); 604 end; /* Move temp to numeric edited. */ 605 606 607 /* Increment the subscript to the next receiving field. */ 608 iy = iy + 1; 609 610 end; /* Generate code to get the quotient into the receiving field(s). */ 611 612 613 if remainder_present 614 then do; /* REMAINDER CLAUSE appeared in the divide statement. */ 615 616 /* At this point in execution, the following conditions are true: 617* 618* 1. quotient_token_ptr points to a token for the numeric representation 619* of the quotient. (If the receiving field was numeric edited, this pointer 620* differs from the pointer to the tgken that receives the numeric edited 621* representation of the quotient. ) 622* 2. divisor_token_ptr points to a token for the divisor. 623* 3. dividend_token_ptr points to the token for the dividend. 624* 625* */ 626 627 628 if ose_flag 629 then do; /* ON SIZE ERROR clause was present. Generate code to test to see 630* if overflow occurred during the divide. 631* If overflow did not occur, then transfer to the code that calculates the remainder 632* , otherwise transfer to the imperative_stmt_tag. */ 633 634 635 /* Reserve a tag to be defined at the first instruction of the code to be 636* generated to calculate the remainder. */ 637 638 remainder_code_tag = cobol_$next_tag; 639 cobol_$next_tag = cobol_$next_tag + 1; 640 641 /* Generate code to 642* a. Load the size error flag into A or Q. 643* b. Transfer if zero to the remainder_code_tag. 644* */ 645 646 call test_size_error (size_error_token_ptr, size_error_inst_ptr, remainder_code_tag, "1"b, 647 "0"b); 648 649 /* Generate code to transfer to the imperative statement. (The 650* statement contained in the ON SIZE ERROR clause) */ 651 652 call test_size_error (size_error_token_ptr, size_error_inst_ptr, imperative_stmt_tag, "0"b, 653 "0"b); 654 655 /* Define the remainder_code_tag. */ 656 657 call cobol_define_tag (remainder_code_tag); 658 659 end; /* ON SIZE ERROR clause was present. Generate code to see if overfllow 660* occurred... */ 661 662 receiving_is_not_stored = "0"b; 663 664 /* Calculate the product of the quotient (moved to the receiving field) and divisor. */ 665 666 if rounded_flag 667 then do; /* Quotient had ROUNDED specified. */ 668 /* Must get a truncated quotient, rather than a ROUNDED 669* quotient, before calculating the remainder. */ 670 671 /* Make a copy of the quotient token. */ 672 673 temp_save_ptr = quotient_token_ptr; 674 quotient_token_ptr = null (); 675 676 call cobol_make_type9$copy (quotient_token_ptr, temp_save_ptr); 677 678 /* Allocate space on the stack to receive the truncated quotient. */ 679 680 call cobol_alloc$stack (fixed (quotient_token_ptr -> data_name.item_length, 17), 0, 681 ret_offset); 682 683 /* Update the new quotient token. */ 684 685 quotient_token_ptr -> data_name.seg_num = 1000; 686 /* Stack */ 687 quotient_token_ptr -> data_name.offset = ret_offset; 688 quotient_token_ptr -> data_name.subscripted = "0"b; 689 quotient_token_ptr -> data_name.variable_length = "0"b; 690 quotient_token_ptr -> data_name.occurs_ptr = 0; 691 quotient_token_ptr -> data_name.rounded = "0"b; 692 /* NO ROUNDING */ 693 694 /* Call the arithmetic move generator to move the result of the 695* division into the temporary quotient field, without rounding. */ 696 697 move_in_token_ptr -> in_token.token_ptr (2) = resultant_operand_ptr; 698 move_in_token_ptr -> in_token.token_ptr (3) = quotient_token_ptr; 699 700 call cobol_arith_move_gen (move_in_token_ptr); 701 702 end; /* Quotient variable had RRUNDED specified. */ 703 704 705 /* Build a token for the resulting product. */ 706 707 call cobol_build_resop (divisor_token_ptr, quotient_token_ptr, mpy_code, product_token_ptr, "0"b, 708 rdmax_value, possible_ovfl_flag); 709 710 /* Generate code to perform the multiplication. */ 711 712 call cobol_mpy3 (divisor_token_ptr, quotient_token_ptr, product_token_ptr, 1 /*MPY*/); 713 714 /* Calculate the difference between the dividend and the product. */ 715 716 /* Build a token for the resulting difference. */ 717 718 call cobol_build_resop (dividend_token_ptr, product_token_ptr, subtract_code, difference_token_ptr, 719 "0"b, rdmax_value, possible_ovfl_flag); 720 721 /* Generate code to perform the subtraction. */ 722 723 call cobol_add3 (product_token_ptr, dividend_token_ptr, difference_token_ptr, 2 /*SUBTRACT*/); 724 725 /* Move the difference into the remainder variable. */ 726 727 /* Set up the in token structure for a call to the move generator. */ 728 729 move_in_token_ptr -> in_token.token_ptr (move_in_token_ptr -> in_token.n - 1) = 730 in_token.token_ptr (in_token.n - 1); 731 /* Receiving field */ 732 733 move_in_token_ptr -> in_token.token_ptr (move_in_token_ptr -> in_token.n - 2) = difference_token_ptr; 734 /* Remainder to be moved. */ 735 736 /* Generate code to store the contents of the receiving field into a temporary. Note 737* that if the receiving field is numeric edited, no storing is necessary. */ 738 739 if ose_flag 740 then call srf (in_token.token_ptr (in_token.n - 1)); 741 742 /* Generate code to turn the overflow mask enable bit ON */ 743 744 if ose_flag 745 then call cobol_fofl_mask$on; 746 747 748 /* Generate code to move the remainder into the receiving field. */ 749 750 call cobol_arith_move_gen (move_in_token_ptr); 751 752 if move_in_token_ptr -> in_token.code ^= 0 753 then receiving_is_not_stored = "1"b; 754 755 if ose_flag 756 then do; /* Generate code to test for overflow resulting from the move. */ 757 758 /* Reserve a tag to which to transfer if no overflow occurred. */ 759 760 no_overflow_tag = cobol_$next_tag; 761 cobol_$next_tag = cobol_$next_tag + 1; 762 763 /* Generate code to test for overflow. */ 764 765 call test_for_overflow (no_overflow_tag, size_error_inst_ptr, move_in_token_ptr); 766 767 /* Generate code to restore the stored value to the receiving field. */ 768 if receiving_is_not_stored = "0"b 769 then call receiving_field (in_token.token_ptr (in_token.n - 1), stored_token_ptr, 770 2 /*RESTORE*/); 771 772 773 /* Define the no overflow tag at the next instruction in the text segment. */ 774 775 call cobol_define_tag (no_overflow_tag); 776 777 /* Generate code to turn the overflow mask indicator bit OFF */ 778 779 call cobol_fofl_mask$off; 780 781 end; /* Generate code to test for overflow resulting from the move. */ 782 783 784 else if receiving_is_not_stored 785 then /* The receiving field is a numeric edited, and the result has been moved 786* to a temp in an attempt to force overflow. Now generate code to move the temp 787* to the numeric edited field. */ 788 call cobol_move_gen (move_in_token_ptr); 789 790 end; /* REMAINDER CLAUSE appeared in the divide statement. */ 791 792 793 794 if ose_flag 795 then do; /* Generate code that tests whether overflow occurred, and jumps over the 796* imperative stmt if no overflow occurred. */ 797 798 /*[4.0-1]*/ 799 if end_stmt.f = "01"b 800 then not_bit = "1"b; 801 else not_bit = "0"b; 802 803 call test_size_error (size_error_token_ptr, size_error_inst_ptr, next_stmt_tag, "1"b, not_bit); 804 805 /* Define the imperative_stmt_tag at the next instruction location. */ 806 807 call cobol_define_tag (imperative_stmt_tag); 808 809 end; /* Generate code that tests whether overflow occurred, and jumps over the 810* imperative stmt if on overflow occurred. */ 811 812 dvx: /***..... if Trace_Bit then call cobol_gen_driver_$Tr_End(cdg);/**/ 813 return; 814 815 srf: 816 proc (p); 817 818 dcl p ptr; 819 820 if p -> data_name.numeric_edited 821 | (p -> data_name.display & p -> data_name.item_signed & ^(p -> data_name.sign_separate)) 822 then receiving_is_not_stored = "1"b; 823 else call receiving_field (p, stored_token_ptr, 1); 824 825 end; 826 827 /***..... dcl cdg char(16) init("COBOL_DIVIDE_GEN");/**/ 828 829 /***..... dcl cobol_gen_driver_$Tr_Beg entry(char(*));/**/ 830 /***..... dcl cobol_gen_driver_$Tr_End entry(char(*));/**/ 831 832 /***..... dcl Trace_Bit bit(1) static external;/**/ 833 /***..... dcl Trace_Lev fixed bin static external;/**/ 834 /***..... dcl Trace_Line char(36) static external;/**/ 835 /***..... dcl ioa_ entry options(variable); /**/ 836 837 838 839 /**************************************************/ 840 /* INTERNAL PROCEDURE */ 841 /* get_size_error_flag */ 842 /**************************************************/ 843 844 get_size_error_flag: 845 proc (size_error_token_ptr, size_error_inst_ptr); 846 847 /* 848*FUNCTION 849* 850*The function of this procedure is to: 851* 852* 1. allocate a fixed bin (35) variable in the COBOL 853* program's run-time stack. 854* 2. build a data name token for the fixed binary variable. 855* 3. Emit code that stores zero into the fixed binary. 856* 4. Return a pointer to the data name token for the fixed 857* binary variable. 858* 5. Return a 36 bit non-eis instruction word that 859* contains the address of the fixed binary variable. 860* 861**/ 862 863 /* DECLARATION OF THE PARAMETERS */ 864 865 dcl size_error_token_ptr 866 ptr; 867 dcl size_error_inst_ptr ptr; 868 869 /* DESCRIPTION OF THE PARAMETERS */ 870 871 /* 872*PARAMETER DESCRIPTION 873* 874*size_error_token_ptr Points to the data name token 875* that describes the fixed binary 876* in the stack. (output) 877*size_error_inst_ptr Points to a 36 bit field in which 878* the non-eix address is constructed. 879* (output) 880* 881**/ 882 883 /* DECLARATION OF INTERNAL STATIC VARIABLES */ 884 885 dcl stz_op bit (10) int static init ("1001010000"b /*450(0)*/); 886 887 /* DECLARATION OF INTERNAL VARIABLES */ 888 889 dcl ret_offset fixed bin; 890 dcl size_error_inst_word 891 bit (36) based (size_error_inst_ptr); 892 dcl input_buffer (1:10) fixed bin; 893 dcl reloc_buffer (1:10) bit (5) aligned; 894 895 896 897 /*************************************************/ 898 /* START OF EXECUTION */ 899 /* INTERNAL PROCEDURE get_size_error_flag */ 900 /**************************************************/ 901 902 /* Allocate a 4 byte fixed binary number on a word boundary in the stack */ 903 904 call cobol_alloc$stack (4, 0, ret_offset); 905 906 /* Make a data name token for the fixed binary number. */ 907 908 size_error_token_ptr = null (); /* The utility will provide the buffer. */ 909 call cobol_make_type9$fixed_bin_35 (size_error_token_ptr, 1000 /*STACK*/, ret_offset); 910 911 /* Generate code to store zero in the stack temporary */ 912 913 input_ptr = addr (input_buffer (1)); 914 reloc_ptr = addr (reloc_buffer (1)); 915 916 input_struc_basic.type = 1; 917 input_struc_basic.operand_no = 0; 918 input_struc_basic.lock = 0; 919 input_struc_basic.segno = 1000; /* STACK */ 920 input_struc_basic.char_offset = ret_offset; /* From cobol_alloc$stack */ 921 922 size_error_inst_word = "0"b; 923 924 /* Get the non-eis instruction */ 925 926 call cobol_addr (input_ptr, size_error_inst_ptr, reloc_ptr); 927 928 /* Set the STZ opcode into the instruction word */ 929 930 size_error_inst_ptr -> inst_struc_basic.fill1_op = stz_op; 931 932 /* Emit the stz instruction */ 933 934 call cobol_emit (size_error_inst_ptr, reloc_ptr, 1); 935 936 /* Set the opcode in the non-eis instruction to "0"b */ 937 938 size_error_inst_ptr -> inst_struc_basic.fill1_op = "0"b; 939 940 end get_size_error_flag; 941 942 943 /**************************************************/ 944 /* INTERNAL PROCEDURE */ 945 /* receiving_field */ 946 /**************************************************/ 947 948 receiving_field: 949 proc (receiving_token_ptr, stored_token_ptr, function_code); 950 951 /* THIS IS NOT A VALID ENTRY POINT */ 952 953 /* DECLARATION OF THE PARAMETERS */ 954 955 dcl receiving_token_ptr ptr; 956 dcl stored_token_ptr ptr; 957 dcl function_code fixed bin; 958 959 /* DESCRIPTION OF THE PARAMETERS */ 960 961 /* 962*PARAMETER DESCRIPTION 963* 964*receiving_token_ptr Points to the data name token of the receiving 965* operand to be stored. (input) 966*stored_token_ptr Points to the data name token of the 967* temporary in which the receiving operand 968* is to be stored. (output) 969*function_code Code that indicates the function to perform 970* 971* value | function 972* ============================= 973* 1 | store 974* 2 | restore 975* 976**/ 977 978 /* DECLARATION OF INTERNAL STATIC VARIABLES */ 979 980 /* Definition of an EOS token used in calls to cobol_arith_move_gen */ 981 982 dcl 1 move_eos int static, 983 2 size fixed bin (15) init (32), 984 2 line fixed bin (15) init (0), 985 2 column fixed bin (15) init (0), 986 2 type fixed bin (15) init (19), /* EOS */ 987 2 verb fixed bin (15) init (18), /* MOVE */ 988 2 e fixed bin (15) init (0), 989 2 h fixed bin (15) init (0), 990 2 i fixed bin (15) init (0), 991 2 j fixed bin (15) init (0), 992 2 a bit (16) init ("0"b); 993 dcl always_an bit (1) static init ("0"b); 994 995 /* DECLARATIONS OF INTERNAL AUTOMATIC VARIABLES */ 996 997 dcl temp_in_token (1:10) ptr; 998 dcl move_eos_ptr ptr; 999 dcl tin_ptr ptr; 1000 dcl temp_save_ptr ptr; 1001 dcl ret_offset fixed bin; 1002 1003 if function_code = 1 1004 then call store; 1005 else call restore; 1006 1007 return; 1008 1009 1010 /*************************************************/ 1011 /* STORE ENTRY POINT */ 1012 /***************************************************/ 1013 1014 store: 1015 proc; 1016 1017 /* This entry point is used to generate code that stores the 1018*contents of a receiving operand into a temporary. */ 1019 1020 /* Modify the token for the receiving variable that is being stored, so that it 1021* looks like an alphanumeric instead of a numeric. This is done so that the move 1022* generator generates an alphanumeric (MLR) move to store the data. */ 1023 1024 /*[5.3-2]*/ 1025 if abit & ^(receiving_token_ptr -> data_name.ascii_packed_dec_h) 1026 then do; 1027 receiving_token_ptr -> data_name.numeric = "0"b; 1028 receiving_token_ptr -> data_name.alphanum = "1"b; 1029 end; 1030 else always_an = "1"b; 1031 1032 temp_save_ptr = null (); /* Utility will provide the buffer for data name token */ 1033 call cobol_make_type9$copy (temp_save_ptr, receiving_token_ptr); 1034 1035 /* Allocate space on the stack to hold the contents of the receiving field */ 1036 1037 call cobol_alloc$stack (fixed (temp_save_ptr -> data_name.item_length, 17), 0, ret_offset); 1038 1039 /* Update the data name for the temporary */ 1040 1041 temp_save_ptr -> data_name.seg_num = 1000; /* Stack */ 1042 temp_save_ptr -> data_name.offset = ret_offset; /* From cobol_alloc$stack */ 1043 temp_save_ptr -> data_name.subscripted = "0"b; 1044 temp_save_ptr -> data_name.variable_length = "0"b; 1045 temp_save_ptr -> data_name.occurs_ptr = 0; 1046 1047 /* Build the in_token structure for calling the move generator */ 1048 1049 tin_ptr = addr (temp_in_token (1)); 1050 move_eos_ptr = addr (move_eos); 1051 stored_token_ptr = temp_save_ptr; 1052 1053 tin_ptr -> in_token.n = 4; 1054 tin_ptr -> in_token.token_ptr (1) = null (); 1055 tin_ptr -> in_token.token_ptr (2) = receiving_token_ptr; 1056 /* operand to be stored */ 1057 tin_ptr -> in_token.token_ptr (3) = stored_token_ptr; 1058 /* Temp in which to store */ 1059 tin_ptr -> in_token.token_ptr (4) = move_eos_ptr; 1060 1061 1062 if always_an = "1"b 1063 then move_eos_ptr -> end_stmt.e = 10001; 1064 else move_eos_ptr -> end_stmt.e = 1; /* Set the number of receiving operands into the EOS */ 1065 1066 /* Call the move generator to move the contents */ 1067 1068 call cobol_move_gen (tin_ptr); 1069 1070 /* Reset the token for the variable being stored. */ 1071 1072 receiving_token_ptr -> data_name.numeric = "1"b; 1073 receiving_token_ptr -> data_name.alphanum = "0"b; 1074 always_an = "0"b; 1075 1076 end store; 1077 1078 1079 /**************************************************/ 1080 /* RESTORE ENTRY POIENT */ 1081 /**************************************************/ 1082 1083 restore: 1084 proc; 1085 1086 /* This entry point is used to restore the contents of a 1087*receiving operand from the contents of a temporary. */ 1088 1089 /* Set up the in_token structure for calling the move generator */ 1090 1091 tin_ptr = addr (temp_in_token (1)); 1092 move_eos_ptr = addr (move_eos); 1093 1094 tin_ptr -> in_token.n = 4; 1095 tin_ptr -> in_token.token_ptr (1) = null (); 1096 tin_ptr -> in_token.token_ptr (2) = stored_token_ptr; 1097 /* source */ 1098 tin_ptr -> in_token.token_ptr (3) = receiving_token_ptr; 1099 /* Receiving field */ 1100 tin_ptr -> in_token.token_ptr (4) = move_eos_ptr; /* move EOS token */ 1101 1102 /* Set the number of receiving fields into the move EOS */ 1103 1104 move_eos_ptr -> end_stmt.e = 1; 1105 1106 /* Modify the token for the receiving variable that is being stored, so that it 1107* looks like an alphanumeric instead of a numeric. This is done so that the move 1108* generator generates an alphanumeric (MLR) move to store the data. */ 1109 1110 if receiving_token_ptr -> data_name.ascii_packed_dec_h = "0"b 1111 then do; 1112 receiving_token_ptr -> data_name.numeric = "0"b; 1113 receiving_token_ptr -> data_name.alphanum = "1"b; 1114 end; 1115 1116 /* Call the move generator */ 1117 1118 call cobol_move_gen (tin_ptr); 1119 1120 /* Reset the token for the variable being stored. */ 1121 1122 receiving_token_ptr -> data_name.numeric = "1"b; 1123 receiving_token_ptr -> data_name.alphanum = "0"b; 1124 1125 end restore; 1126 1127 end receiving_field; 1128 1129 /**************************************************/ 1130 /* INTERNAL PROCEDURE */ 1131 /* test_for_overflow */ 1132 /**************************************************/ 1133 1134 test_for_overflow: 1135 proc (no_overflow_tag, size_error_inst_ptr, move_in_token_ptr); 1136 1137 /* 1138*FUNCTION 1139*The function of this procedure is to generate the following 1140*sequence of code: 1141* 1142* tov 2,ic 1143* tra no_overflow_tag 1144* aos size_error_flag 1145**/ 1146 1147 /* DECLARATION OF THE PARAMETERS */ 1148 1149 dcl no_overflow_tag fixed bin; 1150 dcl size_error_inst_ptr ptr; 1151 dcl move_in_token_ptr ptr; 1152 1153 /* DESCRIPTION OF THE PARAMETERS */ 1154 1155 /* 1156*PARAMETER DESCRIPTION 1157* 1158*no_overflow_tag Contains the compiler generated tag to which 1159* to transfer if there is no overflow. (input) 1160*size_error_inst_ptr Points to a 36 bit field that contains a 1161* non-eis instruction, which contains the address 1162* of the size error flag. (input) 1163* 1164**/ 1165 1166 /* DECLARATIONS OF INTERNAL STATIC VARIABLES */ 1167 1168 dcl tov_op bit (10) int static init ("1100011110"b /*617(0)*/); 1169 dcl tra_op bit (10) int static init ("1110010000"b /*710(0)*/); 1170 dcl aos_op bit (10) int static init ("0001011000"b /*054(0)*/); 1171 1172 /* DECLARATIONS OF INTERNAL AUTOMATIC VARIABLES. */ 1173 1174 dcl temp_inst_word bit (36); 1175 dcl temp_inst_ptr ptr; 1176 1177 dcl reloc_buffer (1:10) bit (5) aligned; 1178 dcl reloc_ptr ptr; 1179 1180 dcl save_locno fixed bin; 1181 dcl overflow_tag fixed bin; 1182 1183 /**************************************************/ 1184 /* START OF EXECUTION */ 1185 /* test_for_overflow */ 1186 /**************************************************/ 1187 1188 1189 temp_inst_word = "0"b; 1190 temp_inst_ptr = addr (temp_inst_word); 1191 1192 /* Insert tov opcode */ 1193 1194 temp_inst_ptr -> inst_struc_basic.fill1_op = tov_op; 1195 1196 /* Reserve a tag to which to transfer if overflow occurs. */ 1197 1198 overflow_tag = cobol_$next_tag; 1199 1200 cobol_$next_tag = cobol_$next_tag + 1; 1201 1202 1203 reloc_ptr = addr (reloc_buffer (1)); 1204 reloc_buffer (1) = "0"b; 1205 reloc_buffer (2) = "0"b; 1206 1207 /* Emit the instruction */ 1208 1209 call cobol_emit (temp_inst_ptr, reloc_ptr, 1); 1210 1211 /* Make a tagref to the overflow tag at the instruction just emitted. */ 1212 1213 call cobol_make_tagref (overflow_tag, cobol_$text_wd_off - 1, null ()); 1214 1215 1216 if move_in_token_ptr ^= null () 1217 then if move_in_token_ptr -> in_token.code ^= 0 1218 then call cobol_move_gen (move_in_token_ptr);/* Move a temp result into a numeric edited. */ 1219 1220 1221 /* Generate the tra to no_overflow_tag */ 1222 1223 temp_inst_word = "0"b; 1224 temp_inst_ptr -> inst_struc_basic.fill1_op = tra_op; 1225 1226 save_locno = cobol_$text_wd_off; 1227 1228 /* Emit the tra instruction */ 1229 1230 call cobol_emit (temp_inst_ptr, reloc_ptr, 1); 1231 1232 /* Make a tagref to the no_overflow_tag at the tra instruction just emitted. */ 1233 1234 call cobol_make_tagref (no_overflow_tag, save_locno, null ()); 1235 1236 /* Generate aos instruction which increments the size error flag */ 1237 /* Define the overflow_tag at the aos instruction */ 1238 1239 call cobol_define_tag (overflow_tag); 1240 size_error_inst_ptr -> inst_struc_basic.fill1_op = aos_op; 1241 1242 /* Emit the instruction */ 1243 1244 call cobol_emit (size_error_inst_ptr, reloc_ptr, 1); 1245 1246 /* Reset the opcode field of the non-eis instruction */ 1247 1248 size_error_inst_ptr -> inst_struc_basic.fill1_op = "0"b; 1249 1250 1251 end test_for_overflow; 1252 1253 /**************************************************/ 1254 /* INTERNAL PROCEDURE */ 1255 /* test_size_error */ 1256 /**************************************************/ 1257 1258 1259 test_size_error: 1260 proc (size_error_token_ptr, size_error_inst_ptr, next_stmt_tag, overflow_code_generated, not_bit); 1261 1262 /* 1263* 1264*FUNCTION 1265* 1266*This internal procedure performs the following functions: 1267* 1268* If the overflow_code generated flag is "1"b then 1269* the following functions are performed: 1270* 1. Gets the A of Q register 1271* 2. Generates two instructions. 1272* a. LDA or LDQ with the contents of the size error flag 1273* b. TZE to the next_stmt_tag 1274* If the overflow_code_generated flag is "0"b, then 1275* the following instruction is generated: 1276* TRA to the next_stmt_tag 1277* 1278* 1279**/ 1280 1281 /* DECLARATION OF THE PARAMETERS */ 1282 1283 dcl size_error_token_ptr 1284 ptr; 1285 dcl size_error_inst_ptr ptr; 1286 dcl next_stmt_tag fixed bin; 1287 dcl (overflow_code_generated, not_bit) 1288 bit (1); 1289 1290 /* DESCRIPTION OF THE PARAMETERS */ 1291 1292 /* 1293*PARAMETER DESCRIPTION 1294* 1295*size_error_token_ptr Points to a data name token 1296* for the size error flag. (input) 1297* 1298*size_error_inst_ptr Points to a 36 bit field that contains 1299* the non-eis address of the size 1300* error flag in the run-time stack. 1301* (input) 1302*next_stmt_tag Contains a compiler generated tag 1303* to be associated with the next 1304* Cobol statement. (input) 1305*overflow_code_generated Contains a one bit indicator that 1306* is "1"b if overflow testing 1307* code was generated for this statement. 1308* (input) 1309*not_bit "1"b if NOT option follows 1310**/ 1311 1312 /* DECLARATION OF INTERNAL STATIC VARIABLES. */ 1313 1314 dcl lda_op bit (10) int static init ("0100111010"b /*235(0)*/); 1315 dcl ldq_op bit (10) int static init ("0100111100"b /*236(0)*/); 1316 dcl tze_op bit (10) int static init ("1100000000"b /*600(0)*/); 1317 dcl tnz_op bit (10) int static init ("1100000010"b /*601(0)*/); 1318 /*[4.0-1]*/ 1319 dcl tra_op bit (10) int static init ("1110010000"b /*710(0)*/); 1320 1321 1322 /* DECLARATIONS OF INTERNAL AUTOMATIC VARIABLES */ 1323 1324 /* Structure used to communicate with the register$load procedure. */ 1325 1326 dcl 1 register_struc, 1327 2 what_reg fixed bin, 1328 2 reg_no bit (4), 1329 2 lock fixed bin, 1330 2 already_there fixed bin, 1331 2 contains fixed bin, 1332 2 dname_ptr ptr, 1333 2 literal bit (36); 1334 1335 dcl temp_inst_word bit (36); 1336 dcl temp_inst_ptr ptr; 1337 1338 dcl save_locno fixed bin; 1339 dcl reloc_buffer (1:10) bit (5) aligned; 1340 dcl reloc_ptr ptr; 1341 dcl size_error_inst bit (36) based (size_error_inst_ptr); 1342 1343 1344 /**************************************************/ 1345 /* START OF EXECUTION */ 1346 /* test_size_error */ 1347 /**************************************************/ 1348 reloc_ptr = addr (reloc_buffer (1)); 1349 reloc_buffer (1) = "0"b; 1350 reloc_buffer (2) = "0"b; 1351 1352 1353 if overflow_code_generated 1354 then do; /* overflow code was generated, must load the size error flag and test it */ 1355 1356 size_error_inst_ptr = addr (size_error_inst); 1357 1358 /* Get the A or Q register */ 1359 1360 register_struc.what_reg = 0; /* A or Q */ 1361 register_struc.lock = 0; /* No change to locks */ 1362 register_struc.contains = 1; /* Register will contain a data item */ 1363 register_struc.dname_ptr = size_error_token_ptr; 1364 1365 call cobol_register$load (addr (register_struc)); 1366 1367 /* Build the LDA or LDQ instruction */ 1368 1369 if register_struc.reg_no = "0001"b 1370 then size_error_inst_ptr -> inst_struc_basic.fill1_op = lda_op; 1371 /* A reg */ 1372 else size_error_inst_ptr -> inst_struc_basic.fill1_op = ldq_op; 1373 /* Q reg */ 1374 1375 1376 /* Emit the LDA or LDQ instruction */ 1377 1378 call cobol_emit (size_error_inst_ptr, reloc_ptr, 1); 1379 end; /* overflow code was generated, must load the size error flag and test it */ 1380 1381 1382 /* Generate a TZE or TRA instruction */ 1383 1384 temp_inst_word = "0"b; 1385 temp_inst_ptr = addr (temp_inst_word); 1386 1387 if overflow_code_generated /*[4.2-1]*/ 1388 then if not_bit /*[4.2-1]*/ 1389 then temp_inst_ptr -> inst_struc_basic.fill1_op = tnz_op; 1390 /*[4.2-1]*/ 1391 else temp_inst_ptr -> inst_struc_basic.fill1_op = tze_op; 1392 else temp_inst_ptr -> inst_struc_basic.fill1_op = tra_op; 1393 1394 /* Save the text word offset at which the tze is to be emitted */ 1395 1396 save_locno = cobol_$text_wd_off; 1397 1398 /* Emit the instruction */ 1399 1400 call cobol_emit (temp_inst_ptr, reloc_ptr, 1); 1401 1402 /* Generate a tagref to the next cobol statement at the TZE or TRA just emitted */ 1403 1404 call cobol_make_tagref (next_stmt_tag, save_locno, null ()); 1405 1406 1407 end test_size_error; 1408 1409 not_dec_operand: 1410 proc (token_ptr) returns (bit (1)); 1411 1412 /* This function procedure determines whether an input data 1413*name token represents a data item that is not decimal, 1414*namely short fixed binary, long fixed binary, or overpunch 1415*sign. If the token represents a fixed binary or overpunch 1416*sign data item, then "1"b is returned. Otherwise "0"b is 1417*returned. */ 1418 1419 dcl token_ptr ptr; 1420 1421 if token_ptr -> data_name.bin_18 | token_ptr -> data_name.bin_36 1422 | token_ptr -> data_name.sign_type = "010"b /* leading not separate */ 1423 | token_ptr -> data_name.sign_type = "001"b /* trailing, not separate */ 1424 | (token_ptr -> data_name.display & token_ptr -> data_name.item_signed 1425 & token_ptr -> data_name.sign_separate = "0"b) 1426 /* Default overpunch. */ 1427 then return ("1"b); 1428 else return ("0"b); 1429 1430 end not_dec_operand; 1431 1432 1433 1434 /*************************************/ 1435 init_move_data: 1436 proc; 1437 1438 /* This internal procedure initializes the input token 1439*and EOS token used in calls to the cobol move generators. */ 1440 1441 /* Initialize in_token structure and EOS token structure 1442* used in calls to the MOVE generator. */ 1443 1444 saved_ptr = in_token_ptr; 1445 in_token_ptr = move_in_token_ptr; 1446 1447 in_token.n = 4; 1448 in_token.code = 0; 1449 in_token.token_ptr (1) = null (); 1450 in_token.token_ptr (in_token.n) = move_eos_ptr; 1451 in_token_ptr = saved_ptr; 1452 1453 saved_ptr = eos_ptr; 1454 eos_ptr = move_eos_ptr; 1455 1456 end_stmt.verb = 18; /* MOVE */ 1457 end_stmt.e = 1; /* COUNT of the receiving fields */ 1458 end_stmt.type = rtc_eos; 1459 eos_ptr = saved_ptr; 1460 1461 move_data_init = cobol_$compile_count; 1462 1463 end init_move_data; 1464 1465 rf: 1466 proc (p, q); 1467 1468 /*[5.3-2]*/ 1469 dcl (p, q) ptr; 1470 1471 /*[5.3-2]*/ 1472 call receiving_field (p, q, 1); /*[5.3-2]*/ 1473 q -> data_name.numeric = "1"b; /*[5.3-2]*/ 1474 q -> data_name.alphanum = "0"b; 1475 1476 end; 1477 1478 lit_test: 1479 proc (p); 1480 1481 /*[5.3-2]*/ 1482 dcl p ptr; 1483 1484 /*[5.3-2]*/ 1485 if p -> data_name.type ^= rtc_dataname /*[5.3-2]*/ 1486 then do; 1487 saved_ptr = p; /*[5.3-2]*/ 1488 p = null (); /*[5.3-2]*/ 1489 call cobol_make_type9$type2_3 (p, saved_ptr); 1490 /*[5.3-2]*/ 1491 end; 1492 end; 1493 1494 f23: 1495 proc (isor, idend); 1496 1497 /*[5.3-2]*/ 1498 dcl (isor, idend) fixed bin; 1499 1500 /*[5.3-2]*/ 1501 divisor_token_ptr = in_token.token_ptr (isor); /*[5.3-2]*/ 1502 dividend_token_ptr = in_token.token_ptr (idend); 1503 1504 /*[5.3-2]*/ 1505 receive_count = end_stmt.h; 1506 end; 1507 1508 f45: 1509 proc (isor, idend); 1510 1511 /*[5.3-2]*/ 1512 dcl (isor, idend) fixed bin; /*[5.3-2]*/ 1513 dcl (temp_divisor_token_ptr, temp_dividend_token_ptr) 1514 ptr; 1515 1516 /*[5.3-2]*/ 1517 temp_divisor_token_ptr = in_token.token_ptr (isor); 1518 /*[5.3-2]*/ 1519 temp_dividend_token_ptr = in_token.token_ptr (idend); 1520 1521 /*[5.3-2]*/ 1522 call lit_test (temp_divisor_token_ptr); /*[5.3-2]*/ 1523 call lit_test (temp_dividend_token_ptr); 1524 1525 /*[5.3-2]*/ 1526 call rf (temp_divisor_token_ptr, divisor_token_ptr); 1527 /*[5.3-2]*/ 1528 call rf (temp_dividend_token_ptr, dividend_token_ptr); 1529 1530 /*[5.3-2]*/ 1531 receive_count = 1; 1532 remainder_present = "1"b; 1533 end; 1534 1535 /**************************************************/ 1536 /* INCLUDE FILES USED BY THIS PROCEDURE */ 1537 /**************************************************/ 1538 1 1 1 2 /* BEGIN INCLUDE FILE ... cobol_type9.incl.pl1 */ 1 3 /* Last modified on 11/19/76 by ORN */ 1 4 1 5 /* 1 6*A type 9 data name token is entered into the name table by the data 1 7*division syntax phase for each data name described in the data division. 1 8*The replacement phase subsequently replaces type 8 user word references 1 9*to data names in the procedure division minpral file with the corresponding 1 10*type 9 tokens from the name table. 1 11**/ 1 12 1 13 /* dcl dn_ptr ptr; */ 1 14 1 15 /* BEGIN DECLARATION OF TYPE9 (DATA NAME) TOKEN */ 1 16 dcl 1 data_name based (dn_ptr), 2 1 2 2 /* begin include file ... cobol_TYPE9.incl.pl1 */ 2 3 /* Last modified on 06/19/77 by ORN */ 2 4 /* Last modified on 12/28/76 by FCH */ 2 5 2 6 /* header */ 2 7 2 size fixed bin, 2 8 2 line fixed bin, 2 9 2 column fixed bin, 2 10 2 type fixed bin, 2 11 /* body */ 2 12 2 string_ptr ptr, 2 13 2 prev_rec ptr, 2 14 2 searched bit (1), 2 15 2 duplicate bit (1), 2 16 2 saved bit (1), 2 17 2 debug_ind bit (1), 2 18 2 filler2 bit (3), 2 19 2 used_as_sub bit (1), 2 20 2 def_line fixed bin, 2 21 2 level fixed bin, 2 22 2 linkage fixed bin, 2 23 2 file_num fixed bin, 2 24 2 size_rtn fixed bin, 2 25 2 item_length fixed bin(24), 2 26 2 places_left fixed bin, 2 27 2 places_right fixed bin, 2 28 /* description */ 2 29 2 file_section bit (1), 2 30 2 working_storage bit (1), 2 31 2 constant_section bit (1), 2 32 2 linkage_section bit (1), 2 33 2 communication_section bit (1), 2 34 2 report_section bit (1), 2 35 2 level_77 bit (1), 2 36 2 level_01 bit (1), 2 37 2 non_elementary bit (1), 2 38 2 elementary bit (1), 2 39 2 filler_item bit (1), 2 40 2 s_of_rdf bit (1), 2 41 2 o_of_rdf bit (1), 2 42 2 bin_18 bit (1), 2 43 2 bin_36 bit (1), 2 44 2 pic_has_l bit (1), 2 45 2 pic_is_do bit (1), 2 46 2 numeric bit (1), 2 47 2 numeric_edited bit (1), 2 48 2 alphanum bit (1), 2 49 2 alphanum_edited bit (1), 2 50 2 alphabetic bit (1), 2 51 2 alphabetic_edited bit (1), 2 52 2 pic_has_p bit (1), 2 53 2 pic_has_ast bit (1), 2 54 2 item_signed bit(1), 2 55 2 sign_separate bit (1), 2 56 2 display bit (1), 2 57 2 comp bit (1), 2 58 2 ascii_packed_dec_h bit (1), /* as of 8/16/76 this field used for comp8. */ 2 59 2 ascii_packed_dec bit (1), 2 60 2 ebcdic_packed_dec bit (1), 2 61 2 bin_16 bit (1), 2 62 2 bin_32 bit (1), 2 63 2 usage_index bit (1), 2 64 2 just_right bit (1), 2 65 2 compare_argument bit (1), 2 66 2 sync bit (1), 2 67 2 temporary bit (1), 2 68 2 bwz bit (1), 2 69 2 variable_length bit (1), 2 70 2 subscripted bit (1), 2 71 2 occurs_do bit (1), 2 72 2 key_a bit (1), 2 73 2 key_d bit (1), 2 74 2 indexed_by bit (1), 2 75 2 value_numeric bit (1), 2 76 2 value_non_numeric bit (1), 2 77 2 value_signed bit (1), 2 78 2 sign_type bit (3), 2 79 2 pic_integer bit (1), 2 80 2 ast_when_zero bit (1), 2 81 2 label_record bit (1), 2 82 2 sign_clause_occurred bit (1), 2 83 2 okey_dn bit (1), 2 84 2 subject_of_keyis bit (1), 2 85 2 exp_redefining bit (1), 2 86 2 sync_in_rec bit (1), 2 87 2 rounded bit (1), 2 88 2 ad_bit bit (1), 2 89 2 debug_all bit (1), 2 90 2 overlap bit (1), 2 91 2 sum_counter bit (1), 2 92 2 exp_occurs bit (1), 2 93 2 linage_counter bit (1), 2 94 2 rnm_01 bit (1), 2 95 2 aligned bit (1), 2 96 2 not_user_writable bit (1), 2 97 2 database_key bit (1), 2 98 2 database_data_item bit (1), 2 99 2 seg_num fixed bin, 2 100 2 offset fixed bin(24), 2 101 2 initial_ptr fixed bin, 2 102 2 edit_ptr fixed bin, 2 103 2 occurs_ptr fixed bin, 2 104 2 do_rec char(5), 2 105 2 bitt bit (1), 2 106 2 byte bit (1), 2 107 2 half_word bit (1), 2 108 2 word bit (1), 2 109 2 double_word bit (1), 2 110 2 half_byte bit (1), 2 111 2 filler5 bit (1), 2 112 2 bit_offset bit (4), 2 113 2 son_cnt bit (16), 2 114 2 max_red_size fixed bin(24), 2 115 2 name_size fixed bin, 2 116 2 name char(0 refer(data_name.name_size)); 2 117 2 118 2 119 2 120 /* end include file ... cobol_TYPE9.incl.pl1 */ 2 121 1 17 1 18 /* END DECLARATION OF TYPE9 (DATA NAME) TOKEN */ 1 19 1 20 /* END INCLUDE FILE ... cobol_type9.incl.pl1 */ 1 21 1539 3 1 3 2 /* BEGIN INCLUDE FILE ... cobol_in_token.incl.pl1 */ 3 3 3 4 /* Last modified August 22, 1974 by AEG */ 3 5 3 6 3 7 declare in_token_ptr ptr; 3 8 3 9 declare 1 in_token aligned based(in_token_ptr), 3 10 2 n fixed bin aligned, 3 11 2 code fixed bin aligned, 3 12 2 token_ptr(0 refer(in_token.n)) ptr aligned; 3 13 3 14 3 15 /* END INCLUDE FILE ... cobol_in_token.incl.pl1 */ 3 16 1540 4 1 4 2 /* BEGIN INCLUDE FILE ... cobol_type19.incl.pl1 */ 4 3 /* last modified on 11/19/76 by ORN */ 4 4 4 5 /* 4 6*A type 19 end of statement token is created in the procedure division 4 7*minpral file at the end of each minpral statement generated by the 4 8*procedure division syntax phase. A minpral statement may be a complete or 4 9*partial source language statement. A type 19 token contains information 4 10*describing the statement which it delimits. 4 11**/ 4 12 4 13 dcl eos_ptr ptr; 4 14 4 15 /* BEGIN DECLARATION OF TYPE19 (END STATEMENT) TOKEN */ 4 16 dcl 1 end_stmt based (eos_ptr), 5 1 5 2 /* begin include file ... cobol_TYPE19.incl.pl1 */ 5 3 /* Last modified on 11/17/76 by ORN */ 5 4 5 5 /* header */ 5 6 2 size fixed bin, 5 7 2 line fixed bin, 5 8 2 column fixed bin, 5 9 2 type fixed bin, 5 10 /* body */ 5 11 2 verb fixed bin, 5 12 2 e fixed bin, 5 13 2 h fixed bin, 5 14 2 i fixed bin, 5 15 2 j fixed bin, 5 16 2 a bit (3), 5 17 2 b bit (1), 5 18 2 c bit (1), 5 19 2 d bit (2), 5 20 2 f bit (2), 5 21 2 g bit (2), 5 22 2 k bit (5), 5 23 2 always_an bit (1); 5 24 5 25 /* end include file ... cobol_TYPE19.incl.pl1 */ 5 26 4 17 4 18 /* END DECLARATION OF TYPE19 (END STATEMENT) TOKEN */ 4 19 4 20 /* 4 21*FIELD CONTENTS 4 22* 4 23*size The total size in bytes of this end of statement token. 4 24*line 0 4 25*column 0 4 26*type 19 4 27*verb A value indicating the verb in this statement 4 28* 1 = accept 4 29* 2 = add 4 30* 3 = on size error 4 31* 4 = alter 4 32* 5 = call 4 33* 7 = cancel 4 34* 8 = close 4 35* 9 = divide 4 36* 10 = multiply 4 37* 11 = subtract 4 38* 12 = exit 4 39* 14 = go 4 40* 15 = merge 4 41* 16 = initiate 4 42* 17 = inspect 4 43* 18 = move 4 44* 19 = open 4 45* 20 = perform 4 46* 21 = read 4 47* 23 = receive 4 48* 24 = release 4 49* 25 = return 4 50* 26 = search 4 51* 27 = rewrite 4 52* 29 = seek 4 53* 30 = send 4 54* 31 = set 4 55* 33 = stop 4 56* 34 = string 4 57* 35 = suspend 4 58* 36 = terminate 4 59* 37 = unstring 4 60* 38 = write 4 61* 39 = use 4 62* 40 = compute 4 63* 41 = disable 4 64* 42 = display 4 65* 43 = enable 4 66* 45 = generate 4 67* 46 = hold 4 68* 48 = process 4 69* 49 = sort 4 70* 52 = procedure 4 71* 53 = declaratives 4 72* 54 = section name 4 73* 55 = paragraph name 4 74* 98 = end 4 75*e,h,i,j The significance of these fields differs with each 4 76* statement. These fields are normally used as counters. 4 77*a,b,c,d,f,g,k The significance of these fields differs with each 4 78* statement. These fields are normally used as indicators. 4 79**/ 4 80 4 81 /* END INCLUDE FILE ... cobol_type19.incl.pl1 */ 4 82 1541 6 1 6 2 /* BEGIN INCLUDE FILE ... cobol_.incl.pl1 */ 6 3 /* last modified Feb 4, 1977 by ORN */ 6 4 6 5 /* This file defines all external data used in the generator phase of Multics Cobol */ 6 6 6 7 /* POINTERS */ 6 8 dcl cobol_$text_base_ptr ptr ext; 6 9 dcl text_base_ptr ptr defined (cobol_$text_base_ptr); 6 10 dcl cobol_$con_end_ptr ptr ext; 6 11 dcl con_end_ptr ptr defined (cobol_$con_end_ptr); 6 12 dcl cobol_$def_base_ptr ptr ext; 6 13 dcl def_base_ptr ptr defined (cobol_$def_base_ptr); 6 14 dcl cobol_$link_base_ptr ptr ext; 6 15 dcl link_base_ptr ptr defined (cobol_$link_base_ptr); 6 16 dcl cobol_$sym_base_ptr ptr ext; 6 17 dcl sym_base_ptr ptr defined (cobol_$sym_base_ptr); 6 18 dcl cobol_$reloc_text_base_ptr ptr ext; 6 19 dcl reloc_text_base_ptr ptr defined (cobol_$reloc_text_base_ptr); 6 20 dcl cobol_$reloc_def_base_ptr ptr ext; 6 21 dcl reloc_def_base_ptr ptr defined (cobol_$reloc_def_base_ptr); 6 22 dcl cobol_$reloc_link_base_ptr ptr ext; 6 23 dcl reloc_link_base_ptr ptr defined (cobol_$reloc_link_base_ptr); 6 24 dcl cobol_$reloc_sym_base_ptr ptr ext; 6 25 dcl reloc_sym_base_ptr ptr defined (cobol_$reloc_sym_base_ptr); 6 26 dcl cobol_$reloc_work_base_ptr ptr ext; 6 27 dcl reloc_work_base_ptr ptr defined (cobol_$reloc_work_base_ptr); 6 28 dcl cobol_$pd_map_ptr ptr ext; 6 29 dcl pd_map_ptr ptr defined (cobol_$pd_map_ptr); 6 30 dcl cobol_$fixup_ptr ptr ext; 6 31 dcl fixup_ptr ptr defined (cobol_$fixup_ptr); 6 32 dcl cobol_$initval_base_ptr ptr ext; 6 33 dcl initval_base_ptr ptr defined (cobol_$initval_base_ptr); 6 34 dcl cobol_$initval_file_ptr ptr ext; 6 35 dcl initval_file_ptr ptr defined (cobol_$initval_file_ptr); 6 36 dcl cobol_$perform_list_ptr ptr ext; 6 37 dcl perform_list_ptr ptr defined (cobol_$perform_list_ptr); 6 38 dcl cobol_$alter_list_ptr ptr ext; 6 39 dcl alter_list_ptr ptr defined (cobol_$alter_list_ptr); 6 40 dcl cobol_$seg_init_list_ptr ptr ext; 6 41 dcl seg_init_list_ptr ptr defined (cobol_$seg_init_list_ptr); 6 42 dcl cobol_$temp_token_area_ptr ptr ext; 6 43 dcl temp_token_area_ptr ptr defined (cobol_$temp_token_area_ptr); 6 44 dcl cobol_$temp_token_ptr ptr ext; 6 45 dcl temp_token_ptr ptr defined (cobol_$temp_token_ptr); 6 46 dcl cobol_$token_block1_ptr ptr ext; 6 47 dcl token_block1_ptr ptr defined (cobol_$token_block1_ptr); 6 48 dcl cobol_$token_block2_ptr ptr ext; 6 49 dcl token_block2_ptr ptr defined (cobol_$token_block2_ptr); 6 50 dcl cobol_$minpral5_ptr ptr ext; 6 51 dcl minpral5_ptr ptr defined (cobol_$minpral5_ptr); 6 52 dcl cobol_$tag_table_ptr ptr ext; 6 53 dcl tag_table_ptr ptr defined (cobol_$tag_table_ptr); 6 54 dcl cobol_$map_data_ptr ptr ext; 6 55 dcl map_data_ptr ptr defined (cobol_$map_data_ptr); 6 56 dcl cobol_$ptr_status_ptr ptr ext; 6 57 dcl ptr_status_ptr ptr defined (cobol_$ptr_status_ptr); 6 58 dcl cobol_$reg_status_ptr ptr ext; 6 59 dcl reg_status_ptr ptr defined (cobol_$reg_status_ptr); 6 60 dcl cobol_$misc_base_ptr ptr ext; 6 61 dcl misc_base_ptr ptr defined (cobol_$misc_base_ptr); 6 62 dcl cobol_$misc_end_ptr ptr ext; 6 63 dcl misc_end_ptr ptr defined (cobol_$misc_end_ptr); 6 64 dcl cobol_$list_ptr ptr ext; 6 65 dcl list_ptr ptr defined (cobol_$list_ptr); 6 66 dcl cobol_$allo1_ptr ptr ext; 6 67 dcl allo1_ptr ptr defined (cobol_$allo1_ptr); 6 68 dcl cobol_$eln_ptr ptr ext; 6 69 dcl eln_ptr ptr defined (cobol_$eln_ptr); 6 70 dcl cobol_$diag_ptr ptr ext; 6 71 dcl diag_ptr ptr defined (cobol_$diag_ptr); 6 72 dcl cobol_$xref_token_ptr ptr ext; 6 73 dcl xref_token_ptr ptr defined (cobol_$xref_token_ptr); 6 74 dcl cobol_$xref_chain_ptr ptr ext; 6 75 dcl xref_chain_ptr ptr defined (cobol_$xref_chain_ptr); 6 76 dcl cobol_$statement_info_ptr ptr ext; 6 77 dcl statement_info_ptr ptr defined (cobol_$statement_info_ptr); 6 78 dcl cobol_$reswd_ptr ptr ext; 6 79 dcl reswd_ptr ptr defined (cobol_$reswd_ptr); 6 80 dcl cobol_$op_con_ptr ptr ext; 6 81 dcl op_con_ptr ptr defined (cobol_$op_con_ptr); 6 82 dcl cobol_$ntbuf_ptr ptr ext; 6 83 dcl ntbuf_ptr ptr defined (cobol_$ntbuf_ptr); 6 84 dcl cobol_$main_pcs_ptr ptr ext; 6 85 dcl main_pcs_ptr ptr defined (cobol_$main_pcs_ptr); 6 86 dcl cobol_$include_info_ptr ptr ext; 6 87 dcl include_info_ptr ptr defined (cobol_$include_info_ptr); 6 88 6 89 /* FIXED BIN */ 6 90 dcl cobol_$text_wd_off fixed bin ext; 6 91 dcl text_wd_off fixed bin defined (cobol_$text_wd_off); 6 92 dcl cobol_$con_wd_off fixed bin ext; 6 93 dcl con_wd_off fixed bin defined (cobol_$con_wd_off); 6 94 dcl cobol_$def_wd_off fixed bin ext; 6 95 dcl def_wd_off fixed bin defined (cobol_$def_wd_off); 6 96 dcl cobol_$def_max fixed bin ext; 6 97 dcl def_max fixed bin defined (cobol_$def_max); 6 98 dcl cobol_$link_wd_off fixed bin ext; 6 99 dcl link_wd_off fixed bin defined (cobol_$link_wd_off); 6 100 dcl cobol_$link_max fixed bin ext; 6 101 dcl link_max fixed bin defined (cobol_$link_max); 6 102 dcl cobol_$sym_wd_off fixed bin ext; 6 103 dcl sym_wd_off fixed bin defined (cobol_$sym_wd_off); 6 104 dcl cobol_$sym_max fixed bin ext; 6 105 dcl sym_max fixed bin defined (cobol_$sym_max); 6 106 dcl cobol_$reloc_text_max fixed bin(24) ext; 6 107 dcl reloc_text_max fixed bin(24) defined (cobol_$reloc_text_max); 6 108 dcl cobol_$reloc_def_max fixed bin(24) ext; 6 109 dcl reloc_def_max fixed bin(24) defined (cobol_$reloc_def_max); 6 110 dcl cobol_$reloc_link_max fixed bin(24) ext; 6 111 dcl reloc_link_max fixed bin(24) defined (cobol_$reloc_link_max); 6 112 dcl cobol_$reloc_sym_max fixed bin(24) ext; 6 113 dcl reloc_sym_max fixed bin(24) defined (cobol_$reloc_sym_max); 6 114 dcl cobol_$reloc_work_max fixed bin(24) ext; 6 115 dcl reloc_work_max fixed bin(24) defined (cobol_$reloc_work_max); 6 116 dcl cobol_$pd_map_index fixed bin ext; 6 117 dcl pd_map_index fixed bin defined (cobol_$pd_map_index); 6 118 dcl cobol_$cobol_data_wd_off fixed bin ext; 6 119 dcl cobol_data_wd_off fixed bin defined (cobol_$cobol_data_wd_off); 6 120 dcl cobol_$stack_off fixed bin ext; 6 121 dcl stack_off fixed bin defined (cobol_$stack_off); 6 122 dcl cobol_$max_stack_off fixed bin ext; 6 123 dcl max_stack_off fixed bin defined (cobol_$max_stack_off); 6 124 dcl cobol_$init_stack_off fixed bin ext; 6 125 dcl init_stack_off fixed bin defined (cobol_$init_stack_off); 6 126 dcl cobol_$pd_map_sw fixed bin ext; 6 127 dcl pd_map_sw fixed bin defined (cobol_$pd_map_sw); 6 128 dcl cobol_$next_tag fixed bin ext; 6 129 dcl next_tag fixed bin defined (cobol_$next_tag); 6 130 dcl cobol_$data_init_flag fixed bin ext; 6 131 dcl data_init_flag fixed bin defined (cobol_$data_init_flag); 6 132 dcl cobol_$seg_init_flag fixed bin ext; 6 133 dcl seg_init_flag fixed bin defined (cobol_$seg_init_flag); 6 134 dcl cobol_$alter_flag fixed bin ext; 6 135 dcl alter_flag fixed bin defined (cobol_$alter_flag); 6 136 dcl cobol_$sect_eop_flag fixed bin ext; 6 137 dcl sect_eop_flag fixed bin defined (cobol_$sect_eop_flag); 6 138 dcl cobol_$para_eop_flag fixed bin ext; 6 139 dcl para_eop_flag fixed bin defined (cobol_$para_eop_flag); 6 140 dcl cobol_$priority_no fixed bin ext; 6 141 dcl priority_no fixed bin defined (cobol_$priority_no); 6 142 dcl cobol_$compile_count fixed bin ext; 6 143 dcl compile_count fixed bin defined (cobol_$compile_count); 6 144 dcl cobol_$ptr_assumption_ind fixed bin ext; 6 145 dcl ptr_assumption_ind fixed bin defined (cobol_$ptr_assumption_ind); 6 146 dcl cobol_$reg_assumption_ind fixed bin ext; 6 147 dcl reg_assumption_ind fixed bin defined (cobol_$reg_assumption_ind); 6 148 dcl cobol_$perform_para_index fixed bin ext; 6 149 dcl perform_para_index fixed bin defined (cobol_$perform_para_index); 6 150 dcl cobol_$perform_sect_index fixed bin ext; 6 151 dcl perform_sect_index fixed bin defined (cobol_$perform_sect_index); 6 152 dcl cobol_$alter_index fixed bin ext; 6 153 dcl alter_index fixed bin defined (cobol_$alter_index); 6 154 dcl cobol_$list_off fixed bin ext; 6 155 dcl list_off fixed bin defined (cobol_$list_off); 6 156 dcl cobol_$constant_offset fixed bin ext; 6 157 dcl constant_offset fixed bin defined (cobol_$constant_offset); 6 158 dcl cobol_$misc_max fixed bin ext; 6 159 dcl misc_max fixed bin defined (cobol_$misc_max); 6 160 dcl cobol_$pd_map_max fixed bin ext; 6 161 dcl pd_map_max fixed bin defined (cobol_$pd_map_max); 6 162 dcl cobol_$map_data_max fixed bin ext; 6 163 dcl map_data_max fixed bin defined (cobol_$map_data_max); 6 164 dcl cobol_$fixup_max fixed bin ext; 6 165 dcl fixup_max fixed bin defined (cobol_$fixup_max); 6 166 dcl cobol_$tag_table_max fixed bin ext; 6 167 dcl tag_table_max fixed bin defined (cobol_$tag_table_max); 6 168 dcl cobol_$temp_token_max fixed bin ext; 6 169 dcl temp_token_max fixed bin defined (cobol_$temp_token_max); 6 170 dcl cobol_$allo1_max fixed bin ext; 6 171 dcl allo1_max fixed bin defined (cobol_$allo1_max); 6 172 dcl cobol_$eln_max fixed bin ext; 6 173 dcl eln_max fixed bin defined (cobol_$eln_max); 6 174 dcl cobol_$debug_enable fixed bin ext; 6 175 dcl debug_enable fixed bin defined (cobol_$debug_enable); 6 176 dcl cobol_$non_source_offset fixed bin ext; 6 177 dcl non_source_offset fixed bin defined (cobol_$non_source_offset); 6 178 dcl cobol_$initval_flag fixed bin ext; 6 179 dcl initval_flag fixed bin defined (cobol_$initval_flag); 6 180 dcl cobol_$date_compiled_sw fixed bin ext; 6 181 dcl date_compiled_sw fixed bin defined (cobol_$date_compiled_sw); 6 182 dcl cobol_$include_cnt fixed bin ext; 6 183 dcl include_cnt fixed bin defined (cobol_$include_cnt); 6 184 dcl cobol_$fs_charcnt fixed bin ext; 6 185 dcl fs_charcnt fixed bin defined (cobol_$fs_charcnt); 6 186 dcl cobol_$ws_charcnt fixed bin ext; 6 187 dcl ws_charcnt fixed bin defined (cobol_$ws_charcnt); 6 188 dcl cobol_$coms_charcnt fixed bin ext; 6 189 dcl coms_charcnt fixed bin defined (cobol_$coms_charcnt); 6 190 dcl cobol_$ls_charcnt fixed bin ext; 6 191 dcl ls_charcnt fixed bin defined (cobol_$ls_charcnt); 6 192 dcl cobol_$cons_charcnt fixed bin ext; 6 193 dcl cons_charcnt fixed bin defined (cobol_$cons_charcnt); 6 194 dcl cobol_$value_cnt fixed bin ext; 6 195 dcl value_cnt fixed bin defined (cobol_$value_cnt); 6 196 dcl cobol_$cd_cnt fixed bin ext; 6 197 dcl cd_cnt fixed bin defined (cobol_$cd_cnt); 6 198 dcl cobol_$fs_wdoff fixed bin ext; 6 199 dcl fs_wdoff fixed bin defined (cobol_$fs_wdoff); 6 200 dcl cobol_$ws_wdoff fixed bin ext; 6 201 dcl ws_wdoff fixed bin defined (cobol_$ws_wdoff); 6 202 dcl cobol_$coms_wdoff fixed bin ext; 6 203 dcl coms_wdoff fixed bin defined (cobol_$coms_wdoff); 6 204 6 205 /* CHARACTER */ 6 206 dcl cobol_$scratch_dir char (168) aligned ext; 6 207 dcl scratch_dir char (168) aligned defined (cobol_$scratch_dir); /* -42- */ 6 208 dcl cobol_$obj_seg_name char (32) aligned ext; 6 209 dcl obj_seg_name char (32) aligned defined (cobol_$obj_seg_name); /* -8- */ 6 210 6 211 /* BIT */ 6 212 dcl cobol_$xref_bypass bit(1) aligned ext; 6 213 dcl xref_bypass bit(1) aligned defined (cobol_$xref_bypass); /* -1- */ 6 214 dcl cobol_$same_sort_merge_proc bit(1) aligned ext; 6 215 dcl same_sort_merge_proc bit(1) aligned defined (cobol_$same_sort_merge_proc); /* -1- */ 6 216 6 217 6 218 /* END INCLUDE FILE ... cobol_incl.pl1*/ 6 219 6 220 1542 7 1 7 2 /* BEGIN INCLUDE FILE ... cobol_addr_tokens.incl.pl1 */ 7 3 7 4 7 5 /****^ HISTORY COMMENTS: 7 6* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8058), 7 7* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 7 8* MCR8058 cobol_addr_tokens.incl.pl1 Change array extents to refer to 7 9* constants rather than variables. 7 10* END HISTORY COMMENTS */ 7 11 7 12 7 13 /* Last modified on 10/1/74 by tg */ 7 14 7 15 7 16 /* parameter list */ 7 17 7 18 dcl (input_ptr, inst_ptr, reloc_ptr) ptr; 7 19 7 20 7 21 /* input_struc_basic is used for type 1 addressing */ 7 22 7 23 dcl 1 input_struc_basic based (input_ptr), 7 24 2 type fixed bin, 7 25 2 operand_no fixed bin, 7 26 2 lock fixed bin, 7 27 2 segno fixed bin, 7 28 2 char_offset fixed bin (24), 7 29 2 send_receive fixed bin; 7 30 7 31 7 32 dcl 1 input_struc based (input_ptr), 7 33 2 type fixed bin, 7 34 2 operand_no fixed bin, 7 35 2 lock fixed bin, 7 36 2 operand (0 refer (input_struc.operand_no)), 7 37 3 token_ptr ptr, 7 38 3 send_receive fixed bin, 7 39 3 ic_mod fixed bin, 7 40 3 size_sw fixed bin; 7 41 7 42 /* reloc_struc is used for all types of addressing * all types */ 7 43 7 44 dcl 1 reloc_struc (input_struc.operand_no + 1) based (reloc_ptr), 7 45 2 left_wd bit (5) aligned, 7 46 2 right_wd bit (5) aligned; 7 47 7 48 /* Instruction format for 1 word instruction */ 7 49 7 50 7 51 dcl 1 inst_struc_basic based (inst_ptr) aligned, 7 52 2 y unaligned, 7 53 3 pr bit (3) unaligned, 7 54 3 wd_offset bit (15) unaligned, 7 55 2 fill1_op bit (10) unaligned, 7 56 2 zero1 bit (1) unaligned, 7 57 2 pr_spec bit (1) unaligned, 7 58 2 tm bit (2) unaligned, 7 59 2 td bit (4) unaligned; 7 60 7 61 7 62 /* The detailed definitions of the fields in this structure 7 63* can be found in the GMAP manual section 8 */ 7 64 /* EIS instruction format for 2_4 word instructions */ 7 65 7 66 dcl 1 inst_struc based (inst_ptr) aligned, 7 67 2 inst unaligned, 7 68 3 zero1 bit (2) unaligned, 7 69 3 mf3 unaligned, 7 70 4 pr_spec bit (1) unaligned, 7 71 4 reg_or_length bit (1) unaligned, 7 72 4 zero2 bit (1) unaligned, 7 73 4 reg_mod bit (4) unaligned, 7 74 3 zero3 bit (2) unaligned, 7 75 3 mf2 unaligned, 7 76 4 pr_spec bit (1) unaligned, 7 77 4 reg_or_length bit (1) unaligned, 7 78 4 zero4 bit (1) unaligned, 7 79 4 reg_mod bit (4) unaligned, 7 80 3 fill1_op bit (10) unaligned, 7 81 3 zero5 bit (1) unaligned, 7 82 3 mf1 unaligned, 7 83 4 pr_spec bit (1) unaligned, 7 84 4 reg_or_length bit (1) unaligned, 7 85 4 zero6 bit (1) unaligned, 7 86 4 reg_mod bit (4) unaligned, 7 87 2 desc_ext unaligned, 7 88 3 desc (512) unaligned, 7 89 4 desc_od bit (36) unaligned; 7 90 7 91 /* The detailed definitions of the fields in this structure 7 92* can be found in the GMAP manual section 8. 7 93* The desc_ext is the descriptor extension of this eis 7 94* instruction. The number of descriptors associated with 7 95* this instruction is equavalent to the operand number. 7 96* Depending on operand data type, the descriptor 7 97* can be alphanumeric or numeric. The structures of the 7 98* alphanumeric and the numeric descriptors are defined 7 99* below. */ 7 100 7 101 /* alphanumeric descriptor format */ 7 102 7 103 dcl 1 desc_an based (desc_an_ptr) unaligned, 7 104 2 desc_f (512) unaligned, 7 105 3 y unaligned, 7 106 4 pr bit (3) unaligned, 7 107 4 wd_offset bit (15) unaligned, 7 108 3 char_n bit (3) unaligned, 7 109 3 zero1 bit (1) unaligned, 7 110 3 ta bit (2), 7 111 3 n bit (12) unaligned; 7 112 7 113 7 114 /* The detailed definitions of the fields in this structure can 7 115* be found in the GMAP manual section 8. */ 7 116 /* numeric descriptor format */ 7 117 7 118 dcl desc_nn_ptr ptr; 7 119 dcl desc_an_ptr ptr; 7 120 7 121 7 122 dcl 1 desc_nn based (desc_nn_ptr) unaligned, 7 123 2 desc_f (512) unaligned, 7 124 3 y unaligned, 7 125 4 pr bit (3) unaligned, 7 126 4 wd_offset bit (15) unaligned, 7 127 3 digit_n bit (3) unaligned, 7 128 3 tn bit (1) unaligned, 7 129 3 sign_type bit (2) unaligned, 7 130 3 scal bit (6) unaligned, 7 131 3 n bit (6) unaligned; 7 132 7 133 7 134 /* The detailed definitions of fields in this structure can 7 135* be found in the GMAP manual section 8. */ 7 136 /* END INCLUDE FILE ... cobol_addr_tokens.incl.pl1 */ 7 137 1543 8 1 8 2 /* BEGIN INCLUDE FILE ... cobol_record_types.incl.pl1 */ 8 3 /* <<< LAST MODIFIED ON 09-09-75 by tlf >>> */ 8 4 8 5 dcl rtc_resword fixed bin (15) int static init(1); 8 6 dcl rtc_numlit fixed bin (15) int static init(2); 8 7 dcl rtc_alphalit fixed bin (15) int static init(3); 8 8 dcl rtc_picstring fixed bin (15) int static init(4); 8 9 dcl rtc_diag fixed bin (15) int static init(5); 8 10 dcl rtc_source fixed bin (15) int static init(6); 8 11 dcl rtc_procdef fixed bin (15) int static init(7); 8 12 dcl rtc_userwd fixed bin (15) int static init(8); 8 13 dcl rtc_dataname fixed bin (15) int static init(9); 8 14 dcl rtc_indexname fixed bin (15) int static init(10); 8 15 dcl rtc_condname fixed bin (15) int static init(11); 8 16 dcl rtc_filedef fixed bin (15) int static init(12); 8 17 dcl rtc_commdesc fixed bin (15) int static init(13); 8 18 dcl rtc_debugitems fixed bin (15) int static init(14); 8 19 dcl rtc_savedarea fixed bin (15) int static init(15); 8 20 dcl rtc_sortmerge fixed bin (15) int static init(16); 8 21 dcl rtc_mnemonic fixed bin (15) int static init(17); 8 22 dcl rtc_pararef fixed bin (15) int static init(18); 8 23 dcl rtc_eos fixed bin (15) int static init(19); 8 24 dcl rtc_reportname fixed bin (15) int static init(20); 8 25 dcl rtc_groupname fixed bin (15) int static init(21); 8 26 dcl rtc_reportentry fixed bin (15) int static init(22); 8 27 dcl rtc_unknown1 fixed bin (15) int static init(23); 8 28 dcl rtc_debugenable fixed bin (15) int static init(24); 8 29 dcl rtc_unknown2 fixed bin (15) int static init(25); 8 30 dcl rtc_unknown3 fixed bin (15) int static init(26); 8 31 dcl rtc_unknown4 fixed bin (15) int static init(27); 8 32 dcl rtc_unknown5 fixed bin (15) int static init(28); 8 33 dcl rtc_unknown6 fixed bin (15) int static init(29); 8 34 dcl rtc_internal_tag fixed bin (15) int static init(30); 8 35 dcl rtc_equate_tag fixed bin (15) int static init(31); 8 36 dcl rtc_register fixed bin (15) int static init(100); 8 37 dcl rtc_fdec_temp fixed bin (15) int static init(101); 8 38 dcl rtc_immed_const fixed bin (15) int static init(102); 8 39 8 40 /* END INCLUDE FILE ... cobol_record_types.incl.pl1 */ 8 41 1544 1545 1546 end cobol_divide_gen; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/00 1135.2 cobol_divide_gen.pl1 >udd>sm>ds>w>ml>cobol_divide_gen.pl1 1539 1 03/27/82 0539.9 cobol_type9.incl.pl1 >ldd>incl>cobol_type9.incl.pl1 1-17 2 11/11/82 1812.7 cobol_TYPE9.incl.pl1 >ldd>incl>cobol_TYPE9.incl.pl1 1540 3 11/11/82 1812.7 cobol_in_token.incl.pl1 >ldd>incl>cobol_in_token.incl.pl1 1541 4 03/27/82 0539.8 cobol_type19.incl.pl1 >ldd>incl>cobol_type19.incl.pl1 4-17 5 03/27/82 0539.6 cobol_TYPE19.incl.pl1 >ldd>incl>cobol_TYPE19.incl.pl1 1542 6 11/11/82 1812.7 cobol_.incl.pl1 >ldd>incl>cobol_.incl.pl1 1543 7 05/24/89 1159.1 cobol_addr_tokens.incl.pl1 >ldd>incl>cobol_addr_tokens.incl.pl1 1544 8 03/27/82 0539.8 cobol_record_types.incl.pl1 >ldd>incl>cobol_record_types.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. a 11 based bit(3) level 2 packed packed unaligned dcl 4-16 ref 347 361 365 369 abit 000103 automatic bit(1) packed unaligned dcl 270 set ref 343* 391* 1025 addr builtin function dcl 207 ref 411 415 416 426 443 444 500 501 913 914 1049 1050 1091 1092 1190 1203 1348 1356 1365 1365 1385 alphanum 21(19) based bit(1) level 2 packed packed unaligned dcl 1-16 set ref 1028* 1073* 1113* 1123* 1474* always_an 000145 internal static bit(1) initial packed unaligned dcl 993 set ref 1030* 1062 1074* aos_op constant bit(10) initial packed unaligned dcl 1170 ref 1240 ascii_packed_dec_h 21(29) based bit(1) level 2 packed packed unaligned dcl 1-16 ref 1025 1110 b 11(03) based bit(1) level 2 packed packed unaligned dcl 4-16 ref 338 bin_18 21(13) based bit(1) level 2 packed packed unaligned dcl 1-16 ref 1421 bin_36 21(14) based bit(1) level 2 packed packed unaligned dcl 1-16 ref 1421 binary_ok 000156 automatic bit(1) packed unaligned dcl 307 set ref 319* 324 char_offset 4 based fixed bin(24,0) level 2 dcl 7-23 set ref 920* cobol_$compile_count 000224 external static fixed bin(17,0) dcl 6-142 ref 446 503 1461 cobol_$next_tag 000222 external static fixed bin(17,0) dcl 6-128 set ref 398 403* 403 562 563* 563 638 639* 639 760 761* 761 1198 1200* 1200 cobol_$text_wd_off 000220 external static fixed bin(17,0) dcl 6-90 ref 1213 1226 1396 cobol_add3 000166 constant entry external dcl 185 ref 723 cobol_addr 000174 constant entry external dcl 188 ref 926 cobol_alloc$stack 000172 constant entry external dcl 187 ref 680 904 1037 cobol_arith_move_gen 000202 constant entry external dcl 191 ref 509 548 700 750 cobol_binary_check$divide 000146 constant entry external dcl 175 ref 319 cobol_build_resop 000160 constant entry external dcl 182 ref 436 489 707 718 cobol_compare_gen 000216 constant entry external dcl 201 ref 422 cobol_define_tag 000170 constant entry external dcl 186 ref 583 657 775 807 1239 cobol_divide_bin_gen 000150 constant entry external dcl 177 ref 326 cobol_emit 000176 constant entry external dcl 189 ref 934 1209 1230 1244 1378 1400 cobol_fofl_mask$off 000156 constant entry external dcl 181 ref 587 779 cobol_fofl_mask$on 000154 constant entry external dcl 180 ref 470 744 cobol_make_tagref 000206 constant entry external dcl 195 ref 1213 1234 1404 cobol_make_type9$copy 000204 constant entry external dcl 193 ref 676 1033 cobol_make_type9$fixed_bin_35 000212 constant entry external dcl 197 ref 909 cobol_make_type9$type2_3 000214 constant entry external dcl 199 ref 1489 cobol_move_gen 000200 constant entry external dcl 190 ref 598 784 1068 1118 1216 cobol_mpy 000164 constant entry external dcl 184 ref 529 cobol_mpy3 000162 constant entry external dcl 183 ref 441 495 712 cobol_num_to_udts 000152 constant entry external dcl 179 ref 524 cobol_register$load 000210 constant entry external dcl 196 ref 1365 code 1 based fixed bin(17,0) level 2 dcl 3-9 set ref 511 550 752 1216 1448* compare_eos_token 000123 internal static structure level 1 unaligned dcl 251 set ref 416 contains 4 000354 automatic fixed bin(17,0) level 2 dcl 1326 set ref 1362* data_name based structure level 1 unaligned dcl 1-16 difference_token_ptr 000126 automatic pointer dcl 285 set ref 718* 723* 733 display 21(27) based bit(1) level 2 packed packed unaligned dcl 1-16 ref 820 1421 div_code 000011 internal static fixed bin(17,0) initial dcl 215 set ref 436* 489* dividend_token_ptr 000116 automatic pointer dcl 280 set ref 351* 436* 441* 718* 723* 1502* 1528* divisor_token_ptr 000114 automatic pointer dcl 279 set ref 350* 355* 414 436* 441* 483 519* 522 523* 524* 529* 707* 712* 1501* 1526* dname_ptr 6 000354 automatic pointer level 2 dcl 1326 set ref 1363* e 5 based fixed bin(17,0) level 2 dcl 4-16 set ref 352 1062* 1064* 1104* 1457* end_stmt based structure level 1 unaligned dcl 4-16 eos_ptr 000166 automatic pointer dcl 4-13 set ref 334* 338 347 352 361 365 369 799 1453 1454* 1456 1457 1458 1459* 1505 f 11(07) based bit(2) level 2 packed packed unaligned dcl 4-16 ref 799 fill1_op 0(18) based bit(10) level 2 packed packed unaligned dcl 7-51 set ref 930* 938* 1194* 1224* 1240* 1248* 1369* 1372* 1387* 1391* 1392* first_ix 000010 internal static fixed bin(17,0) initial dcl 213 set ref 350 351 361* 361 365 365* 369* 369 373 373* fixed builtin function dcl 208 ref 680 680 1037 1037 fmt1 000102 automatic bit(1) packed unaligned dcl 270 set ref 343* 349* 431 473 function_code parameter fixed bin(17,0) dcl 957 ref 948 1003 h 6 based fixed bin(17,0) level 2 in structure "end_stmt" dcl 4-16 in procedure "cobol_divide_gen" ref 1505 h 6 000123 internal static fixed bin(15,0) initial level 2 in structure "compare_eos_token" dcl 251 in procedure "cobol_divide_gen" set ref 420* idend parameter fixed bin(17,0) dcl 1498 in procedure "f23" ref 1494 1502 idend parameter fixed bin(17,0) dcl 1512 in procedure "f45" ref 1508 1519 imperative_stmt_tag 000145 automatic fixed bin(17,0) dcl 301 set ref 402* 420 652* 807* in_token based structure level 1 dcl 3-9 in_token_ptr parameter pointer dcl 3-7 set ref 38 319* 326* 334 334 350 351 410 411* 413 414 415 416 422* 424* 454 456 467 479 484 507 529 540 545 572 729 729 739 739 768 768 1444 1445* 1447 1448 1449 1450 1450 1451* 1501 1502 1517 1519 input_buffer 000213 automatic fixed bin(17,0) array dcl 892 set ref 913 input_ptr 000170 automatic pointer dcl 7-18 set ref 913* 916 917 918 919 920 926* input_struc_basic based structure level 1 unaligned dcl 7-23 inst_struc_basic based structure level 1 dcl 7-51 isor parameter fixed bin(17,0) dcl 1498 in procedure "f23" ref 1494 1501 isor parameter fixed bin(17,0) dcl 1512 in procedure "f45" ref 1508 1517 item_length 16 based fixed bin(24,0) level 2 dcl 1-16 ref 680 680 1037 1037 item_signed 21(25) based bit(1) level 2 packed packed unaligned dcl 1-16 ref 820 1421 ix 000105 automatic fixed bin(17,0) dcl 275 set ref 458* iy 000106 automatic fixed bin(17,0) dcl 276 set ref 454* 456* 467 479 484 507 529 540 545 572 608* 608 lda_op constant bit(10) initial packed unaligned dcl 1314 ref 1369 ldq_op constant bit(10) initial packed unaligned dcl 1315 ref 1372 lock 2 000354 automatic fixed bin(17,0) level 2 in structure "register_struc" dcl 1326 in procedure "test_size_error" set ref 1361* lock 2 based fixed bin(17,0) level 2 in structure "input_struc_basic" dcl 7-23 in procedure "cobol_divide_gen" set ref 918* move_data_init 000110 internal static fixed bin(17,0) initial dcl 229 set ref 446 503 1461* move_eos 000133 internal static structure level 1 unaligned dcl 982 set ref 1050 1092 move_eos_buffer 000014 internal static pointer array dcl 221 set ref 444 501 move_eos_ptr 000272 automatic pointer dcl 998 in procedure "receiving_field" set ref 1050* 1059 1062 1064 1092* 1100 1104 move_eos_ptr 000110 automatic pointer dcl 277 in procedure "cobol_divide_gen" set ref 444* 501* 1450 1454 move_in_token_buffer 000040 internal static pointer array dcl 225 set ref 443 500 move_in_token_ptr parameter pointer dcl 1151 in procedure "test_for_overflow" set ref 1134 1216 1216 1216* move_in_token_ptr 000112 automatic pointer dcl 278 in procedure "cobol_divide_gen" set ref 443* 477* 500* 506 507 509* 511 538 538 540 540 548* 550 567* 579 598* 603 697 698 700* 729 729 733 733 750* 752 765* 784* 1445 mpy_code 000012 internal static fixed bin(17,0) initial dcl 216 set ref 707* n based fixed bin(17,0) level 2 dcl 3-9 set ref 334 413* 454 456 538 540 729 729 733 739 768 1053* 1094* 1447* 1450 next_stmt_tag parameter fixed bin(17,0) dcl 55 in procedure "cobol_divide_gen" set ref 38 326* 398* 402 803* next_stmt_tag parameter fixed bin(17,0) dcl 1286 in procedure "test_size_error" set ref 1259 1404* no_overflow_tag 000144 automatic fixed bin(17,0) dcl 300 in procedure "cobol_divide_gen" set ref 562* 567* 583* 760* 765* 775* no_overflow_tag parameter fixed bin(17,0) dcl 1149 in procedure "test_for_overflow" set ref 1134 1234* not_bit 000157 automatic bit(1) packed unaligned dcl 307 in procedure "cobol_divide_gen" set ref 799* 801* 803* not_bit parameter bit(1) packed unaligned dcl 1287 in procedure "test_size_error" ref 1259 1387 null builtin function dcl 209 ref 477 523 674 908 1032 1054 1095 1213 1213 1216 1234 1234 1404 1404 1449 1488 numeric 21(17) based bit(1) level 2 packed packed unaligned dcl 1-16 set ref 1027* 1072* 1112* 1122* 1473* numeric_edited 21(18) based bit(1) level 2 packed packed unaligned dcl 1-16 ref 820 numeric_lit_zero 000111 internal static structure level 1 unaligned dcl 232 set ref 415 occurs_ptr 27 based fixed bin(17,0) level 2 dcl 1-16 set ref 690* 1045* offset 24 based fixed bin(24,0) level 2 dcl 1-16 set ref 687* 1042* op1_token_ptr 000150 automatic pointer dcl 303 set ref 483* 489* 495* 522* 524* op2_token_ptr 000152 automatic pointer dcl 304 set ref 484* 489* 495* operand_no 1 based fixed bin(17,0) level 2 dcl 7-23 set ref 917* ose_flag 000100 automatic bit(1) packed unaligned dcl 266 set ref 338* 393 470 556 628 739 744 755 794 overflow_code_generated parameter bit(1) packed unaligned dcl 1287 ref 1259 1353 1387 overflow_tag 000345 automatic fixed bin(17,0) dcl 1181 set ref 1198* 1213* 1239* p parameter pointer dcl 818 in procedure "srf" set ref 815 820 820 820 820 823* p parameter pointer dcl 1469 in procedure "rf" set ref 1465 1472* p parameter pointer dcl 1482 in procedure "lit_test" set ref 1478 1485 1487 1488* 1489* possible_ovfl_flag 000133 automatic bit(1) packed unaligned dcl 292 set ref 436* 489* 707* 718* product_token_ptr 000124 automatic pointer dcl 284 set ref 707* 712* 718* 723* q parameter pointer dcl 1469 set ref 1465 1472* 1473 1474 quotient_token_ptr 000130 automatic pointer dcl 287 set ref 545* 547 579* 603* 673 674* 676* 680 680 685 687 688 689 690 691 698 707* 712* rdmax_value 000132 automatic fixed bin(17,0) dcl 289 set ref 436* 489* 707* 718* receive_count 000101 automatic fixed bin(17,0) dcl 267 set ref 352* 456 458 1505* 1531* receiving_is_not_stored 000134 automatic bit(1) packed unaligned dcl 293 set ref 460* 511* 550* 572 593 662* 752* 768 784 820* receiving_token_ptr parameter pointer dcl 955 set ref 948 1025 1027 1028 1033* 1055 1072 1073 1098 1110 1112 1113 1122 1123 reg_no 1 000354 automatic bit(4) level 2 packed packed unaligned dcl 1326 set ref 1369 register_struc 000354 automatic structure level 1 unaligned dcl 1326 set ref 1365 1365 reloc_buffer 000371 automatic bit(5) array dcl 1339 in procedure "test_size_error" set ref 1348 1349* 1350* reloc_buffer 000330 automatic bit(5) array dcl 1177 in procedure "test_for_overflow" set ref 1203 1204* 1205* reloc_buffer 000225 automatic bit(5) array dcl 893 in procedure "get_size_error_flag" set ref 914 reloc_ptr 000342 automatic pointer dcl 1178 in procedure "test_for_overflow" set ref 1203* 1209* 1230* 1244* reloc_ptr 000172 automatic pointer dcl 7-18 in procedure "cobol_divide_gen" set ref 914* 926* 934* reloc_ptr 000404 automatic pointer dcl 1340 in procedure "test_size_error" set ref 1348* 1378* 1400* remainder_code_tag 000146 automatic fixed bin(17,0) dcl 302 set ref 638* 646* 657* remainder_present 000104 automatic bit(1) packed unaligned dcl 271 set ref 344* 454 613 1532* resultant_operand_ptr 000120 automatic pointer dcl 281 set ref 436* 441* 538 697 ret_offset 000300 automatic fixed bin(17,0) dcl 1001 in procedure "receiving_field" set ref 1037* 1042 ret_offset 000212 automatic fixed bin(17,0) dcl 889 in procedure "get_size_error_flag" set ref 904* 909* 920 ret_offset 000163 automatic fixed bin(17,0) dcl 312 in procedure "cobol_divide_gen" set ref 680* 687 rounded 22(24) based bit(1) level 2 packed packed unaligned dcl 1-16 set ref 547 691* rounded_flag 000162 automatic bit(1) packed unaligned dcl 311 set ref 461* 547* 666 rtc_dataname constant fixed bin(15,0) initial dcl 8-13 ref 1485 rtc_eos constant fixed bin(15,0) initial dcl 8-23 ref 1458 save_locno 000370 automatic fixed bin(17,0) dcl 1338 in procedure "test_size_error" set ref 1396* 1404* save_locno 000344 automatic fixed bin(17,0) dcl 1180 in procedure "test_for_overflow" set ref 1226* 1234* saved_ptr 000122 automatic pointer dcl 283 set ref 410* 424 1444* 1451 1453* 1459 1487* 1489* seg_num 23 based fixed bin(17,0) level 2 dcl 1-16 set ref 685* 1041* segno 3 based fixed bin(17,0) level 2 dcl 7-23 set ref 919* sign_separate 21(26) based bit(1) level 2 packed packed unaligned dcl 1-16 ref 820 1421 sign_type 22(13) based bit(3) level 2 packed packed unaligned dcl 1-16 ref 1421 1421 size_error_inst 000135 automatic bit(36) packed unaligned dcl 295 in procedure "cobol_divide_gen" set ref 426 size_error_inst based bit(36) packed unaligned dcl 1341 in procedure "test_size_error" set ref 1356 size_error_inst_ptr parameter pointer dcl 867 in procedure "get_size_error_flag" set ref 844 922 926* 930 934* 938 size_error_inst_ptr parameter pointer dcl 1150 in procedure "test_for_overflow" set ref 1134 1240 1244* 1248 size_error_inst_ptr 000136 automatic pointer dcl 296 in procedure "cobol_divide_gen" set ref 426* 427* 567* 646* 652* 765* 803* size_error_inst_ptr parameter pointer dcl 1285 in procedure "test_size_error" set ref 1259 1356* 1356 1369 1372 1378* size_error_inst_word based bit(36) packed unaligned dcl 890 set ref 922* size_error_token_ptr parameter pointer dcl 865 in procedure "get_size_error_flag" set ref 844 908* 909* size_error_token_ptr parameter pointer dcl 1283 in procedure "test_size_error" ref 1259 1363 size_error_token_ptr 000140 automatic pointer dcl 297 in procedure "cobol_divide_gen" set ref 427* 646* 652* 803* source_code 000160 automatic fixed bin(17,0) dcl 309 set ref 319* stored_token_ptr parameter pointer dcl 956 in procedure "receiving_field" set ref 948 1051* 1057 1096 stored_token_ptr 000142 automatic pointer dcl 299 in procedure "cobol_divide_gen" set ref 572* 768* 823* stz_op constant bit(10) initial packed unaligned dcl 885 ref 930 subscripted 22(05) based bit(1) level 2 packed packed unaligned dcl 1-16 set ref 688* 1043* subtract_code 000013 internal static fixed bin(17,0) initial dcl 217 set ref 718* target_code 000161 automatic fixed bin(17,0) dcl 310 set ref 319* temp_dividend_token_ptr 000454 automatic pointer dcl 1513 set ref 1519* 1523* 1528* temp_divisor_token_ptr 000452 automatic pointer dcl 1513 set ref 1517* 1522* 1526* temp_in_token 000246 automatic pointer array dcl 997 set ref 1049 1091 temp_in_token_buffer 000064 internal static pointer array dcl 227 set ref 411 temp_inst_ptr 000326 automatic pointer dcl 1175 in procedure "test_for_overflow" set ref 1190* 1194 1209* 1224 1230* temp_inst_ptr 000366 automatic pointer dcl 1336 in procedure "test_size_error" set ref 1385* 1387 1391 1392 1400* temp_inst_word 000365 automatic bit(36) packed unaligned dcl 1335 in procedure "test_size_error" set ref 1384* 1385 temp_inst_word 000324 automatic bit(36) packed unaligned dcl 1174 in procedure "test_for_overflow" set ref 1189* 1190 1223* temp_resultant_operand_ptr 000154 automatic pointer dcl 305 set ref 489* 495* 506 temp_save_ptr 000276 automatic pointer dcl 1000 in procedure "receiving_field" set ref 1032* 1033* 1037 1037 1041 1042 1043 1044 1045 1051 temp_save_ptr 000164 automatic pointer dcl 313 in procedure "cobol_divide_gen" set ref 673* 676* tin_ptr 000274 automatic pointer dcl 999 set ref 1049* 1053 1054 1055 1057 1059 1068* 1091* 1094 1095 1096 1098 1100 1118* tnz_op constant bit(10) initial packed unaligned dcl 1317 ref 1387 token_ptr 2 based pointer array level 2 in structure "in_token" dcl 3-9 in procedure "cobol_divide_gen" set ref 334 350 351 414* 415* 416* 467* 479* 484 506* 507* 507 529* 538* 540* 540 545 572* 579 603 697* 698* 729* 729 733* 739* 768* 1054* 1055* 1057* 1059* 1095* 1096* 1098* 1100* 1449* 1450* 1501 1502 1517 1519 token_ptr parameter pointer dcl 1419 in procedure "not_dec_operand" ref 1409 1421 1421 1421 1421 1421 1421 1421 tov_op constant bit(10) initial packed unaligned dcl 1168 ref 1194 tra_op constant bit(10) initial packed unaligned dcl 1319 in procedure "test_size_error" ref 1392 tra_op constant bit(10) initial packed unaligned dcl 1169 in procedure "test_for_overflow" ref 1224 type 3 based fixed bin(17,0) level 2 in structure "data_name" dcl 1-16 in procedure "cobol_divide_gen" ref 1485 type based fixed bin(17,0) level 2 in structure "input_struc_basic" dcl 7-23 in procedure "cobol_divide_gen" set ref 916* type 3 based fixed bin(17,0) level 2 in structure "end_stmt" dcl 4-16 in procedure "cobol_divide_gen" set ref 1458* tze_op constant bit(10) initial packed unaligned dcl 1316 ref 1391 variable_length 22(04) based bit(1) level 2 packed packed unaligned dcl 1-16 set ref 689* 1044* verb 4 based fixed bin(17,0) level 2 dcl 4-16 set ref 1456* what_reg 000354 automatic fixed bin(17,0) level 2 dcl 1326 set ref 1360* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. allo1_max defined fixed bin(17,0) dcl 6-171 allo1_ptr defined pointer dcl 6-67 alter_flag defined fixed bin(17,0) dcl 6-135 alter_index defined fixed bin(17,0) dcl 6-153 alter_list_ptr defined pointer dcl 6-39 cd_cnt defined fixed bin(17,0) dcl 6-197 cobol_$allo1_max external static fixed bin(17,0) dcl 6-170 cobol_$allo1_ptr external static pointer dcl 6-66 cobol_$alter_flag external static fixed bin(17,0) dcl 6-134 cobol_$alter_index external static fixed bin(17,0) dcl 6-152 cobol_$alter_list_ptr external static pointer dcl 6-38 cobol_$cd_cnt external static fixed bin(17,0) dcl 6-196 cobol_$cobol_data_wd_off external static fixed bin(17,0) dcl 6-118 cobol_$coms_charcnt external static fixed bin(17,0) dcl 6-188 cobol_$coms_wdoff external static fixed bin(17,0) dcl 6-202 cobol_$con_end_ptr external static pointer dcl 6-10 cobol_$con_wd_off external static fixed bin(17,0) dcl 6-92 cobol_$cons_charcnt external static fixed bin(17,0) dcl 6-192 cobol_$constant_offset external static fixed bin(17,0) dcl 6-156 cobol_$data_init_flag external static fixed bin(17,0) dcl 6-130 cobol_$date_compiled_sw external static fixed bin(17,0) dcl 6-180 cobol_$debug_enable external static fixed bin(17,0) dcl 6-174 cobol_$def_base_ptr external static pointer dcl 6-12 cobol_$def_max external static fixed bin(17,0) dcl 6-96 cobol_$def_wd_off external static fixed bin(17,0) dcl 6-94 cobol_$diag_ptr external static pointer dcl 6-70 cobol_$eln_max external static fixed bin(17,0) dcl 6-172 cobol_$eln_ptr external static pointer dcl 6-68 cobol_$fixup_max external static fixed bin(17,0) dcl 6-164 cobol_$fixup_ptr external static pointer dcl 6-30 cobol_$fs_charcnt external static fixed bin(17,0) dcl 6-184 cobol_$fs_wdoff external static fixed bin(17,0) dcl 6-198 cobol_$include_cnt external static fixed bin(17,0) dcl 6-182 cobol_$include_info_ptr external static pointer dcl 6-86 cobol_$init_stack_off external static fixed bin(17,0) dcl 6-124 cobol_$initval_base_ptr external static pointer dcl 6-32 cobol_$initval_file_ptr external static pointer dcl 6-34 cobol_$initval_flag external static fixed bin(17,0) dcl 6-178 cobol_$link_base_ptr external static pointer dcl 6-14 cobol_$link_max external static fixed bin(17,0) dcl 6-100 cobol_$link_wd_off external static fixed bin(17,0) dcl 6-98 cobol_$list_off external static fixed bin(17,0) dcl 6-154 cobol_$list_ptr external static pointer dcl 6-64 cobol_$ls_charcnt external static fixed bin(17,0) dcl 6-190 cobol_$main_pcs_ptr external static pointer dcl 6-84 cobol_$map_data_max external static fixed bin(17,0) dcl 6-162 cobol_$map_data_ptr external static pointer dcl 6-54 cobol_$max_stack_off external static fixed bin(17,0) dcl 6-122 cobol_$minpral5_ptr external static pointer dcl 6-50 cobol_$misc_base_ptr external static pointer dcl 6-60 cobol_$misc_end_ptr external static pointer dcl 6-62 cobol_$misc_max external static fixed bin(17,0) dcl 6-158 cobol_$non_source_offset external static fixed bin(17,0) dcl 6-176 cobol_$ntbuf_ptr external static pointer dcl 6-82 cobol_$obj_seg_name external static char(32) dcl 6-208 cobol_$op_con_ptr external static pointer dcl 6-80 cobol_$para_eop_flag external static fixed bin(17,0) dcl 6-138 cobol_$pd_map_index external static fixed bin(17,0) dcl 6-116 cobol_$pd_map_max external static fixed bin(17,0) dcl 6-160 cobol_$pd_map_ptr external static pointer dcl 6-28 cobol_$pd_map_sw external static fixed bin(17,0) dcl 6-126 cobol_$perform_list_ptr external static pointer dcl 6-36 cobol_$perform_para_index external static fixed bin(17,0) dcl 6-148 cobol_$perform_sect_index external static fixed bin(17,0) dcl 6-150 cobol_$priority_no external static fixed bin(17,0) dcl 6-140 cobol_$ptr_assumption_ind external static fixed bin(17,0) dcl 6-144 cobol_$ptr_status_ptr external static pointer dcl 6-56 cobol_$reg_assumption_ind external static fixed bin(17,0) dcl 6-146 cobol_$reg_status_ptr external static pointer dcl 6-58 cobol_$reloc_def_base_ptr external static pointer dcl 6-20 cobol_$reloc_def_max external static fixed bin(24,0) dcl 6-108 cobol_$reloc_link_base_ptr external static pointer dcl 6-22 cobol_$reloc_link_max external static fixed bin(24,0) dcl 6-110 cobol_$reloc_sym_base_ptr external static pointer dcl 6-24 cobol_$reloc_sym_max external static fixed bin(24,0) dcl 6-112 cobol_$reloc_text_base_ptr external static pointer dcl 6-18 cobol_$reloc_text_max external static fixed bin(24,0) dcl 6-106 cobol_$reloc_work_base_ptr external static pointer dcl 6-26 cobol_$reloc_work_max external static fixed bin(24,0) dcl 6-114 cobol_$reswd_ptr external static pointer dcl 6-78 cobol_$same_sort_merge_proc external static bit(1) dcl 6-214 cobol_$scratch_dir external static char(168) dcl 6-206 cobol_$sect_eop_flag external static fixed bin(17,0) dcl 6-136 cobol_$seg_init_flag external static fixed bin(17,0) dcl 6-132 cobol_$seg_init_list_ptr external static pointer dcl 6-40 cobol_$stack_off external static fixed bin(17,0) dcl 6-120 cobol_$statement_info_ptr external static pointer dcl 6-76 cobol_$sym_base_ptr external static pointer dcl 6-16 cobol_$sym_max external static fixed bin(17,0) dcl 6-104 cobol_$sym_wd_off external static fixed bin(17,0) dcl 6-102 cobol_$tag_table_max external static fixed bin(17,0) dcl 6-166 cobol_$tag_table_ptr external static pointer dcl 6-52 cobol_$temp_token_area_ptr external static pointer dcl 6-42 cobol_$temp_token_max external static fixed bin(17,0) dcl 6-168 cobol_$temp_token_ptr external static pointer dcl 6-44 cobol_$text_base_ptr external static pointer dcl 6-8 cobol_$token_block1_ptr external static pointer dcl 6-46 cobol_$token_block2_ptr external static pointer dcl 6-48 cobol_$value_cnt external static fixed bin(17,0) dcl 6-194 cobol_$ws_charcnt external static fixed bin(17,0) dcl 6-186 cobol_$ws_wdoff external static fixed bin(17,0) dcl 6-200 cobol_$xref_bypass external static bit(1) dcl 6-212 cobol_$xref_chain_ptr external static pointer dcl 6-74 cobol_$xref_token_ptr external static pointer dcl 6-72 cobol_data_wd_off defined fixed bin(17,0) dcl 6-119 compile_count defined fixed bin(17,0) dcl 6-143 coms_charcnt defined fixed bin(17,0) dcl 6-189 coms_wdoff defined fixed bin(17,0) dcl 6-203 con_end_ptr defined pointer dcl 6-11 con_wd_off defined fixed bin(17,0) dcl 6-93 cons_charcnt defined fixed bin(17,0) dcl 6-193 constant_offset defined fixed bin(17,0) dcl 6-157 data_init_flag defined fixed bin(17,0) dcl 6-131 date_compiled_sw defined fixed bin(17,0) dcl 6-181 debug_enable defined fixed bin(17,0) dcl 6-175 def_base_ptr defined pointer dcl 6-13 def_max defined fixed bin(17,0) dcl 6-97 def_wd_off defined fixed bin(17,0) dcl 6-95 desc_an based structure level 1 packed packed unaligned dcl 7-103 desc_an_ptr automatic pointer dcl 7-119 desc_nn based structure level 1 packed packed unaligned dcl 7-122 desc_nn_ptr automatic pointer dcl 7-118 diag_ptr defined pointer dcl 6-71 dn_ptr automatic pointer dcl 315 eln_max defined fixed bin(17,0) dcl 6-173 eln_ptr defined pointer dcl 6-69 fixup_max defined fixed bin(17,0) dcl 6-165 fixup_ptr defined pointer dcl 6-31 fs_charcnt defined fixed bin(17,0) dcl 6-185 fs_wdoff defined fixed bin(17,0) dcl 6-199 include_cnt defined fixed bin(17,0) dcl 6-183 include_info_ptr defined pointer dcl 6-87 init_stack_off defined fixed bin(17,0) dcl 6-125 initval_base_ptr defined pointer dcl 6-33 initval_file_ptr defined pointer dcl 6-35 initval_flag defined fixed bin(17,0) dcl 6-179 input_struc based structure level 1 unaligned dcl 7-32 inst_ptr automatic pointer dcl 7-18 inst_struc based structure level 1 dcl 7-66 link_base_ptr defined pointer dcl 6-15 link_max defined fixed bin(17,0) dcl 6-101 link_wd_off defined fixed bin(17,0) dcl 6-99 list_off defined fixed bin(17,0) dcl 6-155 list_ptr defined pointer dcl 6-65 ls_charcnt defined fixed bin(17,0) dcl 6-191 main_pcs_ptr defined pointer dcl 6-85 map_data_max defined fixed bin(17,0) dcl 6-163 map_data_ptr defined pointer dcl 6-55 max_stack_off defined fixed bin(17,0) dcl 6-123 minpral5_ptr defined pointer dcl 6-51 misc_base_ptr defined pointer dcl 6-61 misc_end_ptr defined pointer dcl 6-63 misc_max defined fixed bin(17,0) dcl 6-159 next_tag defined fixed bin(17,0) dcl 6-129 non_source_offset defined fixed bin(17,0) dcl 6-177 ntbuf_ptr defined pointer dcl 6-83 obj_seg_name defined char(32) dcl 6-209 op_con_ptr defined pointer dcl 6-81 overflow_code_generated automatic bit(1) packed unaligned dcl 290 para_eop_flag defined fixed bin(17,0) dcl 6-139 pd_map_index defined fixed bin(17,0) dcl 6-117 pd_map_max defined fixed bin(17,0) dcl 6-161 pd_map_ptr defined pointer dcl 6-29 pd_map_sw defined fixed bin(17,0) dcl 6-127 perform_list_ptr defined pointer dcl 6-37 perform_para_index defined fixed bin(17,0) dcl 6-149 perform_sect_index defined fixed bin(17,0) dcl 6-151 priority_no defined fixed bin(17,0) dcl 6-141 ptr_assumption_ind defined fixed bin(17,0) dcl 6-145 ptr_status_ptr defined pointer dcl 6-57 reg_assumption_ind defined fixed bin(17,0) dcl 6-147 reg_status_ptr defined pointer dcl 6-59 reloc_def_base_ptr defined pointer dcl 6-21 reloc_def_max defined fixed bin(24,0) dcl 6-109 reloc_link_base_ptr defined pointer dcl 6-23 reloc_link_max defined fixed bin(24,0) dcl 6-111 reloc_struc based structure array level 1 unaligned dcl 7-44 reloc_sym_base_ptr defined pointer dcl 6-25 reloc_sym_max defined fixed bin(24,0) dcl 6-113 reloc_text_base_ptr defined pointer dcl 6-19 reloc_text_max defined fixed bin(24,0) dcl 6-107 reloc_work_base_ptr defined pointer dcl 6-27 reloc_work_max defined fixed bin(24,0) dcl 6-115 reswd_ptr defined pointer dcl 6-79 rtc_alphalit internal static fixed bin(15,0) initial dcl 8-7 rtc_commdesc internal static fixed bin(15,0) initial dcl 8-17 rtc_condname internal static fixed bin(15,0) initial dcl 8-15 rtc_debugenable internal static fixed bin(15,0) initial dcl 8-28 rtc_debugitems internal static fixed bin(15,0) initial dcl 8-18 rtc_diag internal static fixed bin(15,0) initial dcl 8-9 rtc_equate_tag internal static fixed bin(15,0) initial dcl 8-35 rtc_fdec_temp internal static fixed bin(15,0) initial dcl 8-37 rtc_filedef internal static fixed bin(15,0) initial dcl 8-16 rtc_groupname internal static fixed bin(15,0) initial dcl 8-25 rtc_immed_const internal static fixed bin(15,0) initial dcl 8-38 rtc_indexname internal static fixed bin(15,0) initial dcl 8-14 rtc_internal_tag internal static fixed bin(15,0) initial dcl 8-34 rtc_mnemonic internal static fixed bin(15,0) initial dcl 8-21 rtc_numlit internal static fixed bin(15,0) initial dcl 8-6 rtc_pararef internal static fixed bin(15,0) initial dcl 8-22 rtc_picstring internal static fixed bin(15,0) initial dcl 8-8 rtc_procdef internal static fixed bin(15,0) initial dcl 8-11 rtc_register internal static fixed bin(15,0) initial dcl 8-36 rtc_reportentry internal static fixed bin(15,0) initial dcl 8-26 rtc_reportname internal static fixed bin(15,0) initial dcl 8-24 rtc_resword internal static fixed bin(15,0) initial dcl 8-5 rtc_savedarea internal static fixed bin(15,0) initial dcl 8-19 rtc_sortmerge internal static fixed bin(15,0) initial dcl 8-20 rtc_source internal static fixed bin(15,0) initial dcl 8-10 rtc_unknown1 internal static fixed bin(15,0) initial dcl 8-27 rtc_unknown2 internal static fixed bin(15,0) initial dcl 8-29 rtc_unknown3 internal static fixed bin(15,0) initial dcl 8-30 rtc_unknown4 internal static fixed bin(15,0) initial dcl 8-31 rtc_unknown5 internal static fixed bin(15,0) initial dcl 8-32 rtc_unknown6 internal static fixed bin(15,0) initial dcl 8-33 rtc_userwd internal static fixed bin(15,0) initial dcl 8-12 same_sort_merge_proc defined bit(1) dcl 6-215 scratch_dir defined char(168) dcl 6-207 sect_eop_flag defined fixed bin(17,0) dcl 6-137 seg_init_flag defined fixed bin(17,0) dcl 6-133 seg_init_list_ptr defined pointer dcl 6-41 stack_off defined fixed bin(17,0) dcl 6-121 statement_info_ptr defined pointer dcl 6-77 sym_base_ptr defined pointer dcl 6-17 sym_max defined fixed bin(17,0) dcl 6-105 sym_wd_off defined fixed bin(17,0) dcl 6-103 tag_table_max defined fixed bin(17,0) dcl 6-167 tag_table_ptr defined pointer dcl 6-53 temp_token_area_ptr defined pointer dcl 6-43 temp_token_max defined fixed bin(17,0) dcl 6-169 temp_token_ptr defined pointer dcl 6-45 text_base_ptr defined pointer dcl 6-9 text_wd_off defined fixed bin(17,0) dcl 6-91 token_block1_ptr defined pointer dcl 6-47 token_block2_ptr defined pointer dcl 6-49 value_cnt defined fixed bin(17,0) dcl 6-195 ws_charcnt defined fixed bin(17,0) dcl 6-187 ws_wdoff defined fixed bin(17,0) dcl 6-201 xref_bypass defined bit(1) dcl 6-213 xref_chain_ptr defined pointer dcl 6-75 xref_token_ptr defined pointer dcl 6-73 NAMES DECLARED BY EXPLICIT CONTEXT. cobol_divide_gen 000012 constant entry external dcl 38 dvx 001404 constant label dcl 812 ref 328 f23 002572 constant entry internal dcl 1494 ref 361 365 f45 002615 constant entry internal dcl 1508 ref 369 373 get_size_error_flag 001443 constant entry internal dcl 844 ref 427 init_move_data 002452 constant entry internal dcl 1435 ref 446 503 lit_test 002546 constant entry internal dcl 1478 ref 355 1522 1523 not_dec_operand 002411 constant entry internal dcl 1409 ref 479 519 receiving_field 001571 constant entry internal dcl 948 ref 572 768 823 1472 restore 001747 constant entry internal dcl 1083 ref 1005 rf 002517 constant entry internal dcl 1465 ref 1526 1528 srf 001405 constant entry internal dcl 815 ref 467 739 start 000017 constant label dcl 319 store 001602 constant entry internal dcl 1014 ref 1003 test_for_overflow 002025 constant entry internal dcl 1134 ref 567 765 test_size_error 002223 constant entry internal dcl 1259 ref 646 652 803 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3274 3522 2764 3304 Length 4134 2764 226 376 307 136 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_divide_gen 418 external procedure is an external procedure. srf internal procedure shares stack frame of external procedure cobol_divide_gen. get_size_error_flag internal procedure shares stack frame of external procedure cobol_divide_gen. receiving_field internal procedure shares stack frame of external procedure cobol_divide_gen. store internal procedure shares stack frame of external procedure cobol_divide_gen. restore internal procedure shares stack frame of external procedure cobol_divide_gen. test_for_overflow internal procedure shares stack frame of external procedure cobol_divide_gen. test_size_error internal procedure shares stack frame of external procedure cobol_divide_gen. not_dec_operand internal procedure shares stack frame of external procedure cobol_divide_gen. init_move_data internal procedure shares stack frame of external procedure cobol_divide_gen. rf internal procedure shares stack frame of external procedure cobol_divide_gen. lit_test internal procedure shares stack frame of external procedure cobol_divide_gen. f23 internal procedure shares stack frame of external procedure cobol_divide_gen. f45 internal procedure shares stack frame of external procedure cobol_divide_gen. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 first_ix cobol_divide_gen 000011 div_code cobol_divide_gen 000012 mpy_code cobol_divide_gen 000013 subtract_code cobol_divide_gen 000014 move_eos_buffer cobol_divide_gen 000040 move_in_token_buffer cobol_divide_gen 000064 temp_in_token_buffer cobol_divide_gen 000110 move_data_init cobol_divide_gen 000111 numeric_lit_zero cobol_divide_gen 000123 compare_eos_token cobol_divide_gen 000133 move_eos receiving_field 000145 always_an receiving_field STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_divide_gen 000100 ose_flag cobol_divide_gen 000101 receive_count cobol_divide_gen 000102 fmt1 cobol_divide_gen 000103 abit cobol_divide_gen 000104 remainder_present cobol_divide_gen 000105 ix cobol_divide_gen 000106 iy cobol_divide_gen 000110 move_eos_ptr cobol_divide_gen 000112 move_in_token_ptr cobol_divide_gen 000114 divisor_token_ptr cobol_divide_gen 000116 dividend_token_ptr cobol_divide_gen 000120 resultant_operand_ptr cobol_divide_gen 000122 saved_ptr cobol_divide_gen 000124 product_token_ptr cobol_divide_gen 000126 difference_token_ptr cobol_divide_gen 000130 quotient_token_ptr cobol_divide_gen 000132 rdmax_value cobol_divide_gen 000133 possible_ovfl_flag cobol_divide_gen 000134 receiving_is_not_stored cobol_divide_gen 000135 size_error_inst cobol_divide_gen 000136 size_error_inst_ptr cobol_divide_gen 000140 size_error_token_ptr cobol_divide_gen 000142 stored_token_ptr cobol_divide_gen 000144 no_overflow_tag cobol_divide_gen 000145 imperative_stmt_tag cobol_divide_gen 000146 remainder_code_tag cobol_divide_gen 000150 op1_token_ptr cobol_divide_gen 000152 op2_token_ptr cobol_divide_gen 000154 temp_resultant_operand_ptr cobol_divide_gen 000156 binary_ok cobol_divide_gen 000157 not_bit cobol_divide_gen 000160 source_code cobol_divide_gen 000161 target_code cobol_divide_gen 000162 rounded_flag cobol_divide_gen 000163 ret_offset cobol_divide_gen 000164 temp_save_ptr cobol_divide_gen 000166 eos_ptr cobol_divide_gen 000170 input_ptr cobol_divide_gen 000172 reloc_ptr cobol_divide_gen 000212 ret_offset get_size_error_flag 000213 input_buffer get_size_error_flag 000225 reloc_buffer get_size_error_flag 000246 temp_in_token receiving_field 000272 move_eos_ptr receiving_field 000274 tin_ptr receiving_field 000276 temp_save_ptr receiving_field 000300 ret_offset receiving_field 000324 temp_inst_word test_for_overflow 000326 temp_inst_ptr test_for_overflow 000330 reloc_buffer test_for_overflow 000342 reloc_ptr test_for_overflow 000344 save_locno test_for_overflow 000345 overflow_tag test_for_overflow 000354 register_struc test_size_error 000365 temp_inst_word test_size_error 000366 temp_inst_ptr test_size_error 000370 save_locno test_size_error 000371 reloc_buffer test_size_error 000404 reloc_ptr test_size_error 000452 temp_divisor_token_ptr f45 000454 temp_dividend_token_ptr f45 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_binary_check$divide cobol_build_resop cobol_compare_gen cobol_define_tag cobol_divide_bin_gen cobol_emit cobol_fofl_mask$off cobol_fofl_mask$on cobol_make_tagref cobol_make_type9$copy cobol_make_type9$fixed_bin_35 cobol_make_type9$type2_3 cobol_move_gen cobol_mpy cobol_mpy3 cobol_num_to_udts cobol_register$load THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cobol_$compile_count cobol_$next_tag cobol_$text_wd_off LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 38 000006 319 000017 324 000034 326 000037 328 000051 334 000052 338 000061 343 000065 344 000067 347 000070 349 000074 350 000076 351 000104 352 000107 355 000112 358 000114 361 000115 365 000134 369 000153 373 000172 391 000206 393 000210 398 000212 402 000216 403 000220 410 000222 411 000225 413 000227 414 000231 415 000233 416 000237 420 000243 422 000245 424 000253 426 000256 427 000260 431 000262 436 000264 441 000311 443 000330 444 000333 446 000335 454 000341 456 000351 458 000356 460 000365 461 000366 467 000367 470 000401 473 000410 477 000412 479 000414 483 000433 484 000435 489 000444 495 000471 500 000510 501 000513 503 000515 506 000521 507 000524 509 000533 511 000542 514 000547 519 000550 522 000555 523 000557 524 000561 529 000572 533 000614 538 000615 540 000622 545 000632 547 000636 548 000642 550 000651 556 000656 562 000660 563 000663 567 000664 572 000666 579 000712 583 000715 587 000724 590 000731 593 000732 598 000734 603 000743 608 000746 610 000747 613 000751 628 000753 638 000755 639 000760 646 000761 652 000767 657 000774 662 001003 666 001004 673 001006 674 001010 676 001012 680 001023 685 001042 687 001045 688 001047 689 001051 690 001053 691 001054 697 001056 698 001061 700 001062 707 001071 712 001116 718 001135 723 001162 729 001201 733 001214 739 001216 744 001232 750 001241 752 001250 755 001255 760 001257 761 001262 765 001263 768 001265 775 001311 779 001320 781 001325 784 001326 794 001337 799 001341 801 001352 803 001354 807 001375 812 001404 815 001405 820 001407 823 001426 825 001442 844 001443 904 001445 908 001463 909 001466 913 001503 914 001505 916 001507 917 001511 918 001513 919 001514 920 001516 922 001520 926 001526 930 001541 934 001547 938 001564 940 001570 948 001571 1003 001573 1005 001600 1007 001601 1014 001602 1025 001603 1027 001613 1028 001615 1029 001617 1030 001620 1032 001623 1033 001625 1037 001637 1041 001656 1042 001661 1043 001663 1044 001665 1045 001667 1049 001670 1050 001672 1051 001675 1053 001700 1054 001702 1055 001705 1057 001711 1059 001715 1062 001717 1064 001725 1068 001727 1072 001735 1073 001742 1074 001744 1076 001746 1083 001747 1091 001750 1092 001752 1094 001755 1095 001757 1096 001761 1098 001766 1100 001772 1104 001774 1110 001776 1112 002003 1113 002005 1118 002007 1122 002015 1123 002022 1125 002024 1134 002025 1189 002027 1190 002030 1194 002032 1198 002036 1200 002041 1203 002042 1204 002044 1205 002045 1209 002046 1213 002062 1216 002102 1223 002122 1224 002123 1226 002127 1230 002132 1234 002146 1239 002164 1240 002173 1244 002201 1248 002216 1251 002222 1259 002223 1348 002225 1349 002227 1350 002230 1353 002231 1356 002236 1360 002242 1361 002243 1362 002244 1363 002246 1365 002251 1369 002262 1372 002274 1378 002302 1384 002317 1385 002320 1387 002322 1391 002342 1392 002347 1396 002353 1400 002356 1404 002372 1407 002410 1409 002411 1421 002413 1428 002445 1435 002452 1444 002453 1445 002457 1447 002461 1448 002464 1449 002466 1450 002470 1451 002475 1453 002477 1454 002501 1456 002502 1457 002505 1458 002507 1459 002511 1461 002513 1463 002516 1465 002517 1472 002521 1473 002536 1474 002543 1476 002545 1478 002546 1485 002550 1487 002555 1488 002556 1489 002560 1492 002571 1494 002572 1501 002574 1502 002603 1505 002611 1506 002614 1508 002615 1517 002617 1519 002626 1522 002633 1523 002635 1526 002637 1528 002641 1531 002643 1532 002645 1533 002647 ----------------------------------------------------------- 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