COMPILATION LISTING OF SEGMENT gcos_read_tape_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/19/82 1001.3 mst Fri Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 /* ******************************************************************** 12* * * 13* * WRITTEN BY: P. Haber March 21, 1974 * 14* * MODIFIED BY: R.H. Morrison September 19, 1974 * 15* * MODIFIED BY: R.H. Morrison September 12, 1975 * 16* * * 17* ******************************************************************** */ 18 19 gcos_read_tape_: proc (a_request, a_request_len, a_test); 20 21 ap = addr (request); /* argument pointer */ 22 ascii_ptr = addr (ascii); /* pointer to ascii version of card image */ 23 bcd_ptr = addr (b972); /* pointer to bcd version of card image */ 24 rh_ptr = addr (record_header); /* pointer to returned status from gcos_gsr_read_ */ 25 request_p = addr (request); /* pointer to request line */ 26 sp = addr (status_bits); /* pointer to status returned from ios calls */ 27 28 on condition (cleanup) /* set up condition handler */ 29 call wrap_up ("1"b); 30 31 /* check request line */ 32 33 request = a_request; /* copy in arguments */ 34 request_len = a_request_len; 35 36 call get_arg; /* fetch the first argument */ 37 38 if arg = "imcv7" /* request to read 7 track tape */ 39 then do; 40 tape_type = ",7track"; 41 i = 6; /* have parsed 6 characters */ 42 end; 43 44 else 45 if arg = "imcv" /* 9 track request */ 46 then do; 47 tape_type = ",9track"; 48 i = 5; /* have parsed 5 characters */ 49 end; 50 51 else /* error, unrecognized request */ 52 do; 53 call com_err_ (0, "gcos_read_tape_", "Invalid tape read command^/^a", request); 54 go to RETURN; 55 end; 56 57 call get_arg; 58 if code = error_table_$noarg /* missing argument .. tape label */ 59 then do; 60 call com_err_ (code, "gcos_read_tape_", "Error in request ^/^a", request); 61 go to RETURN; 62 end; 63 tape_label = arg||tape_type; 64 65 call get_arg; /* get argument from command line */ 66 if code = error_table_$noarg /* error, missing argument ... keyword */ 67 then do; 68 call com_err_ (code, "gcos_read_tape_", "Error in request^/^a", request); 69 go to RETURN; 70 end; 71 72 else /* found argument */ 73 if arg = "all" | arg = "-all" /* wants to execute all jobs */ 74 then all_snumbs_wanted = "1"b; 75 76 else 77 if arg = "take" | arg = "-take" /* wants to execute specified SNUMBs */ 78 then taking_given_snumbs = "1"b; 79 80 else 81 if arg = "start" | arg = "-start" /* wants to execute all SNUMBs after given one */ 82 then starting_from_given_snumb = "1"b; 83 84 else 85 if arg ^= "delete" & arg ^= "-delete" /* unrecognized request */ 86 then do; 87 call com_err_ (0, "gcos_read_tape_", "invalid argument ^a", arg); 88 go to RETURN; 89 end; 90 91 call get_arg; /* get next argument */ 92 if code = 0 /* there is another argument */ 93 then do; 94 if all_snumbs_wanted /* error, shouldn't be another argument */ 95 then do; 96 call com_err_ (0, "gcos_read_tape_", "Too many arguments in ^/^a", request); 97 go to RETURN; 98 end; 99 end; 100 101 else /* no more arguments */ 102 if ^all_snumbs_wanted /* error, need at least 1 more argument */ 103 then do; 104 call com_err_ (code, "gcos_read_tape_", "Error in request ^/^a", request); 105 go to RETURN; 106 end; 107 108 do while (code = 0); /* get remaining arguments */ 109 110 if al > 5 /* SNUMB too long */ 111 then do; 112 call com_err_ (0, "gcos_read_tape_", "SNUMB ^a too long", arg); 113 go to RETURN; 114 end; 115 116 snumb_count = snumb_count + 1; /* increment SNUMB count */ 117 if (snumb_count>5)| (snumb_count>2 & starting_from_given_snumb) /* error, too many SNUMBs */ 118 then do; 119 call com_err_ (0, "gcos_read_tape_", "Too many SNUMBs specified in ^/^a", request); 120 go to RETURN; 121 end; 122 123 do i = 1 to snumb_count -1; /* check for SNUMB duplication */ 124 if snumb_data (i).snumb = arg /* got one */ 125 then do; 126 call com_err_ (error_table_$namedup, "gcos_read_tape_", "in ^/^a", request); 127 go to RETURN; 128 end; 129 end; 130 131 snumb_data (snumb_count).snumb = arg; /* save snumb_data */ 132 133 call get_arg; 134 135 end; 136 137 /* set up gcos_gsr_read_ */ 138 139 if ^test_attach /* tape needs to be attached */ 140 then do; 141 142 call ios_$attach ("tape_input", gcos_daemon_stat_$tape_dim, tape_label, "r", status_bits); 143 code = status.code; 144 if code ^= 0 /* error attaching tape */ 145 then do; 146 call com_err_ (code, "gcos_read_tape_", "Error attaching tape ^a", tape_label); 147 go to RETURN; 148 end; 149 tape_is_attached = "1"b; /* remember tape is attached */ 150 151 end; 152 153 call gcos_gsr_read_$gsr_read_init ("tape_input", code); /* initialize read call */ 154 if code ^= 0 /* error in init call */ 155 then do; 156 call com_err_ (code, "gcos_read_tape_", "Error in call to gsr_read_init"); 157 call wrap_up ("0"b); 158 go to RETURN; 159 end; 160 else /* no error */ 161 gsr_read_init_called = "1"b; /* remember it was called */ 162 163 do i = 1 to 2; /* skip over tape label, tape mark */ 164 165 call ios_$read ("tape_input", bcd_ptr, 0, 27, elements_read, status_bits); 166 if substr (status_bits, 1, 3) = "100"b /* hardware status returned */ 167 then do; 168 if substr (status_bits, 27, 4) ^= "0100"b /* not "tape mark" status */ 169 then do; 170 call com_err_ (0, "gcos_read_tape_", 171 "Unexpected hardware status from nstd_: ^w^w", substr (status_bits, 1, 36), 172 substr (status_bits, 37, 36)); 173 call wrap_up ("0"b); 174 go to RETURN; 175 end; 176 end; 177 178 else /* no status returned */ 179 if status.code ^= 0 /* error code returned */ 180 then do; 181 call com_err_ (status.code, "gcos_read_tape_", "Error reading tape ^a", tape_label); 182 call wrap_up ("0"b); 183 go to RETURN; 184 end; 185 186 end; 187 188 READ: /* read the tape */ 189 190 if fin /* all needed SNUMBs were found */ 191 then do; 192 call wrap_up ("0"b); 193 go to RETURN; 194 end; 195 196 call read; 197 if code ^= 0 /* error in read call */ 198 then do; 199 call com_err_ (code, "gcos_read_tape_", "Error reading from tape"); 200 call wrap_up ("0"b); 201 go to RETURN; 202 end; 203 204 if eot_was_found /* end of tape */ 205 then do; 206 if ^all_snumbs_wanted /* specified SNUMBs were being searched for */ 207 then call check_snumbs; /* inform as to SNUMBs not found */ 208 call wrap_up ("0"b); 209 go to RETURN; 210 end; 211 212 call cv_bcd_to_ascii_ (buf_ptr, ascii_ptr); /* convert card to ascii */ 213 214 if substr (ascii, 1, 6) = "***eof" /* tapes sometimes have eofs */ 215 then do; 216 if last_image_was_eof /* error, 2 eof images in a row */ 217 then do; 218 call com_err_ (0, "gcos_read_tape_", "Unexpected eof image on tape ^a", tape_label); 219 call wrap_up ("0"b); 220 go to RETURN; 221 end; 222 last_image_was_eof = "1"b; /* remember for next read */ 223 go to READ; /* and read another card */ 224 end; 225 else /* card not "***eof" */ 226 last_image_was_eof = "0"b; /* remember */ 227 228 if (substr (ascii, 1, 1) ^= "$") /* not a SNUMB card image */ 229 | (substr (ascii, 8, 5) ^= "snumb") 230 then do; 231 call com_err_ (0, "gcos_read_tape_", "Expected SNUMB not found on tape ^a", tape_label); 232 call find_ejb; 233 if (eot_was_found)| (code ^= 0) /* error or end of tape */ 234 then do; 235 if code = 0 236 then call check_snumbs; 237 call wrap_up ("0"b); 238 go to RETURN; 239 end; 240 go to READ; 241 end; 242 243 if all_snumbs_wanted /* all jobs are to be executed */ 244 then do; 245 call parse_and_check_snumb; /* parse the SNUMB (no check for "all") */ 246 if code ^= 0 /* error parsing SNUMB */ 247 then do; 248 call find_ejb; 249 if code ^= 0 /* error finding eof image */ 250 then do; 251 call wrap_up ("0"b); 252 go to RETURN; 253 end; 254 go to READ; 255 end; 256 call read_and_queue; /* queue up current job */ 257 if (code > 1)| (eot_was_found) /* error or end of tape */ 258 then do; 259 call wrap_up ("0"b); 260 go to RETURN; 261 end; 262 go to READ; /* get another job */ 263 end; 264 265 if (taking_given_snumbs)| (starting_from_given_snumb) 266 then do; 267 268 call parse_and_check_snumb; /* check to see if this is needed SNUMB */ 269 if (^snumb_found)| (code ^= 0) /* SNUMB not in array or already found */ 270 then do; 271 if ^starting_snumb_found /* not a start request with first SNUMB found */ 272 then do; 273 call find_ejb; 274 if (eot_was_found)| (code ^= 0) /* error or end of tape */ 275 then do; 276 if code = 0 277 then call check_snumbs; 278 call wrap_up ("0"b); 279 go to RETURN; 280 end; 281 if ^snumb_found /* no data to update */ 282 then go to READ; /* get another job */ 283 end; 284 end; 285 286 if starting_from_given_snumb 287 then do; 288 if snumb_count = 1 /* found the only specified SNUMB */ 289 then do; 290 all_snumbs_wanted = "1"b; /* execute remaining jobs on tape */ 291 starting_from_given_snumb = "0"b; 292 end; 293 else /* start and finish SNUMB supplied */ 294 do; 295 if ^snumb_data (1).found /* error found finish before start */ 296 then do; 297 call com_err_ (0, "gcos_read_tape_", "Error in ^/^a^/^a found before ^a", 298 request, snumb_data (2).snumb, snumb_data (1).snumb); 299 call wrap_up ("0"b); 300 go to RETURN; 301 end; 302 else 303 do; 304 if found_count = 2 /* found second */ 305 then fin = "1"b; /* finished after processing this one */ 306 else /* first of 2 SNUMBs found */ 307 starting_snumb_found = "1"b; /* remember */ 308 end; 309 end; 310 end; 311 312 else /* taking specified SNUMBs */ 313 if found_count = snumb_count /* all needed SNUMBs found */ 314 then fin = "1"b; /* done */ 315 316 if code ^= 0 /* some error has occurred */ 317 then go to READ; /* don't queue up job */ 318 319 call read_and_queue; /* queue up current job */ 320 if (code > 1)| (eot_was_found) /* fatal error or end of tape */ 321 then do; 322 if code < 2 /* not fatal error */ 323 then call check_snumbs; 324 call wrap_up ("0"b); 325 go to RETURN; 326 end; 327 328 go to READ; /* get another job */ 329 330 end; 331 332 else /* deleting specified SNUMBs */ 333 do; 334 335 call parse_and_check_snumb; 336 337 if (snumb_found)| (code ^= 0) 338 then do; 339 340 call find_ejb; 341 if (code ^= 0)| (eot_was_found) /* error or end of tape */ 342 then do; 343 if code = 0 344 then call check_snumbs; 345 call wrap_up ("0"b); 346 go to RETURN; 347 end; 348 349 go to READ; 350 351 end; 352 353 else /* job to be executed */ 354 do; 355 356 call read_and_queue; 357 if (code > 1)| (eot_was_found) /* fatal error or end of tape */ 358 then do; 359 if code < 2 /* not fatal error */ 360 then call check_snumbs; 361 call wrap_up ("0"b); 362 go to RETURN; 363 end; 364 365 go to READ; 366 367 end; 368 369 end; 370 371 RETURN: 372 373 return; 374 375 /* internal procedures */ 376 377 check_snumbs: proc; 378 379 do i = 1 to snumb_count; 380 if ^snumb_data (i).found /* SNUMB was not found on tape */ 381 then call com_err_ (0, "gcos_read_tape_", "SNUMB ^a not found on tape ^a" 382 , snumb_data (i).snumb, tape_label); 383 end; 384 385 return; 386 387 end check_snumbs; 388 389 390 391 find_ejb: proc; 392 393 dcl ejb_was_found bit (1) aligned init ("0"b); 394 395 do while (^ejb_was_found); 396 call read; 397 if eot_was_found /* end of tape */ 398 then return; 399 if code ^= 0 400 then do; 401 call com_err_ (code, "gcos_read_tape_", "Error searching for $ endjob"); 402 return; 403 end; 404 405 if media_code = "0010"b /* bcd image */ 406 then if first_bcd_char = "101011"b /* "$" */ 407 then do; 408 call cv_bcd_to_ascii_ (buf_ptr, ascii_ptr); 409 if substr (ascii, 8, 6) = "endjob" /* end of job card image found */ 410 then ejb_was_found = "1"b; 411 end; 412 413 end; 414 415 return; 416 417 end find_ejb; 418 419 420 421 get_arg: proc; 422 423 do j = j to request_len while /* find beginning of next argument */ 424 ((substr (request, j, 1) = " ")| (substr (request, j, 1) = " ")); 425 end; 426 427 do k = j to request_len while /* find end of argument */ 428 ((substr (request, k, 1) ^= " ")& (substr (request, k, 1) ^= " ")); 429 end; 430 if k ^= request_len /* not last argument */ 431 then k = k - 1; /* move index back to last char in arg */ 432 433 if k < j /* no next argument */ 434 then do; 435 code = error_table_$noarg; 436 return; 437 end; 438 439 code = 0; /* there is another argument */ 440 ap = addr (request_p -> request_mask.char (j)); /* set argument pointer */ 441 al = k - j + 1; /* set argument length */ 442 j = k + 1; /* set beginning of next possible arg */ 443 444 return; 445 446 end get_arg; 447 448 449 450 parse_and_check_snumb: proc; 451 452 dcl (jj, kk, xb, xc, search_val) fixed bin aligned; 453 dcl comma_found bit (1) aligned init ("0"b); 454 455 comma_found, 456 snumb_found = "0"b; /* initialize return argument */ 457 458 xb = index (substr (ascii, 16), " "); /* locate first blank in variable field */ 459 xc = index (substr (ascii, 16), ","); /* locate first comma in variable f eld */ 460 461 if xb = 1 then 462 do; code = 1; /* return error */ 463 call com_err_ (0, "gcos_read_tape_", "A SNUMB is zero length on tape ^a", tape_label); 464 return; 465 end; 466 467 if (xc = 0 | xc>xb) then xc = xb; /* either no comma or not in SNUMB number field */ 468 /* set comma index to blank index */ 469 else comma_found = "1"b; /* remember */ 470 471 if (xb<10 & xc<7) then snumb = substr (ascii, 16, xc-1); 472 /* put SNUMB in fixed location */ 473 else 474 do; snumb = substr (ascii, 16, 8); /* report first 8 characters of SNUMB */ 475 code = 1; /* return error */ 476 call com_err_ (0, "gcos_read_tape_", 477 "SNUMB ^a too long on tape ^a", snumb, tape_label); 478 return; 479 end; 480 481 search_val = search (substr (ascii, 16, xc-1), ",$/:."); /* search for invalid characters */ 482 if (search_val ^= 0) | (substr (ascii, 16, xc-1) = substr ("00000", 1, xc-1)) then 483 do; code = 1; /* return error */ 484 call com_err_ (0, "gcos_read_tape_", 485 "Invalid characters in SNUMB ^a on tape ^a", snumb, tape_label); 486 return; 487 end; 488 489 if comma_found then 490 do; urgency = cv_dec_check_ (substr (ascii, xc+16, xb-xc-1), code); /* convert to integer */ 491 if code ^= 0 /* conversion error */ 492 then do; 493 call com_err_ (0, "gcos_read_tape_", "Invalid urgency field: SNUMB = ^a, tape ^a", 494 snumb, tape_label); 495 code = 1; 496 return; 497 end; 498 if (urgency < 1)| (urgency > 63) /* invalid urgency field */ 499 then do; 500 urgency = 5; /* set to real gcos default value */ 501 call com_err_ (0, "gcos_read_tape_", 502 "Out of bounds urgency set to default value: SNUMB = ^a, tape ^a", 503 substr (ascii, 16, xb-1), tape_label); 504 end; 505 urgency = divide (63-urgency, 21, 17, 0) + 1; /* convert to Multics priority */ 506 end; 507 else /* no urgency field */ 508 urgency = 3; /* set default */ 509 510 if ^all_snumbs_wanted /* specified SNUMBs wanted, check this one */ 511 then do jj = 1 to snumb_count while (^snumb_found); 512 if snumb = snumb_data (jj).snumb /* match found */ 513 then do; 514 snumb_found = "1"b; /* remember */ 515 if snumb_data (jj).found /* SNUMB was already found */ 516 then do; 517 call com_err_ (0, "gcos_read_tape_", "SNUMB ^a duplicated on tape ^a", snumb, tape_label); 518 code = 2; /* fatal error */ 519 end; 520 else 521 do; 522 snumb_data (jj).found = "1"b; 523 found_count = found_count + 1; /* increment count of found SNUMBs */ 524 end; 525 end; 526 527 end; 528 529 return; 530 531 end parse_and_check_snumb; 532 533 534 535 read: proc; 536 537 call gcos_gsr_read_ ("tape_input", buf_ptr, elements_read, record_header, eot_was_found, code); 538 539 return; 540 541 end read; 542 543 544 545 read_and_queue: proc; 546 gcos_daemon_stat_$snumb = rtrim (snumb); 547 call gcos_read_$tape (urgency, buf_ptr, addr (gcos_abs_data), eot_was_found, code); 548 if code ^= 0 /* error reading rest of job */ 549 then do; 550 if code ^= 1 /* error was fatal */ 551 then return; 552 if ^eot_was_found /* not end of tape */ 553 then do; 554 call find_ejb; /* find end of current job */ 555 if code = 0 /* no error finding ejb */ 556 then code = 1; /* return non-fatal error */ 557 end; 558 return; 559 end; 560 561 call gcos_queue_job_ (addr (gcos_abs_data), a_test, code); 562 if code = 0 then snumb = " "; 563 564 return; 565 566 end read_and_queue; 567 568 wrap_up: proc (cleanup_was_signalled); 569 570 dcl cleanup_was_signalled bit (1) aligned; 571 572 if (tape_is_attached|test_attach) 573 then do; 574 575 if a_test /* test entry was called */ 576 then do; /* check to see if tape should be dismounted */ 577 call command_query_ (addr (query_data), answer, "gcos_read_tape_", 578 "Should tape ^a be dismounted? ", tape_label); 579 if substr (answer, 1, 2) = "no" /* don't dismount */ 580 then do; 581 call ios_$order ("tape_input", "rewind", null, status_bits); 582 if status.code ^= 0 583 then call com_err_ (status.code, "gcos_read_tape_", 584 "Error in order call to rewind ^a", tape_label); 585 test_attach = "1"b; /* remember tape was only rewound */ 586 go to NO_DETACH; 587 end; 588 end; 589 590 call ios_$detach ("tape_input", tape_label, "", status_bits); /* detach the tape */ 591 tape_is_attached = "0"b; 592 test_attach = "0"b; /* allows another attach */ 593 if status.code ^= 0 594 then do; 595 if code < 2 /* no fatal error yet */ 596 then code = status.code; 597 call com_err_ (status.code, "gcos_read_tape_", "Error detaching tape ^a", tape_label); 598 end; 599 600 end; 601 602 NO_DETACH: 603 604 if gsr_read_init_called 605 then do; 606 call gcos_gsr_read_$gsr_read_close ("tape_input", code); 607 gsr_read_init_called = "0"b; 608 end; 609 610 if (code ^= 0)| (cleanup_was_signalled) /* an error occurred or job was aborted */ 611 then do; 612 i = index (snumb, " ") - 1; 613 if i < 1 614 then return; 615 call hcs_$delentry_file (get_wdir_ (), substr (snumb, 1, i)||".gcos", code); 616 end; 617 618 return; 619 620 end wrap_up; 621 622 /* DECLARATIONS */ 623 /* ------------ */ 624 625 626 /* fixed bin */ 627 628 629 dcl ( 630 a_request_len, /* length of tape command (argument) */ 631 al, /* argument length */ 632 arg_num init (0), /* argument count from command line */ 633 elements_read, /* number of elements read in ios call */ 634 found_count init (0), /* count of SNUMBs found on tape */ 635 i, /* loop index */ 636 j init (1), /* loop index */ 637 k init (0), /* loop index */ 638 request_len, /* length of tape command (internal) */ 639 snumb_count init (0), /* number of SNUMBs in tape command */ 640 urgency /* computed urgency from SNUMB image */ 641 ) fixed bin aligned; 642 643 dcl ( 644 code, /* error code */ 645 error_table_$namedup ext, 646 error_table_$noarg ext 647 ) fixed bin (35) aligned; 648 649 650 /* pointers */ 651 652 dcl ( 653 ap, /* argument pointer */ 654 ascii_ptr, /* pointer to ascii version of card image */ 655 bcd_ptr, /* pointer to bcd version of card image */ 656 buf_ptr, /* pointer to tape record read by gcos_gsr_read_ */ 657 rh_ptr, /* pointer to returned status from gcos_gsr_read_ */ 658 request_p, /* pointer to request line */ 659 sp /* pointer to status returned from ios calls */ 660 ) pointer aligned; 661 662 663 /* bit strings */ 664 665 dcl ( 666 a_test /* ON when deamon brought up by user */ 667 ) bit (1) aligned; 668 669 dcl ( 670 all_snumbs_wanted, /* ON when every job found will be queued */ 671 eot_was_found, /* ON when end of tape is encountered */ 672 fin, /* ON when all given SNUMBs are found */ 673 gsr_read_init_called, /* ON once gcos_gsr_read_$gsr_read_init has been called */ 674 last_image_was_eof, /* ON when last card image was "***eof" */ 675 snumb_found, /* ON when a SNUMB is found on tape */ 676 starting_from_given_snumb, /* ON when start imcv request is made */ 677 starting_snumb_found, /* ON when 1st of 2 SNUMBs in "start" found */ 678 taking_given_snumbs, /* ON when take imcv request is made */ 679 tape_is_attached, /* ON when tape is attached */ 680 test_attach int static /* ON when tape is rewound, not detached */ 681 ) bit (1) aligned init ("0"b); 682 683 dcl ( 684 record_header /* returned status from gcos_gsr_read_ */ 685 ) bit (12) aligned; 686 687 dcl ( 688 normal_termination /* ON until tape terminates abnormally */ 689 ) bit (1) aligned init ("1"b); 690 691 dcl ( 692 status_bits /* status returned from ios calls */ 693 ) bit (72) aligned; 694 695 dcl ( 696 b972 /* image read from tape */ 697 ) bit (972) aligned; 698 699 700 /* character strings */ 701 702 dcl ( 703 answer /* answer to command_query_ call */ 704 ) char (4) aligned; 705 706 dcl gcos_daemon_stat_$snumb ext char (6) aligned; 707 708 dcl ( 709 gcos_daemon_stat_$tape_dim ext, /* variable dim name for easy testing */ 710 snumb init (""), /* SNUMB on current card */ 711 tape_type /* = ",7track" or ",9track" */ 712 ) char (8) aligned; 713 714 dcl ( 715 tape_label init ("") /* name of tape */ 716 ) char (32) aligned; 717 718 dcl ( 719 ascii /* ascii version of card */ 720 ) char (80) aligned; 721 722 dcl ( 723 a_request, /* imcv command (argument) */ 724 request /* imcv command (internal) */ 725 ) char (120) aligned; 726 727 728 /* built in functions */ 729 730 dcl ( 731 addr, 732 divide, 733 index, 734 null, 735 substr 736 ) builtin; 737 738 739 /* structures */ 740 dcl 1 query_data aligned, /* structure for command_query_ call */ 741 2 version fixed bin aligned init (2), 742 2 yes_or_no_switch bit (1) aligned init ("1"b), 743 2 suppress_name_switch bit (1) aligned init ("1"b), 744 2 status_code fixed bin (35) aligned, 745 2 query_code fixed bin (35) aligned; 746 747 dcl 1 snumb_data (5) aligned, /* snumb data taken from command */ 748 2 snumb char (8) aligned, /* given SNUMB */ 749 2 found bit (1) aligned init ((5) (1) "0"b); /* ON once SNUMB is found on tape */ 750 751 752 /* masks */ 753 754 dcl arg char (al) based (ap) unaligned; /* argument taken from command line or console */ 755 756 dcl first_bcd_char bit (6) unaligned based (buf_ptr); /* first bcd character on card image */ 757 758 dcl input bit (612) unaligned based (buf_ptr); /* pointer to bcd image */ 759 760 dcl 1 record_header_mask aligned based (rh_ptr), 761 2 pad bit (2) unaligned, 762 2 media_code bit (4) unaligned, 763 2 report_code bit (6) unaligned; 764 765 dcl 1 request_mask aligned based, /* for looking at request character by character */ 766 2 char (request_len) char (1) unaligned; 767 768 dcl 1 status based (sp) aligned, /* returned status from ios calls */ 769 2 code fixed bin (35) aligned, /* error code */ 770 2 pad bit (9) unaligned, 771 2 eof bit (1) unaligned; 772 773 774 /* conditions */ 775 776 dcl ( 777 cleanup 778 ) condition; 779 780 781 /* external entries */ 782 783 dcl com_err_ ext entry 784 options (variable); 785 786 dcl command_query_ ext entry 787 options (variable); 788 789 dcl cv_bcd_to_ascii_ ext entry 790 (ptr aligned, ptr aligned); 791 792 dcl cv_dec_check_ ext entry 793 (char (*) aligned, fixed bin (35) aligned) returns (fixed bin aligned); 794 795 dcl gcos_queue_job_ ext entry 796 (ptr aligned, bit (1) aligned, fixed bin (35) aligned); 797 798 dcl gcos_read_$tape ext entry 799 (fixed bin aligned, ptr aligned, ptr aligned, bit (1)aligned, fixed bin (35)aligned); 800 801 dcl get_wdir_ ext entry 802 returns (char (168) aligned); 803 804 dcl gcos_gsr_read_ ext entry 805 (char (*) aligned, ptr aligned, fixed bin aligned, bit (12) aligned, bit (1) aligned, fixed bin (35) aligned); 806 807 dcl gcos_gsr_read_$gsr_read_close ext entry 808 (char (*) aligned, fixed bin (35) aligned); 809 810 dcl gcos_gsr_read_$gsr_read_init ext entry 811 (char (*) aligned, fixed bin (35) aligned); 812 813 dcl hcs_$delentry_file ext entry 814 (char (*) aligned, char (*) aligned, fixed bin (35) aligned); 815 816 dcl ios_$attach ext entry 817 (char (*) aligned, char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); 818 819 dcl ios_$detach ext entry 820 (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); 821 822 dcl ios_$order ext entry 823 (char (*) aligned, char (*) aligned, ptr aligned, bit (72) aligned); 824 825 dcl ios_$read ext entry 826 (char (*) aligned, ptr aligned, fixed bin aligned, fixed bin aligned, fixed bin aligned, bit (72) aligned); 827 1 1 /* BEGIN gcos_abs_data include file */ 1 2 1 3 dcl abs_data_ptr ptr int static; /* pointer to absentee data */ 1 4 1 5 dcl abs_data_len int static fixed bin aligned; /* bit length of data structure */ 1 6 1 7 dcl 1 abs_data aligned based (abs_data_ptr), /* mask for data */ 1 8 2 absentee_dir char (168) aligned, /* directory to which to direct absentee output */ 1 9 2 home_dir char (168) aligned, /* home directory of absentee user */ 1 10 2 input_segment_name char (32) aligned, /* name of created input segment */ 1 11 2 user_name char (32) aligned, /* proxy name */ 1 12 2 priority_queue fixed bin aligned, /* queue number for absentee and output */ 1 13 2 absentee_options aligned, /* ON if option specified */ 1 14 3 deferral_switch bit (1) unaligned, /* ON if job deferral specified */ 1 15 2 absentee_data aligned, 1 16 3 deferral fixed bin (71) aligned, /* time job deferred to */ 1 17 2 end_abs_data fixed bin aligned; 1 18 1 19 dcl data_blank bit (abs_data_len) aligned based (abs_data_ptr); 1 20 1 21 /* END gcos_abs_data include file */ 828 829 2 1 /* BEGIN gcos_abs_data_storage include file */ 2 2 2 3 dcl 1 gcos_abs_data like abs_data; /* storage for absentee data */ 2 4 2 5 /* END gcos_abs_data_storage include file */ 830 831 832 end gcos_read_tape_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/19/82 0853.2 gcos_read_tape_.pl1 >spec>on>11/19/82>gcos_read_tape_.pl1 828 1 03/27/82 0439.3 gcos_abs_data.incl.pl1 >ldd>include>gcos_abs_data.incl.pl1 830 2 03/27/82 0439.3 gcos_abs_data_storage.incl.pl1 >ldd>include>gcos_abs_data_storage.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. a_request parameter char(120) dcl 722 ref 19 33 a_request_len parameter fixed bin(17,0) dcl 629 ref 19 34 a_test parameter bit(1) dcl 665 set ref 19 561* 575 abs_data based structure level 1 dcl 1-7 addr builtin function dcl 730 ref 21 22 23 24 25 26 440 547 547 561 561 577 577 al 000100 automatic fixed bin(17,0) dcl 629 set ref 38 44 63 72 72 76 76 80 80 84 84 87 87 110 112 112 124 131 441* all_snumbs_wanted 000132 automatic bit(1) initial dcl 669 set ref 72* 94 101 206 243 290* 510 669* answer 000203 automatic char(4) dcl 702 set ref 577* 579 ap 000114 automatic pointer dcl 652 set ref 21* 38 44 63 72 72 76 76 80 80 84 84 87 112 124 131 440* arg based char unaligned dcl 754 set ref 38 44 63 72 72 76 76 80 80 84 84 87* 112* 124 131 arg_num 000101 automatic fixed bin(17,0) initial dcl 629 set ref 629* ascii 000220 automatic char(80) dcl 718 set ref 22 214 228 228 409 458 459 471 474 481 482 490 490 501 501 ascii_ptr 000116 automatic pointer dcl 652 set ref 22* 212* 408* b972 000150 automatic bit(972) dcl 695 set ref 23 bcd_ptr 000120 automatic pointer dcl 652 set ref 23* 165* buf_ptr 000122 automatic pointer dcl 652 set ref 212* 405 408* 537* 547* char based char(1) array level 2 packed unaligned dcl 765 set ref 440 cleanup 000326 stack reference condition dcl 776 ref 28 cleanup_was_signalled parameter bit(1) dcl 570 ref 568 610 code 000112 automatic fixed bin(35,0) dcl 643 in procedure "gcos_read_tape_" set ref 58 60* 66 68* 92 104* 108 143* 144 146* 153* 154 156* 197 199* 233 235 246 249 257 269 274 276 316 320 322 337 341 343 357 359 399 401* 435* 439* 462* 475* 483* 490* 491 495* 518* 537* 547* 548 550 555 555* 561* 562 595 595* 606* 610 615* code based fixed bin(35,0) level 2 in structure "status" dcl 768 in procedure "gcos_read_tape_" set ref 143 178 181* 582 582* 593 595 597* com_err_ 000022 constant entry external dcl 783 ref 53 60 68 87 96 104 112 119 126 146 156 170 181 199 218 231 297 380 401 463 476 484 493 501 517 582 597 comma_found 000552 automatic bit(1) initial dcl 453 set ref 453* 455* 469* 489 command_query_ 000024 constant entry external dcl 786 ref 577 cv_bcd_to_ascii_ 000026 constant entry external dcl 789 ref 212 408 cv_dec_check_ 000030 constant entry external dcl 792 ref 490 divide builtin function dcl 730 ref 505 ejb_was_found 000526 automatic bit(1) initial dcl 393 set ref 393* 395 409* elements_read 000102 automatic fixed bin(17,0) dcl 629 set ref 165* 537* eot_was_found 000133 automatic bit(1) initial dcl 669 set ref 204 233 257 274 320 341 357 397 537* 547* 552 669* error_table_$namedup 000012 external static fixed bin(35,0) dcl 643 set ref 126* error_table_$noarg 000014 external static fixed bin(35,0) dcl 643 ref 58 66 435 fin 000134 automatic bit(1) initial dcl 669 set ref 188 304* 312* 669* first_bcd_char based bit(6) unaligned dcl 756 ref 405 found 2 000307 automatic bit(1) initial array level 2 dcl 747 set ref 295 380 515 522* 747* 747* 747* 747* 747* found_count 000103 automatic fixed bin(17,0) initial dcl 629 set ref 304 312 523* 523 629* gcos_abs_data 000334 automatic structure level 1 unaligned dcl 2-3 set ref 547 547 561 561 gcos_daemon_stat_$snumb 000016 external static char(6) dcl 706 set ref 546* gcos_daemon_stat_$tape_dim 000020 external static char(8) dcl 708 set ref 142* gcos_gsr_read_ 000040 constant entry external dcl 804 ref 537 gcos_gsr_read_$gsr_read_close 000042 constant entry external dcl 807 ref 606 gcos_gsr_read_$gsr_read_init 000044 constant entry external dcl 810 ref 153 gcos_queue_job_ 000032 constant entry external dcl 795 ref 561 gcos_read_$tape 000034 constant entry external dcl 798 ref 547 get_wdir_ 000036 constant entry external dcl 801 ref 615 615 gsr_read_init_called 000135 automatic bit(1) initial dcl 669 set ref 160* 602 607* 669* hcs_$delentry_file 000046 constant entry external dcl 813 ref 615 i 000104 automatic fixed bin(17,0) dcl 629 set ref 41* 48* 123* 124* 163* 379* 380 380* 612* 613 615 index builtin function dcl 730 ref 458 459 612 ios_$attach 000050 constant entry external dcl 816 ref 142 ios_$detach 000052 constant entry external dcl 819 ref 590 ios_$order 000054 constant entry external dcl 822 ref 581 ios_$read 000056 constant entry external dcl 825 ref 165 j 000105 automatic fixed bin(17,0) initial dcl 629 set ref 423* 423 423 423* 427 433 440 441 442* 629* jj 000546 automatic fixed bin(17,0) dcl 452 set ref 510* 512 515 522* k 000106 automatic fixed bin(17,0) initial dcl 629 set ref 427* 427 427* 430 430* 430 433 441 442 629* last_image_was_eof 000136 automatic bit(1) initial dcl 669 set ref 216 222* 225* 669* media_code 0(02) based bit(4) level 2 packed unaligned dcl 760 ref 405 normal_termination 000145 automatic bit(1) initial dcl 687 set ref 687* null builtin function dcl 730 ref 581 581 query_data 000302 automatic structure level 1 dcl 740 set ref 577 577 record_header 000144 automatic bit(12) dcl 683 set ref 24 537* record_header_mask based structure level 1 dcl 760 request 000244 automatic char(120) dcl 722 set ref 21 25 33* 53* 60* 68* 96* 104* 119* 126* 297* 423 423 427 427 request_len 000107 automatic fixed bin(17,0) dcl 629 set ref 34* 423 427 430 request_mask based structure level 1 dcl 765 request_p 000126 automatic pointer dcl 652 set ref 25* 440 rh_ptr 000124 automatic pointer dcl 652 set ref 24* 405 search_val 000551 automatic fixed bin(17,0) dcl 452 set ref 481* 482 snumb 000307 automatic char(8) array level 2 in structure "snumb_data" dcl 747 in procedure "gcos_read_tape_" set ref 124 131* 297* 297* 380* 512 snumb 000204 automatic char(8) initial dcl 708 in procedure "gcos_read_tape_" set ref 471* 474* 476* 484* 493* 512 517* 546 562* 612 615 708* snumb_count 000110 automatic fixed bin(17,0) initial dcl 629 set ref 116* 116 117 117 123 131 288 312 379 510 629* snumb_data 000307 automatic structure array level 1 dcl 747 snumb_found 000137 automatic bit(1) initial dcl 669 set ref 269 281 337 455* 510 514* 669* sp 000130 automatic pointer dcl 652 set ref 26* 143 178 181 582 582 593 595 597 starting_from_given_snumb 000140 automatic bit(1) initial dcl 669 set ref 80* 117 265 286 291* 669* starting_snumb_found 000141 automatic bit(1) initial dcl 669 set ref 271 306* 669* status based structure level 1 dcl 768 status_bits 000146 automatic bit(72) dcl 691 set ref 26 142* 165* 166 168 170 170 170 170 581* 590* substr builtin function dcl 730 ref 166 168 170 170 170 170 214 228 228 409 423 423 427 427 458 459 471 474 481 482 482 490 490 501 501 579 615 suppress_name_switch 2 000302 automatic bit(1) initial level 2 dcl 740 set ref 740* taking_given_snumbs 000142 automatic bit(1) initial dcl 669 set ref 76* 265 669* tape_is_attached 000143 automatic bit(1) initial dcl 669 set ref 149* 572 591* 669* tape_label 000210 automatic char(32) initial dcl 714 set ref 63* 142* 146* 181* 218* 231* 380* 463* 476* 484* 493* 501* 517* 577* 582* 590* 597* 714* tape_type 000206 automatic char(8) dcl 708 set ref 40* 47* 63 test_attach 000010 internal static bit(1) initial dcl 669 set ref 139 572 585* 592* urgency 000111 automatic fixed bin(17,0) dcl 629 set ref 490* 498 498 500* 505* 505 507* 547* version 000302 automatic fixed bin(17,0) initial level 2 dcl 740 set ref 740* xb 000547 automatic fixed bin(17,0) dcl 452 set ref 458* 461 467 467 471 490 490 501 501 xc 000550 automatic fixed bin(17,0) dcl 452 set ref 459* 467 467 467* 471 471 481 482 482 490 490 490 490 yes_or_no_switch 1 000302 automatic bit(1) initial level 2 dcl 740 set ref 740* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. abs_data_len internal static fixed bin(17,0) dcl 1-5 abs_data_ptr internal static pointer dcl 1-3 data_blank based bit dcl 1-19 input based bit(612) unaligned dcl 758 kk automatic fixed bin(17,0) dcl 452 NAMES DECLARED BY EXPLICIT CONTEXT. NO_DETACH 004416 constant label dcl 602 ref 586 READ 002104 constant label dcl 188 ref 223 240 254 262 281 316 328 349 365 RETURN 002712 constant label dcl 371 ref 54 61 69 88 97 105 113 120 127 147 158 174 183 193 201 209 220 238 252 260 279 300 325 346 362 check_snumbs 002713 constant entry internal dcl 377 ref 206 235 276 322 343 359 find_ejb 002775 constant entry internal dcl 391 ref 232 248 273 340 554 gcos_read_tape_ 000450 constant entry external dcl 19 get_arg 003076 constant entry internal dcl 421 ref 36 57 65 91 133 parse_and_check_snumb 003170 constant entry internal dcl 450 ref 245 268 335 read 003755 constant entry internal dcl 535 ref 196 396 read_and_queue 004020 constant entry internal dcl 545 ref 256 319 356 wrap_up 004123 constant entry internal dcl 568 ref 28 157 173 182 192 200 208 219 237 251 259 278 299 324 345 361 NAMES DECLARED BY CONTEXT OR IMPLICATION. rtrim builtin function ref 546 search builtin function ref 481 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 5202 5262 4736 5212 Length 5544 4736 60 245 243 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME gcos_read_tape_ 646 external procedure is an external procedure. on unit on line 28 72 on unit check_snumbs internal procedure shares stack frame of external procedure gcos_read_tape_. find_ejb internal procedure shares stack frame of external procedure gcos_read_tape_. get_arg internal procedure shares stack frame of external procedure gcos_read_tape_. parse_and_check_snumb internal procedure shares stack frame of external procedure gcos_read_tape_. read internal procedure shares stack frame of external procedure gcos_read_tape_. read_and_queue internal procedure shares stack frame of external procedure gcos_read_tape_. wrap_up 146 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 test_attach gcos_read_tape_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME gcos_read_tape_ 000100 al gcos_read_tape_ 000101 arg_num gcos_read_tape_ 000102 elements_read gcos_read_tape_ 000103 found_count gcos_read_tape_ 000104 i gcos_read_tape_ 000105 j gcos_read_tape_ 000106 k gcos_read_tape_ 000107 request_len gcos_read_tape_ 000110 snumb_count gcos_read_tape_ 000111 urgency gcos_read_tape_ 000112 code gcos_read_tape_ 000114 ap gcos_read_tape_ 000116 ascii_ptr gcos_read_tape_ 000120 bcd_ptr gcos_read_tape_ 000122 buf_ptr gcos_read_tape_ 000124 rh_ptr gcos_read_tape_ 000126 request_p gcos_read_tape_ 000130 sp gcos_read_tape_ 000132 all_snumbs_wanted gcos_read_tape_ 000133 eot_was_found gcos_read_tape_ 000134 fin gcos_read_tape_ 000135 gsr_read_init_called gcos_read_tape_ 000136 last_image_was_eof gcos_read_tape_ 000137 snumb_found gcos_read_tape_ 000140 starting_from_given_snumb gcos_read_tape_ 000141 starting_snumb_found gcos_read_tape_ 000142 taking_given_snumbs gcos_read_tape_ 000143 tape_is_attached gcos_read_tape_ 000144 record_header gcos_read_tape_ 000145 normal_termination gcos_read_tape_ 000146 status_bits gcos_read_tape_ 000150 b972 gcos_read_tape_ 000203 answer gcos_read_tape_ 000204 snumb gcos_read_tape_ 000206 tape_type gcos_read_tape_ 000210 tape_label gcos_read_tape_ 000220 ascii gcos_read_tape_ 000244 request gcos_read_tape_ 000302 query_data gcos_read_tape_ 000307 snumb_data gcos_read_tape_ 000334 gcos_abs_data gcos_read_tape_ 000526 ejb_was_found find_ejb 000546 jj parse_and_check_snumb 000547 xb parse_and_check_snumb 000550 xc parse_and_check_snumb 000551 search_val parse_and_check_snumb 000552 comma_found parse_and_check_snumb THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_ne_as alloc_cs call_ext_out_desc call_ext_out call_int_this call_int_other return enable shorten_stack ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ command_query_ cv_bcd_to_ascii_ cv_dec_check_ gcos_gsr_read_ gcos_gsr_read_$gsr_read_close gcos_gsr_read_$gsr_read_init gcos_queue_job_ gcos_read_$tape get_wdir_ hcs_$delentry_file ios_$attach ios_$detach ios_$order ios_$read THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$namedup error_table_$noarg gcos_daemon_stat_$snumb gcos_daemon_stat_$tape_dim LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 19 000444 629 000455 669 000463 687 000475 708 000477 714 000501 740 000504 747 000511 21 000536 22 000540 23 000542 24 000544 25 000546 26 000550 28 000552 33 000600 34 000605 36 000607 38 000610 40 000616 41 000620 42 000622 44 000623 47 000627 48 000631 49 000633 53 000634 54 000673 57 000674 58 000675 60 000701 61 000741 63 000742 65 000760 66 000762 68 000766 69 001023 72 001024 76 001041 80 001054 84 001067 87 001077 88 001143 91 001144 92 001145 94 001147 96 001151 97 001210 99 001211 101 001212 104 001214 105 001255 108 001256 110 001260 112 001263 113 001324 116 001325 117 001326 119 001335 120 001374 123 001375 124 001404 126 001414 127 001451 129 001452 131 001454 133 001464 135 001465 139 001466 142 001471 143 001527 144 001531 146 001532 147 001573 149 001574 153 001576 154 001617 156 001621 157 001653 158 001663 160 001664 163 001666 165 001673 166 001735 168 001741 170 001746 173 002014 174 002024 176 002025 178 002026 181 002030 182 002071 183 002101 186 002102 188 002104 192 002106 193 002116 196 002117 197 002120 199 002122 200 002157 201 002167 204 002170 206 002173 208 002176 209 002206 212 002207 214 002220 216 002224 218 002226 219 002265 220 002275 222 002276 223 002300 225 002301 228 002302 231 002313 232 002352 233 002353 235 002360 237 002363 238 002373 240 002374 243 002375 245 002377 246 002400 248 002402 249 002403 251 002405 252 002415 254 002416 256 002417 257 002420 259 002426 260 002436 262 002437 265 002440 268 002444 269 002445 271 002451 273 002453 274 002454 276 002461 278 002464 279 002474 281 002475 286 002477 288 002501 290 002504 291 002506 292 002507 295 002510 297 002512 299 002561 300 002571 304 002572 306 002600 310 002602 312 002603 316 002610 319 002612 320 002613 322 002621 324 002624 325 002634 328 002635 335 002636 337 002637 340 002643 341 002644 343 002651 345 002654 346 002664 349 002665 356 002666 357 002667 359 002675 361 002700 362 002710 365 002711 371 002712 377 002713 379 002714 380 002723 383 002772 385 002774 391 002775 393 002776 395 002777 396 003001 397 003002 399 003006 401 003010 402 003042 405 003043 408 003055 409 003066 413 003074 415 003075 421 003076 423 003077 425 003116 427 003120 429 003135 430 003137 433 003143 435 003146 436 003151 439 003152 440 003153 441 003161 442 003164 444 003167 450 003170 453 003171 455 003172 458 003174 459 003205 461 003216 462 003221 463 003223 464 003262 467 003263 469 003272 471 003274 474 003310 475 003313 476 003315 478 003360 481 003361 482 003373 483 003401 484 003403 486 003446 489 003447 490 003451 491 003505 493 003510 495 003553 496 003555 498 003556 500 003563 501 003565 504 003641 505 003642 506 003647 507 003650 510 003652 512 003665 514 003675 515 003677 517 003701 518 003744 519 003746 522 003747 523 003751 527 003752 529 003754 535 003755 537 003756 539 004017 545 004020 546 004021 547 004041 548 004061 550 004063 552 004066 554 004071 555 004072 558 004076 561 004077 562 004115 564 004121 568 004122 572 004130 575 004135 577 004141 579 004204 581 004211 582 004246 585 004306 586 004311 590 004312 591 004343 592 004345 593 004347 595 004351 597 004356 602 004416 606 004421 607 004442 610 004444 612 004452 613 004462 615 004465 616 004532 618 004533 ----------------------------------------------------------- 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