COMPILATION LISTING OF SEGMENT cobol_multiply_gen Compiled by: Multics PL/I Compiler, Release 31b, of April 24, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 05/24/89 0942.8 mst Wed Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 15 /****^ HISTORY COMMENTS: 16* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060), 17* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 18* MCR8060 cobol_multiply_gen.pl1 Added Trace statements. 19* END HISTORY COMMENTS */ 20 21 22 /* Modified on 11/22/84 by FCH, [5.3...], trace added */ 23 /* Modified on 10/19/84 by FCH, [4.3-1], BUG563(phx18381), new cobol_addr_tokens.incl.pl1 */ 24 /* Modified on 04/18/80 by FCH, new include file cobol_arith_util, fix not option */ 25 /* Modified on 06/28/79 by FCH, [4.0-1], not option added for debug */ 26 /* Modified since Version 4.0 */ 27 28 /* format: style3 */ 29 cobol_multiply_gen: 30 proc (in_token_ptr, next_stmt_tag); 31 32 /* 33*The MULTIPLY statement generator: cobol_multiply_gen 34* 35*FUNCTION 36* 37*The function of this procedure is to generate code for the 38*Cobol MULTIPLY statement. 39* 40**/ 41 42 /* DECLARATION OF THE PARAMETERS */ 43 44 /* dcl in_token_ptr ptr; */ 45 /* DECLARED BELOW IN AN INCLUDE FILE */ 46 dcl next_stmt_tag fixed bin; 47 48 49 /* DESCRIPTION OF THE PARAMETERS */ 50 /* 51* 52*PARAMETER DESCRIPTION 53* 54*in_token_ptr Points to the in_token structure, which 55* contains information describing the MULTIPLY 56* statement for which code is to be 57* generated. (input) See the description 58* below under INPUT for the exact contents of 59* the input structure. 60* NOTE: This parameter is declared in an include 61* file following the executable statements 62* of this procedure. 63*next_stmt_tag Contains a compiler generated tag number 64* (label) to be associated by the code 65* generator driver with the Cobol statement 66* that follows the MULTIPLY statement for which this 67* procedure was called. (output) See 68* the discussion below under OUTPUT 69* for more details. 70**/ 71 /* 72* 73*INPUT 74* 75*The input to this procedure is a structure, which is defined by a 76*declaration of the following format: 77* 78*dcl 1 in_token based (in_token_ptr), 79* 2 n fixed bin, 80* 2 code fixed bin 81* 2 token_ptr ( 0 refer (in_token.n)) ptr; 82* 83* where: 84* 85* in_token.n contains the number of entries in the 86* token_ptr array. 87* 88* token_ptr(1) contains a pointer to a reserved word token 89* (type 1) for the reserved word MULTIPLY. This pointer is 90* not used by this procedure. 91* 92* token_ptr(n) contains a pointer to an EOS (type 19) token. 93* A declaration that describes the contents of the EOS 94* token is given following the executable statements 95* of this procedure in an include file. The type 19 96* token contains the following information that is 97* used by this procedure. 98* 99* 1. end_stmt.verb contains the code for the 100* reserved word MULTIPLY. 101* 2. end_stmt.a defines the format of the MULTIPLY 102* statement: 103* 104* value of end_stmt.a | Mpy stmt format 105* ---------------------------------------- 106* "000"b | format 1 107* "001"b | format 2 108* 109* 3. end_stmt.b is "1"b if this MULTIPLY statement 110* had an ON SIZE ERROR clause 111* 4. end_stmt.e contains the count of the 112* number of operands to the RIGHT of "BY" for 113* format 1 MULTIPLY statements. 114* 5, end_stmt.h contians the count of the number 115* of operands to the RIGHT of "GIVING" for 116* format 2 MULTIPLY statements. 117* 118* token_ptr(2) through token_ptr(n-1) point to tokens 119* that describe: 120* 121* 1. the data items to be multiplied together. 122* These tokens can be data name (type 9) tokens 123* numeric literal (type 2) tokens. 124* 2. the data items to receive the result of 125* the multiplication. These tokens are always data 126* name (type 9) tokens. 127* 128* 129*OUTPUT 130* 131*The second parameter passed to cobol_multiply_gen is an output parameter. 132*A value is returned to the calling procedure, cobol_gen_driver_, 133*only for those multiply staatments that have on size error clauses. 134*If an on size error clause is specified, then, in addition to 135*the code that evaluates the product, and assigns it to the receiving 136*data items, cobol_multiply_gen must also generate code that checks for 137*size error conditions. If a size error is detected by the execution 138*of the generated code, then the imperative statement in the MULTIPLY 139*statment is executed, otherwise the imperative statement is 140*skipped. The cobol_multiply_gen generator, however, when generating 141*code to skip over the imperative statement to the next statement, 142*does not know anything about the next statement. This situation 143*is handled as follows: 144* 145* 1. cobol_multiply_gen reserves a tag for the next COBOL 146* statement. 147* 2. any transfers to the next statement reference the 148* tag reserved by cobol_multiply_gen. This tag is not yet 149* defined. (associated with an instruction location in 150* the text segment) 151* 3. after generation of code for an multiply statement is 152* completed, cobol_multiply_gen passes the next statement tag 153* back to its caller, cobol_gen_driver_, in the second 154* parameter. 155* 4. when cobol_gen_driver_ detects the end of the imperative 156* statement, the tag, reserved by cobol_multiply_gen, is 157* defined. 158**/ 159 160 /* DECLARATION OF EXTERNAL ENTRIES */ 161 162 dcl cobol_binary_check$multiply 163 ext entry (ptr, bit (1), fixed bin, fixed bin); 164 dcl cobol_multiply_bin_gen 165 ext entry (ptr, fixed bin); 166 dcl cobol_num_to_udts ext entry (ptr, ptr); 167 dcl cobol_fofl_mask$on ext entry; 168 dcl cobol_fofl_mask$off ext entry; 169 dcl cobol_build_resop ext entry (ptr, ptr, fixed bin, ptr, bit (1), fixed bin, bit (1)); 170 dcl cobol_mpy3 ext entry (ptr, ptr, ptr, fixed bin); 171 dcl cobol_mpy ext entry (ptr, ptr, fixed bin); 172 dcl cobol_define_tag ext entry (fixed bin); 173 dcl cobol_alloc$stack ext entry (fixed bin, fixed bin, fixed bin); 174 dcl cobol_addr ext entry (ptr, ptr, ptr); 175 dcl cobol_emit ext entry (ptr, ptr, fixed bin); 176 dcl cobol_arith_move_gen 177 ext entry (ptr); 178 dcl cobol_move_gen ext entry (ptr); 179 dcl cobol_make_type9$copy 180 ext entry (ptr, ptr); 181 dcl cobol_make_tagref ext entry (fixed bin, fixed bin, ptr); 182 dcl cobol_register$load ext entry (ptr); 183 dcl cobol_make_type9$fixed_bin_35 184 ext entry (ptr, fixed bin, fixed bin); 185 dcl cobol_make_type9$type2_3 186 ext entry (ptr, ptr); 187 188 189 190 /* DECLARATIONS OF BUILTIN FUNCTIONS */ 191 192 dcl addr builtin; 193 dcl fixed builtin; 194 dcl null builtin; 195 196 /* DECLARATION OF INTERNAL STATIC VARIABLES */ 197 198 dcl first_ix fixed bin int static init (2); 199 200 dcl mpy_code fixed bin int static init (184); 201 202 /* Definition of an internal static buffer in which an EOS token is built for calls to the MOVE gen. */ 203 204 dcl move_eos_buffer (1:10) ptr int static; 205 206 /* Definition of an internal static buffer in which an in_token is built for calls to the MOVE gen. */ 207 208 dcl move_in_token_buffer 209 (1:10) ptr int static; 210 211 dcl move_data_init fixed bin int static init (0); 212 213 214 215 /* Definition of a numeric literal zero */ 216 217 dcl 1 num_lit_zero int static, 218 2 size fixed bin (15) init (37), 219 2 line fixed bin (15) init (0), 220 2 column fixed bin (15) init (0), 221 2 type fixed bin (15) init (2), 222 2 integral bit (1) init ("1"b), 223 2 floating bit (1) init ("0"b), 224 2 filler1 bit (5) init ("0"b), 225 2 subscript bit (1) init ("0"b), 226 2 sign char (1) init (" "), 227 2 exp_sign char (1) init (" "), 228 2 exp_places fixed bin (15) init (0), 229 2 places_left fixed bin (15) init (1), 230 2 places_right fixed bin (15) init (0), 231 2 places fixed bin (15) init (1), 232 2 lit_val char (1) init ("0"); 233 234 235 /* DECLARATION OF INTERNAL AUTOMATIC VARIABLES */ 236 237 dcl ose_flag bit (1); 238 dcl receive_count fixed bin; 239 240 dcl fmt1 bit (1); 241 242 243 244 dcl ix fixed bin; 245 dcl iy fixed bin; 246 dcl move_eos_ptr ptr; 247 dcl move_in_token_ptr ptr; 248 dcl multiplicand_ptr ptr; 249 dcl multiplier_ptr ptr; 250 dcl resultant_operand_ptr 251 ptr; 252 dcl saved_ptr ptr; 253 254 dcl rdmax_value fixed bin; 255 dcl overflow_code_generated 256 bit (1); 257 dcl possible_ovfl_flag bit (1); 258 dcl receiving_is_not_stored 259 bit (1); 260 dcl size_error_inst bit (36); 261 dcl size_error_inst_ptr ptr; 262 dcl size_error_token_ptr 263 ptr; 264 dcl stored_token_ptr ptr; 265 dcl no_overflow_tag fixed bin; 266 dcl op1_token_ptr ptr; 267 dcl op2_token_ptr ptr; 268 dcl temp_resultant_operand_ptr 269 ptr; 270 dcl (binary_ok, not_bit) 271 bit (1); 272 dcl source_code fixed bin; 273 dcl target_code fixed bin; 274 275 dcl dn_ptr ptr; 276 277 /**************************************************/ 278 start: /***..... if Trace_Bit then call cobol_gen_driver_$Tr_Beg(cmg);/**/ 279 /* Check to see if binary arithmetic (using A and Q registers) can be done. */ 280 call cobol_binary_check$multiply (in_token_ptr, binary_ok, target_code, source_code); 281 if binary_ok 282 then do; /* Binary arithmetic can be done. */ 283 call cobol_multiply_bin_gen (in_token_ptr, next_stmt_tag); 284 return; 285 end; /* Binary arithmetic can be done. */ 286 287 288 move_in_token_ptr = null (); 289 290 /* Get meaningful data from the EOS token. */ 291 eos_ptr = in_token.token_ptr (in_token.n); 292 293 /* ON SIZE ERROR flag */ 294 ose_flag = end_stmt.b; 295 296 /* Determine the number of receiving operands. */ 297 if end_stmt.a = "000"b 298 then do; /* format 1 multiply. */ 299 fmt1 = "1"b; 300 receive_count = end_stmt.e; 301 multiplicand_ptr = in_token.token_ptr (first_ix); 302 303 if multiplicand_ptr -> data_name.type ^= rtc_dataname 304 then do; /* Multiplicand not dataname, must be numeric literal or ZERO. */ 305 306 if multiplicand_ptr -> data_name.type = rtc_numlit 307 then saved_ptr = multiplicand_ptr; 308 /* numeric literal */ 309 else saved_ptr = addr (num_lit_zero); 310 /* Assume multiplicand is figurative constant ZERO. */ 311 multiplicand_ptr = null (); /* Utility provides buffer for dataname token. */ 312 313 /* Pool the literal and get a dataname token for it. */ 314 call cobol_make_type9$type2_3 (multiplicand_ptr, saved_ptr); 315 316 end; /* Multiplicand not dataname, must be numeric literal or ZERO. */ 317 end; /* format 1 multiply */ 318 319 320 else do; /* fmt 2 multiply */ 321 fmt1 = "0"b; 322 receive_count = end_stmt.h; 323 end; /* fmt 2 multiply */ 324 325 if ose_flag /* On size error clause was present, do processing common to both format multiplies. */ 326 then do; 327 328 /* Reserve a tag to be associated (by the cobol generator driver) with the next 329* cobol statement. */ 330 next_stmt_tag = cobol_$next_tag; 331 cobol_$next_tag = cobol_$next_tag + 1; 332 333 334 /* Get a size error flag in the stack, and initialize it to zero. */ 335 size_error_inst_ptr = addr (size_error_inst); 336 call get_size_error_flag (size_error_token_ptr, size_error_inst_ptr); 337 338 end; /* On size error clause was present, do processing common to both format multiplies. */ 339 340 if ^fmt1 341 then do; /* FORMAT 2 multiply, multiply the first two operands and store the result in a temporary. */ 342 343 /* Build a resultant operand for the product. */ 344 multiplicand_ptr = in_token.token_ptr (first_ix); 345 multiplier_ptr = in_token.token_ptr (first_ix + 1); 346 347 call cobol_build_resop (multiplicand_ptr, multiplier_ptr, mpy_code, resultant_operand_ptr, "0"b, 348 rdmax_value, possible_ovfl_flag); 349 350 /* Generate code to perform the multiplication. */ 351 call cobol_mpy3 (multiplicand_ptr, multiplier_ptr, resultant_operand_ptr, 1 /* MPY */); 352 353 move_in_token_ptr = addr (move_in_token_buffer (1)); 354 move_eos_ptr = addr (move_eos_buffer (1)); 355 356 if move_data_init ^= cobol_$compile_count 357 then call init_move_data; 358 end; /* FORMAT2 multiply, multiply the first two operrands and store the result in a temp. */ 359 360 361 /* Get subscript of pointer in the in_token array that points to first receiving field. */ 362 363 iy = in_token.n - receive_count; 364 365 do ix = 1 to receive_count; /* Generate code to get the prdouct into the receiving field(s). */ 366 receiving_is_not_stored = "0"b; /* Generate code to store the receiving field into a temporary, if the on size 367* error flag is on, and the receiving field is NOT a numeric edited item. */ 368 369 if ose_flag 370 then if in_token.token_ptr (iy) -> data_name.numeric_edited /* Receiving is numeric edited. */ 371 | (in_token.token_ptr (iy) -> data_name.display 372 & in_token.token_ptr (iy) -> data_name.item_signed 373 & in_token.token_ptr (iy) -> data_name.sign_separate = "0"b) 374 /* overpunch sign */ 375 then receiving_is_not_stored = "1"b; 376 else call receiving_field (in_token.token_ptr (iy), stored_token_ptr, 1); 377 378 379 /* Generate code to turn the overflow mask indicator bit ON */ 380 if ose_flag 381 then call cobol_fofl_mask$on; 382 383 if fmt1 /* Generate code to multiply the first operand by the receiving field value, 384* and store the result into the receiving field. */ 385 then do; 386 387 388 move_in_token_ptr = null (); 389 if not_dec_operand (in_token.token_ptr (iy)) 390 then do; /* The receiving operand is not decimal. Must convert to decimal 391* before performing the multiplication. */ 392 393 op1_token_ptr = multiplicand_ptr; 394 op2_token_ptr = in_token.token_ptr (iy); 395 396 /* Convert the non-decimal operand(s) , and build a temporary 397* into which to store the result of the computation. */ 398 399 call cobol_build_resop (op1_token_ptr, op2_token_ptr, mpy_code, 400 temp_resultant_operand_ptr, "0"b, rdmax_value, possible_ovfl_flag); 401 402 /* Generate code to multiply the two operands, and 403* store the result into a temporary. */ 404 call cobol_mpy3 (op1_token_ptr, op2_token_ptr, temp_resultant_operand_ptr, 1); 405 406 /* Generate code to move the result of the multiply to 407* the receiving field. */ 408 409 move_in_token_ptr = addr (move_in_token_buffer (1)); 410 move_eos_ptr = addr (move_eos_buffer (1)); 411 412 if move_data_init ^= cobol_$compile_count 413 then call init_move_data; 414 415 move_in_token_ptr -> in_token.token_ptr (2) = temp_resultant_operand_ptr; 416 move_in_token_ptr -> in_token.token_ptr (3) = in_token.token_ptr (iy); 417 418 call cobol_arith_move_gen (move_in_token_ptr); 419 if move_in_token_ptr -> in_token.code ^= 0 420 then receiving_is_not_stored = "1"b; 421 422 423 end; /* The receiving operand is not decimal. Must convert 424* to decimal before performing the multiply. */ 425 426 else do; /* Receiving operand is decimal. */ 427 428 if not_dec_operand (multiplicand_ptr) 429 then do; /* Left operand is not decimal--convert to decimal. */ 430 op1_token_ptr = multiplicand_ptr; 431 multiplicand_ptr = null (); 432 call cobol_num_to_udts (op1_token_ptr, multiplicand_ptr); 433 434 435 end; /* Left operand is not decimal--convert to decimal. */ 436 437 call cobol_mpy (multiplicand_ptr, in_token.token_ptr (iy), 1); 438 439 end; /* Receiving operand is decimal. */ 440 441 end; /* Generate code to multiply the first operand by the receiving field value, 442* and store the result into the recieving field. */ 443 444 else do; /* Generate code to move the product already calculated into the receiving field. */ 445 446 move_in_token_ptr -> in_token.token_ptr (move_in_token_ptr -> in_token.n - 2) = 447 resultant_operand_ptr; 448 move_in_token_ptr -> in_token.token_ptr (move_in_token_ptr -> in_token.n - 1) = 449 in_token.token_ptr (iy); 450 451 call cobol_arith_move_gen (move_in_token_ptr); 452 if move_in_token_ptr -> in_token.code ^= 0 453 then receiving_is_not_stored = "1"b; 454 end; /* Generate code to move the product already calculated into the receiving 455* fields. */ 456 457 if ose_flag 458 then do; /* Generate code to test for overflow resulting from the multiply/store 459* or move. */ 460 461 /* Reserve a tag to which to transfer if no overflow occurs. */ 462 no_overflow_tag = cobol_$next_tag; 463 cobol_$next_tag = cobol_$next_tag + 1; 464 465 /* Generate code to test for overflow. */ 466 call test_for_overflow (no_overflow_tag, size_error_inst_ptr, move_in_token_ptr); 467 468 /* Generate code to restore the stored value back into the receiving 469* field. */ 470 /* The value is restored only if the receiving field was not numeric edited. If 471* the receiving field was numeric edited, the result of the multiplication 472* has been moved into a temporary, and 473* the receiving field has not been modified at all. */ 474 if receiving_is_not_stored = "0"b 475 then call receiving_field (in_token.token_ptr (iy), stored_token_ptr, 2 /* RESTORE*/); 476 477 /* Define the no_overflow_tag at the next instruction in the text segment. */ 478 call cobol_define_tag (no_overflow_tag); 479 480 /* Generate code to turn the overflow mask indicator bit OFF */ 481 call cobol_fofl_mask$off; 482 483 end; /* Generate code to test for overflow resulting from the multiply/store 484* or move. */ 485 else if receiving_is_not_stored 486 then call cobol_move_gen (move_in_token_ptr);/* Call cobol_move_gen to move the temp result 487* into a numeric edited receiving field */ 488 489 490 491 /* Increment the subscript to the next receiving field. */ 492 iy = iy + 1; 493 494 end; /* Get the product into the receiving field(s). */ 495 496 if ose_flag 497 then do; /* Generate code that tests whether overflow occurred, and jumps over the 498* imperative stmt if no overflow occurred. */ 499 500 501 /*[4.0-1]*/ 502 if end_stmt.f = "01"b 503 then not_bit = "1"b; 504 else not_bit = "0"b; 505 call test_size_error (size_error_token_ptr, size_error_inst_ptr, next_stmt_tag, "1"b, not_bit); 506 507 end; /* Generate code that tests whether overflow occurred, and jumps over the 508* imperative stmt if no overflow occurrred. */ 509 510 /***..... if Trace_Bit then call cobol_gen_driver_$Tr_End(cmg);/**/ 511 512 return; 513 514 /*************************************/ 515 init_move_data: 516 proc; 517 518 /* This internal procedure initializes the input token 519*and EOS token used in calls to the cobol move generators. */ 520 521 /* Initialize in_token structure and EOS token structure 522* used in calls to the MOVE generator. */ 523 524 saved_ptr = in_token_ptr; 525 in_token_ptr = move_in_token_ptr; 526 527 in_token.n = 4; 528 in_token.code = 0; 529 in_token.token_ptr (1) = null (); 530 in_token.token_ptr (in_token.n) = move_eos_ptr; 531 in_token_ptr = saved_ptr; 532 533 saved_ptr = eos_ptr; 534 eos_ptr = move_eos_ptr; 535 536 end_stmt.verb = 18; /* MOVE */ 537 end_stmt.e = 1; /* COUNT of the receiving fields */ 538 end_stmt.type = rtc_eos; 539 eos_ptr = saved_ptr; 540 541 move_data_init = cobol_$compile_count; 542 543 end init_move_data; 544 545 /***..... dcl cmg char(18) init("COBOL_MULTIPLY_GEN");/**/ 546 547 /***..... dcl cobol_gen_driver_$Tr_Beg entry(char(*));/**/ 548 /***..... dcl cobol_gen_driver_$Tr_End entry(char(*));/**/ 549 550 /***..... dcl Trace_Bit bit(1) static external;/**/ 551 /***..... dcl Trace_Lev fixed bin static external;/**/ 552 /***..... dcl Trace_Line char(36) static external;/**/ 553 /***..... dcl ioa_ entry options(variable); /**/ 554 555 556 557 558 /**************************************************/ 559 /* INCLUDE FILES USED BY THIS PROCEDURE */ 560 /**************************************************/ 561 1 1 1 2 /* BEGIN INCLUDE FILE ... cobol_arith_util.incl.pl1 */ 1 3 /* <<< LAST MODIFIED ON 9-08-76 by bc >>> */ 1 4 /* <<< LAST MODIFIED ON 9-23-75 by tlf >>> */ 1 5 /* <<< NAME OF INCLUDE FILE: cobol_arith_util.incl.pl1 >>> */ 1 6 1 7 1 8 /**************************************************/ 1 9 /* INTERNAL PROCEDURE */ 1 10 /* get_size_error_flag */ 1 11 /**************************************************/ 1 12 1 13 get_size_error_flag:proc(size_error_token_ptr,size_error_inst_ptr); 1 14 1 15 /* 1 16*FUNCTION 1 17* 1 18*The function of this procedure is to: 1 19* 1 20* 1. allocate a fixed bin (35) variable in the COBOL 1 21* program's run-time stack. 1 22* 2. build a data name token for the fixed binary variable. 1 23* 3. Emit code that stores zero into the fixed binary. 1 24* 4. Return a pointer to the data name token for the fixed 1 25* binary variable. 1 26* 5. Return a 36 bit non-eis instruction word that 1 27* contains the address of the fixed binary variable. 1 28* 1 29**/ 1 30 1 31 /* DECLARATION OF THE PARAMETERS */ 1 32 1 33 dcl size_error_token_ptr ptr; 1 34 dcl size_error_inst_ptr ptr; 1 35 1 36 /* DESCRIPTION OF THE PARAMETERS */ 1 37 1 38 /* 1 39*PARAMETER DESCRIPTION 1 40* 1 41*size_error_token_ptr Points to the data name token 1 42* that describes the fixed binary 1 43* in the stack. (output) 1 44*size_error_inst_ptr Points to a 36 bit field in which 1 45* the non-eix address is constructed. 1 46* (output) 1 47* 1 48**/ 1 49 1 50 /* DECLARATION OF INTERNAL STATIC VARIABLES */ 1 51 1 52 dcl stz_op bit (10) int static init ("1001010000"b /*450(0)*/); 1 53 1 54 /* DECLARATION OF INTERNAL VARIABLES */ 1 55 1 56 dcl ret_offset fixed bin; 1 57 dcl size_error_inst_word bit (36) based (size_error_inst_ptr); 1 58 dcl input_buffer (1:10) fixed bin; 1 59 dcl reloc_buffer (1:10) bit (5) aligned; 1 60 1 61 1 62 1 63 /*************************************************/ 1 64 /* START OF EXECUTION */ 1 65 /* INTERNAL PROCEDURE get_size_error_flag */ 1 66 /**************************************************/ 1 67 1 68 /* Allocate a 4 byte fixed binary number on a word boundary in the stack */ 1 69 call cobol_alloc$stack(4,0,ret_offset); 1 70 1 71 /* Make a data name token for the fixed binary number. */ 1 72 size_error_token_ptr = null(); /* The utility will provide the buffer. */ 1 73 call cobol_make_type9$fixed_bin_35(size_error_token_ptr,1000 /*STACK*/,ret_offset); 1 74 1 75 /* Generate code to store zero in the stack temporary */ 1 76 input_ptr = addr(input_buffer(1)); 1 77 reloc_ptr = addr(reloc_buffer(1)); 1 78 1 79 input_struc_basic.type = 1; 1 80 input_struc_basic.operand_no = 0; 1 81 input_struc_basic.lock = 0; 1 82 input_struc_basic.segno = 1000; /* STACK */ 1 83 input_struc_basic.char_offset = ret_offset; /* From cobol_alloc$stack */ 1 84 1 85 size_error_inst_word = "0"b; 1 86 1 87 /* Get the non-eis instruction */ 1 88 call cobol_addr(input_ptr,size_error_inst_ptr,reloc_ptr); 1 89 1 90 /* Set the STZ opcode into the instruction word */ 1 91 size_error_inst_ptr -> inst_struc_basic.fill1_op = stz_op; 1 92 1 93 /* Emit the stz instruction */ 1 94 call cobol_emit(size_error_inst_ptr,reloc_ptr,1); 1 95 1 96 /* Set the opcode in the non-eis instruction to "0"b */ 1 97 size_error_inst_ptr -> inst_struc_basic.fill1_op = "0"b; 1 98 1 99 end get_size_error_flag; 1 100 1 101 1 102 /**************************************************/ 1 103 /* INTERNAL PROCEDURE */ 1 104 /* receiving_field */ 1 105 /**************************************************/ 1 106 1 107 receiving_field:proc(receiving_token_ptr,stored_token_ptr,function_code); 1 108 1 109 /* THIS IS NOT A VALID ENTRY POINT */ 1 110 1 111 /* DECLARATION OF THE PARAMETERS */ 1 112 1 113 dcl receiving_token_ptr ptr; 1 114 dcl stored_token_ptr ptr; 1 115 dcl function_code fixed bin; 1 116 1 117 /* DESCRIPTION OF THE PARAMETERS */ 1 118 1 119 /* 1 120*PARAMETER DESCRIPTION 1 121* 1 122*receiving_token_ptr Points to the data name token of the receiving 1 123* operand to be stored. (input) 1 124*stored_token_ptr Points to the data name token of the 1 125* temporary in which the receiving operand 1 126* is to be stored. (output) 1 127*function_code Code that indicates the function to perform 1 128* 1 129* value | function 1 130* ============================= 1 131* 1 | store 1 132* 2 | restore 1 133* 1 134**/ 1 135 1 136 /* DECLARATION OF INTERNAL STATIC VARIABLES */ 1 137 1 138 /* Definition of an EOS token used in calls to cobol_arith_move_gen */ 1 139 1 140 dcl 1 move_eos int static, 1 141 2 size fixed bin (15) init (32), 1 142 2 line fixed bin (15) init (0), 1 143 2 column fixed bin (15) init (0), 1 144 2 type fixed bin (15) init (19), /* EOS */ 1 145 2 verb fixed bin (15) init (18), /* MOVE */ 1 146 2 e fixed bin (15) init (0), 1 147 2 h fixed bin (15) init (0), 1 148 2 i fixed bin (15) init (0), 1 149 2 j fixed bin (15) init (0), 1 150 2 a bit (16) init ("0"b); 1 151 dcl always_an bit (1) static init ("0"b); 1 152 1 153 /* DECLARATIONS OF INTERNAL AUTOMATIC VARIABLES */ 1 154 1 155 dcl temp_in_token (1:10) ptr; 1 156 dcl move_eos_ptr ptr; 1 157 dcl tin_ptr ptr; 1 158 dcl temp_save_ptr ptr; 1 159 dcl ret_offset fixed bin; 1 160 1 161 if function_code = 1 then call store; 1 162 else call restore; 1 163 1 164 1 165 1 166 /*************************************************/ 1 167 /* STORE ENTRY POINT */ 1 168 /***************************************************/ 1 169 1 170 store:proc; 1 171 1 172 /* This entry point is used to generate code that stores the 1 173*contents of a receiving operand into a temporary. */ 1 174 1 175 /* Modify the token for the receiving variable that is being stored, so that it 1 176* looks like an alphanumeric instead of a numeric. This is done so that the move 1 177* generator generates an alphanumeric (MLR) move to store the data. */ 1 178 if receiving_token_ptr->data_name.ascii_packed_dec_h="0"b then do; 1 179 receiving_token_ptr -> data_name.numeric = "0"b; 1 180 receiving_token_ptr -> data_name.alphanum = "1"b; 1 181 end; 1 182 else always_an="1"b; 1 183 1 184 temp_save_ptr = null(); /* Utility will provide the buffer for data name token */ 1 185 call cobol_make_type9$copy(temp_save_ptr,receiving_token_ptr); 1 186 1 187 /* Allocate space on the stack to hold the contents of the receiving field */ 1 188 call cobol_alloc$stack(fixed(temp_save_ptr -> data_name.item_length,17),0,ret_offset); 1 189 1 190 /* Update the data name for the temporary */ 1 191 temp_save_ptr -> data_name.seg_num = 1000; /* Stack */ 1 192 temp_save_ptr -> data_name.offset = ret_offset; /* From cobol_alloc$stack */ 1 193 temp_save_ptr -> data_name.subscripted = "0"b; 1 194 temp_save_ptr -> data_name.variable_length = "0"b; 1 195 temp_save_ptr -> data_name.occurs_ptr = 0; 1 196 1 197 /* Build the in_token structure for calling the move generator */ 1 198 1 199 tin_ptr = addr(temp_in_token(1)); 1 200 move_eos_ptr = addr(move_eos); 1 201 stored_token_ptr = temp_save_ptr; 1 202 1 203 tin_ptr -> in_token.n = 4; 1 204 tin_ptr -> in_token.token_ptr(1) = null(); 1 205 tin_ptr -> in_token.token_ptr(2) = receiving_token_ptr; /* operand to be stored */ 1 206 tin_ptr -> in_token.token_ptr(3) = stored_token_ptr; /* Temp in which to store */ 1 207 tin_ptr -> in_token.token_ptr(4) = move_eos_ptr; 1 208 1 209 1 210 if always_an="1"b then move_eos_ptr->end_stmt.e=10001; 1 211 else 1 212 move_eos_ptr -> end_stmt.e = 1; /* Set the number of receiving operands into the EOS */ 1 213 1 214 /* Call the move generator to move the contents */ 1 215 call cobol_move_gen(tin_ptr); 1 216 1 217 /* Reset the token for the variable being stored. */ 1 218 receiving_token_ptr -> data_name.numeric = "1"b; 1 219 receiving_token_ptr -> data_name.alphanum = "0"b; 1 220 always_an="0"b; 1 221 1 222 end store; 1 223 1 224 1 225 1 226 /**************************************************/ 1 227 /* RESTORE ENTRY POIENT */ 1 228 /**************************************************/ 1 229 1 230 restore:proc; 1 231 1 232 /* This entry point is used to restore the contents of a 1 233*receiving operand from the contents of a temporary. */ 1 234 1 235 /* Set up the in_token structure for calling the move generator */ 1 236 1 237 tin_ptr = addr(temp_in_token(1)); 1 238 move_eos_ptr = addr(move_eos); 1 239 1 240 tin_ptr -> in_token.n = 4; 1 241 tin_ptr -> in_token.token_ptr(1) = null(); 1 242 tin_ptr -> in_token.token_ptr(2) = stored_token_ptr; /* source */ 1 243 tin_ptr -> in_token.token_ptr (3) = receiving_token_ptr; /* Receiving field */ 1 244 tin_ptr -> in_token.token_ptr(4) = move_eos_ptr; /* move EOS token */ 1 245 1 246 /* Set the number of receiving fields into the move EOS */ 1 247 move_eos_ptr -> end_stmt.e = 1; 1 248 1 249 /* Modify the token for the receiving variable that is being stored, so that it 1 250* looks like an alphanumeric instead of a numeric. This is done so that the move 1 251* generator generates an alphanumeric (MLR) move to store the data. */ 1 252 if receiving_token_ptr->data_name.ascii_packed_dec_h="0"b then do; 1 253 receiving_token_ptr -> data_name.numeric = "0"b; 1 254 receiving_token_ptr -> data_name.alphanum = "1"b; 1 255 end; 1 256 1 257 /* Call the move generator */ 1 258 1 259 call cobol_move_gen(tin_ptr); 1 260 1 261 /* Reset the token for the variable being stored. */ 1 262 receiving_token_ptr -> data_name.numeric = "1"b; 1 263 receiving_token_ptr -> data_name.alphanum = "0"b; 1 264 1 265 end restore; 1 266 1 267 end receiving_field; 1 268 1 269 /**************************************************/ 1 270 /* INTERNAL PROCEDURE */ 1 271 /* test_for_overflow */ 1 272 /**************************************************/ 1 273 1 274 test_for_overflow:proc(no_overflow_tag,size_error_inst_ptr,move_in_token_ptr); 1 275 1 276 /* 1 277*FUNCTION 1 278*The function of this procedure is to generate the following 1 279*sequence of code: 1 280* 1 281* tov 2,ic 1 282* tra no_overflow_tag 1 283* aos size_error_flag 1 284**/ 1 285 1 286 /* DECLARATION OF THE PARAMETERS */ 1 287 1 288 dcl no_overflow_tag fixed bin; 1 289 dcl size_error_inst_ptr ptr; 1 290 dcl move_in_token_ptr ptr; 1 291 1 292 /* DESCRIPTION OF THE PARAMETERS */ 1 293 1 294 /* 1 295*PARAMETER DESCRIPTION 1 296* 1 297*no_overflow_tag Contains the compiler generated tag to which 1 298* to transfer if there is no overflow. (input) 1 299*size_error_inst_ptr Points to a 36 bit field that contains a 1 300* non-eis instruction, which contains the address 1 301* of the size error flag. (input) 1 302* 1 303**/ 1 304 1 305 /* DECLARATIONS OF INTERNAL STATIC VARIABLES */ 1 306 1 307 dcl tov_op bit (10) int static init ("1100011110"b /*617(0)*/); 1 308 dcl tra_op bit (10) int static init ("1110010000"b /*710(0)*/); 1 309 dcl aos_op bit (10) int static init ("0001011000"b /*054(0)*/); 1 310 1 311 /* DECLARATIONS OF INTERNAL AUTOMATIC VARIABLES. */ 1 312 1 313 dcl temp_inst_word bit (36); 1 314 dcl temp_inst_ptr ptr; 1 315 1 316 dcl reloc_buffer (1:10) bit (5) aligned; 1 317 dcl reloc_ptr ptr; 1 318 1 319 dcl save_locno fixed bin; 1 320 dcl overflow_tag fixed bin; 1 321 1 322 /**************************************************/ 1 323 /* START OF EXECUTION */ 1 324 /* test_for_overflow */ 1 325 /**************************************************/ 1 326 1 327 1 328 temp_inst_word = "0"b; 1 329 temp_inst_ptr = addr(temp_inst_word); 1 330 1 331 /* Insert tov opcode */ 1 332 temp_inst_ptr -> inst_struc_basic.fill1_op = tov_op; 1 333 1 334 /* Reserve a tag to which to transfer if overflow occurs. */ 1 335 overflow_tag = cobol_$next_tag; 1 336 1 337 cobol_$next_tag = cobol_$next_tag + 1; 1 338 1 339 1 340 reloc_ptr = addr(reloc_buffer(1)); 1 341 reloc_buffer(1) = "0"b; 1 342 reloc_buffer(2) = "0"b; 1 343 1 344 /* Emit the instruction */ 1 345 call cobol_emit(temp_inst_ptr,reloc_ptr,1); 1 346 1 347 /* Make a tagref to the overflow tag at the instruction just emitted. */ 1 348 call cobol_make_tagref(overflow_tag, cobol_$text_wd_off - 1,null()); 1 349 1 350 1 351 if move_in_token_ptr ^= null() then 1 352 if move_in_token_ptr -> in_token.code ^= 0 1 353 then call cobol_move_gen(move_in_token_ptr); /* Move a temp result into a numeric edited. */ 1 354 1 355 1 356 /* Generate the tra to no_overflow_tag */ 1 357 temp_inst_word = "0"b; 1 358 temp_inst_ptr -> inst_struc_basic.fill1_op = tra_op; 1 359 1 360 save_locno = cobol_$text_wd_off; 1 361 1 362 /* Emit the tra instruction */ 1 363 call cobol_emit(temp_inst_ptr,reloc_ptr,1); 1 364 1 365 /* Make a tagref to the no_overflow_tag at the tra instruction just emitted. */ 1 366 call cobol_make_tagref(no_overflow_tag,save_locno,null()); 1 367 1 368 /* Generate aos instruction which increments the size error flag */ 1 369 /* Define the overflow_tag at the aos instruction */ 1 370 call cobol_define_tag(overflow_tag); 1 371 size_error_inst_ptr -> inst_struc_basic.fill1_op = aos_op; 1 372 1 373 /* Emit the instruction */ 1 374 call cobol_emit(size_error_inst_ptr,reloc_ptr,1); 1 375 1 376 /* Reset the opcode field of the non-eis instruction */ 1 377 size_error_inst_ptr -> inst_struc_basic.fill1_op = "0"b; 1 378 1 379 1 380 end test_for_overflow; 1 381 1 382 /**************************************************/ 1 383 /* INTERNAL PROCEDURE */ 1 384 /* test_size_error */ 1 385 /**************************************************/ 1 386 1 387 1 388 test_size_error:proc(size_error_token_ptr,size_error_inst_ptr,next_stmt_tag,overflow_code_generated,not_bit); 1 389 1 390 /* 1 391* 1 392*FUNCTION 1 393* 1 394*This internal procedure performs the following functions: 1 395* 1 396* If the overflow_code generated flag is "1"b then 1 397* the following functions are performed: 1 398* 1. Gets the A of Q register 1 399* 2. Generates two instructions. 1 400* a. LDA or LDQ with the contents of the size error flag 1 401* b. TZE to the next_stmt_tag 1 402* If the overflow_code_generated flag is "0"b, then 1 403* the following instruction is generated: 1 404* TRA to the next_stmt_tag 1 405* 1 406* 1 407**/ 1 408 1 409 /* DECLARATION OF THE PARAMETERS */ 1 410 1 411 dcl size_error_token_ptr ptr; 1 412 dcl size_error_inst_ptr ptr; 1 413 dcl next_stmt_tag fixed bin; 1 414 dcl (overflow_code_generated,not_bit) bit (1); 1 415 1 416 /* DESCRIPTION OF THE PARAMETERS */ 1 417 1 418 /* 1 419*PARAMETER DESCRIPTION 1 420* 1 421*size_error_token_ptr Points to a data name token 1 422* for the size error flag. (input) 1 423* 1 424*size_error_inst_ptr Points to a 36 bit field that contains 1 425* the non-eis address of the size 1 426* error flag in the run-time stack. 1 427* (input) 1 428*next_stmt_tag Contains a compiler generated tag 1 429* to be associated with the next 1 430* Cobol statement. (input) 1 431*overflow_code_generated Contains a one bit indicator that 1 432* is "1"b if overflow testing 1 433* code was generated for this statement. 1 434* (input) 1 435*not_bit "1"b if NOT option follows 1 436**/ 1 437 1 438 /* DECLARATION OF INTERNAL STATIC VARIABLES. */ 1 439 1 440 dcl lda_op bit (10) int static init ("0100111010"b /*235(0)*/); 1 441 dcl ldq_op bit (10) int static init ("0100111100"b /*236(0)*/); 1 442 dcl tze_op bit (10) int static init ("1100000000"b /*600(0)*/); 1 443 dcl tnz_op bit (10) int static init ("1100000010"b /*601(0)*/); /*[4.0-1]*/ 1 444 dcl tra_op bit (10) int static init ("1110010000"b /*710(0)*/); 1 445 1 446 1 447 /* DECLARATIONS OF INTERNAL AUTOMATIC VARIABLES */ 1 448 1 449 /* Structure used to communicate with the register$load procedure. */ 1 450 1 451 dcl 1 register_struc, 1 452 2 what_reg fixed bin, 1 453 2 reg_no bit (4), 1 454 2 lock fixed bin, 1 455 2 already_there fixed bin, 1 456 2 contains fixed bin, 1 457 2 dname_ptr ptr, 1 458 2 literal bit (36); 1 459 1 460 dcl temp_inst_word bit (36); 1 461 dcl temp_inst_ptr ptr; 1 462 1 463 dcl save_locno fixed bin; 1 464 dcl reloc_buffer (1:10) bit (5) aligned; 1 465 dcl reloc_ptr ptr; 1 466 dcl size_error_inst bit (36) based (size_error_inst_ptr); 1 467 1 468 1 469 /**************************************************/ 1 470 /* START OF EXECUTION */ 1 471 /* test_size_error */ 1 472 /**************************************************/ 1 473 reloc_ptr = addr(reloc_buffer(1)); 1 474 reloc_buffer(1) = "0"b; 1 475 reloc_buffer(2) = "0"b; 1 476 1 477 1 478 if overflow_code_generated 1 479 then do; /* overflow code was generated, must load the size error flag and test it */ 1 480 1 481 size_error_inst_ptr = addr(size_error_inst); 1 482 1 483 /* Get the A or Q register */ 1 484 register_struc.what_reg = 0; /* A or Q */ 1 485 register_struc.lock = 0; /* No change to locks */ 1 486 register_struc.contains = 1; /* Register will contain a data item */ 1 487 register_struc.dname_ptr = size_error_token_ptr; 1 488 1 489 call cobol_register$load(addr(register_struc)); 1 490 1 491 /* Build the LDA or LDQ instruction */ 1 492 1 493 if register_struc.reg_no = "0001"b 1 494 then size_error_inst_ptr -> inst_struc_basic.fill1_op = lda_op; /* A reg */ 1 495 else size_error_inst_ptr -> inst_struc_basic.fill1_op = ldq_op; /* Q reg */ 1 496 1 497 1 498 /* Emit the LDA or LDQ instruction */ 1 499 1 500 call cobol_emit(size_error_inst_ptr,reloc_ptr,1); 1 501 end; /* overflow code was generated, must load the size error flag and test it */ 1 502 1 503 1 504 /* Generate a TZE or TRA instruction */ 1 505 temp_inst_word = "0"b; 1 506 temp_inst_ptr = addr(temp_inst_word); 1 507 if overflow_code_generated 1 508 /*[4.2-1]*/ then if not_bit 1 509 /*[4.2-1]*/ then temp_inst_ptr -> inst_struc_basic.fill1_op = tnz_op; 1 510 /*[4.2-1]*/ else temp_inst_ptr -> inst_struc_basic.fill1_op = tze_op; 1 511 else temp_inst_ptr -> inst_struc_basic.fill1_op = tra_op; 1 512 1 513 /* Save the text word offset at which the tze is to be emitted */ 1 514 save_locno = cobol_$text_wd_off; 1 515 1 516 /* Emit the instruction */ 1 517 call cobol_emit(temp_inst_ptr,reloc_ptr,1); 1 518 1 519 /* Generate a tagref to the next cobol statement at the TZE or TRA just emitted */ 1 520 call cobol_make_tagref(next_stmt_tag,save_locno,null()); 1 521 1 522 1 523 end test_size_error; 1 524 1 525 1 526 1 527 1 528 not_dec_operand:proc(token_ptr) returns (bit (1)); 1 529 1 530 /* This function procedure determines whether an input data 1 531*name token represents a data item that is not decimal, 1 532*namely short fixed binary, long fixed binary, or overpunch 1 533*sign. If the token represents a fixed binary or overpunch 1 534*sign data item, then "1"b is returned. Otherwise "0"b is 1 535*returned. */ 1 536 1 537 dcl token_ptr ptr; 1 538 1 539 if token_ptr -> data_name.bin_18 1 540 | token_ptr -> data_name.bin_36 1 541 | token_ptr -> data_name.sign_type = "010"b /* leading not separate */ 1 542 | token_ptr -> data_name.sign_type = "001"b /* trailing, not separate */ 1 543 | (token_ptr -> data_name.display & token_ptr -> data_name.item_signed 1 544 & token_ptr -> data_name.sign_separate = "0"b) /* Default overpunch. */ 1 545 then return ("1"b); 1 546 else return ("0"b); 1 547 1 548 end not_dec_operand; 1 549 1 550 /* END INCLUDE FILE ... cobol_arith_util.incl.pl1 */ 1 551 562 2 1 2 2 /* BEGIN INCLUDE FILE ... cobol_type9.incl.pl1 */ 2 3 /* Last modified on 11/19/76 by ORN */ 2 4 2 5 /* 2 6*A type 9 data name token is entered into the name table by the data 2 7*division syntax phase for each data name described in the data division. 2 8*The replacement phase subsequently replaces type 8 user word references 2 9*to data names in the procedure division minpral file with the corresponding 2 10*type 9 tokens from the name table. 2 11**/ 2 12 2 13 /* dcl dn_ptr ptr; */ 2 14 2 15 /* BEGIN DECLARATION OF TYPE9 (DATA NAME) TOKEN */ 2 16 dcl 1 data_name based (dn_ptr), 3 1 3 2 /* begin include file ... cobol_TYPE9.incl.pl1 */ 3 3 /* Last modified on 06/19/77 by ORN */ 3 4 /* Last modified on 12/28/76 by FCH */ 3 5 3 6 /* header */ 3 7 2 size fixed bin, 3 8 2 line fixed bin, 3 9 2 column fixed bin, 3 10 2 type fixed bin, 3 11 /* body */ 3 12 2 string_ptr ptr, 3 13 2 prev_rec ptr, 3 14 2 searched bit (1), 3 15 2 duplicate bit (1), 3 16 2 saved bit (1), 3 17 2 debug_ind bit (1), 3 18 2 filler2 bit (3), 3 19 2 used_as_sub bit (1), 3 20 2 def_line fixed bin, 3 21 2 level fixed bin, 3 22 2 linkage fixed bin, 3 23 2 file_num fixed bin, 3 24 2 size_rtn fixed bin, 3 25 2 item_length fixed bin(24), 3 26 2 places_left fixed bin, 3 27 2 places_right fixed bin, 3 28 /* description */ 3 29 2 file_section bit (1), 3 30 2 working_storage bit (1), 3 31 2 constant_section bit (1), 3 32 2 linkage_section bit (1), 3 33 2 communication_section bit (1), 3 34 2 report_section bit (1), 3 35 2 level_77 bit (1), 3 36 2 level_01 bit (1), 3 37 2 non_elementary bit (1), 3 38 2 elementary bit (1), 3 39 2 filler_item bit (1), 3 40 2 s_of_rdf bit (1), 3 41 2 o_of_rdf bit (1), 3 42 2 bin_18 bit (1), 3 43 2 bin_36 bit (1), 3 44 2 pic_has_l bit (1), 3 45 2 pic_is_do bit (1), 3 46 2 numeric bit (1), 3 47 2 numeric_edited bit (1), 3 48 2 alphanum bit (1), 3 49 2 alphanum_edited bit (1), 3 50 2 alphabetic bit (1), 3 51 2 alphabetic_edited bit (1), 3 52 2 pic_has_p bit (1), 3 53 2 pic_has_ast bit (1), 3 54 2 item_signed bit(1), 3 55 2 sign_separate bit (1), 3 56 2 display bit (1), 3 57 2 comp bit (1), 3 58 2 ascii_packed_dec_h bit (1), /* as of 8/16/76 this field used for comp8. */ 3 59 2 ascii_packed_dec bit (1), 3 60 2 ebcdic_packed_dec bit (1), 3 61 2 bin_16 bit (1), 3 62 2 bin_32 bit (1), 3 63 2 usage_index bit (1), 3 64 2 just_right bit (1), 3 65 2 compare_argument bit (1), 3 66 2 sync bit (1), 3 67 2 temporary bit (1), 3 68 2 bwz bit (1), 3 69 2 variable_length bit (1), 3 70 2 subscripted bit (1), 3 71 2 occurs_do bit (1), 3 72 2 key_a bit (1), 3 73 2 key_d bit (1), 3 74 2 indexed_by bit (1), 3 75 2 value_numeric bit (1), 3 76 2 value_non_numeric bit (1), 3 77 2 value_signed bit (1), 3 78 2 sign_type bit (3), 3 79 2 pic_integer bit (1), 3 80 2 ast_when_zero bit (1), 3 81 2 label_record bit (1), 3 82 2 sign_clause_occurred bit (1), 3 83 2 okey_dn bit (1), 3 84 2 subject_of_keyis bit (1), 3 85 2 exp_redefining bit (1), 3 86 2 sync_in_rec bit (1), 3 87 2 rounded bit (1), 3 88 2 ad_bit bit (1), 3 89 2 debug_all bit (1), 3 90 2 overlap bit (1), 3 91 2 sum_counter bit (1), 3 92 2 exp_occurs bit (1), 3 93 2 linage_counter bit (1), 3 94 2 rnm_01 bit (1), 3 95 2 aligned bit (1), 3 96 2 not_user_writable bit (1), 3 97 2 database_key bit (1), 3 98 2 database_data_item bit (1), 3 99 2 seg_num fixed bin, 3 100 2 offset fixed bin(24), 3 101 2 initial_ptr fixed bin, 3 102 2 edit_ptr fixed bin, 3 103 2 occurs_ptr fixed bin, 3 104 2 do_rec char(5), 3 105 2 bitt bit (1), 3 106 2 byte bit (1), 3 107 2 half_word bit (1), 3 108 2 word bit (1), 3 109 2 double_word bit (1), 3 110 2 half_byte bit (1), 3 111 2 filler5 bit (1), 3 112 2 bit_offset bit (4), 3 113 2 son_cnt bit (16), 3 114 2 max_red_size fixed bin(24), 3 115 2 name_size fixed bin, 3 116 2 name char(0 refer(data_name.name_size)); 3 117 3 118 3 119 3 120 /* end include file ... cobol_TYPE9.incl.pl1 */ 3 121 2 17 2 18 /* END DECLARATION OF TYPE9 (DATA NAME) TOKEN */ 2 19 2 20 /* END INCLUDE FILE ... cobol_type9.incl.pl1 */ 2 21 563 4 1 4 2 /* BEGIN INCLUDE FILE ... cobol_in_token.incl.pl1 */ 4 3 4 4 /* Last modified August 22, 1974 by AEG */ 4 5 4 6 4 7 declare in_token_ptr ptr; 4 8 4 9 declare 1 in_token aligned based(in_token_ptr), 4 10 2 n fixed bin aligned, 4 11 2 code fixed bin aligned, 4 12 2 token_ptr(0 refer(in_token.n)) ptr aligned; 4 13 4 14 4 15 /* END INCLUDE FILE ... cobol_in_token.incl.pl1 */ 4 16 564 5 1 5 2 /* BEGIN INCLUDE FILE ... cobol_type19.incl.pl1 */ 5 3 /* last modified on 11/19/76 by ORN */ 5 4 5 5 /* 5 6*A type 19 end of statement token is created in the procedure division 5 7*minpral file at the end of each minpral statement generated by the 5 8*procedure division syntax phase. A minpral statement may be a complete or 5 9*partial source language statement. A type 19 token contains information 5 10*describing the statement which it delimits. 5 11**/ 5 12 5 13 dcl eos_ptr ptr; 5 14 5 15 /* BEGIN DECLARATION OF TYPE19 (END STATEMENT) TOKEN */ 5 16 dcl 1 end_stmt based (eos_ptr), 6 1 6 2 /* begin include file ... cobol_TYPE19.incl.pl1 */ 6 3 /* Last modified on 11/17/76 by ORN */ 6 4 6 5 /* header */ 6 6 2 size fixed bin, 6 7 2 line fixed bin, 6 8 2 column fixed bin, 6 9 2 type fixed bin, 6 10 /* body */ 6 11 2 verb fixed bin, 6 12 2 e fixed bin, 6 13 2 h fixed bin, 6 14 2 i fixed bin, 6 15 2 j fixed bin, 6 16 2 a bit (3), 6 17 2 b bit (1), 6 18 2 c bit (1), 6 19 2 d bit (2), 6 20 2 f bit (2), 6 21 2 g bit (2), 6 22 2 k bit (5), 6 23 2 always_an bit (1); 6 24 6 25 /* end include file ... cobol_TYPE19.incl.pl1 */ 6 26 5 17 5 18 /* END DECLARATION OF TYPE19 (END STATEMENT) TOKEN */ 5 19 5 20 /* 5 21*FIELD CONTENTS 5 22* 5 23*size The total size in bytes of this end of statement token. 5 24*line 0 5 25*column 0 5 26*type 19 5 27*verb A value indicating the verb in this statement 5 28* 1 = accept 5 29* 2 = add 5 30* 3 = on size error 5 31* 4 = alter 5 32* 5 = call 5 33* 7 = cancel 5 34* 8 = close 5 35* 9 = divide 5 36* 10 = multiply 5 37* 11 = subtract 5 38* 12 = exit 5 39* 14 = go 5 40* 15 = merge 5 41* 16 = initiate 5 42* 17 = inspect 5 43* 18 = move 5 44* 19 = open 5 45* 20 = perform 5 46* 21 = read 5 47* 23 = receive 5 48* 24 = release 5 49* 25 = return 5 50* 26 = search 5 51* 27 = rewrite 5 52* 29 = seek 5 53* 30 = send 5 54* 31 = set 5 55* 33 = stop 5 56* 34 = string 5 57* 35 = suspend 5 58* 36 = terminate 5 59* 37 = unstring 5 60* 38 = write 5 61* 39 = use 5 62* 40 = compute 5 63* 41 = disable 5 64* 42 = display 5 65* 43 = enable 5 66* 45 = generate 5 67* 46 = hold 5 68* 48 = process 5 69* 49 = sort 5 70* 52 = procedure 5 71* 53 = declaratives 5 72* 54 = section name 5 73* 55 = paragraph name 5 74* 98 = end 5 75*e,h,i,j The significance of these fields differs with each 5 76* statement. These fields are normally used as counters. 5 77*a,b,c,d,f,g,k The significance of these fields differs with each 5 78* statement. These fields are normally used as indicators. 5 79**/ 5 80 5 81 /* END INCLUDE FILE ... cobol_type19.incl.pl1 */ 5 82 565 7 1 7 2 /* BEGIN INCLUDE FILE ... cobol_.incl.pl1 */ 7 3 /* last modified Feb 4, 1977 by ORN */ 7 4 7 5 /* This file defines all external data used in the generator phase of Multics Cobol */ 7 6 7 7 /* POINTERS */ 7 8 dcl cobol_$text_base_ptr ptr ext; 7 9 dcl text_base_ptr ptr defined (cobol_$text_base_ptr); 7 10 dcl cobol_$con_end_ptr ptr ext; 7 11 dcl con_end_ptr ptr defined (cobol_$con_end_ptr); 7 12 dcl cobol_$def_base_ptr ptr ext; 7 13 dcl def_base_ptr ptr defined (cobol_$def_base_ptr); 7 14 dcl cobol_$link_base_ptr ptr ext; 7 15 dcl link_base_ptr ptr defined (cobol_$link_base_ptr); 7 16 dcl cobol_$sym_base_ptr ptr ext; 7 17 dcl sym_base_ptr ptr defined (cobol_$sym_base_ptr); 7 18 dcl cobol_$reloc_text_base_ptr ptr ext; 7 19 dcl reloc_text_base_ptr ptr defined (cobol_$reloc_text_base_ptr); 7 20 dcl cobol_$reloc_def_base_ptr ptr ext; 7 21 dcl reloc_def_base_ptr ptr defined (cobol_$reloc_def_base_ptr); 7 22 dcl cobol_$reloc_link_base_ptr ptr ext; 7 23 dcl reloc_link_base_ptr ptr defined (cobol_$reloc_link_base_ptr); 7 24 dcl cobol_$reloc_sym_base_ptr ptr ext; 7 25 dcl reloc_sym_base_ptr ptr defined (cobol_$reloc_sym_base_ptr); 7 26 dcl cobol_$reloc_work_base_ptr ptr ext; 7 27 dcl reloc_work_base_ptr ptr defined (cobol_$reloc_work_base_ptr); 7 28 dcl cobol_$pd_map_ptr ptr ext; 7 29 dcl pd_map_ptr ptr defined (cobol_$pd_map_ptr); 7 30 dcl cobol_$fixup_ptr ptr ext; 7 31 dcl fixup_ptr ptr defined (cobol_$fixup_ptr); 7 32 dcl cobol_$initval_base_ptr ptr ext; 7 33 dcl initval_base_ptr ptr defined (cobol_$initval_base_ptr); 7 34 dcl cobol_$initval_file_ptr ptr ext; 7 35 dcl initval_file_ptr ptr defined (cobol_$initval_file_ptr); 7 36 dcl cobol_$perform_list_ptr ptr ext; 7 37 dcl perform_list_ptr ptr defined (cobol_$perform_list_ptr); 7 38 dcl cobol_$alter_list_ptr ptr ext; 7 39 dcl alter_list_ptr ptr defined (cobol_$alter_list_ptr); 7 40 dcl cobol_$seg_init_list_ptr ptr ext; 7 41 dcl seg_init_list_ptr ptr defined (cobol_$seg_init_list_ptr); 7 42 dcl cobol_$temp_token_area_ptr ptr ext; 7 43 dcl temp_token_area_ptr ptr defined (cobol_$temp_token_area_ptr); 7 44 dcl cobol_$temp_token_ptr ptr ext; 7 45 dcl temp_token_ptr ptr defined (cobol_$temp_token_ptr); 7 46 dcl cobol_$token_block1_ptr ptr ext; 7 47 dcl token_block1_ptr ptr defined (cobol_$token_block1_ptr); 7 48 dcl cobol_$token_block2_ptr ptr ext; 7 49 dcl token_block2_ptr ptr defined (cobol_$token_block2_ptr); 7 50 dcl cobol_$minpral5_ptr ptr ext; 7 51 dcl minpral5_ptr ptr defined (cobol_$minpral5_ptr); 7 52 dcl cobol_$tag_table_ptr ptr ext; 7 53 dcl tag_table_ptr ptr defined (cobol_$tag_table_ptr); 7 54 dcl cobol_$map_data_ptr ptr ext; 7 55 dcl map_data_ptr ptr defined (cobol_$map_data_ptr); 7 56 dcl cobol_$ptr_status_ptr ptr ext; 7 57 dcl ptr_status_ptr ptr defined (cobol_$ptr_status_ptr); 7 58 dcl cobol_$reg_status_ptr ptr ext; 7 59 dcl reg_status_ptr ptr defined (cobol_$reg_status_ptr); 7 60 dcl cobol_$misc_base_ptr ptr ext; 7 61 dcl misc_base_ptr ptr defined (cobol_$misc_base_ptr); 7 62 dcl cobol_$misc_end_ptr ptr ext; 7 63 dcl misc_end_ptr ptr defined (cobol_$misc_end_ptr); 7 64 dcl cobol_$list_ptr ptr ext; 7 65 dcl list_ptr ptr defined (cobol_$list_ptr); 7 66 dcl cobol_$allo1_ptr ptr ext; 7 67 dcl allo1_ptr ptr defined (cobol_$allo1_ptr); 7 68 dcl cobol_$eln_ptr ptr ext; 7 69 dcl eln_ptr ptr defined (cobol_$eln_ptr); 7 70 dcl cobol_$diag_ptr ptr ext; 7 71 dcl diag_ptr ptr defined (cobol_$diag_ptr); 7 72 dcl cobol_$xref_token_ptr ptr ext; 7 73 dcl xref_token_ptr ptr defined (cobol_$xref_token_ptr); 7 74 dcl cobol_$xref_chain_ptr ptr ext; 7 75 dcl xref_chain_ptr ptr defined (cobol_$xref_chain_ptr); 7 76 dcl cobol_$statement_info_ptr ptr ext; 7 77 dcl statement_info_ptr ptr defined (cobol_$statement_info_ptr); 7 78 dcl cobol_$reswd_ptr ptr ext; 7 79 dcl reswd_ptr ptr defined (cobol_$reswd_ptr); 7 80 dcl cobol_$op_con_ptr ptr ext; 7 81 dcl op_con_ptr ptr defined (cobol_$op_con_ptr); 7 82 dcl cobol_$ntbuf_ptr ptr ext; 7 83 dcl ntbuf_ptr ptr defined (cobol_$ntbuf_ptr); 7 84 dcl cobol_$main_pcs_ptr ptr ext; 7 85 dcl main_pcs_ptr ptr defined (cobol_$main_pcs_ptr); 7 86 dcl cobol_$include_info_ptr ptr ext; 7 87 dcl include_info_ptr ptr defined (cobol_$include_info_ptr); 7 88 7 89 /* FIXED BIN */ 7 90 dcl cobol_$text_wd_off fixed bin ext; 7 91 dcl text_wd_off fixed bin defined (cobol_$text_wd_off); 7 92 dcl cobol_$con_wd_off fixed bin ext; 7 93 dcl con_wd_off fixed bin defined (cobol_$con_wd_off); 7 94 dcl cobol_$def_wd_off fixed bin ext; 7 95 dcl def_wd_off fixed bin defined (cobol_$def_wd_off); 7 96 dcl cobol_$def_max fixed bin ext; 7 97 dcl def_max fixed bin defined (cobol_$def_max); 7 98 dcl cobol_$link_wd_off fixed bin ext; 7 99 dcl link_wd_off fixed bin defined (cobol_$link_wd_off); 7 100 dcl cobol_$link_max fixed bin ext; 7 101 dcl link_max fixed bin defined (cobol_$link_max); 7 102 dcl cobol_$sym_wd_off fixed bin ext; 7 103 dcl sym_wd_off fixed bin defined (cobol_$sym_wd_off); 7 104 dcl cobol_$sym_max fixed bin ext; 7 105 dcl sym_max fixed bin defined (cobol_$sym_max); 7 106 dcl cobol_$reloc_text_max fixed bin(24) ext; 7 107 dcl reloc_text_max fixed bin(24) defined (cobol_$reloc_text_max); 7 108 dcl cobol_$reloc_def_max fixed bin(24) ext; 7 109 dcl reloc_def_max fixed bin(24) defined (cobol_$reloc_def_max); 7 110 dcl cobol_$reloc_link_max fixed bin(24) ext; 7 111 dcl reloc_link_max fixed bin(24) defined (cobol_$reloc_link_max); 7 112 dcl cobol_$reloc_sym_max fixed bin(24) ext; 7 113 dcl reloc_sym_max fixed bin(24) defined (cobol_$reloc_sym_max); 7 114 dcl cobol_$reloc_work_max fixed bin(24) ext; 7 115 dcl reloc_work_max fixed bin(24) defined (cobol_$reloc_work_max); 7 116 dcl cobol_$pd_map_index fixed bin ext; 7 117 dcl pd_map_index fixed bin defined (cobol_$pd_map_index); 7 118 dcl cobol_$cobol_data_wd_off fixed bin ext; 7 119 dcl cobol_data_wd_off fixed bin defined (cobol_$cobol_data_wd_off); 7 120 dcl cobol_$stack_off fixed bin ext; 7 121 dcl stack_off fixed bin defined (cobol_$stack_off); 7 122 dcl cobol_$max_stack_off fixed bin ext; 7 123 dcl max_stack_off fixed bin defined (cobol_$max_stack_off); 7 124 dcl cobol_$init_stack_off fixed bin ext; 7 125 dcl init_stack_off fixed bin defined (cobol_$init_stack_off); 7 126 dcl cobol_$pd_map_sw fixed bin ext; 7 127 dcl pd_map_sw fixed bin defined (cobol_$pd_map_sw); 7 128 dcl cobol_$next_tag fixed bin ext; 7 129 dcl next_tag fixed bin defined (cobol_$next_tag); 7 130 dcl cobol_$data_init_flag fixed bin ext; 7 131 dcl data_init_flag fixed bin defined (cobol_$data_init_flag); 7 132 dcl cobol_$seg_init_flag fixed bin ext; 7 133 dcl seg_init_flag fixed bin defined (cobol_$seg_init_flag); 7 134 dcl cobol_$alter_flag fixed bin ext; 7 135 dcl alter_flag fixed bin defined (cobol_$alter_flag); 7 136 dcl cobol_$sect_eop_flag fixed bin ext; 7 137 dcl sect_eop_flag fixed bin defined (cobol_$sect_eop_flag); 7 138 dcl cobol_$para_eop_flag fixed bin ext; 7 139 dcl para_eop_flag fixed bin defined (cobol_$para_eop_flag); 7 140 dcl cobol_$priority_no fixed bin ext; 7 141 dcl priority_no fixed bin defined (cobol_$priority_no); 7 142 dcl cobol_$compile_count fixed bin ext; 7 143 dcl compile_count fixed bin defined (cobol_$compile_count); 7 144 dcl cobol_$ptr_assumption_ind fixed bin ext; 7 145 dcl ptr_assumption_ind fixed bin defined (cobol_$ptr_assumption_ind); 7 146 dcl cobol_$reg_assumption_ind fixed bin ext; 7 147 dcl reg_assumption_ind fixed bin defined (cobol_$reg_assumption_ind); 7 148 dcl cobol_$perform_para_index fixed bin ext; 7 149 dcl perform_para_index fixed bin defined (cobol_$perform_para_index); 7 150 dcl cobol_$perform_sect_index fixed bin ext; 7 151 dcl perform_sect_index fixed bin defined (cobol_$perform_sect_index); 7 152 dcl cobol_$alter_index fixed bin ext; 7 153 dcl alter_index fixed bin defined (cobol_$alter_index); 7 154 dcl cobol_$list_off fixed bin ext; 7 155 dcl list_off fixed bin defined (cobol_$list_off); 7 156 dcl cobol_$constant_offset fixed bin ext; 7 157 dcl constant_offset fixed bin defined (cobol_$constant_offset); 7 158 dcl cobol_$misc_max fixed bin ext; 7 159 dcl misc_max fixed bin defined (cobol_$misc_max); 7 160 dcl cobol_$pd_map_max fixed bin ext; 7 161 dcl pd_map_max fixed bin defined (cobol_$pd_map_max); 7 162 dcl cobol_$map_data_max fixed bin ext; 7 163 dcl map_data_max fixed bin defined (cobol_$map_data_max); 7 164 dcl cobol_$fixup_max fixed bin ext; 7 165 dcl fixup_max fixed bin defined (cobol_$fixup_max); 7 166 dcl cobol_$tag_table_max fixed bin ext; 7 167 dcl tag_table_max fixed bin defined (cobol_$tag_table_max); 7 168 dcl cobol_$temp_token_max fixed bin ext; 7 169 dcl temp_token_max fixed bin defined (cobol_$temp_token_max); 7 170 dcl cobol_$allo1_max fixed bin ext; 7 171 dcl allo1_max fixed bin defined (cobol_$allo1_max); 7 172 dcl cobol_$eln_max fixed bin ext; 7 173 dcl eln_max fixed bin defined (cobol_$eln_max); 7 174 dcl cobol_$debug_enable fixed bin ext; 7 175 dcl debug_enable fixed bin defined (cobol_$debug_enable); 7 176 dcl cobol_$non_source_offset fixed bin ext; 7 177 dcl non_source_offset fixed bin defined (cobol_$non_source_offset); 7 178 dcl cobol_$initval_flag fixed bin ext; 7 179 dcl initval_flag fixed bin defined (cobol_$initval_flag); 7 180 dcl cobol_$date_compiled_sw fixed bin ext; 7 181 dcl date_compiled_sw fixed bin defined (cobol_$date_compiled_sw); 7 182 dcl cobol_$include_cnt fixed bin ext; 7 183 dcl include_cnt fixed bin defined (cobol_$include_cnt); 7 184 dcl cobol_$fs_charcnt fixed bin ext; 7 185 dcl fs_charcnt fixed bin defined (cobol_$fs_charcnt); 7 186 dcl cobol_$ws_charcnt fixed bin ext; 7 187 dcl ws_charcnt fixed bin defined (cobol_$ws_charcnt); 7 188 dcl cobol_$coms_charcnt fixed bin ext; 7 189 dcl coms_charcnt fixed bin defined (cobol_$coms_charcnt); 7 190 dcl cobol_$ls_charcnt fixed bin ext; 7 191 dcl ls_charcnt fixed bin defined (cobol_$ls_charcnt); 7 192 dcl cobol_$cons_charcnt fixed bin ext; 7 193 dcl cons_charcnt fixed bin defined (cobol_$cons_charcnt); 7 194 dcl cobol_$value_cnt fixed bin ext; 7 195 dcl value_cnt fixed bin defined (cobol_$value_cnt); 7 196 dcl cobol_$cd_cnt fixed bin ext; 7 197 dcl cd_cnt fixed bin defined (cobol_$cd_cnt); 7 198 dcl cobol_$fs_wdoff fixed bin ext; 7 199 dcl fs_wdoff fixed bin defined (cobol_$fs_wdoff); 7 200 dcl cobol_$ws_wdoff fixed bin ext; 7 201 dcl ws_wdoff fixed bin defined (cobol_$ws_wdoff); 7 202 dcl cobol_$coms_wdoff fixed bin ext; 7 203 dcl coms_wdoff fixed bin defined (cobol_$coms_wdoff); 7 204 7 205 /* CHARACTER */ 7 206 dcl cobol_$scratch_dir char (168) aligned ext; 7 207 dcl scratch_dir char (168) aligned defined (cobol_$scratch_dir); /* -42- */ 7 208 dcl cobol_$obj_seg_name char (32) aligned ext; 7 209 dcl obj_seg_name char (32) aligned defined (cobol_$obj_seg_name); /* -8- */ 7 210 7 211 /* BIT */ 7 212 dcl cobol_$xref_bypass bit(1) aligned ext; 7 213 dcl xref_bypass bit(1) aligned defined (cobol_$xref_bypass); /* -1- */ 7 214 dcl cobol_$same_sort_merge_proc bit(1) aligned ext; 7 215 dcl same_sort_merge_proc bit(1) aligned defined (cobol_$same_sort_merge_proc); /* -1- */ 7 216 7 217 7 218 /* END INCLUDE FILE ... cobol_incl.pl1*/ 7 219 7 220 566 8 1 8 2 /* BEGIN INCLUDE FILE ... cobol_addr_tokens.incl.pl1 */ 8 3 8 4 8 5 /****^ HISTORY COMMENTS: 8 6* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8058), 8 7* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 8 8* MCR8058 cobol_addr_tokens.incl.pl1 Change array extents to refer to 8 9* constants rather than variables. 8 10* END HISTORY COMMENTS */ 8 11 8 12 8 13 /* Last modified on 10/1/74 by tg */ 8 14 8 15 8 16 /* parameter list */ 8 17 8 18 dcl (input_ptr, inst_ptr, reloc_ptr) ptr; 8 19 8 20 8 21 /* input_struc_basic is used for type 1 addressing */ 8 22 8 23 dcl 1 input_struc_basic based (input_ptr), 8 24 2 type fixed bin, 8 25 2 operand_no fixed bin, 8 26 2 lock fixed bin, 8 27 2 segno fixed bin, 8 28 2 char_offset fixed bin (24), 8 29 2 send_receive fixed bin; 8 30 8 31 8 32 dcl 1 input_struc based (input_ptr), 8 33 2 type fixed bin, 8 34 2 operand_no fixed bin, 8 35 2 lock fixed bin, 8 36 2 operand (0 refer (input_struc.operand_no)), 8 37 3 token_ptr ptr, 8 38 3 send_receive fixed bin, 8 39 3 ic_mod fixed bin, 8 40 3 size_sw fixed bin; 8 41 8 42 /* reloc_struc is used for all types of addressing * all types */ 8 43 8 44 dcl 1 reloc_struc (input_struc.operand_no + 1) based (reloc_ptr), 8 45 2 left_wd bit (5) aligned, 8 46 2 right_wd bit (5) aligned; 8 47 8 48 /* Instruction format for 1 word instruction */ 8 49 8 50 8 51 dcl 1 inst_struc_basic based (inst_ptr) aligned, 8 52 2 y unaligned, 8 53 3 pr bit (3) unaligned, 8 54 3 wd_offset bit (15) unaligned, 8 55 2 fill1_op bit (10) unaligned, 8 56 2 zero1 bit (1) unaligned, 8 57 2 pr_spec bit (1) unaligned, 8 58 2 tm bit (2) unaligned, 8 59 2 td bit (4) unaligned; 8 60 8 61 8 62 /* The detailed definitions of the fields in this structure 8 63* can be found in the GMAP manual section 8 */ 8 64 /* EIS instruction format for 2_4 word instructions */ 8 65 8 66 dcl 1 inst_struc based (inst_ptr) aligned, 8 67 2 inst unaligned, 8 68 3 zero1 bit (2) unaligned, 8 69 3 mf3 unaligned, 8 70 4 pr_spec bit (1) unaligned, 8 71 4 reg_or_length bit (1) unaligned, 8 72 4 zero2 bit (1) unaligned, 8 73 4 reg_mod bit (4) unaligned, 8 74 3 zero3 bit (2) unaligned, 8 75 3 mf2 unaligned, 8 76 4 pr_spec bit (1) unaligned, 8 77 4 reg_or_length bit (1) unaligned, 8 78 4 zero4 bit (1) unaligned, 8 79 4 reg_mod bit (4) unaligned, 8 80 3 fill1_op bit (10) unaligned, 8 81 3 zero5 bit (1) unaligned, 8 82 3 mf1 unaligned, 8 83 4 pr_spec bit (1) unaligned, 8 84 4 reg_or_length bit (1) unaligned, 8 85 4 zero6 bit (1) unaligned, 8 86 4 reg_mod bit (4) unaligned, 8 87 2 desc_ext unaligned, 8 88 3 desc (512) unaligned, 8 89 4 desc_od bit (36) unaligned; 8 90 8 91 /* The detailed definitions of the fields in this structure 8 92* can be found in the GMAP manual section 8. 8 93* The desc_ext is the descriptor extension of this eis 8 94* instruction. The number of descriptors associated with 8 95* this instruction is equavalent to the operand number. 8 96* Depending on operand data type, the descriptor 8 97* can be alphanumeric or numeric. The structures of the 8 98* alphanumeric and the numeric descriptors are defined 8 99* below. */ 8 100 8 101 /* alphanumeric descriptor format */ 8 102 8 103 dcl 1 desc_an based (desc_an_ptr) unaligned, 8 104 2 desc_f (512) unaligned, 8 105 3 y unaligned, 8 106 4 pr bit (3) unaligned, 8 107 4 wd_offset bit (15) unaligned, 8 108 3 char_n bit (3) unaligned, 8 109 3 zero1 bit (1) unaligned, 8 110 3 ta bit (2), 8 111 3 n bit (12) unaligned; 8 112 8 113 8 114 /* The detailed definitions of the fields in this structure can 8 115* be found in the GMAP manual section 8. */ 8 116 /* numeric descriptor format */ 8 117 8 118 dcl desc_nn_ptr ptr; 8 119 dcl desc_an_ptr ptr; 8 120 8 121 8 122 dcl 1 desc_nn based (desc_nn_ptr) unaligned, 8 123 2 desc_f (512) unaligned, 8 124 3 y unaligned, 8 125 4 pr bit (3) unaligned, 8 126 4 wd_offset bit (15) unaligned, 8 127 3 digit_n bit (3) unaligned, 8 128 3 tn bit (1) unaligned, 8 129 3 sign_type bit (2) unaligned, 8 130 3 scal bit (6) unaligned, 8 131 3 n bit (6) unaligned; 8 132 8 133 8 134 /* The detailed definitions of fields in this structure can 8 135* be found in the GMAP manual section 8. */ 8 136 /* END INCLUDE FILE ... cobol_addr_tokens.incl.pl1 */ 8 137 567 9 1 9 2 /* BEGIN INCLUDE FILE ... cobol_record_types.incl.pl1 */ 9 3 /* <<< LAST MODIFIED ON 09-09-75 by tlf >>> */ 9 4 9 5 dcl rtc_resword fixed bin (15) int static init(1); 9 6 dcl rtc_numlit fixed bin (15) int static init(2); 9 7 dcl rtc_alphalit fixed bin (15) int static init(3); 9 8 dcl rtc_picstring fixed bin (15) int static init(4); 9 9 dcl rtc_diag fixed bin (15) int static init(5); 9 10 dcl rtc_source fixed bin (15) int static init(6); 9 11 dcl rtc_procdef fixed bin (15) int static init(7); 9 12 dcl rtc_userwd fixed bin (15) int static init(8); 9 13 dcl rtc_dataname fixed bin (15) int static init(9); 9 14 dcl rtc_indexname fixed bin (15) int static init(10); 9 15 dcl rtc_condname fixed bin (15) int static init(11); 9 16 dcl rtc_filedef fixed bin (15) int static init(12); 9 17 dcl rtc_commdesc fixed bin (15) int static init(13); 9 18 dcl rtc_debugitems fixed bin (15) int static init(14); 9 19 dcl rtc_savedarea fixed bin (15) int static init(15); 9 20 dcl rtc_sortmerge fixed bin (15) int static init(16); 9 21 dcl rtc_mnemonic fixed bin (15) int static init(17); 9 22 dcl rtc_pararef fixed bin (15) int static init(18); 9 23 dcl rtc_eos fixed bin (15) int static init(19); 9 24 dcl rtc_reportname fixed bin (15) int static init(20); 9 25 dcl rtc_groupname fixed bin (15) int static init(21); 9 26 dcl rtc_reportentry fixed bin (15) int static init(22); 9 27 dcl rtc_unknown1 fixed bin (15) int static init(23); 9 28 dcl rtc_debugenable fixed bin (15) int static init(24); 9 29 dcl rtc_unknown2 fixed bin (15) int static init(25); 9 30 dcl rtc_unknown3 fixed bin (15) int static init(26); 9 31 dcl rtc_unknown4 fixed bin (15) int static init(27); 9 32 dcl rtc_unknown5 fixed bin (15) int static init(28); 9 33 dcl rtc_unknown6 fixed bin (15) int static init(29); 9 34 dcl rtc_internal_tag fixed bin (15) int static init(30); 9 35 dcl rtc_equate_tag fixed bin (15) int static init(31); 9 36 dcl rtc_register fixed bin (15) int static init(100); 9 37 dcl rtc_fdec_temp fixed bin (15) int static init(101); 9 38 dcl rtc_immed_const fixed bin (15) int static init(102); 9 39 9 40 /* END INCLUDE FILE ... cobol_record_types.incl.pl1 */ 9 41 568 569 570 end cobol_multiply_gen; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0830.4 cobol_multiply_gen.pl1 >spec>install>MR12.3-1048>cobol_multiply_gen.pl1 562 1 03/27/82 0437.8 cobol_arith_util.incl.pl1 >ldd>include>cobol_arith_util.incl.pl1 563 2 03/27/82 0439.9 cobol_type9.incl.pl1 >ldd>include>cobol_type9.incl.pl1 2-17 3 11/11/82 1712.7 cobol_TYPE9.incl.pl1 >ldd>include>cobol_TYPE9.incl.pl1 564 4 11/11/82 1712.7 cobol_in_token.incl.pl1 >ldd>include>cobol_in_token.incl.pl1 565 5 03/27/82 0439.8 cobol_type19.incl.pl1 >ldd>include>cobol_type19.incl.pl1 5-17 6 03/27/82 0439.6 cobol_TYPE19.incl.pl1 >ldd>include>cobol_TYPE19.incl.pl1 566 7 11/11/82 1712.7 cobol_.incl.pl1 >ldd>include>cobol_.incl.pl1 567 8 05/24/89 0811.7 cobol_addr_tokens.incl.pl1 >spec>install>MR12.3-1048>cobol_addr_tokens.incl.pl1 568 9 03/27/82 0439.8 cobol_record_types.incl.pl1 >ldd>include>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 5-16 ref 297 addr builtin function dcl 192 ref 309 335 353 354 409 410 1-76 1-77 1-199 1-200 1-237 1-238 1-329 1-340 1-473 1-481 1-489 1-489 1-506 alphanum 21(19) based bit(1) level 2 packed packed unaligned dcl 2-16 set ref 1-180* 1-219* 1-254* 1-263* always_an 000107 internal static bit(1) initial packed unaligned dcl 1-151 set ref 1-182* 1-210 1-220* aos_op constant bit(10) initial packed unaligned dcl 1-309 ref 1-371 ascii_packed_dec_h 21(29) based bit(1) level 2 packed packed unaligned dcl 2-16 ref 1-178 1-252 b 11(03) based bit(1) level 2 packed packed unaligned dcl 5-16 ref 294 bin_18 21(13) based bit(1) level 2 packed packed unaligned dcl 2-16 ref 1-539 bin_36 21(14) based bit(1) level 2 packed packed unaligned dcl 2-16 ref 1-539 binary_ok 000144 automatic bit(1) packed unaligned dcl 270 set ref 278* 281 char_offset 4 based fixed bin(24,0) level 2 dcl 8-23 set ref 1-83* cobol_$compile_count 000162 external static fixed bin(17,0) dcl 7-142 ref 356 412 541 cobol_$next_tag 000160 external static fixed bin(17,0) dcl 7-128 set ref 330 331* 331 462 463* 463 1-335 1-337* 1-337 cobol_$text_wd_off 000156 external static fixed bin(17,0) dcl 7-90 ref 1-348 1-360 1-514 cobol_addr 000134 constant entry external dcl 174 ref 1-88 cobol_alloc$stack 000132 constant entry external dcl 173 ref 1-69 1-188 cobol_arith_move_gen 000140 constant entry external dcl 176 ref 418 451 cobol_binary_check$multiply 000110 constant entry external dcl 162 ref 278 cobol_build_resop 000122 constant entry external dcl 169 ref 347 399 cobol_define_tag 000130 constant entry external dcl 172 ref 478 1-370 cobol_emit 000136 constant entry external dcl 175 ref 1-94 1-345 1-363 1-374 1-500 1-517 cobol_fofl_mask$off 000120 constant entry external dcl 168 ref 481 cobol_fofl_mask$on 000116 constant entry external dcl 167 ref 380 cobol_make_tagref 000146 constant entry external dcl 181 ref 1-348 1-366 1-520 cobol_make_type9$copy 000144 constant entry external dcl 179 ref 1-185 cobol_make_type9$fixed_bin_35 000152 constant entry external dcl 183 ref 1-73 cobol_make_type9$type2_3 000154 constant entry external dcl 185 ref 314 cobol_move_gen 000142 constant entry external dcl 178 ref 485 1-215 1-259 1-351 cobol_mpy 000126 constant entry external dcl 171 ref 437 cobol_mpy3 000124 constant entry external dcl 170 ref 351 404 cobol_multiply_bin_gen 000112 constant entry external dcl 164 ref 283 cobol_num_to_udts 000114 constant entry external dcl 166 ref 432 cobol_register$load 000150 constant entry external dcl 182 ref 1-489 code 1 based fixed bin(17,0) level 2 dcl 4-9 set ref 419 452 528* 1-351 contains 4 000336 automatic fixed bin(17,0) level 2 dcl 1-451 set ref 1-486* data_name based structure level 1 unaligned dcl 2-16 display 21(27) based bit(1) level 2 packed packed unaligned dcl 2-16 ref 369 1-539 dname_ptr 6 000336 automatic pointer level 2 dcl 1-451 set ref 1-487* e 5 based fixed bin(17,0) level 2 dcl 5-16 set ref 300 537* 1-210* 1-211* 1-247* end_stmt based structure level 1 unaligned dcl 5-16 eos_ptr 000150 automatic pointer dcl 5-13 set ref 291* 294 297 300 322 502 533 534* 536 537 538 539* f 11(07) based bit(2) level 2 packed packed unaligned dcl 5-16 ref 502 fill1_op 0(18) based bit(10) level 2 packed packed unaligned dcl 8-51 set ref 1-91* 1-97* 1-332* 1-358* 1-371* 1-377* 1-493* 1-495* 1-507* 1-510* 1-511* first_ix constant fixed bin(17,0) initial dcl 198 ref 301 344 345 fixed builtin function dcl 193 ref 1-188 1-188 fmt1 000102 automatic bit(1) packed unaligned dcl 240 set ref 299* 321* 340 383 function_code parameter fixed bin(17,0) dcl 1-115 ref 1-107 1-161 h 6 based fixed bin(17,0) level 2 dcl 5-16 ref 322 in_token based structure level 1 dcl 4-9 in_token_ptr parameter pointer dcl 4-7 set ref 29 278* 283* 291 291 301 344 345 363 369 369 369 369 376 389 394 416 437 448 474 524 525* 527 528 529 530 530 531* input_buffer 000175 automatic fixed bin(17,0) array dcl 1-58 set ref 1-76 input_ptr 000152 automatic pointer dcl 8-18 set ref 1-76* 1-79 1-80 1-81 1-82 1-83 1-88* input_struc_basic based structure level 1 unaligned dcl 8-23 inst_struc_basic based structure level 1 dcl 8-51 item_length 16 based fixed bin(24,0) level 2 dcl 2-16 ref 1-188 1-188 item_signed 21(25) based bit(1) level 2 packed packed unaligned dcl 2-16 ref 369 1-539 ix 000103 automatic fixed bin(17,0) dcl 244 set ref 365* iy 000104 automatic fixed bin(17,0) dcl 245 set ref 363* 369 369 369 369 376 389 394 416 437 448 474 492* 492 lda_op constant bit(10) initial packed unaligned dcl 1-440 ref 1-493 ldq_op constant bit(10) initial packed unaligned dcl 1-441 ref 1-495 lock 2 based fixed bin(17,0) level 2 in structure "input_struc_basic" dcl 8-23 in procedure "cobol_multiply_gen" set ref 1-81* lock 2 000336 automatic fixed bin(17,0) level 2 in structure "register_struc" dcl 1-451 in procedure "test_size_error" set ref 1-485* move_data_init 000062 internal static fixed bin(17,0) initial dcl 211 set ref 356 412 541* move_eos 000075 internal static structure level 1 unaligned dcl 1-140 set ref 1-200 1-238 move_eos_buffer 000012 internal static pointer array dcl 204 set ref 354 410 move_eos_ptr 000106 automatic pointer dcl 246 in procedure "cobol_multiply_gen" set ref 354* 410* 530 534 move_eos_ptr 000254 automatic pointer dcl 1-156 in procedure "receiving_field" set ref 1-200* 1-207 1-210 1-211 1-238* 1-244 1-247 move_in_token_buffer 000036 internal static pointer array dcl 208 set ref 353 409 move_in_token_ptr parameter pointer dcl 1-290 in procedure "test_for_overflow" set ref 1-274 1-351 1-351 1-351* move_in_token_ptr 000110 automatic pointer dcl 247 in procedure "cobol_multiply_gen" set ref 288* 353* 388* 409* 415 416 418* 419 446 446 448 448 451* 452 466* 485* 525 mpy_code 000010 internal static fixed bin(17,0) initial dcl 200 set ref 347* 399* multiplicand_ptr 000112 automatic pointer dcl 248 set ref 301* 303 306 306 311* 314* 344* 347* 351* 393 428* 430 431* 432* 437* multiplier_ptr 000114 automatic pointer dcl 249 set ref 345* 347* 351* n based fixed bin(17,0) level 2 dcl 4-9 set ref 291 363 446 448 527* 530 1-203* 1-240* next_stmt_tag parameter fixed bin(17,0) dcl 1-413 in procedure "test_size_error" set ref 1-388 1-520* next_stmt_tag parameter fixed bin(17,0) dcl 46 in procedure "cobol_multiply_gen" set ref 29 283* 330* 505* no_overflow_tag parameter fixed bin(17,0) dcl 1-288 in procedure "test_for_overflow" set ref 1-274 1-366* no_overflow_tag 000134 automatic fixed bin(17,0) dcl 265 in procedure "cobol_multiply_gen" set ref 462* 466* 478* not_bit parameter bit(1) packed unaligned dcl 1-414 in procedure "test_size_error" ref 1-388 1-507 not_bit 000145 automatic bit(1) packed unaligned dcl 270 in procedure "cobol_multiply_gen" set ref 502* 504* 505* null builtin function dcl 194 ref 288 311 388 431 529 1-72 1-184 1-204 1-241 1-348 1-348 1-351 1-366 1-366 1-520 1-520 num_lit_zero 000063 internal static structure level 1 unaligned dcl 217 set ref 309 numeric 21(17) based bit(1) level 2 packed packed unaligned dcl 2-16 set ref 1-179* 1-218* 1-253* 1-262* numeric_edited 21(18) based bit(1) level 2 packed packed unaligned dcl 2-16 ref 369 occurs_ptr 27 based fixed bin(17,0) level 2 dcl 2-16 set ref 1-195* offset 24 based fixed bin(24,0) level 2 dcl 2-16 set ref 1-192* op1_token_ptr 000136 automatic pointer dcl 266 set ref 393* 399* 404* 430* 432* op2_token_ptr 000140 automatic pointer dcl 267 set ref 394* 399* 404* operand_no 1 based fixed bin(17,0) level 2 dcl 8-23 set ref 1-80* ose_flag 000100 automatic bit(1) packed unaligned dcl 237 set ref 294* 325 369 380 457 496 overflow_code_generated parameter bit(1) packed unaligned dcl 1-414 ref 1-388 1-478 1-507 overflow_tag 000327 automatic fixed bin(17,0) dcl 1-320 set ref 1-335* 1-348* 1-370* possible_ovfl_flag 000123 automatic bit(1) packed unaligned dcl 257 set ref 347* 399* rdmax_value 000122 automatic fixed bin(17,0) dcl 254 set ref 347* 399* receive_count 000101 automatic fixed bin(17,0) dcl 238 set ref 300* 322* 363 365 receiving_is_not_stored 000124 automatic bit(1) packed unaligned dcl 258 set ref 366* 369* 419* 452* 474 485 receiving_token_ptr parameter pointer dcl 1-113 set ref 1-107 1-178 1-179 1-180 1-185* 1-205 1-218 1-219 1-243 1-252 1-253 1-254 1-262 1-263 reg_no 1 000336 automatic bit(4) level 2 packed packed unaligned dcl 1-451 set ref 1-493 register_struc 000336 automatic structure level 1 unaligned dcl 1-451 set ref 1-489 1-489 reloc_buffer 000207 automatic bit(5) array dcl 1-59 in procedure "get_size_error_flag" set ref 1-77 reloc_buffer 000312 automatic bit(5) array dcl 1-316 in procedure "test_for_overflow" set ref 1-340 1-341* 1-342* reloc_buffer 000353 automatic bit(5) array dcl 1-464 in procedure "test_size_error" set ref 1-473 1-474* 1-475* reloc_ptr 000366 automatic pointer dcl 1-465 in procedure "test_size_error" set ref 1-473* 1-500* 1-517* reloc_ptr 000154 automatic pointer dcl 8-18 in procedure "cobol_multiply_gen" set ref 1-77* 1-88* 1-94* reloc_ptr 000324 automatic pointer dcl 1-317 in procedure "test_for_overflow" set ref 1-340* 1-345* 1-363* 1-374* resultant_operand_ptr 000116 automatic pointer dcl 250 set ref 347* 351* 446 ret_offset 000262 automatic fixed bin(17,0) dcl 1-159 in procedure "receiving_field" set ref 1-188* 1-192 ret_offset 000174 automatic fixed bin(17,0) dcl 1-56 in procedure "get_size_error_flag" set ref 1-69* 1-73* 1-83 rtc_dataname constant fixed bin(15,0) initial dcl 9-13 ref 303 rtc_eos constant fixed bin(15,0) initial dcl 9-23 ref 538 rtc_numlit constant fixed bin(15,0) initial dcl 9-6 ref 306 save_locno 000326 automatic fixed bin(17,0) dcl 1-319 in procedure "test_for_overflow" set ref 1-360* 1-366* save_locno 000352 automatic fixed bin(17,0) dcl 1-463 in procedure "test_size_error" set ref 1-514* 1-520* saved_ptr 000120 automatic pointer dcl 252 set ref 306* 309* 314* 524* 531 533* 539 seg_num 23 based fixed bin(17,0) level 2 dcl 2-16 set ref 1-191* segno 3 based fixed bin(17,0) level 2 dcl 8-23 set ref 1-82* sign_separate 21(26) based bit(1) level 2 packed packed unaligned dcl 2-16 ref 369 1-539 sign_type 22(13) based bit(3) level 2 packed packed unaligned dcl 2-16 ref 1-539 1-539 size_error_inst 000125 automatic bit(36) packed unaligned dcl 260 in procedure "cobol_multiply_gen" set ref 335 size_error_inst based bit(36) packed unaligned dcl 1-466 in procedure "test_size_error" set ref 1-481 size_error_inst_ptr parameter pointer dcl 1-34 in procedure "get_size_error_flag" set ref 1-13 1-85 1-88* 1-91 1-94* 1-97 size_error_inst_ptr 000126 automatic pointer dcl 261 in procedure "cobol_multiply_gen" set ref 335* 336* 466* 505* size_error_inst_ptr parameter pointer dcl 1-412 in procedure "test_size_error" set ref 1-388 1-481* 1-481 1-493 1-495 1-500* size_error_inst_ptr parameter pointer dcl 1-289 in procedure "test_for_overflow" set ref 1-274 1-371 1-374* 1-377 size_error_inst_word based bit(36) packed unaligned dcl 1-57 set ref 1-85* size_error_token_ptr parameter pointer dcl 1-411 in procedure "test_size_error" ref 1-388 1-487 size_error_token_ptr parameter pointer dcl 1-33 in procedure "get_size_error_flag" set ref 1-13 1-72* 1-73* size_error_token_ptr 000130 automatic pointer dcl 262 in procedure "cobol_multiply_gen" set ref 336* 505* source_code 000146 automatic fixed bin(17,0) dcl 272 set ref 278* stored_token_ptr parameter pointer dcl 1-114 in procedure "receiving_field" set ref 1-107 1-201* 1-206 1-242 stored_token_ptr 000132 automatic pointer dcl 264 in procedure "cobol_multiply_gen" set ref 376* 474* stz_op constant bit(10) initial packed unaligned dcl 1-52 ref 1-91 subscripted 22(05) based bit(1) level 2 packed packed unaligned dcl 2-16 set ref 1-193* target_code 000147 automatic fixed bin(17,0) dcl 273 set ref 278* temp_in_token 000230 automatic pointer array dcl 1-155 set ref 1-199 1-237 temp_inst_ptr 000350 automatic pointer dcl 1-461 in procedure "test_size_error" set ref 1-506* 1-507 1-510 1-511 1-517* temp_inst_ptr 000310 automatic pointer dcl 1-314 in procedure "test_for_overflow" set ref 1-329* 1-332 1-345* 1-358 1-363* temp_inst_word 000347 automatic bit(36) packed unaligned dcl 1-460 in procedure "test_size_error" set ref 1-505* 1-506 temp_inst_word 000306 automatic bit(36) packed unaligned dcl 1-313 in procedure "test_for_overflow" set ref 1-328* 1-329 1-357* temp_resultant_operand_ptr 000142 automatic pointer dcl 268 set ref 399* 404* 415 temp_save_ptr 000260 automatic pointer dcl 1-158 set ref 1-184* 1-185* 1-188 1-188 1-191 1-192 1-193 1-194 1-195 1-201 tin_ptr 000256 automatic pointer dcl 1-157 set ref 1-199* 1-203 1-204 1-205 1-206 1-207 1-215* 1-237* 1-240 1-241 1-242 1-243 1-244 1-259* tnz_op constant bit(10) initial packed unaligned dcl 1-443 ref 1-507 token_ptr 2 based pointer array level 2 in structure "in_token" dcl 4-9 in procedure "cobol_multiply_gen" set ref 291 301 344 345 369 369 369 369 376* 389* 394 415* 416* 416 437* 446* 448* 448 474* 529* 530* 1-204* 1-205* 1-206* 1-207* 1-241* 1-242* 1-243* 1-244* token_ptr parameter pointer dcl 1-537 in procedure "not_dec_operand" ref 1-528 1-539 1-539 1-539 1-539 1-539 1-539 1-539 tov_op constant bit(10) initial packed unaligned dcl 1-307 ref 1-332 tra_op constant bit(10) initial packed unaligned dcl 1-444 in procedure "test_size_error" ref 1-511 tra_op constant bit(10) initial packed unaligned dcl 1-308 in procedure "test_for_overflow" ref 1-358 type based fixed bin(17,0) level 2 in structure "input_struc_basic" dcl 8-23 in procedure "cobol_multiply_gen" set ref 1-79* type 3 based fixed bin(17,0) level 2 in structure "data_name" dcl 2-16 in procedure "cobol_multiply_gen" ref 303 306 type 3 based fixed bin(17,0) level 2 in structure "end_stmt" dcl 5-16 in procedure "cobol_multiply_gen" set ref 538* tze_op constant bit(10) initial packed unaligned dcl 1-442 ref 1-510 variable_length 22(04) based bit(1) level 2 packed packed unaligned dcl 2-16 set ref 1-194* verb 4 based fixed bin(17,0) level 2 dcl 5-16 set ref 536* what_reg 000336 automatic fixed bin(17,0) level 2 dcl 1-451 set ref 1-484* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. allo1_max defined fixed bin(17,0) dcl 7-171 allo1_ptr defined pointer dcl 7-67 alter_flag defined fixed bin(17,0) dcl 7-135 alter_index defined fixed bin(17,0) dcl 7-153 alter_list_ptr defined pointer dcl 7-39 cd_cnt defined fixed bin(17,0) dcl 7-197 cobol_$allo1_max external static fixed bin(17,0) dcl 7-170 cobol_$allo1_ptr external static pointer dcl 7-66 cobol_$alter_flag external static fixed bin(17,0) dcl 7-134 cobol_$alter_index external static fixed bin(17,0) dcl 7-152 cobol_$alter_list_ptr external static pointer dcl 7-38 cobol_$cd_cnt external static fixed bin(17,0) dcl 7-196 cobol_$cobol_data_wd_off external static fixed bin(17,0) dcl 7-118 cobol_$coms_charcnt external static fixed bin(17,0) dcl 7-188 cobol_$coms_wdoff external static fixed bin(17,0) dcl 7-202 cobol_$con_end_ptr external static pointer dcl 7-10 cobol_$con_wd_off external static fixed bin(17,0) dcl 7-92 cobol_$cons_charcnt external static fixed bin(17,0) dcl 7-192 cobol_$constant_offset external static fixed bin(17,0) dcl 7-156 cobol_$data_init_flag external static fixed bin(17,0) dcl 7-130 cobol_$date_compiled_sw external static fixed bin(17,0) dcl 7-180 cobol_$debug_enable external static fixed bin(17,0) dcl 7-174 cobol_$def_base_ptr external static pointer dcl 7-12 cobol_$def_max external static fixed bin(17,0) dcl 7-96 cobol_$def_wd_off external static fixed bin(17,0) dcl 7-94 cobol_$diag_ptr external static pointer dcl 7-70 cobol_$eln_max external static fixed bin(17,0) dcl 7-172 cobol_$eln_ptr external static pointer dcl 7-68 cobol_$fixup_max external static fixed bin(17,0) dcl 7-164 cobol_$fixup_ptr external static pointer dcl 7-30 cobol_$fs_charcnt external static fixed bin(17,0) dcl 7-184 cobol_$fs_wdoff external static fixed bin(17,0) dcl 7-198 cobol_$include_cnt external static fixed bin(17,0) dcl 7-182 cobol_$include_info_ptr external static pointer dcl 7-86 cobol_$init_stack_off external static fixed bin(17,0) dcl 7-124 cobol_$initval_base_ptr external static pointer dcl 7-32 cobol_$initval_file_ptr external static pointer dcl 7-34 cobol_$initval_flag external static fixed bin(17,0) dcl 7-178 cobol_$link_base_ptr external static pointer dcl 7-14 cobol_$link_max external static fixed bin(17,0) dcl 7-100 cobol_$link_wd_off external static fixed bin(17,0) dcl 7-98 cobol_$list_off external static fixed bin(17,0) dcl 7-154 cobol_$list_ptr external static pointer dcl 7-64 cobol_$ls_charcnt external static fixed bin(17,0) dcl 7-190 cobol_$main_pcs_ptr external static pointer dcl 7-84 cobol_$map_data_max external static fixed bin(17,0) dcl 7-162 cobol_$map_data_ptr external static pointer dcl 7-54 cobol_$max_stack_off external static fixed bin(17,0) dcl 7-122 cobol_$minpral5_ptr external static pointer dcl 7-50 cobol_$misc_base_ptr external static pointer dcl 7-60 cobol_$misc_end_ptr external static pointer dcl 7-62 cobol_$misc_max external static fixed bin(17,0) dcl 7-158 cobol_$non_source_offset external static fixed bin(17,0) dcl 7-176 cobol_$ntbuf_ptr external static pointer dcl 7-82 cobol_$obj_seg_name external static char(32) dcl 7-208 cobol_$op_con_ptr external static pointer dcl 7-80 cobol_$para_eop_flag external static fixed bin(17,0) dcl 7-138 cobol_$pd_map_index external static fixed bin(17,0) dcl 7-116 cobol_$pd_map_max external static fixed bin(17,0) dcl 7-160 cobol_$pd_map_ptr external static pointer dcl 7-28 cobol_$pd_map_sw external static fixed bin(17,0) dcl 7-126 cobol_$perform_list_ptr external static pointer dcl 7-36 cobol_$perform_para_index external static fixed bin(17,0) dcl 7-148 cobol_$perform_sect_index external static fixed bin(17,0) dcl 7-150 cobol_$priority_no external static fixed bin(17,0) dcl 7-140 cobol_$ptr_assumption_ind external static fixed bin(17,0) dcl 7-144 cobol_$ptr_status_ptr external static pointer dcl 7-56 cobol_$reg_assumption_ind external static fixed bin(17,0) dcl 7-146 cobol_$reg_status_ptr external static pointer dcl 7-58 cobol_$reloc_def_base_ptr external static pointer dcl 7-20 cobol_$reloc_def_max external static fixed bin(24,0) dcl 7-108 cobol_$reloc_link_base_ptr external static pointer dcl 7-22 cobol_$reloc_link_max external static fixed bin(24,0) dcl 7-110 cobol_$reloc_sym_base_ptr external static pointer dcl 7-24 cobol_$reloc_sym_max external static fixed bin(24,0) dcl 7-112 cobol_$reloc_text_base_ptr external static pointer dcl 7-18 cobol_$reloc_text_max external static fixed bin(24,0) dcl 7-106 cobol_$reloc_work_base_ptr external static pointer dcl 7-26 cobol_$reloc_work_max external static fixed bin(24,0) dcl 7-114 cobol_$reswd_ptr external static pointer dcl 7-78 cobol_$same_sort_merge_proc external static bit(1) dcl 7-214 cobol_$scratch_dir external static char(168) dcl 7-206 cobol_$sect_eop_flag external static fixed bin(17,0) dcl 7-136 cobol_$seg_init_flag external static fixed bin(17,0) dcl 7-132 cobol_$seg_init_list_ptr external static pointer dcl 7-40 cobol_$stack_off external static fixed bin(17,0) dcl 7-120 cobol_$statement_info_ptr external static pointer dcl 7-76 cobol_$sym_base_ptr external static pointer dcl 7-16 cobol_$sym_max external static fixed bin(17,0) dcl 7-104 cobol_$sym_wd_off external static fixed bin(17,0) dcl 7-102 cobol_$tag_table_max external static fixed bin(17,0) dcl 7-166 cobol_$tag_table_ptr external static pointer dcl 7-52 cobol_$temp_token_area_ptr external static pointer dcl 7-42 cobol_$temp_token_max external static fixed bin(17,0) dcl 7-168 cobol_$temp_token_ptr external static pointer dcl 7-44 cobol_$text_base_ptr external static pointer dcl 7-8 cobol_$token_block1_ptr external static pointer dcl 7-46 cobol_$token_block2_ptr external static pointer dcl 7-48 cobol_$value_cnt external static fixed bin(17,0) dcl 7-194 cobol_$ws_charcnt external static fixed bin(17,0) dcl 7-186 cobol_$ws_wdoff external static fixed bin(17,0) dcl 7-200 cobol_$xref_bypass external static bit(1) dcl 7-212 cobol_$xref_chain_ptr external static pointer dcl 7-74 cobol_$xref_token_ptr external static pointer dcl 7-72 cobol_data_wd_off defined fixed bin(17,0) dcl 7-119 compile_count defined fixed bin(17,0) dcl 7-143 coms_charcnt defined fixed bin(17,0) dcl 7-189 coms_wdoff defined fixed bin(17,0) dcl 7-203 con_end_ptr defined pointer dcl 7-11 con_wd_off defined fixed bin(17,0) dcl 7-93 cons_charcnt defined fixed bin(17,0) dcl 7-193 constant_offset defined fixed bin(17,0) dcl 7-157 data_init_flag defined fixed bin(17,0) dcl 7-131 date_compiled_sw defined fixed bin(17,0) dcl 7-181 debug_enable defined fixed bin(17,0) dcl 7-175 def_base_ptr defined pointer dcl 7-13 def_max defined fixed bin(17,0) dcl 7-97 def_wd_off defined fixed bin(17,0) dcl 7-95 desc_an based structure level 1 packed packed unaligned dcl 8-103 desc_an_ptr automatic pointer dcl 8-119 desc_nn based structure level 1 packed packed unaligned dcl 8-122 desc_nn_ptr automatic pointer dcl 8-118 diag_ptr defined pointer dcl 7-71 dn_ptr automatic pointer dcl 275 eln_max defined fixed bin(17,0) dcl 7-173 eln_ptr defined pointer dcl 7-69 fixup_max defined fixed bin(17,0) dcl 7-165 fixup_ptr defined pointer dcl 7-31 fs_charcnt defined fixed bin(17,0) dcl 7-185 fs_wdoff defined fixed bin(17,0) dcl 7-199 include_cnt defined fixed bin(17,0) dcl 7-183 include_info_ptr defined pointer dcl 7-87 init_stack_off defined fixed bin(17,0) dcl 7-125 initval_base_ptr defined pointer dcl 7-33 initval_file_ptr defined pointer dcl 7-35 initval_flag defined fixed bin(17,0) dcl 7-179 input_struc based structure level 1 unaligned dcl 8-32 inst_ptr automatic pointer dcl 8-18 inst_struc based structure level 1 dcl 8-66 link_base_ptr defined pointer dcl 7-15 link_max defined fixed bin(17,0) dcl 7-101 link_wd_off defined fixed bin(17,0) dcl 7-99 list_off defined fixed bin(17,0) dcl 7-155 list_ptr defined pointer dcl 7-65 ls_charcnt defined fixed bin(17,0) dcl 7-191 main_pcs_ptr defined pointer dcl 7-85 map_data_max defined fixed bin(17,0) dcl 7-163 map_data_ptr defined pointer dcl 7-55 max_stack_off defined fixed bin(17,0) dcl 7-123 minpral5_ptr defined pointer dcl 7-51 misc_base_ptr defined pointer dcl 7-61 misc_end_ptr defined pointer dcl 7-63 misc_max defined fixed bin(17,0) dcl 7-159 next_tag defined fixed bin(17,0) dcl 7-129 non_source_offset defined fixed bin(17,0) dcl 7-177 ntbuf_ptr defined pointer dcl 7-83 obj_seg_name defined char(32) dcl 7-209 op_con_ptr defined pointer dcl 7-81 overflow_code_generated automatic bit(1) packed unaligned dcl 255 para_eop_flag defined fixed bin(17,0) dcl 7-139 pd_map_index defined fixed bin(17,0) dcl 7-117 pd_map_max defined fixed bin(17,0) dcl 7-161 pd_map_ptr defined pointer dcl 7-29 pd_map_sw defined fixed bin(17,0) dcl 7-127 perform_list_ptr defined pointer dcl 7-37 perform_para_index defined fixed bin(17,0) dcl 7-149 perform_sect_index defined fixed bin(17,0) dcl 7-151 priority_no defined fixed bin(17,0) dcl 7-141 ptr_assumption_ind defined fixed bin(17,0) dcl 7-145 ptr_status_ptr defined pointer dcl 7-57 reg_assumption_ind defined fixed bin(17,0) dcl 7-147 reg_status_ptr defined pointer dcl 7-59 reloc_def_base_ptr defined pointer dcl 7-21 reloc_def_max defined fixed bin(24,0) dcl 7-109 reloc_link_base_ptr defined pointer dcl 7-23 reloc_link_max defined fixed bin(24,0) dcl 7-111 reloc_struc based structure array level 1 unaligned dcl 8-44 reloc_sym_base_ptr defined pointer dcl 7-25 reloc_sym_max defined fixed bin(24,0) dcl 7-113 reloc_text_base_ptr defined pointer dcl 7-19 reloc_text_max defined fixed bin(24,0) dcl 7-107 reloc_work_base_ptr defined pointer dcl 7-27 reloc_work_max defined fixed bin(24,0) dcl 7-115 reswd_ptr defined pointer dcl 7-79 rtc_alphalit internal static fixed bin(15,0) initial dcl 9-7 rtc_commdesc internal static fixed bin(15,0) initial dcl 9-17 rtc_condname internal static fixed bin(15,0) initial dcl 9-15 rtc_debugenable internal static fixed bin(15,0) initial dcl 9-28 rtc_debugitems internal static fixed bin(15,0) initial dcl 9-18 rtc_diag internal static fixed bin(15,0) initial dcl 9-9 rtc_equate_tag internal static fixed bin(15,0) initial dcl 9-35 rtc_fdec_temp internal static fixed bin(15,0) initial dcl 9-37 rtc_filedef internal static fixed bin(15,0) initial dcl 9-16 rtc_groupname internal static fixed bin(15,0) initial dcl 9-25 rtc_immed_const internal static fixed bin(15,0) initial dcl 9-38 rtc_indexname internal static fixed bin(15,0) initial dcl 9-14 rtc_internal_tag internal static fixed bin(15,0) initial dcl 9-34 rtc_mnemonic internal static fixed bin(15,0) initial dcl 9-21 rtc_pararef internal static fixed bin(15,0) initial dcl 9-22 rtc_picstring internal static fixed bin(15,0) initial dcl 9-8 rtc_procdef internal static fixed bin(15,0) initial dcl 9-11 rtc_register internal static fixed bin(15,0) initial dcl 9-36 rtc_reportentry internal static fixed bin(15,0) initial dcl 9-26 rtc_reportname internal static fixed bin(15,0) initial dcl 9-24 rtc_resword internal static fixed bin(15,0) initial dcl 9-5 rtc_savedarea internal static fixed bin(15,0) initial dcl 9-19 rtc_sortmerge internal static fixed bin(15,0) initial dcl 9-20 rtc_source internal static fixed bin(15,0) initial dcl 9-10 rtc_unknown1 internal static fixed bin(15,0) initial dcl 9-27 rtc_unknown2 internal static fixed bin(15,0) initial dcl 9-29 rtc_unknown3 internal static fixed bin(15,0) initial dcl 9-30 rtc_unknown4 internal static fixed bin(15,0) initial dcl 9-31 rtc_unknown5 internal static fixed bin(15,0) initial dcl 9-32 rtc_unknown6 internal static fixed bin(15,0) initial dcl 9-33 rtc_userwd internal static fixed bin(15,0) initial dcl 9-12 same_sort_merge_proc defined bit(1) dcl 7-215 scratch_dir defined char(168) dcl 7-207 sect_eop_flag defined fixed bin(17,0) dcl 7-137 seg_init_flag defined fixed bin(17,0) dcl 7-133 seg_init_list_ptr defined pointer dcl 7-41 stack_off defined fixed bin(17,0) dcl 7-121 statement_info_ptr defined pointer dcl 7-77 sym_base_ptr defined pointer dcl 7-17 sym_max defined fixed bin(17,0) dcl 7-105 sym_wd_off defined fixed bin(17,0) dcl 7-103 tag_table_max defined fixed bin(17,0) dcl 7-167 tag_table_ptr defined pointer dcl 7-53 temp_token_area_ptr defined pointer dcl 7-43 temp_token_max defined fixed bin(17,0) dcl 7-169 temp_token_ptr defined pointer dcl 7-45 text_base_ptr defined pointer dcl 7-9 text_wd_off defined fixed bin(17,0) dcl 7-91 token_block1_ptr defined pointer dcl 7-47 token_block2_ptr defined pointer dcl 7-49 value_cnt defined fixed bin(17,0) dcl 7-195 ws_charcnt defined fixed bin(17,0) dcl 7-187 ws_wdoff defined fixed bin(17,0) dcl 7-201 xref_bypass defined bit(1) dcl 7-213 xref_chain_ptr defined pointer dcl 7-75 xref_token_ptr defined pointer dcl 7-73 NAMES DECLARED BY EXPLICIT CONTEXT. cobol_multiply_gen 000012 constant entry external dcl 29 get_size_error_flag 000754 constant entry internal dcl 1-13 ref 336 init_move_data 000707 constant entry internal dcl 515 ref 356 412 not_dec_operand 001717 constant entry internal dcl 1-528 ref 389 428 receiving_field 001102 constant entry internal dcl 1-107 ref 376 474 restore 001255 constant entry internal dcl 1-230 ref 1-162 start 000017 constant label dcl 278 store 001113 constant entry internal dcl 1-170 ref 1-161 test_for_overflow 001333 constant entry internal dcl 1-274 ref 466 test_size_error 001531 constant entry internal dcl 1-388 ref 505 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2304 2470 2012 2314 Length 3112 2012 164 406 272 100 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_multiply_gen 341 external procedure is an external procedure. init_move_data internal procedure shares stack frame of external procedure cobol_multiply_gen. get_size_error_flag internal procedure shares stack frame of external procedure cobol_multiply_gen. receiving_field internal procedure shares stack frame of external procedure cobol_multiply_gen. store internal procedure shares stack frame of external procedure cobol_multiply_gen. restore internal procedure shares stack frame of external procedure cobol_multiply_gen. test_for_overflow internal procedure shares stack frame of external procedure cobol_multiply_gen. test_size_error internal procedure shares stack frame of external procedure cobol_multiply_gen. not_dec_operand internal procedure shares stack frame of external procedure cobol_multiply_gen. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 mpy_code cobol_multiply_gen 000012 move_eos_buffer cobol_multiply_gen 000036 move_in_token_buffer cobol_multiply_gen 000062 move_data_init cobol_multiply_gen 000063 num_lit_zero cobol_multiply_gen 000075 move_eos receiving_field 000107 always_an receiving_field STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_multiply_gen 000100 ose_flag cobol_multiply_gen 000101 receive_count cobol_multiply_gen 000102 fmt1 cobol_multiply_gen 000103 ix cobol_multiply_gen 000104 iy cobol_multiply_gen 000106 move_eos_ptr cobol_multiply_gen 000110 move_in_token_ptr cobol_multiply_gen 000112 multiplicand_ptr cobol_multiply_gen 000114 multiplier_ptr cobol_multiply_gen 000116 resultant_operand_ptr cobol_multiply_gen 000120 saved_ptr cobol_multiply_gen 000122 rdmax_value cobol_multiply_gen 000123 possible_ovfl_flag cobol_multiply_gen 000124 receiving_is_not_stored cobol_multiply_gen 000125 size_error_inst cobol_multiply_gen 000126 size_error_inst_ptr cobol_multiply_gen 000130 size_error_token_ptr cobol_multiply_gen 000132 stored_token_ptr cobol_multiply_gen 000134 no_overflow_tag cobol_multiply_gen 000136 op1_token_ptr cobol_multiply_gen 000140 op2_token_ptr cobol_multiply_gen 000142 temp_resultant_operand_ptr cobol_multiply_gen 000144 binary_ok cobol_multiply_gen 000145 not_bit cobol_multiply_gen 000146 source_code cobol_multiply_gen 000147 target_code cobol_multiply_gen 000150 eos_ptr cobol_multiply_gen 000152 input_ptr cobol_multiply_gen 000154 reloc_ptr cobol_multiply_gen 000174 ret_offset get_size_error_flag 000175 input_buffer get_size_error_flag 000207 reloc_buffer get_size_error_flag 000230 temp_in_token receiving_field 000254 move_eos_ptr receiving_field 000256 tin_ptr receiving_field 000260 temp_save_ptr receiving_field 000262 ret_offset receiving_field 000306 temp_inst_word test_for_overflow 000310 temp_inst_ptr test_for_overflow 000312 reloc_buffer test_for_overflow 000324 reloc_ptr test_for_overflow 000326 save_locno test_for_overflow 000327 overflow_tag test_for_overflow 000336 register_struc test_size_error 000347 temp_inst_word test_size_error 000350 temp_inst_ptr test_size_error 000352 save_locno test_size_error 000353 reloc_buffer test_size_error 000366 reloc_ptr test_size_error THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out return_mac ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cobol_addr cobol_alloc$stack cobol_arith_move_gen cobol_binary_check$multiply cobol_build_resop cobol_define_tag 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_multiply_bin_gen 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 29 000006 278 000017 281 000034 283 000037 284 000051 288 000052 291 000054 294 000063 297 000067 299 000072 300 000074 301 000076 303 000102 306 000105 309 000111 311 000114 314 000116 317 000127 321 000130 322 000131 325 000133 330 000135 331 000141 335 000142 336 000144 340 000146 344 000150 345 000156 347 000161 351 000206 353 000225 354 000230 356 000232 363 000236 365 000243 366 000253 369 000254 376 000302 380 000317 383 000326 388 000330 389 000332 393 000351 394 000353 399 000362 404 000407 409 000426 410 000431 412 000433 415 000437 416 000442 418 000451 419 000460 423 000465 428 000466 430 000473 431 000475 432 000477 437 000510 441 000532 446 000533 448 000540 451 000550 452 000557 457 000564 462 000566 463 000571 466 000572 474 000574 478 000617 481 000626 483 000633 485 000634 492 000645 494 000646 496 000650 502 000652 504 000663 505 000665 512 000706 515 000707 524 000710 525 000714 527 000716 528 000721 529 000723 530 000725 531 000732 533 000734 534 000736 536 000737 537 000742 538 000744 539 000746 541 000750 543 000753 1 13 000754 1 69 000756 1 72 000774 1 73 000777 1 76 001014 1 77 001016 1 79 001020 1 80 001022 1 81 001024 1 82 001025 1 83 001027 1 85 001031 1 88 001037 1 91 001052 1 94 001060 1 97 001075 1 99 001101 1 107 001102 1 161 001104 1 162 001111 1 267 001112 1 170 001113 1 178 001114 1 179 001122 1 180 001124 1 181 001126 1 182 001127 1 184 001132 1 185 001134 1 188 001145 1 191 001164 1 192 001167 1 193 001171 1 194 001173 1 195 001175 1 199 001176 1 200 001200 1 201 001203 1 203 001206 1 204 001210 1 205 001213 1 206 001217 1 207 001223 1 210 001225 1 211 001233 1 215 001235 1 218 001243 1 219 001250 1 220 001252 1 222 001254 1 230 001255 1 237 001256 1 238 001260 1 240 001263 1 241 001265 1 242 001267 1 243 001274 1 244 001300 1 247 001302 1 252 001304 1 253 001311 1 254 001313 1 259 001315 1 262 001323 1 263 001330 1 265 001332 1 274 001333 1 328 001335 1 329 001336 1 332 001340 1 335 001344 1 337 001347 1 340 001350 1 341 001352 1 342 001353 1 345 001354 1 348 001370 1 351 001410 1 357 001430 1 358 001431 1 360 001435 1 363 001440 1 366 001454 1 370 001472 1 371 001501 1 374 001507 1 377 001524 1 380 001530 1 388 001531 1 473 001533 1 474 001535 1 475 001536 1 478 001537 1 481 001544 1 484 001550 1 485 001551 1 486 001552 1 487 001554 1 489 001557 1 493 001570 1 495 001602 1 500 001610 1 505 001625 1 506 001626 1 507 001630 1 510 001650 1 511 001655 1 514 001661 1 517 001664 1 520 001700 1 523 001716 1 528 001717 1 539 001721 1 546 001753 ----------------------------------------------------------- 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