COMPILATION LISTING OF SEGMENT cobol_pointer_register Compiled by: Multics PL/I Compiler, Release 31b, of April 24, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 05/24/89 1029.7 mst Wed Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 15 /****^ HISTORY COMMENTS: 16* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060), 17* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 18* MCR8060 cobol_pointer_register.pl1 Added Trace statements. 19* END HISTORY COMMENTS */ 20 21 22 /* Modified on 11/19/84 by FCH, [4.3-1}, BUG563(phx18381), new cobol_addr_tokens.incl.pl1 */ 23 /* Modified on 09/08/83 by FCH, [5.2...], trace added */ 24 /* Modified on 01/14/77 by ORN to signal command_abort rather than cobol_compiler_error */ 25 /* Modified since Version 2.0 */ 26 27 /*{*/ 28 /* format: style3 */ 29 cobol_pointer_register: 30 proc; /* the procedure is not a valid entry point */ 31 /*}*/ 32 return; 33 34 35 /*************************************/ 36 /*{*/ 37 call: 38 entry; 39 40 /* 41*This entry is called immediately before a call is to be generated; 42*thus PR0 must point to cobol_operators, PR4 must point to linkage 43*section; and PR2 will be destroyed. 44*}*/ 45 start_call: 46 return; /* for now */ 47 48 49 /*************************************/ 50 /*{*/ 51 get: 52 entry (struc_ptr); /* 53*This entry obtains a pointer register for the caller. 54* */ 55 dcl struc_ptr ptr; /* 56*struc_ptr is a pointer to the following structure. (input) 57* */ 58 59 dcl 1 structure based (struc_ptr), 60 2 what_pointer fixed bin, 61 2 pointer_no bit (3), 62 2 lock fixed bin, 63 2 switch fixed bin, 64 2 segno fixed bin, 65 2 offset fixed bin (24), 66 2 reset fixed bin; 67 68 /* 69* what_pointer specifies the pointer register to be obtained. 70* (input) 71* 0-7 - get this pointer register. 72* 10 - get any temporary pointer register. 73* pointer_no is the register that is assigned, in the 74* range 0-7. (output) 75* lock can have the following values. (input) 76* 0 - do not change the lock or unlock status 77* of this pointer. 78* 1 - lock the pointer register. 79* 2 - unlock all pointer registers. 80* 3 - unlock all pointer registers and A register 81* and Q register and all index registers. 82* switch has the following values. (input) 83* 0 - the register will not contain a value 84* that is meaningful for register optimization. 85* Segment number and offset are meaningless. 86* 1 - a segment number and word offset are supplied. 87* 2 - a segment number and character offset are supplied 88* segno is the segment number. (input) 89* values recognized are: 90* 2 - cobol data. 91* 1000 - stack. 92* 3000 - constants. 93* 3002 - multics linkage. 94* 4000 - cobol operators. 95* 2nnnn - cobol linkage. 96* -n - link in multics linkage. 97* offset is the word or character offset (depending on switch). 98* Any case when the offset is meaningless a 0 value 99* must be used. 100* If a character offset is provided only the word 101* portion is meaningful. (input) 102* reset specifies that the caller has requested a register 103* that must have a preset value. For example a preset 104* register to cobol data or the pointer to pl/1 operators 105* (likely). This is only of interest to callers 106* who request a specific register (what_pointer = 0-7) 107* Such callers should test reset. If it is 1, a call to 108* cobol_reset_r should be made in order 109* to emit instructions to reload the register to 110* its proper value. 111* 112* Notes: 113* 1. If switch has a non zero value and the pointer register 114* does not contain the specified segno and offset this 115* utility will emit instructions to load 116* the pointer register. 117* 2. (a) Generally a register should not be locked. 118* (b) Exceptions would be the case when (1) several 119* calls must be make to this utility and the caller 120* does not wish to obtain the same register (2) Calls 121* to this utility are interspurced with calls to the 122* addressability utilities and the user does not wish to 123* obtain the same register. 124* 3. There is no need to call to get pointer register 6 (the 125* stack frame). We can always assume this is set. 126* 4. If the caller requests a specific pointer register 127* who's priority was lock a compile time error will occur. 128* This may change if we need more sophisticated 129* pointer register handling. 130* */ 131 132 133 /*}*/ 134 dcl 1 reg_err static, 135 2 name char (32) init ("cobol_register$get"), 136 2 message_len fixed bin (35) init (30), 137 2 message char (30) init ("Unable to get a register"); 138 dcl 1 ptr_err static, 139 2 name char (32) init ("cobol_register$get"), 140 2 message_len fixed bin (35) init (30), 141 2 message char (30) init ("unable to get pointer register"); 142 dcl 1 contents_err static, 143 2 name char (32) init ("cobol_pointer_register$get"), 144 2 message_len fixed bin init (53), 145 2 message char (54) init ("Attempt to load invalid contents into pointer register"); 146 dcl (i, k, m) fixed bin; 147 dcl save_i fixed bin; 148 dcl best_yet fixed bin; 149 dcl best_current fixed bin; 150 dcl new_wd_off fixed bin (24); 151 dcl call_pr_num bit (3); 152 dcl reloc_ptr ptr; 153 dcl call_off fixed bin (24); 154 dcl 1 inst (10) aligned, 155 2 i_y unaligned, 156 3 i_pr bit (3) unaligned, 157 3 i_off bit (15) unaligned, 158 2 i_op bit (10) unaligned, 159 2 i_zero bit (1) unaligned, 160 2 i_ar bit (1) unaligned, 161 2 i_tm bit (2) unaligned, 162 2 i_td bit (4) unaligned; 163 dcl 1 reloc (20) aligned, 164 2 r_left bit (5) aligned, 165 2 r_right bit (5) aligned; 166 dcl cobol_emit entry (ptr, ptr, fixed bin); /* DECLARATION OF EXTERNAL ENTRIES */ 167 168 dcl cobol_register_util$restore_pointer 169 ext entry (bit (4)); 170 dcl cobol_register_util$restore 171 ext entry (bit (4)); 172 dcl cobol_register_util$save_pointer 173 ext entry (bit (4)); 174 dcl cobol_register$load ext entry (ptr); 175 176 dcl signal_ entry (char (*), ptr, ptr); 177 dcl char_no bit (2); 178 dcl bit_4 bit (4); 179 dcl temp_reg fixed bin int static init (0); 180 dcl r fixed bin; 181 dcl 1 register_struc, 182 2 what_reg fixed bin, 183 2 reg_no bit (4), 184 2 lock fixed bin, 185 2 already_there fixed bin, 186 2 contains fixed bin, 187 2 tok_ptr ptr, 188 2 literal bit (36); 189 190 191 /***..... dcl LOCAL_NAME char (4) int static init ("$GET");/**/ 192 /***.....if Trace_Bit then call cobol_gen_driver_$Tr_Beg(MY_NAME||LOCAL_NAME);/**/ 193 reset = 0; 194 if switch = 1 195 then new_wd_off = offset; 196 else if switch = 2 197 then do; 198 new_wd_off = binary (substr (unspec (offset), 1, 34)); 199 char_no = substr (unspec (offset), 35, 2); 200 end; 201 if what_pointer = 10 202 then do; 203 204 /* get any temporary pointer register */ 205 206 best_yet = 0; 207 do i = 0 to 7; 208 if usage (i) = 0 209 then do; /* the current register is temporary pointer */ 210 best_current = 0; 211 if switch = 0 212 then do; 213 214 /* a specific value was not supplied by caller */ 215 216 if p_lock (i) = 0 217 then do; /* register not locked */ 218 if p_priority (i) = 0 & contents_sw (i) = 0 219 then go to specific_1; 220 if p_priority (i) = 0 & contents_sw (i) = 1 221 then best_current = 3; 222 else if p_priority (i) = 1 & contents_sw (i) = 0 223 then best_current = 2; 224 else best_current = 1; 225 end; 226 end; 227 else do; 228 229 /* a specific value has been supplied by caller */ 230 231 if contents_sw (i) ^= 0 & seg_num (i) = segno & wd_offset (i) = new_wd_off 232 then go to specific_1; 233 /* contents do not match */ 234 if p_lock (i) = 0 235 then do; /* register not locked*/ 236 if p_priority (i) = 0 & contents_sw (i) = 0 237 then best_current = 4; 238 else if p_priority (i) = 0 & contents_sw (i) = 1 239 then best_current = 3; 240 else if p_priority (i) = 1 & contents_sw (i) = 0 241 then best_current = 2; 242 else best_current = 1; 243 end; 244 end; 245 246 /* has a better register been found */ 247 248 if best_current > best_yet 249 then do; 250 best_yet = best_current; 251 save_i = i; 252 end; 253 end; 254 end; 255 i = save_i; 256 if best_yet = 0 257 then do; /* unable to get any temporary register */ 258 /* Pick a temporary pointer register, and save it. */ 259 temp_reg = mod (temp_reg + 1, 7); 260 if temp_reg > 2 261 then temp_reg = 7; 262 bit_4 = substr (unspec (temp_reg), 33, 4); 263 call cobol_register_util$save_pointer (bit_4); 264 i = temp_reg; 265 ptr_status.p_priority (i) = 0; 266 ptr_status.contents_sw (i) = 0; 267 ptr_status.seg_num (i) = 0; 268 ptr_status.wd_offset (i) = 0; 269 end; 270 go to specific_1; 271 end; 272 else do; 273 274 /* a specific pointer register was requested */ 275 276 i = what_pointer; 277 if p_lock (i) = 1 278 then do; /* the pointer register is locked */ 279 /* Save the current contents of the register, and unlock it. */ 280 call cobol_register_util$save_pointer (substr (unspec (i), 33, 4)); 281 ptr_status.p_lock (i) = 0; 282 ptr_status.contents_sw (i) = 0; 283 ptr_status.seg_num (i) = 0; 284 ptr_status.wd_offset (i) = 0; 285 end; 286 287 specific_1: 288 structure.pointer_no = pointer_num (i); 289 if (structure.lock = 1) | (ptr_status.save_stack_count (i) > 0) 290 then p_lock (i) = 1; 291 if switch = 0 292 then do; /* caller has not supplied contents */ 293 contents_sw (i) = 0; 294 reset = p_reset (i); 295 end; 296 else do; 297 if contents_sw (i) = 0 298 then do; 299 go to load; 300 end; 301 else if (^(seg_num (i) = segno & wd_offset (i) = new_wd_off)) 302 then do; 303 304 load: /* emit instructions to load pointer registers*/ 305 m = 0; 306 reloc_ptr = null (); 307 308 /* cobol data */ 309 310 if segno = 2 311 then do; 312 if new_wd_off > 262143 313 then do; 314 cont_err: 315 call signal_ ("command_abort_", null (), addr (contents_err)); 316 return; 317 end; 318 319 /* epbpr pr6|110,* */ 320 /* 7/9/76*/ 321 call make_inst ("110"b, 110, "0111010001"b, "1"b, "01"b, "0"b); 322 323 /* adwpr call_off,du */ 324 call_off = new_wd_off - 16384; 325 call make_inst ("0"b, call_off, "0001010000"b, "0"b, "00"b, "0011"b); 326 go to emit; 327 end; 328 329 /* stack */ 330 331 if segno = 1000 332 then do; 333 if new_wd_off > 16383 334 then go to cont_err; 335 /* eppr pr6|new_wd_off */ 336 call make_inst ("110"b, new_wd_off, "0111010000"b, "1"b, "00"b, "0000"b) 337 ; 338 go to emit; 339 end; 340 341 /* constant portion of text segment */ 342 343 if segno = 3000 344 then do; 345 call_off = (-(cobol_$text_wd_off + new_wd_off)); 346 /* eppr call_off,ic */ 347 call make_inst ("0"b, call_off, "0111010000"b, "0"b, "00"b, "0100"b); 348 go to emit; 349 end; 350 351 /* multics linkage section */ 352 353 if segno = 3002 354 then do; 355 if new_wd_off > 16383 356 then go to cont_err; 357 reloc_ptr = addr (reloc (1)); 358 if contents_sw (4) = 1 & seg_num (4) = 3002 & wd_offset (4) = 0 359 then do; /* pr4 is set to the multics linkage section */ 360 /* eppr pr4|new_wd_off */ 361 call make_inst ("100"b, new_wd_off, "0111010000"b, "1"b, 362 "00"b, "0000"b); 363 r_left (m) = "11001"b; 364 /* internal static 15 */ 365 r_right (m) = "0"b; 366 end; 367 else do; 368 call_pr_num = pointer_num (i); 369 /* eppr pr6|36,* */ 370 call make_inst ("110"b, 36, "0111010000"b, "1"b, "01"b, 371 "0000"b); 372 r_left (m) = "0"b; 373 r_right (m) = "0"b; 374 /* eppr prr | new_wd_off */ 375 call make_inst (call_pr_num, new_wd_off, "0111010000"b, "1"b, 376 "00"b, "0000"b); 377 r_left (m) = "11001"b; 378 /* internal static 18 */ 379 r_right (m) = "0"b; 380 end; 381 go to emit; 382 end; 383 384 /* cobol operators */ 385 386 if segno = 4000 387 then do; /* eppr pr6|24,* */ 388 call make_inst ("110"b, 24, "0111010000"b, "1"b, "01"b, "0000"b); 389 go to emit; 390 end; 391 392 /* cobol linkage section */ 393 394 if segno >= 20000 395 then do; /* sets pointer reg to argument list */ 396 /* eppr pr6|26,* */ 397 call make_inst ("110"b, 26, "0111010000"b, "1"b, "01"b, "0000"b); 398 if segno > 20000 399 then do; /* sets pointer reg to the argument */ 400 /* eppr prr|2nnnn,* */ 401 call_pr_num = pointer_num (i); 402 call_off = 2 * (segno - 20000); 403 call make_inst (call_pr_num, call_off, "0111010000"b, "1"b, 404 "01"b, "0000"b); 405 end; 406 go to emit; 407 end; 408 409 /* link in multics linkage section */ 410 411 if segno < 0 412 then do; 413 if segno < -16384 414 then go to cont_err; 415 if new_wd_off > 262143 416 then go to cont_err; 417 call_off = (-(segno)); 418 reloc_ptr = addr (reloc (1)); 419 if contents_sw (4) = 1 & seg_num (4) = 3002 & wd_offset (4) = 0 420 then do; /* pr4 is set to multics linkage section */ 421 /* eppr pr4|n,* */ 422 /* put link into the register */ 423 call make_inst ("100"b, call_off, "0111010000"b, "1"b, "01"b, 424 "0000"b); 425 r_left (m) = "10100"b; 426 /* link 15 */ 427 r_right (m) = "0"b; 428 end; 429 else do; /* eppr pr6|36,* */ 430 /* set ponter register to linkage section base */ 431 call make_inst ("110"b, 36, "0111010000"b, "1"b, "01"b, 432 "0000"b); 433 r_left (m) = "0"b; 434 r_right (m) = "0"b; 435 /* eppr prr|n,* put link into the register */ 436 call_pr_num = pointer_num (i); 437 call make_inst (call_pr_num, call_off, "0111010000"b, "1"b, 438 "01"b, "0000"b); 439 r_left (m) = "10100"b; 440 /* link 15 */ 441 r_right (m) = "0"b; 442 end; 443 if new_wd_off ^= 0 444 then do; /* adwpr new_wd_off,du */ 445 call make_inst ("0"b, new_wd_off, "0001010000"b, "0"b, "00"b, 446 "0011"b); 447 r_left (m) = "0"b; 448 r_right (m) = "0"b; 449 end; 450 go to emit; 451 end; 452 453 /* invalid segment number */ 454 455 go to cont_err; 456 457 /* emit the instructions */ 458 459 emit: /* acount char offset if needed */ 460 if char_no ^= "00"b & switch ^= 1 461 then do; /* get a register */ 462 /* Set up a register request structure to get any index register. */ 463 register_struc.what_reg = 5; 464 /* Any index. */ 465 register_struc.lock = 0; 466 register_struc.contains = 0; 467 call cobol_register$load (addr (register_struc)); 468 469 load_char: /* ldxn : load char no into register */ 470 m = m + 1; 471 r_left (m) = "0"b; 472 r_right (m) = "0"b; 473 string (inst (m)) = "000000000000000000010010000000000011"b; 474 substr (inst.i_y.i_off (m), 14, 2) = char_no; 475 substr (inst.i_op (m), 7, 3) = substr (register_struc.reg_no, 2, 3); 476 /* a9bd */ 477 m = m + 1; 478 r_left (m) = "0"b; 479 r_right (m) = "0"b; 480 string (inst (m)) = "000000000000000000101000000101101000"b; 481 substr (inst.i_td (m), 2, 3) = substr (register_struc.reg_no, 2, 3); 482 inst.i_y.i_pr (m) = pointer_num (i); 483 contents_sw (i) = 0; 484 end; 485 486 else do; 487 seg_num (i) = segno; 488 wd_offset (i) = new_wd_off; 489 contents_sw (i) = 1; 490 end; 491 492 call cobol_emit (addr (inst (1)), reloc_ptr, m); 493 494 495 496 497 end; 498 499 reset_test: 500 if p_reset (i) ^= 0 501 then do; 502 if seg_num (i) = reset_seg_num (i) & wd_offset (i) = reset_wd_offset (i) 503 then go to lock_test; 504 else reset = 1; 505 end; 506 end; 507 508 lock_test: 509 if structure.lock > 1 510 then do k = 0 to 7; /* unlock all pointer registers */ 511 512 p_lock (k) = 0; 513 end; 514 if structure.lock > 2 515 then do k = 0 to 9; /* unlock A, Q and index registers */ 516 r_lock (k) = 0; 517 end; 518 end; 519 520 go to prx; 521 522 523 /*************************************/ 524 /*{*/ 525 priority: 526 entry (lock_value, priority, reg_no); 527 528 /***..... dcl LOCAL_NAME2 char (9) int static init ("$PRIORITY");/**/ 529 /***.....if Trace_Bit then call cobol_gen_driver_$Tr_Beg(MY_NAME||LOCAL_NAME2);/**/ 530 /* 531*set the priority and/or lock of one or more registers. 532* */ 533 534 dcl lock_value fixed bin; 535 dcl priority fixed bin; 536 dcl reg_no bit (3); /* 537* lock_value can have the following values (input) 538* 0 - do not change the lock or unlock status. 539* 1 - lock this pointer register. 540* 2 - unlock this pointer register. 541* 3 - unlock all pointer registers. 542* 4 - unlock all pointer registers and all index 543* registers, and the A and Q registers. 544* priority can have the following values (input) 545* 0 - do not change register priority. 546* 1 - set this pointer register to normal priority 547* 2 - set this pointer register to high priority. 548* The register handler will attempt to preserve 549* the contents of this register as long as possible 550* 3 - set all pointer registers to normal priority. 551* 4 - set all pointer registers and all index registers, 552* and the A and Q registers to normal priority. 553* reg_no is the pointer register number. (input) 554* */ 555 /*}*/ 556 557 /* manage lock */ 558 559 if lock_value ^= 0 560 then do; 561 if lock_value = 1 562 then p_lock (fixed (reg_no)) = 1; 563 else if lock_value = 2 564 then do; 565 k = fixed (reg_no); 566 if ptr_status.save_stack_count (k) ^= 0 567 then do; /* Restore the pointer register. */ 568 call cobol_register_util$restore_pointer ("0"b || substr (unspec (k), 34, 3)); 569 ptr_status.p_lock (k) = 1; 570 end; /* Restore the pointer register. */ 571 572 else p_lock (k) = 0; 573 end; 574 else do; 575 do k = 0 to 7; 576 577 if ptr_status.save_stack_count (k) ^= 0 578 then do; /* Restore the pointer register. */ 579 call cobol_register_util$restore_pointer ("0"b || substr (unspec (k), 34, 3)) 580 ; 581 ptr_status.p_lock (k) = 1; 582 end; /* Restore the pointer register. */ 583 584 else p_lock (k) = 0; 585 end; 586 if lock_value = 4 587 then do k = 0 to 9; 588 if reg_status.save_stack_count (k) ^= 0 589 then do; /* Restore the register. */ 590 call cobol_register_util$restore ((get_bit_code (k))); 591 reg_status.r_lock (k) = 1; 592 end; /* Restore the register. */ 593 594 else r_lock (k) = 0; 595 end; 596 end; 597 end; 598 599 /* manage priority */ 600 601 if priority ^= 0 602 then do; 603 if priority = 1 604 then p_priority (fixed (reg_no)) = 0; 605 else if priority = 2 606 then p_priority (fixed (reg_no)) = 1; 607 else do; 608 do k = 0 to 7; 609 p_priority (k) = 0; 610 end; 611 if priority = 4 612 then do k = 0 to 9; 613 r_priority (k) = 0; 614 end; 615 end; 616 end; 617 618 prx: /***.....if Trace_Bit then call cobol_gen_driver_$Tr_End(MY_NAME);/**/ 619 return; 620 621 /* MAKE_INST PROC 622* /* make an instruction */ 623 624 make_inst: 625 proc (pr, off, op, ar, tm, td); 626 627 dcl pr bit (3); 628 dcl off fixed bin (24); 629 dcl op bit (10); 630 dcl ar bit (1); 631 dcl tm bit (2); 632 dcl td bit (4); 633 634 /* i must be set as index to ptr_status table */ 635 /* m must be set as index into inst table */ 636 /* op codes recognized are 637* adwpr 050 (0) 638* eppr 350 (0) 639* epbpr 350 (1) 640* */ 641 642 643 m = m + 1; 644 string (inst (m)) = "0"b; 645 i_op (m) = op; 646 i_ar (m) = ar; 647 i_tm (m) = tm; 648 i_td (m) = td; 649 if ar = "0"b 650 then string (i_y (m)) = substr (unspec (off), 19, 18); 651 else do; 652 i_pr (m) = pr; 653 i_off (m) = substr (unspec (off), 22, 15); 654 end; 655 if op = "0001010000"b 656 then do; /* adwpr */ 657 substr (i_op (m), 3, 1) = substr (pointer_num (i), 1, 1); 658 substr (i_op (m), 8, 2) = substr (pointer_num (i), 2, 2); 659 end; 660 else if op = "0111010000"b 661 then do; /* eppr */ 662 substr (i_op (m), 5, 1) = substr (pointer_num (i), 1, 1); 663 substr (i_op (m), 8, 2) = substr (pointer_num (i), 2, 2); 664 substr (i_op (m), 10, 1) = substr (pointer_num (i), 3, 1); 665 end; 666 else if op = "0111010001"b 667 then do; /* epbpr */ 668 substr (i_op (m), 5, 1) = substr (pointer_num (i), 1, 1); 669 substr (i_op (m), 8, 2) = substr (pointer_num (i), 2, 2); 670 substr (i_op (m), 10, 1) = (^(substr (pointer_num (i), 3, 1))); 671 end; 672 return; 673 end make_inst; 674 675 get_bit_code: 676 proc (fbin_code) returns (bit (4)); 677 678 dcl fbin_code fixed bin; 679 680 dcl bit_code bit (4); 681 682 if fbin_code = 9 683 then bit_code = "0010"b; /* Q */ 684 else if fbin_code = 8 685 then bit_code = "0001"b; /* A */ 686 else bit_code = "1"b || substr (unspec (fbin_code), 34, 3); 687 688 return (bit_code); 689 690 end get_bit_code; 691 692 693 /***..... dcl cobol_gen_driver_$Tr_Beg entry(char(*));/**/ 694 /***..... dcl cobol_gen_driver_$Tr_End entry(char(*));/**/ 695 696 /***..... dcl Trace_Bit bit(1) static external;/**/ 697 /***..... dcl Trace_Lev fixed bin static external;/**/ 698 /***..... dcl Trace_Line char(36) static external;/**/ 699 /***..... dcl ioa_ entry options(variable); /**/ 700 /***..... dcl MY_NAME char (22) int static init ("COBOL_POINTER_REGISTER");/**/ 701 702 dcl 1 ptr_status (0:7) based (cobol_$ptr_status_ptr) aligned, 1 1 1 2 /* BEGIN INCLUDE FILE ... cobol_ptr_status.incl.pl1 */ 1 3 /* Last modified June 3, 76 by bc */ 1 4 /* last modified Oct. 31,75 by tlf */ 1 5 1 6 /* 1 7*1. This structure contains the status of the object time 1 8* pointer registers. 1 9*2. The caller should provide a dcl statement in the form: 1 10* dcl 1 ptr_status (0:7) based ( cobol_$ptr_status_ptr) aligned, 1 11**/ 1 12 1 13 2 pointer_num bit (3), 1 14 2 usage fixed bin, 1 15 2 contents_sw fixed bin, 1 16 2 seg_num fixed bin, 1 17 2 wd_offset fixed bin (24), 1 18 2 p_lock fixed bin, 1 19 2 p_priority fixed bin, 1 20 2 p_reset fixed bin, 1 21 2 reset_seg_num fixed bin, 1 22 2 reset_wd_offset fixed bin (24), 1 23 02 save_stack_max fixed bin, 1 24 02 save_stack_count fixed bin, 1 25 02 save_stack (1:10) bit (36), 1 26 02 reloc_stack (1:10), 1 27 03 left_reloc_info bit (5) aligned, 1 28 03 right_reloc_info bit (5) aligned; 1 29 1 30 1 31 1 32 /* END INCLUDE FILE ... cobol_ptr_status.incl.pl1 */ 1 33 703 704 dcl 1 reg_status (0:9) based (cobol_$reg_status_ptr) aligned, 2 1 2 2 /* BEGIN INCLUDE FILE ... cobol_reg_status.incl.pl1 */ 2 3 /* last modified Oct. 31,75 by tlf */ 2 4 2 5 /* 2 6*1. This structure maintains the status of the object 2 7* time A,Q and index registers. 2 8*2. The caller should provide a dcl statement in the form. 2 9* dcl 1 reg_status (0:9) based ( cobol_$reg_status_ptr) aligned, 2 10**/ 2 11 2 12 2 register_num bit (4), 2 13 2 r_lock fixed bin, 2 14 2 r_priority fixed bin, 2 15 02 save_stack_max fixed bin, 2 16 02 save_stack_count fixed bin, 2 17 02 save_stack (1:10) bit (36), 2 18 02 reloc_stack (1:10), 2 19 03 left_reloc_info bit (5) aligned, 2 20 03 right_reloc_info bit (5) aligned; 2 21 2 22 2 23 2 24 /* END INCLUDE FILE ... cobol_reg_status.incl.pl1 */ 2 25 705 3 1 3 2 /* BEGIN INCLUDE FILE ... cobol_.incl.pl1 */ 3 3 /* last modified Feb 4, 1977 by ORN */ 3 4 3 5 /* This file defines all external data used in the generator phase of Multics Cobol */ 3 6 3 7 /* POINTERS */ 3 8 dcl cobol_$text_base_ptr ptr ext; 3 9 dcl text_base_ptr ptr defined (cobol_$text_base_ptr); 3 10 dcl cobol_$con_end_ptr ptr ext; 3 11 dcl con_end_ptr ptr defined (cobol_$con_end_ptr); 3 12 dcl cobol_$def_base_ptr ptr ext; 3 13 dcl def_base_ptr ptr defined (cobol_$def_base_ptr); 3 14 dcl cobol_$link_base_ptr ptr ext; 3 15 dcl link_base_ptr ptr defined (cobol_$link_base_ptr); 3 16 dcl cobol_$sym_base_ptr ptr ext; 3 17 dcl sym_base_ptr ptr defined (cobol_$sym_base_ptr); 3 18 dcl cobol_$reloc_text_base_ptr ptr ext; 3 19 dcl reloc_text_base_ptr ptr defined (cobol_$reloc_text_base_ptr); 3 20 dcl cobol_$reloc_def_base_ptr ptr ext; 3 21 dcl reloc_def_base_ptr ptr defined (cobol_$reloc_def_base_ptr); 3 22 dcl cobol_$reloc_link_base_ptr ptr ext; 3 23 dcl reloc_link_base_ptr ptr defined (cobol_$reloc_link_base_ptr); 3 24 dcl cobol_$reloc_sym_base_ptr ptr ext; 3 25 dcl reloc_sym_base_ptr ptr defined (cobol_$reloc_sym_base_ptr); 3 26 dcl cobol_$reloc_work_base_ptr ptr ext; 3 27 dcl reloc_work_base_ptr ptr defined (cobol_$reloc_work_base_ptr); 3 28 dcl cobol_$pd_map_ptr ptr ext; 3 29 dcl pd_map_ptr ptr defined (cobol_$pd_map_ptr); 3 30 dcl cobol_$fixup_ptr ptr ext; 3 31 dcl fixup_ptr ptr defined (cobol_$fixup_ptr); 3 32 dcl cobol_$initval_base_ptr ptr ext; 3 33 dcl initval_base_ptr ptr defined (cobol_$initval_base_ptr); 3 34 dcl cobol_$initval_file_ptr ptr ext; 3 35 dcl initval_file_ptr ptr defined (cobol_$initval_file_ptr); 3 36 dcl cobol_$perform_list_ptr ptr ext; 3 37 dcl perform_list_ptr ptr defined (cobol_$perform_list_ptr); 3 38 dcl cobol_$alter_list_ptr ptr ext; 3 39 dcl alter_list_ptr ptr defined (cobol_$alter_list_ptr); 3 40 dcl cobol_$seg_init_list_ptr ptr ext; 3 41 dcl seg_init_list_ptr ptr defined (cobol_$seg_init_list_ptr); 3 42 dcl cobol_$temp_token_area_ptr ptr ext; 3 43 dcl temp_token_area_ptr ptr defined (cobol_$temp_token_area_ptr); 3 44 dcl cobol_$temp_token_ptr ptr ext; 3 45 dcl temp_token_ptr ptr defined (cobol_$temp_token_ptr); 3 46 dcl cobol_$token_block1_ptr ptr ext; 3 47 dcl token_block1_ptr ptr defined (cobol_$token_block1_ptr); 3 48 dcl cobol_$token_block2_ptr ptr ext; 3 49 dcl token_block2_ptr ptr defined (cobol_$token_block2_ptr); 3 50 dcl cobol_$minpral5_ptr ptr ext; 3 51 dcl minpral5_ptr ptr defined (cobol_$minpral5_ptr); 3 52 dcl cobol_$tag_table_ptr ptr ext; 3 53 dcl tag_table_ptr ptr defined (cobol_$tag_table_ptr); 3 54 dcl cobol_$map_data_ptr ptr ext; 3 55 dcl map_data_ptr ptr defined (cobol_$map_data_ptr); 3 56 dcl cobol_$ptr_status_ptr ptr ext; 3 57 dcl ptr_status_ptr ptr defined (cobol_$ptr_status_ptr); 3 58 dcl cobol_$reg_status_ptr ptr ext; 3 59 dcl reg_status_ptr ptr defined (cobol_$reg_status_ptr); 3 60 dcl cobol_$misc_base_ptr ptr ext; 3 61 dcl misc_base_ptr ptr defined (cobol_$misc_base_ptr); 3 62 dcl cobol_$misc_end_ptr ptr ext; 3 63 dcl misc_end_ptr ptr defined (cobol_$misc_end_ptr); 3 64 dcl cobol_$list_ptr ptr ext; 3 65 dcl list_ptr ptr defined (cobol_$list_ptr); 3 66 dcl cobol_$allo1_ptr ptr ext; 3 67 dcl allo1_ptr ptr defined (cobol_$allo1_ptr); 3 68 dcl cobol_$eln_ptr ptr ext; 3 69 dcl eln_ptr ptr defined (cobol_$eln_ptr); 3 70 dcl cobol_$diag_ptr ptr ext; 3 71 dcl diag_ptr ptr defined (cobol_$diag_ptr); 3 72 dcl cobol_$xref_token_ptr ptr ext; 3 73 dcl xref_token_ptr ptr defined (cobol_$xref_token_ptr); 3 74 dcl cobol_$xref_chain_ptr ptr ext; 3 75 dcl xref_chain_ptr ptr defined (cobol_$xref_chain_ptr); 3 76 dcl cobol_$statement_info_ptr ptr ext; 3 77 dcl statement_info_ptr ptr defined (cobol_$statement_info_ptr); 3 78 dcl cobol_$reswd_ptr ptr ext; 3 79 dcl reswd_ptr ptr defined (cobol_$reswd_ptr); 3 80 dcl cobol_$op_con_ptr ptr ext; 3 81 dcl op_con_ptr ptr defined (cobol_$op_con_ptr); 3 82 dcl cobol_$ntbuf_ptr ptr ext; 3 83 dcl ntbuf_ptr ptr defined (cobol_$ntbuf_ptr); 3 84 dcl cobol_$main_pcs_ptr ptr ext; 3 85 dcl main_pcs_ptr ptr defined (cobol_$main_pcs_ptr); 3 86 dcl cobol_$include_info_ptr ptr ext; 3 87 dcl include_info_ptr ptr defined (cobol_$include_info_ptr); 3 88 3 89 /* FIXED BIN */ 3 90 dcl cobol_$text_wd_off fixed bin ext; 3 91 dcl text_wd_off fixed bin defined (cobol_$text_wd_off); 3 92 dcl cobol_$con_wd_off fixed bin ext; 3 93 dcl con_wd_off fixed bin defined (cobol_$con_wd_off); 3 94 dcl cobol_$def_wd_off fixed bin ext; 3 95 dcl def_wd_off fixed bin defined (cobol_$def_wd_off); 3 96 dcl cobol_$def_max fixed bin ext; 3 97 dcl def_max fixed bin defined (cobol_$def_max); 3 98 dcl cobol_$link_wd_off fixed bin ext; 3 99 dcl link_wd_off fixed bin defined (cobol_$link_wd_off); 3 100 dcl cobol_$link_max fixed bin ext; 3 101 dcl link_max fixed bin defined (cobol_$link_max); 3 102 dcl cobol_$sym_wd_off fixed bin ext; 3 103 dcl sym_wd_off fixed bin defined (cobol_$sym_wd_off); 3 104 dcl cobol_$sym_max fixed bin ext; 3 105 dcl sym_max fixed bin defined (cobol_$sym_max); 3 106 dcl cobol_$reloc_text_max fixed bin(24) ext; 3 107 dcl reloc_text_max fixed bin(24) defined (cobol_$reloc_text_max); 3 108 dcl cobol_$reloc_def_max fixed bin(24) ext; 3 109 dcl reloc_def_max fixed bin(24) defined (cobol_$reloc_def_max); 3 110 dcl cobol_$reloc_link_max fixed bin(24) ext; 3 111 dcl reloc_link_max fixed bin(24) defined (cobol_$reloc_link_max); 3 112 dcl cobol_$reloc_sym_max fixed bin(24) ext; 3 113 dcl reloc_sym_max fixed bin(24) defined (cobol_$reloc_sym_max); 3 114 dcl cobol_$reloc_work_max fixed bin(24) ext; 3 115 dcl reloc_work_max fixed bin(24) defined (cobol_$reloc_work_max); 3 116 dcl cobol_$pd_map_index fixed bin ext; 3 117 dcl pd_map_index fixed bin defined (cobol_$pd_map_index); 3 118 dcl cobol_$cobol_data_wd_off fixed bin ext; 3 119 dcl cobol_data_wd_off fixed bin defined (cobol_$cobol_data_wd_off); 3 120 dcl cobol_$stack_off fixed bin ext; 3 121 dcl stack_off fixed bin defined (cobol_$stack_off); 3 122 dcl cobol_$max_stack_off fixed bin ext; 3 123 dcl max_stack_off fixed bin defined (cobol_$max_stack_off); 3 124 dcl cobol_$init_stack_off fixed bin ext; 3 125 dcl init_stack_off fixed bin defined (cobol_$init_stack_off); 3 126 dcl cobol_$pd_map_sw fixed bin ext; 3 127 dcl pd_map_sw fixed bin defined (cobol_$pd_map_sw); 3 128 dcl cobol_$next_tag fixed bin ext; 3 129 dcl next_tag fixed bin defined (cobol_$next_tag); 3 130 dcl cobol_$data_init_flag fixed bin ext; 3 131 dcl data_init_flag fixed bin defined (cobol_$data_init_flag); 3 132 dcl cobol_$seg_init_flag fixed bin ext; 3 133 dcl seg_init_flag fixed bin defined (cobol_$seg_init_flag); 3 134 dcl cobol_$alter_flag fixed bin ext; 3 135 dcl alter_flag fixed bin defined (cobol_$alter_flag); 3 136 dcl cobol_$sect_eop_flag fixed bin ext; 3 137 dcl sect_eop_flag fixed bin defined (cobol_$sect_eop_flag); 3 138 dcl cobol_$para_eop_flag fixed bin ext; 3 139 dcl para_eop_flag fixed bin defined (cobol_$para_eop_flag); 3 140 dcl cobol_$priority_no fixed bin ext; 3 141 dcl priority_no fixed bin defined (cobol_$priority_no); 3 142 dcl cobol_$compile_count fixed bin ext; 3 143 dcl compile_count fixed bin defined (cobol_$compile_count); 3 144 dcl cobol_$ptr_assumption_ind fixed bin ext; 3 145 dcl ptr_assumption_ind fixed bin defined (cobol_$ptr_assumption_ind); 3 146 dcl cobol_$reg_assumption_ind fixed bin ext; 3 147 dcl reg_assumption_ind fixed bin defined (cobol_$reg_assumption_ind); 3 148 dcl cobol_$perform_para_index fixed bin ext; 3 149 dcl perform_para_index fixed bin defined (cobol_$perform_para_index); 3 150 dcl cobol_$perform_sect_index fixed bin ext; 3 151 dcl perform_sect_index fixed bin defined (cobol_$perform_sect_index); 3 152 dcl cobol_$alter_index fixed bin ext; 3 153 dcl alter_index fixed bin defined (cobol_$alter_index); 3 154 dcl cobol_$list_off fixed bin ext; 3 155 dcl list_off fixed bin defined (cobol_$list_off); 3 156 dcl cobol_$constant_offset fixed bin ext; 3 157 dcl constant_offset fixed bin defined (cobol_$constant_offset); 3 158 dcl cobol_$misc_max fixed bin ext; 3 159 dcl misc_max fixed bin defined (cobol_$misc_max); 3 160 dcl cobol_$pd_map_max fixed bin ext; 3 161 dcl pd_map_max fixed bin defined (cobol_$pd_map_max); 3 162 dcl cobol_$map_data_max fixed bin ext; 3 163 dcl map_data_max fixed bin defined (cobol_$map_data_max); 3 164 dcl cobol_$fixup_max fixed bin ext; 3 165 dcl fixup_max fixed bin defined (cobol_$fixup_max); 3 166 dcl cobol_$tag_table_max fixed bin ext; 3 167 dcl tag_table_max fixed bin defined (cobol_$tag_table_max); 3 168 dcl cobol_$temp_token_max fixed bin ext; 3 169 dcl temp_token_max fixed bin defined (cobol_$temp_token_max); 3 170 dcl cobol_$allo1_max fixed bin ext; 3 171 dcl allo1_max fixed bin defined (cobol_$allo1_max); 3 172 dcl cobol_$eln_max fixed bin ext; 3 173 dcl eln_max fixed bin defined (cobol_$eln_max); 3 174 dcl cobol_$debug_enable fixed bin ext; 3 175 dcl debug_enable fixed bin defined (cobol_$debug_enable); 3 176 dcl cobol_$non_source_offset fixed bin ext; 3 177 dcl non_source_offset fixed bin defined (cobol_$non_source_offset); 3 178 dcl cobol_$initval_flag fixed bin ext; 3 179 dcl initval_flag fixed bin defined (cobol_$initval_flag); 3 180 dcl cobol_$date_compiled_sw fixed bin ext; 3 181 dcl date_compiled_sw fixed bin defined (cobol_$date_compiled_sw); 3 182 dcl cobol_$include_cnt fixed bin ext; 3 183 dcl include_cnt fixed bin defined (cobol_$include_cnt); 3 184 dcl cobol_$fs_charcnt fixed bin ext; 3 185 dcl fs_charcnt fixed bin defined (cobol_$fs_charcnt); 3 186 dcl cobol_$ws_charcnt fixed bin ext; 3 187 dcl ws_charcnt fixed bin defined (cobol_$ws_charcnt); 3 188 dcl cobol_$coms_charcnt fixed bin ext; 3 189 dcl coms_charcnt fixed bin defined (cobol_$coms_charcnt); 3 190 dcl cobol_$ls_charcnt fixed bin ext; 3 191 dcl ls_charcnt fixed bin defined (cobol_$ls_charcnt); 3 192 dcl cobol_$cons_charcnt fixed bin ext; 3 193 dcl cons_charcnt fixed bin defined (cobol_$cons_charcnt); 3 194 dcl cobol_$value_cnt fixed bin ext; 3 195 dcl value_cnt fixed bin defined (cobol_$value_cnt); 3 196 dcl cobol_$cd_cnt fixed bin ext; 3 197 dcl cd_cnt fixed bin defined (cobol_$cd_cnt); 3 198 dcl cobol_$fs_wdoff fixed bin ext; 3 199 dcl fs_wdoff fixed bin defined (cobol_$fs_wdoff); 3 200 dcl cobol_$ws_wdoff fixed bin ext; 3 201 dcl ws_wdoff fixed bin defined (cobol_$ws_wdoff); 3 202 dcl cobol_$coms_wdoff fixed bin ext; 3 203 dcl coms_wdoff fixed bin defined (cobol_$coms_wdoff); 3 204 3 205 /* CHARACTER */ 3 206 dcl cobol_$scratch_dir char (168) aligned ext; 3 207 dcl scratch_dir char (168) aligned defined (cobol_$scratch_dir); /* -42- */ 3 208 dcl cobol_$obj_seg_name char (32) aligned ext; 3 209 dcl obj_seg_name char (32) aligned defined (cobol_$obj_seg_name); /* -8- */ 3 210 3 211 /* BIT */ 3 212 dcl cobol_$xref_bypass bit(1) aligned ext; 3 213 dcl xref_bypass bit(1) aligned defined (cobol_$xref_bypass); /* -1- */ 3 214 dcl cobol_$same_sort_merge_proc bit(1) aligned ext; 3 215 dcl same_sort_merge_proc bit(1) aligned defined (cobol_$same_sort_merge_proc); /* -1- */ 3 216 3 217 3 218 /* END INCLUDE FILE ... cobol_incl.pl1*/ 3 219 3 220 706 707 708 end cobol_pointer_register; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0837.3 cobol_pointer_register.pl1 >spec>install>MR12.3-1048>cobol_pointer_register.pl1 703 1 11/11/82 1712.8 cobol_ptr_status.incl.pl1 >ldd>include>cobol_ptr_status.incl.pl1 705 2 11/11/82 1712.8 cobol_reg_status.incl.pl1 >ldd>include>cobol_reg_status.incl.pl1 706 3 11/11/82 1712.7 cobol_.incl.pl1 >ldd>include>cobol_.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. ar parameter bit(1) packed unaligned dcl 630 ref 624 646 649 best_current 000105 automatic fixed bin(17,0) dcl 149 set ref 210* 220* 222* 224* 236* 238* 240* 242* 248 250 best_yet 000104 automatic fixed bin(17,0) dcl 148 set ref 206* 248 250* 256 bit_4 000176 automatic bit(4) packed unaligned dcl 178 set ref 262* 263* bit_code 000226 automatic bit(4) packed unaligned dcl 680 set ref 682* 684* 686* 688 call_off 000112 automatic fixed bin(24,0) dcl 153 set ref 324* 325* 345* 347* 402* 403* 417* 423* 437* call_pr_num 000107 automatic bit(3) packed unaligned dcl 151 set ref 368* 375* 401* 403* 436* 437* char_no 000175 automatic bit(2) packed unaligned dcl 177 set ref 199* 459 474 cobol_$ptr_status_ptr 000054 external static pointer dcl 3-56 ref 208 216 218 218 220 220 222 222 231 231 231 234 236 236 238 238 240 240 265 266 267 268 277 281 282 283 284 287 289 289 293 294 297 301 301 358 358 358 368 401 419 419 419 436 482 483 487 488 489 499 502 502 502 502 512 561 566 569 572 577 581 584 603 605 609 657 658 662 663 664 668 669 670 cobol_$reg_status_ptr 000056 external static pointer dcl 3-58 ref 516 588 591 594 613 cobol_$text_wd_off 000060 external static fixed bin(17,0) dcl 3-90 ref 345 cobol_emit 000040 constant entry external dcl 166 ref 492 cobol_register$load 000050 constant entry external dcl 174 ref 467 cobol_register_util$restore 000044 constant entry external dcl 170 ref 590 cobol_register_util$restore_pointer 000042 constant entry external dcl 168 ref 568 579 cobol_register_util$save_pointer 000046 constant entry external dcl 172 ref 263 280 contains 4 000200 automatic fixed bin(17,0) level 2 dcl 181 set ref 466* contents_err 000010 internal static structure level 1 unaligned dcl 142 set ref 314 314 contents_sw 2 based fixed bin(17,0) array level 2 dcl 702 set ref 218 220 222 231 236 238 240 266* 282* 293* 297 358 419 483* 489* fbin_code parameter fixed bin(17,0) dcl 678 ref 675 682 684 686 i 000100 automatic fixed bin(17,0) dcl 146 set ref 207* 208 216 218 218 220 220 222 222 231 231 231 234 236 236 238 238 240 240 251* 255* 264* 265 266 267 268 276* 277 280 280 281 282 283 284 287 289 289 293 294 297 301 301 368 401 436 482 483 487 488 489 499 502 502 502 502 657 658 662 663 664 668 669 670 i_ar 0(29) 000113 automatic bit(1) array level 2 packed packed unaligned dcl 154 set ref 646* i_off 0(03) 000113 automatic bit(15) array level 3 packed packed unaligned dcl 154 set ref 474* 653* i_op 0(18) 000113 automatic bit(10) array level 2 packed packed unaligned dcl 154 set ref 475* 645* 657* 658* 662* 663* 664* 668* 669* 670* i_pr 000113 automatic bit(3) array level 3 packed packed unaligned dcl 154 set ref 482* 652* i_td 0(32) 000113 automatic bit(4) array level 2 packed packed unaligned dcl 154 set ref 481* 648* i_tm 0(30) 000113 automatic bit(2) array level 2 packed packed unaligned dcl 154 set ref 647* i_y 000113 automatic structure array level 2 packed packed unaligned dcl 154 set ref 649* inst 000113 automatic structure array level 1 dcl 154 set ref 473* 480* 492 492 644* k 000101 automatic fixed bin(17,0) dcl 146 set ref 508* 512* 514* 516* 565* 566 568 569 572 575* 577 579 581 584* 586* 588 590* 591 594* 608* 609* 611* 613* lock 2 based fixed bin(17,0) level 2 in structure "structure" dcl 59 in procedure "cobol_pointer_register" ref 289 508 514 lock 2 000200 automatic fixed bin(17,0) level 2 in structure "register_struc" dcl 181 in procedure "cobol_pointer_register" set ref 465* lock_value parameter fixed bin(17,0) dcl 534 ref 525 559 561 563 586 m 000102 automatic fixed bin(17,0) dcl 146 set ref 304* 363 365 372 373 377 379 425 427 433 434 439 441 447 448 469* 469 471 472 473 474 475 477* 477 478 479 480 481 482 492* 643* 643 644 645 646 647 648 649 652 653 657 658 662 663 664 668 669 670 new_wd_off 000106 automatic fixed bin(24,0) dcl 150 set ref 194* 198* 231 301 312 324 333 336* 345 355 361* 375* 415 443 445* 488 off parameter fixed bin(24,0) dcl 628 ref 624 649 653 offset 5 based fixed bin(24,0) level 2 dcl 59 ref 194 198 199 op parameter bit(10) packed unaligned dcl 629 ref 624 645 655 660 666 p_lock 5 based fixed bin(17,0) array level 2 dcl 702 set ref 216 234 277 281* 289* 512* 561* 569* 572* 581* 584* p_priority 6 based fixed bin(17,0) array level 2 dcl 702 set ref 218 220 222 236 238 240 265* 603* 605* 609* p_reset 7 based fixed bin(17,0) array level 2 dcl 702 ref 294 499 pointer_no 1 based bit(3) level 2 packed packed unaligned dcl 59 set ref 287* pointer_num based bit(3) array level 2 dcl 702 ref 287 368 401 436 482 657 658 662 663 664 668 669 670 pr parameter bit(3) packed unaligned dcl 627 ref 624 652 priority parameter fixed bin(17,0) dcl 535 ref 525 601 603 605 611 ptr_status based structure array level 1 dcl 702 r_left 000125 automatic bit(5) array level 2 dcl 163 set ref 363* 372* 377* 425* 433* 439* 447* 471* 478* r_lock 1 based fixed bin(17,0) array level 2 dcl 704 set ref 516* 591* 594* r_priority 2 based fixed bin(17,0) array level 2 dcl 704 set ref 613* r_right 1 000125 automatic bit(5) array level 2 dcl 163 set ref 365* 373* 379* 427* 434* 441* 448* 472* 479* reg_no parameter bit(3) packed unaligned dcl 536 in procedure "cobol_pointer_register" ref 525 561 565 603 605 reg_no 1 000200 automatic bit(4) level 2 in structure "register_struc" packed packed unaligned dcl 181 in procedure "cobol_pointer_register" set ref 475 481 reg_status based structure array level 1 dcl 704 register_struc 000200 automatic structure level 1 unaligned dcl 181 set ref 467 467 reloc 000125 automatic structure array level 1 dcl 163 set ref 357 418 reloc_ptr 000110 automatic pointer dcl 152 set ref 306* 357* 418* 492* reset 6 based fixed bin(17,0) level 2 dcl 59 set ref 193* 294* 504* reset_seg_num 10 based fixed bin(17,0) array level 2 dcl 702 ref 502 reset_wd_offset 11 based fixed bin(24,0) array level 2 dcl 702 ref 502 save_i 000103 automatic fixed bin(17,0) dcl 147 set ref 251* 255 save_stack_count 4 based fixed bin(17,0) array level 2 in structure "reg_status" dcl 704 in procedure "cobol_pointer_register" ref 588 save_stack_count 13 based fixed bin(17,0) array level 2 in structure "ptr_status" dcl 702 in procedure "cobol_pointer_register" ref 289 566 577 seg_num 3 based fixed bin(17,0) array level 2 dcl 702 set ref 231 267* 283* 301 358 419 487* 502 segno 4 based fixed bin(17,0) level 2 dcl 59 ref 231 301 310 331 343 353 386 394 398 402 411 413 417 487 signal_ 000052 constant entry external dcl 176 ref 314 struc_ptr parameter pointer dcl 55 ref 51 193 194 194 196 198 199 201 211 231 276 287 289 291 294 301 310 331 343 353 386 394 398 402 411 413 417 459 487 504 508 514 structure based structure level 1 unaligned dcl 59 switch 3 based fixed bin(17,0) level 2 dcl 59 ref 194 196 211 291 459 td parameter bit(4) packed unaligned dcl 632 ref 624 648 temp_reg 000037 internal static fixed bin(17,0) initial dcl 179 set ref 259* 259 260 260* 262 264 tm parameter bit(2) packed unaligned dcl 631 ref 624 647 usage 1 based fixed bin(17,0) array level 2 dcl 702 ref 208 wd_offset 4 based fixed bin(24,0) array level 2 dcl 702 set ref 231 268* 284* 301 358 419 488* 502 what_pointer based fixed bin(17,0) level 2 dcl 59 ref 201 276 what_reg 000200 automatic fixed bin(17,0) level 2 dcl 181 set ref 463* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. allo1_max defined fixed bin(17,0) dcl 3-171 allo1_ptr defined pointer dcl 3-67 alter_flag defined fixed bin(17,0) dcl 3-135 alter_index defined fixed bin(17,0) dcl 3-153 alter_list_ptr defined pointer dcl 3-39 cd_cnt defined fixed bin(17,0) dcl 3-197 cobol_$allo1_max external static fixed bin(17,0) dcl 3-170 cobol_$allo1_ptr external static pointer dcl 3-66 cobol_$alter_flag external static fixed bin(17,0) dcl 3-134 cobol_$alter_index external static fixed bin(17,0) dcl 3-152 cobol_$alter_list_ptr external static pointer dcl 3-38 cobol_$cd_cnt external static fixed bin(17,0) dcl 3-196 cobol_$cobol_data_wd_off external static fixed bin(17,0) dcl 3-118 cobol_$compile_count external static fixed bin(17,0) dcl 3-142 cobol_$coms_charcnt external static fixed bin(17,0) dcl 3-188 cobol_$coms_wdoff external static fixed bin(17,0) dcl 3-202 cobol_$con_end_ptr external static pointer dcl 3-10 cobol_$con_wd_off external static fixed bin(17,0) dcl 3-92 cobol_$cons_charcnt external static fixed bin(17,0) dcl 3-192 cobol_$constant_offset external static fixed bin(17,0) dcl 3-156 cobol_$data_init_flag external static fixed bin(17,0) dcl 3-130 cobol_$date_compiled_sw external static fixed bin(17,0) dcl 3-180 cobol_$debug_enable external static fixed bin(17,0) dcl 3-174 cobol_$def_base_ptr external static pointer dcl 3-12 cobol_$def_max external static fixed bin(17,0) dcl 3-96 cobol_$def_wd_off external static fixed bin(17,0) dcl 3-94 cobol_$diag_ptr external static pointer dcl 3-70 cobol_$eln_max external static fixed bin(17,0) dcl 3-172 cobol_$eln_ptr external static pointer dcl 3-68 cobol_$fixup_max external static fixed bin(17,0) dcl 3-164 cobol_$fixup_ptr external static pointer dcl 3-30 cobol_$fs_charcnt external static fixed bin(17,0) dcl 3-184 cobol_$fs_wdoff external static fixed bin(17,0) dcl 3-198 cobol_$include_cnt external static fixed bin(17,0) dcl 3-182 cobol_$include_info_ptr external static pointer dcl 3-86 cobol_$init_stack_off external static fixed bin(17,0) dcl 3-124 cobol_$initval_base_ptr external static pointer dcl 3-32 cobol_$initval_file_ptr external static pointer dcl 3-34 cobol_$initval_flag external static fixed bin(17,0) dcl 3-178 cobol_$link_base_ptr external static pointer dcl 3-14 cobol_$link_max external static fixed bin(17,0) dcl 3-100 cobol_$link_wd_off external static fixed bin(17,0) dcl 3-98 cobol_$list_off external static fixed bin(17,0) dcl 3-154 cobol_$list_ptr external static pointer dcl 3-64 cobol_$ls_charcnt external static fixed bin(17,0) dcl 3-190 cobol_$main_pcs_ptr external static pointer dcl 3-84 cobol_$map_data_max external static fixed bin(17,0) dcl 3-162 cobol_$map_data_ptr external static pointer dcl 3-54 cobol_$max_stack_off external static fixed bin(17,0) dcl 3-122 cobol_$minpral5_ptr external static pointer dcl 3-50 cobol_$misc_base_ptr external static pointer dcl 3-60 cobol_$misc_end_ptr external static pointer dcl 3-62 cobol_$misc_max external static fixed bin(17,0) dcl 3-158 cobol_$next_tag external static fixed bin(17,0) dcl 3-128 cobol_$non_source_offset external static fixed bin(17,0) dcl 3-176 cobol_$ntbuf_ptr external static pointer dcl 3-82 cobol_$obj_seg_name external static char(32) dcl 3-208 cobol_$op_con_ptr external static pointer dcl 3-80 cobol_$para_eop_flag external static fixed bin(17,0) dcl 3-138 cobol_$pd_map_index external static fixed bin(17,0) dcl 3-116 cobol_$pd_map_max external static fixed bin(17,0) dcl 3-160 cobol_$pd_map_ptr external static pointer dcl 3-28 cobol_$pd_map_sw external static fixed bin(17,0) dcl 3-126 cobol_$perform_list_ptr external static pointer dcl 3-36 cobol_$perform_para_index external static fixed bin(17,0) dcl 3-148 cobol_$perform_sect_index external static fixed bin(17,0) dcl 3-150 cobol_$priority_no external static fixed bin(17,0) dcl 3-140 cobol_$ptr_assumption_ind external static fixed bin(17,0) dcl 3-144 cobol_$reg_assumption_ind external static fixed bin(17,0) dcl 3-146 cobol_$reloc_def_base_ptr external static pointer dcl 3-20 cobol_$reloc_def_max external static fixed bin(24,0) dcl 3-108 cobol_$reloc_link_base_ptr external static pointer dcl 3-22 cobol_$reloc_link_max external static fixed bin(24,0) dcl 3-110 cobol_$reloc_sym_base_ptr external static pointer dcl 3-24 cobol_$reloc_sym_max external static fixed bin(24,0) dcl 3-112 cobol_$reloc_text_base_ptr external static pointer dcl 3-18 cobol_$reloc_text_max external static fixed bin(24,0) dcl 3-106 cobol_$reloc_work_base_ptr external static pointer dcl 3-26 cobol_$reloc_work_max external static fixed bin(24,0) dcl 3-114 cobol_$reswd_ptr external static pointer dcl 3-78 cobol_$same_sort_merge_proc external static bit(1) dcl 3-214 cobol_$scratch_dir external static char(168) dcl 3-206 cobol_$sect_eop_flag external static fixed bin(17,0) dcl 3-136 cobol_$seg_init_flag external static fixed bin(17,0) dcl 3-132 cobol_$seg_init_list_ptr external static pointer dcl 3-40 cobol_$stack_off external static fixed bin(17,0) dcl 3-120 cobol_$statement_info_ptr external static pointer dcl 3-76 cobol_$sym_base_ptr external static pointer dcl 3-16 cobol_$sym_max external static fixed bin(17,0) dcl 3-104 cobol_$sym_wd_off external static fixed bin(17,0) dcl 3-102 cobol_$tag_table_max external static fixed bin(17,0) dcl 3-166 cobol_$tag_table_ptr external static pointer dcl 3-52 cobol_$temp_token_area_ptr external static pointer dcl 3-42 cobol_$temp_token_max external static fixed bin(17,0) dcl 3-168 cobol_$temp_token_ptr external static pointer dcl 3-44 cobol_$text_base_ptr external static pointer dcl 3-8 cobol_$token_block1_ptr external static pointer dcl 3-46 cobol_$token_block2_ptr external static pointer dcl 3-48 cobol_$value_cnt external static fixed bin(17,0) dcl 3-194 cobol_$ws_charcnt external static fixed bin(17,0) dcl 3-186 cobol_$ws_wdoff external static fixed bin(17,0) dcl 3-200 cobol_$xref_bypass external static bit(1) dcl 3-212 cobol_$xref_chain_ptr external static pointer dcl 3-74 cobol_$xref_token_ptr external static pointer dcl 3-72 cobol_data_wd_off defined fixed bin(17,0) dcl 3-119 compile_count defined fixed bin(17,0) dcl 3-143 coms_charcnt defined fixed bin(17,0) dcl 3-189 coms_wdoff defined fixed bin(17,0) dcl 3-203 con_end_ptr defined pointer dcl 3-11 con_wd_off defined fixed bin(17,0) dcl 3-93 cons_charcnt defined fixed bin(17,0) dcl 3-193 constant_offset defined fixed bin(17,0) dcl 3-157 data_init_flag defined fixed bin(17,0) dcl 3-131 date_compiled_sw defined fixed bin(17,0) dcl 3-181 debug_enable defined fixed bin(17,0) dcl 3-175 def_base_ptr defined pointer dcl 3-13 def_max defined fixed bin(17,0) dcl 3-97 def_wd_off defined fixed bin(17,0) dcl 3-95 diag_ptr defined pointer dcl 3-71 eln_max defined fixed bin(17,0) dcl 3-173 eln_ptr defined pointer dcl 3-69 fixup_max defined fixed bin(17,0) dcl 3-165 fixup_ptr defined pointer dcl 3-31 fs_charcnt defined fixed bin(17,0) dcl 3-185 fs_wdoff defined fixed bin(17,0) dcl 3-199 include_cnt defined fixed bin(17,0) dcl 3-183 include_info_ptr defined pointer dcl 3-87 init_stack_off defined fixed bin(17,0) dcl 3-125 initval_base_ptr defined pointer dcl 3-33 initval_file_ptr defined pointer dcl 3-35 initval_flag defined fixed bin(17,0) dcl 3-179 link_base_ptr defined pointer dcl 3-15 link_max defined fixed bin(17,0) dcl 3-101 link_wd_off defined fixed bin(17,0) dcl 3-99 list_off defined fixed bin(17,0) dcl 3-155 list_ptr defined pointer dcl 3-65 ls_charcnt defined fixed bin(17,0) dcl 3-191 main_pcs_ptr defined pointer dcl 3-85 map_data_max defined fixed bin(17,0) dcl 3-163 map_data_ptr defined pointer dcl 3-55 max_stack_off defined fixed bin(17,0) dcl 3-123 minpral5_ptr defined pointer dcl 3-51 misc_base_ptr defined pointer dcl 3-61 misc_end_ptr defined pointer dcl 3-63 misc_max defined fixed bin(17,0) dcl 3-159 next_tag defined fixed bin(17,0) dcl 3-129 non_source_offset defined fixed bin(17,0) dcl 3-177 ntbuf_ptr defined pointer dcl 3-83 obj_seg_name defined char(32) dcl 3-209 op_con_ptr defined pointer dcl 3-81 para_eop_flag defined fixed bin(17,0) dcl 3-139 pd_map_index defined fixed bin(17,0) dcl 3-117 pd_map_max defined fixed bin(17,0) dcl 3-161 pd_map_ptr defined pointer dcl 3-29 pd_map_sw defined fixed bin(17,0) dcl 3-127 perform_list_ptr defined pointer dcl 3-37 perform_para_index defined fixed bin(17,0) dcl 3-149 perform_sect_index defined fixed bin(17,0) dcl 3-151 priority_no defined fixed bin(17,0) dcl 3-141 ptr_assumption_ind defined fixed bin(17,0) dcl 3-145 ptr_err internal static structure level 1 unaligned dcl 138 ptr_status_ptr defined pointer dcl 3-57 r automatic fixed bin(17,0) dcl 180 reg_assumption_ind defined fixed bin(17,0) dcl 3-147 reg_err internal static structure level 1 unaligned dcl 134 reg_status_ptr defined pointer dcl 3-59 reloc_def_base_ptr defined pointer dcl 3-21 reloc_def_max defined fixed bin(24,0) dcl 3-109 reloc_link_base_ptr defined pointer dcl 3-23 reloc_link_max defined fixed bin(24,0) dcl 3-111 reloc_sym_base_ptr defined pointer dcl 3-25 reloc_sym_max defined fixed bin(24,0) dcl 3-113 reloc_text_base_ptr defined pointer dcl 3-19 reloc_text_max defined fixed bin(24,0) dcl 3-107 reloc_work_base_ptr defined pointer dcl 3-27 reloc_work_max defined fixed bin(24,0) dcl 3-115 reswd_ptr defined pointer dcl 3-79 same_sort_merge_proc defined bit(1) dcl 3-215 scratch_dir defined char(168) dcl 3-207 sect_eop_flag defined fixed bin(17,0) dcl 3-137 seg_init_flag defined fixed bin(17,0) dcl 3-133 seg_init_list_ptr defined pointer dcl 3-41 stack_off defined fixed bin(17,0) dcl 3-121 statement_info_ptr defined pointer dcl 3-77 sym_base_ptr defined pointer dcl 3-17 sym_max defined fixed bin(17,0) dcl 3-105 sym_wd_off defined fixed bin(17,0) dcl 3-103 tag_table_max defined fixed bin(17,0) dcl 3-167 tag_table_ptr defined pointer dcl 3-53 temp_token_area_ptr defined pointer dcl 3-43 temp_token_max defined fixed bin(17,0) dcl 3-169 temp_token_ptr defined pointer dcl 3-45 text_base_ptr defined pointer dcl 3-9 text_wd_off defined fixed bin(17,0) dcl 3-91 token_block1_ptr defined pointer dcl 3-47 token_block2_ptr defined pointer dcl 3-49 value_cnt defined fixed bin(17,0) dcl 3-195 ws_charcnt defined fixed bin(17,0) dcl 3-187 ws_wdoff defined fixed bin(17,0) dcl 3-201 xref_bypass defined bit(1) dcl 3-213 xref_chain_ptr defined pointer dcl 3-75 xref_token_ptr defined pointer dcl 3-73 NAMES DECLARED BY EXPLICIT CONTEXT. call 000030 constant entry external dcl 37 cobol_pointer_register 000021 constant entry external dcl 29 cont_err 000407 constant label dcl 314 ref 333 355 413 415 455 emit 001111 constant label dcl 459 ref 326 338 348 381 389 406 450 get 000041 constant entry external dcl 51 get_bit_code 002042 constant entry internal dcl 675 ref 590 load 000376 constant label dcl 304 ref 299 load_char 001136 constant label dcl 469 lock_test 001267 constant label dcl 508 ref 502 make_inst 001651 constant entry internal dcl 624 ref 321 325 336 347 361 370 375 388 397 403 423 431 437 445 priority 001337 constant entry external dcl 525 prx 001650 constant label dcl 618 ref 520 reset_test 001243 constant label dcl 499 specific_1 000332 constant label dcl 287 ref 218 231 270 start_call 000035 constant label dcl 45 NAMES DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 314 314 357 418 467 467 492 492 binary builtin function ref 198 fixed builtin function ref 561 565 603 605 mod builtin function ref 259 null builtin function ref 306 314 314 string builtin function set ref 473 480* 644* 649* substr builtin function set ref 198 199 262 280 280 474* 475* 475 481* 481 568 579 649 653 657* 657 658* 658 662* 662 663* 663 664* 664 668* 668 669* 669 670* 670 686 unspec builtin function ref 198 199 262 280 280 568 579 649 653 686 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2522 2604 2352 2532 Length 3064 2352 62 243 150 30 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_pointer_register 181 external procedure is an external procedure. make_inst internal procedure shares stack frame of external procedure cobol_pointer_register. get_bit_code internal procedure shares stack frame of external procedure cobol_pointer_register. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 contents_err cobol_pointer_register 000037 temp_reg cobol_pointer_register STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_pointer_register 000100 i cobol_pointer_register 000101 k cobol_pointer_register 000102 m cobol_pointer_register 000103 save_i cobol_pointer_register 000104 best_yet cobol_pointer_register 000105 best_current cobol_pointer_register 000106 new_wd_off cobol_pointer_register 000107 call_pr_num cobol_pointer_register 000110 reloc_ptr cobol_pointer_register 000112 call_off cobol_pointer_register 000113 inst cobol_pointer_register 000125 reloc cobol_pointer_register 000175 char_no cobol_pointer_register 000176 bit_4 cobol_pointer_register 000200 register_struc cobol_pointer_register 000226 bit_code get_bit_code THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as call_ext_out_desc call_ext_out return_mac mpfx2 mdfx1 ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cobol_emit cobol_register$load cobol_register_util$restore cobol_register_util$restore_pointer cobol_register_util$save_pointer signal_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cobol_$ptr_status_ptr cobol_$reg_status_ptr cobol_$text_wd_off LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 29 000020 32 000026 37 000027 45 000035 51 000036 193 000046 194 000052 196 000060 198 000062 199 000065 201 000070 206 000073 207 000074 208 000101 210 000110 211 000111 216 000116 218 000121 220 000132 222 000142 224 000152 226 000154 231 000155 234 000166 236 000170 238 000204 240 000214 242 000224 248 000226 250 000231 251 000232 254 000234 255 000236 256 000240 259 000242 260 000250 262 000254 263 000257 264 000265 265 000270 266 000274 267 000275 268 000276 270 000277 276 000300 277 000301 280 000311 281 000322 282 000327 283 000330 284 000331 287 000332 289 000343 291 000357 293 000361 294 000362 295 000364 297 000365 299 000367 301 000370 304 000376 306 000377 310 000401 312 000404 314 000407 316 000437 321 000440 324 000456 325 000461 326 000475 331 000476 333 000500 336 000503 338 000517 343 000520 345 000522 347 000527 348 000543 353 000544 355 000546 357 000551 358 000553 361 000563 363 000577 365 000603 366 000604 368 000605 370 000607 372 000625 373 000630 375 000631 377 000643 379 000647 381 000650 386 000651 388 000653 389 000671 394 000672 397 000674 398 000712 401 000720 402 000730 403 000734 406 000746 411 000747 413 000751 415 000753 417 000756 418 000760 419 000762 423 000772 425 001006 427 001012 428 001013 431 001014 433 001032 434 001035 436 001036 437 001046 439 001060 441 001064 443 001065 445 001067 447 001103 448 001106 450 001107 455 001110 459 001111 463 001121 465 001123 466 001124 467 001125 469 001136 471 001137 472 001142 473 001143 474 001146 475 001153 477 001160 478 001161 479 001164 480 001165 481 001170 482 001175 483 001205 484 001207 487 001210 488 001223 489 001225 492 001227 499 001243 502 001253 504 001262 508 001267 512 001301 513 001306 514 001310 516 001323 517 001330 520 001332 525 001333 559 001344 561 001347 563 001373 565 001375 566 001404 568 001413 569 001425 570 001433 572 001434 573 001436 575 001437 577 001443 579 001452 581 001464 582 001472 584 001473 585 001475 586 001477 588 001507 590 001516 591 001527 592 001537 594 001540 595 001542 601 001544 603 001547 605 001570 608 001614 609 001621 610 001626 611 001630 613 001641 614 001646 618 001650 624 001651 643 001653 644 001654 645 001656 646 001665 647 001674 648 001703 649 001712 652 001723 653 001730 655 001735 657 001744 658 001755 659 001762 660 001763 662 001765 663 001776 664 002003 665 002010 666 002011 668 002013 669 002024 670 002031 672 002041 675 002042 682 002044 684 002052 686 002057 688 002064 ----------------------------------------------------------- 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