COMPILATION LISTING OF SEGMENT cobol_add_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 0941.0 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_add_gen.pl1 Added Trace statements. 19* END HISTORY COMMENTS */ 20 21 22 /* Modified on 10/19/84 by FCH, [4.3-1], BUG563, new cobol_addr_tokens.incl.pl1 23*/* Modified on 08/31/83 by FCH, [5.2...], trace added */ 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_add_gen: 30 proc (in_token_ptr, next_stmt_tag); 31 /***..... if Trace_Bit then call cobol_gen_driver_$Tr_Beg(MY_NAME);/**/ 32 /* 33*The ADD statement generator: cobol_add_gen 34* 35*FUNCTION 36* 37*The function of this procedure is to generate code for the 38*Cobol ADD 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 /* DECLARATION OF EXTERNAL ENTRIES */ 49 50 dcl cobol_num_to_udts ext entry (ptr, ptr); 51 dcl cobol_fofl_mask$on ext entry; 52 dcl cobol_fofl_mask$off ext entry; 53 dcl cobol_build_resop ext entry (ptr, ptr, fixed bin, ptr, bit (1), fixed bin, bit (1)); 54 dcl cobol_add3 ext entry (ptr, ptr, ptr, fixed bin); 55 dcl cobol_add ext entry (ptr, ptr, fixed bin); 56 dcl cobol_define_tag ext entry (fixed bin); 57 dcl cobol_alloc$stack ext entry (fixed bin, fixed bin, fixed bin); 58 dcl cobol_addr ext entry (ptr, ptr, ptr); 59 dcl cobol_emit ext entry (ptr, ptr, fixed bin); 60 dcl cobol_arith_move_gen 61 ext entry (ptr); 62 dcl cobol_move_gen ext entry (ptr); 63 dcl cobol_make_type9$copy 64 ext entry (ptr, ptr); 65 dcl cobol_make_tagref ext entry (fixed bin, fixed bin, ptr); 66 dcl cobol_register$load ext entry (ptr); 67 dcl cobol_make_type9$fixed_bin_35 68 ext entry (ptr, fixed bin, fixed bin); 69 dcl cobol_make_type9$type2_3 70 ext entry (ptr, ptr); 71 dcl cobol_binary_check$add 72 ext entry (ptr, bit (1), fixed bin, fixed bin); 73 dcl cobol_add_binary_gen 74 ext entry (ptr, fixed bin, fixed bin, fixed bin, fixed bin); 75 76 77 78 /* DECLARATIONS OF BUILTIN FUNCTIONS */ 79 80 dcl addr builtin; 81 dcl fixed builtin; 82 dcl null builtin; 83 84 /* DECLARATION OF INTERNAL STATIC VARIABLES */ 85 86 dcl first_meaningful_ptr_index 87 fixed bin int static init (2); 88 89 dcl add_code fixed bin int static init (182); 90 91 /* Definition of an EOS token to be used in calls to the move generator */ 92 93 dcl 1 move_eos int static, 94 2 size fixed bin (15) init (38), 95 2 line fixed bin (15) init (0), 96 2 column fixed bin (15) init (0), 97 2 txpe fixed bin (15) init (19), /* EOS */ 98 2 verb fixed bin (15) init (18), /* MOVE */ 99 2 e fixed bin (15) init (0), 100 2 h fixed bin (15) init (0), 101 2 i fixed bin (15) init (0), 102 2 j fixed bin (15) init (0), 103 2 a bit (16) init ("0"b); 104 105 /* Definition of a numeric literal zero */ 106 107 dcl 1 num_lit_zero int static, 108 2 size fixed bin (15) init (37), 109 2 line fixed bin (15) init (0), 110 2 column fixed bin (15) init (0), 111 2 type fixed bin (15) init (2), 112 2 integral bit (1) init ("1"b), 113 2 floating bit (1) init ("0"b), 114 2 filler1 bit (5) init ("0"b), 115 2 subscript bit (1) init ("0"b), 116 2 sign char (1) init (" "), 117 2 exp_sign char (1) init (" "), 118 2 exp_places fixed bin (15) init (0), 119 2 places_left fixed bin (15) init (1), 120 2 places_right fixed bin (15) init (0), 121 2 places fixed bin (15) init (1), 122 2 lit_val char (1) init ("0"); 123 124 125 /* Declarations of initialized variables that define verb type codes in EOS token */ 126 127 dcl add_vt fixed bin (15) int static init (2); 128 dcl subtract_vt fixed bin (15) int static init (11); 129 130 131 132 /* DECLARATION OF INTERNAL AUTOMATIC VARIABLES */ 133 134 dcl ose_flag bit (1); 135 dcl addend_count fixed bin; 136 dcl receive_count fixed bin; 137 138 dcl fmt1 bit (1); 139 140 dcl lop_ptr ptr; 141 dcl rop_ptr ptr; 142 dcl resultant_operand_ptr 143 ptr; 144 dcl minuend_token_ptr ptr; 145 dcl subtrahend_token_ptr 146 ptr; 147 148 149 dcl ix fixed bin; 150 dcl iy fixed bin; 151 dcl move_eos_ptr ptr; 152 dcl mv_ptr ptr; 153 154 dcl rdmax_value fixed bin; 155 dcl overflow_code_generated 156 bit (1); 157 dcl possible_ovfl_flag bit (1); 158 dcl receiving_is_not_stored 159 bit (1); 160 dcl overflow_possible bit (1); 161 dcl size_error_flag_defined 162 bit (1); 163 164 dcl temp_in_token (1:10) ptr; 165 dcl size_error_inst bit (36); 166 dcl size_error_inst_ptr ptr; 167 dcl size_error_token_ptr 168 ptr; 169 dcl stored_token_ptr ptr; 170 dcl no_overflow_tag fixed bin; 171 dcl add_gen_code fixed bin; 172 dcl verb_type fixed bin; 173 dcl temp_ptr ptr; 174 dcl op1_token_ptr ptr; 175 dcl op2_token_ptr ptr; 176 dcl temp_resultant_operand_ptr 177 ptr; 178 dcl (binary_ok, not_bit) 179 bit (1); 180 dcl source_code fixed bin; 181 dcl target_code fixed bin; 182 183 dcl dn_ptr ptr; 184 185 186 /***..... dcl cobol_gen_driver_$Tr_Beg entry(char(*));/**/ 187 /***..... dcl cobol_gen_driver_$Tr_End entry(char(*));/**/ 188 189 /***..... dcl Trace_Bit bit(1) static external;/**/ 190 /***..... dcl Trace_Lev fixed bin static external;/**/ 191 /***..... dcl Trace_Line char(36) static external;/**/ 192 /***..... dcl ioa_ entry options(variable); /**/ 193 /***..... dcl MY_NAME char (13) int static init ("COBOL_ADD_GEN"); /**/ 194 195 196 /**************************************************/ 197 /* START OF EXECUTION */ 198 /* cobol_add_gen */ 199 /**************************************************/ 200 201 /* Get meaningful data from the EOS token. */ 202 eos_ptr = in_token.token_ptr (in_token.n); /* Check to see if binary arithemtic and be done for this add/subtract statement */ 203 call cobol_binary_check$add (in_token_ptr, binary_ok, target_code, source_code); 204 205 if binary_ok 206 then do; /* Binary arithmetic can be done. */ 207 if end_stmt.verb = add_vt 208 then add_gen_code = 1; 209 else add_gen_code = 2; 210 call cobol_add_binary_gen (in_token_ptr, next_stmt_tag, target_code, source_code, add_gen_code); 211 return; 212 end; /* Binary arithmetic can be done. */ 213 214 215 /* ON SIZE ERROR flag */ 216 ose_flag = end_stmt.b; 217 218 /* Number of operands to be added */ 219 addend_count = end_stmt.e; 220 221 /* Number of receiving operands */ 222 receive_count = end_stmt.h; 223 224 /* Verb type */ 225 verb_type = end_stmt.verb; 226 227 /* Determine the ADD or SUBTRACT statement format */ 228 if end_stmt.a = "000"b 229 then fmt1 = "1"b; /* Format 1 ADD */ 230 else fmt1 = "0"b; /* Format 2 ADD */ 231 232 233 if ose_flag 234 then do; /* Reserve a tag to be associated with the next Cobol statement */ 235 next_stmt_tag = cobol_$next_tag; 236 cobol_$next_tag = cobol_$next_tag + 1; 237 238 end; /* Reserve a tag to be associated with the next Cobol statement */ 239 240 resultant_operand_ptr = in_token.token_ptr (first_meaningful_ptr_index); 241 242 iy = first_meaningful_ptr_index; 243 244 if addend_count > 1 245 then do; /* Generate code to add all of the operands together. */ 246 247 248 do ix = 1 to addend_count - 1; /* Generate the add code. */ 249 iy = iy + 1; /* subscript of next addend pointer */ 250 lop_ptr = resultant_operand_ptr; 251 rop_ptr = in_token.token_ptr (iy); 252 253 /* Build resultant operand to hold the result of the addition */ 254 call cobol_build_resop (lop_ptr, rop_ptr, add_code, resultant_operand_ptr, "0"b, rdmax_value, 255 possible_ovfl_flag); 256 257 /* Generate code to add the two operands */ 258 call cobol_add3 (lop_ptr, rop_ptr, resultant_operand_ptr, 1 /*ADD*/); 259 260 end; /* Generate the add code. */ 261 262 end; /* Generate code to add all of the operands togenter. */ 263 264 if resultant_operand_ptr -> data_name.type ^= rtc_dataname 265 then do; /* A literal or fig constant ZERO is to be added in fmt 1 add */ 266 267 if resultant_operand_ptr -> data_name.type = rtc_resword 268 then temp_ptr = addr (num_lit_zero); /* Figurative constant ZERO 269* is to be added. */ 270 else temp_ptr = resultant_operand_ptr; /* A numeric literal is to be added. */ 271 272 /* Pool the literal and make a type 9 token */ 273 resultant_operand_ptr = null (); /* utility provides buffer for 274* data name token */ 275 call cobol_make_type9$type2_3 (resultant_operand_ptr, temp_ptr); 276 end; /* A literal or fig constant ZERO is to be added in fmt 1 add */ 277 278 /* 279* At this point in processing, the following coonditions exist: 280* 1. Code has been generated to add together all operands to 281* the left of "TO" (for format 1 ADD) or to he left of 282* "GIVING" ( for format 2 ADD). 283* 2. The data name token that describes the sum of these 284* operands is pointed at by the pointer resultant_operand_ptr. 285* 3. The variable "iy" contains the subscript of the in_token array element 286* that points to the last addend. ( i.e., iy + 1 is the subscript of the 287* pointer to the first receiving token.) 288* 289* */ 290 291 292 293 /* Now check to see if code is being generated for a format 2 subtract. */ 294 295 if (verb_type = subtract_vt & ^fmt1) 296 then do; /* Format 2 SUBTRACT, must generate code to subtract the sum calculated so far, 297* from the minuend. */ 298 299 /* Increment iy to become the subscript of the pointer to the minuend token. */ 300 iy = iy + 1; 301 302 subtrahend_token_ptr = resultant_operand_ptr; 303 minuend_token_ptr = in_token.token_ptr (iy); 304 call cobol_build_resop (minuend_token_ptr, subtrahend_token_ptr, add_code, resultant_operand_ptr, 305 "0"b, rdmax_value, possible_ovfl_flag); 306 307 /* At this point in processing: 308* 309* 1. minuend_token_ptr points to a token for the minuend. 310* 2. subtrahend_token_ptr points to a token for the result of adding all operands 311* to the left of "TO". 312* 3. resultant_operand_ptr points to a token to receive the difference of the 313* subtraction. 314* */ 315 316 call cobol_add3 (subtrahend_token_ptr, minuend_token_ptr, resultant_operand_ptr, 2 /*SUBTRACT*/); 317 318 319 end; /* Format 2 SUBTRACT, must generate code to stubract the sum calculated so far, 320* from the minuend. */ 321 322 /* Now we will get the result into the receiving operands. */ 323 324 overflow_code_generated = "0"b; 325 size_error_flag_defined = "0"b; 326 327 do ix = 1 to receive_count; /* Generate code to get the sum into receiving operands. */ 328 mv_ptr = null (); 329 overflow_possible = "0"b; 330 receiving_is_not_stored = "0"b; 331 iy = iy + 1; /* Get subscript of pointer to "next" receiving operand token. */ 332 if ose_flag 333 then do; /* ON SIZE CHECKING required, */ 334 if fmt1 335 then overflow_possible = "1"b; /* Overflow always possible for format 1 336* add or subtract. */ 337 338 else if (resultant_operand_ptr -> data_name.places_left 339 > in_token.token_ptr (iy) -> data_name.places_left) 340 then overflow_possible = "1"b; /* Format 2, result left digits > 341* receiving left digits. */ 342 else if resultant_operand_ptr -> data_name.sign_type = "111"b 343 then overflow_possible = "1"b; /* Resultant operand is floating decimal. */ 344 end; /* ON SIZE checking required */ 345 346 if overflow_possible 347 then do; /* Store the receiving field into a temporary */ 348 overflow_code_generated = "1"b; 349 if ^size_error_flag_defined 350 then do; /* Define the size error fixed bin flag in the run-time stack. */ 351 352 size_error_inst_ptr = addr (size_error_inst); 353 call get_size_error_flag (size_error_token_ptr, size_error_inst_ptr); 354 size_error_flag_defined = "1"b; 355 end; /* Define the size error fixed bin flag in the run-time stack. */ 356 357 358 /* Store the receiving field into a temporary. */ 359 /* Note that if the receiving field is numeric edited, or overpunch sign, then 360* it is not stored into a temporary. */ 361 362 363 if in_token.token_ptr (iy) -> data_name.numeric_edited /* Receiving is numeric edited. */ 364 | (in_token.token_ptr (iy) -> data_name.display 365 & in_token.token_ptr (iy) -> data_name.item_signed 366 & in_token.token_ptr (iy) -> data_name.sign_separate = "0"b) 367 /* overpunch sign */ 368 then receiving_is_not_stored = "1"b; 369 else call receiving_field (in_token.token_ptr (iy), stored_token_ptr, 1); 370 371 /* Reserve a tag to which to transfer if no overflow occurs. */ 372 no_overflow_tag = cobol_$next_tag; 373 cobol_$next_tag = cobol_$next_tag + 1; 374 375 /* Generate code to turn the overflow mask indicator bit ON */ 376 call cobol_fofl_mask$on; 377 378 end; /* Store the receiving field into a temporary */ 379 380 381 if fmt1 382 then do; /* Add sum to or SUBTRACT sum from the receiving field. The 383* result goes into the receiving field. */ 384 385 if verb_type = add_vt 386 then add_gen_code = 1; /* ADD */ 387 else add_gen_code = 2; /* SUBTRACT */ 388 389 390 391 392 if not_dec_operand (in_token.token_ptr (iy)) 393 then do; /* The receiving operand is not decimal. Must convert to decimal 394* before performing the add or subtract. */ 395 396 op1_token_ptr = resultant_operand_ptr; 397 op2_token_ptr = in_token.token_ptr (iy); 398 399 /* Convert the non-decimal operand(s) , and build a temporary 400* into which to store the result of the computation. */ 401 402 call cobol_build_resop (op1_token_ptr, op2_token_ptr, add_code, 403 temp_resultant_operand_ptr, "0"b, rdmax_value, possible_ovfl_flag); 404 405 /* Generate code to add (or subtract) the two operands, and 406* store the result into a temporary. */ 407 call cobol_add3 (op1_token_ptr, op2_token_ptr, temp_resultant_operand_ptr, 408 add_gen_code); 409 410 /* Generate code to move the result of the add/subtract to 411* the receiving field. */ 412 413 move_eos_ptr = addr (move_eos); 414 move_eos_ptr -> end_stmt.e = 1; 415 mv_ptr = addr (temp_in_token (1)); 416 mv_ptr -> in_token.n = 4; 417 mv_ptr -> in_token.token_ptr (1) = null (); 418 mv_ptr -> in_token.token_ptr (2) = temp_resultant_operand_ptr; 419 mv_ptr -> in_token.token_ptr (3) = in_token.token_ptr (iy); 420 mv_ptr -> in_token.token_ptr (4) = move_eos_ptr; 421 422 call cobol_arith_move_gen (mv_ptr); 423 if mv_ptr -> in_token.code ^= 0 424 then receiving_is_not_stored = "1"b; 425 426 end; /* The receiving operand is not decimal. Must convert 427* to decimal before performing the add or subtract. */ 428 429 else do; /* Receiving operand is decimal. */ 430 431 if not_dec_operand (resultant_operand_ptr) 432 then do; /* Left operand is not decimal--convert to decimal. */ 433 op1_token_ptr = resultant_operand_ptr; 434 resultant_operand_ptr = null (); 435 call cobol_num_to_udts (op1_token_ptr, resultant_operand_ptr); 436 437 438 end; /* Left operand is not decimal--convert to decimal. */ 439 440 call cobol_add (resultant_operand_ptr, in_token.token_ptr (iy), add_gen_code); 441 442 end; /* Receiving operand is decimal. */ 443 444 445 end; /* Add sum or SUBTRACT sum from the receiving field. The 446* result goes into the receiving field. */ 447 448 else do; /* Generate code to MOVE the sum to the receiving field */ 449 /* Set up an in_token structure for a move. */ 450 451 move_eos_ptr = addr (move_eos); 452 move_eos_ptr -> end_stmt.e = 1; /* Number of receiving operands. */ 453 454 mv_ptr = addr (temp_in_token (1)); 455 mv_ptr -> in_token.n = 4; 456 mv_ptr -> in_token.token_ptr (1) = null (); 457 mv_ptr -> in_token.token_ptr (first_meaningful_ptr_index) = resultant_operand_ptr; 458 mv_ptr -> in_token.token_ptr (3) = in_token.token_ptr (iy); 459 /* Receiving field */ 460 mv_ptr -> in_token.token_ptr (4) = move_eos_ptr; 461 462 /* Generate the move code */ 463 if (ose_flag & overflow_possible = "0"b) 464 then call cobol_move_gen (mv_ptr); /* OSE present, but result will fit 465* into the receiving filed with no possibility of overflow. */ 466 else call cobol_arith_move_gen (mv_ptr); 467 468 if mv_ptr -> in_token.code ^= 0 469 then receiving_is_not_stored = "1"b; 470 end; /* Generate code to MOVE the sum to the receiving field. */ 471 472 473 if overflow_possible 474 then do; /* Generate code to test for overflow, and restore 475* the original value to the receiving field if overflow occurred. */ 476 477 call test_for_overflow (no_overflow_tag, size_error_inst_ptr, mv_ptr); 478 479 /* If the receiving field has been stored into a temporary, then resotre it. */ 480 if ^receiving_is_not_stored 481 then call receiving_field (in_token.token_ptr (iy), stored_token_ptr, 2); 482 483 /* DEfine the no overflow tag at the instruction following the restore value code. */ 484 call cobol_define_tag (no_overflow_tag); 485 486 /* Generate code to turn the overflow mask indicator bit OFF */ 487 call cobol_fofl_mask$off; 488 489 end; /* Generate code to tst for overflow, and restore 490* the original value to the receiving filed if overflow occurred. */ 491 else if receiving_is_not_stored /* Receiving field is numeric edited, and the 492* result has been stored into a temporary to see if overflow will occur. Now 493* we must move the temporary into the numeric edited field. */ 494 then call cobol_move_gen (mv_ptr); 495 496 end; /* Generate code to get the sum into receiving operands. */ 497 498 /* At this point in processing, code has been generated to 499* 1. get the result into the receiving operands. 500* 2. test for possible overflow. 501* */ 502 503 if ose_flag 504 then do; /* Generate code to test the size error flag, and transfer over the imperative stmt 505* if no size error occurred. */ 506 507 508 /*[4.0-1]*/ 509 if end_stmt.f = "01"b 510 then not_bit = "1"b; 511 else not_bit = "0"b; 512 call test_size_error (size_error_token_ptr, size_error_inst_ptr, next_stmt_tag, 513 overflow_code_generated, not_bit); 514 end; /* Generate code to test the size error flag, and transfer over the imperative stmt 515* if no size error occurred. */ 516 517 /***..... if Trace_Bit then call cobol_gen_driver_$Tr_End(MY_NAME);/**/ 518 return; 519 520 521 522 /**************************************************/ 523 /* END OF EXECUTABLE STATEMENTS */ 524 /* cobol_add_gen */ 525 /**************************************************/ 526 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 527 528 529 /* INCLUDE FILES USED BY THIS PROCEDURE */ 530 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 531 532 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 533 534 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 535 536 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 537 538 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 539 540 541 542 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 543 544 545 /**************************************************/ 546 /* END OF EXTERNAL PROCEDURE */ 547 /* cobol_add_gen */ 548 /**************************************************/ 549 550 end cobol_add_gen; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0830.4 cobol_add_gen.pl1 >spec>install>MR12.3-1048>cobol_add_gen.pl1 527 1 03/27/82 0437.8 cobol_arith_util.incl.pl1 >ldd>include>cobol_arith_util.incl.pl1 531 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 533 4 11/11/82 1712.7 cobol_in_token.incl.pl1 >ldd>include>cobol_in_token.incl.pl1 535 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 537 7 11/11/82 1712.7 cobol_.incl.pl1 >ldd>include>cobol_.incl.pl1 539 8 05/24/89 0811.7 cobol_addr_tokens.incl.pl1 >spec>install>MR12.3-1048>cobol_addr_tokens.incl.pl1 543 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 228 add_code 000010 internal static fixed bin(17,0) initial dcl 89 set ref 254* 304* 402* add_gen_code 000167 automatic fixed bin(17,0) dcl 171 set ref 207* 209* 210* 385* 387* 407* 440* add_vt constant fixed bin(15,0) initial dcl 127 ref 207 385 addend_count 000101 automatic fixed bin(17,0) dcl 135 set ref 219* 244 248 addr builtin function dcl 80 ref 267 352 413 415 451 454 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 000047 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 216 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 000202 automatic bit(1) packed unaligned dcl 178 set ref 203* 205 char_offset 4 based fixed bin(24,0) level 2 dcl 8-23 set ref 1-83* cobol_$next_tag 000120 external static fixed bin(17,0) dcl 7-128 set ref 235 236* 236 372 373* 373 1-335 1-337* 1-337 cobol_$text_wd_off 000116 external static fixed bin(17,0) dcl 7-90 ref 1-348 1-360 1-514 cobol_add 000062 constant entry external dcl 55 ref 440 cobol_add3 000060 constant entry external dcl 54 ref 258 316 407 cobol_add_binary_gen 000114 constant entry external dcl 73 ref 210 cobol_addr 000070 constant entry external dcl 58 ref 1-88 cobol_alloc$stack 000066 constant entry external dcl 57 ref 1-69 1-188 cobol_arith_move_gen 000074 constant entry external dcl 60 ref 422 466 cobol_binary_check$add 000112 constant entry external dcl 71 ref 203 cobol_build_resop 000056 constant entry external dcl 53 ref 254 304 402 cobol_define_tag 000064 constant entry external dcl 56 ref 484 1-370 cobol_emit 000072 constant entry external dcl 59 ref 1-94 1-345 1-363 1-374 1-500 1-517 cobol_fofl_mask$off 000054 constant entry external dcl 52 ref 487 cobol_fofl_mask$on 000052 constant entry external dcl 51 ref 376 cobol_make_tagref 000102 constant entry external dcl 65 ref 1-348 1-366 1-520 cobol_make_type9$copy 000100 constant entry external dcl 63 ref 1-185 cobol_make_type9$fixed_bin_35 000106 constant entry external dcl 67 ref 1-73 cobol_make_type9$type2_3 000110 constant entry external dcl 69 ref 275 cobol_move_gen 000076 constant entry external dcl 62 ref 463 491 1-215 1-259 1-351 cobol_num_to_udts 000050 constant entry external dcl 50 ref 435 cobol_register$load 000104 constant entry external dcl 66 ref 1-489 code 1 based fixed bin(17,0) level 2 dcl 4-9 ref 423 468 1-351 contains 4 000366 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 363 1-539 dname_ptr 6 000366 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 219 414* 452* 1-210* 1-211* 1-247* end_stmt based structure level 1 unaligned dcl 5-16 eos_ptr 000206 automatic pointer dcl 5-13 set ref 202* 207 216 219 222 225 228 509 f 11(07) based bit(2) level 2 packed packed unaligned dcl 5-16 ref 509 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_meaningful_ptr_index constant fixed bin(17,0) initial dcl 86 ref 240 242 457 fixed builtin function dcl 81 ref 1-188 1-188 fmt1 000103 automatic bit(1) packed unaligned dcl 138 set ref 228* 230* 295 334 381 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 222 in_token based structure level 1 dcl 4-9 in_token_ptr parameter pointer dcl 4-7 set ref 29 202 202 203* 210* 240 251 303 338 363 363 363 363 369 392 397 419 440 458 480 input_buffer 000225 automatic fixed bin(17,0) array dcl 1-58 set ref 1-76 input_ptr 000210 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 363 1-539 ix 000116 automatic fixed bin(17,0) dcl 149 set ref 248* 327* iy 000117 automatic fixed bin(17,0) dcl 150 set ref 242* 249* 249 251 300* 300 303 331* 331 338 363 363 363 363 369 392 397 419 440 458 480 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_add_gen" set ref 1-81* lock 2 000366 automatic fixed bin(17,0) level 2 in structure "register_struc" dcl 1-451 in procedure "test_size_error" set ref 1-485* lop_ptr 000104 automatic pointer dcl 140 set ref 250* 254* 258* minuend_token_ptr 000112 automatic pointer dcl 144 set ref 303* 304* 316* move_eos 000035 internal static structure level 1 unaligned dcl 1-140 in procedure "receiving_field" set ref 1-200 1-238 move_eos 000011 internal static structure level 1 unaligned dcl 93 in procedure "cobol_add_gen" set ref 413 451 move_eos_ptr 000120 automatic pointer dcl 151 in procedure "cobol_add_gen" set ref 413* 414 420 451* 452 460 move_eos_ptr 000304 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_ptr parameter pointer dcl 1-290 set ref 1-274 1-351 1-351 1-351* mv_ptr 000122 automatic pointer dcl 152 set ref 328* 415* 416 417 418 419 420 422* 423 454* 455 456 457 458 460 463* 466* 468 477* 491* n based fixed bin(17,0) level 2 dcl 4-9 set ref 202 416* 455* 1-203* 1-240* next_stmt_tag parameter fixed bin(17,0) dcl 46 in procedure "cobol_add_gen" set ref 29 210* 235* 512* next_stmt_tag parameter fixed bin(17,0) dcl 1-413 in procedure "test_size_error" set ref 1-388 1-520* no_overflow_tag 000166 automatic fixed bin(17,0) dcl 170 in procedure "cobol_add_gen" set ref 372* 477* 484* no_overflow_tag parameter fixed bin(17,0) dcl 1-288 in procedure "test_for_overflow" set ref 1-274 1-366* not_bit parameter bit(1) packed unaligned dcl 1-414 in procedure "test_size_error" ref 1-388 1-507 not_bit 000203 automatic bit(1) packed unaligned dcl 178 in procedure "cobol_add_gen" set ref 509* 511* 512* null builtin function dcl 82 ref 273 328 417 434 456 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 000023 internal static structure level 1 unaligned dcl 107 set ref 267 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 363 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 000174 automatic pointer dcl 174 set ref 396* 402* 407* 433* 435* op2_token_ptr 000176 automatic pointer dcl 175 set ref 397* 402* 407* 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 134 set ref 216* 233 332 463 503 overflow_code_generated parameter bit(1) packed unaligned dcl 1-414 in procedure "test_size_error" ref 1-388 1-478 1-507 overflow_code_generated 000125 automatic bit(1) packed unaligned dcl 155 in procedure "cobol_add_gen" set ref 324* 348* 512* overflow_possible 000130 automatic bit(1) packed unaligned dcl 160 set ref 329* 334* 338* 342* 346 463 473 overflow_tag 000357 automatic fixed bin(17,0) dcl 1-320 set ref 1-335* 1-348* 1-370* places_left 17 based fixed bin(17,0) level 2 dcl 2-16 ref 338 338 possible_ovfl_flag 000126 automatic bit(1) packed unaligned dcl 157 set ref 254* 304* 402* rdmax_value 000124 automatic fixed bin(17,0) dcl 154 set ref 254* 304* 402* receive_count 000102 automatic fixed bin(17,0) dcl 136 set ref 222* 327 receiving_is_not_stored 000127 automatic bit(1) packed unaligned dcl 158 set ref 330* 363* 423* 468* 480 491 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 000366 automatic bit(4) level 2 packed packed unaligned dcl 1-451 set ref 1-493 register_struc 000366 automatic structure level 1 unaligned dcl 1-451 set ref 1-489 1-489 reloc_buffer 000403 automatic bit(5) array dcl 1-464 in procedure "test_size_error" set ref 1-473 1-474* 1-475* reloc_buffer 000237 automatic bit(5) array dcl 1-59 in procedure "get_size_error_flag" set ref 1-77 reloc_buffer 000342 automatic bit(5) array dcl 1-316 in procedure "test_for_overflow" set ref 1-340 1-341* 1-342* reloc_ptr 000416 automatic pointer dcl 1-465 in procedure "test_size_error" set ref 1-473* 1-500* 1-517* reloc_ptr 000354 automatic pointer dcl 1-317 in procedure "test_for_overflow" set ref 1-340* 1-345* 1-363* 1-374* reloc_ptr 000212 automatic pointer dcl 8-18 in procedure "cobol_add_gen" set ref 1-77* 1-88* 1-94* resultant_operand_ptr 000110 automatic pointer dcl 142 set ref 240* 250 254* 258* 264 267 270 273* 275* 302 304* 316* 338 342 396 431* 433 434* 435* 440* 457 ret_offset 000224 automatic fixed bin(17,0) dcl 1-56 in procedure "get_size_error_flag" set ref 1-69* 1-73* 1-83 ret_offset 000312 automatic fixed bin(17,0) dcl 1-159 in procedure "receiving_field" set ref 1-188* 1-192 rop_ptr 000106 automatic pointer dcl 141 set ref 251* 254* 258* rtc_dataname constant fixed bin(15,0) initial dcl 9-13 ref 264 rtc_resword constant fixed bin(15,0) initial dcl 9-5 ref 267 save_locno 000356 automatic fixed bin(17,0) dcl 1-319 in procedure "test_for_overflow" set ref 1-360* 1-366* save_locno 000402 automatic fixed bin(17,0) dcl 1-463 in procedure "test_size_error" set ref 1-514* 1-520* seg_num 23 based fixed bin(17,0) level 2 dcl 2-16 set ref 1-191* segno 3 based fixed bin(17,0) level 2 dcl 8-23 set ref 1-82* sign_separate 21(26) based bit(1) level 2 packed packed unaligned dcl 2-16 ref 363 1-539 sign_type 22(13) based bit(3) level 2 packed packed unaligned dcl 2-16 ref 342 1-539 1-539 size_error_flag_defined 000131 automatic bit(1) packed unaligned dcl 161 set ref 325* 349 354* size_error_inst 000156 automatic bit(36) packed unaligned dcl 165 in procedure "cobol_add_gen" set ref 352 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 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 000160 automatic pointer dcl 166 in procedure "cobol_add_gen" set ref 352* 353* 477* 512* 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 000162 automatic pointer dcl 167 in procedure "cobol_add_gen" set ref 353* 512* 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* source_code 000204 automatic fixed bin(17,0) dcl 180 set ref 203* 210* 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 000164 automatic pointer dcl 169 in procedure "cobol_add_gen" set ref 369* 480* 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* subtract_vt constant fixed bin(15,0) initial dcl 128 ref 295 subtrahend_token_ptr 000114 automatic pointer dcl 145 set ref 302* 304* 316* target_code 000205 automatic fixed bin(17,0) dcl 181 set ref 203* 210* temp_in_token 000260 automatic pointer array dcl 1-155 in procedure "receiving_field" set ref 1-199 1-237 temp_in_token 000132 automatic pointer array dcl 164 in procedure "cobol_add_gen" set ref 415 454 temp_inst_ptr 000340 automatic pointer dcl 1-314 in procedure "test_for_overflow" set ref 1-329* 1-332 1-345* 1-358 1-363* temp_inst_ptr 000400 automatic pointer dcl 1-461 in procedure "test_size_error" set ref 1-506* 1-507 1-510 1-511 1-517* temp_inst_word 000377 automatic bit(36) packed unaligned dcl 1-460 in procedure "test_size_error" set ref 1-505* 1-506 temp_inst_word 000336 automatic bit(36) packed unaligned dcl 1-313 in procedure "test_for_overflow" set ref 1-328* 1-329 1-357* temp_ptr 000172 automatic pointer dcl 173 set ref 267* 270* 275* temp_resultant_operand_ptr 000200 automatic pointer dcl 176 set ref 402* 407* 418 temp_save_ptr 000310 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 000306 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_add_gen" set ref 202 240 251 303 338 363 363 363 363 369* 392* 397 417* 418* 419* 419 420* 440* 456* 457* 458* 458 460* 480* 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-308 in procedure "test_for_overflow" ref 1-358 tra_op constant bit(10) initial packed unaligned dcl 1-444 in procedure "test_size_error" ref 1-511 type 3 based fixed bin(17,0) level 2 in structure "data_name" dcl 2-16 in procedure "cobol_add_gen" ref 264 267 type based fixed bin(17,0) level 2 in structure "input_struc_basic" dcl 8-23 in procedure "cobol_add_gen" set ref 1-79* 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 ref 207 225 verb_type 000170 automatic fixed bin(17,0) dcl 172 set ref 225* 295 385 what_reg 000366 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_$compile_count external static fixed bin(17,0) dcl 7-142 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 183 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 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_eos internal static fixed bin(15,0) initial dcl 9-23 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_numlit internal static fixed bin(15,0) initial dcl 9-6 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_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_add_gen 000012 constant entry external dcl 29 get_size_error_flag 001104 constant entry internal dcl 1-13 ref 353 not_dec_operand 002047 constant entry internal dcl 1-528 ref 392 431 receiving_field 001232 constant entry internal dcl 1-107 ref 369 480 restore 001405 constant entry internal dcl 1-230 ref 1-162 store 001243 constant entry internal dcl 1-170 ref 1-161 test_for_overflow 001463 constant entry internal dcl 1-274 ref 477 test_size_error 001661 constant entry internal dcl 1-388 ref 512 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2422 2544 2142 2432 Length 3164 2142 122 403 260 40 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_add_gen 377 external procedure is an external procedure. get_size_error_flag internal procedure shares stack frame of external procedure cobol_add_gen. receiving_field internal procedure shares stack frame of external procedure cobol_add_gen. store internal procedure shares stack frame of external procedure cobol_add_gen. restore internal procedure shares stack frame of external procedure cobol_add_gen. test_for_overflow internal procedure shares stack frame of external procedure cobol_add_gen. test_size_error internal procedure shares stack frame of external procedure cobol_add_gen. not_dec_operand internal procedure shares stack frame of external procedure cobol_add_gen. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 add_code cobol_add_gen 000011 move_eos cobol_add_gen 000023 num_lit_zero cobol_add_gen 000035 move_eos receiving_field 000047 always_an receiving_field STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_add_gen 000100 ose_flag cobol_add_gen 000101 addend_count cobol_add_gen 000102 receive_count cobol_add_gen 000103 fmt1 cobol_add_gen 000104 lop_ptr cobol_add_gen 000106 rop_ptr cobol_add_gen 000110 resultant_operand_ptr cobol_add_gen 000112 minuend_token_ptr cobol_add_gen 000114 subtrahend_token_ptr cobol_add_gen 000116 ix cobol_add_gen 000117 iy cobol_add_gen 000120 move_eos_ptr cobol_add_gen 000122 mv_ptr cobol_add_gen 000124 rdmax_value cobol_add_gen 000125 overflow_code_generated cobol_add_gen 000126 possible_ovfl_flag cobol_add_gen 000127 receiving_is_not_stored cobol_add_gen 000130 overflow_possible cobol_add_gen 000131 size_error_flag_defined cobol_add_gen 000132 temp_in_token cobol_add_gen 000156 size_error_inst cobol_add_gen 000160 size_error_inst_ptr cobol_add_gen 000162 size_error_token_ptr cobol_add_gen 000164 stored_token_ptr cobol_add_gen 000166 no_overflow_tag cobol_add_gen 000167 add_gen_code cobol_add_gen 000170 verb_type cobol_add_gen 000172 temp_ptr cobol_add_gen 000174 op1_token_ptr cobol_add_gen 000176 op2_token_ptr cobol_add_gen 000200 temp_resultant_operand_ptr cobol_add_gen 000202 binary_ok cobol_add_gen 000203 not_bit cobol_add_gen 000204 source_code cobol_add_gen 000205 target_code cobol_add_gen 000206 eos_ptr cobol_add_gen 000210 input_ptr cobol_add_gen 000212 reloc_ptr cobol_add_gen 000224 ret_offset get_size_error_flag 000225 input_buffer get_size_error_flag 000237 reloc_buffer get_size_error_flag 000260 temp_in_token receiving_field 000304 move_eos_ptr receiving_field 000306 tin_ptr receiving_field 000310 temp_save_ptr receiving_field 000312 ret_offset receiving_field 000336 temp_inst_word test_for_overflow 000340 temp_inst_ptr test_for_overflow 000342 reloc_buffer test_for_overflow 000354 reloc_ptr test_for_overflow 000356 save_locno test_for_overflow 000357 overflow_tag test_for_overflow 000366 register_struc test_size_error 000377 temp_inst_word test_size_error 000400 temp_inst_ptr test_size_error 000402 save_locno test_size_error 000403 reloc_buffer test_size_error 000416 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_add cobol_add3 cobol_add_binary_gen cobol_addr cobol_alloc$stack cobol_arith_move_gen cobol_binary_check$add 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_num_to_udts cobol_register$load THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cobol_$next_tag cobol_$text_wd_off LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 29 000006 202 000017 203 000026 205 000042 207 000045 209 000054 210 000056 211 000076 216 000077 219 000104 222 000106 225 000110 228 000112 230 000120 233 000121 235 000123 236 000127 240 000130 242 000136 244 000140 248 000143 249 000153 250 000154 251 000156 254 000165 258 000212 260 000231 264 000233 267 000237 270 000245 273 000246 275 000250 295 000261 300 000266 302 000267 303 000271 304 000300 316 000325 324 000344 325 000345 327 000346 328 000355 329 000357 330 000360 331 000361 332 000362 334 000364 338 000371 342 000407 346 000416 348 000420 349 000422 352 000424 353 000426 354 000430 363 000432 369 000456 372 000473 373 000476 376 000477 381 000503 385 000505 387 000513 392 000515 396 000534 397 000536 402 000545 407 000573 413 000610 414 000613 415 000615 416 000617 417 000621 418 000623 419 000625 420 000633 422 000635 423 000643 426 000650 431 000651 433 000656 434 000660 435 000662 440 000673 445 000712 451 000713 452 000716 454 000720 455 000722 456 000724 457 000726 458 000731 460 000740 463 000742 466 000755 468 000763 473 000770 477 000772 480 000774 484 001017 487 001026 489 001033 491 001034 496 001045 503 001047 509 001051 511 001062 512 001064 518 001103 1 13 001104 1 69 001106 1 72 001124 1 73 001127 1 76 001144 1 77 001146 1 79 001150 1 80 001152 1 81 001154 1 82 001155 1 83 001157 1 85 001161 1 88 001167 1 91 001202 1 94 001210 1 97 001225 1 99 001231 1 107 001232 1 161 001234 1 162 001241 1 267 001242 1 170 001243 1 178 001244 1 179 001252 1 180 001254 1 181 001256 1 182 001257 1 184 001262 1 185 001264 1 188 001275 1 191 001314 1 192 001317 1 193 001321 1 194 001323 1 195 001325 1 199 001326 1 200 001330 1 201 001333 1 203 001336 1 204 001340 1 205 001343 1 206 001347 1 207 001353 1 210 001355 1 211 001363 1 215 001365 1 218 001373 1 219 001400 1 220 001402 1 222 001404 1 230 001405 1 237 001406 1 238 001410 1 240 001413 1 241 001415 1 242 001417 1 243 001424 1 244 001430 1 247 001432 1 252 001434 1 253 001441 1 254 001443 1 259 001445 1 262 001453 1 263 001460 1 265 001462 1 274 001463 1 328 001465 1 329 001466 1 332 001470 1 335 001474 1 337 001477 1 340 001500 1 341 001502 1 342 001503 1 345 001504 1 348 001520 1 351 001540 1 357 001560 1 358 001561 1 360 001565 1 363 001570 1 366 001604 1 370 001622 1 371 001631 1 374 001637 1 377 001654 1 380 001660 1 388 001661 1 473 001663 1 474 001665 1 475 001666 1 478 001667 1 481 001674 1 484 001700 1 485 001701 1 486 001702 1 487 001704 1 489 001707 1 493 001720 1 495 001732 1 500 001740 1 505 001755 1 506 001756 1 507 001760 1 510 002000 1 511 002005 1 514 002011 1 517 002014 1 520 002030 1 523 002046 1 528 002047 1 539 002051 1 546 002103 ----------------------------------------------------------- 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