COMPILATION LISTING OF SEGMENT cobol_control_ 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 1027.1 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,MCR8090), 17* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 18* MCR8090 cobol_control_.pl1 Disallow duplicate prime keys in Indexed 19* Sequential files. 20* END HISTORY COMMENTS */ 21 22 23 /* Modified on 12/19/84 by FCH, [5.3-1], BUG573(phx16343), cobol_fsb_type_1.incl.pl1 now used */ 24 /* Modified on 11/30/82 by FCH, [5.2-1], delete handlers for error and command_abort_, BUG545(phx14322) */ 25 /* Modified on 09/08/81 by FCH, [5.0-1], rc fails if abs path name used, BUG499(phx11416) */ 26 /* Modified on 06/09/81 by FCH, [4.4-2], cu_$cp used instead of cu_$ptr_call, BUG468 */ 27 /* Modified on 10/24/80 by PRP, [4.4-1], bug451 phx07665 fix close with lock on internal files*/ 28 /* Modified on 07/17/79 by PRP, [4.0-2], -db option added to rc, it sets sw 8*/ 29 /* Modified on 06/14/79 by PRP, [4.0-2], output of detach messages eliminated except when scr is used */ 30 /* Modified on 05/24/79 by FCH, [4.0-1], cobol_control_seg_ replaced by temp seg */ 31 /* Modified on 01/22/79 by FCH, [3.0-1], on statements used */ 32 /* Modified since Version 3.0 */ 33 /* { */ 34 35 36 37 /* format: style3 */ 38 cobol_control_: 39 proc (pr4_save_ptr); 40 41 /* This is a run-time support routine which provides 42* for getting space for all cobol programs. It also maintains 43* a record of programs which are part of the current run-unit. */ 44 45 dcl control_1 fixed bin; /* 1 = called by cobol_rts_; 0 = called directly by cobol program */ 46 47 call cu_$stack_frame_ptr (stack_frame_ptr); 48 stack_frame_ptr = stack_frame.prev_stack_frame_ptr; 49 control_1 = 0; 50 call start; 51 return; 52 53 /* Entry for the new control to interface with cobol_rts_ package. */ 54 55 56 cobol_rts_control_: 57 entry (pr4_save_ptr); 58 59 call cu_$stack_frame_ptr (stack_frame_ptr); 60 stack_frame_ptr = stack_frame.prev_stack_frame_ptr; 61 control_1 = 1; 62 call start; 63 return; 64 65 dcl pr4_save_ptr ptr parameter; 66 dcl statptr ptr parameter; /* 67* statptr a pointer to the calling program's static 68* data area. See the include file stat.inc.pl1 69* } */ 70 71 declare (stop_run, command_abort_, error, finish) 72 condition; /* [3.0-1] */ 73 74 75 /*[4.0-1]*/ 76 dcl get_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)); 77 /*[4.0-1]*/ 78 dcl release_temp_segments_ 79 entry (char (*), (*) ptr, fixed bin (35)); 80 81 /*[4.0-1]*/ 82 dcl tp (1) ptr static int; 83 84 dcl 1 cond based (cond_ptr), 85 2 next_ptr ptr, 86 2 action_ptr ptr, 87 2 action_len fixed bin (21), 88 2 cont fixed bin, 89 2 name char (32), 90 2 action char (0 refer (cond.action_len)); 91 dcl mcode fixed bin (35); 92 dcl close_code fixed bin (35); 93 dcl stop_code fixed bin; 94 dcl (i, j, k, m, n) fixed bin; 95 dcl (jlen, klen) fixed bin; 96 dcl (nargs, bl_pos, dlr_pos) 97 fixed bin; 98 dcl len fixed bin; 99 dcl (arglen, arg1_len) fixed bin (21); 100 dcl rwds fixed bin; 101 dcl continue fixed bin; 102 dcl bc fixed bin (21); 103 104 dcl stop_run_command static bit (1); 105 dcl stop_run_sw bit (1) static init ("0"b); 106 dcl found bit (1); 107 dcl others_found bit (1); 108 109 dcl rseg char (rwds) based (rsegptr); 110 dcl nl char (1) static init (" 111 "); 112 dcl dir char (168); 113 dcl error_name char (3); 114 dcl name1 char (32); 115 dcl rname char (32); 116 dcl progname char (32); 117 dcl lineno char (20); 118 dcl cobol_data_area (stat.data_len + 1) fixed bin (35) based; 119 /* 08-26-77 */ 120 /* only need to run pre 3.0 cobol programs */ 121 dcl based_area area based; 122 dcl area_ptr ptr; 123 124 dcl evar entry auto; 125 dcl bptr ptr based (addr (evar)); 126 dcl arg char (arglen) based (argptr); 127 128 dcl cond_ptr ptr; 129 dcl (argptr, arg1_ptr) ptr; 130 dcl save_cond_ptr ptr; 131 dcl rsegptr ptr; 132 dcl segptr ptr; 133 dcl error_ptr ptr; 134 dcl iox_$user_output ptr ext; 135 dcl iox_$error_output ptr ext; 136 dcl iox_$user_input ptr ext; 137 138 dcl condition_ entry (char (*), entry); 139 dcl cobol_rts_handler_ entry (ptr, char (*), ptr, ptr, bit (1)); 140 /*[4.4-2]*/ 141 dcl add_epilogue_handler_ 142 entry (entry, fixed bin (35)); 143 dcl find_command_ entry (ptr, fixed bin (21), ptr, fixed bin (35)); 144 dcl cu_$cp entry (ptr, fixed bin (21), fixed bin (35)); 145 dcl cu_$arg_count entry (fixed bin); 146 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); 147 dcl expand_path_ entry (ptr, fixed bin (21), ptr, ptr, fixed bin (35)); 148 dcl hcs_$terminate_noname 149 entry (ptr, fixed bin (35)); 150 dcl hcs_$delentry_file entry (char (*), char (*), fixed bin (35)); 151 dcl get_pdir_ entry returns (char (168)); 152 dcl hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (21), fixed bin (2), ptr, fixed bin (35)); 153 dcl hcs_$fs_get_ref_name 154 entry (ptr, fixed bin, char (*), fixed bin (35)); 155 dcl hcs_$truncate_seg entry (ptr, fixed bin, fixed bin (35)); 156 dcl hcs_$terminate_seg entry (ptr, fixed bin, fixed bin (35)); 157 dcl hcs_$make_ptr entry (ptr, char (*), char (*), ptr, fixed bin (35)); 158 dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); 159 dcl cobol_mcs_$stop_run entry; 160 dcl com_err_ entry options (variable); 161 dcl cobol_error_ entry (fixed bin, fixed bin (35), fixed bin, fixed bin, char (65) varying, ptr); 162 dcl ioa_ entry options (variable); 163 dcl ioa_$rsnnl entry options (variable); 164 dcl cobol_file_control_ entry (char (*), ptr, fixed bin, char (*), bit (1) aligned, fixed bin (35)); 165 dcl signal_ entry (char (*), ptr, ptr); 166 dcl cu_$stack_frame_ptr entry (ptr); 167 168 dcl error_table_$seg_not_found 169 fixed bin (35) static ext; 170 dcl error_table_$noarg fixed bin (35) ext static; 171 dcl error_table_$badopt fixed bin (35) ext static; 172 173 174 /* prologue */ 175 176 start: 177 proc; 178 179 /*[3.0-1]*/ 180 if controlp = null 181 then call set_handlers (0); 182 183 /*[5.2-1]*/ 184 /* on command_abort_ call COND ("command_abort_"); */ 185 /*[5.2-1]*/ 186 /* on error call COND ("error"); */ 187 /*[4.0-1]*/ 188 on stop_run call COND ("stop_run"); /*[4.0-1]*/ 189 on finish call COND ("finish"); 190 191 if control_1 ^= 0 192 then do; 193 194 stat_ptr = addrel (pr4_save_ptr, 8); 195 stack_frame_ptr = stack_frame.prev_stack_frame_ptr; 196 end; 197 else stat_ptr = addrel (stack_frame.link_ptr, 8); /* initialize extended fixed_static area if new rts interface */ 198 if control_1 ^= 0 199 then do; 200 201 stat.user_output_ptr = iox_$user_output; 202 stat.error_output_ptr = iox_$error_output; 203 stat.user_input_ptr = iox_$user_input; 204 stat.error_con = ""; 205 end; 206 207 208 209 j = index (stat.prog_id, "$"); 210 211 if j > 0 212 then do; 213 214 stat.prog_id_len = stat.prog_id_len - j; 215 progname = substr (stat.prog_id, j + 1); 216 end; 217 else progname = substr (stat.prog_id, 1, stat.prog_id_len); 218 219 rname = ""; 220 221 do j = 1 to 1000 /* nominal */ while (rname = ""); 222 223 if control_1 ^= 0 224 then call hcs_$fs_get_ref_name (pointer (stack_frame.new_return_ptr, 0), j, rname, mcode); 225 else call hcs_$fs_get_ref_name (pointer (stack_frame.return_ptr, 0), j, rname, mcode); 226 227 if mcode ^= 0 228 then go to control_error; 229 230 end; 231 232 if rname ^= stat.prog_id 233 then do; 234 235 j = index (rname, " "); 236 if j = 0 237 then j = 33; 238 239 stat.prog_id = substr (rname, 1, j - 1) || "$" || progname; 240 stat.prog_id_len = stat.prog_id_len + j; 241 end; 242 243 if stat.entry_pt_ptr = control.main_prog_ptr 244 then do; 245 246 stat.main_prog_sw = 1; 247 control.mpname = substr (stat.prog_id, 1, stat.prog_id_len); 248 end; 249 else do; 250 251 stat.main_prog_sw = 0; 252 control.mpname = ""; 253 end; 254 255 if control.no_of_segs > 0 256 then do i = 1 to control.no_of_segs; 257 258 if control.statptr (i) = stat_ptr 259 then go to set_data_ptr; 260 261 if control.statptr (i) ^= null 262 then do; 263 264 j = index (control.statptr (i) -> stat.prog_id, "$"); 265 266 if j = 0 267 then j = control.statptr (i) -> stat.prog_id_len; 268 else j = j - 1; 269 270 k = index (stat.prog_id, "$"); 271 272 if k = 0 273 then k = stat.prog_id_len; 274 else k = k - 1; 275 276 if substr (control.statptr (i) -> stat.prog_id, 1, j) = substr (stat.prog_id, 1, k) 277 then control.statptr (i) = null (); 278 279 end; 280 end; 281 else control.name = stat.prog_id; /* set run-unit name */ 282 283 control.no_of_segs = control.no_of_segs + 1; 284 control.statptr (control.no_of_segs) = stat_ptr; 285 stat.control_ptr = controlp; 286 287 if sort_dir_len = 0 288 then do; 289 substr (sort_dir, 1, 168) = get_pdir_ (); 290 sort_dir_len = index (sort_dir, " ") - 1; 291 end; 292 293 set_data_ptr: 294 if stat.data_len > 0 295 then if stat.data_ptr = null () 296 then do; 297 area_ptr = ptr (addr (i), 0) -> stack_header.user_free_ptr; 298 allocate cobol_data_area set (stat.data_ptr) in (area_ptr -> based_area); 299 end; 300 301 end; 302 303 cobol_stop_run_: 304 entry (statptr, rdsw, rfsw, code); 305 306 307 /* This is the entry called by the standard default 308* condition handler for the "stop_run" condition and 309* by the cancel command when the "-all" option is 310* specified. It causes cancellation of every cobol program 311* in the current run-unit. */ 312 313 dcl rdsw fixed bin; /* retain data segments */ 314 dcl rfsw fixed bin; /* retain files */ 315 316 /* dcl statptr ptr parameter; 317* 318* statptr a pointer to the calling program's static 319* data area. See the include file 320* stat.incl.pl1 (input). 321* } */ 322 323 stop_run_command = "0"b; 324 call start_cobol_stop_run; 325 return; 326 327 328 cobol_stop_run_command_: 329 entry (statptr, rdsw, rfsw, code); 330 331 stop_run_command = "1"b; 332 call start_cobol_stop_run; 333 return; 334 335 /* [4.0-2] */ 336 /* this new entry point was added so that cobol_stop_run_ can tell 337* the difference between a call from command level and an 338* epilogue handler call. thus some messages are suppressed unless 339* there is a stop_cobol_run command. */ 340 341 342 start_cobol_stop_run: 343 proc; 344 345 if statptr ^= null () 346 then error_name = "ccp"; 347 else error_name = "scr"; 348 349 found = "0"b; 350 351 if controlp ^= null () 352 then do; 353 354 if sort_dir_len ^= 0 355 then call hcs_$delentry_file (substr (sort_dir, 1, sort_dir_len), "cobol_temp_merge_file_", mcode); 356 357 end; 358 359 if controlp ^= null () 360 then if control.no_of_segs > 0 361 then do i = 1 to control.no_of_segs; 362 363 stat_ptr = control.statptr (i); 364 365 if stat_ptr ^= null () 366 then do; 367 368 stat.call_cnt = -1; /* reset initialization switch */ 369 370 if rfsw = 0 371 then if stat.file_info_ptr ^= null () 372 then do; 373 374 call cobol_file_control_ ("-a", stat_ptr, 0, error_name, "1"b, 375 close_code); 376 stat.file_info_ptr = null (); 377 378 end; 379 380 if rdsw = 0 381 then if stat.data_ptr ^= null () 382 then do; 383 if stat.data_len > 0 384 then free stat.data_ptr -> cobol_data_area; 385 stat.data_ptr = null (); 386 end; 387 388 found = "1"b; 389 390 end; 391 end; 392 393 stop_run_command = "0"b; 394 395 /* purge all communication partial files. */ 396 397 /*[4.4-2]*/ 398 /* call cobol_mcs_$stop_run; */ 399 400 if ^found 401 then code = -1; 402 else do; 403 404 405 406 code = 0; 407 408 if statptr ^= null () 409 then do; 410 411 stat_ptr = statptr; 412 413 if stat.line_no (1) = 0 414 then lineno = ""; 415 else if stat.line_no (2) = 0 416 then call ioa_$rsnnl (" (line ^d)", lineno, len, stat.line_no (1)); 417 else call ioa_$rsnnl (" (line ^d-^d)", lineno, len, stat.line_no (1), stat.line_no (2)); 418 419 call ioa_ ("^a: Run-unit ^a terminated^a.", statptr -> stat.prog_id, control.name, lineno); 420 end; 421 422 call hcs_$truncate_seg (controlp, 0, mcode); 423 if mcode ^= 0 424 then go to multics_error; 425 426 /* call hcs_$terminate_seg (controlp, 0, mcode);*/ 427 /*[4.4-2]*/ 428 call release_temp_segments_ ("cobol_control_", tp, mcode); 429 if mcode ^= 0 430 then go to multics_error; 431 432 controlp = null (); 433 434 call signal_ ("command_abort_", null (), null ()); 435 436 end; 437 438 end; 439 440 441 /* *********************************** */ 442 443 cobol_cancel_: 444 entry (name); 445 446 dcl cancel_code fixed bin; /* always ignored */ 447 dcl cobol_control_$cancel 448 entry (char (*), fixed bin, fixed bin, fixed bin); 449 450 cancel_code = 0; 451 call cobol_control_$cancel (name, 0, 0, cancel_code); 452 return; 453 454 cancel: 455 entry (name, rdsw, rfsw, code); 456 457 /* This entry is called by the cancel command and by 458* object programs compiled by cobol to cancel a program 459* in the run-unit by name. If the named program is not 460* currently active in the run-unit then an error code is 461* returned. This condition is an error for the cancel command, 462* but is ignored by the code generated for the cancel verb. */ 463 464 dcl name char (*) parameter; /* dcl rfsw fixed bin; /* retain files */ 465 /* dcl rdsw fixed bin; /* retain data segment */ 466 dcl code fixed bin; 467 468 /* 469* name a character string up to 65 chars long 470* identifying the program to be cancelled. 471* This corresponds to the name recorded in 472* stat.prog_id i.e. if the Identification 473* Division prog-id = the segment name, then 474* stat.prog_id = segment name; otherwise, it 475* is segment name$prog-id (input). 476* 477* code set to 0 if program successfully cancelled; 478* otherwise set to 1 (output). 479* } */ 480 481 i = index (name, "$"); 482 if i > 0 483 then rname = substr (name, 1, i - 1); 484 else rname = name; 485 486 call hcs_$make_ptr (null (), rname, substr (name, i + 1), segptr, mcode); 487 if mcode ^= 0 488 then go to return_multics_error; 489 490 found, others_found = "0"b; 491 if code = -3 492 then others_found = "1"b; /* special - don't ever stop run */ 493 code = -2; 494 495 if controlp ^= null () 496 then if control.no_of_segs > 0 497 then do i = 1 to control.no_of_segs; 498 499 stat_ptr = control.statptr (i); 500 501 if stat_ptr ^= null () 502 then do; 503 504 if stat.entry_pt_ptr = segptr & stat.call_cnt ^= -1 505 then do; 506 507 stat.call_cnt = -1; 508 /* reset initialization switch */ 509 510 if rfsw = 0 511 then if stat.file_info_ptr ^= null () 512 then do; 513 514 call cobol_file_control_ ("-a", stat_ptr, 0, "ccp", "1"b, 515 close_code); 516 stat.file_info_ptr = null (); 517 518 end; 519 520 if rdsw = 0 521 then if stat.data_ptr ^= null () 522 then do; 523 524 if stat.data_len > 0 525 then free stat.data_ptr 526 -> cobol_data_area in (area_ptr -> based_area); 527 528 stat.data_ptr = null (); 529 530 end; 531 532 control.statptr (i) = null (); 533 found = "1"b; 534 end; 535 536 else if stat.call_cnt ^= -1 537 then others_found = "1"b; 538 539 end; 540 end; 541 else return; 542 else return; 543 544 if ^found 545 then code = -1; 546 else do; 547 548 code = 0; 549 550 if ^others_found 551 then do; 552 553 call com_err_ (0, "cancel_cobol_program", 554 "^a was the only active cobol program of the run-unit.^/Run-unit ^a terminated.", name, 555 control.name); 556 557 call hcs_$truncate_seg (controlp, 0, mcode); 558 if mcode ^= 0 559 then go to multics_error; 560 561 /* call hcs_$terminate_seg (controlp, 0, mcode);*/ 562 /*[4.4-2]*/ 563 call release_temp_segments_ ("cobol_control_", tp, mcode); 564 if mcode ^= 0 565 then go to multics_error; 566 567 controlp = null (); 568 569 call signal_ ("command_abort_", null (), null ()); 570 571 end; 572 end; 573 574 return; 575 576 577 /* *********************************** */ 578 579 cobol_stoprun_: 580 entry; 581 582 call cu_$stack_frame_ptr (stack_frame_ptr); 583 584 stack_frame_ptr = stack_frame.prev_stack_frame_ptr; 585 stat_ptr = addrel (stack_frame.link_ptr, 8); 586 587 if controlp ^= null () 588 then if control.main_prog_sw ^= 0 589 then call signal_ ("stop_run", null (), stat_ptr); 590 591 stop_code = 0; 592 593 call cobol_stop_run_ (stat_ptr, 0, 0, stop_code); 594 595 call signal_ ("command_abort_", null (), null ()); 596 597 return; 598 599 600 /* *********************************** */ 601 602 cobol_finish_: 603 entry; 604 605 if controlp ^= null () 606 then call hcs_$delentry_file (substr (sort_dir, 1, sort_dir_len), "cobol_temp_merge_file_", mcode); 607 608 if controlp ^= null () 609 then if control.no_of_segs > 0 610 then do i = 1 to control.no_of_segs; 611 612 stat_ptr = control.statptr (i); 613 614 if stat_ptr ^= null () 615 then if stat.file_info_ptr ^= null () 616 then call cobol_file_control_ ("-a", stat_ptr, 0, "", "1"b, close_code); 617 618 end; 619 620 return; 621 622 623 /* *********************************** */ 624 625 626 get_pointer: 627 entry returns (pointer); 628 629 return (controlp); 630 631 632 /* ************************************ */ 633 634 635 rc: 636 run_cobol: 637 entry; 638 639 if controlp ^= null () 640 then go to recursion_error; 641 642 call cu_$arg_count (nargs); 643 if nargs < 1 644 then go to missing_arg_error; 645 646 call cu_$arg_ptr (1, argptr, arglen, mcode); 647 if mcode ^= 0 648 then go to rc_multics_error; 649 650 /*[4.4-2]*/ 651 arg1_ptr = argptr; 652 arg1_len = arglen; 653 654 /*[5.0-1]*/ 655 call find_command_ (argptr, arglen, segptr, mcode); 656 657 /*[4.4-2]*/ 658 if mcode = error_table_$seg_not_found /*[4.4-2]*/ 659 then do; 660 call com_err_ (0, "run_cobol", "Segment ^a not found", arg); 661 return; 662 end; 663 664 /* [3.0-1] */ 665 call set_handlers (1); 666 667 sort_dir_len = 0; 668 669 if nargs > 1 670 then do i = 2 to nargs; 671 672 call cu_$arg_ptr (i, argptr, arglen, mcode); 673 if mcode ^= 0 674 then go to rc_multics_error; 675 676 if arg = "-cs" | arg = "-cobol_switch" 677 then do; 678 679 switch_loop: 680 i = i + 1; 681 682 if i <= nargs 683 then do; 684 685 call cu_$arg_ptr (i, argptr, arglen, mcode); 686 if mcode ^= 0 687 then go to rc_multics_error; 688 689 if substr (arg, 1, 1) = "-" 690 then i = i - 1; 691 else do; 692 693 if arglen > 1 | arg < "1" | arg > "8" 694 then go to bad_arg_error; 695 696 control.sense_sw (fixed (arg, 17)) = 1; 697 698 go to switch_loop; 699 700 end; 701 end; 702 end; 703 else if arg = "-sd" | arg = "-sort_dir" 704 then do; 705 706 i = i + 1; 707 708 if i <= nargs 709 then do; 710 711 call cu_$arg_ptr (i, argptr, arglen, mcode); 712 if mcode ^= 0 713 then go to rc_multics_error; 714 715 if substr (arg, 1, 1) = "-" 716 then i = i - 1; 717 else do; 718 719 call expand_path_ (argptr, arglen, addr (sort_dir), null (), mcode); 720 sort_dir_len = index (sort_dir, " ") - 1; 721 end; 722 end; 723 end; 724 else if arg = "-sfs" | arg = "-sort_file_size" 725 then do; 726 727 i = i + 1; 728 729 if i <= nargs 730 then do; 731 call cu_$arg_ptr (i, argptr, arglen, mcode); 732 if mcode ^= 0 733 then go to rc_multics_error; 734 735 if substr (arg, 1, 1) = "-" 736 then i = i - 1; 737 else sort_file_size = float (arg, 27); 738 739 end; 740 end; 741 else if arg = "-ctu" | arg = "-continue" 742 then control.ind_mask = "000000001"b; 743 else if arg = "-nsr" | arg = "-no_stop_run" 744 then stop_run_sw = "1"b; 745 else if arg = "-db" | arg = "-debug" 746 then control.sense_sw (8) = 1; 747 else go to bad_arg_error; 748 749 end; 750 751 control.main_prog_ptr = segptr; 752 control.main_prog_sw = 1; 753 754 if ^stop_run_sw 755 then on stop_run call COND ("stop_run"); /* [3.0-1] */ 756 757 /*[4.4-2]*/ 758 call cu_$cp (arg1_ptr, arg1_len, mcode); /*[4.4-2]*/ 759 if mcode ^= 0 760 then go to invalid_exit_error; /*[4.4-2]*/ 761 return; 762 763 764 bad_arg_error: 765 call com_err_ (error_table_$badopt, "run_cobol", arg); 766 go to rc_error; 767 768 recursion_error: 769 call com_err_ (0, "run_cobol", 770 "A cobol run-unit already exists; stop_cobol_run must be issued before another can be created."); 771 return; 772 773 missing_arg_error: 774 call com_err_ (error_table_$noarg, "run_cobol"); 775 go to rc_error; 776 777 invalid_exit_error: 778 call com_err_ (0, "Error", "An invalid EXIT PROGRAM has been executed."); 779 return; 780 781 rc_multics_error: 782 call com_err_ (mcode, "run_cobol"); 783 784 rc_error: 785 controlp = null (); 786 return; 787 788 789 790 COND: 791 proc (cond_name); /*[3.0-1]*/ 792 793 declare find_condition_info_ 794 entry (ptr, ptr, fixed bin (35)); 795 /*[3.0-1]*/ 796 declare code fixed bin (35), 797 cond_name char (*); /*[3.0-1]*/ 798 799 800 call find_condition_info_ (null (), addr (cond_info), code); 801 /*[3.0-1]*/ 802 call cobol_hand (cond_name, cond_info.infoptr); /*[3.0-1]*/ 803 /* 804* call release_temp_segments_ ("cobol_control_", tp, mcode); 805**/ 806 end; /*[3.0-1]*/ 807 808 /* called if controlp = null, 0(prologue), 1(run_cobol) */ 809 810 set_handlers: 811 proc (mode); /*[3.0-1]*/ 812 813 /**/ 814 declare mode fixed bin; 815 816 /*[4.0-1]*/ 817 call get_temp_segments_ ("cobol_control_", tp, mcode); 818 /*[4.0-1]*/ 819 if mcode ^= 0 820 then go to control_error; 821 822 /*[4.0-1]*/ 823 controlp = tp (1); 824 825 /**/ 826 if mode ^= 0 /**/ 827 then do; 828 call hcs_$truncate_seg (controlp, 0, mcode); 829 /**/ 830 if mcode ^= 0 831 then go to rc_multics_error; /**/ 832 end; 833 834 /**/ 835 evar = cobol_control_; 836 837 /**/ 838 call hcs_$make_ptr (bptr, /**/ 839 "cobol_rts_handler_", /**/ 840 "cobol_rts_handler_", /**/ 841 control.fofl_handler_ptr, /**/ 842 mcode); 843 844 /**/ 845 if mcode ^= 0 846 then go to control_error; 847 848 /*[4.4-2]*/ 849 call add_epilogue_handler_ (cobol_finish_, mcode);/**/ 850 if mcode ^= 0 851 then go to control_error; 852 853 end; 854 855 /* [3.0-1] */ 856 857 858 859 /* *********************************** */ 860 861 cobol_handler_: 862 entry; /* This entry can be deleted but bound_cobol_rts_.bind must be altered */ 863 864 return; 865 866 cobol_hand: 867 proc (cond_name, infoptr); /* [3.0-1] */ 868 ; 869 870 dcl cond_name char (*); 871 dcl infoptr ptr; 872 873 if ^stop_run_sw 874 then if cond_name = "stop_run" 875 then do; 876 877 stop_code = 0; 878 call cobol_stop_run_ (infoptr, 0, 0, stop_code); 879 880 call com_err_ (0, "Error", "No cobol run-unit exists - cannot STOP RUN."); 881 call signal_ ("command_abort_", null (), null ()); 882 883 884 end; 885 886 call com_err_ (0, "Error", "^a condition raised - internal inconsistency in the run-unit.", cond_name); 887 888 end; 889 890 891 /* *********************************** */ 892 /* *********************************** */ 893 894 cobol_file_control_: 895 entry (ioname, statp, type, errorname, dtsw, cfc_code); 896 897 dcl ioname char (*); 898 dcl statp ptr; 899 dcl type fixed bin; /* -1=nomes,0=norm,1=long: close; 2=norm,3=long: list */ 900 dcl errorname char (*); 901 dcl dtsw bit (1) aligned; 902 dcl cfc_code fixed bin (35); 903 904 begin; 905 dcl statptr ptr; 906 statptr = statp; 907 908 dcl 1 opened_files static, 909 2 n fixed bin init (0), 910 2 pt (20) ptr; 911 912 dcl 1 dup, 913 2 n fixed bin, 914 2 pt (100) ptr; 915 916 dcl mcode fixed bin (35); 917 dcl save_mode fixed bin; 918 dcl i fixed bin; 919 dcl j fixed bin; 920 dcl k fixed bin; 921 dcl m fixed bin; 922 dcl org fixed bin; 923 dcl acc fixed bin; 924 dcl mode fixed bin; 925 926 dcl odptr ptr; 927 dcl adptr ptr; 928 929 dcl anysw bit (1); 930 dcl nodupsw bit (1); 931 dcl command_sw bit (1); 932 933 dcl vstring char (240) varying based; 934 dcl save_od char (240) varying; 935 dcl save_ad char (240) varying; 936 dcl save_ocname char (65); 937 dcl pname char (65); 938 dcl file_name char (32); 939 dcl eicon char (8); 940 dcl pcon char (69); 941 dcl action_con char (20); 942 dcl oiscon char (3); 943 dcl aiscon char (3); 944 dcl mode_con (0:3) char (6) static init ("extend", "input", "i-o", "output"); 945 dcl org_con (0:3) char (10) static init ("stream", "sequential", "relative", "indexed"); 946 dcl acc_con (3) char (10) static init ("sequential", "random", "dynamic"); 947 948 dcl iox_$close entry (ptr, fixed bin (35)); 949 dcl iox_$detach_iocb entry (ptr, fixed bin (35)); /* dcl ioa_ entry options(variable); */ 950 /* dcl com_err_ entry options(variable); */ 951 952 953 cfc_code = -2; 954 955 if controlp = null () 956 then return; 957 if control.no_of_segs < 1 958 then return; 959 960 cfc_code = -1; /* until something is done */ 961 nodupsw = "0"b; 962 dup.n = 0; 963 964 if substr (ioname, 1, 1) = "-" 965 then anysw = "1"b; 966 else anysw = "0"b; 967 968 if statptr ^= null () 969 then do; 970 971 stat_ptr = statptr; 972 if stat.file_info_ptr = null () 973 then return; 974 975 pname = stat.prog_id; 976 file_info_ptr = stat.file_info_ptr; 977 978 call look; 979 end; 980 else do; 981 982 if anysw 983 then do; 984 985 nodupsw = "1"b; 986 987 do i = 1 to control.no_of_segs; 988 989 stat_ptr = control.statptr (i); 990 991 if stat_ptr ^= null () 992 then do; 993 994 if stat.file_info_ptr ^= null () 995 then do; 996 997 pname = stat.prog_id; 998 file_info_ptr = stat.file_info_ptr; 999 call look; 1000 end; 1001 end; 1002 end; 1003 1004 end; 1005 else do; 1006 call hcs_$make_ptr (null (), "cobol_fsb_", ioname, fsb_ptr, mcode); 1007 if fsb_ptr = null () 1008 then return; 1009 call action; 1010 end; 1011 1012 end; 1013 1014 return; 1015 1016 1017 1018 1019 /* *********************************** */ 1020 /* SUBROUTINES */ 1021 /* *********************************** */ 1022 1023 /* *********************************** */ 1024 1025 look: 1026 proc; 1027 1028 do k = 1 to divide (file_info.n, 2, 17, 0); 1029 1030 if file_info.pt (k) ^= null () 1031 then do; 1032 fsb_ptr = file_info.pt (k); 1033 dtsw = ^fsb.attach_flag; 1034 1035 /*[5.3-1]*/ 1036 if fsb.fsb_skel.mod1 1037 then fsb.last_key_read = ""; 1038 1039 if anysw 1040 then if ioname = "-a" | ioname = "-i" & fsb.internal | ioname = "-e" & ^fsb.internal 1041 then call action; 1042 else ; 1043 else do; 1044 1045 if ioname = fsb.iocb_ptr -> iocb.name 1046 then call action; 1047 1048 if fsb.internal 1049 then do; 1050 j = index (fsb.iocb_ptr -> iocb.name, " ") - 17; 1051 if j < 0 1052 then j = 16; 1053 if ioname = substr (fsb.iocb_ptr -> iocb.name, 1, j) 1054 then call action; 1055 end; 1056 1057 end; 1058 end; 1059 end; 1060 1061 end; 1062 1063 1064 /* *********************************** */ 1065 1066 action: 1067 proc; 1068 1069 save_ocname = fsb.open_close_name; 1070 save_mode = fsb.open_mode; 1071 1072 if nodupsw & pname ^= save_ocname 1073 then do; 1074 1075 if substr (save_ocname, 1, 3) = "***" | save_ocname = "" 1076 then do; /* by command or non-cobol prog */ 1077 1078 if dup.n > 0 1079 then do m = 1 to dup.n; 1080 1081 if dup.pt (m) = fsb_ptr 1082 then return; 1083 end; 1084 1085 if dup.n < 100 1086 then dup.n = dup.n + 1; /* don't be ridiculous */ 1087 1088 dup.pt (dup.n) = fsb_ptr; 1089 command_sw = "1"b; 1090 1091 end; 1092 else return; 1093 1094 end; 1095 else command_sw = "0"b; 1096 1097 if fsb.iocb_ptr ^= null () 1098 then do; 1099 if errorname = "scr" 1100 then if fsb.internal 1101 then fsb.lock = "0"b; 1102 1103 odptr = fsb.iocb_ptr -> iocb.open_descrip_ptr; 1104 adptr = fsb.iocb_ptr -> iocb.attach_descrip_ptr; 1105 1106 if odptr ^= null () 1107 then save_od = odptr -> vstring; 1108 1109 if adptr ^= null () 1110 then save_ad = adptr -> vstring; 1111 end; 1112 else return; 1113 1114 if type > 1 1115 then cfc_code = 0; /* list only */ 1116 else if pname = save_ocname | ^anysw | command_sw 1117 then do; 1118 1119 if save_mode > 0 1120 then cfc_code = 0; 1121 1122 if save_mode < 0 1123 then do; 1124 1125 if ^anysw 1126 then do; 1127 1128 call com_err_ (0, "close_cobol_file", 1129 "Not closing external file ^a (it was opened by a non-cobol program).", 1130 fsb.iocb_ptr -> iocb.name); 1131 cfc_code = 0; 1132 1133 end; 1134 1135 return; 1136 1137 end; 1138 1139 if save_mode ^= 0 1140 then do; 1141 1142 call iox_$close (fsb.iocb_ptr, mcode); 1143 if mcode ^= 0 1144 then go to merror; 1145 1146 cfc_code = 0; 1147 fsb.open_mode = 0; 1148 j = index (errorname, " ") - 1; 1149 1150 if j < 0 1151 then j = length (errorname); 1152 1153 fsb.open_close_name = "***" || substr (errorname, 1, j) || "***"; 1154 end; 1155 1156 if dtsw 1157 then do; 1158 1159 call iox_$detach_iocb (fsb.iocb_ptr, mcode); 1160 1161 if mcode ^= 0 1162 then do; 1163 1164 if save_mode ^= 0 1165 then go to merror; 1166 else return; 1167 end; 1168 else cfc_code = 0; 1169 1170 end; 1171 else if save_mode = 0 1172 then return; 1173 1174 end; 1175 else return; 1176 1177 if type < 0 1178 then return; /* no message */ 1179 1180 if fsb.internal 1181 then do; 1182 1183 j = index (fsb.iocb_ptr -> iocb.name, " ") - 17; 1184 1185 if j < 0 1186 then j = 16; 1187 1188 file_name = substr (fsb.iocb_ptr -> iocb.name, 1, j); 1189 eicon = "Internal"; 1190 pcon = " in " || substr (stat.prog_id, 1, stat.prog_id_len); 1191 end; 1192 else do; 1193 file_name = fsb.iocb_ptr -> iocb.name; 1194 eicon = "External"; 1195 pcon = ""; 1196 end; 1197 1198 if type < 2 1199 then do; 1200 1201 if dtsw 1202 then do; 1203 if save_mode = 0 1204 then action_con = " detached"; 1205 else action_con = " closed and detached"; 1206 end; 1207 else action_con = " closed"; 1208 1209 pcon = ""; 1210 end; 1211 else action_con = ""; 1212 1213 if stop_run_command 1214 then call ioa_ ("^a file ^a^a^a", eicon, file_name, action_con, pcon); 1215 else ; 1216 1217 if save_mode = 0 1218 then if stop_run_command 1219 then call ioa_ (" closed by ^a", save_ocname); 1220 else ; 1221 else do; 1222 1223 if save_mode < 0 1224 then if stop_run_command 1225 then call ioa_ (" opened by a non-cobol program"); 1226 else ; 1227 else do; 1228 1229 org = fixed (substr (unspec (save_mode), 33, 2), 2); 1230 acc = fixed (substr (unspec (save_mode), 35, 2), 2); 1231 mode = fixed (substr (unspec (save_mode), 31, 2), 2); 1232 1233 /* [4.0-2] */ 1234 if stop_run_command 1235 then call ioa_ (" opened by ^a for ^a with ^a organization and ^a access", save_ocname, 1236 mode_con (mode), org_con (org), acc_con (acc)); 1237 1238 end; 1239 1240 end; 1241 1242 if type = 0 | type = 2 1243 then return; /* normal message */ 1244 1245 if stop_run_command 1246 then call ioa_ (" file state block at ^p^/ io_control_block for io_switch ^a at ^p", fsb_ptr, 1247 fsb.iocb_ptr -> iocb.name, fsb.iocb_ptr); 1248 1249 if type = 3 1250 then oiscon, aiscon = "is"; 1251 else do; 1252 oiscon = "was"; 1253 1254 if dtsw 1255 then aiscon = "was"; 1256 else aiscon = "is"; 1257 1258 end; 1259 1260 if stop_run_command 1261 then do; 1262 if odptr ^= null () 1263 then call ioa_ (" open description ^a: ""^a""", oiscon, save_od); 1264 1265 if adptr ^= null () 1266 then call ioa_ (" attach description ^a: ""^a""", aiscon, save_ad); 1267 1268 call ioa_ (""); 1269 1270 end; 1271 else ; 1272 return; 1273 merror: 1274 call com_err_ (mcode, errorname); 1275 return; 1276 end; 1277 1278 1279 /* *********************************** */ 1280 1281 end; /* *********************************** */ 1282 /* *********************************** */ 1283 control_error: 1284 call cu_$stack_frame_ptr (stack_frame_ptr); 1285 stack_frame_ptr = stack_frame.prev_stack_frame_ptr; 1286 error_ptr = addrel (stack_frame.return_ptr, -1); 1287 call cobol_error_ (0, mcode, 0, 0, "cobol_control_", error_ptr); 1288 return; 1289 1290 multics_error: 1291 call com_err_ (mcode, "stop_run"); 1292 call signal_ ("command_abort_", null (), null ()); 1293 return; 1294 1295 return_multics_error: 1296 code = mcode; 1297 return; 1298 1299 1300 /* *********************************** */ 1301 1302 /* **** Declaration for builtin function **** */ 1303 1304 dcl (substr, mod, binary, fixed, addr, addrel, rel, length, string, unspec, null, index, float) 1305 builtin; 1306 1307 /* **** End of declaration for builtin function **** */ 1308 1 1 1 2 /* BEGIN INCLUDE FILE ... cobol_control.incl.pl1 */ 1 3 /* Last modified May 5, 1977 by BC */ 1 4 1 5 dcl controlp ptr static init(null()); 1 6 dcl 1 control based(controlp) aligned, 1 7 2 sense_sw (8) fixed bin, 1 8 2 next_data_ptr ptr, /* not currently used - each program has own data segment for now */ 1 9 2 name char(65) aligned, /* name of the run-unit */ 1 10 2 flags bit(27) unaligned, 1 11 2 ind_mask bit(9) unaligned, 1 12 2 mpname char(65) varying aligned, /* name of the main program of the run-unit */ 1 13 2 fofl_handler_ptr ptr, /* a ptr to the entry pt of the cobol fixedoverflow handler cobol_fofl_handler_ */ 1 14 2 main_prog_ptr ptr, /* a ptr to the entry point of the main program - valid only if main_prog_sw^=0 */ 1 15 2 main_prog_sw fixed bin aligned, 1 16 2 sort_file_size float bin(27), 1 17 2 sort_dir_len fixed bin, 1 18 2 sort_dir char(168), 1 19 2 no_of_segs fixed bin, 1 20 2 statptr (0 refer(control.no_of_segs)) ptr; 1 21 1 22 /* END INCLUDE FILE ... cobol_control.incl.pl1 */ 1 23 1309 2 1 2 2 /* BEGIN INCLUDE FILE ... cobol_fixed_static.incl.pl1 */ 2 3 /* Last Modified May 5, 1977 by BC */ 2 4 2 5 /* This structure exists in the static data portion of the 2 6*linkage section of each cobol object segment. This 2 7*include file provides a "based" template for it. */ 2 8 2 9 /* This include file also contains internal static initialized 2 10*variables that define the offset of each field in this static 2 11*data portion of the linkage section from the 2 12*pointer upon which it is based. */ 2 13 2 14 2 15 /* WARNING: The fields in this structure,data_ptr 2 16*up to, but not including reserved, 2 17*must retain their positions in this structure forever. 2 18*No new fields not having space already allocated may be 2 19*defined as the position of the first link which follows 2 20*this fixed static area (to cobol_rts_) is in a fixed location 2 21*known to cobol_operators_. */ 2 22 dcl stat_ptr ptr; 2 23 dcl 1 stat based(stat_ptr) aligned, 2 24 2 data_ptr ptr aligned, 2 25 2 control_ptr ptr aligned, 2 26 2 file_info_ptr ptr aligned, 2 27 2 call_cnt fixed bin aligned, 2 28 2 data_len fixed bin aligned, 2 29 2 entry_pt_ptr ptr aligned, 2 30 2 prog_id_len fixed bin aligned, 2 31 2 prog_id char(65) aligned, 2 32 2 line_no (2) fixed bin aligned, 2 33 2 fo_flag fixed bin aligned, 2 34 2 fo_disp fixed bin aligned, 2 35 2 main_prog_sw fixed bin aligned, 2 36 2 sort_merge_sw fixed bin aligned, 2 37 2 ind_mask bit(36), /* overflow masking indicator bits. */ 2 38 2 pr3_save ptr, 2 39 2 pr5_save ptr, 2 40 2 user_output_ptr ptr, 2 41 2 error_output_ptr ptr, 2 42 2 user_input_ptr ptr, 2 43 2 error_con char(30) varying, 2 44 2 trace_control_word fixed bin aligned; 2 45 2 46 2 47 /* INTERNAL STATIC INITIALIZED VARIABLES THAT DEFINE THE 2 48*OFFSET OF EACH FIELD IN THE STATIC PORTION OF THE LINKAGE 2 49*SEGMENT. */ 2 50 2 51 dcl fixed_static_length fixed bin static options(constant) init(56); 2 52 dcl first_link_offset fixed bin static options(constant) init(64); 2 53 /*dcl stat_data_ptr_off fixed bin static options(constant) init(0); 2 54*/*dcl stat_control_ptr_off fixed bin static options(constant) init(2); 2 55*/*dcl stat_file_info_ptr_off fixed bin static options(constant) init(4); 2 56*/*dcl stat_call_cnt_off fixed bin static options(constant) init(6); 2 57*/*dcl stat_data_len_off fixed bin static options(constant) init(7); 2 58*/*dcl stat_entry_pt_ptr_off fixed bin static options(constant) init(8); 2 59*/*dcl stat_prog_id_len_off fixed bin static options(constant) init(10); 2 60*/*dcl stat_prog_id_off fixed bin static options(constant) init(11); 2 61*/*dcl stat_line_no_off fixed bin static options(constant) init(28); 2 62*/*dcl stat_fo_flag_off fixed bin static options(constant) init(30); 2 63*/*dcl stat_fo_disp_off fixed bin static options(constant) init(31); 2 64*/*dcl stat_main_prog_sw_off fixed bin static options(constant) init(32); 2 65*/*dcl stat_pr3_ptr_off fixed bin static options(constant) init(34); 2 66*/*dcl stat_pr5_ptr_off fixed bin static options(constant) init(36); 2 67*/*dcl stat_user_output_ptr_off fixed bin static options(constant) init(38); 2 68*/*dcl stat_error_output_ptr_off fixed bin static options(constant) init(40); 2 69*/*dcl stat_user_input_ptr_off fixed bin static options(constant) init(42); 2 70*/*dcl stat_error_con_off fixed bin static options(constant) init(44); 2 71*/*dcl stat_trace_control_word_off fixed bin static options(constant) init(53); 2 72*/**/ 2 73 2 74 /* END INCLUDE FILE ... cobol_fixed_static.incl.pl1 */ 2 75 1310 3 1 3 2 /* BEGIN INCLUDE FILE ... cobol_stack_frame.incl.pl1 */ 3 3 /* Last modified on Apr 27, 1976 by BC */ 3 4 /* Last modified on Jan 1, 1975 by ORN */ 3 5 3 6 dcl stack_frame_ptr ptr; 3 7 dcl 1 stack_frame based(stack_frame_ptr) aligned, 3 8 2 pad1 (16) fixed bin, 3 9 2 prev_stack_frame_ptr ptr, 3 10 2 next_stack_frame_ptr ptr, 3 11 2 return_ptr ptr, 3 12 2 entry_ptr ptr, 3 13 2 operator_link_ptr ptr, 3 14 2 argument_ptr ptr, 3 15 2 reserved (2) fixed bin, 3 16 2 on_unit_rel_ptrs (2) bit(18) unaligned, 3 17 2 operator_return_offset bit(18), 3 18 2 pad2 (4) fixed bin, 3 19 2 link_ptr ptr, 3 20 2 pad3 (2) fixed bin, 3 21 2 scratch (24) fixed bin, 3 22 2 new_return_ptr ptr; 3 23 3 24 /* END INCLUDE FILE ... cobol_stack_frame.incl.pl1 */ 3 25 1311 4 1 /* BEGIN INCLUDE FILE ... cobol_fsb_type_1.incl.pl1 */ 4 2 4 3 4 4 /****^ HISTORY COMMENTS: 4 5* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8090), 4 6* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 4 7* MCR8090 cobol_fsb_type_1.incl.pl1 Disallow duplicate prime keys in Indexed 4 8* Sequential files. 4 9* END HISTORY COMMENTS */ 4 10 4 11 4 12 /* Modified on 12/14/84 by FCH, [5.3-1], BUG574, save last prime key read */ 4 13 /* Last Modified on Oct. 16, 1978 by FCH */ 4 14 4 15 4 16 dcl fsb_ptr ptr; 4 17 4 18 dcl 1 fsb based (fsb_ptr), 4 19 2 fsb_skel aligned like fsbskel, 4 20 2 key_of_ref fixed bin (35), 4 21 2 crp, 4 22 3 prime_key char (256) varying, 4 23 3 alt_key char (256) varying, 4 24 3 descriptor fixed bin (35), 4 25 2 last_key_read char (256) varying; /*[5.3-1]*/ 4 26 4 27 /* 4 28* 4 29*FIELD CONTENTS 4 30* 4 31*key_of_ref key of reference 4 32* 1 ,... ,510: alternate key 4 33* 511: prime key 4 34*crp current record pointer 4 35*prime_key value of prime key 4 36* "" designates end-of-file 4 37*alt_key value of key of reference 4 38*descriptor descriptor for key of reference 4 39*last_read_key value of the prime key in the last record read 4 40**/ 4 41 4 42 /* END INCLUDE FILE ... cobol_fsb_type_1.incl.pl1 */ 1312 5 1 5 2 /* BEGIN INCLUDE FILE ... cobol_fsbskel.incl.pl1 */ 5 3 5 4 5 5 /****^ HISTORY COMMENTS: 5 6* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8090), 5 7* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 5 8* MCR8090 cobol_fsbskel.incl.pl1 Disallow duplicate prime keys in Indexed 5 9* Sequential files. 5 10* END HISTORY COMMENTS */ 5 11 5 12 5 13 /* Modified on 12/19/84 by FCH */ 5 14 /* Last Modified on Oct. 16, 1978 by FCH */ 5 15 5 16 dcl 1 fsbskel aligned based, 5 17 2 iocb_ptr ptr, 5 18 2 open_mode fixed bin (35), 5 19 2 max_cra_size fixed bin (35), 5 20 2 relkeylen fixed bin (35), 5 21 2 relkey fixed bin (35), 5 22 2 keylen_sw fixed bin (35), 5 23 2 key char (256) aligned, 5 24 2 open_close_name char (65) unal, 5 25 2 attach_flag bit (1) unal, /* only cobol_control seems to use this item */ 5 26 2 linage_counter char (8) aligned, 5 27 2 indicators, 5 28 3 optional bit (2), 5 29 3 opened bit (1), /* initialized to "" by 5.3 and previous versions */ 5 30 3 internal bit (1) unal, /* initialized to "" by 5.3 and previous versions */ 5 31 3 lock bit (1) unal, 5 32 3 mod1 bit (1) unal, 5 33 2 vfile_open_mode fixed bin (35), 5 34 2 file_desc_ptr ptr, 5 35 2 cobol_open_mode fixed bin (35), 5 36 2 last_cobol_op fixed bin (35), 5 37 2 code fixed bin (35); 5 38 5 39 /* 5 40* 5 41*FIELD CONTENTS 5 42* 5 43*iocb_ptr pointer to iocb, set by open 5 44*opened file opened at least once 5 45*internal 0 if external, 1 if internal 5 46*lock 0 if no lock, 1 if lock, reset by start of new 5 47* run unit 5 48*mod1 set to "1"b if the fsb contains the key of the 5 49* last record read from the file, present in 5.3 5 50* and subsequent versions 5 51*file_desc_ptr pointer to the file description 5 52*vfile_open_mode open mode established by iox_$open 5 53* 1,2,3 stream_(i o i-o) 5 54* 4,5,6,7 seq_(i o i-o u) 5 55* 8,9,10 k_s_(i o u) 5 56* 11,12,13 d_(i o u) 5 57*cobol_open_mode open mode established by open statement 5 58* 21 i, seq 5 59* 53 o, seq 5 60* 37 i-o, seq 5 61* 5 e, seq 5 62* 5 63* 25,26,27 i, rel(seq,ran,dyn) 5 64* 57,58,59 o, rel(seq,ran,dyn) 5 65* 41,42,43 i-o,rel(seq,ran,dyn) 5 66* 5 67* 29,30,31 i, ind(seq,ran,dyn) 5 68* 61,62,63 o, ind(seq,ran,dyn) 5 69* 45,46,47 i-o, ind(seq,ran,dyn) 5 70*last_cobol_op COBOL I/O statement last executed 5 71* 1 open 5 read key 5 72* 2 close 6 rewrite 5 73* 3 start 7 delete 5 74* 4 read next 8 write 5 75*code last vfile_ error code 5 76**/ 5 77 5 78 /* END INCLUDE FILE ... cobol_fsbskel.incl.pl1 */ 5 79 1313 6 1 /* BEGIN INCLUDE FILE ..... iocb.incl.pl1 ..... 13 Feb 1975, M. Asherman */ 6 2 /* Modified 11/29/82 by S. Krupp to add new entries and to change 6 3* version number to IOX2. */ 6 4 /* format: style2 */ 6 5 6 6 dcl 1 iocb aligned based, /* I/O control block. */ 6 7 2 version character (4) aligned, /* IOX2 */ 6 8 2 name char (32), /* I/O name of this block. */ 6 9 2 actual_iocb_ptr ptr, /* IOCB ultimately SYNed to. */ 6 10 2 attach_descrip_ptr ptr, /* Ptr to printable attach description. */ 6 11 2 attach_data_ptr ptr, /* Ptr to attach data structure. */ 6 12 2 open_descrip_ptr ptr, /* Ptr to printable open description. */ 6 13 2 open_data_ptr ptr, /* Ptr to open data structure (old SDB). */ 6 14 2 reserved bit (72), /* Reserved for future use. */ 6 15 2 detach_iocb entry (ptr, fixed (35)),/* detach_iocb(p,s) */ 6 16 2 open entry (ptr, fixed, bit (1) aligned, fixed (35)), 6 17 /* open(p,mode,not_used,s) */ 6 18 2 close entry (ptr, fixed (35)),/* close(p,s) */ 6 19 2 get_line entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 6 20 /* get_line(p,bufptr,buflen,actlen,s) */ 6 21 2 get_chars entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 6 22 /* get_chars(p,bufptr,buflen,actlen,s) */ 6 23 2 put_chars entry (ptr, ptr, fixed (21), fixed (35)), 6 24 /* put_chars(p,bufptr,buflen,s) */ 6 25 2 modes entry (ptr, char (*), char (*), fixed (35)), 6 26 /* modes(p,newmode,oldmode,s) */ 6 27 2 position entry (ptr, fixed, fixed (21), fixed (35)), 6 28 /* position(p,u1,u2,s) */ 6 29 2 control entry (ptr, char (*), ptr, fixed (35)), 6 30 /* control(p,order,infptr,s) */ 6 31 2 read_record entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 6 32 /* read_record(p,bufptr,buflen,actlen,s) */ 6 33 2 write_record entry (ptr, ptr, fixed (21), fixed (35)), 6 34 /* write_record(p,bufptr,buflen,s) */ 6 35 2 rewrite_record entry (ptr, ptr, fixed (21), fixed (35)), 6 36 /* rewrite_record(p,bufptr,buflen,s) */ 6 37 2 delete_record entry (ptr, fixed (35)),/* delete_record(p,s) */ 6 38 2 seek_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 6 39 /* seek_key(p,key,len,s) */ 6 40 2 read_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 6 41 /* read_key(p,key,len,s) */ 6 42 2 read_length entry (ptr, fixed (21), fixed (35)), 6 43 /* read_length(p,len,s) */ 6 44 2 open_file entry (ptr, fixed bin, char (*), bit (1) aligned, fixed bin (35)), 6 45 /* open_file(p,mode,desc,not_used,s) */ 6 46 2 close_file entry (ptr, char (*), fixed bin (35)), 6 47 /* close_file(p,desc,s) */ 6 48 2 detach entry (ptr, char (*), fixed bin (35)); 6 49 /* detach(p,desc,s) */ 6 50 6 51 declare iox_$iocb_version_sentinel 6 52 character (4) aligned external static; 6 53 6 54 /* END INCLUDE FILE ..... iocb.incl.pl1 ..... */ 1314 7 1 /* BEGIN INCLUDE FILE ... stack_header.incl.pl1 .. 3/72 Bill Silver */ 7 2 /* modified 7/76 by M. Weaver for *system links and more system use of areas */ 7 3 /* modified 3/77 by M. Weaver to add rnt_ptr */ 7 4 /* Modified April 1983 by C. Hornig for tasking */ 7 5 7 6 /****^ HISTORY COMMENTS: 7 7* 1) change(86-06-24,DGHowe), approve(86-06-24,MCR7396), 7 8* audit(86-08-05,Schroth), install(86-11-03,MR12.0-1206): 7 9* added the heap_header_ptr definition. 7 10* 2) change(86-08-12,Kissel), approve(86-08-12,MCR7473), 7 11* audit(86-10-10,Fawcett), install(86-11-03,MR12.0-1206): 7 12* Modified to support control point management. These changes were actually 7 13* made in February 1985 by G. Palter. 7 14* 3) change(86-10-22,Fawcett), approve(86-10-22,MCR7473), 7 15* audit(86-10-22,Farley), install(86-11-03,MR12.0-1206): 7 16* Remove the old_lot pointer and replace it with cpm_data_ptr. Use the 18 7 17* bit pad after cur_lot_size for the cpm_enabled. This was done to save some 7 18* space int the stack header and change the cpd_ptr unal to cpm_data_ptr 7 19* (ITS pair). 7 20* END HISTORY COMMENTS */ 7 21 7 22 /* format: style2 */ 7 23 7 24 dcl sb ptr; /* the main pointer to the stack header */ 7 25 7 26 dcl 1 stack_header based (sb) aligned, 7 27 2 pad1 (4) fixed bin, /* (0) also used as arg list by outward_call_handler */ 7 28 2 cpm_data_ptr ptr, /* (4) pointer to control point which owns this stack */ 7 29 2 combined_stat_ptr ptr, /* (6) pointer to area containing separate static */ 7 30 2 clr_ptr ptr, /* (8) pointer to area containing linkage sections */ 7 31 2 max_lot_size fixed bin (17) unal, /* (10) DU number of words allowed in lot */ 7 32 2 main_proc_invoked fixed bin (11) unal, /* (10) DL nonzero if main procedure invoked in run unit */ 7 33 2 have_static_vlas bit (1) unal, /* (10) DL "1"b if (very) large arrays are being used in static */ 7 34 2 pad4 bit (2) unal, 7 35 2 run_unit_depth fixed bin (2) unal, /* (10) DL number of active run units stacked */ 7 36 2 cur_lot_size fixed bin (17) unal, /* (11) DU number of words (entries) in lot */ 7 37 2 cpm_enabled bit (18) unal, /* (11) DL non-zero if control point management is enabled */ 7 38 2 system_free_ptr ptr, /* (12) pointer to system storage area */ 7 39 2 user_free_ptr ptr, /* (14) pointer to user storage area */ 7 40 2 null_ptr ptr, /* (16) */ 7 41 2 stack_begin_ptr ptr, /* (18) pointer to first stack frame on the stack */ 7 42 2 stack_end_ptr ptr, /* (20) pointer to next useable stack frame */ 7 43 2 lot_ptr ptr, /* (22) pointer to the lot for the current ring */ 7 44 2 signal_ptr ptr, /* (24) pointer to signal procedure for current ring */ 7 45 2 bar_mode_sp ptr, /* (26) value of sp before entering bar mode */ 7 46 2 pl1_operators_ptr ptr, /* (28) pointer to pl1_operators_$operator_table */ 7 47 2 call_op_ptr ptr, /* (30) pointer to standard call operator */ 7 48 2 push_op_ptr ptr, /* (32) pointer to standard push operator */ 7 49 2 return_op_ptr ptr, /* (34) pointer to standard return operator */ 7 50 2 return_no_pop_op_ptr 7 51 ptr, /* (36) pointer to standard return / no pop operator */ 7 52 2 entry_op_ptr ptr, /* (38) pointer to standard entry operator */ 7 53 2 trans_op_tv_ptr ptr, /* (40) pointer to translator operator ptrs */ 7 54 2 isot_ptr ptr, /* (42) pointer to ISOT */ 7 55 2 sct_ptr ptr, /* (44) pointer to System Condition Table */ 7 56 2 unwinder_ptr ptr, /* (46) pointer to unwinder for current ring */ 7 57 2 sys_link_info_ptr ptr, /* (48) pointer to *system link name table */ 7 58 2 rnt_ptr ptr, /* (50) pointer to Reference Name Table */ 7 59 2 ect_ptr ptr, /* (52) pointer to event channel table */ 7 60 2 assign_linkage_ptr ptr, /* (54) pointer to storage for (obsolete) hcs_$assign_linkage */ 7 61 2 heap_header_ptr ptr, /* (56) pointer to the heap header for this ring */ 7 62 2 trace, 7 63 3 frames, 7 64 4 count fixed bin, /* (58) number of trace frames */ 7 65 4 top_ptr ptr unal, /* (59) pointer to last trace frame */ 7 66 3 in_trace bit (36) aligned, /* (60) trace antirecursion flag */ 7 67 2 pad2 bit (36), /* (61) */ 7 68 2 pad5 pointer; /* (62) pointer to future stuff */ 7 69 7 70 /* The following offset refers to a table within the pl1 operator table. */ 7 71 7 72 dcl tv_offset fixed bin init (361) internal static; 7 73 /* (551) octal */ 7 74 7 75 7 76 /* The following constants are offsets within this transfer vector table. */ 7 77 7 78 dcl ( 7 79 call_offset fixed bin init (271), 7 80 push_offset fixed bin init (272), 7 81 return_offset fixed bin init (273), 7 82 return_no_pop_offset fixed bin init (274), 7 83 entry_offset fixed bin init (275) 7 84 ) internal static; 7 85 7 86 7 87 7 88 7 89 7 90 /* The following declaration is an overlay of the whole stack header. Procedures which 7 91* move the whole stack header should use this overlay. 7 92**/ 7 93 7 94 dcl stack_header_overlay (size (stack_header)) fixed bin based (sb); 7 95 7 96 7 97 7 98 /* END INCLUDE FILE ... stack_header.incl.pl1 */ 1315 8 1 8 2 /* BEGIN INCLUDE FILE ... cobol_file_info.incl.pl1 */ 8 3 /* Last modified Oct 17, 1974 by ORN */ 8 4 8 5 dcl file_info_ptr ptr; 8 6 dcl 1 file_info based(file_info_ptr), 8 7 2 n fixed bin, 8 8 2 pt (1000) ptr; 8 9 8 10 /* END INCLUDE FILE ... cobol_file_info.incl.pl1 */ 8 11 1316 1317 1318 dcl 1 cond_info, /*[3.0-1]*/ 9 1 /* BEGIN INCLUDE FILE ... cond_info.incl.pl1 9 2* coded by M. Weaver 12 July 1973 */ 9 3 9 4 2 mcptr ptr, /* ptr to machine conditions at time of fault */ 9 5 2 version fixed bin, /* version of this structure (now=1) */ 9 6 2 condition_name char(32) var, /* name of condition */ 9 7 2 infoptr ptr, /* ptr to software info structure */ 9 8 2 wcptr ptr, /* ptr to wall crossing machine conditions */ 9 9 2 loc_ptr ptr, /* ptr to location where condition occurred */ 9 10 2 flags aligned, 9 11 3 crawlout bit(1) unal, /* = "1"b if condition occurred in inner ring */ 9 12 3 pad1 bit(35) unal, 9 13 2 pad_word bit(36) aligned, 9 14 2 user_loc_ptr ptr, /* ptr to last non-support loc before condition */ 9 15 2 pad (4) bit(36) aligned; 9 16 9 17 /* END INCLUDE FILE ... cond_info.incl.pl1 */ 1319 1320 1321 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0836.9 cobol_control_.pl1 >spec>install>MR12.3-1048>cobol_control_.pl1 1309 1 03/27/82 0439.3 cobol_control.incl.pl1 >ldd>include>cobol_control.incl.pl1 1310 2 10/10/83 1730.8 cobol_fixed_static.incl.pl1 >ldd>include>cobol_fixed_static.incl.pl1 1311 3 03/27/82 0439.8 cobol_stack_frame.incl.pl1 >ldd>include>cobol_stack_frame.incl.pl1 1312 4 05/24/89 0811.6 cobol_fsb_type_1.incl.pl1 >spec>install>MR12.3-1048>cobol_fsb_type_1.incl.pl1 1313 5 05/24/89 0811.6 cobol_fsbskel.incl.pl1 >spec>install>MR12.3-1048>cobol_fsbskel.incl.pl1 1314 6 05/20/83 1846.4 iocb.incl.pl1 >ldd>include>iocb.incl.pl1 1315 7 11/07/86 1550.3 stack_header.incl.pl1 >ldd>include>stack_header.incl.pl1 1316 8 03/27/82 0439.7 cobol_file_info.incl.pl1 >ldd>include>cobol_file_info.incl.pl1 1319 9 05/06/74 1741.0 cond_info.incl.pl1 >ldd>include>cond_info.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. acc 000573 automatic fixed bin(17,0) dcl 923 set ref 1230* 1234 acc_con 000036 internal static char(10) initial array packed unaligned dcl 946 set ref 1234* action_con 001076 automatic char(20) packed unaligned dcl 941 set ref 1203* 1205* 1207* 1211* 1213* add_epilogue_handler_ 000060 constant entry external dcl 141 ref 849 addr builtin function dcl 1304 ref 297 719 719 800 800 838 addrel builtin function dcl 1304 ref 194 197 585 1286 adptr 000600 automatic pointer dcl 927 set ref 1104* 1109 1109 1265 aiscon 001104 automatic char(3) packed unaligned dcl 943 set ref 1249* 1254* 1256* 1265* anysw 000602 automatic bit(1) packed unaligned dcl 929 set ref 964* 966* 982 1039 1116 1125 area_ptr 000152 automatic pointer dcl 122 set ref 297* 298 524 arg based char packed unaligned dcl 126 set ref 660* 676 676 689 693 693 696 703 703 715 724 724 735 737 741 741 743 743 745 745 764* arg1_len 000121 automatic fixed bin(21,0) dcl 99 set ref 652* 758* arg1_ptr 000162 automatic pointer dcl 129 set ref 651* 758* arglen 000120 automatic fixed bin(21,0) dcl 99 set ref 646* 652 655* 660 660 672* 676 676 685* 689 693 693 693 696 703 703 711* 715 719* 724 724 731* 735 737 741 741 743 743 745 745 764 764 argptr 000160 automatic pointer dcl 129 set ref 646* 651 655* 660 672* 676 676 685* 689 693 693 696 703 703 711* 715 719* 724 724 731* 735 737 741 741 743 743 745 745 764 attach_descrip_ptr 14 based pointer level 2 dcl 6-6 ref 1104 attach_flag 127(09) based bit(1) level 3 packed packed unaligned dcl 4-18 ref 1033 based_area based area(1024) dcl 121 ref 298 524 bptr based pointer dcl 125 set ref 838* call_cnt 6 based fixed bin(17,0) level 2 dcl 2-23 set ref 368* 504 507* 536 cancel_code 000170 automatic fixed bin(17,0) dcl 446 set ref 450* 451* cfc_code parameter fixed bin(35,0) dcl 902 set ref 894 953* 960* 1114* 1119* 1131* 1146* 1168* close_code 000111 automatic fixed bin(35,0) dcl 92 set ref 374* 514* 614* cobol_control_$cancel 000132 constant entry external dcl 447 ref 451 cobol_data_area based fixed bin(35,0) array dcl 118 ref 298 383 524 cobol_error_ 000110 constant entry external dcl 161 ref 1287 cobol_file_control_ 000116 constant entry external dcl 164 ref 374 514 614 code 000100 automatic fixed bin(35,0) dcl 796 in procedure "COND" set ref 800* code parameter fixed bin(17,0) dcl 466 in procedure "cobol_control_" set ref 303 328 400* 406* 454 491 493* 544* 548* 1295* com_err_ 000106 constant entry external dcl 160 ref 553 660 764 768 773 777 781 880 886 1128 1273 1290 command_sw 000604 automatic bit(1) packed unaligned dcl 931 set ref 1089* 1095* 1116 cond_info 000202 automatic structure level 1 unaligned dcl 1318 set ref 800 800 cond_name parameter char packed unaligned dcl 870 in procedure "cobol_hand" set ref 866 873 886* cond_name parameter char packed unaligned dcl 796 in procedure "COND" set ref 790 802* control based structure level 1 dcl 1-6 control_1 000100 automatic fixed bin(17,0) dcl 45 set ref 49* 61* 191 198 223 control_ptr 2 based pointer level 2 dcl 2-23 set ref 285* controlp 000014 internal static pointer initial dcl 1-5 set ref 180 243 247 252 255 255 258 261 264 266 276 276 281 283 283 284 284 285 287 289 290 290 351 354 354 354 354 354 359 359 359 363 419 422* 432* 495 495 495 499 532 553 557* 567* 587 587 605 605 605 605 605 608 608 608 612 629 639 667 696 719 719 720 720 737 741 745 751 752 784* 823* 828* 838 955 957 987 989 cu_$arg_count 000066 constant entry external dcl 145 ref 642 cu_$arg_ptr 000070 constant entry external dcl 146 ref 646 672 685 711 731 cu_$cp 000064 constant entry external dcl 144 ref 758 cu_$stack_frame_ptr 000122 constant entry external dcl 166 ref 47 59 582 1283 data_len 7 based fixed bin(17,0) level 2 dcl 2-23 ref 293 298 383 383 524 524 data_ptr based pointer level 2 dcl 2-23 set ref 293 298* 380 383 385* 520 524 528* dtsw parameter bit(1) dcl 901 set ref 894 1033* 1156 1201 1254 dup 000252 automatic structure level 1 unaligned dcl 912 eicon 001052 automatic char(8) packed unaligned dcl 939 set ref 1189* 1194* 1213* entry_pt_ptr 10 based pointer level 2 dcl 2-23 ref 243 504 error_con 56 based varying char(30) level 2 dcl 2-23 set ref 204* error_name 000124 automatic char(3) packed unaligned dcl 113 set ref 345* 347* 374* error_output_ptr 52 based pointer level 2 dcl 2-23 set ref 202* error_ptr 000166 automatic pointer dcl 133 set ref 1286* 1287* error_table_$badopt 000130 external static fixed bin(35,0) dcl 171 set ref 764* error_table_$noarg 000126 external static fixed bin(35,0) dcl 170 set ref 773* error_table_$seg_not_found 000124 external static fixed bin(35,0) dcl 168 ref 658 errorname parameter char packed unaligned dcl 900 set ref 894 1099 1148 1150 1153 1273* evar 000154 automatic entry variable dcl 124 set ref 835* 838 expand_path_ 000072 constant entry external dcl 147 ref 719 file_info based structure level 1 unaligned dcl 8-6 file_info_ptr 000200 automatic pointer dcl 8-5 in procedure "cobol_control_" set ref 976* 998* 1028 1030 1032 file_info_ptr 4 based pointer level 2 in structure "stat" dcl 2-23 in procedure "cobol_control_" set ref 370 376* 510 516* 614 972 976 994 998 file_name 001041 automatic char(32) packed unaligned dcl 938 set ref 1188* 1193* 1213* find_command_ 000062 constant entry external dcl 143 ref 655 find_condition_info_ 000134 constant entry external dcl 793 ref 800 finish 000000 stack reference condition dcl 71 ref 189 fixed builtin function dcl 1304 ref 696 1229 1230 1231 float builtin function dcl 1304 ref 737 fofl_handler_ptr 56 based pointer level 2 dcl 1-6 set ref 838* found 000122 automatic bit(1) packed unaligned dcl 106 set ref 349* 388* 400 490* 533* 544 fsb based structure level 1 unaligned dcl 4-18 fsb_ptr 000176 automatic pointer dcl 4-16 set ref 1006* 1007 1032* 1033 1036 1036 1039 1039 1045 1048 1050 1053 1069 1070 1081 1088 1097 1099 1099 1103 1104 1128 1142 1147 1153 1159 1180 1183 1188 1193 1245* 1245 1245 fsb_skel based structure level 2 dcl 4-18 fsbskel based structure level 1 dcl 5-16 get_pdir_ 000076 constant entry external dcl 151 ref 289 get_temp_segments_ 000046 constant entry external dcl 76 ref 817 hcs_$delentry_file 000074 constant entry external dcl 150 ref 354 605 hcs_$fs_get_ref_name 000100 constant entry external dcl 153 ref 223 225 hcs_$make_ptr 000104 constant entry external dcl 157 ref 486 838 1006 hcs_$truncate_seg 000102 constant entry external dcl 155 ref 422 557 828 i 000113 automatic fixed bin(17,0) dcl 94 in procedure "cobol_control_" set ref 255* 258 261 264 266 276 276* 297 359* 363* 481* 482 482 486 486 495* 499 532* 608* 612* 669* 672* 679* 679 682 685* 689* 689 706* 706 708 711* 715* 715 727* 727 729 731* 735* 735* i 000566 automatic fixed bin(17,0) dcl 918 in begin block on line 904 set ref 987* 989* ind_mask 33(27) based bit(9) level 2 packed packed unaligned dcl 1-6 set ref 741* index builtin function dcl 1304 ref 209 235 264 270 290 481 720 1050 1148 1183 indicators 132 based structure level 3 dcl 4-18 infoptr parameter pointer dcl 871 in procedure "cobol_hand" set ref 866 878* infoptr 14 000202 automatic pointer level 2 in structure "cond_info" dcl 1318 in procedure "cobol_control_" set ref 802* internal 134 based bit(1) level 4 packed packed unaligned dcl 4-18 ref 1039 1039 1048 1099 1180 ioa_ 000112 constant entry external dcl 162 ref 419 1213 1217 1223 1234 1245 1262 1265 1268 ioa_$rsnnl 000114 constant entry external dcl 163 ref 415 417 iocb based structure level 1 dcl 6-6 iocb_ptr based pointer level 3 dcl 4-18 set ref 1045 1050 1053 1097 1103 1104 1128 1142* 1159* 1183 1188 1193 1245 1245* ioname parameter char packed unaligned dcl 897 set ref 894 964 1006* 1039 1039 1039 1045 1053 iox_$close 000136 constant entry external dcl 948 ref 1142 iox_$detach_iocb 000140 constant entry external dcl 949 ref 1159 iox_$error_output 000054 external static pointer dcl 135 ref 202 iox_$user_input 000056 external static pointer dcl 136 ref 203 iox_$user_output 000052 external static pointer dcl 134 ref 201 j 000567 automatic fixed bin(17,0) dcl 919 in begin block on line 904 set ref 1050* 1051 1051* 1053 1148* 1150 1150* 1153 1183* 1185 1185* 1188 j 000114 automatic fixed bin(17,0) dcl 94 in procedure "cobol_control_" set ref 209* 211 214 215 221* 223* 225* 235* 236 236* 239 240 264* 266 266* 268* 268 276 k 000115 automatic fixed bin(17,0) dcl 94 in procedure "cobol_control_" set ref 270* 272 272* 274* 274 276 k 000570 automatic fixed bin(17,0) dcl 920 in begin block on line 904 set ref 1028* 1030 1032* last_key_read 347 based varying char(256) level 2 dcl 4-18 set ref 1036* len 000117 automatic fixed bin(17,0) dcl 98 set ref 415* 417* length builtin function dcl 1304 ref 1150 line_no 34 based fixed bin(17,0) array level 2 dcl 2-23 set ref 413 415 415* 417* 417* lineno 000145 automatic char(20) packed unaligned dcl 117 set ref 413* 415* 417* 419* link_ptr 44 based pointer level 2 dcl 3-7 ref 197 585 lock 134(01) based bit(1) level 4 packed packed unaligned dcl 4-18 set ref 1099* m 000571 automatic fixed bin(17,0) dcl 921 set ref 1078* 1081* main_prog_ptr 60 based pointer level 2 dcl 1-6 set ref 243 751* main_prog_sw 62 based fixed bin(17,0) level 2 in structure "control" dcl 1-6 in procedure "cobol_control_" set ref 587 752* main_prog_sw 40 based fixed bin(17,0) level 2 in structure "stat" dcl 2-23 in procedure "cobol_control_" set ref 246* 251* mcode 000110 automatic fixed bin(35,0) dcl 91 in procedure "cobol_control_" set ref 223* 225* 227 354* 422* 423 428* 429 486* 487 557* 558 563* 564 605* 646* 647 655* 658 672* 673 685* 686 711* 712 719* 731* 732 758* 759 781* 817* 819 828* 830 838* 845 849* 850 1287* 1290* 1295 mcode 000564 automatic fixed bin(35,0) dcl 916 in begin block on line 904 set ref 1006* 1142* 1143 1159* 1161 1273* mod1 134(02) based bit(1) level 4 packed packed unaligned dcl 4-18 ref 1036 mode 000574 automatic fixed bin(17,0) dcl 924 in begin block on line 904 set ref 1231* 1234 mode parameter fixed bin(17,0) dcl 814 in procedure "set_handlers" ref 810 826 mode_con 000016 internal static char(6) initial array packed unaligned dcl 944 set ref 1234* mpname 34 based varying char(65) level 2 dcl 1-6 set ref 247* 252* n 000252 automatic fixed bin(17,0) level 2 in structure "dup" dcl 912 in begin block on line 904 set ref 962* 1078 1078 1085 1085* 1085 1088 n based fixed bin(17,0) level 2 in structure "file_info" dcl 8-6 in procedure "cobol_control_" ref 1028 name 12 based char(65) level 2 in structure "control" dcl 1-6 in procedure "cobol_control_" set ref 281* 419* 553* name 1 based char(32) level 2 in structure "iocb" dcl 6-6 in procedure "cobol_control_" set ref 1045 1050 1053 1128* 1183 1188 1193 1245* name parameter char packed unaligned dcl 464 in procedure "cobol_control_" set ref 443 451* 454 481 482 484 486 486 553* nargs 000116 automatic fixed bin(17,0) dcl 96 set ref 642* 643 669 669 682 708 729 new_return_ptr 100 based pointer level 2 dcl 3-7 ref 223 223 no_of_segs 137 based fixed bin(17,0) level 2 dcl 1-6 set ref 255 255 283* 283 284 359 359 495 495 608 608 957 987 nodupsw 000603 automatic bit(1) packed unaligned dcl 930 set ref 961* 985* 1072 null builtin function dcl 1304 ref 180 261 276 293 345 351 359 365 370 376 380 385 408 432 434 434 434 434 486 486 495 501 510 516 520 528 532 567 569 569 569 569 587 587 587 595 595 595 595 605 608 614 614 639 719 719 784 800 800 881 881 881 881 955 968 972 991 994 1006 1006 1007 1030 1097 1106 1109 1262 1265 1292 1292 1292 1292 odptr 000576 automatic pointer dcl 926 set ref 1103* 1106 1106 1262 oiscon 001103 automatic char(3) packed unaligned dcl 942 set ref 1249* 1252* 1262* open_close_name 107 based char(65) level 3 packed packed unaligned dcl 4-18 set ref 1069 1153* open_descrip_ptr 20 based pointer level 2 dcl 6-6 ref 1103 open_mode 2 based fixed bin(35,0) level 3 dcl 4-18 set ref 1070 1147* org 000572 automatic fixed bin(17,0) dcl 922 set ref 1229* 1234 org_con 000024 internal static char(10) initial array packed unaligned dcl 945 set ref 1234* others_found 000123 automatic bit(1) packed unaligned dcl 107 set ref 490* 491* 536* 550 pcon 001054 automatic char(69) packed unaligned dcl 940 set ref 1190* 1195* 1209* 1213* pname 001020 automatic char(65) packed unaligned dcl 937 set ref 975* 997* 1072 1116 pr4_save_ptr parameter pointer dcl 65 ref 38 56 194 prev_stack_frame_ptr 20 based pointer level 2 dcl 3-7 ref 48 60 195 584 1285 prog_id 13 based char(65) level 2 dcl 2-23 set ref 209 215 217 232 239* 247 264 270 276 276 281 419* 975 997 1190 prog_id_len 12 based fixed bin(17,0) level 2 dcl 2-23 set ref 214* 214 217 240* 240 247 266 272 1190 progname 000135 automatic char(32) packed unaligned dcl 116 set ref 215* 217* 239 pt 2 based pointer array level 2 in structure "file_info" dcl 8-6 in procedure "cobol_control_" ref 1030 1032 pt 2 000252 automatic pointer array level 2 in structure "dup" dcl 912 in begin block on line 904 set ref 1081 1088* rdsw parameter fixed bin(17,0) dcl 313 ref 303 328 380 454 520 release_temp_segments_ 000050 constant entry external dcl 78 ref 428 563 return_ptr 24 based pointer level 2 dcl 3-7 ref 225 225 1286 rfsw parameter fixed bin(17,0) dcl 314 ref 303 328 370 454 510 rname 000125 automatic char(32) packed unaligned dcl 115 set ref 219* 221 223* 225* 232 235 239 482* 484* 486* save_ad 000702 automatic varying char(240) dcl 935 set ref 1109* 1265* save_mode 000565 automatic fixed bin(17,0) dcl 917 set ref 1070* 1119 1122 1139 1164 1171 1203 1217 1223 1229 1230 1231 save_ocname 000777 automatic char(65) packed unaligned dcl 936 set ref 1069* 1072 1075 1075 1116 1217* 1234* save_od 000605 automatic varying char(240) dcl 934 set ref 1106* 1262* segptr 000164 automatic pointer dcl 132 set ref 486* 504 655* 751 sense_sw based fixed bin(17,0) array level 2 dcl 1-6 set ref 696* 745* signal_ 000120 constant entry external dcl 165 ref 434 569 587 595 881 1292 sort_dir 65 based char(168) level 2 dcl 1-6 set ref 289* 290 354 354 605 605 719 719 720 sort_dir_len 64 based fixed bin(17,0) level 2 dcl 1-6 set ref 287 290* 354 354 354 605 605 667* 720* sort_file_size 63 based float bin(27) level 2 dcl 1-6 set ref 737* stack_frame based structure level 1 dcl 3-7 stack_frame_ptr 000174 automatic pointer dcl 3-6 set ref 47* 48* 48 59* 60* 60 195* 195 197 223 223 225 225 582* 584* 584 585 1283* 1285* 1285 1286 stack_header based structure level 1 dcl 7-26 stat based structure level 1 dcl 2-23 stat_ptr 000172 automatic pointer dcl 2-22 set ref 194* 197* 201 202 203 204 209 214 214 215 217 217 232 239 240 240 243 246 247 247 251 258 270 272 276 281 284 285 293 293 298 298 363* 365 368 370 374* 376 380 383 383 383 385 411* 413 415 415 417 417 499* 501 504 504 507 510 514* 516 520 524 524 524 528 536 585* 587* 593* 612* 614 614 614* 971* 972 975 976 989* 991 994 997 998 1190 1190 statp parameter pointer dcl 898 ref 894 906 statptr parameter pointer dcl 66 in procedure "cobol_control_" ref 303 328 345 408 411 419 statptr 000250 automatic pointer dcl 905 in begin block on line 904 set ref 906* 968 971 statptr 140 based pointer array level 2 in structure "control" dcl 1-6 in procedure "cobol_control_" set ref 258 261 264 266 276 276* 284* 363 499 532* 612 989 stop_code 000112 automatic fixed bin(17,0) dcl 93 set ref 591* 593* 877* 878* stop_run 000102 stack reference condition dcl 71 ref 188 754 stop_run_command 000012 internal static bit(1) packed unaligned dcl 104 set ref 323* 331* 393* 1213 1217 1223 1234 1245 1260 stop_run_sw 000013 internal static bit(1) initial packed unaligned dcl 105 set ref 743* 754 873 substr builtin function dcl 1304 set ref 215 217 239 247 276 276 289* 354 354 482 486 486 605 605 689 715 735 964 1053 1075 1153 1188 1190 1229 1230 1231 tp 000010 internal static pointer array dcl 82 set ref 428* 563* 817* 823 type parameter fixed bin(17,0) dcl 899 ref 894 1114 1177 1198 1242 1242 1249 unspec builtin function dcl 1304 ref 1229 1230 1231 user_free_ptr 16 based pointer level 2 dcl 7-26 ref 297 user_input_ptr 54 based pointer level 2 dcl 2-23 set ref 203* user_output_ptr 50 based pointer level 2 dcl 2-23 set ref 201* vstring based varying char(240) dcl 933 ref 1106 1109 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. bc automatic fixed bin(21,0) dcl 102 binary builtin function dcl 1304 bl_pos automatic fixed bin(17,0) dcl 96 call_offset internal static fixed bin(17,0) initial dcl 7-78 cobol_mcs_$stop_run 000000 constant entry external dcl 159 cobol_rts_handler_ 000000 constant entry external dcl 139 command_abort_ 000000 stack reference condition dcl 71 cond based structure level 1 unaligned dcl 84 cond_ptr automatic pointer dcl 128 condition_ 000000 constant entry external dcl 138 continue automatic fixed bin(17,0) dcl 101 dir automatic char(168) packed unaligned dcl 112 dlr_pos automatic fixed bin(17,0) dcl 96 entry_offset internal static fixed bin(17,0) initial dcl 7-78 error 000000 stack reference condition dcl 71 first_link_offset internal static fixed bin(17,0) initial dcl 2-52 fixed_static_length internal static fixed bin(17,0) initial dcl 2-51 hcs_$initiate_count 000000 constant entry external dcl 152 hcs_$make_seg 000000 constant entry external dcl 158 hcs_$terminate_noname 000000 constant entry external dcl 148 hcs_$terminate_seg 000000 constant entry external dcl 156 iox_$iocb_version_sentinel external static char(4) dcl 6-51 jlen automatic fixed bin(17,0) dcl 95 klen automatic fixed bin(17,0) dcl 95 m automatic fixed bin(17,0) dcl 94 mod builtin function dcl 1304 n automatic fixed bin(17,0) dcl 94 name1 automatic char(32) packed unaligned dcl 114 nl internal static char(1) initial packed unaligned dcl 110 opened_files internal static structure level 1 unaligned dcl 908 push_offset internal static fixed bin(17,0) initial dcl 7-78 rel builtin function dcl 1304 return_no_pop_offset internal static fixed bin(17,0) initial dcl 7-78 return_offset internal static fixed bin(17,0) initial dcl 7-78 rseg based char packed unaligned dcl 109 rsegptr automatic pointer dcl 131 rwds automatic fixed bin(17,0) dcl 100 save_cond_ptr automatic pointer dcl 130 sb automatic pointer dcl 7-24 stack_header_overlay based fixed bin(17,0) array dcl 7-94 string builtin function dcl 1304 tv_offset internal static fixed bin(17,0) initial dcl 7-72 NAMES DECLARED BY EXPLICIT CONTEXT. COND 006231 constant entry internal dcl 790 ref 188 189 754 action 003524 constant entry internal dcl 1066 ref 1009 1039 1045 1053 bad_arg_error 002657 constant label dcl 764 set ref 693 745 cancel 000741 constant entry external dcl 454 cobol_cancel_ 000660 constant entry external dcl 443 cobol_control_ 000507 constant entry external dcl 38 ref 835 cobol_file_control_ 003107 constant entry external dcl 894 cobol_finish_ 001611 constant entry external dcl 602 ref 849 849 cobol_hand 006502 constant entry internal dcl 866 ref 802 cobol_handler_ 003063 constant entry external dcl 861 cobol_rts_control_ 000545 constant entry external dcl 56 cobol_stop_run_ 000610 constant entry external dcl 303 ref 593 878 cobol_stop_run_command_ 000633 constant entry external dcl 328 cobol_stoprun_ 001452 constant entry external dcl 579 control_error 004575 constant label dcl 1283 ref 227 819 845 850 get_pointer 001770 constant entry external dcl 626 invalid_exit_error 002771 constant label dcl 777 ref 759 look 003372 constant entry internal dcl 1025 ref 978 999 merror 004555 constant label dcl 1273 ref 1143 1164 missing_arg_error 002747 constant label dcl 773 set ref 643 multics_error 004652 constant label dcl 1290 ref 423 429 558 564 rc 002023 constant entry external dcl 635 rc_error 003050 constant label dcl 784 ref 766 775 rc_multics_error 003027 constant label dcl 781 ref 647 673 686 712 732 830 recursion_error 002710 constant label dcl 768 ref 639 return_multics_error 004731 constant label dcl 1295 ref 487 run_cobol 002012 constant entry external dcl 635 set_data_ptr 005521 constant label dcl 293 ref 258 set_handlers 006304 constant entry internal dcl 810 ref 180 665 start 004743 constant entry internal dcl 176 ref 50 62 start_cobol_stop_run 005550 constant entry internal dcl 342 ref 324 332 switch_loop 002242 constant label dcl 679 ref 698 NAMES DECLARED BY CONTEXT OR IMPLICATION. divide builtin function ref 1028 pointer builtin function ref 223 223 225 225 ptr builtin function ref 297 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 7414 7556 6701 7424 Length 10316 6701 142 524 513 36 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_control_ 982 external procedure is an external procedure. start 148 internal procedure enables or reverts conditions. on unit on line 188 74 on unit on unit on line 189 74 on unit start_cobol_stop_run internal procedure shares stack frame of external procedure cobol_control_. on unit on line 754 74 on unit COND 176 internal procedure is called by several nonquick procedures. set_handlers 112 internal procedure is called by several nonquick procedures. cobol_hand internal procedure shares stack frame of internal procedure COND. begin block on line 904 begin block shares stack frame of external procedure cobol_control_. look internal procedure shares stack frame of external procedure cobol_control_. action internal procedure shares stack frame of external procedure cobol_control_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 tp cobol_control_ 000012 stop_run_command cobol_control_ 000013 stop_run_sw cobol_control_ 000014 controlp cobol_control_ 000016 mode_con begin block on line 904 000024 org_con begin block on line 904 000036 acc_con begin block on line 904 STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME COND 000100 code COND cobol_control_ 000100 control_1 cobol_control_ 000110 mcode cobol_control_ 000111 close_code cobol_control_ 000112 stop_code cobol_control_ 000113 i cobol_control_ 000114 j cobol_control_ 000115 k cobol_control_ 000116 nargs cobol_control_ 000117 len cobol_control_ 000120 arglen cobol_control_ 000121 arg1_len cobol_control_ 000122 found cobol_control_ 000123 others_found cobol_control_ 000124 error_name cobol_control_ 000125 rname cobol_control_ 000135 progname cobol_control_ 000145 lineno cobol_control_ 000152 area_ptr cobol_control_ 000154 evar cobol_control_ 000160 argptr cobol_control_ 000162 arg1_ptr cobol_control_ 000164 segptr cobol_control_ 000166 error_ptr cobol_control_ 000170 cancel_code cobol_control_ 000172 stat_ptr cobol_control_ 000174 stack_frame_ptr cobol_control_ 000176 fsb_ptr cobol_control_ 000200 file_info_ptr cobol_control_ 000202 cond_info cobol_control_ 000250 statptr begin block on line 904 000252 dup begin block on line 904 000564 mcode begin block on line 904 000565 save_mode begin block on line 904 000566 i begin block on line 904 000567 j begin block on line 904 000570 k begin block on line 904 000571 m begin block on line 904 000572 org begin block on line 904 000573 acc begin block on line 904 000574 mode begin block on line 904 000576 odptr begin block on line 904 000600 adptr begin block on line 904 000602 anysw begin block on line 904 000603 nodupsw begin block on line 904 000604 command_sw begin block on line 904 000605 save_od begin block on line 904 000702 save_ad begin block on line 904 000777 save_ocname begin block on line 904 001020 pname begin block on line 904 001041 file_name begin block on line 904 001052 eicon begin block on line 904 001054 pcon begin block on line 904 001076 action_con begin block on line 904 001103 oiscon begin block on line 904 001104 aiscon begin block on line 904 THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp cat_realloc_chars call_ext_in call_ext_out_desc call_ext_out call_int_this call_int_other_desc call_int_other begin_return_mac return_mac tra_ext_1 signal_op enable_op shorten_stack ext_entry ext_entry_desc int_entry int_entry_desc real_to_real_round_ any_to_any_round_ any_to_any_truncate_op_alloc_ op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. add_epilogue_handler_ cobol_control_$cancel cobol_error_ cobol_file_control_ com_err_ cu_$arg_count cu_$arg_ptr cu_$cp cu_$stack_frame_ptr expand_path_ find_command_ find_condition_info_ get_pdir_ get_temp_segments_ hcs_$delentry_file hcs_$fs_get_ref_name hcs_$make_ptr hcs_$truncate_seg ioa_ ioa_$rsnnl iox_$close iox_$detach_iocb release_temp_segments_ signal_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$noarg error_table_$seg_not_found iox_$error_output iox_$user_input iox_$user_output LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 38 000504 47 000516 48 000524 49 000527 50 000530 51 000534 56 000543 59 000554 60 000563 61 000566 62 000570 63 000574 303 000603 323 000617 324 000621 325 000622 328 000631 331 000642 332 000645 333 000646 443 000655 450 000675 451 000676 452 000725 454 000734 481 000756 482 000772 484 001000 486 001003 487 001047 490 001052 491 001054 493 001062 495 001064 499 001103 501 001110 504 001114 507 001123 510 001125 514 001134 516 001177 520 001202 524 001211 528 001216 532 001220 533 001227 534 001231 536 001232 540 001237 541 001242 542 001252 544 001261 548 001267 550 001271 553 001273 557 001340 558 001354 563 001356 564 001405 567 001407 569 001412 574 001442 579 001451 582 001461 584 001470 585 001473 587 001476 591 001531 593 001532 595 001550 597 001601 602 001610 605 001620 608 001660 612 001677 614 001704 618 001755 620 001757 626 001766 629 001776 635 002011 639 002032 642 002037 643 002045 646 002050 647 002067 651 002071 652 002073 655 002075 658 002112 660 002116 661 002155 665 002164 667 002174 669 002177 672 002211 673 002226 676 002230 679 002242 682 002243 685 002246 686 002263 689 002265 693 002275 696 002311 698 002331 702 002332 703 002333 706 002343 708 002344 711 002347 712 002364 715 002366 719 002376 720 002422 723 002434 724 002435 727 002445 729 002446 731 002451 732 002466 735 002470 737 002500 740 002522 741 002523 743 002540 745 002554 749 002570 751 002572 752 002576 754 002601 758 002633 759 002646 761 002650 764 002657 766 002707 768 002710 771 002740 773 002747 775 002770 777 002771 779 003020 781 003027 784 003050 786 003053 861 003062 864 003072 894 003101 906 003131 953 003135 955 003137 957 003155 960 003172 961 003174 962 003175 964 003176 966 003206 968 003207 971 003213 972 003214 975 003232 976 003235 978 003237 979 003240 982 003241 985 003243 987 003245 989 003255 991 003262 994 003266 997 003272 998 003275 999 003277 1002 003300 1004 003302 1006 003303 1007 003342 1009 003357 1014 003360 1281 003371 1025 003372 1028 003373 1030 003403 1032 003411 1033 003415 1036 003423 1039 003427 1042 003457 1045 003460 1048 003470 1050 003474 1051 003506 1053 003511 1059 003521 1061 003523 1066 003524 1069 003525 1070 003531 1072 003533 1075 003541 1078 003551 1081 003561 1083 003567 1085 003571 1088 003575 1089 003601 1091 003603 1092 003604 1094 003605 1095 003606 1097 003607 1099 003613 1103 003630 1104 003634 1106 003636 1109 003647 1111 003660 1112 003661 1114 003662 1116 003667 1119 003701 1122 003704 1125 003705 1128 003707 1131 003746 1135 003750 1139 003751 1142 003752 1143 003763 1146 003765 1147 003767 1148 003771 1150 004003 1153 004006 1154 004033 1156 004034 1159 004037 1161 004050 1164 004052 1166 004054 1168 004055 1170 004057 1171 004060 1174 004063 1175 004064 1177 004065 1180 004071 1183 004075 1185 004107 1188 004112 1189 004115 1190 004117 1191 004135 1193 004137 1194 004143 1195 004145 1198 004150 1201 004153 1203 004156 1205 004164 1206 004167 1207 004170 1209 004173 1210 004176 1211 004177 1213 004202 1217 004243 1220 004272 1223 004273 1226 004312 1229 004313 1230 004317 1231 004322 1234 004326 1242 004376 1245 004404 1249 004437 1252 004447 1254 004451 1256 004457 1260 004461 1262 004464 1265 004513 1268 004543 1272 004554 1273 004555 1275 004574 1283 004575 1285 004604 1286 004607 1287 004612 1288 004643 1290 004652 1292 004671 1293 004722 1295 004731 1297 004733 176 004742 180 004750 188 004764 189 005014 191 005044 194 005047 195 005054 196 005057 197 005060 198 005064 201 005065 202 005072 203 005076 204 005102 209 005104 211 005116 214 005117 215 005121 216 005127 217 005130 219 005134 221 005137 223 005152 225 005205 227 005235 230 005243 232 005246 235 005253 236 005264 239 005267 240 005315 243 005320 246 005326 247 005330 248 005340 251 005341 252 005342 255 005343 258 005354 261 005364 264 005371 266 005403 268 005412 270 005414 272 005426 274 005432 276 005434 280 005451 281 005454 283 005457 284 005462 285 005467 287 005473 289 005476 290 005511 293 005521 297 005531 298 005535 301 005547 342 005550 345 005551 347 005561 349 005563 351 005564 354 005571 357 005625 359 005626 363 005645 365 005652 368 005656 370 005660 374 005667 376 005730 380 005733 383 005742 385 005747 388 005751 391 005753 393 005755 400 005757 406 005765 408 005767 411 005773 413 005776 415 006004 417 006036 419 006072 422 006125 423 006141 428 006143 429 006172 432 006174 434 006177 438 006227 790 006230 800 006244 802 006263 806 006302 810 006303 817 006311 819 006340 823 006346 826 006351 828 006354 830 006370 835 006376 838 006403 845 006447 849 006455 850 006473 853 006501 866 006502 873 006513 877 006524 878 006526 880 006544 881 006573 886 006624 888 006661 ----------------------------------------------------------- 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