COMPILATION LISTING OF SEGMENT cobol_display_text 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 0933.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_display_text.pl1 Reformatted code to new Cobol standard. 19* END HISTORY COMMENTS */ 20 21 22 /* Modified on 08/18/83 by FCH, [5.2-1], entry trace added */ 23 /* Modified since Version 5.0 */ 24 25 26 27 /* Program to display output text produced by pl/1 and Fortran. A reduced version of 28* display_text. Numbers in the disassembled instruction are decimal. The offset and 29* the instruction as it apears in core are in octal. 30* 31* The numbers are really in octal, despite comment. Modified by JRDavis 19 Mar 80 32* to not call binoct (which was transfer vector to pl1 compiler lang_util_ MCR 4422 33**/ 34 35 /* format: style3 */ 36 cobol_display_text: 37 proc (t_pt, arg_number, output_switch); 38 39 dcl t_pt ptr, /* points at text base */ 40 arg_number fixed bin, /* max. no. of words to print */ 41 output_switch char (*) aligned, /* switch name for printing disassembled line */ 42 arg_offset fixed bin (18); /* real offset to be printed instead of t_pt */ 43 44 45 dcl number fixed bin; /* no. of words to print */ 46 dcl desc_type fixed bin; /* descriptor type: 0 = alpha, 1 = bit, 2 = numeric */ 47 dcl comment char (50) var; 48 dcl op_name char (32) aligned; 49 dcl (p, pt) ptr, 50 (no_to_print, j, k, m, op_index, irand, nrands, ndesc) 51 fixed bin, 52 (fract_offset, offset, scale) 53 fixed bin (18), 54 (double, eis, eis_desc, need_comma, ext_base, has_ic, decimal) 55 bit (1), 56 ht char (1) int static aligned init (" "), 57 /* tab */ 58 htht char (2) int static aligned init (" "), 59 /* two tabs */ 60 cstring char (12), 61 op_code char (5), 62 tag char (3), 63 line char (256), 64 buff char (12) varying, 65 pl1_operators_$operator_table 66 fixed bin ext; 67 68 dcl repeat_inst bit (1); /* ON for rpd, rpt, rpl */ 69 dcl print_instr bit (1); /* 1= print instr; 0= return formatted string */ 70 dcl real_offset_entry bit (1) unal; /* ON if instruction ptr is different from text location */ 71 dcl real_offset fixed bin (18); /* used with $format, $offset entries */ 72 dcl ioa_$ioa_stream ext entry options (variable); 73 dcl ioa_$rsnnl ext entry options (variable); 74 dcl ioa_ entry options (variable); 75 dcl find_operator_name_ entry (char (*) aligned, ptr, char (32) aligned); 76 77 dcl (addr, addrel, fixed, length, rel, string, substr) 78 builtin; 79 80 81 dcl 1 op_mnemonic_$op_mnemonic 82 (0:1023) ext static aligned, 83 2 opcode char (6) unal, 84 2 dtype fixed bin (2) unal, /* 0 = alpha, 1 = bit, 2 = numeric */ 85 2 num_desc fixed bin (5) unal, 86 2 num_words fixed bin (8) unal; 87 88 89 dcl digit (0:9) char (1) aligned int static init ("0", "1", "2", "3", "4", "5", "6", "7", "8", "9"); 90 /*[5.2-1]*/ 91 dcl instr char (128) varying; 92 93 dcl base (0:7) char (4) aligned int static 94 init ("pr0|", "pr1|", "pr2|", "pr3|", "pr4|", "pr5|", "pr6|", "pr7|"); 95 96 dcl modifier (0:63) char (3) aligned int static 97 init (" ", "au", "qu", "du", "ic", "al", "ql", "dl", "0", "1", "2", "3", "4", "5", "6", "7", 98 "*", "au*", "qu*", "...", "ic*", "al*", "ql*", "...", "0*", "1*", "2*", "3*", "4*", "5*", 99 "6*", "7*", "f", "itp", "...", "its", "sd", "scr", "f2", "f3", "ci", "i", "sc", "ad", "di", 100 "dic", "id", "idc", "*n", "*au", "*qu", "*du", "*ic", "*al", "*ql", "*dl", "*0", "*1", "*2", 101 "*3", "*4", "*5", "*6", "*7"); 102 103 dcl word (0:1) bit (36) aligned based (p); 104 105 dcl 1 instruction based (p) aligned, 106 2 base unaligned bit (3), 107 2 offset unaligned bit (15), 108 2 op_code unaligned bit (10), 109 2 inhibit unaligned bit (1), 110 2 ext_base unaligned bit (1), 111 2 tag unaligned bit (6); 112 113 dcl 1 half based (p) aligned, 114 2 left unaligned bit (18), 115 2 right unaligned bit (18); 116 117 dcl 1 mod_factor aligned, 118 2 ext_base bit (1) unal, 119 2 length_in_reg bit (1) unal, 120 2 indirect_descriptor 121 bit (1) unal, 122 2 tag bit (4) unal; 123 124 dcl mf (3) fixed bin (6) int static init (30, 12, 3); 125 /* location of modification factor fields in EIS inst */ 126 127 dcl 1 packed_ptr_st based aligned, 128 2 packed_ptr ptr unal; 129 130 dcl (ebase, len_reg, ic) 131 (3) bit (1) aligned; 132 dcl desc_word char (8) varying; 133 134 dcl desc_op (0:3) char (8) varying int static init ("desc9a", "descb", "desc9fl", "desc9ls"); 135 136 dcl eis_modifier (0:15) char (3) aligned int static 137 init ("n", "au", "qu", "du", "ic", "al", "ql", "...", "x0", "x1", "x2", "x3", "x4", "x5", 138 "x6", "x7"); 139 140 dcl bool_word (0:15) char (6) aligned int static varying 141 init ("clear", "and", "andnot", "move", "", "", "xor", "or", "", "", "", "", "invert", "", 142 "nand", "set"); 143 144 dcl 1 descriptor based aligned, /* EIS descriptor */ 145 2 address bit (18) unal, 146 2 char bit (2) unal, 147 2 bit bit (4) unal, 148 2 length bit (12) unal; 149 150 /* */ 151 152 number = arg_number; 153 print_instr = "1"b; 154 real_offset_entry = "0"b; 155 p = t_pt; 156 157 begin: 158 substr (line, 11, 3) = " "; 159 eis = "0"b; 160 irand = 0; 161 162 do no_to_print = 1 to number; 163 164 comment = ""; 165 tag = " "; 166 substr (line, 7, 2) = " "; 167 cstring = binoct (p -> word (0)); 168 169 if eis 170 then op_index = 0; 171 172 else do; 173 op_index = fixed (p -> instruction.op_code, 10); 174 op_code = opcode (op_index); 175 end; 176 177 if num_words (op_index) > 1 178 then call eis_instruction; 179 180 else do; 181 has_ic, double, repeat_inst = "0"b; 182 183 eis_desc = eis & desc_word ^= "arg"; 184 if eis_desc 185 then call eis_descriptor; 186 187 else do; 188 substr (line, 13, 2) = " "; 189 substr (line, 15, 6) = substr (cstring, 2, 5); 190 substr (line, 21, 5) = substr (cstring, 7, 4); 191 substr (line, 26, 8) = substr (cstring, 11, 2) || ht || op_code; 192 k = 34; 193 194 ext_base = p -> instruction.ext_base; 195 196 if op_code = "rpd " | op_code = "rpt " | op_code = "rpl " 197 then do; 198 repeat_inst = "1"b; 199 call ioa_$rsnnl ("^d", tag, j, fixed (p -> instruction.tag, 6)); 200 offset = fixed (substr (p -> half.left, 1, 8), 8); 201 substr (line, 14, 1) = cstring; 202 call ioa_$rsnnl (" ^d", buff, j, offset); 203 substr (line, k, j) = buff; 204 k = k + j; 205 end; 206 207 else do; 208 if num_desc (op_index) ^= 0 209 then tag = substr (binoct ((p -> instruction.tag)), 1, 2); 210 211 else do; 212 if p -> instruction.tag 213 then tag = modifier (fixed (p -> instruction.tag, 6)); 214 double = 215 substr (op_code, 1, 2) = "df" 216 | substr (op_code, 3, 2) = "aq" 217 | substr (op_code, 4, 2) = "aq"; 218 has_ic = p -> instruction.tag = "000100"b; 219 /* IC */ 220 end; 221 call address; 222 end; 223 224 call set_tag; 225 end; 226 227 /* Print data referred to by self relative address: (tab) (tab) data offset = contents */ 228 229 /*[5.2-1]*/ 230 if print_instr & has_ic 231 then do; 232 if real_offset_entry 233 then pt = ptr (p, real_offset + offset - irand); 234 else pt = addrel (p, offset - irand); 235 substr (line, k, 8) = htht || binoct (rel (pt)); 236 k = k + 8; 237 238 if substr (op_code, 1, 1) ^= "t" 239 then do; 240 comment = " = " || binoct (pt -> word (0)); 241 if double 242 then comment = comment || " " || binoct (pt -> word (1)); 243 end; 244 end; 245 246 else if ext_base & (p -> instruction.base = "000"b) 247 then do; /* info for pr0 only */ 248 249 if op_code = "xec " 250 then do; 251 pt = addrel (addr (pl1_operators_$operator_table), offset); 252 op_index = fixed (pt -> instruction.op_code, 10); 253 if num_words (op_index) > 1 254 then do; 255 256 /* we are executing an EIS instruction in pl1_operators_ */ 257 258 call init_eis; 259 260 do j = 1 to ndesc; 261 ebase (j) = "1"b; 262 len_reg (j) = ^decimal; 263 ic (j) = "0"b; 264 end; 265 end; 266 end; 267 268 if tag ^= " " 269 then do; 270 call find_operator_name_ ("pl1_operators_", p, op_name); 271 if op_name ^= " " 272 then do; 273 substr (line, k, 34) = htht || op_name; 274 k = k + 34; 275 end; 276 277 end; 278 end; 279 if ^eis_desc & ^repeat_inst & p -> instruction.inhibit 280 then comment = comment || " interrupt inhibit"; 281 282 end; 283 284 if comment ^= "" 285 then do; 286 j = length (comment); 287 substr (line, k, j) = comment; 288 k = k + j; 289 end; 290 291 if print_instr 292 then call ioa_$ioa_stream (output_switch, "^6o ^a", fixed (rel (p), 17), substr (line, 11, k - 11)); 293 294 else do; /* return string for one line only */ 295 j = k - 11; /* save length of strjng */ 296 k = 1; 297 call bin_to_oct (real_offset); 298 instr = substr (line, 1, k - 1) || substr (line, 11, j); 299 /*[5.2-1]*/ 300 call ioa_ ("^40x^a", instr); 301 end; 302 303 if eis 304 then do; 305 irand = irand + 1; 306 if irand > nrands 307 then do; 308 eis = "0"b; 309 irand = 0; 310 end; 311 else if irand > ndesc 312 then op_code, desc_word = "arg"; 313 end; 314 315 p = addrel (p, 1); 316 end; 317 318 return; 319 320 321 /* */ 322 /* Entry point to return a formatted string with the disassembled instruction. The 323* real offset is returned in the string. */ 324 325 trace: 326 entry (t_pt, arg_number); 327 328 329 p = t_pt; /*[5.2-1]*/ 330 real_offset = 0; /*[5.2-1]*/ 331 number = arg_number; /* process one word only */ 332 print_instr = "0"b; /* return string instead */ 333 real_offset_entry = "1"b; 334 go to begin; 335 336 bin_to_oct: 337 proc (number); 338 339 dcl (m, number) fixed bin (18); 340 341 call ioa_$rsnnl ("^d", buff, m, number); 342 substr (line, k, m) = buff; 343 k = k + m; 344 345 end bin_to_oct; 346 347 348 init_eis: 349 proc; 350 351 eis = "1"b; 352 nrands = num_words (op_index) - 1; 353 ndesc = num_desc (op_index); 354 decimal = dtype (op_index) = 2; 355 desc_word = desc_op (dtype (op_index)); 356 desc_type = dtype (op_index); 357 irand = 0; 358 359 end init_eis; 360 361 /* */ 362 eis_instruction: 363 proc; 364 365 call init_eis; 366 367 substr (line, 13, 4) = substr (cstring, 1, 3); 368 substr (line, 17, 4) = substr (cstring, 4, 3); 369 substr (line, 21, 4) = substr (cstring, 7, 3); 370 substr (line, 25, 3) = substr (cstring, 10, 3); 371 372 substr (line, 28, 1) = ht; 373 substr (line, 29, 5) = op_code; 374 substr (line, 34, 1) = ht; 375 376 k = 35; 377 378 do j = 1 to ndesc; 379 string (mod_factor) = substr (p -> word (0), mf (j), 7); 380 ebase (j) = mod_factor.ext_base; 381 len_reg (j) = mod_factor.length_in_reg; 382 383 substr (line, k, 1) = "("; 384 k = k + 1; 385 need_comma = "0"b; 386 387 if ebase (j) 388 then do; 389 substr (line, k, 2) = "pr"; 390 k = k + 2; 391 need_comma = "1"b; 392 end; 393 394 if len_reg (j) 395 then do; 396 if need_comma 397 then do; 398 substr (line, k, 1) = ","; 399 k = k + 1; 400 end; 401 substr (line, k, 2) = "rl"; 402 k = k + 2; 403 need_comma = "1"b; 404 end; 405 406 if mod_factor.tag 407 then do; 408 if need_comma 409 then do; 410 substr (line, k, 1) = ","; 411 k = k + 1; 412 end; 413 ic (j) = mod_factor.tag = "0100"b; /* IC */ 414 substr (line, k, 2) = eis_modifier (fixed (mod_factor.tag, 4)); 415 k = k + 2; 416 end; 417 else ic (j) = "0"b; 418 419 substr (line, k, 2) = "),"; 420 k = k + 2; 421 end; 422 423 424 if substr (p -> word (0), 10, 1) 425 then do; 426 substr (line, k, 12) = "enablefault,"; 427 k = k + 12; 428 end; 429 430 if desc_word = "desc9a" 431 then if ndesc < 3 432 then do; 433 if substr (op_code, 1, 2) ^= "sc" 434 then substr (line, k, 5) = "fill("; 435 else substr (line, k, 5) = "mask("; 436 k = k + 5; 437 substr (line, k, 3) = substr (cstring, 1, 3); 438 k = k + 3; 439 substr (line, k, 1) = ")"; 440 k = k + 1; 441 end; 442 else k = k - 1; 443 else if desc_word = "descb" 444 then do; 445 substr (line, k, 7) = "fill(" || digit (fixed (substr (p -> word (0), 1, 1), 1)) || ")"; 446 /* fill(N) */ 447 k = k + 7; 448 449 if op_code ^= "cmpb " 450 then do; 451 substr (line, k, 6) = ",bool("; 452 k = k + 6; 453 j = fixed (substr (p -> word (0), 6, 4), 4); 454 m = length (bool_word (j)); 455 if m > 0 456 then do; 457 substr (line, k, m) = bool_word (j); 458 k = k + m; 459 end; 460 else do; 461 substr (line, k, 1) = digit (fixed (substr (p -> word (0), 6, 1), 1)); 462 substr (line, k + 1, 1) = digit (fixed (substr (p -> word (0), 7, 3), 3)); 463 k = k + 2; 464 end; 465 substr (line, k, 1) = ")"; 466 k = k + 1; 467 end; 468 end; 469 else if substr (p -> word (0), 11, 1) 470 then do; 471 substr (line, k, 5) = "round"; 472 k = k + 5; 473 end; 474 else k = k - 1; 475 476 return; 477 478 end eis_instruction; 479 480 /* */ 481 482 eis_descriptor: 483 proc; 484 485 dcl len fixed bin (18); 486 dcl type fixed bin; /* descriptor type */ 487 488 dcl 1 n_desc aligned based (p), 489 2 y bit (18) unal, /* address field */ 490 2 CN bit (3) unal, /* character position */ 491 2 TN bit (1) unal, /* type 0 = 9bit; 1 = 4 bit */ 492 2 S bit (2) unal, /* sign type 0 = fl, 1 = ls, 2 = ts, 3 = ns */ 493 2 SF bit (6) unal, /* scale factor */ 494 2 N bit (6) unal; /* length */ 495 496 dcl 1 b_desc aligned based (p), /* bit descriptor */ 497 2 y bit (18) unal, /* address field */ 498 2 c bit (2) unal, /* 9 bit offset */ 499 2 b bit (4) unal, /* bit offset */ 500 2 N bit (12) unal; /* length */ 501 502 dcl 1 a_desc aligned based (p), /* alpha-numeric descriptor */ 503 2 y bit (18) unal, /* address field */ 504 2 CN bit (3) unal, /* character offset */ 505 2 TA bit (2) unal, 506 2 pad bit (1) unal, /* always zero */ 507 2 N bit (12) unal; /* length */ 508 509 dcl table_n_S (0:3) char (2) int static init ("fl", "ls", "ts", "ns"); 510 dcl table_a_TA (0:3) char (1) int static init ("9", "6", "4", "?"); 511 512 substr (line, 13, 2) = " "; 513 substr (line, 15, 6) = substr (cstring, 2, 5); 514 substr (line, 21, 3) = substr (cstring, 7, 2); 515 substr (line, 24, 4) = substr (cstring, 9, 4); 516 substr (line, 28, 1) = ht; 517 518 ext_base = ebase (irand); 519 has_ic = ic (irand); 520 521 type = desc_type; 522 if op_code = "btd" & irand = 1 523 then type = 0; 524 else if op_code = "dtb" | op_code = "mvne" 525 then if irand > 1 526 then type = 0; 527 528 if type = 0 529 then do; /* alpha-nummeric descriptor */ 530 desc_word = "desc" || table_a_TA (fixed (a_desc.TA, 2)) || "a"; 531 if a_desc.TA = "00"b 532 then fract_offset = fixed (substr (a_desc.CN, 1, 2), 2); 533 else fract_offset = fixed (a_desc.CN, 3); 534 len = fixed (a_desc.N, 12); 535 end; 536 537 else if type = 1 538 then do; /* bit descriptor */ 539 desc_word = "descb"; 540 len = fixed (b_desc.N, 12); 541 fract_offset = fixed (b_desc.c, 2) * 9 + fixed (b_desc.b, 4); 542 end; 543 544 else do; /* numeric descriptor */ 545 if n_desc.TN 546 then do; 547 desc_word = "desc4"; 548 fract_offset = fixed (n_desc.CN, 3); 549 end; 550 else do; 551 desc_word = "desc9"; 552 fract_offset = fixed (substr (n_desc.CN, 1, 2), 2); 553 end; 554 desc_word = desc_word || table_n_S (fixed (n_desc.S, 2)); 555 len = fixed (n_desc.N, 6); 556 557 if n_desc.S 558 then do; /* for S = 00 there is no scale factor */ 559 scale = fixed (n_desc.SF, 6); 560 if scale > 32 561 then scale = scale - 64; 562 end; 563 end; 564 565 /* desc_word address(fract_offset),tag,length,scale */ 566 567 k = length (desc_word); 568 substr (line, 29, k) = desc_word; 569 k = k + 29; 570 call address; 571 572 if fract_offset ^= 0 573 then do; 574 call ioa_$rsnnl ("(^d)", buff, j, fract_offset); 575 substr (line, k, j) = buff; 576 k = k + j; 577 end; 578 579 if len_reg (irand) 580 then do; /* print register which contains length */ 581 tag = eis_modifier (fixed (substr (p -> descriptor.length, 9, 4), 4)); 582 call set_tag; 583 end; 584 585 else do; /* print length as given */ 586 substr (line, k, 1) = ","; 587 k = k + 1; 588 call bin_to_oct (len); 589 end; 590 591 if type = 2 592 then if n_desc.S 593 then do; /* scale factor for numeric only */ 594 substr (line, k, 1) = ","; 595 k = k + 1; 596 call bin_to_oct (scale); 597 end; 598 599 return; 600 601 end eis_descriptor; 602 603 /* */ 604 605 /* This procedure disassembles the address portion. It adds: tab [prN|] offset 606* It also sets the first octal digit so a blank will separate the register from the rest of the address field. 607* 608* cstring The octal representation of the word. 609* 610* ext_base ON if the address uses a register. 611**/ 612 613 address: 614 proc; 615 616 substr (line, k, 1) = ht; 617 k = k + 1; 618 619 if ext_base 620 then do; 621 substr (line, k, 4) = base (fixed (p -> instruction.base, 3)); 622 offset = fixed (p -> instruction.offset, 15); 623 if offset > 16384 624 then offset = offset - 32768; 625 k = k + 4; 626 substr (line, 13, 1) = cstring; 627 end; 628 629 else do; 630 offset = fixed (p -> half.left, 18); 631 if offset > 131072 632 then if tag ^= "du " & tag ^= "dl " 633 then offset = offset - 262144; /* 2's comp */ 634 substr (line, 14, 1) = cstring; 635 end; 636 637 638 call bin_to_oct (offset); 639 640 end address; 641 642 643 /* This procedure sets the tag in the instruction line. */ 644 645 set_tag: 646 proc; 647 648 if tag ^= " " 649 then do; 650 substr (line, k, 4) = "," || tag; 651 k = k + 2; 652 if substr (line, k, 1) ^= " " 653 then k = k + 1; 654 if substr (line, k, 1) ^= " " 655 then k = k + 1; 656 end; 657 658 return; 659 end set_tag; 660 661 binoct: 662 proc (bits) returns (char (12) aligned); 663 dcl bits bit (*) aligned parameter; 664 dcl c12 char (12) aligned; 665 666 call ioa_$rsnnl ("^12.3b", c12, j, bits); 667 return (c12); 668 end binoct; 669 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0830.1 cobol_display_text.pl1 >spec>install>MR12.3-1048>cobol_display_text.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. CN 0(18) based bit(3) level 2 in structure "a_desc" packed packed unaligned dcl 502 in procedure "eis_descriptor" ref 531 533 CN 0(18) based bit(3) level 2 in structure "n_desc" packed packed unaligned dcl 488 in procedure "eis_descriptor" ref 548 552 N 0(24) based bit(12) level 2 in structure "a_desc" packed packed unaligned dcl 502 in procedure "eis_descriptor" ref 534 N 0(24) based bit(12) level 2 in structure "b_desc" packed packed unaligned dcl 496 in procedure "eis_descriptor" ref 540 N 0(30) based bit(6) level 2 in structure "n_desc" packed packed unaligned dcl 488 in procedure "eis_descriptor" ref 555 S 0(22) based bit(2) level 2 packed packed unaligned dcl 488 ref 554 557 591 SF 0(24) based bit(6) level 2 packed packed unaligned dcl 488 ref 559 TA 0(21) based bit(2) level 2 packed packed unaligned dcl 502 ref 530 531 TN 0(21) based bit(1) level 2 packed packed unaligned dcl 488 ref 545 a_desc based structure level 1 dcl 502 addr builtin function dcl 77 ref 251 addrel builtin function dcl 77 ref 234 251 315 arg_number parameter fixed bin(17,0) dcl 39 ref 36 152 325 331 b 0(20) based bit(4) level 2 packed packed unaligned dcl 496 ref 541 b_desc based structure level 1 dcl 496 base 000223 constant char(4) initial array dcl 93 in procedure "cobol_display_text" ref 621 base based bit(3) level 2 in structure "instruction" packed packed unaligned dcl 105 in procedure "cobol_display_text" ref 246 621 bits parameter bit dcl 663 set ref 661 666* bool_word 000004 constant varying char(6) initial array dcl 140 ref 454 457 buff 000265 automatic varying char(12) dcl 49 set ref 202* 203 341* 342 574* 575 c 0(18) based bit(2) level 2 packed packed unaligned dcl 496 ref 541 c12 000436 automatic char(12) dcl 664 set ref 666* 667 comment 000102 automatic varying char(50) dcl 47 set ref 164* 240* 241* 241 279* 279 284 286 287 cstring 000156 automatic char(12) packed unaligned dcl 49 set ref 167* 189 190 191 201 367 368 369 370 437 513 514 515 626 634 decimal 000155 automatic bit(1) packed unaligned dcl 49 set ref 262 354* desc_op 000104 constant varying char(8) initial array dcl 134 ref 355 desc_type 000101 automatic fixed bin(17,0) dcl 46 set ref 356* 521 desc_word 000350 automatic varying char(8) dcl 132 set ref 183 311* 355* 430 443 530* 539* 547* 551* 554* 554 567 568 descriptor based structure level 1 dcl 144 digit 000233 constant char(1) initial array dcl 89 ref 445 461 462 double 000147 automatic bit(1) packed unaligned dcl 49 set ref 181* 214* 241 dtype 1(18) 000022 external static fixed bin(2,0) array level 2 packed packed unaligned dcl 81 ref 354 355 356 ebase 000337 automatic bit(1) array dcl 130 set ref 261* 380* 387 518 eis 000150 automatic bit(1) packed unaligned dcl 49 set ref 159* 169 183 303 308* 351* eis_desc 000151 automatic bit(1) packed unaligned dcl 49 set ref 183* 184 279 eis_modifier 000064 constant char(3) initial array dcl 136 ref 414 581 ext_base 0(29) based bit(1) level 2 in structure "instruction" packed packed unaligned dcl 105 in procedure "cobol_display_text" ref 194 ext_base 000153 automatic bit(1) packed unaligned dcl 49 in procedure "cobol_display_text" set ref 194* 246 518* 619 ext_base 000336 automatic bit(1) level 2 in structure "mod_factor" packed packed unaligned dcl 117 in procedure "cobol_display_text" set ref 380 find_operator_name_ 000020 constant entry external dcl 75 ref 270 fixed builtin function dcl 77 ref 173 199 199 200 212 252 291 291 414 445 453 461 462 530 531 533 534 540 541 541 548 552 554 555 559 581 621 622 630 fract_offset 000144 automatic fixed bin(18,0) dcl 49 set ref 531* 533* 541* 548* 552* 572 574* half based structure level 1 dcl 113 has_ic 000154 automatic bit(1) packed unaligned dcl 49 set ref 181* 218* 230 519* ht constant char(1) initial dcl 49 ref 191 372 374 516 616 htht 003040 constant char(2) initial dcl 49 ref 235 273 ic 000345 automatic bit(1) array dcl 130 set ref 263* 413* 417* 519 inhibit 0(28) based bit(1) level 2 packed packed unaligned dcl 105 ref 279 instr 000275 automatic varying char(128) dcl 91 set ref 298* 300* instruction based structure level 1 dcl 105 ioa_ 000016 constant entry external dcl 74 ref 300 ioa_$ioa_stream 000012 constant entry external dcl 72 ref 291 ioa_$rsnnl 000014 constant entry external dcl 73 ref 199 202 341 574 666 irand 000141 automatic fixed bin(17,0) dcl 49 set ref 160* 232 234 305* 305 306 309* 311 357* 518 519 522 524 579 j 000135 automatic fixed bin(17,0) dcl 49 set ref 199* 202* 203 204 260* 261 262 263* 286* 287 288 295* 298 378* 379 380 381 387 394 413 417* 453* 454 457 574* 575 576 666* k 000136 automatic fixed bin(17,0) dcl 49 set ref 192* 203 204* 204 235 236* 236 273 274* 274 287 288* 288 291 291 295 296* 298 342 343* 343 376* 383 384* 384 389 390* 390 398 399* 399 401 402* 402 410 411* 411 414 415* 415 419 420* 420 426 427* 427 433 435 436* 436 437 438* 438 439 440* 440 442* 442 445 447* 447 451 452* 452 457 458* 458 461 462 463* 463 465 466* 466 471 472* 472 474* 474 567* 568 569* 569 575 576* 576 586 587* 587 594 595* 595 616 617* 617 621 625* 625 650 651* 651 652 652* 652 654 654* 654 left based bit(18) level 2 packed packed unaligned dcl 113 ref 200 630 len 000412 automatic fixed bin(18,0) dcl 485 set ref 534* 540* 555* 588* len_reg 000342 automatic bit(1) array dcl 130 set ref 262* 381* 394 579 length builtin function dcl 77 in procedure "cobol_display_text" ref 286 454 567 length 0(24) based bit(12) level 2 in structure "descriptor" packed packed unaligned dcl 144 in procedure "cobol_display_text" ref 581 length_in_reg 0(01) 000336 automatic bit(1) level 2 packed packed unaligned dcl 117 set ref 381 line 000165 automatic char(256) packed unaligned dcl 49 set ref 157* 166* 188* 189* 190* 191* 201* 203* 235* 273* 287* 291 291 298 298 342* 367* 368* 369* 370* 372* 373* 374* 383* 389* 398* 401* 410* 414* 419* 426* 433* 435* 437* 439* 445* 451* 457* 461* 462* 465* 471* 512* 513* 514* 515* 516* 568* 575* 586* 594* 616* 621* 626* 634* 650* 652 654 m 000364 automatic fixed bin(18,0) dcl 339 in procedure "bin_to_oct" set ref 341* 342 343 m 000137 automatic fixed bin(17,0) dcl 49 in procedure "cobol_display_text" set ref 454* 455 457 458 mf 000120 constant fixed bin(6,0) initial array dcl 124 ref 379 mod_factor 000336 automatic structure level 1 dcl 117 set ref 379* modifier 000123 constant char(3) initial array dcl 96 ref 212 n_desc based structure level 1 dcl 488 ndesc 000143 automatic fixed bin(17,0) dcl 49 set ref 260 311 353* 378 430 need_comma 000152 automatic bit(1) packed unaligned dcl 49 set ref 385* 391* 396 403* 408 no_to_print 000134 automatic fixed bin(17,0) dcl 49 set ref 162* nrands 000142 automatic fixed bin(17,0) dcl 49 set ref 306 352* num_desc 1(21) 000022 external static fixed bin(5,0) array level 2 packed packed unaligned dcl 81 ref 208 353 num_words 1(27) 000022 external static fixed bin(8,0) array level 2 packed packed unaligned dcl 81 ref 177 253 352 number parameter fixed bin(18,0) dcl 339 in procedure "bin_to_oct" set ref 336 341* number 000100 automatic fixed bin(17,0) dcl 45 in procedure "cobol_display_text" set ref 152* 162 331* offset 0(03) based bit(15) level 2 in structure "instruction" packed packed unaligned dcl 105 in procedure "cobol_display_text" ref 622 offset 000145 automatic fixed bin(18,0) dcl 49 in procedure "cobol_display_text" set ref 200* 202* 232 234 251 622* 623 623* 623 630* 631 631* 631 638* op_code 0(18) based bit(10) level 2 in structure "instruction" packed packed unaligned dcl 105 in procedure "cobol_display_text" ref 173 252 op_code 000162 automatic char(5) packed unaligned dcl 49 in procedure "cobol_display_text" set ref 174* 191 196 196 196 214 214 214 238 249 311* 373 433 449 522 524 524 op_index 000140 automatic fixed bin(17,0) dcl 49 set ref 169* 173* 174 177 208 252* 253 352 353 354 355 356 op_mnemonic_$op_mnemonic 000022 external static structure array level 1 dcl 81 op_name 000120 automatic char(32) dcl 48 set ref 270* 271 273 opcode 000022 external static char(6) array level 2 packed packed unaligned dcl 81 ref 174 output_switch parameter char dcl 39 set ref 36 291* p 000130 automatic pointer dcl 49 set ref 155* 167 173 194 199 199 200 208 212 212 218 232 234 246 270* 279 291 291 315* 315 329* 379 424 445 453 461 462 469 530 531 531 533 534 540 541 541 545 548 552 554 555 557 559 581 591 621 622 630 pl1_operators_$operator_table 000010 external static fixed bin(17,0) dcl 49 set ref 251 print_instr 000272 automatic bit(1) packed unaligned dcl 69 set ref 153* 230 291 332* pt 000132 automatic pointer dcl 49 set ref 232* 234* 235 235 240 241 251* 252 real_offset 000274 automatic fixed bin(18,0) dcl 71 set ref 232 297* 330* real_offset_entry 000273 automatic bit(1) packed unaligned dcl 70 set ref 154* 232 333* rel builtin function dcl 77 ref 235 235 291 291 repeat_inst 000271 automatic bit(1) packed unaligned dcl 68 set ref 181* 198* 279 scale 000146 automatic fixed bin(18,0) dcl 49 set ref 559* 560 560* 560 596* string builtin function dcl 77 set ref 379* substr builtin function dcl 77 set ref 157* 166* 188* 189* 189 190* 190 191* 191 200 201* 203* 208 214 214 214 235* 238 273* 287* 291 291 298 298 342* 367* 367 368* 368 369* 369 370* 370 372* 373* 374* 379 383* 389* 398* 401* 410* 414* 419* 424 426* 433 433* 435* 437* 437 439* 445* 445 451* 453 457* 461* 461 462* 462 465* 469 471* 512* 513* 513 514* 514 515* 515 516* 531 552 568* 575* 581 586* 594* 616* 621* 626* 634* 650* 652 654 t_pt parameter pointer dcl 39 ref 36 155 325 329 table_a_TA 000000 constant char(1) initial array packed unaligned dcl 510 ref 530 table_n_S 000002 constant char(2) initial array packed unaligned dcl 509 ref 554 tag 000164 automatic char(3) packed unaligned dcl 49 in procedure "cobol_display_text" set ref 165* 199* 208* 212* 268 581* 631 631 648 650 tag 0(03) 000336 automatic bit(4) level 2 in structure "mod_factor" packed packed unaligned dcl 117 in procedure "cobol_display_text" set ref 406 413 414 tag 0(30) based bit(6) level 2 in structure "instruction" packed packed unaligned dcl 105 in procedure "cobol_display_text" ref 199 199 208 212 212 218 type 000413 automatic fixed bin(17,0) dcl 486 set ref 521* 522* 524* 528 537 591 word based bit(36) array dcl 103 set ref 167* 240* 241* 379 424 445 453 461 462 469 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. arg_offset automatic fixed bin(18,0) dcl 39 packed_ptr_st based structure level 1 dcl 127 NAMES DECLARED BY EXPLICIT CONTEXT. address 002577 constant entry internal dcl 613 ref 221 570 begin 000412 constant label dcl 157 ref 334 bin_to_oct 001517 constant entry internal dcl 336 ref 297 588 596 638 binoct 002717 constant entry internal dcl 661 ref 167 208 235 240 241 cobol_display_text 000366 constant entry external dcl 36 eis_descriptor 002222 constant entry internal dcl 482 ref 184 eis_instruction 001625 constant entry internal dcl 362 ref 177 init_eis 001561 constant entry internal dcl 348 ref 258 365 set_tag 002656 constant entry internal dcl 645 ref 224 582 trace 001477 constant entry external dcl 325 NAME DECLARED BY CONTEXT OR IMPLICATION. ptr builtin function ref 232 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3156 3202 3045 3166 Length 3400 3045 24 161 110 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_display_text 404 external procedure is an external procedure. bin_to_oct internal procedure shares stack frame of external procedure cobol_display_text. init_eis internal procedure shares stack frame of external procedure cobol_display_text. eis_instruction internal procedure shares stack frame of external procedure cobol_display_text. eis_descriptor internal procedure shares stack frame of external procedure cobol_display_text. address internal procedure shares stack frame of external procedure cobol_display_text. set_tag internal procedure shares stack frame of external procedure cobol_display_text. binoct internal procedure shares stack frame of external procedure cobol_display_text. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_display_text 000100 number cobol_display_text 000101 desc_type cobol_display_text 000102 comment cobol_display_text 000120 op_name cobol_display_text 000130 p cobol_display_text 000132 pt cobol_display_text 000134 no_to_print cobol_display_text 000135 j cobol_display_text 000136 k cobol_display_text 000137 m cobol_display_text 000140 op_index cobol_display_text 000141 irand cobol_display_text 000142 nrands cobol_display_text 000143 ndesc cobol_display_text 000144 fract_offset cobol_display_text 000145 offset cobol_display_text 000146 scale cobol_display_text 000147 double cobol_display_text 000150 eis cobol_display_text 000151 eis_desc cobol_display_text 000152 need_comma cobol_display_text 000153 ext_base cobol_display_text 000154 has_ic cobol_display_text 000155 decimal cobol_display_text 000156 cstring cobol_display_text 000162 op_code cobol_display_text 000164 tag cobol_display_text 000165 line cobol_display_text 000265 buff cobol_display_text 000271 repeat_inst cobol_display_text 000272 print_instr cobol_display_text 000273 real_offset_entry cobol_display_text 000274 real_offset cobol_display_text 000275 instr cobol_display_text 000336 mod_factor cobol_display_text 000337 ebase cobol_display_text 000342 len_reg cobol_display_text 000345 ic cobol_display_text 000350 desc_word cobol_display_text 000364 m bin_to_oct 000412 len eis_descriptor 000413 type eis_descriptor 000436 c12 binoct THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as r_ne_as alloc_char_temp cat_realloc_chars call_ext_out_desc return_mac shorten_stack ext_entry ext_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. find_operator_name_ ioa_ ioa_$ioa_stream ioa_$rsnnl THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. op_mnemonic_$op_mnemonic pl1_operators_$operator_table LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 36 000362 152 000401 153 000404 154 000406 155 000407 157 000412 159 000415 160 000416 162 000417 164 000427 165 000430 166 000432 167 000434 169 000454 173 000460 174 000464 177 000473 181 000507 183 000512 184 000521 188 000524 189 000526 190 000534 191 000543 192 000560 194 000562 196 000566 198 000575 199 000577 200 000630 201 000633 202 000636 203 000665 204 000673 205 000675 208 000676 212 000717 214 000726 218 000750 221 000754 224 000755 230 000756 232 000762 234 000773 235 001000 236 001021 238 001024 240 001030 241 001060 243 001133 244 001134 246 001135 249 001142 251 001145 252 001153 253 001157 258 001166 260 001170 261 001177 262 001201 263 001204 264 001205 268 001207 270 001217 271 001246 273 001252 274 001261 279 001263 284 001304 286 001311 287 001313 288 001320 291 001321 294 001371 295 001372 296 001375 297 001377 298 001401 300 001424 303 001444 305 001446 306 001447 308 001452 309 001453 310 001454 311 001455 315 001465 316 001470 318 001472 325 001473 329 001504 330 001510 331 001511 332 001513 333 001514 334 001516 336 001517 341 001521 342 001550 343 001556 345 001560 348 001561 351 001562 352 001564 353 001576 354 001602 355 001610 356 001621 357 001623 359 001624 362 001625 365 001626 367 001627 368 001633 369 001641 370 001650 372 001653 373 001655 374 001660 376 001662 378 001664 379 001673 380 001701 381 001705 383 001711 384 001715 385 001716 387 001717 389 001721 390 001725 391 001727 394 001731 396 001733 398 001735 399 001741 401 001742 402 001746 403 001750 406 001752 408 001757 410 001761 411 001765 413 001766 414 001772 415 002001 416 002003 417 002004 419 002005 420 002011 421 002013 424 002015 426 002020 427 002024 430 002026 433 002036 435 002047 436 002053 437 002055 438 002061 439 002063 440 002067 441 002070 442 002071 443 002074 445 002101 447 002121 449 002123 451 002126 452 002132 453 002134 454 002140 455 002144 457 002145 458 002154 459 002155 461 002156 462 002166 463 002175 465 002177 466 002203 468 002204 469 002205 471 002210 472 002214 473 002216 474 002217 476 002221 482 002222 512 002223 513 002225 514 002233 515 002241 516 002245 518 002247 519 002252 521 002254 522 002256 524 002271 528 002311 530 002313 531 002337 533 002346 534 002352 535 002355 537 002356 539 002360 540 002365 541 002370 542 002402 545 002403 547 002406 548 002413 549 002417 551 002420 552 002425 554 002431 555 002452 557 002455 559 002457 560 002463 567 002467 568 002471 569 002475 570 002477 572 002500 574 002502 575 002531 576 002537 579 002541 581 002544 582 002550 583 002551 586 002552 587 002556 588 002557 591 002561 594 002567 595 002573 596 002574 599 002576 613 002577 616 002600 617 002604 619 002605 621 002607 622 002616 623 002622 625 002626 626 002630 627 002632 630 002633 631 002636 634 002650 638 002653 640 002655 645 002656 648 002657 650 002667 651 002700 652 002702 654 002710 658 002716 661 002717 666 002730 667 002761 ----------------------------------------------------------- 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