COMPILATION LISTING OF SEGMENT cobol_search_gen Compiled by: Multics PL/I Compiler, Release 31b, of April 24, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 05/24/89 0956.0 mst Wed Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 15 /****^ HISTORY COMMENTS: 16* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060), 17* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 18* MCR8060 cobol_search_gen.pl1 Added Trace statements. 19* 2) change(89-04-23,Zimmerman), approve(89-04-23,MCR8082), 20* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 21* MCR8082 cobol_search_gen.pl1 Fix wild array subscript. 22* END HISTORY COMMENTS */ 23 24 25 /* Modified on 02/11/85 by FCH, [5.3-2], BUG561, search_flag=0 in fmt4_eos */ 26 /* Modified on 10/19/84 by FCH, [5.3-1], BUG563(phx18381), new cobol_addr_tokens.incl.pl1 */ 27 /* Modified on 09/11/81 by FCH, [5.0-1], set search_flag to 1 in fmt3_eos not fmt1_eos, BUG503(phx11385) */ 28 /* Modified on 09/08/77 by Bob Chang to fix the bug for not setting numeric_lit.places_left. */ 29 /* Modified on 7/18/76 by Bob Chang to handle the varying length data. */ 30 31 32 33 34 35 36 37 38 /* format: style3 */ 39 cobol_search_gen: 40 proc (in_token_ptr, search_flag); 41 42 /* 43*This procedure generates code for the Cobol Search statment. */ 44 /* Because of the way the PD syntax phase parses the 45*SEARCH statement, cobol_search_gen will be called more than 46*once to generate code for a single SEARCH statement. See 47*details below in the documentation for the separate internal 48*procedures used to implement the code generation. */ 49 50 /* 51*The current implemenattion generates code only for format 1 52*SEARCH statements. If called to generate code for format 2 53*SEARCH statements, a diagnostic is issued, and unpredictable 54*code is generated. 55**/ 56 57 /* DECLARATION OF THE PARAMETERS */ 58 59 /* dcl in_token_ptr ptr; */ 60 /* THIS PARAMETER IS DECLARED BELOW IN AN INCLUDE FILE */ 61 dcl search_flag fixed bin; 62 63 /* DECLARATION OF EXTERNAL ENTRIES */ 64 65 dcl cobol_register$load ext entry (ptr); 66 dcl ioa_$ioa_stream ext entry options (variable); 67 dcl cobol_compare_gen ext entry (ptr); 68 dcl cobol_emit ext entry (ptr, ptr, fixed bin); 69 dcl cobol_make_tagref ext entry (fixed bin, fixed bin, ptr); 70 dcl cobol_define_tag ext entry (fixed bin); 71 dcl cobol_set_gen ext entry (ptr); 72 dcl cobol_add_gen ext entry (ptr, fixed bin); 73 dcl cobol_read_rand entry (fixed bin, char (5), ptr); 74 dcl cobol_make_type9$copy 75 ext entry (ptr, ptr); 76 dcl cobol_addr ext entry (ptr, ptr, ptr); 77 dcl cobol_process_error ext entry (fixed bin, fixed bin, fixed bin); 78 dcl cobol_alloc$stack ext entry (fixed bin, fixed bin, fixed bin); 79 80 81 82 /*}*/ 83 84 85 /*************************************************/ 86 /* START OF EXECUTION */ 87 /* cobol_search_gen */ 88 /**************************************************/ 89 90 /* Save the in_token_ptr. */ 91 save_in_token_ptr = in_token_ptr; 92 93 if in_token.token_ptr (in_token.n) -> end_stmt.a = "000"b 94 then call format1_search; 95 else call format2_search; /* Restore the in_token_ptr to its original value. */ 96 in_token_ptr = save_in_token_ptr; 97 98 99 100 101 102 103 104 /* DECLARATIONS OF INTERNAL STATIC VARIABLES */ 105 106 dcl 1 set_eos_token int static, 107 2 size fixed bin (15) init (38), 108 2 line fixed bin (15) init (0), 109 2 column fixed bin (15) init (0), 110 2 type fixed bin (15) init (19), /* EOS */ 111 2 verb fixed bin (15) init (31), /* SET */ 112 2 e fixed bin (15), 113 2 h fixed bin (15), 114 2 i fixed bin (15), 115 2 j fixed bin (15), 116 2 a bit (3) init ("000"b), /* SET FOR EITHER FMT 1 OR FMT 2 */ 117 2 b bit (1) init ("0"b); /* SET FOR FMT 1 OR FMT 2 */ 118 119 120 dcl 1 numeric_lit_1 int static, 121 2 size fixed bin (15) init (36), 122 2 line fixed bin (15) init (0), 123 2 column fixed bin (15) init (0), 124 2 type fixed bin (15) init (2), /* NUMERIC LITERAL */ 125 2 integral bit (1) init ("1"b), 126 2 floating bit (1) init ("0"b), 127 2 filler1 bit (5) init ("00000"b), 128 2 subscript bit (1) init ("0"b), 129 2 sign char (1) init (" "), 130 2 exp_sign char (1) init (" "), 131 2 exp_places fixed bin (15) init (0), 132 2 places_left fixed bin (15) init (1), 133 2 places_right fixed bin (15) init (0), 134 2 places fixed bin (15) init (1), 135 2 literal char (1) init ("1"); 136 137 138 139 dcl 1 add_eos_token int static, 140 2 size fixed bin (15) init (38), 141 2 line fixed bin (15) init (0), 142 2 column fixed bin (15) init (0), 143 2 type fixed bin (15) init (19), /* EOS */ 144 2 verb fixed bin (15) init (2), /* ADD */ 145 2 e fixed bin (15) init (1), /* left operands */ 146 2 h fixed bin (15) init (1), /* right operands */ 147 2 i fixed bin (15) init (0), 148 2 j fixed bin (15) init (0), 149 2 a bit (3) init ("000"b), /* FORMAT 1 */ 150 2 b bit (1) init ("0"b); /* NO OSE CLAUSE PRESENT */ 151 152 153 dcl 1 compare_eos_token int static, 154 2 size fixed bin (15) init (38), 155 2 line fixed bin (15) init (0), 156 2 column fixed bin (15) init (0), 157 2 type fixed bin (15) init (19), /* EOS */ 158 2 verb fixed bin (15) init (13), /* BRANCH */ 159 2 e fixed bin (15) init (0), /* SET TO GREATER OR EQUAL */ 160 2 h fixed bin (15) init (0), 161 2 i bit (36) init ("010"b); /* TRANSFER IF CONDITION NOT TRUE */ 162 163 164 dcl 1 work_numeric_lit int static, 165 2 size fixed bin (15) init (36), 166 2 line fixed bin (15) init (0), 167 2 column fixed bin (15) init (0), 168 2 type fixed bin (15) init (2), /* NUMERIC LITERAL */ 169 2 integral bit (1) init ("1"b), 170 2 floating bit (1) init ("0"b), 171 2 filler1 bit (5) init ("00000"b), 172 2 subscript bit (1) init ("0"b), 173 2 sign char (1) init (" "), 174 2 exp_sign char (1) init (" "), 175 2 exp_places fixed bin (15) init (0), 176 2 places_left fixed bin (15) init (0), 177 2 places_right fixed bin (15) init (0), 178 2 places fixed bin (15) init (0), 179 2 literal char (20); 180 181 /* Declaration of an unconditional transfer instruction */ 182 183 dcl tra_inst bit (36) int static init ("000000000000000000111001000000000000"b); 184 185 186 dcl mlr_op bit (10) int static init ("0010000011"b /*010(1)*/); 187 dcl ldq_op bit (10) int static init ("0100111100"b /*236(0)*/); 188 dcl stq_op bit (10) int static init ("1111011100"b /*756(0)*/); 189 dcl lda_op bit (10) int static init ("0100111010"b /*235(0)*/); 190 dcl div_op bit (10) int static init ("1010001100"b /*506(0)*/); 191 dcl asa_op bit (10) int static init ("0001011010"b /*055(0)*/); 192 dcl aos_op bit (10) int static init ("0001011000"b /* 054(0)*/); 193 dcl sta_op bit (10) int static init ("1111011010"b /*755(0)*/); 194 195 dcl do_ptr ptr, 196 com2_ptr ptr; 197 dcl next_compare_tag fixed bin static; 198 dcl next_stmt_tag fixed bin int static; 199 dcl compare_code_tag fixed bin int static; 200 dcl increment_code_tag fixed bin int static; 201 dcl next_when_tag fixed bin int static; 202 dcl check_index_tag fixed bin int static; 203 dcl at_end_tag fixed bin int static; 204 205 dcl save_in_token_ptr ptr; 206 207 dcl work_in_token (1:20) ptr; 208 209 /* Structure used to communicate with the register handling routines. */ 210 211 dcl 1 register_struc, 212 2 what_reg fixed bin, 213 2 reg_no bit (4), 214 2 lock fixed bin, 215 2 already_there fixed bin, 216 2 contains fixed bin; 217 218 dcl dn_ptr ptr; 219 format1_search: 220 proc; 221 222 /* Declaration of an entry array */ 223 224 dcl eos_proc (1:4) entry init (fmt1_eos, fmt2_eos, fmt3_eos, fmt4_eos); 225 226 227 /* DECLARATIONS OF INTERNAL VARIABLES */ 228 229 dcl index_token_ptr ptr; 230 dcl varying_token_ptr ptr; 231 232 dcl add_next_stmt_tag fixed bin; 233 dcl work_string char (20); 234 dcl varying_done bit (1); 235 dcl ix fixed bin; 236 dcl iy fixed bin; 237 dcl offset_inst_word bit (36); 238 dcl occurrence_inst_word 239 bit (36); 240 dcl element_length_inst_word 241 bit (36); 242 243 /**************************************************/ 244 /* START OF EXECUTION */ 245 /* INTERNAL PROCEDURE */ 246 /* format1_search */ 247 /**************************************************/ 248 249 250 251 call eos_proc (in_token.token_ptr (in_token.n) -> end_stmt.e); 252 253 254 fmt1_eos: 255 proc; 256 257 /* Reserve a tag to be defined at the next Cobol statement (the statement 258* following this SEARCH stetement) */ 259 260 next_stmt_tag = cobol_$next_tag; 261 262 /* Reserve a tag to be defined at the first instruction of the code generated to 263* compare the index name value with the maximum size of the table. */ 264 265 compare_code_tag = next_stmt_tag + 1; 266 267 /* Reserve a tag to be defined at the next WHEN clause in the SEARCH statement. */ 268 269 next_when_tag = next_stmt_tag + 2; 270 271 /* Reserve a tag to be defined at the first instruction generated to increment the index name. */ 272 273 next_compare_tag = cobol_$next_tag + 4; 274 at_end_tag = cobol_$next_tag + 5; 275 276 increment_code_tag = next_stmt_tag + 3; 277 278 /* Update the next tag variable in the external data segment. */ 279 280 cobol_$next_tag = cobol_$next_tag + 6; 281 282 eos_ptr = in_token.token_ptr (in_token.n); 283 284 dn_ptr = in_token.token_ptr (2); 285 if data_name.occurs_do 286 then do; 287 call cobol_read_rand (1, data_name.do_rec, com2_ptr); 288 call cobol_read_rand (3, odo_rec.descr, dn_ptr); 289 do_ptr = dn_ptr; 290 end; 291 else do_ptr = null (); 292 if end_stmt.c = "1"b /* VARYING clause present. */ 293 then if (in_token.token_ptr (in_token.n - 1) -> data_name.type = rtc_dataname 294 & in_token.token_ptr (in_token.n - 1) -> data_name.usage_index) 295 then /* VARYING variabble is an index data item. */ 296 /* Generate code to extract data from the index data item to be used 297* in incrementing the index data item during the execution of the SEARCH. */ 298 call get_index_item_data (in_token.token_ptr (in_token.n - 1), offset_inst_word, occurrence_inst_word, 299 element_length_inst_word); 300 301 /* Generate an unconditional transfer to the compare_code_tag. */ 302 303 call cobol_emit (addr (tra_inst), null (), 1); 304 305 /* Make a tag reference to compare_code_tag at the instruction just emitted. */ 306 307 call cobol_make_tagref (compare_code_tag, cobol_$text_wd_off - 1, null ()); 308 309 /* Define the increment_code_tag at the next instruction location. */ 310 call cobol_define_tag (increment_code_tag); 311 312 /* Determine what index name should be used to search the table. */ 313 314 315 if end_stmt.c = "0"b 316 then do; /* No VARYING clause present. */ 317 318 index_token_ptr = in_token.token_ptr (in_token.n - 1); 319 dn_ptr = in_token.token_ptr (in_token.n - 2); 320 occurs_ptr = addrel (dn_ptr, divide (data_name.occurs_ptr, 4, 35, 0)); 321 varying_token_ptr = null (); 322 323 end; /* No VARYING clause present. */ 324 325 else do; /* VARYING present, determine whether the index name appearing in the 326* VARYING clause should be used to search the table. */ 327 328 dn_ptr = in_token.token_ptr (in_token.n - 3); 329 330 /* Build a pointer to the occurs extension of the table being searched. */ 331 occurs_ptr = addrel (dn_ptr, divide (data_name.occurs_ptr, 4, 35, 0)); 332 333 if in_token.token_ptr (in_token.n - 1) -> data_name.type = rtc_indexname 334 then do; /* VARYING variable is an index name. */ 335 336 /* Check to see if the index name in the VARYING clause appears in 337* the INDEXED BY clause of the table being searched. This index name 338* appears in the INDEXED BY clause of the table if the index_no value in the 339* index name token is equal to the index_no value in the occurs extension 340* of the table. */ 341 342 if occurs.level.index_no (occurs.dimensions) 343 = in_token.token_ptr (in_token.n - 1) -> index_name.index_no 344 then do; /* It does appear in the INDEXED BY clause of the table. */ 345 346 /* Use the index name in the VARYING clause for the SEARCH. */ 347 index_token_ptr = in_token.token_ptr (in_token.n - 1); 348 varying_token_ptr = null (); 349 /* no varying identifier to worry about. */ 350 351 end; /* It does appear in the INDEXED BY clause of the table. */ 352 353 else do; /* Index name not associated with the table via INDEXED BY clause. */ 354 355 /* The first index name token appears on cobol_pdout_ immediately 356* following the data name token for the table. */ 357 index_token_ptr = in_token.token_ptr (in_token.n - 2); 358 359 /* The INDEX name in the varying clause is also incremented during 360* the search. */ 361 varying_token_ptr = in_token.token_ptr (in_token.n - 1); 362 363 end; /* The Index name not associated with the table via 364* INDEXED BY clause. */ 365 366 end; /* VARYING variable is an index name. */ 367 368 else do; /* VARYING VARIABLE is not an index name. */ 369 370 /* Index used to search the table is the first index appearing in the 371* INDEXED BY clause. */ 372 index_token_ptr = in_token.token_ptr (in_token.n - 2); 373 varying_token_ptr = in_token.token_ptr (in_token.n - 1); 374 375 end; /* VARYING variable is not an index name. */ 376 377 end; /* VARYING present, determine whether the index name appearing in the VARYING 378* clause should be used to search the table. */ 379 380 381 /* AT THIS POINT IN PROCESSING: 382* 383* 1. dn_ptr points to the data name token (type 9) for the 384* table to be searched. 385* 2. index_token_ptr points to the index name token (type 10) for the 386* index to be used in the search. 387* 3. varying_token_ptr points to the token appearing in the VARYING 388* clause, to be incremented along with the index name used in the 389* search. If there was no VARYING clause, or if the variable 390* referenced in the VARYING clause was the index name now being used 391* in the search, then this pointer is null. 392* 393**/ 394 395 396 397 /* Generate code to increment the index name, and the variable referenced 398* in the VARYING clause. */ 399 400 401 varying_done = "0"b; 402 in_token_ptr = addr (work_in_token (1)); 403 404 in_token.token_ptr (1) = save_in_token_ptr -> in_token.token_ptr (1); 405 in_token.token_ptr (2) = index_token_ptr; 406 407 408 409 if varying_token_ptr ^= null () 410 then do; /* VARYING variable is present. */ 411 412 if varying_token_ptr -> data_name.type = rtc_indexname 413 then do; /* VARYING variable is an index name. */ 414 415 /* We will call the SET generator once to increment both index names. */ 416 417 varying_done = "1"b; 418 in_token.token_ptr (3) = varying_token_ptr; 419 in_token.token_ptr (4) = addr (numeric_lit_1); 420 /* Numeric literal 1 is increment. */ 421 in_token.token_ptr (5) = addr (set_eos_token); 422 in_token.n = 5; 423 in_token.token_ptr (5) -> end_stmt.e = 2; 424 /* Two operands to be SET. */ 425 set_eos_token.a = "001"b; /* Format 2 set stmt. */ 426 set_eos_token.b = "0"b; /* UP */ 427 428 end; /* VARYING variable is an index name. */ 429 430 else if (varying_token_ptr -> data_name.type = rtc_dataname 431 & varying_token_ptr -> data_name.usage_index = "1"b) 432 then do; /* VARYING variable is an index data item. */ 433 434 call increment_index_data_item (varying_token_ptr, offset_inst_word, occurrence_inst_word, 435 element_length_inst_word); 436 437 end; /* VARYING variable is an index data item. */ 438 439 end; /* VARYING variable is present. */ 440 441 if ^varying_done 442 then do; /* VARYING not present, or if present, varying variable is not index name */ 443 444 in_token.token_ptr (3) = addr (numeric_lit_1); 445 /* Increment is literal 1. */ 446 in_token.token_ptr (4) = addr (set_eos_token); 447 in_token.n = 4; 448 in_token.token_ptr (4) -> end_stmt.e = 1; 449 /* One operand to be set. */ 450 set_eos_token.a = "001"b; /* Format 2 SET stmt. */ 451 set_eos_token.b = "0"b; /* UP */ 452 453 end; /* VARYING not present, or if present, varying variable is not an index name. */ 454 455 /* Call the SET generator to increment the index. */ 456 457 /* Modify the maximum value field in the index name token so the SET generator will allow it to 458* be set to one greater than the maximum size defined in the occurs clause. */ 459 460 index_token_ptr -> index_name.max = index_token_ptr -> index_name.max + 1; 461 462 /* Increment the same field in the varying token if it is also an index name. */ 463 464 if varying_token_ptr ^= null () 465 then if varying_token_ptr -> data_name.type = rtc_indexname 466 then varying_token_ptr -> index_name.max = 467 varying_token_ptr -> index_name.max + index_token_ptr -> index_name.max - 1; 468 469 /* Call the SET generator. */ 470 call cobol_set_gen (in_token_ptr); 471 472 473 if varying_token_ptr ^= null () 474 then if (varying_token_ptr -> data_name.type = rtc_dataname & varying_token_ptr -> data_name.usage_index = "0"b) 475 then do; /* VARYING present, and the varying variable is a dataname, but not usage index. */ 476 477 /* Generate code to add one to the variable referenced in the VARYING clause. */ 478 479 in_token_ptr = addr (work_in_token (1)); 480 in_token.token_ptr (1) = null (); 481 in_token.token_ptr (2) = addr (numeric_lit_1); 482 in_token.token_ptr (3) = varying_token_ptr; 483 in_token.token_ptr (4) = addr (add_eos_token); 484 in_token.n = 4; 485 486 call cobol_add_gen (in_token_ptr, add_next_stmt_tag); 487 488 end; /* VARYING present, and the varying variable is a dataname, but not usage index. */ 489 490 /* Define the compare_code_tag at the next instruction. */ 491 492 call cobol_define_tag (compare_code_tag); 493 494 /* Generate code to compare the index name being used to search the table, to its maximum size. */ 495 496 /* Convert the maximum size of the table being searched (in fixed binary representation) to a 497* character string. */ 498 499 call bin_to_char (index_token_ptr -> index_name.max - 1, 500 /* Remember that we incremented "max" 501* by 1 before calling the set generator. */ 502 work_numeric_lit.literal, work_numeric_lit.places); 503 work_numeric_lit.places_left = work_numeric_lit.places; 504 505 in_token.n = 3; 506 in_token.token_ptr (3) = addr (compare_eos_token); 507 in_token.token_ptr (1) = index_token_ptr; 508 compare_eos_token.e = 113; /* GREATER */ 509 compare_eos_token.i = "010"b; /* Transfer if not greater. */ 510 511 /* Generate code to do the comparison. */ 512 if do_ptr ^= null () 513 then do; 514 in_token.token_ptr (2) = do_ptr; 515 compare_eos_token.h = next_compare_tag; 516 call cobol_compare_gen (in_token_ptr); 517 call cobol_emit (addr (tra_inst), null (), 1); 518 if end_stmt.b = "0"b 519 then call cobol_make_tagref (next_stmt_tag, cobol_$text_wd_off - 1, null ()); 520 else call cobol_make_tagref (at_end_tag, cobol_$text_wd_off - 1, null ()); 521 end; 522 call cobol_define_tag (next_compare_tag); 523 in_token.token_ptr (2) = addr (work_numeric_lit); 524 compare_eos_token.h = next_when_tag; 525 call cobol_compare_gen (in_token_ptr); /* Check to see if an AT END clause was not present, and generate a transfer to the next 526* Cobol statement. */ 527 528 if end_stmt.b ^= "1"b 529 then do; /* AT END clause not present. */ 530 /* Emit a transfer to the next Cobol statement. */ 531 /* Make a tag reference at the instruction just emitted. */ 532 /* Define the next when tag at the next instruction to be generated. */ 533 534 /*[5.3-2]*/ 535 call TG (next_stmt_tag, next_when_tag); 536 537 end; /* AT END clause not present. */ 538 539 call cobol_define_tag (at_end_tag); /* Set the output parameter to non_zero. */ 540 /*[5.0-1]*/ 541 /* search_flag = 1; */ 542 543 end fmt1_eos; 544 545 546 fmt2_eos: 547 proc; 548 549 550 if in_token.token_ptr (in_token.n) -> end_stmt.b = "1"b 551 then do; /* This EOS is the last EOS for the sEARCH statement. */ 552 553 /* Generate code to transfer to increment code tag. */ 554 555 call cobol_emit (addr (tra_inst), null (), 1); 556 call cobol_make_tagref (increment_code_tag, cobol_$text_wd_off - 1, null ()); 557 558 /* Define the next_stmt_tag. */ 559 560 /*[5.3-2]*/ 561 call TG (increment_code_tag, next_stmt_tag); 562 563 /* Set the output parameter search_flag to zero. */ 564 565 search_flag = 0; 566 567 end; /* This EOS is the last EOS for the SEaRCH statement. */ 568 569 else do; /* This EOs is not the last EOS for the sEaRCH statement. */ 570 571 /* Generate a transfer to the next Cobol statement. */ 572 /* Make a reference to the next Cobol statement at the instruction just emitted. */ 573 /* Define the next_when_tag. */ 574 575 /*[5.3-2]*/ 576 call TG (next_stmt_tag, next_when_tag); 577 578 end; /* This EOS is not the last EOS for the sEaRCH statement. */ 579 580 581 end fmt2_eos; 582 583 TG: 584 proc (T1, T2); 585 586 /*[5.3-2]*/ 587 dcl (T1, T2) fixed bin; 588 589 /*[5.3-2]*/ 590 call cobol_emit (addr (tra_inst), null (), 1); /*[5.3-2]*/ 591 call cobol_make_tagref (T1, cobol_$text_wd_off - 1, null ()); 592 /*[5.3-2]*/ 593 call cobol_define_tag (T2); 594 595 end; 596 597 fmt3_eos: 598 proc; 599 600 /*[5.0-1]*/ 601 search_flag = 1; 602 603 return; 604 605 end fmt3_eos; 606 607 608 fmt4_eos: 609 proc; 610 611 /* Save the internal tag defined in the internal tag token (type 30) as the next_when_tag. */ 612 next_when_tag = in_token.token_ptr (in_token.n - 1) -> int_tag.proc_num; 613 /*[5.3-2]*/ 614 search_flag = 0; 615 end fmt4_eos; 616 617 end format1_search; 618 619 620 /*************************************************/ 621 /* INTERNAL PROCEDURE */ 622 /* get_index_item_data */ 623 /**************************************************/ 624 625 get_index_item_data: 626 proc (index_data_item_ptr, work_offset_inst, work_occurrence_inst, element_length_inst); 627 628 /* 629*This internal proceduure generates code to get the following information 630*for an index data item that is to be incremented during 631*the execution of a SEARCH statement: 632* 1. occurrence number 633* 2. byte offset of the item referenced by 634* "occurrence number". 635* 3. element length of the item referenced by the index 636* data item. (this length is calculated by dividing 637* "byte offset" by "occurrence number".) 638* 639*An index data item in Multics cobol consists of six bytes of 640*data. the first four bytes contain the byte offset, and the last 641*two bytes contain the occurrence number. However, within each 642*byte, only the least significant 8 bits contain meaningful 643*data. Therefore, to do any computation or incrementing of The 644*data in an index data item, it is necessary to squeeze out the 645*junk bits, and store the resulting data into temporary storage. 646*This procedure does That silly bit squeezing. 647**/ 648 649 /* DECLARATION OF THE PARAMETERS */ 650 651 dcl index_data_item_ptr ptr; 652 dcl work_offset_inst bit (36); 653 dcl work_occurrence_inst 654 bit (36); 655 dcl element_length_inst bit (36); 656 657 /* DESCRIPTION OF THE PARAMETERS */ 658 659 /* 660*PARAMETER DESCRIPTION 661* 662*index_data_item_ptr Pointer to the index data item token 663* (type 9) from which data is to be 664* extracted by this procedure. (input) 665*work_offset_inst a word in which the basic, non-eis 666* address of the word in wich the fixed 667* binary offset value is stored by this 668* procedure. (output) 669*work_occurrence_inst a word in which the basic, non-eis 670* address of the word in which the fixed binary 671* occurrence number is stored by this 672* procedure. (output) 673*element_length_inst a word in which the basic, non-eis address 674* of the word in which the fixed binary 675* element length is stored by this procedure. 676* (output) 677* 678**/ 679 680 681 /* DECLARATIONS OF INTERNAL STATIC VARIABLES */ 682 683 dcl 1 get_occurrence_no_code 684 int static, 685 2 i1 bit (36) init ("000000000000000000010011101000000011"b), 686 /* lda 0,du */ 687 2 i2 bit (36) init ("000000000000001010111011111000000000"b), 688 /* lls 10 */ 689 2 i3 bit (36) init ("000000000000000001111011001000000000"b), 690 /* ars 1 */ 691 2 i4 bit (36) init ("000000000000011100111011011000000000"b), 692 /* lrs 28 */ 693 2 i5 bit (36) init ("000000000000000000110000001000000000"b); 694 /* tnz 0 */ 695 696 dcl 1 get_offset_code int static, 697 2 i1 bit (36) init ("000000000000001000111011011000000000"b), 698 /* lrs 8 */ 699 2 i2 bit (36) init ("000000000000000001111011001000000000"b), 700 /* ars 1 */ 701 2 i3 bit (36) init ("000000000000001000111011011000000000"b), 702 /* lrs 8 */ 703 2 i4 bit (36) init ("000000000000000001111011001000000000"b), 704 /* ars 1 */ 705 2 i5 bit (36) init ("000000000000001000111011011000000000"b), 706 /* lrs 8 */ 707 2 i6 bit (36) init ("000000000000000001111011001000000000"b), 708 /* ars 1 */ 709 2 i7 bit (36) init ("000000000000001100111011011000000000"b); 710 /* lrs 12 */ 711 712 dcl search_occurrence_error 713 fixed bin int static init (46); 714 715 716 /* DECLARATION OF INTERNAL VARIABLES */ 717 718 dcl work_offset1 fixed bin; 719 dcl work_offset2 fixed bin; 720 dcl work_offset3 fixed bin; 721 722 dcl work_ptr ptr; 723 724 dcl work_offset_inst_ptr 725 ptr; 726 dcl work_occurrence_inst_ptr 727 ptr; 728 dcl element_length_inst_ptr 729 ptr; 730 731 dcl buff1 (1:10) ptr; 732 dcl buff2 (1:10) ptr; 733 dcl buff3 (1:10) ptr; 734 dcl occurrence_ok_tag fixed bin; 735 736 input_ptr = addr (buff1 (1)); 737 inst_ptr = addr (buff2 (1)); 738 reloc_ptr = addr (buff3 (1)); 739 740 /* allocate 3 words (12 bytes) on an even word boundary in the stack. these 741*three words ar to be used to hold: 742* 1. first word-byte offset of the index data item. 743* 2. second occurrence number from the index data item 744* 3. element length of the array item described by the index data item. 745* 746**/ 747 748 call cobol_alloc$stack (12, 2, work_offset1); 749 750 /* Convert the word offset returned by cobol_alloc$stack to a byte offset. */ 751 work_offset1 = work_offset1 * 4; 752 753 /* calculate the byte offset of the word for the occurrence number from the index data item. */ 754 work_offset2 = work_offset1 + 4; 755 756 /* calculate the byte offset for the word to contain the element length. */ 757 work_offset3 = work_offset1 + 8; 758 759 /* Make a copy of the input index data item token. */ 760 work_ptr = null (); /* Utility provides buffer for the token. */ 761 call cobol_make_type9$copy (work_ptr, index_data_item_ptr); 762 763 /* Modify the token so that it describes the temporary space just allocated in the stack. */ 764 work_ptr -> data_name.seg_num = 1000; /* stack */ 765 work_ptr -> data_name.offset = work_offset1; 766 work_ptr -> data_name.subscripted = "0"b; 767 768 /* generate code to move the index data item ( 6 bytes long) to the stack space. */ 769 770 input_struc.type = 5; /* EIS, 2 operands input, instruction and 2 descriptors returned. */ 771 input_struc.operand_no = 2; 772 input_struc.lock = 0; 773 input_struc.operand.token_ptr (1) = index_data_item_ptr; 774 input_struc.operand.send_receive (1) = 0; /* sending */ 775 input_struc.operand.size_sw (1) = 0; 776 777 input_struc.operand.token_ptr (2) = work_ptr; 778 input_struc.operand.send_receive (2) = 1; /* receiving */ 779 input_struc.operand.size_sw = 0; 780 781 /* call the addressability utility */ 782 call cobol_addr (input_ptr, inst_ptr, reloc_ptr); 783 784 /* set the MLR opcode into the instruction returned. */ 785 inst_struc.inst.fill1_op = mlr_op; 786 787 /* emit the instruction and 2 descriptors. */ 788 call cobol_emit (inst_ptr, reloc_ptr, 3); 789 790 /* get the basic addresses (6180 non-eis addresses of the offset, occurrence number, and element 791* length words. */ 792 793 work_offset_inst_ptr = addr (work_offset_inst); 794 work_occurrence_inst_ptr = addr (work_occurrence_inst); 795 element_length_inst_ptr = addr (element_length_inst); 796 797 input_struc_basic.type = 1; /* basic, non-eis */ 798 input_struc_basic.operand_no = 0; 799 input_struc_basic.segno = 1000; 800 801 /* get basic address of the offset word */ 802 input_struc_basic.char_offset = work_offset1; 803 call cobol_addr (input_ptr, work_offset_inst_ptr, reloc_ptr); 804 805 /* get the basic address of the occurrence number wordl */ 806 input_struc_basic.char_offset = work_offset2; 807 call cobol_addr (input_ptr, work_occurrence_inst_ptr, reloc_ptr); 808 809 /* get basic address of the element length word. */ 810 input_struc_basic.char_offset = work_offset3; 811 call cobol_addr (input_ptr, element_length_inst_ptr, reloc_ptr); 812 813 /* get the a and q registera */ 814 815 register_struc.what_reg = 3; /* A and Q */ 816 register_struc.lock = 0; /* no change to locks. */ 817 register_struc.contains = 0; /* Contents of A and Q will not be meaningful ofr register 818* optimization, because the code to be generated shifts the contents of the registers. */ 819 820 call cobol_register$load (addr (register_struc)); 821 822 /* build instruction to load the Q register with the occurrence number. */ 823 work_occurrence_inst_ptr -> inst_struc_basic.fill1_op = ldq_op; 824 825 /* Emit the ldq instruction */ 826 call cobol_emit (work_occurrence_inst_ptr, null (), 1); 827 828 /* at this point we have generated code to load the occurrence number into the Q register. */ 829 830 /* emit a stream of code to convert the occurrence number into a fixed bin (35) value 831* in the Q register */ 832 833 /* The code stream emitted is: 834* lda 0,dl 835* lls 10 836* ars 1 837* lrs 28 838* tnz 839* */ 840 841 call cobol_emit (addr (get_occurrence_no_code), null (), 5); 842 843 /* Reserve a tag to which to transfer if the occurrence number is OK (non-zero) */ 844 occurrence_ok_tag = cobol_$next_tag; 845 cobol_$next_tag = cobol_$next_tag + 1; /* Make a reference to the tag just reserved at the tnz instruction just emitted. */ 846 847 call cobol_make_tagref (occurrence_ok_tag, cobol_$text_wd_off - 1, null ()); 848 849 /* Generate code to signal an error, if the occurrence number is zero. */ 850 851 call cobol_process_error (search_occurrence_error, fixed (index_data_item_ptr -> data_name.line, 17), 0); 852 853 /* Define the occurrence_ok_tag. */ 854 call cobol_define_tag (occurrence_ok_tag); 855 856 /* Generate code to store the occurrence number, back into the temporary in the stack. */ 857 work_occurrence_inst_ptr -> inst_struc_basic.fill1_op = stq_op; 858 859 /* Emit the instruction. */ 860 call cobol_emit (work_occurrence_inst_ptr, null (), 1); 861 862 /* Now generate code to load the offset into the A-Q register and squeeze out the junk bits. */ 863 work_offset_inst_ptr -> inst_struc_basic.fill1_op = lda_op; 864 call cobol_emit (work_offset_inst_ptr, null (), 1); 865 866 /* Emit a stream of code to squeeze out the junk bits. */ 867 /* The stream of code is: 868* lrs 8 869* ars 1 870* lrs 8 871* ars 1 872* lrs 8 873* ars 1 874* lrs 12 RESULT WINDS UP IN Q 875* */ 876 877 call cobol_emit (addr (get_offset_code), null (), 7); 878 879 /* Generate code to store the Q into the owrk offset word. */ 880 work_offset_inst_ptr -> inst_struc_basic.fill1_op = stq_op; 881 call cobol_emit (work_offset_inst_ptr, null (), 1); 882 883 /* Now generate code to calculate the element length of the item described by the index data item, 884* and store the element length in the stack for use later when the index data item is incremented. */ 885 886 /* Note at this point in the generated code, the offset is contained in the Q register, 887* the occurrence number is sorted in the stack. The element length is calculated by dividing 888* the offset by the occurrence number. */ 889 890 work_occurrence_inst_ptr -> inst_struc_basic.fill1_op = div_op; 891 call cobol_emit (work_occurrence_inst_ptr, null (), 1); 892 893 /* Store the quotient (in the Q ) into the stack space allocated to hold the element length */ 894 element_length_inst_ptr -> inst_struc_basic.fill1_op = stq_op; 895 call cobol_emit (element_length_inst_ptr, null (), 1); 896 897 end get_index_item_data; 898 899 900 /**************************************************/ 901 /* INTERNAL PROCEDURE */ 902 /* increment_index_data_item */ 903 /**************************************************/ 904 905 increment_index_data_item: 906 proc (index_data_item_ptr, work_offset_inst, work_occurrence_inst, element_length_inst); 907 908 /* 909*This procedure generates code to increment an index data item 910*that is referenced in the VARYING clause of a format 1 SEARCH 911*statement. When this procedure is entered, code has been generated 912*to convert the contents of the index data item into the format of 913*an index data name in the stack. (i.e. two consecutinve words of 914*storage; the first word contains the byte offset, the second 915*word contains the occurrence number.) 916*The value to be used to increment the byte offset is also 917*contained in a temporary in the stack. This procedure generates 918*code that 919* 1. increments the value of the temporary index name 920* representation. 921* 2. converts this index name representation to the 922* index data item representation. 923* 3. moves the index data item representation into the 924* index data item referenced in the VARYING clause. 925* 926**/ 927 928 /* DECLARATION OF THE PARAMETERS */ 929 930 dcl index_data_item_ptr ptr; 931 dcl work_offset_inst bit (36); 932 dcl work_occurrence_inst 933 bit (36); 934 dcl element_length_inst bit (36); 935 936 /* DESCRIPTION OF THE PARAMETERS */ 937 938 /* 939*PARAMETER DESCRIPTION 940* 941*index_data_item_ptr Pointer to the index data item token (type9) 942* that is be be incremented because it appears 943* in the VARYING clause of a SEARCH statement. 944*work_offset_inst A word that contains the basic, non-eis 945* address of the word containing the byte 946* offset in the index data name format. 947* (input) 948*work_occurrence_inst A word that contains the basic,non-eis 949* address of the word containing the occurrence 950* number in index data name format. (input) 951*element_length_inst A word that contains the basic, non-eis 952* address of the word containing the 953* element length of the item represented 954* by the index data item that appears in 955* the VARYING clause. (input) 956* 957**/ 958 959 /* DECLARATION OF INTERNAL STATIC VARIABLES */ 960 961 dcl 1 get_offset_code int static, 962 2 i1 bit (36) init ("000000000000001100111011111000000000"b), 963 /* lrs 12 */ 964 2 i2 bit (36) init ("000000000000000001111011101000000000"b), 965 /* als 1 */ 966 2 i3 bit (36) init ("000000000000001000111011111000000000"b), 967 /* lls 8 */ 968 2 i4 bit (36) init ("000000000000000001111011101000000000"b), 969 /* als 1 */ 970 2 i5 bit (36) init ("000000000000001000111011111000000000"b), 971 2 i6 bit (36) init ("000000000000000001111011101000000000"b), 972 /* als 1 */ 973 2 i7 bit (36) init ("000000000000001000111011111000000000"b); 974 /* lls 8 */ 975 976 977 dcl 1 get_occurrence_code 978 int static, 979 2 i1 bit (36) init ("000000000000011100111011111000000000"b), 980 /* lls 28 */ 981 2 i2 bit (36) init ("000000000000000001111011101000000000"b), 982 /* als 1 */ 983 2 i3 bit (36) init ("000000000000011010111011111000000000"b); 984 /* lls 26 */ 985 986 987 /* DECLARATION OF INTERNAL VARIABLES */ 988 989 dcl work_offset_inst_ptr 990 ptr; 991 dcl work_occurrence_inst_ptr 992 ptr; 993 dcl element_length_inst_ptr 994 ptr; 995 996 dcl temp_ptr ptr; 997 998 dcl work_offset1 fixed bin; 999 dcl work_offset2 fixed bin; 1000 dcl buff1 (1:10) ptr; 1001 dcl buff2 (1:10) ptr; 1002 dcl buff3 (1:10) ptr; 1003 1004 dcl temp_offset_inst_ptr 1005 ptr; 1006 dcl temp_occurrence_inst_ptr 1007 ptr; 1008 dcl temp_offset_inst bit (36); 1009 dcl temp_occurrence_inst 1010 bit (36); 1011 1012 /**************************************************/ 1013 /* START OF EXECUTION */ 1014 /* INTERNAL PROCEDURE */ 1015 /* increment_index_data_item */ 1016 /**************************************************/ 1017 1018 work_offset_inst_ptr = addr (work_offset_inst); 1019 work_occurrence_inst_ptr = addr (work_occurrence_inst); 1020 element_length_inst_ptr = addr (element_length_inst); 1021 1022 input_ptr = addr (buff1 (1)); 1023 inst_ptr = addr (buff2 (1)); 1024 reloc_ptr = addr (buff3 (1)); 1025 1026 /* Generate code to increment the work occurrence number by one. */ 1027 work_occurrence_inst_ptr -> inst_struc_basic.fill1_op = aos_op; 1028 call cobol_emit (work_occurrence_inst_ptr, null (), 1); 1029 1030 /* Get the A and Q registers */ 1031 register_struc.what_reg = 3; /* A AND Q */ 1032 register_struc.lock = 0; 1033 register_struc.contains = 0; 1034 1035 call cobol_register$load (addr (register_struc)); 1036 1037 /* Load the element length into the A register. */ 1038 element_length_inst_ptr -> inst_struc_basic.fill1_op = lda_op; 1039 call cobol_emit (element_length_inst_ptr, null (), 1); 1040 1041 /* Add the contents of the A register to the byte offset in temporary storage. */ 1042 work_offset_inst_ptr -> inst_struc_basic.fill1_op = asa_op; 1043 call cobol_emit (work_offset_inst_ptr, null (), 1); 1044 1045 /* At this point, code has been generated to increment the occurrence number by one, 1046* and the byte offset by the stored element length. */ 1047 1048 /* Allocate 6 bytes on an even word boundary on the stack to receive the index data item 1049* format information. */ 1050 call cobol_alloc$stack (6, 2, work_offset1); 1051 1052 1053 /* Convert the word offset to a byte offset. */ 1054 work_offset1 = work_offset1 * 4; 1055 1056 /* Calculate the byte offset of the occurrence number bytes of the temporary index data item. */ 1057 work_offset2 = work_offset1 + 4; 1058 1059 /* Get the basic, non-eis address of the byte offset and occurrence number bytes. */ 1060 temp_offset_inst_ptr = addr (temp_offset_inst); 1061 temp_occurrence_inst_ptr = addr (temp_occurrence_inst); 1062 1063 input_struc_basic.type = 1; /* basic, non-eis */ 1064 input_struc_basic.operand_no = 0; 1065 input_struc_basic.segno = 1000; /* stack */ 1066 1067 input_struc_basic.char_offset = work_offset1; 1068 call cobol_addr (input_ptr, temp_offset_inst_ptr, reloc_ptr); 1069 1070 input_struc_basic.char_offset = work_offset2; 1071 call cobol_addr (input_ptr, temp_occurrence_inst_ptr, reloc_ptr); 1072 1073 /* Generate an instruction to load the stored offset into the Q. */ 1074 work_offset_inst_ptr -> inst_struc_basic.fill1_op = ldq_op; 1075 call cobol_emit (work_offset_inst_ptr, null (), 1); 1076 1077 /* Emit a stream of code to expand the offset and insert the junk bits. 1078* The expanded result winds up in the A register. */ 1079 /* The emitted code stream is: 1080* lls 12 1081* als 1 1082* lls 8 1083* als 1 1084* lls 8 1085* als 1 1086* lls 8 1087* */ 1088 1089 call cobol_emit (addr (get_offset_code), null (), 7); 1090 1091 /* Emit code to store the A register into the temporary storage set aside for the offset 1092* part of the index data item. */ 1093 temp_offset_inst_ptr -> inst_struc_basic.fill1_op = sta_op; 1094 call cobol_emit (temp_offset_inst_ptr, null (), 1); 1095 1096 /* Emit code to load the Q register with the occurrence number from the temporary. */ 1097 work_occurrence_inst_ptr -> inst_struc_basic.fill1_op = ldq_op; 1098 call cobol_emit (work_occurrence_inst_ptr, null (), 1); 1099 1100 /* Emit a stream of code to expand the occurrence number and insert the junk bits. 1101* The expanded result winds up in the 2 leftmost bytes of the a register. */ 1102 /* The emitted stream is: 1103* lls 28 1104* als 1 1105* lls 26 1106* */ 1107 1108 /* Emit the stream of code. */ 1109 call cobol_emit (addr (get_occurrence_code), null (), 3); 1110 1111 /* Emit code to store the A register into the temporary storage for the occurrence number 1112* part of the index data item. */ 1113 temp_occurrence_inst_ptr -> inst_struc_basic.fill1_op = sta_op; 1114 call cobol_emit (temp_occurrence_inst_ptr, null (), 1); 1115 1116 /* At this point, we have generated code to expand the offset and occurrence number and 1117* store these values in index data item format in the six bytes of storage in the stack. */ 1118 1119 /* Now we must generate code to move the temporary index stat item from the stack 1120* into the index data item being incremented during the execution of the SEARCH. */ 1121 1122 /* Make a copy of the input index data item token. */ 1123 1124 temp_ptr = null (); 1125 call cobol_make_type9$copy (temp_ptr, index_data_item_ptr); 1126 1127 /* Modify the copy so that it describes the six byte temporary in the stack. */ 1128 temp_ptr -> data_name.seg_num = 1000; /* stack */ 1129 temp_ptr -> data_name.offset = work_offset1; 1130 temp_ptr -> data_name.subscripted = "0"b; 1131 1132 /* Build the input structure to the addressability utility. */ 1133 input_struc.type = 5; /* EIS, 2 operands input; instruction and 2 descriptors returned. */ 1134 input_struc.operand_no = 2; 1135 input_struc.lock = 0; 1136 1137 input_struc.operand.token_ptr (1) = temp_ptr; 1138 input_struc.operand.send_receive (1) = 0; /* Sending */ 1139 input_struc.operand.size_sw (1) = 0; 1140 1141 input_struc.operand.token_ptr (2) = index_data_item_ptr; 1142 input_struc.operand.send_receive (2) = 1; /* Receiving */ 1143 input_struc.operand.size_sw (2) = 0; 1144 1145 call cobol_addr (input_ptr, inst_ptr, reloc_ptr); 1146 1147 /* Set the mlr opcode into the instruction */ 1148 inst_struc.inst.fill1_op = mlr_op; 1149 1150 /* Emit the instruction to move the temp index data item image to the index data item 1151* being incremented. */ 1152 call cobol_emit (inst_ptr, reloc_ptr, 3); 1153 1154 end increment_index_data_item; 1155 1156 format2_search: 1157 proc; 1158 1159 1160 1161 /* DECLARATION OF AN ENTRY ARRAY. */ 1162 1163 dcl fmt2_eos_proc (1:3) entry init (fmt2_eos1, fmt2_eos2, fmt2_eos3); 1164 1165 /**************************************************/ 1166 /* START OF EXECUTION */ 1167 /* INTERNAL PROCEDURE */ 1168 /* format2_search */ 1169 /**************************************************/ 1170 1171 call fmt2_eos_proc (in_token.token_ptr (in_token.n) -> end_stmt.e); 1172 1173 1174 fmt2_eos1: 1175 proc; 1176 1177 /* Reserve a tag to be defined at the first instruction generated to test whether 1178* the index name is within limits. */ 1179 1180 check_index_tag = cobol_$next_tag; 1181 1182 /* Reserve a tag to be defined at the first instruction generated for the WHEN clause. */ 1183 1184 next_when_tag = check_index_tag + 1; 1185 1186 /* Reserve a tag to be defined at the first instruction of the next cobol statement. 1187* (The statement following this SEARCH statement. ) */ 1188 1189 next_stmt_tag = check_index_tag + 2; 1190 1191 next_compare_tag = cobol_$next_tag + 3; 1192 1193 /* Update the next tag counter in MCOBOL external data segment. */ 1194 1195 cobol_$next_tag = cobol_$next_tag + 4; 1196 1197 dn_ptr = in_token.token_ptr (2); 1198 if data_name.occurs_do 1199 then do; 1200 call cobol_read_rand (1, data_name.do_rec, com2_ptr); 1201 call cobol_read_rand (3, odo_rec.descr, dn_ptr); 1202 do_ptr = dn_ptr; 1203 end; 1204 else do_ptr = null (); 1205 1206 /* Generate code to initialize the index name being used in the search. */ 1207 1208 /* Set up the in_token structure for a call to the SET generator. */ 1209 1210 in_token_ptr = addr (work_in_token (1)); 1211 in_token.token_ptr (1) = save_in_token_ptr -> in_token.token_ptr (1); 1212 /* Reserved word SEARCH */ 1213 in_token.token_ptr (2) = save_in_token_ptr -> in_token.token_ptr (3); 1214 /* Index name token. */ 1215 in_token.token_ptr (3) = addr (numeric_lit_1); 1216 in_token.token_ptr (4) = addr (set_eos_token); 1217 in_token.n = 4; 1218 set_eos_token.a = "000"b; /* Format 1 set. */ 1219 set_eos_token.e = 1; /* One operand to be set. */ 1220 1221 /* Call the SET generator. */ 1222 call cobol_set_gen (in_token_ptr); 1223 1224 1225 /* Generate code to determine whether the index is at its maximum value. */ 1226 1227 eos_ptr = save_in_token_ptr -> in_token.token_ptr (save_in_token_ptr -> in_token.n); 1228 1229 /* Build an in_token structure for calling cobol_compare_gen. */ 1230 1231 in_token.token_ptr (1) = null (); /* in_token.token_ptr(2) points to the index name already. (It was set above when 1232* the in_token structure was built for the call to cobol_set_gen. */ 1233 1234 in_token.token_ptr (3) = addr (work_numeric_lit); 1235 in_token.token_ptr (4) = addr (compare_eos_token); 1236 in_token.n = 4; 1237 1238 /* Convert the maximum value that can be contained in the index name to a character string literal. */ 1239 1240 1241 work_numeric_lit.places_left = work_numeric_lit.places; 1242 1243 compare_eos_token.e = 102; /* COMPARE EQUAL */ 1244 compare_eos_token.i = "000"b; /* Transfer if equal to the tag in end_stmt.h. */ 1245 1246 if end_stmt.b = "1"b 1247 then do; /* AT END CLAUSE present. */ 1248 /* Reserve a tag to be defined at the first instruction generated 1249* for the AT END clause. */ 1250 1251 at_end_tag = cobol_$next_tag; 1252 cobol_$next_tag = cobol_$next_tag + 1; 1253 compare_eos_token.h = at_end_tag; /* Transfer to the at_end_tag when the index equals 1254* its maximum value. */ 1255 1256 end; /* AT END CLAUSE present. */ 1257 1258 else compare_eos_token.h = next_stmt_tag; /* Transfer to the next Cobol statement when the 1259* index equals its maximum value. */ 1260 1261 if do_ptr ^= null () 1262 then do; 1263 in_token.token_ptr (3) = do_ptr; 1264 call bin_to_char (fixed (in_token.token_ptr (2) -> index_name.max, 17), work_numeric_lit.literal, 1265 work_numeric_lit.places); 1266 work_numeric_lit.places_left = work_numeric_lit.places; 1267 compare_eos_token.e = 113; /* greater compare */ 1268 call cobol_compare_gen (in_token_ptr); 1269 compare_eos_token.e = 102; 1270 end; 1271 1272 /* Generate an instruction to transfer to the next_when_tag. */ 1273 1274 call cobol_emit (addr (tra_inst), null (), 1); 1275 1276 /* Make a tag reference at the instruction just emitted. */ 1277 call cobol_make_tagref (next_when_tag, cobol_$text_wd_off - 1, null ()); 1278 1279 /* Define the check_index_tag at the next instruction to be generated. */ 1280 call cobol_define_tag (check_index_tag); 1281 1282 call bin_to_char (fixed (in_token.token_ptr (2) -> index_name.max, 17), work_numeric_lit.literal, 1283 work_numeric_lit.places); 1284 work_numeric_lit.places_left = work_numeric_lit.places; 1285 1286 if do_ptr ^= null () 1287 then do; 1288 call cobol_compare_gen (in_token_ptr); 1289 in_token.token_ptr (3) = addr (work_numeric_lit); 1290 end; 1291 call cobol_compare_gen (in_token_ptr); 1292 1293 /* Generate code to increment the index by 1. */ 1294 1295 in_token.token_ptr (1) = save_in_token_ptr -> in_token.token_ptr (1); 1296 /* in_token.token_ptr(2) still points to the index name token. */ 1297 in_token.token_ptr (3) = addr (numeric_lit_1); 1298 in_token.token_ptr (4) = addr (set_eos_token); 1299 1300 set_eos_token.a = "001"b; /* FOR AT 2 SET */ 1301 set_eos_token.b = "0"b; /* UP */ 1302 1303 call cobol_set_gen (in_token_ptr); 1304 1305 /* Check to see if AT END clause was present. If present, generate a transfer to the WHEN clause. */ 1306 1307 if end_stmt.b = "1"b 1308 then do; /* AT END CLAUSE present. */ 1309 1310 /* Generate a transfer. */ 1311 call cobol_emit (addr (tra_inst), null (), 1); 1312 1313 /* Make a reference to the next_when_tag at the instruction just emitted. */ 1314 call cobol_make_tagref (next_when_tag, cobol_$text_wd_off - 1, null ()); 1315 1316 /* Define the at_end_tag at the next instruction location. */ 1317 call cobol_define_tag (at_end_tag); 1318 1319 1320 end; /* AT END CLAUSE present. */ 1321 1322 else /* Define the next_when tag at the next instruction location. */ 1323 call cobol_define_tag (next_when_tag); 1324 1325 end fmt2_eos1; 1326 1327 1328 fmt2_eos2: 1329 proc; 1330 1331 1332 if in_token.token_ptr (in_token.n) -> end_stmt.b = "1"b 1333 then /* This is the lase EOS2 in the SEARCH statement. */ /* Define the next_stmt_tag. */ 1334 call cobol_define_tag (next_stmt_tag); 1335 1336 else do; /* This is not the last EOS2 in the SEARCH statement. */ 1337 /* Generate code to transfer to the next_stmt_tag. */ 1338 call cobol_emit (addr (tra_inst), null (), 1); 1339 1340 /* Make a tagref at the instruction just emitted. */ 1341 call cobol_make_tagref (next_stmt_tag, cobol_$text_wd_off - 1, null ()); 1342 1343 /* Define the next_when_tag at the next instruction location. */ 1344 1345 call cobol_define_tag (next_when_tag); 1346 1347 end; /* This is not the last EOS2 in the SEARCH statement. */ 1348 1349 end fmt2_eos2; 1350 1351 1352 fmt2_eos3: 1353 proc; 1354 1355 dcl ix fixed bin; 1356 dcl iy fixed bin; /* Build an in_token structure for calling cobol_compare_gen. */ 1357 in_token_ptr = addr (work_in_token); 1358 in_token.n = 3; 1359 in_token.token_ptr (3) = addr (compare_eos_token); 1360 compare_eos_token.h = check_index_tag; 1361 compare_eos_token.i = "010"b; /* Transfer if not equal to check_index_tag. */ 1362 1363 ix = 1; 1364 iy = 1; /* Generate code to compare two operands and transfer to check_index_tag if not equal. */ 1365 1366 /* Process each pair of operands in the input token structure. */ 1367 1368 do while (save_in_token_ptr -> in_token.token_ptr (iy) -> end_stmt.type ^= rtc_eos); 1369 1370 /* Get a pointer to the first operand of the comparison. */ 1371 in_token.token_ptr (1) = save_in_token_ptr -> in_token.token_ptr (ix); 1372 1373 /* Get a pointer to the second operand of the comparison. Note that the token for 1374* the reserved word EQUAL is in in_token.token_ptr(ix+ 1) */ 1375 1376 in_token.token_ptr (2) = save_in_token_ptr -> in_token.token_ptr (ix + 2); 1377 1378 call cobol_compare_gen (in_token_ptr); 1379 1380 /* Increment the index to reference the pointer following the 2nd operand. */ 1381 ix = ix + 4; 1382 iy = ix - 1; 1383 1384 end; 1385 1386 end fmt2_eos3; 1387 end format2_search; 1388 1389 bin_to_char: 1390 proc (bin_value, ret_string, ret_length); 1391 1392 dcl bin_value fixed bin; 1393 dcl ret_string char (*); 1394 dcl ret_length fixed bin (15); 1395 1396 dcl digit fixed bin; 1397 dcl work_string char (20); 1398 dcl work_value fixed bin; 1399 dcl iy fixed bin; 1400 1401 dcl char_value (0:9) char (1) int static init ("0", "1", "2", "3", "4", "5", "6", "7", "8", "9"); 1402 1403 if bin_value = 0 1404 then do; /* INput value is zero. */ 1405 ret_length = 1; 1406 substr (ret_string, 1, 1) = char_value (0); 1407 end; /* Input value is zero. */ 1408 1409 else do; /* Input value non-zero. */ 1410 1411 work_value = bin_value; 1412 iy = 0; 1413 1414 do while (work_value ^= 0); 1415 iy = iy + 1; 1416 digit = mod (work_value, 10); 1417 work_value = work_value / 10; 1418 substr (work_string, 21 - iy, 1) = char_value (digit); 1419 end; 1420 substr (ret_string, 1, iy) = substr (work_string, 21 - iy, iy); 1421 ret_length = iy; 1422 end; 1423 1424 1425 end bin_to_char; 1426 1427 /**************************************************/ 1428 /* INCLUDE FILES USED BY THIS PROCEDURE */ 1429 /**************************************************/ 1430 1431 1432 /***** Declaration for builtin function *****/ 1433 1434 dcl (substr, mod, binary, fixed, addr, addrel, rel, length, string, unspec, null, index) 1435 builtin; 1436 1437 /***** End of declaration for builtin function *****/ 1438 1 1 1 2 /* BEGIN INCLUDE FILE ... cobol_type19.incl.pl1 */ 1 3 /* last modified on 11/19/76 by ORN */ 1 4 1 5 /* 1 6*A type 19 end of statement token is created in the procedure division 1 7*minpral file at the end of each minpral statement generated by the 1 8*procedure division syntax phase. A minpral statement may be a complete or 1 9*partial source language statement. A type 19 token contains information 1 10*describing the statement which it delimits. 1 11**/ 1 12 1 13 dcl eos_ptr ptr; 1 14 1 15 /* BEGIN DECLARATION OF TYPE19 (END STATEMENT) TOKEN */ 1 16 dcl 1 end_stmt based (eos_ptr), 2 1 2 2 /* begin include file ... cobol_TYPE19.incl.pl1 */ 2 3 /* Last modified on 11/17/76 by ORN */ 2 4 2 5 /* header */ 2 6 2 size fixed bin, 2 7 2 line fixed bin, 2 8 2 column fixed bin, 2 9 2 type fixed bin, 2 10 /* body */ 2 11 2 verb fixed bin, 2 12 2 e fixed bin, 2 13 2 h fixed bin, 2 14 2 i fixed bin, 2 15 2 j fixed bin, 2 16 2 a bit (3), 2 17 2 b bit (1), 2 18 2 c bit (1), 2 19 2 d bit (2), 2 20 2 f bit (2), 2 21 2 g bit (2), 2 22 2 k bit (5), 2 23 2 always_an bit (1); 2 24 2 25 /* end include file ... cobol_TYPE19.incl.pl1 */ 2 26 1 17 1 18 /* END DECLARATION OF TYPE19 (END STATEMENT) TOKEN */ 1 19 1 20 /* 1 21*FIELD CONTENTS 1 22* 1 23*size The total size in bytes of this end of statement token. 1 24*line 0 1 25*column 0 1 26*type 19 1 27*verb A value indicating the verb in this statement 1 28* 1 = accept 1 29* 2 = add 1 30* 3 = on size error 1 31* 4 = alter 1 32* 5 = call 1 33* 7 = cancel 1 34* 8 = close 1 35* 9 = divide 1 36* 10 = multiply 1 37* 11 = subtract 1 38* 12 = exit 1 39* 14 = go 1 40* 15 = merge 1 41* 16 = initiate 1 42* 17 = inspect 1 43* 18 = move 1 44* 19 = open 1 45* 20 = perform 1 46* 21 = read 1 47* 23 = receive 1 48* 24 = release 1 49* 25 = return 1 50* 26 = search 1 51* 27 = rewrite 1 52* 29 = seek 1 53* 30 = send 1 54* 31 = set 1 55* 33 = stop 1 56* 34 = string 1 57* 35 = suspend 1 58* 36 = terminate 1 59* 37 = unstring 1 60* 38 = write 1 61* 39 = use 1 62* 40 = compute 1 63* 41 = disable 1 64* 42 = display 1 65* 43 = enable 1 66* 45 = generate 1 67* 46 = hold 1 68* 48 = process 1 69* 49 = sort 1 70* 52 = procedure 1 71* 53 = declaratives 1 72* 54 = section name 1 73* 55 = paragraph name 1 74* 98 = end 1 75*e,h,i,j The significance of these fields differs with each 1 76* statement. These fields are normally used as counters. 1 77*a,b,c,d,f,g,k The significance of these fields differs with each 1 78* statement. These fields are normally used as indicators. 1 79**/ 1 80 1 81 /* END INCLUDE FILE ... cobol_type19.incl.pl1 */ 1 82 1439 1440 1441 3 1 3 2 /* BEGIN INCLUDE FILE ... cobol_type30.incl.pl1 */ 3 3 /* Last modified on 11/19/76 by ORN */ 3 4 3 5 /* 3 6*An internal tag token is created in the procedure division minpral file by 3 7*the procedure division syntax phase whenever the introduction of a 3 8*compiler-generated procedure definition is required to maintain the proper 3 9*logical flow between minpral statements. A typical usage of type 30 tokens 3 10*is as labels of simple conditions within a compound condition. 3 11**/ 3 12 3 13 dcl tag_ptr ptr; 3 14 3 15 /* BEGIN DECLARATION OF TYPE30 (INTERNAL TAG) TOKEN */ 3 16 dcl 1 int_tag based (tag_ptr), 3 17 /* header */ 3 18 2 size fixed bin (15), 3 19 2 line fixed bin (15), 3 20 2 column fixed bin (15), 3 21 2 type fixed bin (15), 3 22 /* body */ 3 23 2 filler1 ptr, 3 24 2 filler2 ptr, 3 25 2 perform_bit bit (1), 3 26 2 true_path bit (1), 3 27 2 filler3 bit (6), 3 28 2 filler4 char (2), 3 29 2 filler5 bit (8), 3 30 2 filler6 fixed bin (15), 3 31 2 proc_num fixed bin (15), 3 32 2 filler7 fixed bin (15), 3 33 2 filler8 char (1); 3 34 /* END DECLARATION OF TYPE30 (INTERNAL TAG) TOKEN */ 3 35 3 36 /* 3 37*FIELD CONTENTS 3 38* 3 39*size The total size in bytes of this internal tag token. 3 40*line 0 3 41*column 0 3 42*type 30 3 43*filler1 Available for future use. 3 44*filler2 Available for future use. 3 45*perform_bit Set to "1"b when this token is issued at the 3 46* end of a condition in a format #3 or format #4 3 47* perform. 3 48*true_path This field is significant only when perform_bit is 3 49* "1"b. Set to "1"b when this token represents the true 3 50* path of a condition. Set to "0"b when this token 3 51* represents the false path of a condition. 3 52*filler3 Available for future use. 3 53*filler4 Available for future use. 3 54*filler5 Available for future use. 3 55*filler6 Available for future use. 3 56*proc_num The internally generated procedure number of the tag 3 57* defined by this token. 3 58*filler7 Available for future use. 3 59*filler8 Available for future use. 3 60**/ 3 61 3 62 /* END INCLUDE FILE ... cobol_type30.incl.pl1 */ 3 63 1442 1443 1444 4 1 4 2 /* BEGIN INCLUDE FILE ... cobol_type10.incl.pl1 */ 4 3 /* Last modified on 11/19/76 by ORN */ 4 4 /* 4 5*A type 10 index name token is entered into the name table by the data 4 6*division syntax phase for each index name appearing in the data division. 4 7*An index name is declared in the indexed by phrase of an occurs clause. 4 8*maintain the binary byte offset, within the array, corresponding to the 4 9*current setting of the index name. The right-most two bytes contain the 4 10*binary occurrence number to which the index name is set. 4 11*When the replacement phase processes the procedure division minpral file, 4 12*each reference to an index name is replaced with the type 10 token created 4 13*for that index name. 4 14**/ 4 15 4 16 dcl ind_ptr ptr; 4 17 4 18 /* BEGIN DECLARATION OF TYPE10 (INDEX NAME) TOKEN */ 4 19 dcl 1 index_name based (ind_ptr), 5 1 5 2 /* begin include file ... cobol_TYPE10.incl.pl1 5 3*/* Last modified on 01/25/77 by ORN */ 5 4 5 5 /* header */ 5 6 2 size fixed bin, 5 7 2 line fixed bin, 5 8 2 column fixed bin, 5 9 2 type fixed bin, 5 10 /* body */ 5 11 2 string_ptr ptr, 5 12 2 prev_rec ptr, 5 13 2 searched bit(1), 5 14 2 duplicate bit(1), 5 15 2 saved bit(1), 5 16 2 debug_ind bit(1), 5 17 2 filler1 bit(3), 5 18 2 subscript bit(1), 5 19 2 def_line fixed bin, 5 20 2 level fixed bin, 5 21 2 seg_num fixed bin, 5 22 2 offset fixed bin(24), 5 23 2 index_no fixed bin, 5 24 2 min fixed bin, 5 25 2 max fixed bin, 5 26 2 struc_length fixed bin, 5 27 2 cswd_seg fixed bin, 5 28 2 cswd_offset fixed bin(24), 5 29 2 name_size fixed bin, 5 30 2 name char(0 refer(index_name.name_size)); 5 31 5 32 5 33 5 34 /* end include file ... cobol_TYPE10.incl.pl1 */ 5 35 4 20 4 21 /* END DECLARATION OF TYPE10 (INDEX NAME) TOKEN */ 4 22 4 23 /* END INCLUDE FILE ... cobol_type10.incl.pl1 */ 4 24 1445 1446 1447 6 1 6 2 /* BEGIN INCLUDE FILE ... cobol_type9.incl.pl1 */ 6 3 /* Last modified on 11/19/76 by ORN */ 6 4 6 5 /* 6 6*A type 9 data name token is entered into the name table by the data 6 7*division syntax phase for each data name described in the data division. 6 8*The replacement phase subsequently replaces type 8 user word references 6 9*to data names in the procedure division minpral file with the corresponding 6 10*type 9 tokens from the name table. 6 11**/ 6 12 6 13 /* dcl dn_ptr ptr; */ 6 14 6 15 /* BEGIN DECLARATION OF TYPE9 (DATA NAME) TOKEN */ 6 16 dcl 1 data_name based (dn_ptr), 7 1 7 2 /* begin include file ... cobol_TYPE9.incl.pl1 */ 7 3 /* Last modified on 06/19/77 by ORN */ 7 4 /* Last modified on 12/28/76 by FCH */ 7 5 7 6 /* header */ 7 7 2 size fixed bin, 7 8 2 line fixed bin, 7 9 2 column fixed bin, 7 10 2 type fixed bin, 7 11 /* body */ 7 12 2 string_ptr ptr, 7 13 2 prev_rec ptr, 7 14 2 searched bit (1), 7 15 2 duplicate bit (1), 7 16 2 saved bit (1), 7 17 2 debug_ind bit (1), 7 18 2 filler2 bit (3), 7 19 2 used_as_sub bit (1), 7 20 2 def_line fixed bin, 7 21 2 level fixed bin, 7 22 2 linkage fixed bin, 7 23 2 file_num fixed bin, 7 24 2 size_rtn fixed bin, 7 25 2 item_length fixed bin(24), 7 26 2 places_left fixed bin, 7 27 2 places_right fixed bin, 7 28 /* description */ 7 29 2 file_section bit (1), 7 30 2 working_storage bit (1), 7 31 2 constant_section bit (1), 7 32 2 linkage_section bit (1), 7 33 2 communication_section bit (1), 7 34 2 report_section bit (1), 7 35 2 level_77 bit (1), 7 36 2 level_01 bit (1), 7 37 2 non_elementary bit (1), 7 38 2 elementary bit (1), 7 39 2 filler_item bit (1), 7 40 2 s_of_rdf bit (1), 7 41 2 o_of_rdf bit (1), 7 42 2 bin_18 bit (1), 7 43 2 bin_36 bit (1), 7 44 2 pic_has_l bit (1), 7 45 2 pic_is_do bit (1), 7 46 2 numeric bit (1), 7 47 2 numeric_edited bit (1), 7 48 2 alphanum bit (1), 7 49 2 alphanum_edited bit (1), 7 50 2 alphabetic bit (1), 7 51 2 alphabetic_edited bit (1), 7 52 2 pic_has_p bit (1), 7 53 2 pic_has_ast bit (1), 7 54 2 item_signed bit(1), 7 55 2 sign_separate bit (1), 7 56 2 display bit (1), 7 57 2 comp bit (1), 7 58 2 ascii_packed_dec_h bit (1), /* as of 8/16/76 this field used for comp8. */ 7 59 2 ascii_packed_dec bit (1), 7 60 2 ebcdic_packed_dec bit (1), 7 61 2 bin_16 bit (1), 7 62 2 bin_32 bit (1), 7 63 2 usage_index bit (1), 7 64 2 just_right bit (1), 7 65 2 compare_argument bit (1), 7 66 2 sync bit (1), 7 67 2 temporary bit (1), 7 68 2 bwz bit (1), 7 69 2 variable_length bit (1), 7 70 2 subscripted bit (1), 7 71 2 occurs_do bit (1), 7 72 2 key_a bit (1), 7 73 2 key_d bit (1), 7 74 2 indexed_by bit (1), 7 75 2 value_numeric bit (1), 7 76 2 value_non_numeric bit (1), 7 77 2 value_signed bit (1), 7 78 2 sign_type bit (3), 7 79 2 pic_integer bit (1), 7 80 2 ast_when_zero bit (1), 7 81 2 label_record bit (1), 7 82 2 sign_clause_occurred bit (1), 7 83 2 okey_dn bit (1), 7 84 2 subject_of_keyis bit (1), 7 85 2 exp_redefining bit (1), 7 86 2 sync_in_rec bit (1), 7 87 2 rounded bit (1), 7 88 2 ad_bit bit (1), 7 89 2 debug_all bit (1), 7 90 2 overlap bit (1), 7 91 2 sum_counter bit (1), 7 92 2 exp_occurs bit (1), 7 93 2 linage_counter bit (1), 7 94 2 rnm_01 bit (1), 7 95 2 aligned bit (1), 7 96 2 not_user_writable bit (1), 7 97 2 database_key bit (1), 7 98 2 database_data_item bit (1), 7 99 2 seg_num fixed bin, 7 100 2 offset fixed bin(24), 7 101 2 initial_ptr fixed bin, 7 102 2 edit_ptr fixed bin, 7 103 2 occurs_ptr fixed bin, 7 104 2 do_rec char(5), 7 105 2 bitt bit (1), 7 106 2 byte bit (1), 7 107 2 half_word bit (1), 7 108 2 word bit (1), 7 109 2 double_word bit (1), 7 110 2 half_byte bit (1), 7 111 2 filler5 bit (1), 7 112 2 bit_offset bit (4), 7 113 2 son_cnt bit (16), 7 114 2 max_red_size fixed bin(24), 7 115 2 name_size fixed bin, 7 116 2 name char(0 refer(data_name.name_size)); 7 117 7 118 7 119 7 120 /* end include file ... cobol_TYPE9.incl.pl1 */ 7 121 6 17 6 18 /* END DECLARATION OF TYPE9 (DATA NAME) TOKEN */ 6 19 6 20 /* END INCLUDE FILE ... cobol_type9.incl.pl1 */ 6 21 1448 1449 1450 8 1 8 2 /* BEGIN INCLUDE FILE ... cobol_in_token.incl.pl1 */ 8 3 8 4 /* Last modified August 22, 1974 by AEG */ 8 5 8 6 8 7 declare in_token_ptr ptr; 8 8 8 9 declare 1 in_token aligned based(in_token_ptr), 8 10 2 n fixed bin aligned, 8 11 2 code fixed bin aligned, 8 12 2 token_ptr(0 refer(in_token.n)) ptr aligned; 8 13 8 14 8 15 /* END INCLUDE FILE ... cobol_in_token.incl.pl1 */ 8 16 1451 1452 9 1 9 2 /* BEGIN INCLUDE FILE ... cobol_record_types.incl.pl1 */ 9 3 /* <<< LAST MODIFIED ON 09-09-75 by tlf >>> */ 9 4 9 5 dcl rtc_resword fixed bin (15) int static init(1); 9 6 dcl rtc_numlit fixed bin (15) int static init(2); 9 7 dcl rtc_alphalit fixed bin (15) int static init(3); 9 8 dcl rtc_picstring fixed bin (15) int static init(4); 9 9 dcl rtc_diag fixed bin (15) int static init(5); 9 10 dcl rtc_source fixed bin (15) int static init(6); 9 11 dcl rtc_procdef fixed bin (15) int static init(7); 9 12 dcl rtc_userwd fixed bin (15) int static init(8); 9 13 dcl rtc_dataname fixed bin (15) int static init(9); 9 14 dcl rtc_indexname fixed bin (15) int static init(10); 9 15 dcl rtc_condname fixed bin (15) int static init(11); 9 16 dcl rtc_filedef fixed bin (15) int static init(12); 9 17 dcl rtc_commdesc fixed bin (15) int static init(13); 9 18 dcl rtc_debugitems fixed bin (15) int static init(14); 9 19 dcl rtc_savedarea fixed bin (15) int static init(15); 9 20 dcl rtc_sortmerge fixed bin (15) int static init(16); 9 21 dcl rtc_mnemonic fixed bin (15) int static init(17); 9 22 dcl rtc_pararef fixed bin (15) int static init(18); 9 23 dcl rtc_eos fixed bin (15) int static init(19); 9 24 dcl rtc_reportname fixed bin (15) int static init(20); 9 25 dcl rtc_groupname fixed bin (15) int static init(21); 9 26 dcl rtc_reportentry fixed bin (15) int static init(22); 9 27 dcl rtc_unknown1 fixed bin (15) int static init(23); 9 28 dcl rtc_debugenable fixed bin (15) int static init(24); 9 29 dcl rtc_unknown2 fixed bin (15) int static init(25); 9 30 dcl rtc_unknown3 fixed bin (15) int static init(26); 9 31 dcl rtc_unknown4 fixed bin (15) int static init(27); 9 32 dcl rtc_unknown5 fixed bin (15) int static init(28); 9 33 dcl rtc_unknown6 fixed bin (15) int static init(29); 9 34 dcl rtc_internal_tag fixed bin (15) int static init(30); 9 35 dcl rtc_equate_tag fixed bin (15) int static init(31); 9 36 dcl rtc_register fixed bin (15) int static init(100); 9 37 dcl rtc_fdec_temp fixed bin (15) int static init(101); 9 38 dcl rtc_immed_const fixed bin (15) int static init(102); 9 39 9 40 /* END INCLUDE FILE ... cobol_record_types.incl.pl1 */ 9 41 1453 1454 1455 10 1 10 2 /* BEGIN INCLUDE FILE ... cobol_.incl.pl1 */ 10 3 /* last modified Feb 4, 1977 by ORN */ 10 4 10 5 /* This file defines all external data used in the generator phase of Multics Cobol */ 10 6 10 7 /* POINTERS */ 10 8 dcl cobol_$text_base_ptr ptr ext; 10 9 dcl text_base_ptr ptr defined (cobol_$text_base_ptr); 10 10 dcl cobol_$con_end_ptr ptr ext; 10 11 dcl con_end_ptr ptr defined (cobol_$con_end_ptr); 10 12 dcl cobol_$def_base_ptr ptr ext; 10 13 dcl def_base_ptr ptr defined (cobol_$def_base_ptr); 10 14 dcl cobol_$link_base_ptr ptr ext; 10 15 dcl link_base_ptr ptr defined (cobol_$link_base_ptr); 10 16 dcl cobol_$sym_base_ptr ptr ext; 10 17 dcl sym_base_ptr ptr defined (cobol_$sym_base_ptr); 10 18 dcl cobol_$reloc_text_base_ptr ptr ext; 10 19 dcl reloc_text_base_ptr ptr defined (cobol_$reloc_text_base_ptr); 10 20 dcl cobol_$reloc_def_base_ptr ptr ext; 10 21 dcl reloc_def_base_ptr ptr defined (cobol_$reloc_def_base_ptr); 10 22 dcl cobol_$reloc_link_base_ptr ptr ext; 10 23 dcl reloc_link_base_ptr ptr defined (cobol_$reloc_link_base_ptr); 10 24 dcl cobol_$reloc_sym_base_ptr ptr ext; 10 25 dcl reloc_sym_base_ptr ptr defined (cobol_$reloc_sym_base_ptr); 10 26 dcl cobol_$reloc_work_base_ptr ptr ext; 10 27 dcl reloc_work_base_ptr ptr defined (cobol_$reloc_work_base_ptr); 10 28 dcl cobol_$pd_map_ptr ptr ext; 10 29 dcl pd_map_ptr ptr defined (cobol_$pd_map_ptr); 10 30 dcl cobol_$fixup_ptr ptr ext; 10 31 dcl fixup_ptr ptr defined (cobol_$fixup_ptr); 10 32 dcl cobol_$initval_base_ptr ptr ext; 10 33 dcl initval_base_ptr ptr defined (cobol_$initval_base_ptr); 10 34 dcl cobol_$initval_file_ptr ptr ext; 10 35 dcl initval_file_ptr ptr defined (cobol_$initval_file_ptr); 10 36 dcl cobol_$perform_list_ptr ptr ext; 10 37 dcl perform_list_ptr ptr defined (cobol_$perform_list_ptr); 10 38 dcl cobol_$alter_list_ptr ptr ext; 10 39 dcl alter_list_ptr ptr defined (cobol_$alter_list_ptr); 10 40 dcl cobol_$seg_init_list_ptr ptr ext; 10 41 dcl seg_init_list_ptr ptr defined (cobol_$seg_init_list_ptr); 10 42 dcl cobol_$temp_token_area_ptr ptr ext; 10 43 dcl temp_token_area_ptr ptr defined (cobol_$temp_token_area_ptr); 10 44 dcl cobol_$temp_token_ptr ptr ext; 10 45 dcl temp_token_ptr ptr defined (cobol_$temp_token_ptr); 10 46 dcl cobol_$token_block1_ptr ptr ext; 10 47 dcl token_block1_ptr ptr defined (cobol_$token_block1_ptr); 10 48 dcl cobol_$token_block2_ptr ptr ext; 10 49 dcl token_block2_ptr ptr defined (cobol_$token_block2_ptr); 10 50 dcl cobol_$minpral5_ptr ptr ext; 10 51 dcl minpral5_ptr ptr defined (cobol_$minpral5_ptr); 10 52 dcl cobol_$tag_table_ptr ptr ext; 10 53 dcl tag_table_ptr ptr defined (cobol_$tag_table_ptr); 10 54 dcl cobol_$map_data_ptr ptr ext; 10 55 dcl map_data_ptr ptr defined (cobol_$map_data_ptr); 10 56 dcl cobol_$ptr_status_ptr ptr ext; 10 57 dcl ptr_status_ptr ptr defined (cobol_$ptr_status_ptr); 10 58 dcl cobol_$reg_status_ptr ptr ext; 10 59 dcl reg_status_ptr ptr defined (cobol_$reg_status_ptr); 10 60 dcl cobol_$misc_base_ptr ptr ext; 10 61 dcl misc_base_ptr ptr defined (cobol_$misc_base_ptr); 10 62 dcl cobol_$misc_end_ptr ptr ext; 10 63 dcl misc_end_ptr ptr defined (cobol_$misc_end_ptr); 10 64 dcl cobol_$list_ptr ptr ext; 10 65 dcl list_ptr ptr defined (cobol_$list_ptr); 10 66 dcl cobol_$allo1_ptr ptr ext; 10 67 dcl allo1_ptr ptr defined (cobol_$allo1_ptr); 10 68 dcl cobol_$eln_ptr ptr ext; 10 69 dcl eln_ptr ptr defined (cobol_$eln_ptr); 10 70 dcl cobol_$diag_ptr ptr ext; 10 71 dcl diag_ptr ptr defined (cobol_$diag_ptr); 10 72 dcl cobol_$xref_token_ptr ptr ext; 10 73 dcl xref_token_ptr ptr defined (cobol_$xref_token_ptr); 10 74 dcl cobol_$xref_chain_ptr ptr ext; 10 75 dcl xref_chain_ptr ptr defined (cobol_$xref_chain_ptr); 10 76 dcl cobol_$statement_info_ptr ptr ext; 10 77 dcl statement_info_ptr ptr defined (cobol_$statement_info_ptr); 10 78 dcl cobol_$reswd_ptr ptr ext; 10 79 dcl reswd_ptr ptr defined (cobol_$reswd_ptr); 10 80 dcl cobol_$op_con_ptr ptr ext; 10 81 dcl op_con_ptr ptr defined (cobol_$op_con_ptr); 10 82 dcl cobol_$ntbuf_ptr ptr ext; 10 83 dcl ntbuf_ptr ptr defined (cobol_$ntbuf_ptr); 10 84 dcl cobol_$main_pcs_ptr ptr ext; 10 85 dcl main_pcs_ptr ptr defined (cobol_$main_pcs_ptr); 10 86 dcl cobol_$include_info_ptr ptr ext; 10 87 dcl include_info_ptr ptr defined (cobol_$include_info_ptr); 10 88 10 89 /* FIXED BIN */ 10 90 dcl cobol_$text_wd_off fixed bin ext; 10 91 dcl text_wd_off fixed bin defined (cobol_$text_wd_off); 10 92 dcl cobol_$con_wd_off fixed bin ext; 10 93 dcl con_wd_off fixed bin defined (cobol_$con_wd_off); 10 94 dcl cobol_$def_wd_off fixed bin ext; 10 95 dcl def_wd_off fixed bin defined (cobol_$def_wd_off); 10 96 dcl cobol_$def_max fixed bin ext; 10 97 dcl def_max fixed bin defined (cobol_$def_max); 10 98 dcl cobol_$link_wd_off fixed bin ext; 10 99 dcl link_wd_off fixed bin defined (cobol_$link_wd_off); 10 100 dcl cobol_$link_max fixed bin ext; 10 101 dcl link_max fixed bin defined (cobol_$link_max); 10 102 dcl cobol_$sym_wd_off fixed bin ext; 10 103 dcl sym_wd_off fixed bin defined (cobol_$sym_wd_off); 10 104 dcl cobol_$sym_max fixed bin ext; 10 105 dcl sym_max fixed bin defined (cobol_$sym_max); 10 106 dcl cobol_$reloc_text_max fixed bin(24) ext; 10 107 dcl reloc_text_max fixed bin(24) defined (cobol_$reloc_text_max); 10 108 dcl cobol_$reloc_def_max fixed bin(24) ext; 10 109 dcl reloc_def_max fixed bin(24) defined (cobol_$reloc_def_max); 10 110 dcl cobol_$reloc_link_max fixed bin(24) ext; 10 111 dcl reloc_link_max fixed bin(24) defined (cobol_$reloc_link_max); 10 112 dcl cobol_$reloc_sym_max fixed bin(24) ext; 10 113 dcl reloc_sym_max fixed bin(24) defined (cobol_$reloc_sym_max); 10 114 dcl cobol_$reloc_work_max fixed bin(24) ext; 10 115 dcl reloc_work_max fixed bin(24) defined (cobol_$reloc_work_max); 10 116 dcl cobol_$pd_map_index fixed bin ext; 10 117 dcl pd_map_index fixed bin defined (cobol_$pd_map_index); 10 118 dcl cobol_$cobol_data_wd_off fixed bin ext; 10 119 dcl cobol_data_wd_off fixed bin defined (cobol_$cobol_data_wd_off); 10 120 dcl cobol_$stack_off fixed bin ext; 10 121 dcl stack_off fixed bin defined (cobol_$stack_off); 10 122 dcl cobol_$max_stack_off fixed bin ext; 10 123 dcl max_stack_off fixed bin defined (cobol_$max_stack_off); 10 124 dcl cobol_$init_stack_off fixed bin ext; 10 125 dcl init_stack_off fixed bin defined (cobol_$init_stack_off); 10 126 dcl cobol_$pd_map_sw fixed bin ext; 10 127 dcl pd_map_sw fixed bin defined (cobol_$pd_map_sw); 10 128 dcl cobol_$next_tag fixed bin ext; 10 129 dcl next_tag fixed bin defined (cobol_$next_tag); 10 130 dcl cobol_$data_init_flag fixed bin ext; 10 131 dcl data_init_flag fixed bin defined (cobol_$data_init_flag); 10 132 dcl cobol_$seg_init_flag fixed bin ext; 10 133 dcl seg_init_flag fixed bin defined (cobol_$seg_init_flag); 10 134 dcl cobol_$alter_flag fixed bin ext; 10 135 dcl alter_flag fixed bin defined (cobol_$alter_flag); 10 136 dcl cobol_$sect_eop_flag fixed bin ext; 10 137 dcl sect_eop_flag fixed bin defined (cobol_$sect_eop_flag); 10 138 dcl cobol_$para_eop_flag fixed bin ext; 10 139 dcl para_eop_flag fixed bin defined (cobol_$para_eop_flag); 10 140 dcl cobol_$priority_no fixed bin ext; 10 141 dcl priority_no fixed bin defined (cobol_$priority_no); 10 142 dcl cobol_$compile_count fixed bin ext; 10 143 dcl compile_count fixed bin defined (cobol_$compile_count); 10 144 dcl cobol_$ptr_assumption_ind fixed bin ext; 10 145 dcl ptr_assumption_ind fixed bin defined (cobol_$ptr_assumption_ind); 10 146 dcl cobol_$reg_assumption_ind fixed bin ext; 10 147 dcl reg_assumption_ind fixed bin defined (cobol_$reg_assumption_ind); 10 148 dcl cobol_$perform_para_index fixed bin ext; 10 149 dcl perform_para_index fixed bin defined (cobol_$perform_para_index); 10 150 dcl cobol_$perform_sect_index fixed bin ext; 10 151 dcl perform_sect_index fixed bin defined (cobol_$perform_sect_index); 10 152 dcl cobol_$alter_index fixed bin ext; 10 153 dcl alter_index fixed bin defined (cobol_$alter_index); 10 154 dcl cobol_$list_off fixed bin ext; 10 155 dcl list_off fixed bin defined (cobol_$list_off); 10 156 dcl cobol_$constant_offset fixed bin ext; 10 157 dcl constant_offset fixed bin defined (cobol_$constant_offset); 10 158 dcl cobol_$misc_max fixed bin ext; 10 159 dcl misc_max fixed bin defined (cobol_$misc_max); 10 160 dcl cobol_$pd_map_max fixed bin ext; 10 161 dcl pd_map_max fixed bin defined (cobol_$pd_map_max); 10 162 dcl cobol_$map_data_max fixed bin ext; 10 163 dcl map_data_max fixed bin defined (cobol_$map_data_max); 10 164 dcl cobol_$fixup_max fixed bin ext; 10 165 dcl fixup_max fixed bin defined (cobol_$fixup_max); 10 166 dcl cobol_$tag_table_max fixed bin ext; 10 167 dcl tag_table_max fixed bin defined (cobol_$tag_table_max); 10 168 dcl cobol_$temp_token_max fixed bin ext; 10 169 dcl temp_token_max fixed bin defined (cobol_$temp_token_max); 10 170 dcl cobol_$allo1_max fixed bin ext; 10 171 dcl allo1_max fixed bin defined (cobol_$allo1_max); 10 172 dcl cobol_$eln_max fixed bin ext; 10 173 dcl eln_max fixed bin defined (cobol_$eln_max); 10 174 dcl cobol_$debug_enable fixed bin ext; 10 175 dcl debug_enable fixed bin defined (cobol_$debug_enable); 10 176 dcl cobol_$non_source_offset fixed bin ext; 10 177 dcl non_source_offset fixed bin defined (cobol_$non_source_offset); 10 178 dcl cobol_$initval_flag fixed bin ext; 10 179 dcl initval_flag fixed bin defined (cobol_$initval_flag); 10 180 dcl cobol_$date_compiled_sw fixed bin ext; 10 181 dcl date_compiled_sw fixed bin defined (cobol_$date_compiled_sw); 10 182 dcl cobol_$include_cnt fixed bin ext; 10 183 dcl include_cnt fixed bin defined (cobol_$include_cnt); 10 184 dcl cobol_$fs_charcnt fixed bin ext; 10 185 dcl fs_charcnt fixed bin defined (cobol_$fs_charcnt); 10 186 dcl cobol_$ws_charcnt fixed bin ext; 10 187 dcl ws_charcnt fixed bin defined (cobol_$ws_charcnt); 10 188 dcl cobol_$coms_charcnt fixed bin ext; 10 189 dcl coms_charcnt fixed bin defined (cobol_$coms_charcnt); 10 190 dcl cobol_$ls_charcnt fixed bin ext; 10 191 dcl ls_charcnt fixed bin defined (cobol_$ls_charcnt); 10 192 dcl cobol_$cons_charcnt fixed bin ext; 10 193 dcl cons_charcnt fixed bin defined (cobol_$cons_charcnt); 10 194 dcl cobol_$value_cnt fixed bin ext; 10 195 dcl value_cnt fixed bin defined (cobol_$value_cnt); 10 196 dcl cobol_$cd_cnt fixed bin ext; 10 197 dcl cd_cnt fixed bin defined (cobol_$cd_cnt); 10 198 dcl cobol_$fs_wdoff fixed bin ext; 10 199 dcl fs_wdoff fixed bin defined (cobol_$fs_wdoff); 10 200 dcl cobol_$ws_wdoff fixed bin ext; 10 201 dcl ws_wdoff fixed bin defined (cobol_$ws_wdoff); 10 202 dcl cobol_$coms_wdoff fixed bin ext; 10 203 dcl coms_wdoff fixed bin defined (cobol_$coms_wdoff); 10 204 10 205 /* CHARACTER */ 10 206 dcl cobol_$scratch_dir char (168) aligned ext; 10 207 dcl scratch_dir char (168) aligned defined (cobol_$scratch_dir); /* -42- */ 10 208 dcl cobol_$obj_seg_name char (32) aligned ext; 10 209 dcl obj_seg_name char (32) aligned defined (cobol_$obj_seg_name); /* -8- */ 10 210 10 211 /* BIT */ 10 212 dcl cobol_$xref_bypass bit(1) aligned ext; 10 213 dcl xref_bypass bit(1) aligned defined (cobol_$xref_bypass); /* -1- */ 10 214 dcl cobol_$same_sort_merge_proc bit(1) aligned ext; 10 215 dcl same_sort_merge_proc bit(1) aligned defined (cobol_$same_sort_merge_proc); /* -1- */ 10 216 10 217 10 218 /* END INCLUDE FILE ... cobol_incl.pl1*/ 10 219 10 220 1456 1457 1458 11 1 11 2 /* BEGIN INCLUDE FILE ... cobol_occurs_ext.incl.pl1 */ 11 3 /* Last modified on 01/19/77 by ORN */ 11 4 11 5 /* 11 6*An occurs extension is included in a type 9 data name token when the data 11 7*name is described with an occurs clause or is subordinate to an item 11 8*described with an occurs clause. 11 9**/ 11 10 11 11 /* ***STRUCTURE SIZE INFORMATION*** */ 11 12 /* THE SIZE OF THIS STRUCTURE IN BYTES, (EXCLUDING VARIABLE 11 13* LENGTH ENTITIES), FOR EACH HARDWARE IMPLEMENTATION IS: 11 14* 11 15* HARDWARE | SIZE (BYTES) 11 16* --------------------------------- 11 17* 6180 | 12 + 24 * dimensions 11 18* P7 | 6 + 14 * dimensions 11 19* --------------------------------- 11 20**/ 11 21 11 22 /* THE OCCURS EXTENSION STRUCTURE */ 11 23 11 24 dcl occurs_ptr ptr; 11 25 11 26 dcl 1 occurs based (occurs_ptr), 11 27 2 keyed fixed bin, 11 28 2 key_number fixed bin, 11 29 2 dimensions fixed bin, 11 30 2 level (occurs.dimensions), 11 31 3 index_no fixed bin, 11 32 3 min fixed bin, 11 33 3 max fixed bin, 11 34 3 struc_length fixed bin, 11 35 3 cswd_seg fixed bin, 11 36 3 cswd_offset fixed bin(24); 11 37 11 38 11 39 11 40 /* END INCLUDE FILE ... cobol_occurs_ext.incl.pl1 */ 11 41 1459 1460 1461 12 1 12 2 /* BEGIN INCLUDE FILE ... cobol_addr_tokens.incl.pl1 */ 12 3 12 4 12 5 /****^ HISTORY COMMENTS: 12 6* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8058), 12 7* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 12 8* MCR8058 cobol_addr_tokens.incl.pl1 Change array extents to refer to 12 9* constants rather than variables. 12 10* END HISTORY COMMENTS */ 12 11 12 12 12 13 /* Last modified on 10/1/74 by tg */ 12 14 12 15 12 16 /* parameter list */ 12 17 12 18 dcl (input_ptr, inst_ptr, reloc_ptr) ptr; 12 19 12 20 12 21 /* input_struc_basic is used for type 1 addressing */ 12 22 12 23 dcl 1 input_struc_basic based (input_ptr), 12 24 2 type fixed bin, 12 25 2 operand_no fixed bin, 12 26 2 lock fixed bin, 12 27 2 segno fixed bin, 12 28 2 char_offset fixed bin (24), 12 29 2 send_receive fixed bin; 12 30 12 31 12 32 dcl 1 input_struc based (input_ptr), 12 33 2 type fixed bin, 12 34 2 operand_no fixed bin, 12 35 2 lock fixed bin, 12 36 2 operand (0 refer (input_struc.operand_no)), 12 37 3 token_ptr ptr, 12 38 3 send_receive fixed bin, 12 39 3 ic_mod fixed bin, 12 40 3 size_sw fixed bin; 12 41 12 42 /* reloc_struc is used for all types of addressing * all types */ 12 43 12 44 dcl 1 reloc_struc (input_struc.operand_no + 1) based (reloc_ptr), 12 45 2 left_wd bit (5) aligned, 12 46 2 right_wd bit (5) aligned; 12 47 12 48 /* Instruction format for 1 word instruction */ 12 49 12 50 12 51 dcl 1 inst_struc_basic based (inst_ptr) aligned, 12 52 2 y unaligned, 12 53 3 pr bit (3) unaligned, 12 54 3 wd_offset bit (15) unaligned, 12 55 2 fill1_op bit (10) unaligned, 12 56 2 zero1 bit (1) unaligned, 12 57 2 pr_spec bit (1) unaligned, 12 58 2 tm bit (2) unaligned, 12 59 2 td bit (4) unaligned; 12 60 12 61 12 62 /* The detailed definitions of the fields in this structure 12 63* can be found in the GMAP manual section 8 */ 12 64 /* EIS instruction format for 2_4 word instructions */ 12 65 12 66 dcl 1 inst_struc based (inst_ptr) aligned, 12 67 2 inst unaligned, 12 68 3 zero1 bit (2) unaligned, 12 69 3 mf3 unaligned, 12 70 4 pr_spec bit (1) unaligned, 12 71 4 reg_or_length bit (1) unaligned, 12 72 4 zero2 bit (1) unaligned, 12 73 4 reg_mod bit (4) unaligned, 12 74 3 zero3 bit (2) unaligned, 12 75 3 mf2 unaligned, 12 76 4 pr_spec bit (1) unaligned, 12 77 4 reg_or_length bit (1) unaligned, 12 78 4 zero4 bit (1) unaligned, 12 79 4 reg_mod bit (4) unaligned, 12 80 3 fill1_op bit (10) unaligned, 12 81 3 zero5 bit (1) unaligned, 12 82 3 mf1 unaligned, 12 83 4 pr_spec bit (1) unaligned, 12 84 4 reg_or_length bit (1) unaligned, 12 85 4 zero6 bit (1) unaligned, 12 86 4 reg_mod bit (4) unaligned, 12 87 2 desc_ext unaligned, 12 88 3 desc (512) unaligned, 12 89 4 desc_od bit (36) unaligned; 12 90 12 91 /* The detailed definitions of the fields in this structure 12 92* can be found in the GMAP manual section 8. 12 93* The desc_ext is the descriptor extension of this eis 12 94* instruction. The number of descriptors associated with 12 95* this instruction is equavalent to the operand number. 12 96* Depending on operand data type, the descriptor 12 97* can be alphanumeric or numeric. The structures of the 12 98* alphanumeric and the numeric descriptors are defined 12 99* below. */ 12 100 12 101 /* alphanumeric descriptor format */ 12 102 12 103 dcl 1 desc_an based (desc_an_ptr) unaligned, 12 104 2 desc_f (512) unaligned, 12 105 3 y unaligned, 12 106 4 pr bit (3) unaligned, 12 107 4 wd_offset bit (15) unaligned, 12 108 3 char_n bit (3) unaligned, 12 109 3 zero1 bit (1) unaligned, 12 110 3 ta bit (2), 12 111 3 n bit (12) unaligned; 12 112 12 113 12 114 /* The detailed definitions of the fields in this structure can 12 115* be found in the GMAP manual section 8. */ 12 116 /* numeric descriptor format */ 12 117 12 118 dcl desc_nn_ptr ptr; 12 119 dcl desc_an_ptr ptr; 12 120 12 121 12 122 dcl 1 desc_nn based (desc_nn_ptr) unaligned, 12 123 2 desc_f (512) unaligned, 12 124 3 y unaligned, 12 125 4 pr bit (3) unaligned, 12 126 4 wd_offset bit (15) unaligned, 12 127 3 digit_n bit (3) unaligned, 12 128 3 tn bit (1) unaligned, 12 129 3 sign_type bit (2) unaligned, 12 130 3 scal bit (6) unaligned, 12 131 3 n bit (6) unaligned; 12 132 12 133 12 134 /* The detailed definitions of fields in this structure can 12 135* be found in the GMAP manual section 8. */ 12 136 /* END INCLUDE FILE ... cobol_addr_tokens.incl.pl1 */ 12 137 1462 13 1 13 2 /* BEGIN INCLUDE FILE ... cobol_odo_rec.incl.pl1 */ 13 3 dcl 1 odo_rec based(com2_ptr), 13 4 2 next char(5), 13 5 2 descr char(5), 13 6 2 seg_no fixed bin, 13 7 2 offset_l fixed bin(24), 13 8 2 offset_r fixed bin(24), 13 9 2 info bit(8); 13 10 /* END INCLUDE FILE ... cobol_odo_rec.incl.pl1 */ 13 11 1463 1464 1465 1466 1467 /**************************************************/ 1468 /* END OF EXTERNAL PROCEDURE */ 1469 /* cobol_search_gen */ 1470 /**************************************************/ 1471 1472 end cobol_search_gen; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0832.6 cobol_search_gen.pl1 >spec>install>MR12.3-1048>cobol_search_gen.pl1 1439 1 03/27/82 0439.8 cobol_type19.incl.pl1 >ldd>include>cobol_type19.incl.pl1 1-17 2 03/27/82 0439.6 cobol_TYPE19.incl.pl1 >ldd>include>cobol_TYPE19.incl.pl1 1442 3 03/27/82 0439.8 cobol_type30.incl.pl1 >ldd>include>cobol_type30.incl.pl1 1445 4 03/27/82 0439.8 cobol_type10.incl.pl1 >ldd>include>cobol_type10.incl.pl1 4-20 5 11/11/82 1712.7 cobol_TYPE10.incl.pl1 >ldd>include>cobol_TYPE10.incl.pl1 1448 6 03/27/82 0439.9 cobol_type9.incl.pl1 >ldd>include>cobol_type9.incl.pl1 6-17 7 11/11/82 1712.7 cobol_TYPE9.incl.pl1 >ldd>include>cobol_TYPE9.incl.pl1 1451 8 11/11/82 1712.7 cobol_in_token.incl.pl1 >ldd>include>cobol_in_token.incl.pl1 1453 9 03/27/82 0439.8 cobol_record_types.incl.pl1 >ldd>include>cobol_record_types.incl.pl1 1456 10 11/11/82 1712.7 cobol_.incl.pl1 >ldd>include>cobol_.incl.pl1 1459 11 11/11/82 1712.7 cobol_occurs_ext.incl.pl1 >ldd>include>cobol_occurs_ext.incl.pl1 1462 12 05/24/89 0811.7 cobol_addr_tokens.incl.pl1 >spec>install>MR12.3-1048>cobol_addr_tokens.incl.pl1 1463 13 03/27/82 0439.7 cobol_odo_rec.incl.pl1 >ldd>include>cobol_odo_rec.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. T1 parameter fixed bin(17,0) dcl 587 set ref 583 591* T2 parameter fixed bin(17,0) dcl 587 set ref 583 593* a 11 based bit(3) level 2 in structure "end_stmt" packed packed unaligned dcl 1-16 in procedure "cobol_search_gen" ref 93 a 11 000010 internal static bit(3) initial level 2 in structure "set_eos_token" packed packed unaligned dcl 106 in procedure "cobol_search_gen" set ref 425* 450* 1218* 1300* add_eos_token 000034 internal static structure level 1 unaligned dcl 139 set ref 483 add_next_stmt_tag 000232 automatic fixed bin(17,0) dcl 232 set ref 486* addr builtin function dcl 1434 ref 303 303 402 419 421 444 446 479 481 483 506 517 517 523 555 555 590 590 736 737 738 793 794 795 820 820 841 841 877 877 1018 1019 1020 1022 1023 1024 1035 1035 1060 1061 1089 1089 1109 1109 1210 1215 1216 1234 1235 1274 1274 1289 1297 1298 1311 1311 1338 1338 1357 1359 addrel builtin function dcl 1434 ref 320 331 aos_op constant bit(10) initial packed unaligned dcl 192 ref 1027 asa_op constant bit(10) initial packed unaligned dcl 191 ref 1042 at_end_tag 000103 internal static fixed bin(17,0) dcl 203 set ref 274* 520* 539* 1251* 1253 1317* b 11(03) 000010 internal static bit(1) initial level 2 in structure "set_eos_token" packed packed unaligned dcl 106 in procedure "cobol_search_gen" set ref 426* 451* 1301* b 11(03) based bit(1) level 2 in structure "end_stmt" packed packed unaligned dcl 1-16 in procedure "cobol_search_gen" ref 518 528 550 1246 1307 1332 bin_value parameter fixed bin(17,0) dcl 1392 ref 1389 1403 1411 buff1 000240 automatic pointer array dcl 1000 in procedure "increment_index_data_item" set ref 1022 buff1 000122 automatic pointer array dcl 731 in procedure "get_index_item_data" set ref 736 buff2 000264 automatic pointer array dcl 1001 in procedure "increment_index_data_item" set ref 1023 buff2 000146 automatic pointer array dcl 732 in procedure "get_index_item_data" set ref 737 buff3 000310 automatic pointer array dcl 1002 in procedure "increment_index_data_item" set ref 1024 buff3 000172 automatic pointer array dcl 733 in procedure "get_index_item_data" set ref 738 c 11(04) based bit(1) level 2 packed packed unaligned dcl 1-16 ref 292 315 char_offset 4 based fixed bin(24,0) level 2 dcl 12-23 set ref 802* 806* 810* 1067* 1070* char_value 000000 constant char(1) initial array packed unaligned dcl 1401 ref 1406 1418 check_index_tag 000102 internal static fixed bin(17,0) dcl 202 set ref 1180* 1184 1189 1280* 1360 cobol_$next_tag 000166 external static fixed bin(17,0) dcl 10-128 set ref 260 273 274 280* 280 844 845* 845 1180 1191 1195* 1195 1251 1252* 1252 cobol_$text_wd_off 000164 external static fixed bin(17,0) dcl 10-90 ref 307 518 520 556 591 847 1277 1314 1341 cobol_add_gen 000150 constant entry external dcl 72 ref 486 cobol_addr 000156 constant entry external dcl 76 ref 782 803 807 811 1068 1071 1145 cobol_alloc$stack 000162 constant entry external dcl 78 ref 748 1050 cobol_compare_gen 000136 constant entry external dcl 67 ref 516 525 1268 1288 1291 1378 cobol_define_tag 000144 constant entry external dcl 70 ref 310 492 522 539 593 854 1280 1317 1322 1332 1345 cobol_emit 000140 constant entry external dcl 68 ref 303 517 555 590 788 826 841 860 864 877 881 891 895 1028 1039 1043 1075 1089 1094 1098 1109 1114 1152 1274 1311 1338 cobol_make_tagref 000142 constant entry external dcl 69 ref 307 518 520 556 591 847 1277 1314 1341 cobol_make_type9$copy 000154 constant entry external dcl 74 ref 761 1125 cobol_process_error 000160 constant entry external dcl 77 ref 851 cobol_read_rand 000152 constant entry external dcl 73 ref 287 288 1200 1201 cobol_register$load 000134 constant entry external dcl 65 ref 820 1035 cobol_set_gen 000146 constant entry external dcl 71 ref 470 1222 1303 com2_ptr 000102 automatic pointer dcl 195 set ref 287* 288 1200* 1201 compare_code_tag 000077 internal static fixed bin(17,0) dcl 199 set ref 265* 307* 492* compare_eos_token 000046 internal static structure level 1 unaligned dcl 153 set ref 506 1235 1359 contains 4 000156 automatic fixed bin(17,0) level 2 dcl 211 set ref 817* 1033* data_name based structure level 1 unaligned dcl 6-16 descr 1(09) based char(5) level 2 packed packed unaligned dcl 13-3 set ref 288* 1201* digit 000100 automatic fixed bin(17,0) dcl 1396 set ref 1416* 1418 dimensions 2 based fixed bin(17,0) level 2 dcl 11-26 ref 342 div_op constant bit(10) initial packed unaligned dcl 190 ref 890 dn_ptr 000164 automatic pointer dcl 218 set ref 284* 285 287 288* 289 319* 320 320 328* 331 331 1197* 1198 1200 1201* 1202 do_ptr 000100 automatic pointer dcl 195 set ref 289* 291* 512 514 1202* 1204* 1261 1263 1286 do_rec 30 based char(5) level 2 packed packed unaligned dcl 6-16 set ref 287* 1200* e 5 000046 internal static fixed bin(15,0) initial level 2 in structure "compare_eos_token" dcl 153 in procedure "cobol_search_gen" set ref 508* 1243* 1267* 1269* e 5 000010 internal static fixed bin(15,0) level 2 in structure "set_eos_token" dcl 106 in procedure "cobol_search_gen" set ref 1219* e 5 based fixed bin(17,0) level 2 in structure "end_stmt" dcl 1-16 in procedure "cobol_search_gen" set ref 251 423* 448* 1171 element_length_inst parameter bit(36) packed unaligned dcl 655 in procedure "get_index_item_data" set ref 625 795 element_length_inst parameter bit(36) packed unaligned dcl 934 in procedure "increment_index_data_item" set ref 905 1020 element_length_inst_ptr 000232 automatic pointer dcl 993 in procedure "increment_index_data_item" set ref 1020* 1038 1039* element_length_inst_ptr 000120 automatic pointer dcl 728 in procedure "get_index_item_data" set ref 795* 811* 894 895* element_length_inst_word 000236 automatic bit(36) packed unaligned dcl 240 set ref 292* 434* end_stmt based structure level 1 unaligned dcl 1-16 eos_proc 000206 automatic entry variable initial array dcl 224 set ref 224* 224* 224* 224* 251 eos_ptr 000166 automatic pointer dcl 1-13 set ref 282* 292 315 518 528 1227* 1246 1307 fill1_op 0(18) based bit(10) level 3 in structure "inst_struc" packed packed unaligned dcl 12-66 in procedure "cobol_search_gen" set ref 785* 1148* fill1_op 0(18) based bit(10) level 2 in structure "inst_struc_basic" packed packed unaligned dcl 12-51 in procedure "cobol_search_gen" set ref 823* 857* 863* 880* 890* 894* 1027* 1038* 1042* 1074* 1093* 1097* 1113* fixed builtin function dcl 1434 ref 851 851 1264 1264 1282 1282 fmt2_eos_proc 000246 automatic entry variable initial array dcl 1163 set ref 1163* 1163* 1163* 1171 get_occurrence_code 000130 internal static structure level 1 packed packed unaligned dcl 977 set ref 1109 1109 get_occurrence_no_code 000104 internal static structure level 1 packed packed unaligned dcl 683 set ref 841 841 get_offset_code 000121 internal static structure level 1 packed packed unaligned dcl 961 in procedure "increment_index_data_item" set ref 1089 1089 get_offset_code 000111 internal static structure level 1 packed packed unaligned dcl 696 in procedure "get_index_item_data" set ref 877 877 h 6 000046 internal static fixed bin(15,0) initial level 2 dcl 153 set ref 515* 524* 1253* 1258* 1360* i 7 000046 internal static bit(36) initial level 2 packed packed unaligned dcl 153 set ref 509* 1244* 1361* in_token based structure level 1 dcl 8-9 in_token_ptr parameter pointer dcl 8-7 set ref 39 91 93 93 96* 251 251 282 282 284 292 292 292 292 292 292 318 318 319 319 328 328 333 333 342 342 347 347 357 357 361 361 372 372 373 373 402* 404 405 418 419 421 422 423 444 446 447 448 470* 479* 480 481 482 483 484 486* 505 506 507 514 516* 523 525* 550 550 612 612 1171 1171 1197 1210* 1211 1213 1215 1216 1217 1222* 1231 1234 1235 1236 1263 1264 1264 1268* 1282 1282 1288* 1289 1291* 1295 1297 1298 1303* 1332 1332 1357* 1358 1359 1371 1376 1378* increment_code_tag 000100 internal static fixed bin(17,0) dcl 200 set ref 276* 310* 556* 561* index_data_item_ptr parameter pointer dcl 651 in procedure "get_index_item_data" set ref 625 761* 773 851 851 index_data_item_ptr parameter pointer dcl 930 in procedure "increment_index_data_item" set ref 905 1125* 1141 index_name based structure level 1 unaligned dcl 4-19 index_no 3 based fixed bin(17,0) array level 3 in structure "occurs" dcl 11-26 in procedure "cobol_search_gen" ref 342 index_no 15 based fixed bin(17,0) level 2 in structure "index_name" dcl 4-19 in procedure "cobol_search_gen" ref 342 index_token_ptr 000226 automatic pointer dcl 229 set ref 318* 347* 357* 372* 405 460 460 464 499 507 input_ptr 000172 automatic pointer dcl 12-18 set ref 736* 770 771 772 773 774 775 777 778 779 782* 797 798 799 802 803* 806 807* 810 811* 1022* 1063 1064 1065 1067 1068* 1070 1071* 1133 1134 1135 1137 1138 1139 1141 1142 1143 1145* input_struc based structure level 1 unaligned dcl 12-32 input_struc_basic based structure level 1 unaligned dcl 12-23 inst based structure level 2 packed packed unaligned dcl 12-66 inst_ptr 000174 automatic pointer dcl 12-18 set ref 737* 782* 785 788* 1023* 1145* 1148 1152* inst_struc based structure level 1 dcl 12-66 inst_struc_basic based structure level 1 dcl 12-51 int_tag based structure level 1 unaligned dcl 3-16 ix 000100 automatic fixed bin(17,0) dcl 1355 set ref 1363* 1371 1376 1381* 1381 1382 iy 000107 automatic fixed bin(17,0) dcl 1399 in procedure "bin_to_char" set ref 1412* 1415* 1415 1418 1420 1420 1420 1421 iy 000101 automatic fixed bin(17,0) dcl 1356 in procedure "fmt2_eos3" set ref 1364* 1368 1382* lda_op constant bit(10) initial packed unaligned dcl 189 ref 863 1038 ldq_op constant bit(10) initial packed unaligned dcl 187 ref 823 1074 1097 level 3 based structure array level 2 unaligned dcl 11-26 line 1 based fixed bin(17,0) level 2 dcl 6-16 ref 851 851 literal 11 000056 internal static char(20) level 2 packed packed unaligned dcl 164 set ref 499* 1264* 1282* lock 2 000156 automatic fixed bin(17,0) level 2 in structure "register_struc" dcl 211 in procedure "cobol_search_gen" set ref 816* 1032* lock 2 based fixed bin(17,0) level 2 in structure "input_struc" dcl 12-32 in procedure "cobol_search_gen" set ref 772* 1135* max 17 based fixed bin(17,0) level 2 dcl 4-19 set ref 460* 460 464* 464 464 499 1264 1264 1282 1282 mlr_op constant bit(10) initial packed unaligned dcl 186 ref 785 1148 mod builtin function dcl 1434 ref 1416 n based fixed bin(17,0) level 2 dcl 8-9 set ref 93 251 282 292 292 292 318 319 328 333 342 347 357 361 372 373 422* 447* 484* 505* 550 612 1171 1217* 1227 1236* 1332 1358* next_compare_tag 000075 internal static fixed bin(17,0) dcl 197 set ref 273* 515 522* 1191* next_stmt_tag 000076 internal static fixed bin(17,0) dcl 198 set ref 260* 265 269 276 518* 535* 561* 576* 1189* 1258 1332* 1341* next_when_tag 000101 internal static fixed bin(17,0) dcl 201 set ref 269* 524 535* 576* 612* 1184* 1277* 1314* 1322* 1345* null builtin function dcl 1434 ref 291 303 303 307 307 321 348 409 464 473 480 512 517 517 518 518 520 520 555 555 556 556 590 590 591 591 760 826 826 841 841 847 847 860 860 864 864 877 877 881 881 891 891 895 895 1028 1028 1039 1039 1043 1043 1075 1075 1089 1089 1094 1094 1098 1098 1109 1109 1114 1114 1124 1204 1231 1261 1274 1274 1277 1277 1286 1311 1311 1314 1314 1338 1338 1341 1341 numeric_lit_1 000022 internal static structure level 1 unaligned dcl 120 set ref 419 444 481 1215 1297 occurrence_inst_word 000235 automatic bit(36) packed unaligned dcl 238 set ref 292* 434* occurrence_ok_tag 000216 automatic fixed bin(17,0) dcl 734 set ref 844* 847* 854* occurs based structure level 1 unaligned dcl 11-26 occurs_do 22(06) based bit(1) level 2 packed packed unaligned dcl 6-16 ref 285 1198 occurs_ptr 27 based fixed bin(17,0) level 2 in structure "data_name" dcl 6-16 in procedure "cobol_search_gen" ref 320 331 occurs_ptr 000170 automatic pointer dcl 11-24 in procedure "cobol_search_gen" set ref 320* 331* 342 342 odo_rec based structure level 1 unaligned dcl 13-3 offset 24 based fixed bin(24,0) level 2 dcl 6-16 set ref 765* 1129* offset_inst_word 000234 automatic bit(36) packed unaligned dcl 237 set ref 292* 434* operand 4 based structure array level 2 unaligned dcl 12-32 operand_no 1 based fixed bin(17,0) level 2 in structure "input_struc_basic" dcl 12-23 in procedure "cobol_search_gen" set ref 798* 1064* operand_no 1 based fixed bin(17,0) level 2 in structure "input_struc" dcl 12-32 in procedure "cobol_search_gen" set ref 771* 779 1134* places 10 000056 internal static fixed bin(15,0) initial level 2 dcl 164 set ref 499* 503 1241 1264* 1266 1282* 1284 places_left 6 000056 internal static fixed bin(15,0) initial level 2 dcl 164 set ref 503* 1241* 1266* 1284* proc_num 12 based fixed bin(15,0) level 2 dcl 3-16 ref 612 register_struc 000156 automatic structure level 1 unaligned dcl 211 set ref 820 820 1035 1035 reloc_ptr 000176 automatic pointer dcl 12-18 set ref 738* 782* 788* 803* 807* 811* 1024* 1068* 1071* 1145* 1152* ret_length parameter fixed bin(15,0) dcl 1394 set ref 1389 1405* 1421* ret_string parameter char packed unaligned dcl 1393 set ref 1389 1406* 1420* rtc_dataname constant fixed bin(15,0) initial dcl 9-13 ref 292 430 473 rtc_eos constant fixed bin(15,0) initial dcl 9-23 ref 1368 rtc_indexname constant fixed bin(15,0) initial dcl 9-14 ref 333 412 464 save_in_token_ptr 000104 automatic pointer dcl 205 set ref 91* 96 404 1211 1213 1227 1227 1295 1368 1371 1376 search_flag parameter fixed bin(17,0) dcl 61 set ref 39 565* 601* 614* search_occurrence_error 000120 internal static fixed bin(17,0) initial dcl 712 set ref 851* seg_num 23 based fixed bin(17,0) level 2 dcl 6-16 set ref 764* 1128* segno 3 based fixed bin(17,0) level 2 dcl 12-23 set ref 799* 1065* send_receive 6 based fixed bin(17,0) array level 3 dcl 12-32 set ref 774* 778* 1138* 1142* set_eos_token 000010 internal static structure level 1 unaligned dcl 106 set ref 421 446 1216 1298 size_sw 10 based fixed bin(17,0) array level 3 dcl 12-32 set ref 775* 779* 1139* 1143* sta_op constant bit(10) initial packed unaligned dcl 193 ref 1093 1113 stq_op constant bit(10) initial packed unaligned dcl 188 ref 857 880 894 subscripted 22(05) based bit(1) level 2 packed packed unaligned dcl 6-16 set ref 766* 1130* substr builtin function dcl 1434 set ref 1406* 1418* 1420* 1420 temp_occurrence_inst 000341 automatic bit(36) packed unaligned dcl 1009 set ref 1061 temp_occurrence_inst_ptr 000336 automatic pointer dcl 1006 set ref 1061* 1071* 1113 1114* temp_offset_inst 000340 automatic bit(36) packed unaligned dcl 1008 set ref 1060 temp_offset_inst_ptr 000334 automatic pointer dcl 1004 set ref 1060* 1068* 1093 1094* temp_ptr 000234 automatic pointer dcl 996 set ref 1124* 1125* 1128 1129 1130 1137 token_ptr 2 based pointer array level 2 in structure "in_token" dcl 8-9 in procedure "cobol_search_gen" set ref 93 251 282 284 292 292 292* 318 319 328 333 342 347 357 361 372 373 404* 404 405* 418* 419* 421* 423 444* 446* 448 480* 481* 482* 483* 506* 507* 514* 523* 550 612 1171 1197 1211* 1211 1213* 1213 1215* 1216* 1227 1231* 1234* 1235* 1263* 1264 1264 1282 1282 1289* 1295* 1295 1297* 1298* 1332 1359* 1368 1371* 1371 1376* 1376 token_ptr 4 based pointer array level 3 in structure "input_struc" dcl 12-32 in procedure "cobol_search_gen" set ref 773* 777* 1137* 1141* tra_inst 000074 internal static bit(36) initial packed unaligned dcl 183 set ref 303 303 517 517 555 555 590 590 1274 1274 1311 1311 1338 1338 type based fixed bin(17,0) level 2 in structure "input_struc_basic" dcl 12-23 in procedure "cobol_search_gen" set ref 797* 1063* type based fixed bin(17,0) level 2 in structure "input_struc" dcl 12-32 in procedure "cobol_search_gen" set ref 770* 1133* type 3 based fixed bin(17,0) level 2 in structure "end_stmt" dcl 1-16 in procedure "cobol_search_gen" ref 1368 type 3 based fixed bin(17,0) level 2 in structure "data_name" dcl 6-16 in procedure "cobol_search_gen" ref 292 333 412 430 464 473 usage_index 21(34) based bit(1) level 2 packed packed unaligned dcl 6-16 ref 292 430 473 varying_done 000233 automatic bit(1) packed unaligned dcl 234 set ref 401* 417* 441 varying_token_ptr 000230 automatic pointer dcl 230 set ref 321* 348* 361* 373* 409 412 418 430 430 434* 464 464 464 464 473 473 473 482 what_reg 000156 automatic fixed bin(17,0) level 2 dcl 211 set ref 815* 1031* work_in_token 000106 automatic pointer array dcl 207 set ref 402 479 1210 1357 work_numeric_lit 000056 internal static structure level 1 unaligned dcl 164 set ref 523 1234 1289 work_occurrence_inst parameter bit(36) packed unaligned dcl 932 in procedure "increment_index_data_item" set ref 905 1019 work_occurrence_inst parameter bit(36) packed unaligned dcl 653 in procedure "get_index_item_data" set ref 625 794 work_occurrence_inst_ptr 000116 automatic pointer dcl 726 in procedure "get_index_item_data" set ref 794* 807* 823 826* 857 860* 890 891* work_occurrence_inst_ptr 000230 automatic pointer dcl 991 in procedure "increment_index_data_item" set ref 1019* 1027 1028* 1097 1098* work_offset1 000106 automatic fixed bin(17,0) dcl 718 in procedure "get_index_item_data" set ref 748* 751* 751 754 757 765 802 work_offset1 000236 automatic fixed bin(17,0) dcl 998 in procedure "increment_index_data_item" set ref 1050* 1054* 1054 1057 1067 1129 work_offset2 000107 automatic fixed bin(17,0) dcl 719 in procedure "get_index_item_data" set ref 754* 806 work_offset2 000237 automatic fixed bin(17,0) dcl 999 in procedure "increment_index_data_item" set ref 1057* 1070 work_offset3 000110 automatic fixed bin(17,0) dcl 720 set ref 757* 810 work_offset_inst parameter bit(36) packed unaligned dcl 652 in procedure "get_index_item_data" set ref 625 793 work_offset_inst parameter bit(36) packed unaligned dcl 931 in procedure "increment_index_data_item" set ref 905 1018 work_offset_inst_ptr 000226 automatic pointer dcl 989 in procedure "increment_index_data_item" set ref 1018* 1042 1043* 1074 1075* work_offset_inst_ptr 000114 automatic pointer dcl 724 in procedure "get_index_item_data" set ref 793* 803* 863 864* 880 881* work_ptr 000112 automatic pointer dcl 722 set ref 760* 761* 764 765 766 777 work_string 000101 automatic char(20) packed unaligned dcl 1397 set ref 1418* 1420 work_value 000106 automatic fixed bin(17,0) dcl 1398 set ref 1411* 1414 1416 1417* 1417 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. allo1_max defined fixed bin(17,0) dcl 10-171 allo1_ptr defined pointer dcl 10-67 alter_flag defined fixed bin(17,0) dcl 10-135 alter_index defined fixed bin(17,0) dcl 10-153 alter_list_ptr defined pointer dcl 10-39 binary builtin function dcl 1434 cd_cnt defined fixed bin(17,0) dcl 10-197 cobol_$allo1_max external static fixed bin(17,0) dcl 10-170 cobol_$allo1_ptr external static pointer dcl 10-66 cobol_$alter_flag external static fixed bin(17,0) dcl 10-134 cobol_$alter_index external static fixed bin(17,0) dcl 10-152 cobol_$alter_list_ptr external static pointer dcl 10-38 cobol_$cd_cnt external static fixed bin(17,0) dcl 10-196 cobol_$cobol_data_wd_off external static fixed bin(17,0) dcl 10-118 cobol_$compile_count external static fixed bin(17,0) dcl 10-142 cobol_$coms_charcnt external static fixed bin(17,0) dcl 10-188 cobol_$coms_wdoff external static fixed bin(17,0) dcl 10-202 cobol_$con_end_ptr external static pointer dcl 10-10 cobol_$con_wd_off external static fixed bin(17,0) dcl 10-92 cobol_$cons_charcnt external static fixed bin(17,0) dcl 10-192 cobol_$constant_offset external static fixed bin(17,0) dcl 10-156 cobol_$data_init_flag external static fixed bin(17,0) dcl 10-130 cobol_$date_compiled_sw external static fixed bin(17,0) dcl 10-180 cobol_$debug_enable external static fixed bin(17,0) dcl 10-174 cobol_$def_base_ptr external static pointer dcl 10-12 cobol_$def_max external static fixed bin(17,0) dcl 10-96 cobol_$def_wd_off external static fixed bin(17,0) dcl 10-94 cobol_$diag_ptr external static pointer dcl 10-70 cobol_$eln_max external static fixed bin(17,0) dcl 10-172 cobol_$eln_ptr external static pointer dcl 10-68 cobol_$fixup_max external static fixed bin(17,0) dcl 10-164 cobol_$fixup_ptr external static pointer dcl 10-30 cobol_$fs_charcnt external static fixed bin(17,0) dcl 10-184 cobol_$fs_wdoff external static fixed bin(17,0) dcl 10-198 cobol_$include_cnt external static fixed bin(17,0) dcl 10-182 cobol_$include_info_ptr external static pointer dcl 10-86 cobol_$init_stack_off external static fixed bin(17,0) dcl 10-124 cobol_$initval_base_ptr external static pointer dcl 10-32 cobol_$initval_file_ptr external static pointer dcl 10-34 cobol_$initval_flag external static fixed bin(17,0) dcl 10-178 cobol_$link_base_ptr external static pointer dcl 10-14 cobol_$link_max external static fixed bin(17,0) dcl 10-100 cobol_$link_wd_off external static fixed bin(17,0) dcl 10-98 cobol_$list_off external static fixed bin(17,0) dcl 10-154 cobol_$list_ptr external static pointer dcl 10-64 cobol_$ls_charcnt external static fixed bin(17,0) dcl 10-190 cobol_$main_pcs_ptr external static pointer dcl 10-84 cobol_$map_data_max external static fixed bin(17,0) dcl 10-162 cobol_$map_data_ptr external static pointer dcl 10-54 cobol_$max_stack_off external static fixed bin(17,0) dcl 10-122 cobol_$minpral5_ptr external static pointer dcl 10-50 cobol_$misc_base_ptr external static pointer dcl 10-60 cobol_$misc_end_ptr external static pointer dcl 10-62 cobol_$misc_max external static fixed bin(17,0) dcl 10-158 cobol_$non_source_offset external static fixed bin(17,0) dcl 10-176 cobol_$ntbuf_ptr external static pointer dcl 10-82 cobol_$obj_seg_name external static char(32) dcl 10-208 cobol_$op_con_ptr external static pointer dcl 10-80 cobol_$para_eop_flag external static fixed bin(17,0) dcl 10-138 cobol_$pd_map_index external static fixed bin(17,0) dcl 10-116 cobol_$pd_map_max external static fixed bin(17,0) dcl 10-160 cobol_$pd_map_ptr external static pointer dcl 10-28 cobol_$pd_map_sw external static fixed bin(17,0) dcl 10-126 cobol_$perform_list_ptr external static pointer dcl 10-36 cobol_$perform_para_index external static fixed bin(17,0) dcl 10-148 cobol_$perform_sect_index external static fixed bin(17,0) dcl 10-150 cobol_$priority_no external static fixed bin(17,0) dcl 10-140 cobol_$ptr_assumption_ind external static fixed bin(17,0) dcl 10-144 cobol_$ptr_status_ptr external static pointer dcl 10-56 cobol_$reg_assumption_ind external static fixed bin(17,0) dcl 10-146 cobol_$reg_status_ptr external static pointer dcl 10-58 cobol_$reloc_def_base_ptr external static pointer dcl 10-20 cobol_$reloc_def_max external static fixed bin(24,0) dcl 10-108 cobol_$reloc_link_base_ptr external static pointer dcl 10-22 cobol_$reloc_link_max external static fixed bin(24,0) dcl 10-110 cobol_$reloc_sym_base_ptr external static pointer dcl 10-24 cobol_$reloc_sym_max external static fixed bin(24,0) dcl 10-112 cobol_$reloc_text_base_ptr external static pointer dcl 10-18 cobol_$reloc_text_max external static fixed bin(24,0) dcl 10-106 cobol_$reloc_work_base_ptr external static pointer dcl 10-26 cobol_$reloc_work_max external static fixed bin(24,0) dcl 10-114 cobol_$reswd_ptr external static pointer dcl 10-78 cobol_$same_sort_merge_proc external static bit(1) dcl 10-214 cobol_$scratch_dir external static char(168) dcl 10-206 cobol_$sect_eop_flag external static fixed bin(17,0) dcl 10-136 cobol_$seg_init_flag external static fixed bin(17,0) dcl 10-132 cobol_$seg_init_list_ptr external static pointer dcl 10-40 cobol_$stack_off external static fixed bin(17,0) dcl 10-120 cobol_$statement_info_ptr external static pointer dcl 10-76 cobol_$sym_base_ptr external static pointer dcl 10-16 cobol_$sym_max external static fixed bin(17,0) dcl 10-104 cobol_$sym_wd_off external static fixed bin(17,0) dcl 10-102 cobol_$tag_table_max external static fixed bin(17,0) dcl 10-166 cobol_$tag_table_ptr external static pointer dcl 10-52 cobol_$temp_token_area_ptr external static pointer dcl 10-42 cobol_$temp_token_max external static fixed bin(17,0) dcl 10-168 cobol_$temp_token_ptr external static pointer dcl 10-44 cobol_$text_base_ptr external static pointer dcl 10-8 cobol_$token_block1_ptr external static pointer dcl 10-46 cobol_$token_block2_ptr external static pointer dcl 10-48 cobol_$value_cnt external static fixed bin(17,0) dcl 10-194 cobol_$ws_charcnt external static fixed bin(17,0) dcl 10-186 cobol_$ws_wdoff external static fixed bin(17,0) dcl 10-200 cobol_$xref_bypass external static bit(1) dcl 10-212 cobol_$xref_chain_ptr external static pointer dcl 10-74 cobol_$xref_token_ptr external static pointer dcl 10-72 cobol_data_wd_off defined fixed bin(17,0) dcl 10-119 compile_count defined fixed bin(17,0) dcl 10-143 coms_charcnt defined fixed bin(17,0) dcl 10-189 coms_wdoff defined fixed bin(17,0) dcl 10-203 con_end_ptr defined pointer dcl 10-11 con_wd_off defined fixed bin(17,0) dcl 10-93 cons_charcnt defined fixed bin(17,0) dcl 10-193 constant_offset defined fixed bin(17,0) dcl 10-157 data_init_flag defined fixed bin(17,0) dcl 10-131 date_compiled_sw defined fixed bin(17,0) dcl 10-181 debug_enable defined fixed bin(17,0) dcl 10-175 def_base_ptr defined pointer dcl 10-13 def_max defined fixed bin(17,0) dcl 10-97 def_wd_off defined fixed bin(17,0) dcl 10-95 desc_an based structure level 1 packed packed unaligned dcl 12-103 desc_an_ptr automatic pointer dcl 12-119 desc_nn based structure level 1 packed packed unaligned dcl 12-122 desc_nn_ptr automatic pointer dcl 12-118 diag_ptr defined pointer dcl 10-71 eln_max defined fixed bin(17,0) dcl 10-173 eln_ptr defined pointer dcl 10-69 fixup_max defined fixed bin(17,0) dcl 10-165 fixup_ptr defined pointer dcl 10-31 fs_charcnt defined fixed bin(17,0) dcl 10-185 fs_wdoff defined fixed bin(17,0) dcl 10-199 include_cnt defined fixed bin(17,0) dcl 10-183 include_info_ptr defined pointer dcl 10-87 ind_ptr automatic pointer dcl 4-16 index builtin function dcl 1434 init_stack_off defined fixed bin(17,0) dcl 10-125 initval_base_ptr defined pointer dcl 10-33 initval_file_ptr defined pointer dcl 10-35 initval_flag defined fixed bin(17,0) dcl 10-179 ioa_$ioa_stream 000000 constant entry external dcl 66 ix automatic fixed bin(17,0) dcl 235 iy automatic fixed bin(17,0) dcl 236 length builtin function dcl 1434 link_base_ptr defined pointer dcl 10-15 link_max defined fixed bin(17,0) dcl 10-101 link_wd_off defined fixed bin(17,0) dcl 10-99 list_off defined fixed bin(17,0) dcl 10-155 list_ptr defined pointer dcl 10-65 ls_charcnt defined fixed bin(17,0) dcl 10-191 main_pcs_ptr defined pointer dcl 10-85 map_data_max defined fixed bin(17,0) dcl 10-163 map_data_ptr defined pointer dcl 10-55 max_stack_off defined fixed bin(17,0) dcl 10-123 minpral5_ptr defined pointer dcl 10-51 misc_base_ptr defined pointer dcl 10-61 misc_end_ptr defined pointer dcl 10-63 misc_max defined fixed bin(17,0) dcl 10-159 next_tag defined fixed bin(17,0) dcl 10-129 non_source_offset defined fixed bin(17,0) dcl 10-177 ntbuf_ptr defined pointer dcl 10-83 obj_seg_name defined char(32) dcl 10-209 op_con_ptr defined pointer dcl 10-81 para_eop_flag defined fixed bin(17,0) dcl 10-139 pd_map_index defined fixed bin(17,0) dcl 10-117 pd_map_max defined fixed bin(17,0) dcl 10-161 pd_map_ptr defined pointer dcl 10-29 pd_map_sw defined fixed bin(17,0) dcl 10-127 perform_list_ptr defined pointer dcl 10-37 perform_para_index defined fixed bin(17,0) dcl 10-149 perform_sect_index defined fixed bin(17,0) dcl 10-151 priority_no defined fixed bin(17,0) dcl 10-141 ptr_assumption_ind defined fixed bin(17,0) dcl 10-145 ptr_status_ptr defined pointer dcl 10-57 reg_assumption_ind defined fixed bin(17,0) dcl 10-147 reg_status_ptr defined pointer dcl 10-59 rel builtin function dcl 1434 reloc_def_base_ptr defined pointer dcl 10-21 reloc_def_max defined fixed bin(24,0) dcl 10-109 reloc_link_base_ptr defined pointer dcl 10-23 reloc_link_max defined fixed bin(24,0) dcl 10-111 reloc_struc based structure array level 1 unaligned dcl 12-44 reloc_sym_base_ptr defined pointer dcl 10-25 reloc_sym_max defined fixed bin(24,0) dcl 10-113 reloc_text_base_ptr defined pointer dcl 10-19 reloc_text_max defined fixed bin(24,0) dcl 10-107 reloc_work_base_ptr defined pointer dcl 10-27 reloc_work_max defined fixed bin(24,0) dcl 10-115 reswd_ptr defined pointer dcl 10-79 rtc_alphalit internal static fixed bin(15,0) initial dcl 9-7 rtc_commdesc internal static fixed bin(15,0) initial dcl 9-17 rtc_condname internal static fixed bin(15,0) initial dcl 9-15 rtc_debugenable internal static fixed bin(15,0) initial dcl 9-28 rtc_debugitems internal static fixed bin(15,0) initial dcl 9-18 rtc_diag internal static fixed bin(15,0) initial dcl 9-9 rtc_equate_tag internal static fixed bin(15,0) initial dcl 9-35 rtc_fdec_temp internal static fixed bin(15,0) initial dcl 9-37 rtc_filedef internal static fixed bin(15,0) initial dcl 9-16 rtc_groupname internal static fixed bin(15,0) initial dcl 9-25 rtc_immed_const internal static fixed bin(15,0) initial dcl 9-38 rtc_internal_tag internal static fixed bin(15,0) initial dcl 9-34 rtc_mnemonic internal static fixed bin(15,0) initial dcl 9-21 rtc_numlit internal static fixed bin(15,0) initial dcl 9-6 rtc_pararef internal static fixed bin(15,0) initial dcl 9-22 rtc_picstring internal static fixed bin(15,0) initial dcl 9-8 rtc_procdef internal static fixed bin(15,0) initial dcl 9-11 rtc_register internal static fixed bin(15,0) initial dcl 9-36 rtc_reportentry internal static fixed bin(15,0) initial dcl 9-26 rtc_reportname internal static fixed bin(15,0) initial dcl 9-24 rtc_resword internal static fixed bin(15,0) initial dcl 9-5 rtc_savedarea internal static fixed bin(15,0) initial dcl 9-19 rtc_sortmerge internal static fixed bin(15,0) initial dcl 9-20 rtc_source internal static fixed bin(15,0) initial dcl 9-10 rtc_unknown1 internal static fixed bin(15,0) initial dcl 9-27 rtc_unknown2 internal static fixed bin(15,0) initial dcl 9-29 rtc_unknown3 internal static fixed bin(15,0) initial dcl 9-30 rtc_unknown4 internal static fixed bin(15,0) initial dcl 9-31 rtc_unknown5 internal static fixed bin(15,0) initial dcl 9-32 rtc_unknown6 internal static fixed bin(15,0) initial dcl 9-33 rtc_userwd internal static fixed bin(15,0) initial dcl 9-12 same_sort_merge_proc defined bit(1) dcl 10-215 scratch_dir defined char(168) dcl 10-207 sect_eop_flag defined fixed bin(17,0) dcl 10-137 seg_init_flag defined fixed bin(17,0) dcl 10-133 seg_init_list_ptr defined pointer dcl 10-41 stack_off defined fixed bin(17,0) dcl 10-121 statement_info_ptr defined pointer dcl 10-77 string builtin function dcl 1434 sym_base_ptr defined pointer dcl 10-17 sym_max defined fixed bin(17,0) dcl 10-105 sym_wd_off defined fixed bin(17,0) dcl 10-103 tag_ptr automatic pointer dcl 3-13 tag_table_max defined fixed bin(17,0) dcl 10-167 tag_table_ptr defined pointer dcl 10-53 temp_token_area_ptr defined pointer dcl 10-43 temp_token_max defined fixed bin(17,0) dcl 10-169 temp_token_ptr defined pointer dcl 10-45 text_base_ptr defined pointer dcl 10-9 text_wd_off defined fixed bin(17,0) dcl 10-91 token_block1_ptr defined pointer dcl 10-47 token_block2_ptr defined pointer dcl 10-49 unspec builtin function dcl 1434 value_cnt defined fixed bin(17,0) dcl 10-195 work_string automatic char(20) packed unaligned dcl 233 ws_charcnt defined fixed bin(17,0) dcl 10-187 ws_wdoff defined fixed bin(17,0) dcl 10-201 xref_bypass defined bit(1) dcl 10-213 xref_chain_ptr defined pointer dcl 10-75 xref_token_ptr defined pointer dcl 10-73 NAMES DECLARED BY EXPLICIT CONTEXT. TG 001264 constant entry internal dcl 583 ref 535 561 576 bin_to_char 003704 constant entry internal dcl 1389 ref 499 1264 1282 cobol_search_gen 000020 constant entry external dcl 39 fmt1_eos 000117 constant entry internal dcl 254 ref 224 fmt2_eos 001152 constant entry internal dcl 546 ref 224 fmt2_eos1 002734 constant entry internal dcl 1174 ref 1163 fmt2_eos2 003511 constant entry internal dcl 1328 ref 1163 fmt2_eos3 003612 constant entry internal dcl 1352 ref 1163 fmt3_eos 001344 constant entry internal dcl 597 ref 224 fmt4_eos 001357 constant entry internal dcl 608 ref 224 format1_search 000046 constant entry internal dcl 219 ref 93 format2_search 002671 constant entry internal dcl 1156 ref 95 get_index_item_data 001377 constant entry internal dcl 625 ref 292 increment_index_data_item 002165 constant entry internal dcl 905 ref 434 NAME DECLARED BY CONTEXT OR IMPLICATION. divide builtin function ref 320 331 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 4262 4452 3776 4272 Length 5246 3776 170 560 264 124 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_search_gen 181 external procedure is an external procedure. format1_search internal procedure shares stack frame of external procedure cobol_search_gen. fmt1_eos 296 internal procedure is assigned to an entry variable. fmt2_eos 78 internal procedure is assigned to an entry variable. TG 78 internal procedure is called by several nonquick procedures. fmt3_eos 64 internal procedure is assigned to an entry variable. fmt4_eos 64 internal procedure is assigned to an entry variable. get_index_item_data internal procedure shares stack frame of internal procedure fmt1_eos. increment_index_data_item internal procedure shares stack frame of internal procedure fmt1_eos. format2_search internal procedure shares stack frame of external procedure cobol_search_gen. fmt2_eos1 94 internal procedure is assigned to an entry variable. fmt2_eos2 82 internal procedure is assigned to an entry variable. fmt2_eos3 70 internal procedure is assigned to an entry variable. bin_to_char 73 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 set_eos_token cobol_search_gen 000022 numeric_lit_1 cobol_search_gen 000034 add_eos_token cobol_search_gen 000046 compare_eos_token cobol_search_gen 000056 work_numeric_lit cobol_search_gen 000074 tra_inst cobol_search_gen 000075 next_compare_tag cobol_search_gen 000076 next_stmt_tag cobol_search_gen 000077 compare_code_tag cobol_search_gen 000100 increment_code_tag cobol_search_gen 000101 next_when_tag cobol_search_gen 000102 check_index_tag cobol_search_gen 000103 at_end_tag cobol_search_gen 000104 get_occurrence_no_code get_index_item_data 000111 get_offset_code get_index_item_data 000120 search_occurrence_error get_index_item_data 000121 get_offset_code increment_index_data_item 000130 get_occurrence_code increment_index_data_item STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME bin_to_char 000100 digit bin_to_char 000101 work_string bin_to_char 000106 work_value bin_to_char 000107 iy bin_to_char cobol_search_gen 000100 do_ptr cobol_search_gen 000102 com2_ptr cobol_search_gen 000104 save_in_token_ptr cobol_search_gen 000106 work_in_token cobol_search_gen 000156 register_struc cobol_search_gen 000164 dn_ptr cobol_search_gen 000166 eos_ptr cobol_search_gen 000170 occurs_ptr cobol_search_gen 000172 input_ptr cobol_search_gen 000174 inst_ptr cobol_search_gen 000176 reloc_ptr cobol_search_gen 000206 eos_proc format1_search 000226 index_token_ptr format1_search 000230 varying_token_ptr format1_search 000232 add_next_stmt_tag format1_search 000233 varying_done format1_search 000234 offset_inst_word format1_search 000235 occurrence_inst_word format1_search 000236 element_length_inst_word format1_search 000246 fmt2_eos_proc format2_search fmt1_eos 000106 work_offset1 get_index_item_data 000107 work_offset2 get_index_item_data 000110 work_offset3 get_index_item_data 000112 work_ptr get_index_item_data 000114 work_offset_inst_ptr get_index_item_data 000116 work_occurrence_inst_ptr get_index_item_data 000120 element_length_inst_ptr get_index_item_data 000122 buff1 get_index_item_data 000146 buff2 get_index_item_data 000172 buff3 get_index_item_data 000216 occurrence_ok_tag get_index_item_data 000226 work_offset_inst_ptr increment_index_data_item 000230 work_occurrence_inst_ptr increment_index_data_item 000232 element_length_inst_ptr increment_index_data_item 000234 temp_ptr increment_index_data_item 000236 work_offset1 increment_index_data_item 000237 work_offset2 increment_index_data_item 000240 buff1 increment_index_data_item 000264 buff2 increment_index_data_item 000310 buff3 increment_index_data_item 000334 temp_offset_inst_ptr increment_index_data_item 000336 temp_occurrence_inst_ptr increment_index_data_item 000340 temp_offset_inst increment_index_data_item 000341 temp_occurrence_inst increment_index_data_item fmt2_eos3 000100 ix fmt2_eos3 000101 iy fmt2_eos3 THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ent_var call_ext_out call_int_other_desc call_int_other return_mac mdfx1 ext_entry int_entry int_entry_desc trunc_fx2 divide_fx1 THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cobol_add_gen cobol_addr cobol_alloc$stack cobol_compare_gen cobol_define_tag cobol_emit cobol_make_tagref cobol_make_type9$copy cobol_process_error cobol_read_rand cobol_register$load cobol_set_gen THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cobol_$next_tag cobol_$text_wd_off LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 39 000014 91 000025 93 000031 95 000041 96 000042 1472 000045 219 000046 224 000047 251 000100 617 000115 254 000116 260 000124 265 000126 269 000130 273 000133 274 000136 276 000141 280 000144 282 000146 284 000156 285 000161 287 000164 288 000200 289 000221 290 000225 291 000226 292 000230 303 000272 307 000313 310 000333 315 000342 318 000347 319 000357 320 000361 321 000366 323 000370 328 000371 331 000401 333 000406 342 000417 347 000424 348 000426 351 000430 357 000431 361 000435 366 000436 372 000437 373 000443 401 000444 402 000446 404 000451 405 000454 409 000460 412 000464 417 000470 418 000472 419 000475 421 000502 422 000506 423 000511 425 000515 426 000521 428 000523 430 000524 434 000533 441 000547 444 000552 446 000560 447 000564 448 000567 450 000573 451 000577 460 000601 464 000604 470 000620 473 000630 479 000644 480 000647 481 000651 482 000656 483 000662 484 000666 486 000671 492 000701 499 000710 503 000737 505 000742 506 000747 507 000752 508 000757 509 000761 512 000763 514 000767 515 000773 516 000775 517 001003 518 001024 520 001052 522 001072 523 001101 524 001110 525 001112 528 001120 535 001127 539 001141 543 001150 546 001151 550 001157 555 001173 556 001213 561 001233 565 001245 567 001250 576 001251 581 001262 583 001263 590 001271 591 001311 593 001332 595 001342 597 001343 601 001351 603 001355 608 001356 612 001364 614 001375 615 001376 625 001377 736 001401 737 001404 738 001406 748 001410 751 001427 754 001432 757 001434 760 001437 761 001441 764 001453 765 001456 766 001460 770 001462 771 001465 772 001470 773 001471 774 001475 775 001477 777 001500 778 001502 779 001505 782 001521 785 001534 788 001541 793 001556 794 001561 795 001563 797 001565 798 001570 799 001572 802 001574 803 001576 806 001611 807 001615 810 001630 811 001634 815 001647 816 001652 817 001653 820 001654 823 001665 826 001671 841 001710 844 001731 845 001734 847 001735 851 001754 854 001775 857 002004 860 002010 863 002027 864 002033 877 002052 880 002073 881 002077 890 002116 891 002122 894 002141 895 002145 897 002164 905 002165 1018 002167 1019 002171 1020 002174 1022 002176 1023 002201 1024 002203 1027 002205 1028 002211 1031 002230 1032 002233 1033 002234 1035 002235 1038 002246 1039 002252 1042 002271 1043 002275 1050 002314 1054 002333 1057 002336 1060 002340 1061 002342 1063 002344 1064 002347 1065 002351 1067 002353 1068 002355 1070 002370 1071 002374 1074 002407 1075 002413 1089 002432 1093 002453 1094 002457 1097 002476 1098 002502 1109 002521 1113 002542 1114 002546 1124 002565 1125 002567 1128 002601 1129 002604 1130 002606 1133 002610 1134 002613 1135 002616 1137 002617 1138 002620 1139 002622 1141 002623 1142 002627 1143 002632 1145 002633 1148 002646 1152 002653 1154 002670 1156 002671 1163 002672 1171 002715 1387 002732 1174 002733 1180 002741 1184 002743 1189 002745 1191 002750 1195 002753 1197 002755 1198 002763 1200 002766 1201 003002 1202 003023 1203 003027 1204 003030 1210 003032 1211 003037 1213 003042 1215 003047 1216 003054 1217 003060 1218 003063 1219 003065 1222 003067 1227 003075 1231 003103 1234 003110 1235 003115 1236 003121 1241 003124 1243 003126 1244 003130 1246 003131 1251 003137 1252 003141 1253 003142 1256 003144 1258 003145 1261 003147 1263 003153 1264 003156 1266 003205 1267 003210 1268 003212 1269 003222 1274 003225 1277 003245 1280 003265 1282 003274 1284 003325 1286 003330 1288 003335 1289 003344 1291 003353 1295 003363 1297 003373 1298 003400 1300 003404 1301 003410 1303 003412 1307 003420 1311 003427 1314 003450 1317 003470 1320 003477 1322 003500 1325 003507 1328 003510 1332 003516 1338 003541 1341 003561 1345 003601 1349 003610 1352 003611 1357 003617 1358 003624 1359 003626 1360 003630 1361 003632 1363 003634 1364 003636 1368 003637 1371 003650 1376 003660 1378 003665 1381 003674 1382 003676 1384 003701 1386 003702 1389 003703 1403 003717 1405 003722 1406 003724 1407 003730 1411 003731 1412 003732 1414 003733 1415 003736 1416 003737 1417 003742 1418 003750 1419 003756 1420 003757 1421 003767 1425 003771 ----------------------------------------------------------- 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