COMPILATION LISTING OF SEGMENT probe_operate_ Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-04-18_1133.51_Tue_mdt Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 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 /****^ HISTORY COMMENTS: 15* 1) change(88-06-08,WAAnderson), approve(88-09-30,MCR7952), 16* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 17* Added the procedure 'c_pointer_arithmetic' to perform addition and 18* subraction on pointers. 19* 2) change(88-06-13,WAAnderson), approve(88-09-30,MCR7952), 20* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 21* Modified the 'infix' entry to detect the C_LEFT_SHIFT and C_RIGHT_SHIFT 22* operators and call the new procedure 'c_shift_arithmetic'; the 23* procedure that performs the shift. 24* 3) change(88-09-07,WAAnderson), approve(88-09-30,MCR7952), 25* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 26* Added format control comment to make the source more readable. 27* 4) change(88-09-29,WAAnderson), approve(88-09-30,MCR7952), 28* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 29* Created the procedure 'c_mod_arithmetic' to perform the modulous 30* operator. Better late than never. 31* END HISTORY COMMENTS */ 32 33 34 /* format: style1,insnl,ifthendo,indthenelse,^indnoniterdo,^inditerdo,indcom,^indthenbegin,^indprocbody,ind2,ll78,initcol0,dclind4,idind24,struclvlind1,comcol41 */ 35 36 /**** * * * * * * * * * * * * * * * * * * * * * * * */ 37 38 probe_operate_: 39 procedure (); 40 41 call probe_error_$malfunction (); /* cant call this entry */ 42 43 /* This procedure is used to perform simple arithmetic operations on one */ 44 /* or two values represented by reference nodes. Resultant value is */ 45 /* allocated in supplied area, caller must ensure it is large enough. It */ 46 /* has two entries, infix and prefix, to do the appropriate kind of math */ 47 48 /* * 49* * 12 Aug 74, Jeffery M. Broughton: 50* * Initial Version. 51* * ?? Jul 77, R.J.C. Kissel: 52* * To handle new data types. When any_to_any_ is updated to handle 53* * all data types, all references to probe_assign_ should be changed 54* * to references to assign_ and probe_assign_ and probe_convert_ 55* * should be deleted. 56* * ?? Oct 78, James R. Davis: 57* * To add multiplication and division. 58* * ?? Nov 78, JRD: 59* * To do temp allocs in supplied area, not free seg. 60* * ?? Dec 78, JRD: 61* * To check for valid decimal data before trying to use it. 62* * ?? May 79, JRD: 63* * To use data_type_info_ and packed decimal. 64* * ?? May 79, WOS: 65* * To convert to probe 4.0. 66* * ?? Nov 79, ??? 67* * To use assign_computational_. 68* * 31 Mar 80, ??? 69* * To fix division MPRF 5504 probe bug 184. 70* * ?? Jun 83, JMAthane: 71* * For PASCAL : check for subrange types by calls to 72* * probe_pascal_$real_type 73* * 17 Jan 84, S. Herbst: 74* * Changed to use generic float decimal types for results of hex 75* * float computations. 76* * */ 77 78 /**** * * * * * * * * * * * * * * * * * * * * * * * */ 79 80 dcl ( 81 P_probe_info_ptr pointer, 82 P_opcode char (1) aligned, 83 /* (input) what to do */ 84 P_code fixed bin (35), 85 1 P_first aligned like reference_node, 86 /* (input) first operand of operation */ 87 1 P_second aligned like reference_node, 88 /* (input) second operand of infix ops */ 89 1 P_result aligned like reference_node 90 ) parameter;/* output */ 91 92 dcl MAX_GENFD_WORDS fixed bin int static options (constant) 93 init (17); 94 /* 16 for fixed dec(59) mantissa, 1 for exp */ 95 96 dcl 1 source (2) aligned like computational_data; 97 dcl 1 intermediate (2) aligned like computational_data; 98 dcl 1 result aligned like computational_data; 99 100 dcl 1 operand (2) aligned like reference_node; 101 /* copies of first and second */ 102 103 dcl 1 type_bits aligned, /* indicates type, base and mode */ 104 2 float bit (1) unaligned, 105 /* of the temp or target, which */ 106 2 binary bit (1) unaligned, 107 /* need not be the same as for the operand */ 108 2 complex bit (1) unaligned; 109 110 dcl type_type fixed bin;/* type_bits, as in fixed bin (3) */ 111 112 dcl 1 common_info (0:7), /* indexed by type_type */ 113 2 type_array fixed bin initial /* type to convert to */ 114 (real_fix_dec_9bit_ls_dtype, 115 cplx_fix_dec_9bit_ls_dtype, 116 real_fix_bin_2_dtype, 117 cplx_fix_bin_2_dtype, 118 real_flt_dec_9bit_dtype, 119 cplx_flt_dec_9bit_dtype, 120 real_flt_bin_2_dtype, 121 cplx_flt_bin_2_dtype), 122 2 prec_array fixed bin 123 initial (59, 59, 71, 71, 59, 59, 63, 63), 124 /* precision of result */ 125 2 size_array fixed bin initial (30, 60, 2, 4, 32, 64, 2, 4); 126 /* number of words */ 127 128 dcl 1 an_encoded_precision aligned like encoded_precision; 129 130 dcl 1 type_bits_copy aligned like type_bits; 131 132 dcl 1 gen_decimal_struc aligned based, 133 /* format of real_flt_dec_generic_dtype */ 134 2 exponent fixed bin (35), 135 2 mantissa fixed decimal (59); 136 137 dcl 1 cplx_gen_decimal_struc 138 aligned based, 139 /* format of cplx_flt_dec_generic_dtype */ 140 2 (real, imaginary) aligned like gen_decimal_struc; 141 142 dcl (use_genfd_sw, use_genfd_complex_sw) 143 bit (1); 144 dcl genfd_type fixed bin; 145 146 dcl dp pointer; /* to storage of temporary */ 147 dcl op (2) pointer; 148 /* to intermediate values */ 149 dcl (alloc_size, i, temp_precision) 150 fixed bin; 151 152 dcl fixed_bin_real fixed bin (71) real based; 153 /* operand overlays */ 154 dcl fixed_bin_complex fixed bin (71) complex based; 155 dcl float_bin_real float bin (63) real based; 156 dcl float_bin_complex float bin (63) complex based; 157 dcl fixed_dec_real fixed dec (59) real based; 158 dcl fixed_dec_complex fixed dec (59) complex based; 159 dcl float_dec_real float dec (59) real based; 160 dcl float_dec_complex float dec (59) complex based; 161 162 dcl ( 163 probe_et_$bad_operand, 164 probe_et_$bad_decimal, 165 probe_et_$recorded_message 166 ) fixed bin (35) external static; 167 dcl probe_pascal_$real_type entry (fixed bin (35), ptr, fixed bin (35), ptr) 168 ; 169 170 dcl valid_decimal_ entry (fixed bin, ptr, fixed bin) 171 returns (bit (1)); 172 dcl assign_$computational_ entry (ptr, ptr, fixed bin (35)); 173 174 dcl ( 175 generic_math_$add_decimal, 176 generic_math_$divide_decimal, 177 generic_math_$multiply_decimal, 178 generic_math_$subtract_decimal 179 ) 180 entry (1 aligned like gen_decimal_struc, 181 1 aligned like gen_decimal_struc, 182 1 aligned like gen_decimal_struc); 183 184 dcl ( 185 generic_math_$add_decimal_complex, 186 generic_math_$divide_decimal_complex, 187 generic_math_$multiply_decimal_complex, 188 generic_math_$subtract_decimal_complex 189 ) 190 entry (1 aligned like cplx_gen_decimal_struc, 191 1 aligned like cplx_gen_decimal_struc, 192 1 aligned like cplx_gen_decimal_struc); 193 194 dcl generic_math_$negate_decimal 195 entry (1 aligned like gen_decimal_struc, 196 1 aligned like gen_decimal_struc); 197 dcl generic_math_$negate_decimal_complex 198 entry (1 aligned like cplx_gen_decimal_struc, 199 1 aligned like cplx_gen_decimal_struc); 200 201 dcl ( 202 probe_error_$malfunction, 203 probe_error_$record 204 ) entry options (variable); 205 206 dcl (abs, addr, addrel, ceil, divide, fixed, hbound, lbound, mod, 207 multiply, null, max, min, pointer, sign, string, substr, unspec) 208 builtin; 209 210 /**** * * * * * * * * * * * * * * * * * * * * * * * */ 211 212 /* * The procdedure is simple: 213* * 1) Check the inputs. 214* * 2) Compute attributes of result and temporary. 215* * 3) Convert input to temporary. 216* * 4) Do arithmetic on temp(s). 217* * 5) Assign temporary to result. */ 218 219 220 probe_operate_$prefix: 221 entry (P_probe_info_ptr, P_opcode, P_first, P_result, P_code); 222 223 probe_info_ptr = P_probe_info_ptr; 224 P_code = 0; /* until we decide otherwise */ 225 226 if probe_info.language_type = PASCAL_lang_type 227 then 228 call probe_pascal_$real_type (P_first.type, P_first.type_ptr, 229 P_first.type, P_first.type_ptr); 230 231 if P_first.type < lbound (data_type_info_$info, 1) 232 | P_first.type > hbound (data_type_info_$info, 1) then do; 233 call probe_error_$record (probe_info_ptr, probe_et_$bad_operand, 234 P_first.name); 235 goto RECORDED_MESSAGE; 236 end; 237 238 if ^data_type_info_$info (P_first.type).computational then do; 239 call probe_error_$record (probe_info_ptr, probe_et_$bad_operand, 240 P_first.name); 241 goto RECORDED_MESSAGE; 242 end; 243 244 245 if data_type_info_$info (P_first.type).arithmetic 246 & /* optimize - prefix + of number */ 247 P_opcode = "+" then do; /* result is the reference itself */ 248 P_result.address_ptr = P_first.address_ptr; 249 P_result.type = P_first.type; 250 P_result.descriptor = P_first.descriptor; 251 P_result.precision = P_first.precision; 252 end; 253 else do; 254 255 /* Must convert operand to a standard arithmetic type before continuing */ 256 257 type_bits = compute_type_bits ((P_first.type)); 258 type_type = fixed (string (type_bits), 3, 0); 259 260 /* gather source attributes */ 261 262 use_genfd_sw, use_genfd_complex_sw = "0"b; 263 if data_type_info_$info (P_first.type).hex 264 & data_type_info_$info (P_first.type).arithmetic then do; 265 use_genfd_sw = "1"b; 266 if data_type_info_$info (P_first.type).complex then do; 267 use_genfd_complex_sw = "1"b; 268 genfd_type = cplx_flt_dec_generic_dtype; 269 end; 270 else genfd_type = real_flt_dec_generic_dtype; 271 end; 272 273 call setup_structure (P_first, source (1)); 274 275 if ^type_bits.binary & ^use_genfd_sw 276 then 277 if ^valid_decimal_ ((P_first.type), P_first.address_ptr, 278 (source (1).prec_or_length)) 279 then do; 280 call probe_error_$record (probe_info_ptr, 281 probe_et_$bad_decimal, P_first.name); 282 goto RECORDED_MESSAGE; 283 end; 284 285 /* make temp for intermediate, and convert to it */ 286 287 unspec (intermediate (1)) = "0"b; 288 if use_genfd_sw then do; 289 intermediate (1).data_type = genfd_type; 290 intermediate (1).prec_or_length = 291 data_type_info_$max_decimal_precision; 292 alloc_size = MAX_GENFD_WORDS; 293 if use_genfd_complex_sw 294 then alloc_size = alloc_size * 2; 295 end; 296 else do; 297 intermediate (1).data_type = common_info (type_type).type_array; 298 intermediate (1).prec_or_length = 299 common_info (type_type).prec_array; 300 alloc_size = common_info (type_type).size_array; 301 end; 302 intermediate (1).scale = source (1).scale; 303 intermediate (1).picture_image_ptr = null (); 304 305 dp = allocate_temp (alloc_size); 306 intermediate (1).address = dp; 307 308 call assign_$computational_ (addr (intermediate (1)), addr (source (1)), 309 P_code); 310 if P_code ^= 0 311 then 312 return; 313 314 /* Now do the arithmetic on the intermediate value */ 315 316 if P_opcode = "+" 317 then ; /* nothing need be done */ 318 319 else if P_opcode = "-" then do; 320 if use_genfd_sw 321 then 322 if use_genfd_complex_sw 323 then call generic_math_$negate_decimal_complex 324 (dp -> cplx_gen_decimal_struc, 325 dp -> cplx_gen_decimal_struc); 326 else call generic_math_$negate_decimal 327 (dp -> gen_decimal_struc, 328 dp -> gen_decimal_struc); 329 else if type_bits.binary 330 then if type_bits.float 331 then if type_bits.complex 332 then dp -> float_bin_complex = 333 -dp -> float_bin_complex; 334 else dp -> float_bin_real = -dp -> float_bin_real; 335 else if type_bits.complex 336 then dp -> fixed_bin_complex = -dp -> fixed_bin_complex; 337 else dp -> fixed_bin_real = -dp -> fixed_bin_real; 338 else if type_bits.float 339 then if type_bits.complex 340 then dp -> float_dec_complex = -dp -> float_dec_complex; 341 else dp -> float_dec_real = -dp -> float_dec_real; 342 else if type_bits.complex 343 then dp -> fixed_dec_complex = -dp -> fixed_dec_complex; 344 else dp -> fixed_dec_real = -dp -> fixed_dec_real; 345 end; /* of minus */ 346 347 else call probe_error_$malfunction (probe_info_ptr, 0, 348 "Invalid prefix operator: ""^a"".", P_opcode); 349 350 if use_genfd_sw then do; 351 P_result.type = genfd_type; 352 P_result.precision = data_type_info_$max_decimal_precision; 353 end; 354 else P_result.type = common_info (type_type).type_array; 355 P_result.descriptor = P_result.type * 2; 356 357 /* now create some storage in the work area for the result 358* This storage must survive our invocation! */ 359 360 P_result.address_ptr = allocate_temp (alloc_size); 361 362 call setup_structure (P_result, result); 363 call assign_$computational_ (addr (result), addr (intermediate (1)), 364 P_code); 365 end; 366 367 P_result.symbol_ptr = null (); 368 if P_result.source_info_ptr ^= null 369 then 370 P_result.source_info_ptr -> source_info.block_ptr, 371 P_result.source_info_ptr -> source_info.stack_ptr, 372 P_result.source_info_ptr -> source_info.entry_ptr = null (); 373 P_result.name = "<>"; 374 P_result.flags = "0"b; 375 P_result.constant = "1"b; 376 377 return; /* end of code for probe_operate_$prefix */ 378 379 380 /*****************************************************************************/ 381 382 probe_operate_$infix: 383 entry (P_probe_info_ptr, P_opcode, P_first, P_second, P_result, P_code); 384 385 /**** * * * * * * * * * * * * * * * * * * * * * * * */ 386 387 c_pointer_arithmetic: 388 proc (); 389 390 dcl i fixed bin; 391 dcl tp ptr; 392 dcl total_bits (2) fixed bin; 393 dcl data_value (2) fixed bin; 394 dcl tp_type fixed bin; 395 dcl op_addr ptr; 396 dcl total_bits_to_add fixed bin (24); 397 dcl add_word_offset fixed bin (17); 398 dcl add_bit_offset fixed bin (5); 399 dcl temp_node_ptr ptr; 400 dcl fixed_bin_short fixed bin (17) based (op_addr); 401 dcl fixed_bin_long fixed bin (71) based (op_addr); 402 dcl dec_string char (32) based (op_addr); 403 dcl stored_addr ptr; 404 dcl based_ptr ptr based; 405 dcl based_int fixed bin (35) based; 406 407 dcl 1 its based aligned, 408 2 pad1 bit (3) unaligned, 409 2 segno bit (15) unaligned, 410 2 ringno bit (3) unaligned, 411 2 pad2 bit (9) unaligned, 412 2 its_mod bit (6) unaligned, 413 414 2 offset fixed bin (17) unaligned, 415 2 pad3 bit (3) unaligned, 416 2 bit_offset fixed bin (5) unaligned, 417 2 pad4 bit (3) unaligned, 418 2 future_mod bit (6) unaligned; 419 420 dcl pointer_encountered bit (1); 421 dcl code fixed bin (35); 422 dcl probe_create_reference_ entry (ptr, ptr); 423 dcl 01 temp_ref aligned like reference_node; 424 dcl probe_builtins_$sizeof_builtin 425 entry (ptr, ptr, fixed bin (35)); 426 dcl 01 sub_refs aligned like subscript_reference_ptrs; 427 428 429 /* Get the size of the data type pointed to. */ 430 /* Get the number of units */ 431 /* Convert the units to words and bits */ 432 /* Add the appropriate fileds of the ITS pointer */ 433 434 if (P_opcode ^= "+" & P_opcode ^= "-") then do; 435 call probe_error_$record (probe_info_ptr, 0, 436 "Only addition and subtraction may be done in C pointer arithmetic." 437 ); 438 goto RECORDED_MESSAGE; 439 end; 440 total_bits (*) = 0; 441 data_value (*) = 0; 442 pointer_encountered = "0"b; 443 P_result.symbol_ptr = null (); 444 do i = 1 to 2; 445 if operand (i).type = pointer_dtype then do; 446 if (pointer_encountered) then do; 447 call probe_error_$record (probe_info_ptr, 0, 448 "Only one operand in a pointer arithmetic expression may be a pointer." 449 ); 450 goto RECORDED_MESSAGE; 451 end; 452 else pointer_encountered = "1"b; 453 P_result.symbol_ptr = operand (i).symbol_ptr; 454 if (operand (i).symbol_ptr = null () 455 & operand (i).c_symbol_ptr = null ()) then do; 456 call probe_error_$record (probe_info_ptr, 0, 457 "Cannot locate the data type of the data pointed to by a pointer" 458 ); 459 goto RECORDED_MESSAGE; 460 end; 461 else do; 462 if (operand (i).symbol_ptr ^= null ()) 463 then 464 tp = operand (i).symbol_ptr; 465 else 466 tp = operand (i).c_symbol_ptr; 467 468 stored_addr = operand (i).address_ptr -> based_ptr; 469 470 tp = addrel (tp, fixed (tp -> runtime_symbol.son)); 471 472 do while (fixed (tp -> runtime_symbol.type) = c_typeref_dtype); 473 tp = addrel (tp, fixed (tp -> runtime_symbol.son)); 474 end; 475 476 temp_ref = operand (i); 477 temp_ref.symbol_ptr = tp; 478 479 sub_refs.ptr (1, 1) = addr (temp_ref); 480 call probe_create_reference_ (probe_info_ptr, temp_node_ptr); 481 temp_node_ptr -> reference_node.name = "<<>>"; 482 temp_node_ptr -> reference_node.source_info_ptr = 483 temp_ref.source_info_ptr; 484 temp_node_ptr -> reference_node.optional_info.n_subscripts = 1; 485 temp_node_ptr -> reference_node.subscript_refs_ptr = 486 addr (sub_refs); 487 call probe_builtins_$sizeof_builtin (probe_info_ptr, 488 temp_node_ptr, code); 489 temp_node_ptr -> reference_node.optional_info.n_subscripts = 0; 490 491 total_bits (i) = 492 temp_node_ptr -> reference_node.address_ptr -> based_int * 9; 493 end; 494 end; 495 else do; 496 op_addr = operand (i).address_ptr; 497 tp_type = operand (i).type; 498 if (tp_type = real_fix_bin_1_dtype) 499 then 500 data_value (i) = fixed (fixed_bin_short, 17, 0); 501 else if (tp_type = real_fix_bin_2_dtype) 502 then 503 data_value (i) = fixed (fixed_bin_long, 17, 0); 504 else if (tp_type = real_fix_dec_9bit_ls_dtype) 505 then 506 data_value (i) = 507 fixed (substr (dec_string, 1, operand (i).precision + 1), 508 17, 0); 509 end; 510 end; /* end do loop */ 511 512 P_result.type = pointer_dtype; 513 514 if (total_bits (1) = 0) 515 then 516 total_bits_to_add = multiply (total_bits (2), data_value (1), 24, 0); 517 else 518 total_bits_to_add = multiply (total_bits (1), data_value (2), 24, 0); 519 520 add_word_offset = divide (total_bits_to_add, 36, 17, 0); 521 add_bit_offset = fixed (mod (total_bits_to_add, 36), 5, 0); 522 523 P_result.descriptor = P_result.type * 2; 524 525 if P_result.source_info_ptr ^= null 526 then 527 P_result.source_info_ptr -> source_info.block_ptr, 528 P_result.source_info_ptr -> source_info.stack_ptr, 529 P_result.source_info_ptr -> source_info.entry_ptr = null (); 530 P_result.name = "<>"; 531 P_result.flags = "0"b; 532 P_result.constant = "1"b; 533 534 P_result.address_ptr = allocate_temp (2); 535 P_result.address_ptr -> based_ptr = stored_addr; 536 537 if (P_opcode = "+") then do; 538 add_word_offset = P_result.address_ptr -> its.offset + add_word_offset; 539 add_bit_offset = 540 P_result.address_ptr -> its.bit_offset + add_bit_offset; 541 if (add_bit_offset >= 36) then do; 542 add_word_offset = 543 add_word_offset + divide (add_bit_offset, 36, 17, 0); 544 add_bit_offset = fixed (mod (add_bit_offset, 36), 5, 0); 545 end; 546 end; 547 else if (P_opcode = "-") then do; 548 add_word_offset = P_result.address_ptr -> its.offset - add_word_offset; 549 add_bit_offset = 550 P_result.address_ptr -> its.bit_offset - add_bit_offset; 551 if (add_bit_offset < 0) then do; 552 add_word_offset = add_word_offset - 1; 553 add_bit_offset = 36 + add_bit_offset; 554 end; 555 end; 556 P_result.address_ptr -> its.offset = add_word_offset; 557 P_result.address_ptr -> its.bit_offset = add_bit_offset; 558 559 end c_pointer_arithmetic; 560 561 562 /**** * * * * * * * * * * * * * * * * * * * * * * * */ 563 564 c_shift_arithmetic: 565 proc (); 566 567 dcl (tp_type, data_value) fixed bin; 568 dcl op_addr ptr; 569 dcl fixed_bin_short fixed bin (17) based (op_addr); 570 dcl fixed_bin_long fixed bin (71) based (op_addr); 571 dcl dec_string char (32) based (op_addr); 572 dcl bit_9 (4) unaligned bit (9) based; 573 dcl bit_18 (2) unaligned bit (18) based; 574 dcl bit_36 bit (36) based; 575 dcl bit_72 bit (72) based; 576 dcl zeros bit (72) int static options (constant) 577 init ("0"b); 578 dcl mod_bits fixed bin; 579 580 if (probe_info.language_type ^= C_lang_type) then do; 581 call probe_error_$record (probe_info_ptr, 0, 582 "The >> and << operators may not be used by the current language"); 583 goto RECORDED_MESSAGE; 584 end; 585 586 tp_type = operand (1).type; 587 588 /* char */ 589 if (tp_type = char_dtype) then do; 590 mod_bits = 9; 591 P_result.address_ptr = allocate_temp (1); 592 P_result.address_ptr -> bit_9 (1) = 593 operand (1).address_ptr -> bit_9 (1); 594 end; 595 596 /* int & short & long */ 597 else if (tp_type <= real_flt_bin_2_dtype) then do; 598 if (tp_type = real_fix_bin_1_dtype | tp_type = real_flt_bin_1_dtype) 599 then do; 600 P_result.address_ptr = allocate_temp (1); 601 if (operand (1).precision <= 18) then do; 602 mod_bits = 18; 603 P_result.address_ptr -> bit_18 (1) = 604 operand (1).address_ptr -> bit_18 (1); 605 end; 606 else do; 607 mod_bits = 36; 608 P_result.address_ptr -> bit_36 = 609 operand (1).address_ptr -> bit_36; 610 end; 611 end; 612 else do; 613 P_result.address_ptr = allocate_temp (2); 614 P_result.address_ptr -> bit_72 = operand (1).address_ptr -> bit_72; 615 mod_bits = 72; 616 end; 617 end; 618 619 /* Invalid data type for a shift */ 620 else 621 call probe_error_$record (probe_info_ptr, 0, 622 "Invalid data type for the shift operator."); 623 624 625 op_addr = operand (2).address_ptr; 626 tp_type = operand (2).type; 627 628 if (tp_type = real_fix_bin_1_dtype) 629 then 630 data_value = fixed (fixed_bin_short, 17, 0); 631 else if (tp_type = real_fix_bin_2_dtype) 632 then 633 data_value = fixed (fixed_bin_long, 17, 0); 634 else if (tp_type = real_fix_dec_9bit_ls_dtype) 635 then 636 data_value = 637 fixed (substr (dec_string, 1, operand (2).precision + 1), 17, 0) 638 ; 639 640 P_result.type = operand (1).type; 641 642 P_result.descriptor = P_result.type * 2; 643 644 P_result.symbol_ptr = null (); 645 if P_result.source_info_ptr ^= null 646 then 647 P_result.source_info_ptr -> source_info.block_ptr, 648 P_result.source_info_ptr -> source_info.stack_ptr, 649 P_result.source_info_ptr -> source_info.entry_ptr = null (); 650 P_result.name = "<>"; 651 P_result.flags = "0"b; 652 P_result.constant = "1"b; 653 654 if (data_value >= mod_bits) then do; 655 substr (P_result.address_ptr -> bit_72, 1, mod_bits) = 656 substr (zeros, 1, mod_bits); 657 return; 658 end; 659 else if (P_opcode = "<") 660 then 661 substr (P_result.address_ptr -> bit_72, 1, mod_bits) = 662 substr (P_result.address_ptr -> bit_72, data_value + 1, 663 mod_bits - data_value) || substr (zeros, 1, data_value); 664 else if (P_opcode = ">") 665 then 666 substr (P_result.address_ptr -> bit_72, 1, mod_bits) = 667 substr (zeros, 1, data_value) 668 || 669 substr (P_result.address_ptr -> bit_72, 1, 670 mod_bits - data_value); 671 672 end c_shift_arithmetic; 673 674 /**** * * * * * * * * * * * * * * * * * * * * * * * */ 675 676 c_mod_arithmetic: 677 proc (); 678 679 dcl tp_type fixed bin; 680 dcl op_addr ptr; 681 dcl fixed_bin_short fixed bin (35) based (op_addr); 682 dcl fixed_bin_long fixed bin (71) based (op_addr); 683 dcl dec_string char (32) based (op_addr); 684 dcl (op1, op2) fixed bin (35); 685 dcl mod builtin; 686 687 if (probe_info.language_type ^= C_lang_type) then do; 688 call probe_error_$record (probe_info_ptr, 0, 689 "The % operator may not be used by the current language."); 690 goto RECORDED_MESSAGE; 691 end; 692 693 op_addr = operand (1).address_ptr; 694 tp_type = operand (1).type; 695 696 P_result.type = real_fix_bin_1_dtype; 697 P_result.address_ptr = allocate_temp (1); 698 699 if (tp_type = real_fix_bin_1_dtype) 700 then 701 op1 = operand (1).address_ptr -> fixed_bin_short; 702 else if (tp_type = real_fix_bin_2_dtype) 703 then 704 op1 = fixed (operand (1).address_ptr -> fixed_bin_long, 35, 0); 705 else if (tp_type = real_fix_dec_9bit_ls_dtype) 706 then 707 op1 = fixed (substr (dec_string, 1, operand (1).precision + 1), 35, 708 0); 709 /* Invalid data type for modulous */ 710 else 711 call probe_error_$record (probe_info_ptr, 0, 712 "Invalid data type for the modulous operator."); 713 714 op_addr = operand (2).address_ptr; 715 tp_type = operand (2).type; 716 717 if (tp_type = real_fix_bin_1_dtype) 718 then 719 op2 = operand (2).address_ptr -> fixed_bin_short; 720 else if (tp_type = real_fix_bin_2_dtype) 721 then 722 op2 = fixed (operand (2).address_ptr -> fixed_bin_long, 35, 0); 723 else if (tp_type = real_fix_dec_9bit_ls_dtype) 724 then 725 op2 = fixed (substr (dec_string, 1, operand (2).precision + 1), 35, 726 0); 727 /* Invalid data type for modulous */ 728 else 729 call probe_error_$record (probe_info_ptr, 0, 730 "Invalid data type for the modulous operator."); 731 732 P_result.descriptor = P_result.type * 2; 733 734 P_result.symbol_ptr = null (); 735 if P_result.source_info_ptr ^= null 736 then 737 P_result.source_info_ptr -> source_info.block_ptr, 738 P_result.source_info_ptr -> source_info.stack_ptr, 739 P_result.source_info_ptr -> source_info.entry_ptr = null (); 740 P_result.name = "<>"; 741 P_result.flags = "0"b; 742 P_result.constant = "1"b; 743 744 if (op2 = 0) then do; 745 call probe_error_$record (probe_info_ptr, 0, 746 "The second argument of the modulous operator is zero."); 747 goto RECORDED_MESSAGE; 748 end; 749 750 P_result.address_ptr -> fixed_bin_short = mod (op1, op2); 751 752 end c_mod_arithmetic; 753 754 /**** * * * * * * * * * * * * * * * * * * * * * * * */ 755 756 probe_info_ptr = P_probe_info_ptr; 757 P_code = 0; /* until we decide otherwise */ 758 759 operand (1) = P_first; 760 operand (2) = P_second; /* for easier processing */ 761 762 /* check ops for validity ******************** */ 763 764 use_genfd_sw, use_genfd_complex_sw = "0"b; 765 766 do i = 1 to 2; /* check ops for validity */ 767 if probe_info.language_type = PASCAL_lang_type 768 then 769 call probe_pascal_$real_type (operand (i).type, 770 operand (i).type_ptr, 771 operand (i).type, operand (i).type_ptr); 772 773 if operand (i).type < lbound (data_type_info_$info, 1) | 774 operand (i).type > hbound (data_type_info_$info, 1) then do; 775 call probe_error_$record (probe_info_ptr, probe_et_$bad_operand, 776 operand (i).name); 777 goto RECORDED_MESSAGE; 778 end; 779 780 /* C pointers may be incremented or decremented */ 781 782 if ^data_type_info_$info (operand (i).type).computational & 783 probe_info.language_type ^= C_lang_type then do; 784 call probe_error_$record (probe_info_ptr, probe_et_$bad_operand, 785 operand (i).name); 786 goto RECORDED_MESSAGE; 787 end; 788 789 if data_type_info_$info (operand (i).type).hex & 790 data_type_info_$info (operand (i).type).arithmetic then do; 791 use_genfd_sw = "1"b; 792 if data_type_info_$info (operand (i).type).complex then do; 793 use_genfd_complex_sw = "1"b; 794 genfd_type = cplx_flt_dec_generic_dtype; 795 end; 796 else if ^use_genfd_complex_sw 797 then genfd_type = real_flt_dec_generic_dtype; 798 end; 799 end; 800 801 /* Do C pointer arithmetic */ 802 803 if (operand (1).type = pointer_dtype | operand (2).type = pointer_dtype) 804 then do; 805 call c_pointer_arithmetic (); 806 return; 807 end; 808 809 /* Do C left and right shift arithmetic */ 810 811 if (P_opcode = "<" | P_opcode = ">") then do; 812 call c_shift_arithmetic (); 813 return; 814 end; 815 816 /* Do C % operator */ 817 818 if (P_opcode = "%") then do; 819 call c_mod_arithmetic (); 820 return; 821 end; 822 823 /* to compute the attributes of the result - type_bits is cleverly set up so 824* that the common attribute may be found by or'ing the separate attributes */ 825 826 type_bits = compute_type_bits ((P_first.type)); 827 type_bits_copy = compute_type_bits ((P_second.type)); 828 829 string (type_bits) = string (type_bits) | string (type_bits_copy); 830 831 type_type = fixed (string (type_bits), 3, 0); 832 if use_genfd_sw then do; 833 P_result.type = genfd_type; 834 P_result.precision = data_type_info_$max_decimal_precision; 835 end; 836 else P_result.type = common_info (type_type).type_array; 837 P_result.descriptor = P_result.type * 2; 838 839 P_result.symbol_ptr = null (); 840 if P_result.source_info_ptr ^= null 841 then 842 P_result.source_info_ptr -> source_info.block_ptr, 843 P_result.source_info_ptr -> source_info.stack_ptr, 844 P_result.source_info_ptr -> source_info.entry_ptr = null (); 845 P_result.name = "<>"; 846 P_result.flags = "0"b; 847 P_result.constant = "1"b; 848 849 if use_genfd_sw then do; 850 alloc_size = MAX_GENFD_WORDS; 851 if use_genfd_complex_sw 852 then alloc_size = alloc_size * 2; 853 end; 854 else alloc_size = common_info (type_type).size_array; 855 P_result.address_ptr = allocate_temp (alloc_size); 856 do i = 1 to 2; 857 858 call setup_structure (operand (i), source (i)); 859 if data_type_info_$info (operand (i).type).decimal 860 then if ^valid_decimal_ ((operand (i).type), operand (i).address_ptr, 861 (source (i).prec_or_length)) then do; 862 call probe_error_$record (probe_info_ptr, 863 probe_et_$bad_decimal, operand (i).name); 864 goto RECORDED_MESSAGE; 865 end; 866 867 if use_genfd_sw then do; 868 intermediate (i).data_type = genfd_type; 869 intermediate (i).prec_or_length = 870 data_type_info_$max_decimal_precision; 871 end; 872 else intermediate (i).data_type = common_info (type_type).type_array; 873 874 if ^data_type_info_$info (source (i).data_type).arithmetic 875 then if data_type_info_$info (source (i).data_type).char_string 876 then intermediate (i).prec_or_length = 877 data_type_info_$max_decimal_precision; 878 else intermediate (i).prec_or_length = 879 data_type_info_$max_fixed_binary_precision; 880 881 if (data_type_info_$info (source (i).data_type).decimal | 882 data_type_info_$info (source (i).data_type).char_string) & 883 type_bits.binary & ^use_genfd_sw then do; 884 intermediate (i).prec_or_length = 885 min (ceil (intermediate (i).prec_or_length * 3.332), 886 common_info (type_type).prec_array); 887 intermediate (i).scale = 888 ceil (abs (intermediate (i).scale) * 3.332) 889 * sign (intermediate (i).scale); 890 end; /* decimal to bin precision hack */ 891 892 op (i), intermediate (i).address = allocate_temp (alloc_size); 893 end; 894 895 result.address = P_result.address_ptr; 896 result.data_type = P_result.type; 897 result.flags = "0"b; 898 899 900 /* We now branch depending on the opcode. Each opcode computes the precision that the 901* operands are to be converted to, does the conversion, does the operation, computes 902* the precision of the result, converts the result to proper precision, and returns. 903**/ 904 905 if P_opcode = "+" | P_opcode = "-" then do; 906 907 /* Compute temporary and result precisions - both temps must have the same scale, 908* because the addition is done with two dummies. the decimal points must be in 909* the same column, in order to get meaningful results. */ 910 911 /* Rules of PL/I tell what attributes of plus result are */ 912 913 if use_genfd_sw 914 then result.prec_or_length = data_type_info_$max_decimal_precision; 915 else result.prec_or_length = min (common_info (type_type).prec_array, 916 max (source (1).prec_or_length - source (1).scale, 917 source (2).prec_or_length - source (2).scale) + 918 max (source (1).scale, source (2).scale) + 1); 919 result.scale = max (source (1).scale, source (2).scale); 920 921 /* for intermediates use max possible */ 922 if ^use_genfd_sw 923 then intermediate (*).prec_or_length = 924 common_info (type_type).prec_array; 925 intermediate (*).scale = max (source (1).scale, source (2).scale); 926 927 do i = 1 to 2; 928 call assign_$computational_ (addr (intermediate (i)), 929 addr (source (i)), P_code); 930 if P_code ^= 0 931 then 932 return; 933 end; 934 935 if P_opcode = "+" then do; 936 if use_genfd_sw 937 then 938 if use_genfd_complex_sw 939 then call generic_math_$add_decimal_complex 940 (op (1) -> cplx_gen_decimal_struc, 941 op (2) -> cplx_gen_decimal_struc, 942 op (1) -> cplx_gen_decimal_struc); 943 else call generic_math_$add_decimal 944 (op (1) -> gen_decimal_struc, 945 op (2) -> gen_decimal_struc, 946 op (1) -> gen_decimal_struc); 947 else if type_bits.binary 948 then if type_bits.float 949 then if type_bits.complex 950 then op (1) -> float_bin_complex = 951 op (1) -> float_bin_complex 952 + op (2) -> float_bin_complex; 953 else op (1) -> float_bin_real = 954 op (1) -> float_bin_real 955 + op (2) -> float_bin_real; 956 else if type_bits.complex 957 then op (1) -> fixed_bin_complex = 958 op (1) -> fixed_bin_complex 959 + op (2) -> fixed_bin_complex; 960 else op (1) -> fixed_bin_real = 961 op (1) -> fixed_bin_real 962 + op (2) -> fixed_bin_real; 963 else if type_bits.float 964 then if type_bits.complex 965 then op (1) -> float_dec_complex = 966 op (1) -> float_dec_complex 967 + op (2) -> float_dec_complex; 968 else op (1) -> float_dec_real = 969 op (1) -> float_dec_real 970 + op (2) -> float_dec_real; 971 else if type_bits.complex 972 then op (1) -> fixed_dec_complex = 973 op (1) -> fixed_dec_complex 974 + op (2) -> fixed_dec_complex; 975 else op (1) -> fixed_dec_real = 976 op (1) -> fixed_dec_real + op (2) -> fixed_dec_real; 977 end; /* plus */ 978 979 else if P_opcode = "-" then do; 980 if use_genfd_sw 981 then 982 if use_genfd_complex_sw 983 then call generic_math_$subtract_decimal_complex 984 (op (1) -> cplx_gen_decimal_struc, 985 op (2) -> cplx_gen_decimal_struc, 986 op (1) -> cplx_gen_decimal_struc); 987 else call generic_math_$subtract_decimal 988 (op (1) -> gen_decimal_struc, 989 op (2) -> gen_decimal_struc, 990 op (1) -> gen_decimal_struc); 991 else if type_bits.binary 992 then if type_bits.float 993 then if type_bits.complex 994 then op (1) -> float_bin_complex = 995 op (1) -> float_bin_complex 996 - op (2) -> float_bin_complex; 997 else op (1) -> float_bin_real = 998 op (1) -> float_bin_real 999 - op (2) -> float_bin_real; 1000 else if type_bits.complex 1001 then op (1) -> fixed_bin_complex = 1002 op (1) -> fixed_bin_complex 1003 - op (2) -> fixed_bin_complex; 1004 else op (1) -> fixed_bin_real = 1005 op (1) -> fixed_bin_real 1006 - op (2) -> fixed_bin_real; 1007 else if type_bits.float 1008 then if type_bits.complex 1009 then op (1) -> float_dec_complex = 1010 op (1) -> float_dec_complex 1011 - op (2) -> float_dec_complex; 1012 else op (1) -> float_dec_real = 1013 op (1) -> float_dec_real 1014 - op (2) -> float_dec_real; 1015 else if type_bits.complex 1016 then op (1) -> fixed_dec_complex = 1017 op (1) -> fixed_dec_complex 1018 - op (2) -> fixed_dec_complex; 1019 else op (1) -> fixed_dec_real = 1020 op (1) -> fixed_dec_real - op (2) -> fixed_dec_real; 1021 end; /* minus */ 1022 end; /* plus and minus */ 1023 1024 else if P_opcode = "*" then do; 1025 1026 if use_genfd_sw 1027 then temp_precision = data_type_info_$max_decimal_precision; 1028 else temp_precision = common_info (type_type).prec_array; 1029 1030 if type_bits.float then do; 1031 P_result.precision, result.prec_or_length, 1032 intermediate (*).prec_or_length = temp_precision; 1033 result.scale, intermediate (*).scale = 0; 1034 do i = 1 to 2; 1035 call assign_$computational_ (addr (intermediate (i)), 1036 addr (source (i)), P_code); 1037 if P_code ^= 0 1038 then 1039 return; 1040 end; 1041 if use_genfd_sw 1042 then 1043 if use_genfd_complex_sw 1044 then call generic_math_$multiply_decimal_complex 1045 (op (1) -> cplx_gen_decimal_struc, 1046 op (2) -> cplx_gen_decimal_struc, 1047 op (1) -> cplx_gen_decimal_struc); 1048 else call generic_math_$multiply_decimal 1049 (op (1) -> gen_decimal_struc, 1050 op (2) -> gen_decimal_struc, 1051 op (1) -> gen_decimal_struc); 1052 else if type_bits.binary 1053 then if type_bits.complex 1054 then op (1) -> float_bin_complex = 1055 op (1) -> float_bin_complex 1056 * op (2) -> float_bin_complex; 1057 else op (1) -> float_bin_real = 1058 op (1) -> float_bin_real 1059 * op (2) -> float_bin_real; 1060 else if type_bits.complex 1061 then op (1) -> float_dec_complex = 1062 op (1) -> float_dec_complex 1063 * op (2) -> float_dec_complex; 1064 else op (1) -> float_dec_real = 1065 op (1) -> float_dec_real * op (2) -> float_dec_real; 1066 end; /* float work */ 1067 1068 else do; 1069 intermediate (*).prec_or_length = temp_precision; 1070 do i = 1 to 2; 1071 intermediate (i).scale = source (i).scale; 1072 call assign_$computational_ (addr (intermediate (i)), 1073 addr (source (i)), P_code); 1074 if P_code ^= 0 1075 then 1076 return; 1077 end; 1078 1079 1080 if type_bits.binary 1081 then if type_bits.complex 1082 then op (1) -> fixed_bin_complex = 1083 op (1) -> fixed_bin_complex 1084 * op (2) -> fixed_bin_complex; 1085 else op (1) -> fixed_bin_real = 1086 op (1) -> fixed_bin_real 1087 * op (2) -> fixed_bin_real; 1088 else if type_bits.complex 1089 then op (1) -> fixed_dec_complex = 1090 op (1) -> fixed_dec_complex 1091 * op (2) -> fixed_dec_complex; 1092 else op (1) -> fixed_dec_real = 1093 op (1) -> fixed_dec_real * op (2) -> fixed_dec_real; 1094 1095 result.prec_or_length = min (common_info (type_type).prec_array, 1096 source (1).prec_or_length + source (2).prec_or_length + 1); 1097 result.scale = source (1).scale + source (2).scale; 1098 end; /* fixed point multiplication */ 1099 1100 end; /* multiply */ 1101 1102 else if P_opcode = "/" then do; 1103 if use_genfd_sw 1104 then temp_precision = data_type_info_$max_decimal_precision; 1105 else temp_precision = common_info (type_type).prec_array; 1106 result.prec_or_length, intermediate (*).prec_or_length, 1107 P_result.precision = temp_precision; 1108 intermediate (*).scale, result.scale = 0; 1109 1110 do i = 1 to 2; 1111 call assign_$computational_ (addr (intermediate (i)), 1112 addr (source (i)), P_code); 1113 if P_code ^= 0 1114 then 1115 return; 1116 end; 1117 1118 if use_genfd_sw 1119 then 1120 if use_genfd_complex_sw 1121 then call generic_math_$divide_decimal_complex 1122 (op (1) -> cplx_gen_decimal_struc, 1123 op (2) -> cplx_gen_decimal_struc, 1124 op (1) -> cplx_gen_decimal_struc); 1125 else call generic_math_$divide_decimal 1126 (op (1) -> gen_decimal_struc, 1127 op (2) -> gen_decimal_struc, 1128 op (1) -> gen_decimal_struc); 1129 else if type_bits.binary 1130 then if type_bits.float 1131 then if type_bits.complex 1132 then op (1) -> float_bin_complex = 1133 divide (op (1) -> float_bin_complex, 1134 op (2) -> float_bin_complex, 63); 1135 else op (1) -> float_bin_real = 1136 divide (op (1) -> float_bin_real, 1137 op (2) -> float_bin_real, 63); 1138 else if type_bits.complex 1139 then op (1) -> fixed_bin_complex = 1140 divide (op (1) -> fixed_bin_complex, 1141 op (2) -> fixed_bin_complex, 71); 1142 else op (1) -> fixed_bin_real = 1143 divide (op (1) -> fixed_bin_real, 1144 op (2) -> fixed_bin_real, 71, 0); 1145 else if type_bits.float 1146 then if type_bits.complex 1147 then op (1) -> float_dec_complex = 1148 divide (op (1) -> float_dec_complex, 1149 op (2) -> float_dec_complex, 59); 1150 else op (1) -> float_dec_real = 1151 divide (op (1) -> float_dec_real, 1152 op (2) -> float_dec_real, 59); 1153 else if type_bits.complex 1154 then op (1) -> fixed_dec_complex = 1155 divide (op (1) -> fixed_dec_complex, 1156 op (2) -> fixed_dec_complex, 59, 0); 1157 else op (1) -> fixed_dec_real = 1158 divide (op (1) -> fixed_dec_real, op (2) -> fixed_dec_real, 1159 59, 0); 1160 1161 end; /* divide */ 1162 1163 1164 call assign_$computational_ (addr (result), addr (intermediate (1)), P_code) 1165 ; 1166 an_encoded_precision.prec = result.prec_or_length; 1167 an_encoded_precision.scale = result.scale; 1168 unspec (P_result.precision) = unspec (an_encoded_precision); 1169 1170 return; 1171 1172 1173 RECORDED_MESSAGE: /* error exit */ 1174 P_code = probe_et_$recorded_message; 1175 1176 return; 1177 1178 1179 /**** * * * * * * * * * * * * * * * * * * * * * * * */ 1180 1181 allocate_temp: 1182 proc (P_size_in_words) returns (ptr); 1183 1184 dcl P_size_in_words fixed bin parameter; 1185 dcl based_bit bit (P_size_in_words * 36) based; 1186 dcl result_ptr ptr; 1187 1188 allocate based_bit in (expression_area) set (result_ptr); 1189 return (result_ptr); 1190 1191 end allocate_temp; 1192 1193 /**** * * * * * * * * * * * * * * * * * * * * * * * */ 1194 1195 setup_structure: 1196 proc (ref, comp); 1197 1198 dcl 1 ref parameter aligned like reference_node; 1199 dcl 1 comp parameter aligned like computational_data; 1200 dcl 1 an_encoded_value like encoded_precision; 1201 1202 comp.address = ref.address_ptr; 1203 comp.data_type = ref.type; 1204 string (comp.flags) = "0"b; 1205 comp.flags.packed = ref.flags.packed; 1206 if data_type_info_$info (ref.type).arithmetic 1207 then do; 1208 unspec (an_encoded_value) = unspec (ref.precision); 1209 comp.prec_or_length = an_encoded_value.prec; 1210 comp.scale = an_encoded_value.scale; 1211 end; 1212 else do; 1213 comp.prec_or_length = ref.precision; 1214 comp.scale = 0; 1215 end; 1216 if ref.type = picture_runtime_dtype 1217 then comp.picture_image_ptr = pointer (ref.symbol_ptr, ref.precision); 1218 else comp.picture_image_ptr = null (); 1219 1220 end setup_structure; 1221 1222 /**** * * * * * * * * * * * * * * * * * * * * * * * */ 1223 1224 compute_type_bits: 1225 proc (P_dtype) returns (1 aligned like type_bits); 1226 1227 dcl P_dtype fixed bin parameter; 1228 1229 dcl 1 d_type_bits aligned like type_bits; 1230 1231 if data_type_info_$info (P_dtype).arithmetic then do; 1232 d_type_bits.float = ^data_type_info_$info (P_dtype).fixed; 1233 d_type_bits.binary = ^data_type_info_$info (P_dtype).decimal; 1234 d_type_bits.complex = data_type_info_$info (P_dtype).complex; 1235 end; 1236 1237 else do; 1238 d_type_bits.float = "0"b; 1239 if data_type_info_$info (P_dtype).bit_string 1240 then 1241 d_type_bits.binary = "1"b; 1242 else d_type_bits.binary = "0"b; 1243 d_type_bits.complex = "0"b; 1244 end; 1245 1246 return (d_type_bits); 1247 end compute_type_bits; 1248 1249 /**** * * * * * * * * * * * * * * * * * * * * * * * */ 1250 1 1 /* BEGIN INCLUDE FILE probe_info.incl.pl1 */ 1 2 1 3 1 4 1 5 /****^ HISTORY COMMENTS: 1 6* 1) change(88-10-24,WAAnderson), approve(88-10-24,MCR7952), 1 7* audit(88-10-24,RWaters), install(88-10-27,MR12.2-1194): 1 8* Added field 'retry_using_main' to add new C feature. 1 9* END HISTORY COMMENTS */ 1 10 1 11 1 12 /* Created: 04/22/79 W. Olin Sibert, from subsystem_info 1 13* Modified: 22 Sept 79 JRd to remove: default (ptr & (auto|based)) init (null ()); 1 14* Added flags.setting_break 08/22/83 Steve Herbst 1 15* Added flags.executing_quit_request 01/15/85 Steve Herbst 1 16**/ 1 17 1 18 dcl 1 probe_info aligned based (probe_info_ptr), /* standard data for a probe invocation */ 1 19 2 probe_info_version fixed bin, /* version of this structure */ 1 20 1 21 2 static_info_ptr pointer unaligned, /* pointer to static information structure */ 1 22 2 modes_ptr pointer unaligned, /* pointer to probe_modes structure */ 1 23 1 24 2 ptr_to_current_source ptr, /* current_source is based on this */ 1 25 2 ptr_to_initial_source ptr, /* initial_source is based on this */ 1 26 2 machine_cond_ptr pointer, /* pointer to machine conditions, if we faulted to get here */ 1 27 1 28 2 token_info aligned, /* information about token chain currently being processed */ 1 29 3 first_token pointer unaligned, /* first token in chain */ 1 30 3 ct pointer unaligned, /* pointer to current token; updated in MANY places */ 1 31 3 end_token bit (18) aligned, /* token type at which to stop scanning token chain */ 1 32 3 buffer_ptr pointer unaligned, /* pointer to input buffer */ 1 33 3 buffer_lth fixed bin (21), /* and length */ 1 34 1 35 2 random_info aligned, 1 36 3 current_stack_frame pointer unaligned, /* stack frame pointer for frame in which probe was invoked */ 1 37 3 input_type fixed bin, /* current input type */ 1 38 3 language_type fixed bin, /* current language being processed */ 1 39 3 return_method fixed bin, /* how we should return after exiting probe */ 1 40 3 entry_method fixed bin, /* how we got here in the first place */ 1 41 3 pad1 (19) bit (36) aligned, 1 42 1 43 2 break_info, /* break info -- only interesting if we got here via a break */ 1 44 3 break_slot_ptr pointer, /* pointer to break slot -- non-null IFF at a break */ 1 45 3 last_break_slot_ptr pointer unaligned, /* pointer to previous break slot, not presently used */ 1 46 3 break_reset bit (1) aligned, /* this break has been reset by somebody further on */ 1 47 3 real_break_return_loc pointer, /* where to REALLY return to, modulo previous bit */ 1 48 1 49 2 probe_area_info, /* information about various probe areas */ 1 50 3 break_segment_ptr pointer unaligned, /* pointer to Personid.probe */ 1 51 3 break_area_ptr pointer unaligned, /* pointer to area in break segment */ 1 52 3 scratch_area_ptr pointer unaligned, /* pointer to probe scratch seg in process dir */ 1 53 3 probe_area_ptr pointer unaligned, /* This area lasts as long as an invocation of probe. */ 1 54 3 work_area_ptr pointer unaligned, /* This area lasts as long as the current request line */ 1 55 3 expression_area_ptr pointer unaligned, /* This area lasts as long as the current command */ 1 56 1 57 2 flags aligned, /* this, in particular, should be saved and restored correctly */ 1 58 (3 execute, /* "1"b => execute requests, "0"b => just check syntax */ 1 59 3 in_listener, /* ON => in probe listener loop */ 1 60 3 executing_request, /* ON => executing a request */ 1 61 3 in_interpret_line, /* executing in probe_listen_$interpret_line */ 1 62 3 setting_break, /* executing "after" or "before": check syntax of "if" */ 1 63 3 executing_quit_request, /* to prevent error looping during "quit" request */ 1 64 3 pad (30)) bit (1) unaligned, 1 65 1 66 2 io_switches, /* switches probe will do normal I/O on */ 1 67 3 input_switch pointer, 1 68 3 output_switch pointer, 1 69 1 70 2 error_info, /* information about the last error saved for later printing */ 1 71 3 error_code fixed bin (35), 1 72 3 error_message char (300) varying, 1 73 1 74 2 listener_info, /* internal use by probe listener */ 1 75 3 request_name character (32) varying, /* primary name of the request being processed */ 1 76 3 abort_probe_label label variable, 1 77 3 abort_line_label label variable, 1 78 3 depth fixed binary, /* count of active invocations of probe */ 1 79 3 previous pointer unaligned, /* -> previous invocation's info */ 1 80 3 next pointer unaligned, 1 81 1 82 2 end_of_probe_info pointer aligned, 1 83 2 retry_using_main fixed bin aligned; 1 84 1 85 1 86 dcl probe_info_ptr pointer; 1 87 1 88 dcl probe_info_version fixed bin static options (constant) initial (1); 1 89 1 90 dcl probe_info_version_1 fixed bin static options (constant) initial (1); 1 91 1 92 dcl scratch_area area based (probe_info.scratch_area_ptr); 1 93 dcl probe_area area based (probe_info.probe_area_ptr); 1 94 dcl work_area area based (probe_info.work_area_ptr); 1 95 dcl expression_area area based (probe_info.expression_area_ptr); 1 96 1 97 /* END INCLUDE FILE probe_info.incl.pl1 */ 1251 1252 2 1 /* BEGIN INCLUDE FILE probe_tokens.incl.pl1 */ 2 2 /* Split up into probe_tokens and probe_references, 04/22/79 WOS */ 2 3 2 4 dcl 1 token_header aligned based, /* header information common to all tokens */ 2 5 2 next pointer unaligned, /* pointer to next token in chain */ 2 6 2 prev pointer unaligned, /* same for previous token */ 2 7 2 type bit (18) aligned, 2 8 2 buffer_ptr pointer unaligned, /* pointer to beginning of input buffer */ 2 9 2 location fixed bin (17) unal, /* offset in input buffer */ 2 10 2 length fixed bin (17) unal, 2 11 2 flags aligned, 2 12 (3 leading_whitespace, /* there is whitespace before thios token */ 2 13 3 trailing_whitespace) bit (1) unaligned, /* and same for after */ 2 14 3 pad1 bit (34) unaligned; 2 15 2 16 dcl 1 token aligned based, /* produced by scan_probe_input_ */ 2 17 2 header aligned like token_header; /* that's all there is */ 2 18 2 19 dcl 1 identifier aligned based, /* keyword or identifier token */ 2 20 2 header aligned like token_header, 2 21 2 length fixed bin, /* length of name */ 2 22 2 name pointer unaligned; /* to string in buffer containing name */ 2 23 2 24 dcl 1 operator aligned based, /* for punctuation */ 2 25 2 header aligned like token_header; /* nothing but a header here */ 2 26 2 27 dcl 1 constant aligned based, /* for strings pointers numbers etc */ 2 28 2 header aligned like token_header, 2 29 2 encoded_precision aligned, /* encoded precision kludge for assign_ */ 2 30 3 scale fixed bin (17) unaligned, /* arithmetic scale */ 2 31 3 precision fixed bin (17) unaligned, /* arithmetic precision or other size */ 2 32 2 scale_and_precision fixed bin (35), /* An identical copy of the two values above */ 2 33 2 data_type fixed bin, /* standard data type code + packed bit */ 2 34 2 data_ptr pointer unaligned; 2 35 2 36 2 37 dcl (OPERATOR_TYPE init ("100"b), /* types for above */ 2 38 NAME_TYPE init ("010"b), 2 39 CONSTANT_TYPE init ("001"b)) bit (18) internal static options (constant); 2 40 2 41 2 42 dcl current_identifier_name /* Overlays for looking at the current tokens */ 2 43 char (probe_info.ct -> identifier.length) based (probe_info.ct -> identifier.name); 2 44 dcl 1 current_constant aligned like constant based (probe_info.ct); 2 45 dcl 1 current_token aligned like token based (probe_info.ct); 2 46 2 47 /* END INCLUDE FILE probe_tokens.incl.pl1 */ 1253 1254 3 1 /* BEGIN INCLUDE FILE probe_references.incl.pl1 */ 3 2 3 3 /****^ HISTORY COMMENTS: 3 4* 1) change(88-09-20,WAAnderson), approve(88-09-20,MCR7952), 3 5* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 3 6* Added new field (c_symbol) for C-Probe support. 3 7* 2) change(88-10-28,WAAnderson), approve(88-10-28,MCR7952), 3 8* audit(88-10-31,RWaters), install(88-11-11,MR12.2-1210): 3 9* Added new field (c_sub_c_ptr) for C-Probe_support. 3 10* END HISTORY COMMENTS */ 3 11 3 12 /* Split out of probe_tokens, 04/22/79 WOS */ 3 13 /* modified for probe variables Feb 19 80 JRD */ 3 14 /* Modified June 83 JMAthane to add "type_ptr" and "builtin" fields */ 3 15 3 16 dcl 1 reference_node aligned based, /* information about a reference */ 3 17 2 symbol_ptr pointer aligned, /* to symbol table entry for reference */ 3 18 2 type_ptr pointer aligned, /* to symbol table entry for type (null if none) */ 3 19 2 address_ptr pointer aligned, /* to location of variable */ 3 20 2 base_addr pointer aligned, /* pointer on which whole symbol is based */ 3 21 2 source_info_ptr pointer aligned, /* to symbol structure for reference */ 3 22 3 23 2 name char (256) unaligned varying, /* symbol name */ 3 24 3 25 2 type fixed bin (35), /* data type */ 3 26 2 descriptor fixed bin (35), /* type || packed */ 3 27 2 precision fixed bin (35), /* scale and precision */ 3 28 2 flags, 3 29 3 packed bit (1) unal, /* data is in packed format */ 3 30 3 constant bit (1) unal, /* data is really a constant */ 3 31 3 cross_section bit (1) unal, /* reference is an array cross-section */ 3 32 3 function bit (1) unal, /* reference is function value */ 3 33 3 octal bit (1) unal, /* indicates that this is the octal bif */ 3 34 3 star_extent bit (1) unal, /* reference is a star subscript for father */ 3 35 3 have_generation bit (1) unal, /* this reference has an explicitly specified generation */ 3 36 3 pseudo_var bit (1) unal, /* it is ok to assign to it */ 3 37 3 probe_variable bit (1) unal, 3 38 3 path bit (1) unal, /* it's a pathname/virtual entry */ 3 39 3 builtin bit (1) unal, /* probe builtinvalue */ 3 40 3 c_ptr_to_char bit (1) unal, 3 41 3 c_sub_c_ptr bit (1) unal, 3 42 3 pad2 bit (23) unal, 3 43 3 44 2 optional_info, /* information which may or may not be present */ 3 45 3 argument_list pointer unaligned, /* pointer to reference_arg_list */ 3 46 3 subscript_ptr pointer unaligned, /* pointer to reference_subscripts */ 3 47 3 n_arguments fixed bin, /* number of arguments in argument list */ 3 48 3 n_subscripts fixed bin, /* number of subscripts present */ 3 49 3 50 2 constant_token_ptr pointer unaligned, /* pointer to constant token if this is a constant */ 3 51 2 subscript_refs_ptr pointer unaligned, /* pointer to array of subscript reference node pointers */ 3 52 2 invocation_level fixed bin, /* invocation level number ("[-17]") for this reference */ 3 53 2 probe_var_info_ptr ptr unal, /* only if flags.probe_variable */ 3 54 2 c_symbol_ptr ptr unal, 3 55 2 pad1 (9) pointer unaligned, 3 56 2 end_of_reference_node pointer aligned; 3 57 3 58 3 59 dcl 1 reference_arg_list aligned based, /* argument list; based on reference.argument_list */ 3 60 2 number fixed bin, /* number of arguments actually present */ 3 61 2 node (16) pointer aligned; /* reference node pointers for each argument */ 3 62 3 63 3 64 dcl 1 reference_subscripts aligned based, /* subscript array; based on reference.subscript_ptr */ 3 65 2 number fixed bin, /* number actually present */ 3 66 2 value (2, 16) fixed bin (24); /* values for lower and upper bound for each */ 3 67 3 68 3 69 dcl 1 subscript_reference_ptrs aligned based, /* array of pointers to subscript reference nodes */ 3 70 2 ptr (2, 16) pointer aligned; 3 71 3 72 /* END INCLUDE FILE probe_references.incl.pl1 */ 1255 1256 4 1 /* BEGIN INCLUDE FILE ... probe_source_info.incl.pl1 4 2* 4 3* James R. Davis 2 July 79 */ 4 4 4 5 dcl 1 source_info based aligned, 4 6 2 stmnt_map_entry_index fixed bin, /* index in stmnt map for this stmnt */ 4 7 2 instruction_ptr ptr, /* to last instruction executed */ 4 8 2 block_ptr ptr, /* to runtime_block node */ 4 9 2 stack_ptr ptr, /* to a stack frame */ 4 10 2 entry_ptr ptr, /* to entry seq. for this proc */ 4 11 2 seg_info_ptr ptr; /* to seg_info */ 4 12 4 13 dcl 1 current_source aligned like source_info based (probe_info.ptr_to_current_source); 4 14 dcl 1 initial_source aligned like source_info based (probe_info.ptr_to_initial_source); 4 15 4 16 /* END INCLUDE FILE ... probe_source_info.incl.pl1 */ 1257 1258 5 1 /* BEGIN INCLUDE FILE ... std_descriptor_types.incl.pl1 */ 5 2 5 3 5 4 /****^ HISTORY COMMENTS: 5 5* 1) change(86-09-05,JMAthane), approve(86-09-05,MCR7525), 5 6* audit(86-09-11,Martinson), install(86-11-12,MR12.0-1208): 5 7* Added pascal_string_type_dtype descriptor type. Its number is 87. 5 8* Objects of this type are PASCAL string types. 5 9* 2) change(88-09-20,WAAnderson), approve(88-09-20,MCR7952), 5 10* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 5 11* Added the new C types. 5 12* END HISTORY COMMENTS */ 5 13 5 14 /* This include file defines mnemonic names for the Multics 5 15* standard descriptor types, using both pl1 and cobol terminology. 5 16* PG 780613 5 17* JRD 790530 5 18* JRD 791016 5 19* MBW 810731 5 20* TGO 830614 Add hex types. 5 21* Modified June 83 JMAthane to add PASCAL data types 5 22* TGO 840120 Add float dec extended and generic, float binary generic 5 23**/ 5 24 5 25 dcl (real_fix_bin_1_dtype init (1), 5 26 real_fix_bin_2_dtype init (2), 5 27 real_flt_bin_1_dtype init (3), 5 28 real_flt_bin_2_dtype init (4), 5 29 cplx_fix_bin_1_dtype init (5), 5 30 cplx_fix_bin_2_dtype init (6), 5 31 cplx_flt_bin_1_dtype init (7), 5 32 cplx_flt_bin_2_dtype init (8), 5 33 real_fix_dec_9bit_ls_dtype init (9), 5 34 real_flt_dec_9bit_dtype init (10), 5 35 cplx_fix_dec_9bit_ls_dtype init (11), 5 36 cplx_flt_dec_9bit_dtype init (12), 5 37 pointer_dtype init (13), 5 38 offset_dtype init (14), 5 39 label_dtype init (15), 5 40 entry_dtype init (16), 5 41 structure_dtype init (17), 5 42 area_dtype init (18), 5 43 bit_dtype init (19), 5 44 varying_bit_dtype init (20), 5 45 char_dtype init (21), 5 46 varying_char_dtype init (22), 5 47 file_dtype init (23), 5 48 real_fix_dec_9bit_ls_overp_dtype init (29), 5 49 real_fix_dec_9bit_ts_overp_dtype init (30), 5 50 real_fix_bin_1_uns_dtype init (33), 5 51 real_fix_bin_2_uns_dtype init (34), 5 52 real_fix_dec_9bit_uns_dtype init (35), 5 53 real_fix_dec_9bit_ts_dtype init (36), 5 54 real_fix_dec_4bit_uns_dtype init (38), /* digit-aligned */ 5 55 real_fix_dec_4bit_ts_dtype init (39), /* byte-aligned */ 5 56 real_fix_dec_4bit_bytealigned_uns_dtype init (40), /* COBOL */ 5 57 real_fix_dec_4bit_ls_dtype init (41), /* digit-aligned */ 5 58 real_flt_dec_4bit_dtype init (42), /* digit-aligned */ 5 59 real_fix_dec_4bit_bytealigned_ls_dtype init (43), 5 60 real_flt_dec_4bit_bytealigned_dtype init (44), 5 61 cplx_fix_dec_4bit_bytealigned_ls_dtype init (45), 5 62 cplx_flt_dec_4bit_bytealigned_dtype init (46), 5 63 real_flt_hex_1_dtype init (47), 5 64 real_flt_hex_2_dtype init (48), 5 65 cplx_flt_hex_1_dtype init (49), 5 66 cplx_flt_hex_2_dtype init (50), 5 67 c_typeref_dtype init (54), 5 68 c_enum_dtype init (55), 5 69 c_enum_const_dtype init (56), 5 70 c_union_dtype init (57), 5 71 algol68_straight_dtype init (59), 5 72 algol68_format_dtype init (60), 5 73 algol68_array_descriptor_dtype init (61), 5 74 algol68_union_dtype init (62), 5 75 5 76 cobol_comp_6_dtype init (1), 5 77 cobol_comp_7_dtype init (1), 5 78 cobol_display_ls_dtype init (9), 5 79 cobol_structure_dtype init (17), 5 80 cobol_char_string_dtype init (21), 5 81 cobol_display_ls_overp_dtype init (29), 5 82 cobol_display_ts_overp_dtype init (30), 5 83 cobol_display_uns_dtype init (35), 5 84 cobol_display_ts_dtype init (36), 5 85 cobol_comp_8_uns_dtype init (38), /* digit aligned */ 5 86 cobol_comp_5_ts_dtype init (39), /* byte aligned */ 5 87 cobol_comp_5_uns_dtype init (40), 5 88 cobol_comp_8_ls_dtype init (41), /* digit aligned */ 5 89 real_flt_dec_extended_dtype init (81), /* 9-bit exponent */ 5 90 cplx_flt_dec_extended_dtype init (82), /* 9-bit exponent */ 5 91 real_flt_dec_generic_dtype init (83), /* generic float decimal */ 5 92 cplx_flt_dec_generic_dtype init (84), 5 93 real_flt_bin_generic_dtype init (85), /* generic float binary */ 5 94 cplx_flt_bin_generic_dtype init (86)) fixed bin internal static options (constant); 5 95 5 96 dcl (ft_integer_dtype init (1), 5 97 ft_real_dtype init (3), 5 98 ft_double_dtype init (4), 5 99 ft_complex_dtype init (7), 5 100 ft_complex_double_dtype init (8), 5 101 ft_external_dtype init (16), 5 102 ft_logical_dtype init (19), 5 103 ft_char_dtype init (21), 5 104 ft_hex_real_dtype init (47), 5 105 ft_hex_double_dtype init (48), 5 106 ft_hex_complex_dtype init (49), 5 107 ft_hex_complex_double_dtype init (50) 5 108 ) fixed bin internal static options (constant); 5 109 5 110 dcl (algol68_short_int_dtype init (1), 5 111 algol68_int_dtype init (1), 5 112 algol68_long_int_dtype init (2), 5 113 algol68_real_dtype init (3), 5 114 algol68_long_real_dtype init (4), 5 115 algol68_compl_dtype init (7), 5 116 algol68_long_compl_dtype init (8), 5 117 algol68_bits_dtype init (19), 5 118 algol68_bool_dtype init (19), 5 119 algol68_char_dtype init (21), 5 120 algol68_byte_dtype init (21), 5 121 algol68_struct_struct_char_dtype init (22), 5 122 algol68_struct_struct_bool_dtype init (20) 5 123 ) fixed bin internal static options (constant); 5 124 5 125 dcl (label_constant_runtime_dtype init (24), 5 126 int_entry_runtime_dtype init (25), 5 127 ext_entry_runtime_dtype init (26), 5 128 ext_procedure_runtime_dtype init (27), 5 129 picture_runtime_dtype init (63) 5 130 ) fixed bin internal static options (constant); 5 131 5 132 dcl (pascal_integer_dtype init (1), 5 133 pascal_real_dtype init (4), 5 134 pascal_label_dtype init (24), 5 135 pascal_internal_procedure_dtype init (25), 5 136 pascal_exportable_procedure_dtype init (26), 5 137 pascal_imported_procedure_dtype init (27), 5 138 pascal_typed_pointer_type_dtype init (64), 5 139 pascal_char_dtype init (65), 5 140 pascal_boolean_dtype init (66), 5 141 pascal_record_file_type_dtype init (67), 5 142 pascal_record_type_dtype init (68), 5 143 pascal_set_dtype init (69), 5 144 pascal_enumerated_type_dtype init (70), 5 145 pascal_enumerated_type_element_dtype init (71), 5 146 pascal_enumerated_type_instance_dtype init (72), 5 147 pascal_user_defined_type_dtype init (73), 5 148 pascal_user_defined_type_instance_dtype init (74), 5 149 pascal_text_file_dtype init (75), 5 150 pascal_procedure_type_dtype init (76), 5 151 pascal_variable_formal_parameter_dtype init (77), 5 152 pascal_value_formal_parameter_dtype init (78), 5 153 pascal_entry_formal_parameter_dtype init (79), 5 154 pascal_parameter_procedure_dtype init (80), 5 155 pascal_string_type_dtype init (87)) fixed bin int static options (constant); 5 156 5 157 5 158 /* END INCLUDE FILE ... std_descriptor_types.incl.pl1 */ 1259 1260 6 1 /* BEGIN INCLUDE FILE ... data_type_info_.incl.pl1 6 2* 6 3* attributes of each Multics data type. You may not rely on the dimension never exceeding 64 6 4* James R. Davis 6 Apr 79 6 5* Modified JMAthane June 83 to add "type" bit field 6 6* Upped bound from 64 to 80 10/18/83 S. Herbst 6 7* Added "hex" and "generic" bits 01/23/84 S. Herbst 6 8* Upped bound from 80 to 86 01/81/84 R. Gray 6 9* Upper bound from 86 to 87 JMAthane (for Pascal strings type dtype) 6 10**/ 6 11 6 12 6 13 /****^ HISTORY COMMENTS: 6 14* 1) change(86-09-05,JMAthane), approve(86-09-05,MCR7525), 6 15* audit(86-09-11,Martinson), install(86-11-12,MR12.0-1208): 6 16* The data_type_info array now has 87 entries instead of 86 due to 6 17* introduction of pascal_string_type_dtype. 6 18* END HISTORY COMMENTS */ 6 19 6 20 dcl data_type_info_$version_number fixed bin external static; 6 21 dcl data_type_info_this_version fixed bin internal static options (constant) init (1); 6 22 6 23 dcl 1 data_type_info_$info (87) aligned external static, 6 24 2 computational bit (1) unal, 6 25 2 arithmetic bit (1) unal, 6 26 2 arithmetic_attributes unal, /* only valid if arithmetic */ 6 27 3 fixed bit (1) unal, /* PL/I type */ 6 28 3 complex bit (1) unal, /* PL/I mode */ 6 29 3 decimal bit (1) unal, /* PL/I base */ 6 30 3 signed bit (1) unal, 6 31 3 trailing_sign bit (1) unal, /* only valid if signed */ 6 32 3 decimal_attributes unal, /* only valid if decimal */ 6 33 4 packed_dec bit (1) unal, /* 4 bits per digit or 9 */ 6 34 4 digit_aligned bit (1) unal, /* valid for packed_dec only */ 6 35 4 overpunched bit (1) unal, 6 36 2 char_string bit (1) unal, /* valid for non-arithmetic */ 6 37 2 bit_string bit (1) unal, /* valid for non-arithmetic */ 6 38 2 varying bit (1) unal, /* for bit or char only */ 6 39 2 type bit (1) unal, /* this symbol is a type */ 6 40 2 hex bit (1) unal, /* a hexadecimal type (eg., hex floating point) */ 6 41 2 generic bit (1) unal, /* eg., real_flt_dec_generic_dtype */ 6 42 2 pad bit (20) unal; 6 43 6 44 dcl data_type_info_$ninebit_sign_chars char (2) external static; 6 45 dcl data_type_info_$ninebit_digit_chars char (10) external static; 6 46 dcl data_type_info_$ninebit_overpunched_sign_chars char (22) external static; 6 47 6 48 dcl data_type_info_$max_decimal_precision fixed bin external static; 6 49 dcl data_type_info_$max_float_binary_precision fixed bin external static; 6 50 dcl data_type_info_$max_fixed_binary_precision fixed bin external static; 6 51 6 52 6 53 /* END INCLUDE FILE ... data_type_info_.incl.pl1 */ 1261 1262 7 1 /* BEGIN INCLUDE FILE ... probe_lang_types.incl.pl1 7 2* 7 3* JRD 26 June 79 7 4* MBW 31 July 1981 to add algol68 */ 7 5 7 6 7 7 /****^ HISTORY COMMENTS: 7 8* 1) change(88-09-20,WAAnderson), approve(88-09-20,MCR7952), 7 9* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 7 10* Added C Language type. 7 11* END HISTORY COMMENTS */ 7 12 7 13 7 14 /* Modified June 83 JMAthane to add PASCAL language type */ 7 15 /* Modified April 88 Hinatsu to add C language type */ 7 16 7 17 dcl (UNKNOWN_lang_type init (1), 7 18 OTHER_lang_type init (2), 7 19 PL1_lang_type init (3), 7 20 FORTRAN_lang_type init (4), 7 21 COBOL_lang_type init (5), 7 22 ALM_lang_type init (6), 7 23 ALGOL68_lang_type init (7), 7 24 PASCAL_lang_type init (8), 7 25 C_lang_type init (9)) fixed bin internal static options (constant); 7 26 7 27 dcl official_language_names (9) char (32) internal static options (constant) init 7 28 ("Unknown", "other", "PL/I", "FORTRAN", "COBOL", "ALM", "Algol 68", "Pascal", "C"); 7 29 7 30 dcl palatable_language_names (9) char (32) internal static options (constant) init 7 31 ("Unknown", "Other", "pl1", "fortran", "cobol", "alm", "algol68", "pascal", "c"); 7 32 7 33 /* END INCLUDE FILE ... probe_lang_types.incl.pl1 */ 1263 1264 8 1 /* BEGIN INCLUDE FILE ... encoded_precision.incl.pl1 8 2* 8 3* This is the format used by assign_ to encode the precision and scale of 8 4* arithmetic data into one word. This structure should be assigned (use unspec) 8 5* to a fixed bin (35). 8 6**/ 8 7 8 8 dcl 1 encoded_precision based aligned, 8 9 2 scale fixed bin (17) unal, 8 10 2 prec fixed bin (18) unsigned unal; 8 11 8 12 /* END INCLUDE FILE ... encoded_precision.incl.pl1 */ 1265 1266 9 1 /* BEGIN INCLUDE FILE ... computational_data.incl.pl1 9 2* 9 3* 12 July 79 JRDavis */ 9 4 9 5 /* this is the format of the structure given to assign_$computational_ 9 6* that describes the data to be assigned */ 9 7 9 8 dcl 1 computational_data aligned based, 9 9 2 address ptr aligned, /* to data */ 9 10 2 data_type fixed bin (17), /* standard descriptor type */ 9 11 2 flags aligned, 9 12 3 packed bit (1) unal, 9 13 3 pad bit (35) unal, 9 14 2 prec_or_length fixed bin (24), /* string length or arith prec */ 9 15 2 scale fixed bin (35), /* must be zero even if has no scale */ 9 16 2 picture_image_ptr ptr aligned; /* to picture image block */ 9 17 9 18 /* END INCLUDE FILE ... computational_data.incl.pl1 */ 1267 1268 10 1 /* BEGIN INCLUDE FILE ... runtime_symbol.incl.pl1 ... Modified 07/79 */ 10 2 10 3 dcl 1 runtime_symbol aligned based, 10 4 2 flag unal bit(1), /* always "1"b for Version II */ 10 5 2 use_digit unal bit(1), /* if "1"b and units are half words units are really digits */ 10 6 2 array_units unal bit(2), 10 7 2 units unal bit(2), /* addressing units */ 10 8 2 type unal bit(6), /* data type */ 10 9 2 level unal bit(6), /* structure level */ 10 10 2 ndims unal bit(6), /* number of dimensions */ 10 11 2 bits unal, 10 12 3 aligned bit(1), 10 13 3 packed bit(1), 10 14 3 simple bit(1), 10 15 2 skip unal bit(1), 10 16 2 scale unal bit(8), /* arithmetic scale factor */ 10 17 2 name unal bit(18), /* rel ptr to acc name */ 10 18 2 brother unal bit(18), /* rel ptr to brother entry */ 10 19 2 father unal bit(18), /* rel ptr to father entry */ 10 20 2 son unal bit(18), /* rel ptr to son entry */ 10 21 2 address unal, 10 22 3 location bit(18), /* location in storage class */ 10 23 3 class bit(4), /* storage class */ 10 24 3 next bit(14), /* rel ptr to next of same class */ 10 25 2 size fixed bin(35), /* encoded string|arith size */ 10 26 2 offset fixed bin(35), /* encoded offset from address */ 10 27 2 virtual_org fixed bin(35), 10 28 2 bounds(1), 10 29 3 lower fixed bin(35), /* encoded lower bound */ 10 30 3 upper fixed bin(35), /* encoded upper bound */ 10 31 3 multiplier fixed bin(35); /* encoded multiplier */ 10 32 10 33 dcl 1 runtime_bound based, 10 34 2 lower fixed bin(35), 10 35 2 upper fixed bin(35), 10 36 2 multiplier fixed bin(35); 10 37 10 38 dcl 1 runtime_block aligned based, 10 39 2 flag unal bit(1), /* always "1"b for Version II */ 10 40 2 quick unal bit(1), /* "1"b if quick block */ 10 41 2 fortran unal bit(1), /* "1"b if fortran program */ 10 42 2 standard unal bit(1), /* "1"b if program has std obj segment */ 10 43 2 owner_flag unal bit(1), /* "1"b if block has valid owner field */ 10 44 2 skip unal bit(1), 10 45 2 type unal bit(6), /* = 0 for a block node */ 10 46 2 number unal bit(6), /* begin block number */ 10 47 2 start unal bit(18), /* rel ptr to start of symbols */ 10 48 2 name unal bit(18), /* rel ptr to name of proc */ 10 49 2 brother unal bit(18), /* rel ptr to brother block */ 10 50 2 father unal bit(18), /* rel ptr to father block */ 10 51 2 son unal bit(18), /* rel ptr to son block */ 10 52 2 map unal, 10 53 3 first bit(18), /* rel ptr to first word of map */ 10 54 3 last bit(18), /* rel ptr to last word of map */ 10 55 2 entry_info unal bit(18), /* info about entry of quick block */ 10 56 2 header unal bit(18), /* rel ptr to symbol header */ 10 57 2 chain(4) unal bit(18), /* chain(i) is rel ptr to first symbol 10 58* on start list with length >= 2**i */ 10 59 2 token(0:5) unal bit(18), /* token(i) is rel ptr to first token 10 60* on list with length >= 2 ** i */ 10 61 2 owner unal bit(18); /* rel ptr to owner block */ 10 62 10 63 dcl 1 runtime_token aligned based, 10 64 2 next unal bit(18), /* rel ptr to next token */ 10 65 2 dcl unal bit(18), /* rel ptr to first dcl of this token */ 10 66 2 name, /* ACC */ 10 67 3 size unal unsigned fixed bin (9), /* number of chars in token */ 10 68 3 string unal char(n refer(runtime_token.size)); 10 69 10 70 dcl 1 encoded_value aligned based, 10 71 2 flag bit (2) unal, 10 72 2 code bit (4) unal, 10 73 2 n1 bit (6) unal, 10 74 2 n2 bit (6) unal, 10 75 2 n3 bit (18) unal; 10 76 10 77 /* END INCLUDE FILE ... runtime_symbol.incl.pl1 */ 1269 1270 1271 end probe_operate_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/00 1133.5 probe_operate_.pl1 >udd>sm>ds>w>ml>probe_operate_.pl1 1251 1 10/27/88 1439.2 probe_info.incl.pl1 >ldd>incl>probe_info.incl.pl1 1253 2 11/26/79 1420.6 probe_tokens.incl.pl1 >ldd>incl>probe_tokens.incl.pl1 1255 3 11/11/88 1701.5 probe_references.incl.pl1 >ldd>incl>probe_references.incl.pl1 1257 4 11/26/79 1420.6 probe_source_info.incl.pl1 >ldd>incl>probe_source_info.incl.pl1 1259 5 10/26/88 1355.5 std_descriptor_types.incl.pl1 >ldd>incl>std_descriptor_types.incl.pl1 1261 6 11/12/86 1848.0 data_type_info_.incl.pl1 >ldd>incl>data_type_info_.incl.pl1 1263 7 10/26/88 1355.5 probe_lang_types.incl.pl1 >ldd>incl>probe_lang_types.incl.pl1 1265 8 07/11/79 1811.3 encoded_precision.incl.pl1 >ldd>incl>encoded_precision.incl.pl1 1267 9 11/01/79 1712.9 computational_data.incl.pl1 >ldd>incl>computational_data.incl.pl1 1269 10 11/26/79 1420.6 runtime_symbol.incl.pl1 >ldd>incl>runtime_symbol.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. C_lang_type constant fixed bin(17,0) initial dcl 7-17 ref 580 687 782 MAX_GENFD_WORDS constant fixed bin(17,0) initial dcl 92 ref 292 850 PASCAL_lang_type constant fixed bin(17,0) initial dcl 7-17 ref 226 767 P_code parameter fixed bin(35,0) dcl 80 set ref 220 224* 308* 310 363* 382 757* 928* 930 1035* 1037 1072* 1074 1111* 1113 1164* 1173* P_dtype parameter fixed bin(17,0) dcl 1227 ref 1224 1231 1232 1233 1234 1239 P_first parameter structure level 1 dcl 80 set ref 220 273* 382 759 P_opcode parameter char(1) dcl 80 set ref 220 245 316 319 347* 382 434 434 537 547 659 664 811 811 818 905 905 935 979 1024 1102 P_probe_info_ptr parameter pointer dcl 80 ref 220 223 382 756 P_result parameter structure level 1 dcl 80 set ref 220 362* 382 P_second parameter structure level 1 dcl 80 ref 382 760 P_size_in_words parameter fixed bin(17,0) dcl 1184 ref 1181 1188 1188 abs builtin function dcl 206 ref 887 add_bit_offset 000570 automatic fixed bin(5,0) dcl 398 set ref 521* 539* 539 541 542 544* 544 549* 549 551 553* 553 557 add_word_offset 000567 automatic fixed bin(17,0) dcl 397 set ref 520* 538* 538 542* 542 548* 548 552* 552 556 addr builtin function dcl 206 ref 308 308 308 308 363 363 363 363 479 485 928 928 928 928 1035 1035 1035 1035 1072 1072 1072 1072 1111 1111 1111 1111 1164 1164 1164 1164 addrel builtin function dcl 206 ref 470 473 address 000120 automatic pointer array level 2 in structure "intermediate" dcl 97 in procedure "probe_operate_" set ref 306* 892* address parameter pointer level 2 in structure "comp" dcl 1199 in procedure "setup_structure" set ref 1202* address 000140 automatic pointer level 2 in structure "result" dcl 98 in procedure "probe_operate_" set ref 895* address_ptr 4 000150 automatic pointer array level 2 in structure "operand" dcl 100 in procedure "probe_operate_" set ref 468 496 592 603 608 614 625 693 699 702 714 717 720 859* address_ptr 4 parameter pointer level 2 in structure "P_first" dcl 80 in procedure "probe_operate_" set ref 248 275* address_ptr 4 based pointer level 2 in structure "reference_node" dcl 3-16 in procedure "probe_operate_" ref 491 address_ptr 4 parameter pointer level 2 in structure "P_result" dcl 80 in procedure "probe_operate_" set ref 248* 360* 534* 535 538 539 548 549 556 557 591* 592 600* 603 608 613* 614 655 659 659 664 664 697* 750 855* 895 address_ptr 4 parameter pointer level 2 in structure "ref" dcl 1198 in procedure "setup_structure" ref 1202 alloc_size 000526 automatic fixed bin(17,0) dcl 149 set ref 292* 293* 293 300* 305* 360* 850* 851* 851 854* 855* 892* an_encoded_precision 000512 automatic structure level 1 dcl 128 set ref 1168 an_encoded_value 001114 automatic structure level 1 packed packed unaligned dcl 1200 set ref 1208* arithmetic 0(01) 000054 external static bit(1) array level 2 packed packed unaligned dcl 6-23 ref 245 263 789 874 1206 1231 arithmetic_attributes 0(02) 000054 external static structure array level 2 packed packed unaligned dcl 6-23 assign_$computational_ 000022 constant entry external dcl 172 ref 308 363 928 1035 1072 1111 1164 based_bit based bit packed unaligned dcl 1185 ref 1188 based_int based fixed bin(35,0) dcl 405 ref 491 based_ptr based pointer dcl 404 set ref 468 535* binary 0(01) 001124 automatic bit(1) level 2 in structure "d_type_bits" packed packed unaligned dcl 1229 in procedure "compute_type_bits" set ref 1233* 1239* 1242* binary 0(01) 000460 automatic bit(1) level 2 in structure "type_bits" packed packed unaligned dcl 103 in procedure "probe_operate_" set ref 275 329 881 947 991 1052 1080 1129 bit_18 based bit(18) array packed unaligned dcl 573 set ref 603* 603 bit_36 based bit(36) packed unaligned dcl 574 set ref 608* 608 bit_72 based bit(72) packed unaligned dcl 575 set ref 614* 614 655* 659* 659 664* 664 bit_9 based bit(9) array packed unaligned dcl 572 set ref 592* 592 bit_offset 1(21) based fixed bin(5,0) level 2 packed packed unaligned dcl 407 set ref 539 549 557* bit_string 0(11) 000054 external static bit(1) array level 2 packed packed unaligned dcl 6-23 ref 1239 block_ptr 4 based pointer level 2 dcl 4-5 set ref 368* 525* 645* 735* 840* c_symbol_ptr 127 000150 automatic pointer array level 2 packed packed unaligned dcl 100 set ref 454 465 c_typeref_dtype constant fixed bin(17,0) initial dcl 5-25 ref 472 ceil builtin function dcl 206 ref 884 887 char_dtype constant fixed bin(17,0) initial dcl 5-25 ref 589 char_string 0(10) 000054 external static bit(1) array level 2 packed packed unaligned dcl 6-23 ref 874 881 code 000577 automatic fixed bin(35,0) dcl 421 set ref 487* common_info 000462 automatic structure array level 1 unaligned dcl 112 comp parameter structure level 1 dcl 1199 set ref 1195 complex 0(02) 001124 automatic bit(1) level 2 in structure "d_type_bits" packed packed unaligned dcl 1229 in procedure "compute_type_bits" set ref 1234* 1243* complex 0(02) 000460 automatic bit(1) level 2 in structure "type_bits" packed packed unaligned dcl 103 in procedure "probe_operate_" set ref 329 335 338 342 947 956 963 971 991 1000 1007 1015 1052 1060 1080 1088 1129 1138 1145 1153 complex 0(03) 000054 external static bit(1) array level 3 in structure "data_type_info_$info" packed packed unaligned dcl 6-23 in procedure "probe_operate_" ref 266 792 1234 computational 000054 external static bit(1) array level 2 packed packed unaligned dcl 6-23 ref 238 782 computational_data based structure level 1 dcl 9-8 constant based structure level 1 dcl 2-27 in procedure "probe_operate_" constant 116(01) parameter bit(1) level 3 in structure "P_result" packed packed unaligned dcl 80 in procedure "probe_operate_" set ref 375* 532* 652* 742* 847* cplx_fix_bin_2_dtype constant fixed bin(17,0) initial dcl 5-25 ref 112 cplx_fix_dec_9bit_ls_dtype constant fixed bin(17,0) initial dcl 5-25 ref 112 cplx_flt_bin_2_dtype constant fixed bin(17,0) initial dcl 5-25 ref 112 cplx_flt_dec_9bit_dtype constant fixed bin(17,0) initial dcl 5-25 ref 112 cplx_flt_dec_generic_dtype constant fixed bin(17,0) initial dcl 5-25 ref 268 794 cplx_gen_decimal_struc based structure level 1 dcl 137 set ref 320* 320* 936* 936* 936* 980* 980* 980* 1041* 1041* 1041* 1118* 1118* 1118* d_type_bits 001124 automatic structure level 1 dcl 1229 set ref 1246 data_type 2 000100 automatic fixed bin(17,0) array level 2 in structure "source" dcl 96 in procedure "probe_operate_" set ref 874 874 881 881 data_type 2 000120 automatic fixed bin(17,0) array level 2 in structure "intermediate" dcl 97 in procedure "probe_operate_" set ref 289* 297* 868* 872* data_type 2 parameter fixed bin(17,0) level 2 in structure "comp" dcl 1199 in procedure "setup_structure" set ref 1203* data_type 2 000140 automatic fixed bin(17,0) level 2 in structure "result" dcl 98 in procedure "probe_operate_" set ref 896* data_type_info_$info 000054 external static structure array level 1 dcl 6-23 ref 231 231 773 773 data_type_info_$max_decimal_precision 000056 external static fixed bin(17,0) dcl 6-48 ref 290 352 834 869 874 913 1026 1103 data_type_info_$max_fixed_binary_precision 000060 external static fixed bin(17,0) dcl 6-50 ref 878 data_value 000560 automatic fixed bin(17,0) array dcl 393 in procedure "c_pointer_arithmetic" set ref 441* 498* 501* 504* 514 517 data_value 001055 automatic fixed bin(17,0) dcl 567 in procedure "c_shift_arithmetic" set ref 628* 631* 634* 654 659 659 659 664 664 dec_string based char(32) packed unaligned dcl 402 in procedure "c_pointer_arithmetic" ref 504 dec_string based char(32) packed unaligned dcl 571 in procedure "c_shift_arithmetic" ref 634 dec_string based char(32) packed unaligned dcl 683 in procedure "c_mod_arithmetic" ref 705 723 decimal 0(04) 000054 external static bit(1) array level 3 packed packed unaligned dcl 6-23 ref 859 881 1233 descriptor 114 parameter fixed bin(35,0) level 2 in structure "P_result" dcl 80 in procedure "probe_operate_" set ref 250* 355* 523* 642* 732* 837* descriptor 114 parameter fixed bin(35,0) level 2 in structure "P_first" dcl 80 in procedure "probe_operate_" set ref 250 divide builtin function dcl 206 ref 520 542 1129 1135 1138 1142 1145 1150 1153 1157 dp 000520 automatic pointer dcl 146 set ref 305* 306 320 320 326 326 329 329 334 334 335 335 337 337 338 338 341 341 342 342 344 344 encoded_precision based structure level 1 dcl 8-8 entry_ptr 10 based pointer level 2 dcl 4-5 set ref 368* 525* 645* 735* 840* expression_area based area(1024) dcl 1-95 ref 1188 expression_area_ptr 63 based pointer level 3 packed packed unaligned dcl 1-18 ref 1188 fixed 0(02) 000054 external static bit(1) array level 3 in structure "data_type_info_$info" packed packed unaligned dcl 6-23 in procedure "probe_operate_" ref 1232 fixed builtin function dcl 206 in procedure "probe_operate_" ref 258 470 472 473 498 501 504 521 544 628 631 634 702 705 720 723 831 fixed_bin_complex based complex fixed bin(71,0) dcl 154 set ref 335* 335 956* 956 956 1000* 1000 1000 1080* 1080 1080 1138* 1138 1138 fixed_bin_long based fixed bin(71,0) dcl 401 in procedure "c_pointer_arithmetic" ref 501 fixed_bin_long based fixed bin(71,0) dcl 570 in procedure "c_shift_arithmetic" ref 631 fixed_bin_long based fixed bin(71,0) dcl 682 in procedure "c_mod_arithmetic" ref 702 720 fixed_bin_real based fixed bin(71,0) dcl 152 set ref 337* 337 960* 960 960 1004* 1004 1004 1085* 1085 1085 1142* 1142 1142 fixed_bin_short based fixed bin(17,0) dcl 400 in procedure "c_pointer_arithmetic" ref 498 fixed_bin_short based fixed bin(35,0) dcl 681 in procedure "c_mod_arithmetic" set ref 699 717 750* fixed_bin_short based fixed bin(17,0) dcl 569 in procedure "c_shift_arithmetic" ref 628 fixed_dec_complex based complex fixed dec(59,0) dcl 158 set ref 342* 342 971* 971 971 1015* 1015 1015 1088* 1088 1088 1153* 1153 1153 fixed_dec_real based fixed dec(59,0) dcl 157 set ref 344* 344 975* 975 975 1019* 1019 1019 1092* 1092 1092 1157* 1157 1157 flags 3 parameter structure level 2 in structure "comp" dcl 1199 in procedure "setup_structure" set ref 1204* flags 3 000140 automatic structure level 2 in structure "result" dcl 98 in procedure "probe_operate_" set ref 897* flags 116 parameter structure level 2 in structure "ref" dcl 1198 in procedure "setup_structure" flags 116 parameter structure level 2 in structure "P_result" dcl 80 in procedure "probe_operate_" set ref 374* 531* 651* 741* 846* float 001124 automatic bit(1) level 2 in structure "d_type_bits" packed packed unaligned dcl 1229 in procedure "compute_type_bits" set ref 1232* 1238* float 000460 automatic bit(1) level 2 in structure "type_bits" packed packed unaligned dcl 103 in procedure "probe_operate_" set ref 329 338 947 963 991 1007 1030 1129 1145 float_bin_complex based complex float bin(63) dcl 156 set ref 329* 329 947* 947 947 991* 991 991 1052* 1052 1052 1129* 1129 1129 float_bin_real based float bin(63) dcl 155 set ref 334* 334 953* 953 953 997* 997 997 1057* 1057 1057 1135* 1135 1135 float_dec_complex based complex float dec(59) dcl 160 set ref 338* 338 963* 963 963 1007* 1007 1007 1060* 1060 1060 1145* 1145 1145 float_dec_real based float dec(59) dcl 159 set ref 341* 341 968* 968 968 1012* 1012 1012 1064* 1064 1064 1150* 1150 1150 gen_decimal_struc based structure level 1 dcl 132 set ref 326* 326* 943* 943* 943* 987* 987* 987* 1048* 1048* 1048* 1125* 1125* 1125* generic_math_$add_decimal 000024 constant entry external dcl 174 ref 943 generic_math_$add_decimal_complex 000034 constant entry external dcl 184 ref 936 generic_math_$divide_decimal 000026 constant entry external dcl 174 ref 1125 generic_math_$divide_decimal_complex 000036 constant entry external dcl 184 ref 1118 generic_math_$multiply_decimal 000030 constant entry external dcl 174 ref 1048 generic_math_$multiply_decimal_complex 000040 constant entry external dcl 184 ref 1041 generic_math_$negate_decimal 000044 constant entry external dcl 194 ref 326 generic_math_$negate_decimal_complex 000046 constant entry external dcl 197 ref 320 generic_math_$subtract_decimal 000032 constant entry external dcl 174 ref 987 generic_math_$subtract_decimal_complex 000042 constant entry external dcl 184 ref 980 genfd_type 000516 automatic fixed bin(17,0) dcl 144 set ref 268* 270* 289 351 794* 796* 833 868 hbound builtin function dcl 206 ref 231 773 hex 0(14) 000054 external static bit(1) array level 2 packed packed unaligned dcl 6-23 ref 263 789 i 000552 automatic fixed bin(17,0) dcl 390 in procedure "c_pointer_arithmetic" set ref 444* 445 453 454 454 462 462 465 468 476 491 496 497 498 501 504 504* i 000527 automatic fixed bin(17,0) dcl 149 in procedure "probe_operate_" set ref 766* 767 767 767 767 773 773 775 782 784 789 789 792* 856* 858 858 859 859 859 859 862 868 869 872 874 874 874 878 881 881 884 884 887 887 887 892 892* 927* 928 928 928 928* 1034* 1035 1035 1035 1035* 1070* 1071 1071 1072 1072 1072 1072* 1110* 1111 1111 1111 1111* intermediate 000120 automatic structure array level 1 dcl 97 set ref 287* 308 308 363 363 928 928 1035 1035 1072 1072 1111 1111 1164 1164 its based structure level 1 dcl 407 language_type 21 based fixed bin(17,0) level 3 dcl 1-18 ref 226 580 687 767 782 lbound builtin function dcl 206 ref 231 773 max builtin function dcl 206 ref 915 915 919 925 min builtin function dcl 206 ref 884 915 1095 mod builtin function dcl 685 in procedure "c_mod_arithmetic" ref 750 mod builtin function dcl 206 in procedure "probe_operate_" ref 521 544 mod_bits 001060 automatic fixed bin(17,0) dcl 578 set ref 590* 602* 607* 615* 654 655 655 659 659 664 664 multiply builtin function dcl 206 ref 514 517 n_subscripts 122 based fixed bin(17,0) level 3 dcl 3-16 set ref 484* 489* name 12 parameter varying char(256) level 2 in structure "P_first" dcl 80 in procedure "probe_operate_" set ref 233* 239* 280* name 12 000150 automatic varying char(256) array level 2 in structure "operand" dcl 100 in procedure "probe_operate_" set ref 775* 784* 862* name 12 based varying char(256) level 2 in structure "reference_node" dcl 3-16 in procedure "probe_operate_" set ref 481* name 12 parameter varying char(256) level 2 in structure "P_result" dcl 80 in procedure "probe_operate_" set ref 373* 530* 650* 740* 845* null builtin function dcl 206 ref 303 367 368 368 443 454 454 462 525 525 644 645 645 734 735 735 839 840 840 1218 offset 1 based fixed bin(17,0) level 2 packed packed unaligned dcl 407 set ref 538 548 556* op 000522 automatic pointer array dcl 147 set ref 892* 936 936 936 943 943 943 947 947 947 953 953 953 956 956 956 960 960 960 963 963 963 968 968 968 971 971 971 975 975 975 980 980 980 987 987 987 991 991 991 997 997 997 1000 1000 1000 1004 1004 1004 1007 1007 1007 1012 1012 1012 1015 1015 1015 1019 1019 1019 1041 1041 1041 1048 1048 1048 1052 1052 1052 1057 1057 1057 1060 1060 1060 1064 1064 1064 1080 1080 1080 1085 1085 1085 1088 1088 1088 1092 1092 1092 1118 1118 1118 1125 1125 1125 1129 1129 1129 1135 1135 1135 1138 1138 1138 1142 1142 1142 1145 1145 1145 1150 1150 1150 1153 1153 1153 1157 1157 1157 op1 001074 automatic fixed bin(35,0) dcl 684 set ref 699* 702* 705* 750 op2 001075 automatic fixed bin(35,0) dcl 684 set ref 717* 720* 723* 744 750 op_addr 001072 automatic pointer dcl 680 in procedure "c_mod_arithmetic" set ref 693* 705 714* 723 op_addr 001056 automatic pointer dcl 568 in procedure "c_shift_arithmetic" set ref 625* 628 631 634 op_addr 000564 automatic pointer dcl 395 in procedure "c_pointer_arithmetic" set ref 496* 498 501 504 operand 000150 automatic structure array level 1 dcl 100 set ref 476 759* 760* 858* optional_info 117 based structure level 2 dcl 3-16 packed 116 parameter bit(1) level 3 in structure "ref" packed packed unaligned dcl 1198 in procedure "setup_structure" ref 1205 packed 3 parameter bit(1) level 3 in structure "comp" packed packed unaligned dcl 1199 in procedure "setup_structure" set ref 1205* picture_image_ptr 6 000120 automatic pointer array level 2 in structure "intermediate" dcl 97 in procedure "probe_operate_" set ref 303* picture_image_ptr 6 parameter pointer level 2 in structure "comp" dcl 1199 in procedure "setup_structure" set ref 1216* 1218* picture_runtime_dtype constant fixed bin(17,0) initial dcl 5-125 ref 1216 pointer builtin function dcl 206 ref 1216 pointer_dtype constant fixed bin(17,0) initial dcl 5-25 ref 445 512 803 803 pointer_encountered 000576 automatic bit(1) packed unaligned dcl 420 set ref 442* 446 452* prec 0(18) 001114 automatic fixed bin(18,0) level 2 in structure "an_encoded_value" packed packed unsigned unaligned dcl 1200 in procedure "setup_structure" set ref 1209 prec 0(18) 000512 automatic fixed bin(18,0) level 2 in structure "an_encoded_precision" packed packed unsigned unaligned dcl 128 in procedure "probe_operate_" set ref 1166* prec_array 1 000462 automatic fixed bin(17,0) initial array level 2 dcl 112 set ref 112* 112* 112* 112* 112* 112* 112* 112* 298 884 915 922 1028 1095 1105 prec_or_length 4 000120 automatic fixed bin(24,0) array level 2 in structure "intermediate" dcl 97 in procedure "probe_operate_" set ref 290* 298* 869* 874* 878* 884* 884 922* 1031* 1069* 1106* prec_or_length 4 parameter fixed bin(24,0) level 2 in structure "comp" dcl 1199 in procedure "setup_structure" set ref 1209* 1213* prec_or_length 4 000100 automatic fixed bin(24,0) array level 2 in structure "source" dcl 96 in procedure "probe_operate_" set ref 275 859 915 915 1095 1095 prec_or_length 4 000140 automatic fixed bin(24,0) level 2 in structure "result" dcl 98 in procedure "probe_operate_" set ref 913* 915* 1031* 1095* 1106* 1166 precision 115 parameter fixed bin(35,0) level 2 in structure "P_result" dcl 80 in procedure "probe_operate_" set ref 251* 352* 834* 1031* 1106* 1168* precision 115 parameter fixed bin(35,0) level 2 in structure "ref" dcl 1198 in procedure "setup_structure" ref 1208 1213 1216 precision 115 parameter fixed bin(35,0) level 2 in structure "P_first" dcl 80 in procedure "probe_operate_" set ref 251 precision 115 000150 automatic fixed bin(35,0) array level 2 in structure "operand" dcl 100 in procedure "probe_operate_" set ref 504 601 634 705 723 probe_area_info 56 based structure level 2 dcl 1-18 probe_builtins_$sizeof_builtin 000064 constant entry external dcl 424 ref 487 probe_create_reference_ 000062 constant entry external dcl 422 ref 480 probe_error_$malfunction 000050 constant entry external dcl 201 ref 41 347 probe_error_$record 000052 constant entry external dcl 201 ref 233 239 280 435 447 456 581 620 688 710 728 745 775 784 862 probe_et_$bad_decimal 000012 external static fixed bin(35,0) dcl 162 set ref 280* 862* probe_et_$bad_operand 000010 external static fixed bin(35,0) dcl 162 set ref 233* 239* 775* 784* probe_et_$recorded_message 000014 external static fixed bin(35,0) dcl 162 ref 1173 probe_info based structure level 1 dcl 1-18 probe_info_ptr 000532 automatic pointer dcl 1-86 set ref 223* 226 233* 239* 280* 347* 435* 447* 456* 480* 487* 580 581* 620* 687 688* 710* 728* 745* 756* 767 775* 782 784* 862* 1188 probe_pascal_$real_type 000016 constant entry external dcl 167 ref 226 767 ptr 000744 automatic pointer array level 2 dcl 426 set ref 479* random_info 17 based structure level 2 dcl 1-18 real_fix_bin_1_dtype 006021 constant fixed bin(17,0) initial dcl 5-25 ref 498 598 628 696 699 717 real_fix_bin_2_dtype 006020 constant fixed bin(17,0) initial dcl 5-25 ref 112 501 631 702 720 real_fix_dec_9bit_ls_dtype constant fixed bin(17,0) initial dcl 5-25 ref 112 504 634 705 723 real_flt_bin_1_dtype 006017 constant fixed bin(17,0) initial dcl 5-25 ref 598 real_flt_bin_2_dtype 006016 constant fixed bin(17,0) initial dcl 5-25 ref 112 597 real_flt_dec_9bit_dtype constant fixed bin(17,0) initial dcl 5-25 ref 112 real_flt_dec_generic_dtype constant fixed bin(17,0) initial dcl 5-25 ref 270 796 ref parameter structure level 1 dcl 1198 ref 1195 reference_node based structure level 1 dcl 3-16 result 000140 automatic structure level 1 dcl 98 set ref 362* 363 363 1164 1164 result_ptr 001104 automatic pointer dcl 1186 set ref 1188* 1189 runtime_symbol based structure level 1 dcl 10-3 scale 5 000120 automatic fixed bin(35,0) array level 2 in structure "intermediate" dcl 97 in procedure "probe_operate_" set ref 302* 887* 887 887 925* 1033* 1071* 1108* scale 5 parameter fixed bin(35,0) level 2 in structure "comp" dcl 1199 in procedure "setup_structure" set ref 1210* 1214* scale 001114 automatic fixed bin(17,0) level 2 in structure "an_encoded_value" packed packed unaligned dcl 1200 in procedure "setup_structure" set ref 1210 scale 5 000100 automatic fixed bin(35,0) array level 2 in structure "source" dcl 96 in procedure "probe_operate_" set ref 302 915 915 915 915 919 919 925 925 1071 1097 1097 scale 5 000140 automatic fixed bin(35,0) level 2 in structure "result" dcl 98 in procedure "probe_operate_" set ref 919* 1033* 1097* 1108* 1167 scale 000512 automatic fixed bin(17,0) level 2 in structure "an_encoded_precision" packed packed unaligned dcl 128 in procedure "probe_operate_" set ref 1167* sign builtin function dcl 206 ref 887 size_array 2 000462 automatic fixed bin(17,0) initial array level 2 dcl 112 set ref 112* 112* 112* 112* 112* 112* 112* 112* 300 854 son 2(18) based bit(18) level 2 packed packed unaligned dcl 10-3 ref 470 473 source 000100 automatic structure array level 1 dcl 96 set ref 273* 308 308 858* 928 928 1035 1035 1072 1072 1111 1111 source_info based structure level 1 dcl 4-5 source_info_ptr 10 based pointer level 2 in structure "reference_node" dcl 3-16 in procedure "probe_operate_" set ref 482* source_info_ptr 10 parameter pointer level 2 in structure "P_result" dcl 80 in procedure "probe_operate_" set ref 368 368 368 368 525 525 525 525 645 645 645 645 735 735 735 735 840 840 840 840 source_info_ptr 10 000600 automatic pointer level 2 in structure "temp_ref" dcl 423 in procedure "c_pointer_arithmetic" set ref 482 stack_ptr 6 based pointer level 2 dcl 4-5 set ref 368* 525* 645* 735* 840* stored_addr 000574 automatic pointer dcl 403 set ref 468* 535 string builtin function dcl 206 set ref 258 829* 829 829 831 1204* sub_refs 000744 automatic structure level 1 dcl 426 set ref 485 subscript_reference_ptrs based structure level 1 dcl 3-69 subscript_refs_ptr 124 based pointer level 2 packed packed unaligned dcl 3-16 set ref 485* substr builtin function dcl 206 set ref 504 634 655* 655 659* 659 659 664* 664 664 705 723 symbol_ptr parameter pointer level 2 in structure "P_result" dcl 80 in procedure "probe_operate_" set ref 367* 443* 453* 644* 734* 839* symbol_ptr 000600 automatic pointer level 2 in structure "temp_ref" dcl 423 in procedure "c_pointer_arithmetic" set ref 477* symbol_ptr 000150 automatic pointer array level 2 in structure "operand" dcl 100 in procedure "probe_operate_" set ref 453 454 462 462 symbol_ptr parameter pointer level 2 in structure "ref" dcl 1198 in procedure "setup_structure" ref 1216 temp_node_ptr 000572 automatic pointer dcl 399 set ref 480* 481 482 484 485 487* 489 491 temp_precision 000530 automatic fixed bin(17,0) dcl 149 set ref 1026* 1028* 1031 1069 1103* 1105* 1106 temp_ref 000600 automatic structure level 1 dcl 423 set ref 476* 479 token based structure level 1 dcl 2-16 token_header based structure level 1 dcl 2-4 total_bits 000556 automatic fixed bin(17,0) array dcl 392 set ref 440* 491* 514 514 517 total_bits_to_add 000566 automatic fixed bin(24,0) dcl 396 set ref 514* 517* 520 521 tp 000554 automatic pointer dcl 391 set ref 462* 465* 470* 470 470 472 473* 473 473 477 tp_type 000562 automatic fixed bin(17,0) dcl 394 in procedure "c_pointer_arithmetic" set ref 497* 498 501 504 tp_type 001054 automatic fixed bin(17,0) dcl 567 in procedure "c_shift_arithmetic" set ref 586* 589 597 598 598 626* 628 631 634 tp_type 001070 automatic fixed bin(17,0) dcl 679 in procedure "c_mod_arithmetic" set ref 694* 699 702 705 715* 717 720 723 type 113 parameter fixed bin(35,0) level 2 in structure "P_second" dcl 80 in procedure "probe_operate_" ref 827 type 0(06) based bit(6) level 2 in structure "runtime_symbol" packed packed unaligned dcl 10-3 in procedure "probe_operate_" ref 472 type 113 parameter fixed bin(35,0) level 2 in structure "P_first" dcl 80 in procedure "probe_operate_" set ref 226* 226* 231 231 238 245 249 257 263 263 266 275 826 type 113 000150 automatic fixed bin(35,0) array level 2 in structure "operand" dcl 100 in procedure "probe_operate_" set ref 445 497 586 626 640 694 715 767* 767* 773 773 782 789 789 792 803 803 859 859 type 113 parameter fixed bin(35,0) level 2 in structure "ref" dcl 1198 in procedure "setup_structure" ref 1203 1206 1216 type 113 parameter fixed bin(35,0) level 2 in structure "P_result" dcl 80 in procedure "probe_operate_" set ref 249* 351* 354* 355 512* 523 640* 642 696* 732 833* 836* 837 896 type_array 000462 automatic fixed bin(17,0) initial array level 2 dcl 112 set ref 112* 112* 112* 112* 112* 112* 112* 112* 297 354 836 872 type_bits 000460 automatic structure level 1 dcl 103 set ref 257* 258 826* 829* 829 831 type_bits_copy 000513 automatic structure level 1 dcl 130 set ref 827* 829 type_ptr 2 parameter pointer level 2 in structure "P_first" dcl 80 in procedure "probe_operate_" set ref 226* 226* type_ptr 2 000150 automatic pointer array level 2 in structure "operand" dcl 100 in procedure "probe_operate_" set ref 767* 767* type_type 000461 automatic fixed bin(17,0) dcl 110 set ref 258* 297 298 300 354 831* 836 854 872 884 915 922 1028 1095 1105 unspec builtin function dcl 206 set ref 287* 1168* 1168 1208* 1208 use_genfd_complex_sw 000515 automatic bit(1) packed unaligned dcl 142 set ref 262* 267* 293 320 764* 793* 796 851 936 980 1041 1118 use_genfd_sw 000514 automatic bit(1) packed unaligned dcl 142 set ref 262* 265* 275 288 320 350 764* 791* 832 849 867 881 913 922 936 980 1026 1041 1103 1118 valid_decimal_ 000020 constant entry external dcl 170 ref 275 859 zeros 000000 constant bit(72) initial packed unaligned dcl 576 ref 655 659 664 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ALGOL68_lang_type internal static fixed bin(17,0) initial dcl 7-17 ALM_lang_type internal static fixed bin(17,0) initial dcl 7-17 COBOL_lang_type internal static fixed bin(17,0) initial dcl 7-17 CONSTANT_TYPE internal static bit(18) initial packed unaligned dcl 2-37 FORTRAN_lang_type internal static fixed bin(17,0) initial dcl 7-17 NAME_TYPE internal static bit(18) initial packed unaligned dcl 2-37 OPERATOR_TYPE internal static bit(18) initial packed unaligned dcl 2-37 OTHER_lang_type internal static fixed bin(17,0) initial dcl 7-17 PL1_lang_type internal static fixed bin(17,0) initial dcl 7-17 UNKNOWN_lang_type internal static fixed bin(17,0) initial dcl 7-17 algol68_array_descriptor_dtype internal static fixed bin(17,0) initial dcl 5-25 algol68_bits_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_bool_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_byte_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_char_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_compl_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_format_dtype internal static fixed bin(17,0) initial dcl 5-25 algol68_int_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_long_compl_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_long_int_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_long_real_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_real_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_short_int_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_straight_dtype internal static fixed bin(17,0) initial dcl 5-25 algol68_struct_struct_bool_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_struct_struct_char_dtype internal static fixed bin(17,0) initial dcl 5-110 algol68_union_dtype internal static fixed bin(17,0) initial dcl 5-25 area_dtype internal static fixed bin(17,0) initial dcl 5-25 bit_dtype internal static fixed bin(17,0) initial dcl 5-25 c_enum_const_dtype internal static fixed bin(17,0) initial dcl 5-25 c_enum_dtype internal static fixed bin(17,0) initial dcl 5-25 c_union_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_char_string_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_comp_5_ts_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_comp_5_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_comp_6_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_comp_7_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_comp_8_ls_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_comp_8_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_display_ls_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_display_ls_overp_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_display_ts_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_display_ts_overp_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_display_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 cobol_structure_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_fix_bin_1_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_fix_dec_4bit_bytealigned_ls_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_bin_1_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_bin_generic_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_dec_4bit_bytealigned_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_dec_extended_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_hex_1_dtype internal static fixed bin(17,0) initial dcl 5-25 cplx_flt_hex_2_dtype internal static fixed bin(17,0) initial dcl 5-25 current_constant based structure level 1 dcl 2-44 current_identifier_name based char packed unaligned dcl 2-42 current_source based structure level 1 dcl 4-13 current_token based structure level 1 dcl 2-45 data_type_info_$max_float_binary_precision external static fixed bin(17,0) dcl 6-49 data_type_info_$ninebit_digit_chars external static char(10) packed unaligned dcl 6-45 data_type_info_$ninebit_overpunched_sign_chars external static char(22) packed unaligned dcl 6-46 data_type_info_$ninebit_sign_chars external static char(2) packed unaligned dcl 6-44 data_type_info_$version_number external static fixed bin(17,0) dcl 6-20 data_type_info_this_version internal static fixed bin(17,0) initial dcl 6-21 encoded_value based structure level 1 dcl 10-70 entry_dtype internal static fixed bin(17,0) initial dcl 5-25 ext_entry_runtime_dtype internal static fixed bin(17,0) initial dcl 5-125 ext_procedure_runtime_dtype internal static fixed bin(17,0) initial dcl 5-125 file_dtype internal static fixed bin(17,0) initial dcl 5-25 ft_char_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_complex_double_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_complex_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_double_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_external_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_hex_complex_double_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_hex_complex_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_hex_double_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_hex_real_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_integer_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_logical_dtype internal static fixed bin(17,0) initial dcl 5-96 ft_real_dtype internal static fixed bin(17,0) initial dcl 5-96 identifier based structure level 1 dcl 2-19 initial_source based structure level 1 dcl 4-14 int_entry_runtime_dtype internal static fixed bin(17,0) initial dcl 5-125 label_constant_runtime_dtype internal static fixed bin(17,0) initial dcl 5-125 label_dtype internal static fixed bin(17,0) initial dcl 5-25 official_language_names internal static char(32) initial array packed unaligned dcl 7-27 offset_dtype internal static fixed bin(17,0) initial dcl 5-25 operator based structure level 1 dcl 2-24 palatable_language_names internal static char(32) initial array packed unaligned dcl 7-30 pascal_boolean_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_char_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_entry_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_enumerated_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_enumerated_type_element_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_enumerated_type_instance_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_exportable_procedure_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_imported_procedure_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_integer_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_internal_procedure_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_label_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_parameter_procedure_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_procedure_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_real_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_record_file_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_record_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_set_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_string_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_text_file_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_typed_pointer_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_user_defined_type_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_user_defined_type_instance_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_value_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 5-132 pascal_variable_formal_parameter_dtype internal static fixed bin(17,0) initial dcl 5-132 probe_area based area(1024) dcl 1-93 probe_info_version internal static fixed bin(17,0) initial dcl 1-88 probe_info_version_1 internal static fixed bin(17,0) initial dcl 1-90 real_fix_bin_1_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_bin_2_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_4bit_bytealigned_ls_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_4bit_bytealigned_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_4bit_ls_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_4bit_ts_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_4bit_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_9bit_ls_overp_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_9bit_ts_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_9bit_ts_overp_dtype internal static fixed bin(17,0) initial dcl 5-25 real_fix_dec_9bit_uns_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_bin_generic_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_dec_4bit_bytealigned_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_dec_4bit_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_dec_extended_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_hex_1_dtype internal static fixed bin(17,0) initial dcl 5-25 real_flt_hex_2_dtype internal static fixed bin(17,0) initial dcl 5-25 reference_arg_list based structure level 1 dcl 3-59 reference_subscripts based structure level 1 dcl 3-64 runtime_block based structure level 1 dcl 10-38 runtime_bound based structure level 1 unaligned dcl 10-33 runtime_token based structure level 1 dcl 10-63 scratch_area based area(1024) dcl 1-92 structure_dtype internal static fixed bin(17,0) initial dcl 5-25 varying_bit_dtype internal static fixed bin(17,0) initial dcl 5-25 varying_char_dtype internal static fixed bin(17,0) initial dcl 5-25 work_area based area(1024) dcl 1-94 NAMES DECLARED BY EXPLICIT CONTEXT. RECORDED_MESSAGE 004035 constant label dcl 1173 ref 235 241 282 438 450 459 583 690 747 777 786 864 allocate_temp 005561 constant entry internal dcl 1181 ref 305 360 534 591 600 613 697 855 892 c_mod_arithmetic 005224 constant entry internal dcl 676 ref 819 c_pointer_arithmetic 004041 constant entry internal dcl 387 ref 805 c_shift_arithmetic 004613 constant entry internal dcl 564 ref 812 compute_type_bits 005653 constant entry internal dcl 1224 ref 257 826 827 probe_operate_ 000550 constant entry external dcl 38 probe_operate_$infix 001531 constant entry external dcl 382 probe_operate_$prefix 000571 constant entry external dcl 220 setup_structure 005601 constant entry internal dcl 1195 ref 273 362 858 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 6424 6514 6024 6434 Length 7170 6024 70 437 377 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME probe_operate_ 1295 external procedure is an external procedure. c_pointer_arithmetic internal procedure shares stack frame of external procedure probe_operate_. c_shift_arithmetic internal procedure shares stack frame of external procedure probe_operate_. c_mod_arithmetic internal procedure shares stack frame of external procedure probe_operate_. allocate_temp internal procedure shares stack frame of external procedure probe_operate_. setup_structure internal procedure shares stack frame of external procedure probe_operate_. compute_type_bits internal procedure shares stack frame of external procedure probe_operate_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME probe_operate_ 000100 source probe_operate_ 000120 intermediate probe_operate_ 000140 result probe_operate_ 000150 operand probe_operate_ 000460 type_bits probe_operate_ 000461 type_type probe_operate_ 000462 common_info probe_operate_ 000512 an_encoded_precision probe_operate_ 000513 type_bits_copy probe_operate_ 000514 use_genfd_sw probe_operate_ 000515 use_genfd_complex_sw probe_operate_ 000516 genfd_type probe_operate_ 000520 dp probe_operate_ 000522 op probe_operate_ 000526 alloc_size probe_operate_ 000527 i probe_operate_ 000530 temp_precision probe_operate_ 000532 probe_info_ptr probe_operate_ 000552 i c_pointer_arithmetic 000554 tp c_pointer_arithmetic 000556 total_bits c_pointer_arithmetic 000560 data_value c_pointer_arithmetic 000562 tp_type c_pointer_arithmetic 000564 op_addr c_pointer_arithmetic 000566 total_bits_to_add c_pointer_arithmetic 000567 add_word_offset c_pointer_arithmetic 000570 add_bit_offset c_pointer_arithmetic 000572 temp_node_ptr c_pointer_arithmetic 000574 stored_addr c_pointer_arithmetic 000576 pointer_encountered c_pointer_arithmetic 000577 code c_pointer_arithmetic 000600 temp_ref c_pointer_arithmetic 000744 sub_refs c_pointer_arithmetic 001054 tp_type c_shift_arithmetic 001055 data_value c_shift_arithmetic 001056 op_addr c_shift_arithmetic 001060 mod_bits c_shift_arithmetic 001070 tp_type c_mod_arithmetic 001072 op_addr c_mod_arithmetic 001074 op1 c_mod_arithmetic 001075 op2 c_mod_arithmetic 001104 result_ptr allocate_temp 001114 an_encoded_value setup_structure 001124 d_type_bits compute_type_bits THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_bit_temp call_ext_out_desc call_ext_out return_mac sign_mac mpfx2 mpfx3 mdfx1 shorten_stack ext_entry ceil_fx2 any_to_any_truncate_ divide_fx4 mpcdec dvcdec op_alloc_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. assign_$computational_ complex_binary_op_ generic_math_$add_decimal generic_math_$add_decimal_complex generic_math_$divide_decimal generic_math_$divide_decimal_complex generic_math_$multiply_decimal generic_math_$multiply_decimal_complex generic_math_$negate_decimal generic_math_$negate_decimal_complex generic_math_$subtract_decimal generic_math_$subtract_decimal_complex probe_builtins_$sizeof_builtin probe_create_reference_ probe_error_$malfunction probe_error_$record probe_pascal_$real_type valid_decimal_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. data_type_info_$info data_type_info_$max_decimal_precision data_type_info_$max_fixed_binary_precision probe_et_$bad_decimal probe_et_$bad_operand probe_et_$recorded_message LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 112 000317 38 000547 41 000556 220 000563 223 000604 224 000610 226 000611 231 000632 233 000641 235 000662 238 000663 239 000670 241 000710 245 000711 248 000720 249 000723 250 000725 251 000727 252 000731 257 000732 258 000740 262 000743 263 000745 265 000756 266 000760 267 000763 268 000765 269 000767 270 000770 273 000772 275 001002 280 001035 282 001060 287 001061 288 001064 289 001066 290 001070 292 001073 293 001075 295 001101 297 001102 298 001107 300 001111 302 001113 303 001115 305 001117 306 001121 308 001123 310 001142 316 001144 319 001153 320 001155 326 001173 329 001205 334 001235 335 001241 337 001263 338 001266 341 001304 342 001311 344 001324 345 001330 347 001331 350 001362 351 001364 352 001367 353 001372 354 001373 355 001400 360 001403 362 001413 363 001423 367 001442 368 001444 373 001457 374 001464 375 001520 377 001522 382 001523 756 001544 757 001550 759 001551 760 001555 764 001561 766 001563 767 001571 773 001614 775 001624 777 001646 782 001647 784 001660 786 001701 789 001702 791 001710 792 001712 793 001715 794 001717 795 001721 796 001722 799 001726 803 001730 805 001736 806 001737 811 001740 812 001750 813 001751 818 001752 819 001754 820 001755 826 001756 827 001765 829 001775 831 002000 832 002003 833 002005 834 002010 835 002013 836 002014 837 002020 839 002023 840 002025 845 002037 846 002044 847 002100 849 002102 850 002104 851 002106 853 002112 854 002113 855 002117 856 002127 858 002135 859 002151 862 002210 864 002232 867 002233 868 002235 869 002242 871 002245 872 002246 874 002255 878 002275 881 002300 884 002310 887 002325 892 002341 893 002352 895 002354 896 002357 897 002362 905 002366 913 002376 915 002404 919 002443 922 002450 925 002471 927 002511 928 002517 930 002537 933 002541 935 002543 936 002551 943 002571 947 002605 953 002640 956 002644 960 002671 963 002675 968 002714 971 002722 975 002736 977 002743 979 002744 980 002746 987 002766 991 003002 997 003035 1000 003041 1004 003066 1007 003072 1012 003111 1015 003117 1019 003133 1022 003140 1024 003141 1026 003143 1028 003151 1030 003155 1031 003160 1033 003177 1034 003211 1035 003217 1037 003237 1040 003241 1041 003243 1048 003263 1052 003277 1057 003327 1060 003333 1064 003344 1066 003351 1069 003352 1070 003365 1071 003373 1072 003377 1074 003416 1077 003420 1080 003422 1085 003452 1088 003457 1092 003470 1095 003475 1097 003507 1100 003513 1102 003514 1103 003516 1105 003524 1106 003530 1108 003550 1110 003562 1111 003567 1113 003607 1116 003611 1118 003613 1125 003633 1129 003647 1135 003702 1138 003706 1142 003733 1145 003741 1150 003755 1153 003767 1157 004000 1164 004005 1166 004024 1167 004026 1168 004031 1170 004034 1173 004035 1176 004040 387 004041 434 004042 435 004052 438 004077 440 004100 441 004110 442 004120 443 004121 444 004123 445 004131 446 004136 447 004140 450 004165 452 004166 453 004170 454 004173 456 004202 459 004227 462 004230 465 004237 468 004241 470 004244 472 004250 473 004260 474 004265 476 004266 477 004274 479 004276 480 004300 481 004311 482 004317 484 004321 485 004323 487 004325 489 004341 491 004343 494 004347 496 004350 497 004353 498 004354 501 004362 504 004370 510 004410 512 004412 514 004415 517 004423 520 004425 521 004427 523 004433 525 004436 530 004451 531 004456 532 004512 534 004514 535 004526 537 004531 538 004537 539 004543 541 004547 542 004552 544 004554 546 004560 547 004561 548 004563 549 004567 551 004573 552 004575 553 004577 556 004601 557 004605 559 004612 564 004613 580 004614 581 004620 583 004645 586 004646 589 004650 590 004652 591 004654 592 004667 594 004675 597 004676 598 004700 600 004704 601 004717 602 004722 603 004724 605 004732 607 004733 608 004735 611 004743 613 004744 614 004757 615 004765 617 004767 620 004770 625 005015 626 005017 628 005021 631 005026 634 005033 640 005051 642 005054 644 005056 645 005060 650 005072 651 005077 652 005133 654 005135 655 005140 657 005145 659 005146 664 005176 672 005222 676 005224 687 005225 688 005231 690 005256 693 005257 694 005261 696 005263 697 005266 699 005300 702 005306 705 005313 710 005332 714 005357 715 005361 717 005363 720 005370 723 005375 728 005414 732 005441 734 005445 735 005447 740 005461 741 005466 742 005522 744 005524 745 005526 747 005553 750 005554 752 005560 1181 005561 1188 005563 1189 005576 1195 005601 1202 005603 1203 005606 1204 005611 1205 005612 1206 005616 1208 005623 1209 005625 1210 005630 1211 005633 1213 005634 1214 005636 1216 005637 1218 005650 1220 005652 1224 005653 1231 005655 1232 005663 1233 005672 1234 005702 1235 005707 1238 005710 1239 005712 1242 005720 1243 005722 1246 005724 ----------------------------------------------------------- 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