COMPILATION LISTING OF SEGMENT expand_cobol_source 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 1024.9 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 expand_cobol_source.pl1 Reformatted code to new Cobol standard. 19* END HISTORY COMMENTS */ 20 21 22 /* Modified on 02/08/82 by FCH, [5.1-3], cobol$copy_file_size defined, phx11819(BUG517) */ 23 /* Modified on 01/04/81 by FCH, [5.1-2], let cobol_expand_source know if called by command, phx11818(BUG519) */ 24 /* Modified on 10/27/81 by FCH, [5.1-1], issue diag if long line found, phx11819(BUG517) */ 25 /* Modified on 07/20/81 by FCH, [4.4-2], bit count not computed correctly, phx10605(BUG495) */ 26 /* Modified on 03/06/81 by FCH, [4.4-1], test for zero length seg, release areas if error */ 27 /* Modified on 10/09/79 by FCH, [4.0-4], new control arguments */ 28 /* Modified on 10/03/79 by FCH, [4.0-3], new control arguments */ 29 /* Modified on 03/08/79 by FCH, [4.0-2], -strip blanks option */ 30 /* Modified on 02/23/79 by FCH, [4.0-1], copy library name qualification */ 31 /* Created on 09/16/78 by FCH */ 32 33 34 35 36 37 38 39 40 /* expand_cobol_source path1 {path2} {-control_args} 41* 42* where 43* path1 name of input segment, ".cobol" suffix implied 44* 45* control_args 46* 47* one of the following 48* 49* -lower_case, -lc lower case conversion, implies formatting 50* 51* -upper_case, -uc upper case conversion, implies formatting 52* 53* -card card image format, strip trailing blanks 54* 55* -expand, -exp expand source 56* 57* -no_expand, -no_exp do not expand source 58* 59* -format,-fmt format cobol source 60* 61**/ 62 63 64 65 66 67 /* format: style3 */ 68 expand_cobol_source: 69 ecs: 70 proc; 71 72 /*************************************/ 73 74 call cu_$arg_count (nargs); 75 command = "1"b; 76 etype = 1; /*[4.4-1]*/ 77 tssi_ind = "0"b; 78 ecs_info_ptr = addr (ecs_info_table); 79 80 if nargs = 0 81 then do; 82 83 call ioa_ ("^a^/^a^/^a^/^a^/", "expand_cobol_source: Expected argument missing", 84 "Usage: expand_cobol_source path1 path2 {control_args}", 85 "Control Arguments: -format(-fmt) -lower_case(-lc) -upper_case(-uc)", 86 /*[4.0-2]*/ 87 "Control Arguments: -card -expand(-exp) -no_expand(-no_exp)" /*[4.0-3]*/); 88 89 return; 90 end; 91 92 on cleanup call cl; 93 on command_abort_ call cl; 94 call init; 95 96 if code ^= 0 97 then go to multics_error; 98 99 /* path1 */ 100 101 102 103 call cu_$arg_ptr (1, argptr, arglen, code); 104 105 if code ^= 0 106 then go to multics_error; 107 108 call expand_pathname_$add_suffix (arg, "cobol", dn_1, en_1, code); 109 110 if code ^= 0 111 then go to multics_error; 112 113 if nargs = 1 114 then do; 115 call gen_path2; 116 if code ^= 0 117 then go to multics_error; 118 end; 119 120 /*[4.0-3]*/ 121 else do; 122 123 i = 2; 124 125 do while (i <= nargs); 126 127 call cu_$arg_ptr (i, argptr, arglen, code); 128 129 if code ^= 0 130 then go to multics_error; 131 132 /*[4.0-3]*/ 133 if i = 2 /*[4.0-3]*/ 134 then do; 135 if substr (arg, 1, 1) = "-" 136 /*[4.0-3]*/ 137 then do; 138 call gen_path2;/*[4.0-3]*/ 139 call process_control_arg; 140 /*[4.0-3]*/ 141 end; /*[4.0-3]*/ 142 else call expand_pathname_$add_suffix (arg, "cobol", dn_2, en_2, code); 143 /*[4.0-3]*/ 144 end; /*[4.0-4]*/ 145 else if substr (arg, 1, 1) = "-" /*[4.0-4]*/ 146 then call process_control_arg; /*[4.0-4]*/ 147 else go to too_many_args_error; 148 149 i = i + 1; 150 151 end; 152 153 /*[4.0-3]*/ 154 end; 155 156 call hcs_$initiate_count (dn_1, en_1, "", bc, 1, s1_ptr, code); 157 158 if s1_ptr = null () 159 then do; 160 en = en_1; 161 go to multics_arg_error; 162 end; /*[4.4-1]*/ 163 if bc = 0 /*[4.4-1]*/ 164 then do; 165 code = error_table_$zero_length_seg; /*[4.4-1]*/ 166 en = en_1; 167 168 /*[4.4-1]*/ 169 go to multics_arg_error; /*[4.4-1]*/ 170 end; 171 172 en = en_2; 173 174 /*[4.0-4]*/ 175 call hcs_$initiate_count (dn_2, en_2, "", bc_temp, 1, s2_ptr, code); 176 177 /*[4.0-4]*/ 178 if s1_ptr ^= s2_ptr /*[4.0-4]*/ 179 then do; 180 call tssi_$get_segment (dn_2, en_2, s2_ptr, aclinfo_ptr, code); 181 182 /*[4.4-1]*/ 183 tssi_ind = "1"b; 184 185 /*[4.0-4]*/ 186 if code ^= 0 187 then go to multics_arg_error; /*[4.0-4]*/ 188 end; 189 190 ecs_info_table_.format_indicator = "1"b; 191 192 call finish; 193 194 if code ^= 0 195 then go to multics_error; 196 197 goto exp_end_1; 198 199 expand: 200 entry (ecs_ptr, e_code); 201 202 on cleanup call cl; 203 on command_abort_ call cl; 204 205 ecs_info_ptr = ecs_ptr; 206 command = "0"b; 207 208 call init; 209 210 if code ^= 0 211 then go to exp_end; 212 213 call hcs_$fs_get_path_name (ecs_info_table_.input_ptr, dn_1, ldn, en_1, code); 214 215 if code ^= 0 216 then go to exp_end; 217 218 call hcs_$initiate_count (dn_1, en_1, "", bc, 1, s1_ptr, code); 219 220 if s1_ptr = null () 221 then go to exp_end; 222 223 call tssi_$get_segment (ecs_info_table_.dir, ecs_info_table_.ent, ecs_info_table_.output_ptr, aclinfo_ptr, code) 224 ; 225 226 if code ^= 0 227 then go to exp_end; 228 229 /*[4.4-1]*/ 230 tssi_ind = "1"b; 231 232 s1_ptr = ecs_info_table_.input_ptr; 233 s2_ptr = ecs_info_table_.output_ptr; 234 235 /*[4.0-4]*/ 236 if ecs_info_table_.exp_indicator 237 then etype = 1; 238 else etype = -1; 239 240 if ecs_info_table_.format_indicator 241 then ftype = 1; 242 243 /*[4.0-4]*/ 244 if ecs_info_table_.card_indicator 245 then ftype = 2; 246 247 ecs_info_table_.format_indicator = "0"b; /*[4.0-4]*/ 248 ecs_info_table_.card_indicator = "0"b; 249 250 call finish; 251 252 /* Used to reinitialize the new *.ex.cobol (expanded version) and return */ 253 /* the pointer to COBOL */ 254 255 call hcs_$initiate_count (ecs_info_table_.dir, ecs_info_table_.ent, "", bc, 01b, ecs_info_table_.output_ptr, 256 code); 257 258 if ^(code = 0 | code = error_table_$segknown) 259 then go to exp_end; 260 261 e_code = 0; /*[5.1-1]*/ 262 ecs_info_table_.bc = bc; 263 264 goto exp_end_1; 265 266 exp_end: 267 e_code = code; 268 269 exp_end_1: 270 if area_info_area.areap ^= null () 271 then call release_area_ (area_info_area.areap); 272 call release_temp_segments_ ("expand_cobol_source", temp_ptr, code); 273 274 return; 275 276 /*[4.0-1]*/ 277 278 find_incl_file: 279 entry (file_name, lib_name, source_ptr, file_ptr, e_code); 280 281 /*[4.0-1]*/ 282 if lib_name ^= "" /*[4.0-1]*/ 283 then do; 284 call expand_pathname_$add_suffix 285 /*[4.0-1]*/ (lib_name || ">" || file_name, "incl.cobol", dn_1, en_1, e_code); 286 287 /*[4.0-1]*/ 288 if e_code ^= 0 289 then return; 290 291 /*[4.0-2]*/ 292 call hcs_$initiate_count (dn_1, en_1, "", bc, 1, file_ptr, e_code); 293 294 /*[4.0-1]*/ 295 if e_code = error_table_$segknown 296 then e_code = 0; 297 298 /*[4.0-1]*/ 299 end; /*[4.0-1]*/ 300 else do; 301 call find_include_file_$initiate_count 302 /*[4.0-1]*/ ("cobol", source_ptr, file_name || ".incl.cobol", bc, file_ptr, e_code); 303 304 /*[4.0-1]*/ 305 end; 306 307 /*[5.1-3]*/ 308 call cobol$copy_file_size (bc); 309 310 /*[4.0-1]*/ 311 return; 312 313 /* Error Handling */ 314 315 badopt_error: 316 call com_err_ (error_table_$badopt, "expand_cobol_source", arg); 317 /*[4.4-1]*/ 318 call cl; 319 return; 320 321 too_many_args_error: 322 code = error_table_$too_many_args; 323 go to multics_error; 324 325 sameseg_error: 326 code = error_table_$sameseg; 327 go to multics_error; 328 329 multics_error: 330 call com_err_ (code, "expand_cobol_source"); /*[4.4-1]*/ 331 call cl; 332 return; 333 334 multics_arg_error: 335 call com_err_ (code, "expand_cobol_source", "^a", en); 336 /*[4.4-1]*/ 337 call cl; 338 return; 339 340 cl: 341 proc; 342 343 344 if area_info_area.areap ^= null () 345 then call release_area_ (area_info_area.areap); 346 347 /*[4.4-1]*/ 348 if tssi_ind 349 then call tssi_$clean_up_segment (aclinfo_ptr); 350 351 call release_temp_segments_ ("expand_cobol_source", temp_ptr, code); 352 353 end; 354 355 init: 356 proc; 357 358 call get_temp_segments_ ("expand_cobol_source", temp_ptr, code); 359 360 if code ^= 0 361 then return; 362 363 area_infop = addr (area_info_area); 364 365 area_info_area.version = area_info_version_1; 366 area_info_area.owner = "expand_cobol_source"; 367 area_info_area.areap = temp_ptr (3); 368 area_info_area.size = sys_info$max_seg_size; 369 string (area_info_area.control) = "0"b; 370 371 /*[4.4-1]*/ 372 area_info_area.extend /* , area_info_area.zero_on_alloc*/ = "1"b; 373 374 375 call define_area_ (area_infop, code); 376 377 if code ^= 0 378 then return; 379 380 comp_lev = 5; /*[4.0-2]*/ 381 ctype, ftype, etype = 0; 382 383 end; 384 385 finish: 386 proc; 387 388 /* ctype -1 lc 389* 0 no change 390* +1 uc 391* 392* ftype 0 expand 393* 1 fmt, lc, uc 394* 2 card 395* 396* etype -1 no_exp 397* 0 exp 398* +1 exp 399* 400* 401* (I) fmt/card (T1) move (I) 402* (O) 403* 404* (I) copy (T2) replace (T1) move (I) 405* (O) 406* 407* (I) fmt/card (T1) copy (T2) replace (T1) move (I) 408* (O) 409* 410**/ 411 412 /*[4.0-4]*/ 413 declare o_ptr ptr; 414 415 /*[4.0-4]*/ 416 if s1_ptr = s2_ptr 417 then o_ptr = temp_ptr (1); 418 else o_ptr = s2_ptr; 419 420 /*[4.0-4]*/ 421 go to FT (ftype); 422 423 FT (0): /* expand */ 424 /*[4.0-4]*/ 425 call CR (s1_ptr, temp_ptr (2), o_ptr); 426 427 go to FT_END; 428 429 FT (1): /* format */ 430 FT (2): /* card */ 431 /*[4.0-4]*/ 432 if etype < 0 /*[4.0-4]*/ 433 then call TRANS (s1_ptr, o_ptr); /*[4.0-4]*/ 434 else do; 435 call TRANS (s1_ptr, temp_ptr (1)); /*[4.0-4]*/ 436 call CR (temp_ptr (1), temp_ptr (2), o_ptr); 437 /*[4.0-4]*/ 438 end; 439 440 FT_END: /*[4.0-4]*/ 441 call MOVE (o_ptr, s1_ptr); 442 443 /*[4.0-4]*/ 444 ecs_info_table_.output_ptr = o_ptr; 445 446 /*[4.0-4]*/ 447 return; 448 449 CR: 450 proc (in_ptr, t_p, out_ptr); 451 452 /*[4.0-4]*/ 453 declare (in_ptr, t_p, out_ptr) 454 ptr; 455 456 /*[4.0-4]*/ 457 ecs_info_table_.input_ptr = in_ptr; /*[4.0-4]*/ 458 ecs_info_table_.output_ptr = t_p; 459 460 /*[4.0-4]*/ 461 call SET (t_p, null ()); 462 463 /*[5.1-2]*/ 464 ecs_info_table_.command = command; 465 466 /*[4.0-4]*/ 467 call cobol_expand_source_$copy (ecs_info_ptr, bc, command, temp_ptr (3)); 468 469 /*[4.0-4]*/ 470 call SET (out_ptr, t_p); 471 472 /*[4.0-4]*/ 473 ecs_info_table_.input_ptr = t_p; /*[4.0-4]*/ 474 ecs_info_table_.output_ptr = out_ptr; 475 476 /*[4.0-4]*/ 477 call cobol_expand_source_$replace (ecs_info_ptr, bc, command, temp_ptr (3)); 478 479 /*[4.0-4]*/ 480 call SET (t_p, out_ptr); 481 482 end; 483 484 SET: 485 proc (tr_ptr, set_ptr); 486 487 /*[4.0-4]*/ 488 declare (tr_ptr, set_ptr) ptr; 489 490 /*[4.0-4]*/ 491 call hcs_$truncate_seg (tr_ptr, 0, code); 492 493 /*[4.0-4]*/ 494 if code ^= 0 495 then go to multics_error; 496 497 /*[4.0-4]*/ 498 if set_ptr = null () 499 then return; 500 501 /*[4.0-4]*/ 502 call hcs_$set_bc_seg (set_ptr, bc, code); 503 504 /*[4.0-4]*/ 505 if code ^= 0 506 then go to multics_error; 507 508 end; 509 510 TRANS: 511 proc (in_ptr, out_ptr); 512 513 /*[4.0-4]*/ 514 declare (in_ptr, IP, out_ptr, OP) 515 ptr; 516 517 /*[4.0-4]*/ 518 IP = in_ptr; 519 OP = out_ptr; 520 521 /*[4.0-4]*/ 522 call SET (OP, IP); 523 524 /*[4.0-4]*/ 525 go to TRAN (ftype); 526 527 TRAN (1): /* format */ 528 call cobol_source_formatter_ (IP, OP, bc, ctype, 0); 529 530 go to TRAN_END; 531 532 TRAN (2): /* card */ 533 /*[4.0-4]*/ 534 call cobol_blank_stripper_ (IP, OP, bc); 535 536 TRAN_END: /*[4.0-4]*/ 537 call hcs_$set_bc_seg (OP, bc, code); 538 539 /*[4.0-4]*/ 540 if code ^= 0 541 then go to multics_error; 542 543 end; 544 545 MOVE: 546 proc (in_ptr, out_ptr); 547 548 /*[4.0-4]*/ 549 declare (in_ptr, out_ptr) ptr; /*[4.4-2]*/ 550 declare cc fixed bin; /*[4.0-4]*/ 551 declare seg char (500000) based; 552 553 /*[4.0-4]*/ 554 if s1_ptr = s2_ptr /*[4.0-4]*/ 555 then do; 556 call hcs_$truncate_seg (out_ptr, 0, code); 557 /*[4.0-4]*/ 558 if code ^= 0 559 then go to multics_error; 560 561 /*[4.4-2]*/ 562 cc = divide (bc, 9, 31, 0); /*[4.4-2]*/ 563 substr (out_ptr -> seg, 1, cc) = substr (in_ptr -> seg, 1, cc); 564 565 /*[4.4-2]*/ 566 call hcs_$set_bc_seg (out_ptr, bc, code); 567 /*[4.4-2]*/ 568 if code ^= 0 569 then go to multics_error; 570 571 /*[4.0-4]*/ 572 end; /*[4.0-4]*/ 573 else do; 574 call tssi_$finish_segment (in_ptr, bc, "101"b, aclinfo_ptr, code); 575 576 /*[4.0-4]*/ 577 if code ^= 0 578 then go to multics_error; 579 580 /*[4.0-4]*/ 581 end; 582 583 end; 584 585 end; 586 587 cobol_strip: 588 proc (p); 589 590 declare p ptr, 591 sz fixed bin; 592 593 declare name char (32) based (p); 594 595 call get_length (p); 596 597 if j > 9 598 then do; 599 if substr (name, j - 8, 9) = ".ex.cobol" 600 then do; 601 name = substr (name, 1, j - 9); 602 return; 603 end; 604 end; 605 606 if j > 6 607 then if substr (name, j - 5, 6) = ".cobol" 608 then name = substr (name, 1, j - 6); 609 610 end; 611 612 gen_path2: 613 proc; 614 615 dn_2 = get_wdir_ (); 616 en_2 = en_1; 617 code = 0; 618 619 call cobol_strip (addr (en_2)); 620 621 call get_length (addr (en_2)); 622 623 if j <= 23 624 then en_2 = substr (en_2, 1, j) || ".ex.cobol"; 625 else code = error_table_$entlong; 626 end; 627 628 process_control_arg: 629 proc; 630 631 if arg = "-upper_case" | arg = "-uc" /*[4.0-2]*/ 632 then do; 633 call test_arg (ctype, 1); /*[4.0-3]*/ 634 call test_arg (ftype, 1); /*[4.0-3]*/ 635 end; 636 else if arg = "-lower_case" | arg = "-lc" /*[4.0-2]*/ 637 then do; 638 call test_arg (ctype, -1); /*[4.0-4]*/ 639 call test_arg (ftype, 1); /*[4.0-4]*/ 640 end; 641 642 else if arg = "-format" | arg = "-fmt" 643 then call test_arg (ftype, 1); 644 645 else /*[4.0-3]*/ 646 if arg = "-card" /*[4.0-3]*/ 647 then call test_arg (ftype, 2); /*[4.0-3]*/ 648 else /*[4.0-3]*/ 649 if arg = "-expand" | arg = "-exp" /*[4.0-3]*/ 650 then call test_arg (etype, 1); /*[4.0-3]*/ 651 else /*[4.0-3]*/ 652 if arg = "-no_expand" | arg = "-no_exp" /*[4.0-3]*/ 653 then call test_arg (etype, -1); 654 else if arg = "" 655 then return; 656 else go to badopt_error; 657 658 end; 659 660 test_arg: 661 proc (type, val); /*[4.0-2]*/ 662 663 /*[4.0-2]*/ 664 dcl (type, val) fixed bin; 665 666 /*[4.0-2]*/ 667 if type = 0 /*[4.0-2]*/ 668 then type = val; /*[4.0-2]*/ 669 else /*[4.0-2]*/ 670 call com_err_ (error_table_$arg_ignored, "expand_cobol_source", arg); 671 672 end; /*[4.0-2]*/ 673 674 get_length: 675 proc (p); 676 677 declare p ptr; 678 declare name char (32) based (p); 679 680 j = index (name, " "); 681 682 if j = 0 683 then j = 32; 684 else j = j - 1; 685 686 end; 687 688 dcl (file_name, lib_name) 689 char (*), 690 (source_ptr, file_ptr) 691 ptr; /*[4.0-1]*/ 692 693 dcl command bit (1); 694 dcl dir_ptr ptr; 695 dcl (aclinfo_ptr, ecs_ptr) 696 ptr; 697 dcl (e1_ptr, e2_ptr) ptr; 698 dcl final_ptr ptr; 699 dcl argptr ptr; 700 dcl (s1_ptr, s2_ptr, sf_ptr) 701 ptr; 702 dcl tssi_ind bit (1); 703 dcl (nargs, comp_lev) fixed bin; 704 dcl arglen fixed bin; 705 dcl arg char (arglen) based (argptr); 706 dcl 1 area_info_area aligned automatic structure like area_info; 707 dcl 1 ecs_info_table automatic structure like ecs_info_table_; 708 dcl (code, e_code, abc) fixed bin (35); 709 dcl (bc, bc_temp) fixed bin (24); 710 dcl (i, j, ldn) fixed bin; 711 dcl (ctype, etype, ftype) 712 fixed bin; /*[4.0-2]*/ 713 dcl (dn_1, dn_2) char (168); 714 dcl (en, en_1, en_2) char (32); 715 dcl tn char (32); 716 717 dcl error_table_$segknown 718 fixed bin (35) ext; 719 dcl error_table_$sameseg 720 fixed bin (35) ext; 721 dcl error_table_$noarg fixed bin (35) ext; 722 dcl error_table_$badopt fixed bin (35) ext; 723 dcl error_table_$arg_ignored 724 fixed bin (35) ext; 725 dcl error_table_$too_many_args 726 fixed bin (35) ext; 727 dcl error_table_$entlong 728 fixed bin (35) ext; 729 dcl error_table_$zero_length_seg 730 fixed bin (35) ext; 731 dcl sys_info$max_seg_size 732 fixed bin (35) ext; 733 734 dcl cobol_source_formatter_ 735 entry (ptr, ptr, fixed bin (24), fixed bin, fixed bin); 736 dcl hcs_$truncate_seg entry (ptr, fixed bin, fixed bin (35)); 737 dcl cobol_source_formatter_$no_shift 738 entry (ptr, ptr, fixed bin (24), fixed bin); 739 dcl com_err_ entry options (variable); 740 dcl cobol_expand_source_$copy 741 entry (ptr, fixed bin (24), bit (1), ptr); 742 dcl cobol_expand_source_$replace 743 entry (ptr, fixed bin (24), bit (1), ptr); 744 dcl get_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)); 745 dcl release_temp_segments_ 746 entry (char (*), (*) ptr, fixed bin (35)); 747 dcl hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35)); 748 dcl hcs_$fs_get_path_name 749 entry (ptr, char (*), fixed bin, char (*), fixed bin (35)); 750 dcl get_system_free_area_ 751 entry returns (ptr); 752 dcl get_wdir_ entry returns (char (168)); 753 dcl define_area_ entry (ptr, fixed bin (35)); 754 dcl release_area_ entry (ptr); 755 dcl expand_pathname_$add_suffix 756 entry (char (*), char (*), char (*), char (*), fixed bin (35)); 757 dcl cu_$arg_count entry (fixed bin); 758 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 759 dcl hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, fixed bin (35)); 760 /*[4.0-2]*/ 761 dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); 762 dcl ioa_ entry options (variable); 763 764 dcl tssi_$get_segment entry (char (*), char (*), ptr, ptr, fixed bin (35)); 765 766 dcl find_include_file_$initiate_count 767 entry (char (*), ptr, char (*), fixed bin (24), ptr, fixed bin (35)); 768 /*[4.0-1]*/ 769 dcl tssi_$finish_segment 770 entry (ptr, fixed bin (24), bit (36) aligned, ptr, fixed bin (35)); 771 dcl tssi_$clean_up_segment 772 entry (ptr); 773 dcl cobol_blank_stripper_ 774 entry (ptr, ptr, fixed bin (24)); 775 /*[4.0-2]*/ 776 777 /*[5.1-3]*/ 778 declare cobol$copy_file_size 779 entry (fixed bin (24)); 780 781 dcl (addr, index, null, substr, divide) 782 builtin; 783 784 dcl temp_ptr (3) ptr; 785 786 dcl (cleanup, command_abort_) 787 condition; 788 1 1 /* BEGIN INCLUDE FILE area_info.incl.pl1 12/75 */ 1 2 1 3 dcl area_info_version_1 fixed bin static init (1) options (constant); 1 4 1 5 dcl area_infop ptr; 1 6 1 7 dcl 1 area_info aligned based (area_infop), 1 8 2 version fixed bin, /* version number for this structure is 1 */ 1 9 2 control aligned like area_control, /* control bits for the area */ 1 10 2 owner char (32) unal, /* creator of the area */ 1 11 2 n_components fixed bin, /* number of components in the area (returned only) */ 1 12 2 size fixed bin (18), /* size of the area in words */ 1 13 2 version_of_area fixed bin, /* version of area (returned only) */ 1 14 2 areap ptr, /* pointer to the area (first component on multisegment area) */ 1 15 2 allocated_blocks fixed bin, /* number of blocks allocated */ 1 16 2 free_blocks fixed bin, /* number of free blocks not in virgin */ 1 17 2 allocated_words fixed bin (30), /* number of words allocated in the area */ 1 18 2 free_words fixed bin (30); /* number of words free in area not in virgin */ 1 19 1 20 dcl 1 area_control aligned based, 1 21 2 extend bit (1) unal, /* says area is extensible */ 1 22 2 zero_on_alloc bit (1) unal, /* says block gets zerod at allocation time */ 1 23 2 zero_on_free bit (1) unal, /* says block gets zerod at free time */ 1 24 2 dont_free bit (1) unal, /* debugging aid, turns off free requests */ 1 25 2 no_freeing bit (1) unal, /* for allocation method without freeing */ 1 26 2 system bit (1) unal, /* says area is managed by system */ 1 27 2 pad bit (30) unal; 1 28 1 29 /* END INCLUDE FILE area_info.incl.pl1 */ 789 2 1 /* BEGIN INCLUDE FILE ... cobol_ecs_info.incl.pl1 */ 2 2 /* Modified on 10/09/79 by FCH, [4.0-2], new field added */ 2 3 /* Modified on 03/02/79 by FCH, [4.0-1], -levsv option */ 2 4 /* Modified on 10/27/81 by FCH, [5.1-1], new fields added */ 2 5 2 6 dcl ecs_info_ptr ptr; 2 7 2 8 dcl 2 9 2 10 1 ecs_info_table_ based (ecs_info_ptr), 2 11 2 12 2 expand_cobol_source_info, 2 13 3 input_ptr ptr, 2 14 3 output_ptr ptr, 2 15 3 format_indicator bit (1), 2 16 3 card_indicator bit(1), /*[4.0-2]*/ 2 17 3 exp_indicator bit(1), /*[4.0-2]*/ 2 18 3 command bit(1), /*[5.1-1]*/ 2 19 3 dir char(168), /*[4.0-2]*/ 2 20 3 ent char(32), /*[4.0-2]*/ 2 21 2 22 2 compiler_info, 2 23 3 compiler_level char (1), 2 24 3 diag_indicators bit (3), 2 25 3 levsv bit(3), /*[4.0-1]*/ 2 26 3 fatal_count fixed bin, 2 27 3 bc fixed bin(24); /*[5.1-1]*/ 2 28 2 29 /* END INCLUDE FILE ... cobol_ecs_info.incl.pl1 */ 790 791 792 end expand_cobol_source; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0836.8 expand_cobol_source.pl1 >spec>install>MR12.3-1048>expand_cobol_source.pl1 789 1 06/11/76 1043.4 area_info.incl.pl1 >ldd>include>area_info.incl.pl1 790 2 11/11/82 1712.8 cobol_ecs_info.incl.pl1 >ldd>include>cobol_ecs_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. IP 000512 automatic pointer dcl 514 set ref 518* 522* 527* 532* OP 000514 automatic pointer dcl 514 set ref 519* 522* 527* 532* 536* aclinfo_ptr 000102 automatic pointer dcl 695 set ref 180* 223* 348* 574* addr builtin function dcl 781 ref 78 363 619 619 621 621 area_control based structure level 1 dcl 1-20 area_info based structure level 1 dcl 1-7 area_info_area 000116 automatic structure level 1 dcl 706 set ref 363 area_info_version_1 constant fixed bin(17,0) initial dcl 1-3 ref 365 area_infop 000444 automatic pointer dcl 1-5 set ref 363* 375* areap 16 000116 automatic pointer level 2 dcl 706 set ref 269 269* 344 344* 367* arg based char packed unaligned dcl 705 set ref 108* 135 142* 145 315* 631 631 636 636 642 642 645 648 648 651 651 654 669* arglen 000115 automatic fixed bin(17,0) dcl 704 set ref 103* 108 108 127* 135 142 142 145 315 315 631 631 636 636 642 642 645 648 648 651 651 654 669 669 argptr 000104 automatic pointer dcl 699 set ref 103* 108 127* 135 142 145 315 631 631 636 636 642 642 645 648 648 651 651 654 669 bc 000235 automatic fixed bin(24,0) dcl 709 in procedure "ecs" set ref 156* 163 218* 255* 262 292* 301* 308* 467* 477* 502* 527* 532* 536* 562 566* 574* bc 71 based fixed bin(24,0) level 3 in structure "ecs_info_table_" dcl 2-8 in procedure "ecs" set ref 262* bc_temp 000236 automatic fixed bin(24,0) dcl 709 set ref 175* card_indicator 4(01) based bit(1) level 3 packed packed unaligned dcl 2-8 set ref 244 248* cc 000524 automatic fixed bin(17,0) dcl 550 set ref 562* 563 563 cleanup 000430 stack reference condition dcl 786 ref 92 202 cobol$copy_file_size 000104 constant entry external dcl 778 ref 308 cobol_blank_stripper_ 000102 constant entry external dcl 773 ref 532 cobol_expand_source_$copy 000036 constant entry external dcl 740 ref 467 cobol_expand_source_$replace 000040 constant entry external dcl 742 ref 477 cobol_source_formatter_ 000030 constant entry external dcl 734 ref 527 code 000234 automatic fixed bin(35,0) dcl 708 set ref 96 103* 105 108* 110 116 127* 129 142* 156* 165* 175* 180* 186 194 210 213* 215 218* 223* 226 255* 258 258 266 272* 321* 325* 329* 334* 351* 358* 360 375* 377 491* 494 502* 505 536* 540 556* 558 566* 568 574* 577 617* 625* com_err_ 000034 constant entry external dcl 739 ref 315 329 334 669 command 4(03) based bit(1) level 3 in structure "ecs_info_table_" packed packed unaligned dcl 2-8 in procedure "ecs" set ref 464* command 000100 automatic bit(1) packed unaligned dcl 693 in procedure "ecs" set ref 75* 206* 464 467* 477* command_abort_ 000436 stack reference condition dcl 786 ref 93 203 comp_lev 000114 automatic fixed bin(17,0) dcl 703 set ref 380* compiler_info 67 based structure level 2 unaligned dcl 2-8 control 1 000116 automatic structure level 2 dcl 706 set ref 369* ctype 000242 automatic fixed bin(17,0) dcl 711 set ref 381* 527* 633* 638* cu_$arg_count 000062 constant entry external dcl 757 ref 74 cu_$arg_ptr 000064 constant entry external dcl 758 ref 103 127 define_area_ 000054 constant entry external dcl 753 ref 375 dir 4(09) based char(168) level 3 packed packed unaligned dcl 2-8 set ref 223* 255* divide builtin function dcl 781 ref 562 dn_1 000245 automatic char(168) packed unaligned dcl 713 set ref 108* 156* 213* 218* 284* 292* dn_2 000317 automatic char(168) packed unaligned dcl 713 set ref 142* 175* 180* 615* e_code parameter fixed bin(35,0) dcl 708 set ref 199 261* 266* 278 284* 288 292* 295 295* 301* ecs_info_ptr 000446 automatic pointer dcl 2-6 set ref 78* 190 205* 213 223 223 223 232 233 236 240 244 247 248 255 255 255 262 444 457 458 464 467* 473 474 477* ecs_info_table 000142 automatic structure level 1 unaligned dcl 707 set ref 78 ecs_info_table_ based structure level 1 unaligned dcl 2-8 ecs_ptr parameter pointer dcl 695 ref 199 205 en 000371 automatic char(32) packed unaligned dcl 714 set ref 160* 166* 172* 334* en_1 000401 automatic char(32) packed unaligned dcl 714 set ref 108* 156* 160 166 213* 218* 284* 292* 616 en_2 000411 automatic char(32) packed unaligned dcl 714 set ref 142* 172 175* 180* 616* 619 619 621 621 623* 623 ent 56(09) based char(32) level 3 packed packed unaligned dcl 2-8 set ref 223* 255* error_table_$arg_ignored 000016 external static fixed bin(35,0) dcl 723 set ref 669* error_table_$badopt 000014 external static fixed bin(35,0) dcl 722 set ref 315* error_table_$entlong 000022 external static fixed bin(35,0) dcl 727 ref 625 error_table_$sameseg 000012 external static fixed bin(35,0) dcl 719 ref 325 error_table_$segknown 000010 external static fixed bin(35,0) dcl 717 ref 258 295 error_table_$too_many_args 000020 external static fixed bin(35,0) dcl 725 ref 321 error_table_$zero_length_seg 000024 external static fixed bin(35,0) dcl 729 ref 165 etype 000243 automatic fixed bin(17,0) dcl 711 set ref 76* 236* 238* 381* 429 648* 651* exp_indicator 4(02) based bit(1) level 3 packed packed unaligned dcl 2-8 ref 236 expand_cobol_source_info based structure level 2 unaligned dcl 2-8 expand_pathname_$add_suffix 000060 constant entry external dcl 755 ref 108 142 284 extend 1 000116 automatic bit(1) level 3 packed packed unaligned dcl 706 set ref 372* file_name parameter char packed unaligned dcl 688 ref 278 284 301 file_ptr parameter pointer dcl 688 set ref 278 292* 301* find_include_file_$initiate_count 000074 constant entry external dcl 766 ref 301 format_indicator 4 based bit(1) level 3 packed packed unaligned dcl 2-8 set ref 190* 240 247* ftype 000244 automatic fixed bin(17,0) dcl 711 set ref 240* 244* 381* 421 525 634* 639* 642* 645* get_temp_segments_ 000042 constant entry external dcl 744 ref 358 get_wdir_ 000052 constant entry external dcl 752 ref 615 hcs_$fs_get_path_name 000050 constant entry external dcl 748 ref 213 hcs_$initiate_count 000066 constant entry external dcl 759 ref 156 175 218 255 292 hcs_$set_bc_seg 000046 constant entry external dcl 747 ref 502 536 566 hcs_$truncate_seg 000032 constant entry external dcl 736 ref 491 556 i 000237 automatic fixed bin(17,0) dcl 710 set ref 123* 125 127* 133 149* 149 in_ptr parameter pointer dcl 514 in procedure "TRANS" ref 510 518 in_ptr parameter pointer dcl 549 in procedure "MOVE" set ref 545 563 574* in_ptr parameter pointer dcl 453 in procedure "CR" ref 449 457 index builtin function dcl 781 ref 680 input_ptr based pointer level 3 dcl 2-8 set ref 213* 232 457* 473* ioa_ 000070 constant entry external dcl 762 ref 83 j 000240 automatic fixed bin(17,0) dcl 710 set ref 597 599 601 606 606 606 623 623 680* 682 682* 684* 684 ldn 000241 automatic fixed bin(17,0) dcl 710 set ref 213* lib_name parameter char packed unaligned dcl 688 ref 278 282 284 name based char(32) packed unaligned dcl 678 in procedure "get_length" ref 680 name based char(32) packed unaligned dcl 593 in procedure "cobol_strip" set ref 599 601* 601 606 606* 606 nargs 000113 automatic fixed bin(17,0) dcl 703 set ref 74* 80 113 125 null builtin function dcl 781 ref 158 220 269 344 461 461 498 o_ptr 000466 automatic pointer dcl 413 set ref 416* 418* 423* 429* 436* 440* 444 out_ptr parameter pointer dcl 453 in procedure "CR" set ref 449 470* 474 480* out_ptr parameter pointer dcl 549 in procedure "MOVE" set ref 545 556* 563 566* out_ptr parameter pointer dcl 514 in procedure "TRANS" ref 510 519 output_ptr 2 based pointer level 3 dcl 2-8 set ref 223* 233 255* 444* 458* 474* owner 2 000116 automatic char(32) level 2 packed packed unaligned dcl 706 set ref 366* p parameter pointer dcl 590 in procedure "cobol_strip" set ref 587 595* 599 601 601 606 606 606 p parameter pointer dcl 677 in procedure "get_length" ref 674 680 release_area_ 000056 constant entry external dcl 754 ref 269 344 release_temp_segments_ 000044 constant entry external dcl 745 ref 272 351 s1_ptr 000106 automatic pointer dcl 700 set ref 156* 158 178 218* 220 232* 416 423* 429* 435* 440* 554 s2_ptr 000110 automatic pointer dcl 700 set ref 175* 178 180* 233* 416 418 554 seg based char(500000) packed unaligned dcl 551 set ref 563* 563 set_ptr parameter pointer dcl 488 set ref 484 498 502* size 13 000116 automatic fixed bin(18,0) level 2 dcl 706 set ref 368* source_ptr parameter pointer dcl 688 set ref 278 301* substr builtin function dcl 781 set ref 135 145 563* 563 599 601 606 606 623 sys_info$max_seg_size 000026 external static fixed bin(35,0) dcl 731 ref 368 t_p parameter pointer dcl 453 set ref 449 458 461* 470* 473 480* temp_ptr 000422 automatic pointer array dcl 784 set ref 272* 351* 358* 367 416 423* 435* 436* 436* 467* 477* tr_ptr parameter pointer dcl 488 set ref 484 491* tssi_$clean_up_segment 000100 constant entry external dcl 771 ref 348 tssi_$finish_segment 000076 constant entry external dcl 769 ref 574 tssi_$get_segment 000072 constant entry external dcl 764 ref 180 223 tssi_ind 000112 automatic bit(1) packed unaligned dcl 702 set ref 77* 183* 230* 348 type parameter fixed bin(17,0) dcl 664 set ref 660 667 667* val parameter fixed bin(17,0) dcl 664 ref 660 667 version 000116 automatic fixed bin(17,0) level 2 dcl 706 set ref 365* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. abc automatic fixed bin(35,0) dcl 708 cobol_source_formatter_$no_shift 000000 constant entry external dcl 737 dir_ptr automatic pointer dcl 694 e1_ptr automatic pointer dcl 697 e2_ptr automatic pointer dcl 697 error_table_$noarg external static fixed bin(35,0) dcl 721 final_ptr automatic pointer dcl 698 get_system_free_area_ 000000 constant entry external dcl 750 hcs_$make_seg 000000 constant entry external dcl 761 sf_ptr automatic pointer dcl 700 sz automatic fixed bin(17,0) dcl 590 tn automatic char(32) packed unaligned dcl 715 NAMES DECLARED BY EXPLICIT CONTEXT. CR 002250 constant entry internal dcl 449 ref 423 436 FT 000000 constant label array(0:2) dcl 423 set ref 421 FT_END 002242 constant label dcl 440 set ref 427 MOVE 002520 constant entry internal dcl 545 ref 440 SET 002366 constant entry internal dcl 484 ref 461 470 480 522 TRAN 000003 constant label array(2) dcl 527 ref 525 TRANS 002432 constant entry internal dcl 510 ref 429 435 TRAN_END 002502 constant label dcl 536 ref 530 badopt_error 001672 constant label dcl 315 ref 654 cl 002034 constant entry internal dcl 340 ref 92 93 202 203 318 331 337 cobol_strip 002621 constant entry internal dcl 587 ref 619 ecs 000212 constant entry external dcl 68 exp_end 001337 constant label dcl 266 ref 210 215 220 226 258 exp_end_1 001341 constant label dcl 269 ref 197 264 expand 000771 constant entry external dcl 199 expand_cobol_source 000221 constant entry external dcl 68 find_incl_file 001411 constant entry external dcl 278 finish 002212 constant entry internal dcl 385 ref 192 250 gen_path2 002666 constant entry internal dcl 612 ref 115 138 get_length 003134 constant entry internal dcl 674 ref 595 621 init 002117 constant entry internal dcl 355 ref 94 208 multics_arg_error 001771 constant label dcl 334 ref 161 169 186 multics_error 001741 constant label dcl 329 ref 96 105 110 116 129 194 323 327 494 505 540 558 568 577 process_control_arg 002737 constant entry internal dcl 628 ref 139 145 sameseg_error 001735 constant label dcl 325 test_arg 003072 constant entry internal dcl 660 ref 633 634 638 639 642 645 648 651 too_many_args_error 001731 constant label dcl 321 ref 145 NAME DECLARED BY CONTEXT OR IMPLICATION. string builtin function ref 369 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3736 4044 3262 3746 Length 4352 3262 106 272 454 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME ecs 616 external procedure is an external procedure. on unit on line 92 64 on unit on unit on line 93 64 on unit on unit on line 202 64 on unit on unit on line 203 64 on unit cl 88 internal procedure is called by several nonquick procedures. init internal procedure shares stack frame of external procedure ecs. finish internal procedure shares stack frame of external procedure ecs. CR internal procedure shares stack frame of external procedure ecs. SET internal procedure shares stack frame of external procedure ecs. TRANS internal procedure shares stack frame of external procedure ecs. MOVE internal procedure shares stack frame of external procedure ecs. cobol_strip internal procedure shares stack frame of external procedure ecs. gen_path2 internal procedure shares stack frame of external procedure ecs. process_control_arg internal procedure shares stack frame of external procedure ecs. test_arg internal procedure shares stack frame of external procedure ecs. get_length internal procedure shares stack frame of external procedure ecs. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME ecs 000100 command ecs 000102 aclinfo_ptr ecs 000104 argptr ecs 000106 s1_ptr ecs 000110 s2_ptr ecs 000112 tssi_ind ecs 000113 nargs ecs 000114 comp_lev ecs 000115 arglen ecs 000116 area_info_area ecs 000142 ecs_info_table ecs 000234 code ecs 000235 bc ecs 000236 bc_temp ecs 000237 i ecs 000240 j ecs 000241 ldn ecs 000242 ctype ecs 000243 etype ecs 000244 ftype ecs 000245 dn_1 ecs 000317 dn_2 ecs 000371 en ecs 000401 en_1 ecs 000411 en_2 ecs 000422 temp_ptr ecs 000444 area_infop ecs 000446 ecs_info_ptr ecs 000466 o_ptr finish 000512 IP TRANS 000514 OP TRANS 000524 cc MOVE THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out call_int_this call_int_other return_mac enable_op shorten_stack ext_entry ext_entry_desc int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cobol$copy_file_size cobol_blank_stripper_ cobol_expand_source_$copy cobol_expand_source_$replace cobol_source_formatter_ com_err_ cu_$arg_count cu_$arg_ptr define_area_ expand_pathname_$add_suffix find_include_file_$initiate_count get_temp_segments_ get_wdir_ hcs_$fs_get_path_name hcs_$initiate_count hcs_$set_bc_seg hcs_$truncate_seg ioa_ release_area_ release_temp_segments_ tssi_$clean_up_segment tssi_$finish_segment tssi_$get_segment THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$arg_ignored error_table_$badopt error_table_$entlong error_table_$sameseg error_table_$segknown error_table_$too_many_args error_table_$zero_length_seg sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 68 000211 74 000226 75 000234 76 000236 77 000240 78 000241 80 000243 83 000245 89 000316 92 000317 93 000341 94 000363 96 000364 103 000366 105 000405 108 000407 110 000445 113 000447 115 000452 116 000453 118 000455 123 000456 125 000460 127 000463 129 000500 133 000502 135 000505 138 000512 139 000513 141 000514 142 000515 144 000553 145 000554 149 000562 151 000563 156 000564 158 000627 160 000633 161 000636 163 000637 165 000641 166 000644 169 000647 172 000650 175 000653 178 000716 180 000722 183 000752 186 000754 190 000756 192 000761 194 000762 197 000764 199 000765 202 001001 203 001023 205 001045 206 001051 208 001053 210 001054 213 001056 215 001107 218 001111 220 001154 223 001160 226 001214 230 001216 232 001220 233 001223 236 001226 238 001235 240 001237 244 001244 247 001251 248 001253 250 001255 255 001256 258 001325 261 001332 262 001333 264 001336 266 001337 269 001341 272 001354 274 001403 278 001404 282 001434 284 001443 288 001530 292 001533 295 001577 299 001604 301 001605 305 001661 308 001662 311 001671 315 001672 318 001724 319 001730 321 001731 323 001734 325 001735 327 001740 329 001741 331 001764 332 001770 334 001771 337 002026 338 002032 340 002033 344 002041 348 002054 351 002066 353 002116 355 002117 358 002120 360 002147 363 002152 365 002154 366 002156 367 002161 368 002163 369 002166 372 002167 375 002171 377 002201 380 002204 381 002206 383 002211 385 002212 416 002213 418 002222 421 002224 423 002226 427 002230 429 002231 435 002236 436 002240 440 002242 444 002244 447 002247 449 002250 457 002252 458 002255 461 002261 464 002273 467 002301 470 002316 473 002327 474 002333 477 002337 480 002354 482 002365 484 002366 491 002370 494 002404 498 002406 502 002414 505 002427 508 002431 510 002432 518 002434 519 002437 522 002442 525 002444 527 002446 530 002466 532 002467 536 002502 540 002515 543 002517 545 002520 554 002522 556 002526 558 002542 562 002544 563 002547 566 002557 568 002572 572 002574 574 002575 577 002616 583 002620 587 002621 595 002623 597 002631 599 002634 601 002643 602 002647 606 002650 610 002665 612 002666 615 002667 616 002676 617 002701 619 002702 621 002706 623 002712 625 002732 626 002736 628 002737 631 002740 633 002752 634 002756 635 002762 636 002763 638 002773 639 002777 640 003003 642 003004 645 003021 648 003032 651 003047 654 003064 658 003071 660 003072 667 003074 669 003101 672 003133 674 003134 680 003136 682 003151 684 003155 686 003157 ----------------------------------------------------------- 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