COMPILATION LISTING OF SEGMENT gcos_read_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/19/82 1000.9 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* WRITTEN BY: P. Haber MAR 21 74 13* MODIFIED BY: R.H. Morrison MAY 22 74 14* MAR 75 15* MODIFIED BY: Bob May JUL 18 78 To allow IMCV tapes to use ***EOF 16* cards instead of $ENDJOB cards 17* (see GEIN PLM). A dummy $ENDJOB 18* card is written to the JCL 19* instead of the ***EOF card. 20* 21* Also to allow placement of the 22* $IDENT card anywhere in the job 23* deck. This change eliminated the 24* use of the "first_read" switch 25* and replaced it with an 26* "ident_found" switch. 27* 28* MODIFIED BY: Scott C. Akers MAR 30 82 To give operator the option of 29* resolving duplicate SNUMBs. 30* 31* MODIFIED BY: Scott C. Akers MAR 31 82 To use gcos_daemon_stat_$snumb 32* 33**/ 34 35 gcos_read_: proc; 36 37 cards: entry (a_urgency, a_input_ptr, a_abs_data_ptr, a_eof_found, a_code); 38 39 reading_cards = "1"b; 40 stream_name = "card_input"; 41 card_no = 1; /* First card is snumb */ 42 43 go to COMMON; 44 45 46 tape: entry (a_urgency, a_input_ptr, a_abs_data_ptr, a_eof_found, a_code); 47 48 reading_cards = "0"b; 49 stream_name = "tape_input"; 50 51 COMMON: ; 52 53 rh_ptr = addr (record_header); /* pointer for looking at record header */ 54 sp = addr (status_stuff); /* pointer to returned status from ios_ calls */ 55 56 on condition (cleanup) /* establish cleanup condition handler */ 57 call end_work; 58 59 if ^initialized /* first call */ 60 then do; /* initialize internal directory info */ 61 input_dir = substr (gcos_daemon_stat_$input_dir, 1, gcos_daemon_stat_$input_dir_len); 62 pool_dir = substr (gcos_daemon_stat_$pool_dir, 1, gcos_daemon_stat_$pool_dir_len); 63 root_dir_len = gcos_daemon_stat_$root_dir_len; 64 root_dir = substr (gcos_daemon_stat_$root_dir, 1, root_dir_len); 65 default_home_dir = substr (gcos_daemon_stat_$default_home_dir, 1, 66 gcos_daemon_stat_$default_home_dir_len); 67 user_ring = fixed (get_ring_ (), 17); /* set for effmode calls later */ 68 abs_data_len = (fixed (rel (addr (a_abs_data_ptr -> abs_data.end_abs_data)), 17) - 69 fixed (rel (addr (a_abs_data_ptr -> abs_data)), 17)) * 36; /* set abs data length */ 70 my_name = get_group_id_$tag_star (); /* remember proc id */ 71 initialized = "1"b; 72 end; 73 74 abs_data_ptr = a_abs_data_ptr; 75 data_blank = "0"b; /* initialize absentee data */ 76 code = 0; /* initialize internal error code */ 77 78 segment_name = ""; /* initialize internal variables */ 79 input_ptr = addr (input); 80 ascii_ptr = addr (ascii); 81 priority_queue = a_urgency; 82 write_ptr = a_input_ptr; /* first write is of bcd snumb card argument */ 83 write_size = 14; /* = 14 36 bit words */ 84 85 segment_name = rtrim (gcos_daemon_stat_$snumb)||".*"; /* make star name */ 86 87 report_code = "0"b; /* set record header for first write */ 88 media_code = "0010"b; /* bcd image */ 89 90 do dir_name = input_dir, pool_dir; /* check directories for similarly named segment */ 91 92 call check_entry; /* see if SNUMB is already on system */ 93 if code ^= 0 /* error or SNUMB already exists */ 94 then go to RETURN; 95 96 end; 97 98 segment_name = rtrim (gcos_daemon_stat_$snumb) || ".gcos"; /* set default segment name */ 99 100 call ios_$attach ("segment_output", "file_", segment_name, "w", status_stuff); /* attach segment */ 101 code = status.code; /* check error code */ 102 if code ^= 0 /* error attaching segment */ 103 then do; 104 call com_err_ (code, "gcos_read_", "Error attaching to segment_output stream"); 105 go to RETURN; 106 end; 107 else /* no error */ 108 output_is_attached = "1"b; /* for condition handler */ 109 110 call ios_$setsize ("segment_output", 36, status_stuff); /* set element size for writing */ 111 code = status.code; /* check code */ 112 if code ^= 0 /* error setting size */ 113 then do; 114 call com_err_ (code, "gcos_read_", "Error setting element size on segment_output stream"); 115 go to DETACH; 116 end; 117 118 call gcos_gsr_write_$gsr_write_init ("segment_output", code); /* initialize write package */ 119 if code ^= 0 /* error initializing write routine */ 120 then do; 121 call com_err_ (code, "gcos_read_", 122 "Error in call to gsr_write_init: SNUMB = ^a", 123 gcos_daemon_stat_$snumb); 124 go to DETACH; 125 end; 126 else /* no error */ 127 gsr_write_init_called = "1"b; /* remember it was called */ 128 129 130 131 WRITE: 132 133 call gcos_gsr_write_ ("segment_output", write_ptr, write_size, record_header, ejb_found, code); 134 /* write the binary or bcd image */ 135 if code ^= 0 /* error writing */ 136 then do; 137 call com_err_ (code, "gcos_read_", "Error from gsr_write: SNUMB = ^a", gcos_daemon_stat_$snumb); 138 go to DETACH; 139 end; 140 141 if ejb_found /* end of job found */ 142 then do; 143 gsr_write_init_called = "0"b; /* ejb switch closed out file */ 144 go to DETACH; 145 end; 146 147 dollar_card = "0"b; 148 149 if reading_cards 150 then do; 151 152 card_no = card_no + 1; /* Keep count of cards read */ 153 call ios_$read (stream_name, input_ptr, 0, 1, elements_read, status_stuff); 154 code = status.code; /* check code */ 155 if code ^= 0 /* error reading */ 156 then do; 157 call com_err_ (code, "gcos_read_", "Error reading from ^a: SNUMB = ^a", stream_name, gcos_daemon_stat_$snumb); 158 go to DETACH; 159 end; 160 if status.eof /* last card and "last batch" button */ 161 then do; 162 call com_err_ (0, "gcos_read_", "Unexpected end of card input: SNUMB = ^a", gcos_daemon_stat_$snumb); 163 code = 2; /* fatal error */ 164 go to DETACH; 165 end; 166 167 write_ptr = input_ptr; /* set pointer for writing */ 168 169 if substr (input, 10, 3) ^= "101"b /* check for non-binary card */ 170 then do; 171 172 call cv_bin_to_bcd_ (input_ptr, input_ptr, code); /* convert to bcd */ 173 if code ^= 0 174 then do; 175 call com_err_ (0, "gcos_read_", "Error converting card ^i to bcd: SNUMB = ^a", 176 card_no, gcos_daemon_stat_$snumb); 177 go to DETACH; 178 end; 179 180 write_size = 14; 181 media_code = "0010"b; /* bcd image */ 182 if substr (input, 1, 6) = "101011"b /* "$" */ 183 then dollar_card = "1"b; 184 end; 185 186 else /* binary image */ 187 do; 188 media_code = "0001"b; 189 write_size = 27; 190 end; 191 192 report_code = "0"b; 193 194 end; 195 196 else /* reading from tape */ 197 do; 198 199 if eof_found /* error, attempt to read past eof */ 200 then do; 201 call com_err_ (0, "gcos_read_", "Unexpected eof on tape: SNUMB = ^a", gcos_daemon_stat_$snumb); 202 code = 2; /* return fatal error */ 203 go to DETACH; 204 end; 205 206 call gcos_gsr_read_ (stream_name, write_ptr, write_size, record_header, eof_found, code); 207 if code ^= 0 /* error reading from tape */ 208 then do; 209 call com_err_ (code, "gcos_read_", "Error from gcos_gsr_read_, SNUMB = ^a", gcos_daemon_stat_$snumb); 210 go to DETACH; 211 end; 212 213 /* BCD */ 214 if media_code = "0010"b /* bcd card */ 215 216 /* $ */ 217 then if first_bcd_char = "101011"b /* = $ */ 218 then dollar_card = "1"b; 219 220 /* ***EOF */ 221 else if substr (tape_input_record, 1, 36) = "545454254626"b3 222 then do; 223 substr (tape_input_record, 1, 252) = (42) "20"b3; /* init bcd string to blanks, in two parts, */ 224 substr (tape_input_record, 253, 252) = (42) "20"b3; /* to get around PL/I restriction */ 225 substr (tape_input_record, 1, 126) = 226 "532020202020202545244146222020545454254626"b3; /* "$ ENDJOB ***EOF" */ 227 ejb_found = "1"b; /* same as for $ENDJOB */ 228 go to WRITE; 229 end; 230 231 232 end; 233 234 if dollar_card /* image is a $ card image */ 235 then do; 236 237 call cv_bcd_to_ascii_ (write_ptr, ascii_ptr); /* convert card image to ascii */ 238 239 /* SNUMB */ 240 if substr (ascii, 8, 5) = "snumb" /* error, SNUMB card in job stream */ 241 then do; 242 call com_err_ (0, "gcos_read_", "SNUMB card found in job stream"); 243 code = 2; /* return fatal error */ 244 go to DETACH; 245 end; 246 247 /* ENDCOPY */ 248 249 if substr (ascii, 8, 7) = "endcopy" /* endcopy card */ 250 then do; 251 card_is_data = "0"b; /* following cards are not data */ 252 go to WRITE; 253 end; 254 255 /* DATA CHECK */ 256 257 if card_is_data /* in between data and endcopy card */ 258 then go to WRITE; /* ignore card */ 259 260 /* ENDJOB */ 261 262 if substr (ascii, 8, 6) = "endjob" /* end of job card */ 263 then do; 264 ejb_found = "1"b; 265 go to WRITE; 266 end; 267 268 /* DATA */ 269 270 if substr (ascii, 8, 4) = "data" /* data card */ 271 then do; 272 if substr (ascii, 20, 1) = "," /* there is a second field on the card image */ 273 then do; 274 do i = 17 to 70 while (substr (ascii, i, 1) ^= ","); /* check for third field */ 275 end; 276 if i < 70 /* third field exists */ 277 then if substr (ascii, i+1, 4) = "copy" /* it contains the copy option */ 278 then card_is_data = "1"b; /* following cards are data */ 279 end; 280 go to WRITE; 281 end; 282 283 /* IDENT */ 284 285 if substr (ascii, 8, 5) = "ident" /* ident card */ 286 then if ^ident_found /* use first $IDENT card only */ 287 then do; 288 ident_found = "1"b; /* checked at end of current job stream */ 289 290 do j = 16 to 80 while (substr (ascii, j, 1) ^= ","); /* look for end of epa number */ 291 end; 292 if (j = 16)| (j>79) /* format error */ 293 then do; 294 code = 1; /* return non-fatal error */ 295 call com_err_ (0, "gcos_read_", "Format error on ident card: SNUMB = ^a", gcos_daemon_stat_$snumb); 296 go to DETACH; 297 end; 298 epa_num = substr (ascii, 16, j-16); /* pick off epa number */ 299 300 call gcos_user_$validate (epa_num, gutep, code); 301 if code ^= 0 /* some error from validate procedure */ 302 then do; 303 if code < 3 /* password or missing entry error */ 304 then do; 305 call com_err_ (0, "gcos_read_", "Error in epa number: SNUMB = ^a", gcos_daemon_stat_$snumb); 306 code = 1; /* non-fatal error */ 307 go to DETACH; 308 end; 309 else /* some problem with gcos_user table */ 310 do; 311 call com_err_ (code, "gcos_read_", "***ATTENTION***^/Error in gcos user table: code = ^d", code); 312 code = 2; /* return fatal error */ 313 go to DETACH; 314 end; 315 end; 316 317 if ^epa_found /* an epa was not yet encountered */ 318 then do; 319 320 do j = 22 to 1 by -1 while /* find last char in multics user name */ 321 (substr (gutep -> gute_multics_person, j, 1) = " "); 322 end; 323 do k = 9 to 1 by -1 while /* find end of multics project name */ 324 (substr (gutep -> gute_multics_project, k, 1) = " "); 325 end; 326 user_name = substr (gcos_daemon_stat_$anonymous_user, 1, 327 gcos_daemon_stat_$anonymous_user_len); /* set absentee user name */ 328 329 absentee_dir, 330 home_dir = substr (gcos_daemon_stat_$home_root_dir, 1, gcos_daemon_stat_$home_root_dir_len) 331 ||">"||substr (gutep -> gute_multics_project, 1, k)||">" 332 ||substr (gutep -> gute_multics_person, 1, j); /* make up new home dir path name */ 333 334 dir_name = absentee_dir; /* prepare for entry check call */ 335 call check_entry; /* see if job already exists */ 336 if code ^= 0 /* job already exists or fatal error */ 337 then go to DETACH; 338 339 do ac_name = absentee_dir, home_dir; /* check daemon's access to these dirs */ 340 call check_access (ac_name, my_name); 341 if code ^= 0 /* error checking access */ 342 then go to DETACH; 343 end; 344 345 epa_found = "1"b; /* remember a epa number was found */ 346 347 end; 348 349 go to WRITE; 350 351 end; 352 353 /* MSG3 */ 354 355 if substr (ascii, 8, 4) = "msg3" /* deferral card */ 356 then if ^deferral_switch /* one was not yet found */ 357 then do; 358 359 call gcos_convert_time_ (substr (ascii, 16, 12), deferral, code); /* convert to Multics time */ 360 if code ^= 0 /* error converting time */ 361 then do; 362 call com_err_ (0, "gcos_read_", "Invalid time field on msg3 card: SNUMB = ^a", gcos_daemon_stat_$snumb); 363 go to DETACH; 364 end; 365 366 deferral_switch = "1"b; /* fill in absentee information */ 367 go to WRITE; 368 369 end; 370 371 end; 372 373 go to WRITE; 374 375 376 377 DETACH: 378 379 if ^ident_found 380 then do; 381 NO_IDENT: 382 call com_err_ (0, "gcos_read_", "Missing or invalid ident card: SNUMB = ^a", gcos_daemon_stat_$snumb); 383 code = 1; 384 end; 385 386 call end_work; /* finish processing */ 387 388 if code = 0 /* no error occurred */ 389 then do; 390 391 input_segment_name = segment_name; 392 if ^epa_found /* no epa image was encountered */ 393 then do; 394 absentee_dir = pool_dir; 395 home_dir = default_home_dir; 396 user_name = "Anonymous.GCOS.*"; 397 end; 398 399 do dir_name = input_dir, absentee_dir, home_dir; /* check users access to these dirs */ 400 call check_access (dir_name, user_name); 401 end; 402 403 call hcs_$set_ring_brackets (input_dir, segment_name, rb, code); /* set ring brackets */ 404 if code ^= 0 then 405 do; call com_err_ (code, "gcos_read_", "Error setting ring brackets for ^a>^a", 406 input_dir, segment_name); 407 go to RETURN; 408 end; 409 410 call hcs_$acl_add1 (input_dir, segment_name, user_name, 01111b, ringbrackets, code); /* set users access */ 411 if code ^= 0 /* error setting access */ 412 then call com_err_ (code, "gcos_read_", "Error setting access on ^a>^a", input_dir, segment_name); 413 414 end; 415 416 RETURN: 417 418 if code ^= 0 /* some error occurred */ 419 then data_blank = "0"b; /* zero out absentee data structure */ 420 421 a_eof_found = eof_found; /* return flag */ 422 a_code = code; /* return error code */ 423 return; 424 425 check_access: proc (c_dir_name, c_user_name); 426 427 dcl ( 428 c_user_name 429 ) char (32) aligned; 430 431 dcl ( 432 c_dir_name 433 ) char (168) aligned; 434 435 i = index (c_dir_name, " ") - 1; 436 if i = -1 437 then i = 168; 438 439 call expand_path_ (addr (c_dir_name), i, addr (run_dn), addr (run_en), code); 440 if code ^= 0 441 then do; 442 call com_err_ (code, "gcos_read_", "Error expanding ^a", c_dir_name); 443 code = 2; /* fatal error */ 444 go to RETURN; 445 end; 446 447 call hcs_$get_user_effmode (run_dn, run_en, c_user_name, user_ring, dir_mode, code); /* check access */ 448 if code ^= 0 449 then do; 450 call com_err_ (code, "gcos_read", "Error getting access to ^a", c_dir_name); 451 go to RETURN; 452 end; 453 454 if (bit (dir_mode, 5) & "01011"b) ^= "01011"b /* user doesn't have access */ 455 then do; 456 call com_err_ (error_table_$moderr, "gcos_read_", "^a to ^a", c_user_name, c_dir_name); 457 code = 1; /* error is not fatal */ 458 go to RETURN; 459 end; 460 461 return; 462 463 end check_access; 464 465 check_entry: proc; 466 467 call gcos_daemon_temp_$star_ (dir_name, segment_name, 3, null, ecount, null, null, code); 468 if code ^= 0 /* error from gcos_daemon_temp_$star_ */ 469 then do; 470 call com_err_ (code, "gcos_read_", "Error searching ^a for ^a", 471 dir_name, segment_name); 472 473 if code = error_table_$noentry /* not fatal error */ 474 then code = 1; /* return non-fatal error */ 475 return; 476 end; 477 478 if ecount ^= 0 /* SNUMB already on system. */ 479 then if ^dup_resolved () /* Try to resolve the duplication. */ 480 then do; 481 code = 1; /* Set code to non-fatal. */ 482 call end_work; 483 end; 484 485 return; 486 487 end check_entry; 488 489 dup_resolved: proc () returns (bit (1)); 490 491 start_snumb = rtrim (gcos_daemon_stat_$snumb); 492 query_info.version = query_info_version_4; 493 query_info.switches = "0"b; /* Standard format. */ 494 query_info.switches.cp_escape_control = "10"b; /* No command escape. */ 495 query_info.status_code = 0; 496 query_info.query_code = 0; 497 query_info.question_iocbp = null (); /* Normal I/O switches. */ 498 query_info.answer_iocbp = null (); 499 query_info.repeat_time = 45; /* Wait 45 seconds to repeat question. */ 500 call command_query_ (addr (query_info), 501 query_response, 502 "gcos_daemon", 503 "Duplicate SNUMB - ^a. Abort or resolve (a/r)?", 504 start_snumb); 505 506 bail_out = "0"b; 507 if substr (query_response, 1, 1) = "r" 508 then do; 509 start_snumb, temp_snumb = substr (rtrim (start_snumb) || "00000", 1, 5); 510 do while (^bail_out); 511 temp_snumb = next_snumb (temp_snumb); 512 temp_segname = rtrim (temp_snumb) || ".*"; 513 if temp_snumb = start_snumb /* If we've come full circle and have */ 514 /* yet to resolve the duplication. */ 515 then do; 516 bail_out = "1"b; 517 resolved = "0"b; 518 end; 519 520 else do temp_dir_name = input_dir, pool_dir 521 while (^bail_out); 522 523 call gcos_daemon_temp_$star_ (temp_dir_name, temp_segname, 524 3, null, ecount, null, null, code); 525 526 if code ^= 0 527 then do; 528 call com_err_ (code, "gcos_read_", 529 "^/Error while attempting to resolve duplicate SNUMB ^a", 530 gcos_daemon_stat_$snumb); 531 resolved = "0"b; 532 bail_out = "1"b; 533 end; 534 535 else if ecount = 0 536 then do; 537 call ioa_ ("gcos_daemon: SNUMB #^a entered as #^a", 538 gcos_daemon_stat_$snumb, temp_snumb); 539 540 snumb_length1 = 5; /* Gotta set the values so caller 541* /* doesn't get all confoozed. */ 542 gcos_daemon_stat_$snumb = temp_snumb; 543 bail_out = "1"b; 544 resolved = "1"b; 545 end; 546 end; 547 end; 548 end; 549 else resolved = "0"b; 550 551 return (resolved); 552 553 dcl bail_out bit (1); 554 dcl query_response char (80) varying; 555 dcl resolved bit (1); 556 dcl (start_snumb, temp_snumb) char (5); 557 dcl temp_segname char (32) aligned; 558 dcl temp_dir_name char (168) aligned; 559 560 end dup_resolved; 561 562 end_work: proc; 563 564 if gsr_write_init_called 565 then do; 566 call gcos_gsr_write_$gsr_write_close ("segment_output", code2); 567 if code2 ^= 0 568 then do; 569 call com_err_ (code2, "gcos_read_", "Error from gsr_write_close"); 570 if code < 2 /* no fatal error yet */ 571 then code = code2; /* return this one */ 572 end; 573 end; 574 575 if output_is_attached /* output stream is attached */ 576 then do; 577 578 call ios_$detach ("segment_output", "file_", "", status_stuff); /* detach the output stream */ 579 code2 = status.code; /* check error code */ 580 if code2 ^= 0 /* error detaching output stream */ 581 then do; 582 call com_err_ (code2, "gcos_read_", "Unable to detach ^a", segment_name); 583 if code <= 1 /* no previous fatal error */ 584 then code = code2; /* return this one */ 585 end; 586 else 587 output_is_attached = "0"b; 588 589 end; 590 591 end end_work; 592 593 next_snumb: proc (in_string) returns (char (5)); 594 595 dcl in_string char (5) parm; 596 dcl in_length fixed bin; 597 598 conv_block = in_string; /* Put it where we can work on it. */ 599 in_length = length (rtrim (conv_block)); 600 if in_length ^= 0 601 then do; 602 if conv_ovrl (in_length) = 57 603 then conv_ovrl (in_length) = 97; 604 else if conv_ovrl (in_length) = 122 605 then conv_block = rtrim (next_snumb (substr (in_string, 1, in_length-1))) || "0"; 606 else conv_ovrl (in_length) = conv_ovrl (in_length) + 1; 607 end; 608 609 return (conv_block); 610 611 dcl conv_block char (5) aligned; 612 dcl conv_ovrl (5) fixed bin (9) unsigned unaligned based (addr (conv_block)); 613 dcl conv_ptr pointer; 614 dcl ret_string char (5); 615 616 end next_snumb; 617 618 /* DECLARATIONS */ 619 /* ------------ */ 620 621 622 /* fixed bin */ 623 /* ----- --- */ 624 625 dcl ( 626 a_root_dir_len, /* length of root directory path-name (argument) */ 627 a_urgency, /* urgency field from SNUMB card (argument) */ 628 ecount, /* number of segments from gcos_daemon_temp_$star_ call */ 629 elements_read, /* elements read from ios_$read call */ 630 elements_written, /* elements written from ios_$write call */ 631 gcos_daemon_stat_$default_home_dir_len ext, /* length of pn */ 632 gcos_daemon_stat_$home_root_dir_len ext, /* length of pn */ 633 gcos_daemon_stat_$input_dir_len ext, /* character count of input directory */ 634 gcos_daemon_stat_$pool_dir_len ext, /* character count of pool directory */ 635 gcos_daemon_stat_$root_dir_len ext, /* character count of root directory */ 636 gcos_daemon_stat_$anonymous_user_len ext, /* character count of anonymous user */ 637 i, /* random variable */ 638 j, /* random variable */ 639 k, /* random variable */ 640 root_dir_len int static, /* length of root directory path-name (internal) */ 641 snumb_length1, /* length of SNUMB + 1 */ 642 user_ring int static, /* for effmode call */ 643 card_no, /* sequence number for reading cards */ 644 write_size /* number of elements to write into segment */ 645 ) fixed bin aligned; 646 647 dcl ( 648 dir_mode /* access of user to dir_name */ 649 ) fixed bin (5) aligned; 650 651 dcl ringbrackets (0:2) fixed bin (6) aligned int static init (5, 5, 5); 652 653 dcl rb (3) fixed bin (3) init (5, 5, 5) aligned; /* ringbrackets for set_ring_brackets call */ 654 655 dcl ( 656 a_code, /* error code (argument) */ 657 code, /* error code (internal) */ 658 code2, /* error code (internal) */ 659 error_table_$namedup ext, 660 error_table_$moderr ext, 661 error_table_$noentry ext 662 ) fixed bin (35) aligned; 663 664 665 /* bit strings */ 666 /* --- ------- */ 667 668 dcl ( 669 a_eof_found /* ON if end of read input encountered (argument) */ 670 ) bit (1) aligned; 671 672 dcl ( 673 record_header /* record header from tape returned from gsr_read_ */ 674 ) bit (12) aligned; 675 676 dcl ( 677 card_is_data, /* ON between data and endcopy cards */ 678 dollar_card, /* ON when a $ card is being processed */ 679 ejb_found, /* ON when end of job card found */ 680 eof_found, /* ON if end of read input encountered (internal) */ 681 ident_found, /* ON when at least one IDENT card found in job stream */ 682 epa_found, /* ON once epa number is found */ 683 gsr_write_init_called, /* ON once gsr_write_init is called */ 684 initialized int static, /* ON once this procedure has been called */ 685 output_is_attached, /* ON once output has been attached */ 686 reading_cards /* ON when cards are being read */ 687 ) bit (1) aligned init ("0"b); 688 689 dcl ( 690 status_stuff /* returned from ios_ calls */ 691 ) bit (72) aligned; 692 693 dcl ( 694 input /* binary card image */ 695 ) bit (972) aligned; 696 697 698 /* pointer */ 699 /* ------- */ 700 701 dcl ( 702 a_abs_data_ptr, /* pointer to absentee job info (argument) */ 703 a_input_ptr, /* pointer to bcd SNUMB card (argument) */ 704 ascii_ptr, /* pointer to ascii card image */ 705 input_ptr, /* pointer to binary card image */ 706 rh_ptr, /* pointer for looking at record header */ 707 sp, /* pointer to returned status from ios_ calls */ 708 write_ptr /* points to data to be written */ 709 ) ptr aligned; 710 711 712 /* character strings */ 713 /* --------- ------- */ 714 715 dcl ( 716 gcos_daemon_stat_$snumb ext 717 ) char (6) aligned; 718 719 dcl (snumb /* SNUMB (internal) */ 720 ) char (8) aligned; 721 722 dcl ( 723 epa_num, /* epa number from ident card */ 724 stream_name /* device from which to read (internal) */ 725 ) char (12) aligned; 726 727 dcl ( 728 my_name int static, /* id of caller of this proc */ 729 run_en, /* for checking dir access */ 730 segment_name /* old segment name */ 731 ) char (32) aligned; 732 733 dcl ( 734 ascii init ("") /* ascii card image */ 735 ) char (80) aligned; 736 dcl ( 737 ac_name, /* used in loop call */ 738 default_home_dir int static, /* default Anonymous home dir */ 739 dir_name, /* for do loop */ 740 gcos_daemon_stat_$default_home_dir ext, /* default Anonymous home dir */ 741 gcos_daemon_stat_$home_root_dir ext, /* root portion of all GCOS home dirs */ 742 gcos_daemon_stat_$input_dir ext, /* input directory */ 743 gcos_daemon_stat_$pool_dir ext, /* pool directory */ 744 gcos_daemon_stat_$root_dir ext, /* root directory */ 745 gcos_daemon_stat_$anonymous_user ext, /* name of default anonymous user */ 746 input_dir int static, /* input directory (internal) */ 747 pool_dir int static, /* pool directory (internal) */ 748 root_dir int static, /* root directory (internal) */ 749 run_dn /* for checking dir access */ 750 ) char (168) aligned; 751 752 753 /* built in */ 754 /* ----- -- */ 755 756 dcl ( 757 addr, 758 bit, 759 fixed, 760 index, 761 null, 762 rel, 763 substr 764 ) builtin; 765 766 767 /* masks */ 768 /* ----- */ 769 770 dcl first_bcd_char bit (6) unaligned based (write_ptr); 771 772 dcl tape_input_record bit (504) aligned based (write_ptr); 773 774 dcl 1 record_header_mask aligned based (rh_ptr), 775 2 pad bit (2) unaligned, 776 2 media_code bit (4) unaligned, 777 2 report_code bit (6) unaligned; 778 779 dcl 1 status based (sp) aligned, /* for examining status from ios_ */ 780 2 code fixed bin (35) aligned, 781 2 pad bit (9) unaligned, 782 2 eof bit (1) unaligned; 783 784 /* conditions */ 785 /* ---------- */ 786 787 dcl ( 788 cleanup 789 ) condition; 790 791 792 /* external entries */ 793 /* -------- ------- */ 794 795 dcl com_err_ entry() options(variable); 796 dcl command_query_ entry() options(variable); 797 dcl ioa_ entry() options(variable); 798 dcl cv_bcd_to_ascii_ ext entry 799 (ptr aligned, ptr aligned); 800 801 dcl cv_bin_to_bcd_ ext entry 802 (ptr aligned, ptr aligned, fixed bin (35) aligned); 803 804 dcl expand_path_ ext entry 805 (ptr aligned, fixed bin aligned, ptr aligned, ptr aligned, fixed bin (35) aligned); 806 807 dcl gcos_convert_time_ ext entry 808 (char (16) aligned, fixed bin (71) aligned, fixed bin (35) aligned); 809 810 dcl gcos_daemon_temp_$star_ ext entry 811 (char (*) aligned, char (*) aligned, fixed bin (2) aligned, ptr aligned, fixed bin aligned, 812 ptr aligned, ptr aligned, fixed bin (35) aligned); 813 814 dcl gcos_user_$validate ext entry 815 (char (12) aligned, ptr aligned, fixed bin (35) aligned); 816 817 dcl gcos_gsr_read_ ext entry 818 (char (*) aligned, ptr aligned, fixed bin aligned, bit (12) aligned, bit (1) aligned, fixed bin (35) aligned); 819 820 dcl gcos_gsr_write_ ext entry 821 (char (*) aligned, ptr aligned, fixed bin aligned, bit (12) aligned, bit (1) aligned, fixed bin (35) aligned); 822 823 dcl gcos_gsr_write_$gsr_write_close ext entry 824 (char (*) aligned, fixed bin (35) aligned); 825 826 dcl gcos_gsr_write_$gsr_write_init ext entry 827 (char (*) aligned, fixed bin (35) aligned); 828 829 dcl get_ring_ ext entry 830 returns (fixed bin (6) aligned); 831 832 dcl get_group_id_$tag_star ext entry 833 returns (char (32) aligned); 834 835 dcl hcs_$acl_add1 ext entry 836 (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (5) aligned, (0:2) fixed bin (6) aligned, 837 fixed bin (35) aligned); 838 839 dcl hcs_$set_ring_brackets ext entry 840 (char (*) aligned, char (*) aligned, (3) fixed bin (3) aligned, fixed bin (35) aligned); 841 842 dcl hcs_$get_user_effmode ext entry 843 (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin aligned, fixed bin (5) aligned, fixed bin (35) aligned); 844 845 dcl ios_$attach ext entry 846 (char (*) aligned, char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); 847 848 dcl ios_$detach ext entry 849 (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned); 850 851 dcl ios_$read ext entry 852 (char (*) aligned, ptr aligned, fixed bin aligned, fixed bin aligned, fixed bin aligned, bit (72) aligned); 853 854 dcl ios_$setsize ext entry 855 (char (*) aligned, fixed bin aligned, bit (72) aligned); 856 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 */ 857 858 2 1 /* BEGIN INCLUDE FILE gcos_user_table_entry_.incl.pl1 November 1974 RHM */ 2 2 2 3 dcl gutep ptr, /* pointer to origin of based entry */ 2 4 2 5 1 gcos_user_table_entry_ based, 2 6 2 gute_status fixed bin, /* 0 => inactive, 1 => active */ 2 7 2 gute_filler_1 fixed bin, 2 8 2 gute_gcos_account_id char (12), /* probably 8 or fewer chars */ 2 9 2 gute_multics_person char (22), 2 10 2 gute_multics_project char (9), 2 11 2 gute_ctl, 2 12 3 gute_ctl_filler (18) fixed bin; 2 13 2 14 /* END INCLUDE FILE...gcos_user_table_entry_.incl.pl1 */ 859 860 3 1 /* BEGIN INCLUDE FILE query_info.incl.pl1 TAC June 1, 1973 */ 3 2 /* Renamed to query_info.incl.pl1 and cp_escape_control added, 08/10/78 WOS */ 3 3 /* version number changed to 4, 08/10/78 WOS */ 3 4 /* Version 5 adds explanation_(ptr len) 05/08/81 S. Herbst */ 3 5 3 6 dcl 1 query_info aligned, /* argument structure for command_query_ call */ 3 7 2 version fixed bin, /* version of this structure - must be set, see below */ 3 8 2 switches aligned, /* various bit switch values */ 3 9 3 yes_or_no_sw bit (1) unaligned init ("0"b), /* not a yes-or-no question, by default */ 3 10 3 suppress_name_sw bit (1) unaligned init ("0"b), /* do not suppress command name */ 3 11 3 cp_escape_control bit (2) unaligned init ("00"b), /* obey static default value */ 3 12 /* "01" -> invalid, "10" -> don't allow, "11" -> allow */ 3 13 3 suppress_spacing bit (1) unaligned init ("0"b), /* whether to print extra spacing */ 3 14 3 padding bit (31) unaligned init (""b), /* pads it out to t word */ 3 15 2 status_code fixed bin (35) init (0), /* query not prompted by any error, by default */ 3 16 2 query_code fixed bin (35) init (0), /* currently has no meaning */ 3 17 3 18 /* Limit of data defined for version 2 */ 3 19 3 20 2 question_iocbp ptr init (null ()), /* IO switch to write question */ 3 21 2 answer_iocbp ptr init (null ()), /* IO switch to read answer */ 3 22 2 repeat_time fixed bin (71) init (0), /* repeat question every N seconds if no answer */ 3 23 /* minimum of 30 seconds required for repeat */ 3 24 /* otherwise, no repeat will occur */ 3 25 /* Limit of data defined for version 4 */ 3 26 3 27 2 explanation_ptr ptr init (null ()), /* explanation of question to be printed if */ 3 28 2 explanation_len fixed bin (21) init (0); /* user answers "?" (disabled if ptr=null or len=0) */ 3 29 3 30 dcl query_info_version_3 fixed bin int static options (constant) init (3); 3 31 dcl query_info_version_4 fixed bin int static options (constant) init (4); 3 32 dcl query_info_version_5 fixed bin int static options (constant) init (5); /* the current version number */ 3 33 3 34 /* END INCLUDE FILE query_info.incl.pl1 */ 861 862 863 end gcos_read_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/19/82 0853.2 gcos_read_.pl1 >spec>on>11/19/82>gcos_read_.pl1 857 1 03/27/82 0439.3 gcos_abs_data.incl.pl1 >ldd>include>gcos_abs_data.incl.pl1 859 2 03/27/82 0439.3 gcos_user_table_entry_.incl.pl1 >ldd>include>gcos_user_table_entry_.incl.pl1 861 3 08/12/81 0911.2 query_info.incl.pl1 >ldd>include>query_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. a_abs_data_ptr parameter pointer dcl 701 ref 37 46 68 68 74 a_code parameter fixed bin(35,0) dcl 655 set ref 37 46 422* a_eof_found parameter bit(1) dcl 668 set ref 37 46 421* a_input_ptr parameter pointer dcl 701 ref 37 46 82 a_urgency parameter fixed bin(17,0) dcl 625 ref 37 46 81 abs_data based structure level 1 dcl 1-7 set ref 68 abs_data_len 000300 internal static fixed bin(17,0) dcl 1-5 set ref 68* 75 416 abs_data_ptr 000276 internal static pointer dcl 1-3 set ref 74* 75 81 326 329 329 334 339 339 355 359 366 391 394 395 396 399 399 400 410 416 absentee_data 146 based structure level 2 dcl 1-7 absentee_dir based char(168) level 2 dcl 1-7 set ref 329* 334 339 394* 399 absentee_options 145 based structure level 2 dcl 1-7 ac_name 000252 automatic char(168) dcl 736 set ref 339* 340* addr builtin function dcl 756 ref 53 54 68 68 79 80 439 439 439 439 439 439 500 500 602 602 604 606 606 answer_iocbp 6 000460 automatic pointer initial level 2 dcl 3-6 set ref 3-6* 498* ascii 000226 automatic char(80) initial dcl 733 set ref 80 240 249 262 270 272 274 276 285 290 298 355 359 359 733* ascii_ptr 000166 automatic pointer dcl 701 set ref 80* 237* bail_out 000526 automatic bit(1) unaligned dcl 553 set ref 506* 510 516* 532* 543* 546 bit builtin function dcl 756 ref 454 c_dir_name parameter char(168) dcl 431 set ref 425 435 439 439 442* 450* 456* c_user_name parameter char(32) dcl 427 set ref 425 447* 456* card_is_data 000117 automatic bit(1) initial dcl 676 set ref 251* 257 276* 676* card_no 000106 automatic fixed bin(17,0) dcl 625 set ref 41* 152* 152 175* cleanup 000450 stack reference condition dcl 787 ref 56 code 000114 automatic fixed bin(35,0) dcl 655 in procedure "gcos_read_" set ref 76* 93 101* 102 104* 111* 112 114* 118* 119 121* 131* 135 137* 154* 155 157* 163* 172* 173 202* 206* 207 209* 243* 294* 300* 301 303 306* 311* 311* 312* 336 341 359* 360 383* 388 403* 404 405* 410* 411 411* 416 422 439* 440 442* 443* 447* 448 450* 457* 467* 468 470* 473 473* 481* 523* 526 528* 570 570* 583 583* code based fixed bin(35,0) level 2 in structure "status" dcl 779 in procedure "gcos_read_" ref 101 111 154 579 code2 000115 automatic fixed bin(35,0) dcl 655 set ref 566* 567 569* 570 579* 580 582* 583 com_err_ 000340 constant entry external dcl 795 ref 104 114 121 137 157 162 175 201 209 242 295 305 311 362 381 405 411 442 450 456 470 528 569 582 command_query_ 000342 constant entry external dcl 796 ref 500 conv_block 000102 automatic char(5) dcl 611 set ref 598* 599 602 602 604 604* 606 606 609 conv_ovrl based fixed bin(9,0) array unsigned unaligned dcl 612 set ref 602 602* 604 606* 606 cp_escape_control 1(02) 000460 automatic bit(2) initial level 3 packed unaligned dcl 3-6 set ref 3-6* 494* cv_bcd_to_ascii_ 000346 constant entry external dcl 798 ref 237 cv_bin_to_bcd_ 000350 constant entry external dcl 801 ref 172 data_blank based bit dcl 1-19 set ref 75* 416* default_home_dir 000026 internal static char(168) dcl 736 set ref 65* 395 deferral 146 based fixed bin(71,0) level 3 dcl 1-7 set ref 359* deferral_switch 145 based bit(1) level 3 packed unaligned dcl 1-7 set ref 355 366* dir_mode 000110 automatic fixed bin(5,0) dcl 647 set ref 447* 454 dir_name 000324 automatic char(168) dcl 736 set ref 90* 334* 399* 400* 467* 470* dollar_card 000120 automatic bit(1) initial dcl 676 set ref 147* 182* 214* 234 676* ecount 000100 automatic fixed bin(17,0) dcl 625 set ref 467* 478 523* 535 ejb_found 000121 automatic bit(1) initial dcl 676 set ref 131* 141 227* 264* 676* elements_read 000101 automatic fixed bin(17,0) dcl 625 set ref 153* end_abs_data 150 based fixed bin(17,0) level 2 dcl 1-7 set ref 68 eof 1(09) based bit(1) level 2 packed unaligned dcl 779 ref 160 eof_found 000122 automatic bit(1) initial dcl 676 set ref 199 206* 421 676* epa_found 000124 automatic bit(1) initial dcl 676 set ref 317 345* 392 676* epa_num 000200 automatic char(12) dcl 722 set ref 298* 300* error_table_$moderr 000316 external static fixed bin(35,0) dcl 655 set ref 456* error_table_$noentry 000320 external static fixed bin(35,0) dcl 655 ref 473 expand_path_ 000352 constant entry external dcl 804 ref 439 explanation_len 14 000460 automatic fixed bin(21,0) initial level 2 dcl 3-6 set ref 3-6* explanation_ptr 12 000460 automatic pointer initial level 2 dcl 3-6 set ref 3-6* first_bcd_char based bit(6) unaligned dcl 770 ref 214 fixed builtin function dcl 756 ref 67 68 68 gcos_convert_time_ 000354 constant entry external dcl 807 ref 359 gcos_daemon_stat_$anonymous_user 000336 external static char(168) dcl 736 ref 326 gcos_daemon_stat_$anonymous_user_len 000314 external static fixed bin(17,0) dcl 625 ref 326 gcos_daemon_stat_$default_home_dir 000324 external static char(168) dcl 736 ref 65 gcos_daemon_stat_$default_home_dir_len 000302 external static fixed bin(17,0) dcl 625 ref 65 gcos_daemon_stat_$home_root_dir 000326 external static char(168) dcl 736 ref 329 gcos_daemon_stat_$home_root_dir_len 000304 external static fixed bin(17,0) dcl 625 ref 329 gcos_daemon_stat_$input_dir 000330 external static char(168) dcl 736 ref 61 gcos_daemon_stat_$input_dir_len 000306 external static fixed bin(17,0) dcl 625 ref 61 gcos_daemon_stat_$pool_dir 000332 external static char(168) dcl 736 ref 62 gcos_daemon_stat_$pool_dir_len 000310 external static fixed bin(17,0) dcl 625 ref 62 gcos_daemon_stat_$root_dir 000334 external static char(168) dcl 736 ref 64 gcos_daemon_stat_$root_dir_len 000312 external static fixed bin(17,0) dcl 625 ref 63 gcos_daemon_stat_$snumb 000322 external static char(6) dcl 715 set ref 85 98 121* 137* 157* 162* 175* 201* 209* 295* 305* 362* 381* 491 528* 537* 542* gcos_daemon_temp_$star_ 000356 constant entry external dcl 810 ref 467 523 gcos_gsr_read_ 000362 constant entry external dcl 817 ref 206 gcos_gsr_write_ 000364 constant entry external dcl 820 ref 131 gcos_gsr_write_$gsr_write_close 000366 constant entry external dcl 823 ref 566 gcos_gsr_write_$gsr_write_init 000370 constant entry external dcl 826 ref 118 gcos_user_$validate 000360 constant entry external dcl 814 ref 300 gcos_user_table_entry_ based structure level 1 unaligned dcl 2-3 get_group_id_$tag_star 000374 constant entry external dcl 832 ref 70 get_ring_ 000372 constant entry external dcl 829 ref 67 gsr_write_init_called 000125 automatic bit(1) initial dcl 676 set ref 126* 143* 564 676* gute_multics_person 5 based char(22) level 2 packed unaligned dcl 2-3 ref 320 329 gute_multics_project 12(18) based char(9) level 2 packed unaligned dcl 2-3 ref 323 329 gutep 000456 automatic pointer dcl 2-3 set ref 300* 320 323 329 329 hcs_$acl_add1 000376 constant entry external dcl 835 ref 410 hcs_$get_user_effmode 000402 constant entry external dcl 842 ref 447 hcs_$set_ring_brackets 000400 constant entry external dcl 839 ref 403 home_dir 52 based char(168) level 2 dcl 1-7 set ref 329* 339 395* 399 i 000102 automatic fixed bin(17,0) dcl 625 set ref 274* 274* 276 276 435* 436 436* 439* ident_found 000123 automatic bit(1) initial dcl 676 set ref 285 288* 377 676* in_length 000100 automatic fixed bin(17,0) dcl 596 set ref 599* 600 602 602 604 604 604 606 606 in_string parameter char(5) unaligned dcl 595 ref 593 598 604 604 index builtin function dcl 756 ref 435 initialized 000015 internal static bit(1) initial dcl 676 set ref 59 71* input 000132 automatic bit(972) dcl 693 set ref 79 169 182 input_dir 000100 internal static char(168) dcl 736 set ref 61* 90 399 403* 405* 410* 411* 520 input_ptr 000170 automatic pointer dcl 701 set ref 79* 153* 167 172* 172* input_segment_name 124 based char(32) level 2 dcl 1-7 set ref 391* ioa_ 000344 constant entry external dcl 797 ref 537 ios_$attach 000404 constant entry external dcl 845 ref 100 ios_$detach 000406 constant entry external dcl 848 ref 578 ios_$read 000410 constant entry external dcl 851 ref 153 ios_$setsize 000412 constant entry external dcl 854 ref 110 j 000103 automatic fixed bin(17,0) dcl 625 set ref 290* 290* 292 292 298 320* 320* 329 k 000104 automatic fixed bin(17,0) dcl 625 set ref 323* 323* 329 media_code 0(02) based bit(4) level 2 packed unaligned dcl 774 set ref 88* 181* 188* 214 my_name 000016 internal static char(32) dcl 727 set ref 70* 340* null builtin function dcl 756 ref 3-6 3-6 3-6 467 467 467 467 467 467 497 498 523 523 523 523 523 523 output_is_attached 000126 automatic bit(1) initial dcl 676 set ref 107* 575 586* 676* padding 1(05) 000460 automatic bit(31) initial level 3 packed unaligned dcl 3-6 set ref 3-6* pool_dir 000152 internal static char(168) dcl 736 set ref 62* 90 394 520 priority_queue 144 based fixed bin(17,0) level 2 dcl 1-7 set ref 81* query_code 3 000460 automatic fixed bin(35,0) initial level 2 dcl 3-6 set ref 3-6* 496* query_info 000460 automatic structure level 1 dcl 3-6 set ref 500 500 query_info_version_4 constant fixed bin(17,0) initial dcl 3-31 ref 492 query_response 000527 automatic varying char(80) dcl 554 set ref 500* 507 question_iocbp 4 000460 automatic pointer initial level 2 dcl 3-6 set ref 3-6* 497* rb 000111 automatic fixed bin(3,0) initial array dcl 653 set ref 403* 653* 653* 653* reading_cards 000127 automatic bit(1) initial dcl 676 set ref 39* 48* 149 676* record_header 000116 automatic bit(12) dcl 672 set ref 53 131* 206* record_header_mask based structure level 1 dcl 774 rel builtin function dcl 756 ref 68 68 repeat_time 10 000460 automatic fixed bin(71,0) initial level 2 dcl 3-6 set ref 3-6* 499* report_code 0(06) based bit(6) level 2 packed unaligned dcl 774 set ref 87* 192* resolved 000554 automatic bit(1) unaligned dcl 555 set ref 517* 531* 544* 549* 551 rh_ptr 000172 automatic pointer dcl 701 set ref 53* 87 88 181 188 192 214 ringbrackets 000012 internal static fixed bin(6,0) initial array dcl 651 set ref 410* root_dir 000224 internal static char(168) dcl 736 set ref 64* root_dir_len 000010 internal static fixed bin(17,0) dcl 625 set ref 63* 64 run_dn 000376 automatic char(168) dcl 736 set ref 439 439 447* run_en 000206 automatic char(32) dcl 727 set ref 439 439 447* segment_name 000216 automatic char(32) dcl 727 set ref 78* 85* 98* 100* 391 403* 405* 410* 411* 467* 470* 582* snumb_length1 000105 automatic fixed bin(17,0) dcl 625 set ref 540* sp 000174 automatic pointer dcl 701 set ref 54* 101 111 154 160 579 start_snumb 000556 automatic char(5) unaligned dcl 556 set ref 491* 500* 509 509* 513 status based structure level 1 dcl 779 status_code 2 000460 automatic fixed bin(35,0) initial level 2 dcl 3-6 set ref 3-6* 495* status_stuff 000130 automatic bit(72) dcl 689 set ref 54 100* 110* 153* 578* stream_name 000203 automatic char(12) dcl 722 set ref 40* 49* 153* 157* 206* substr builtin function dcl 756 set ref 61 62 64 65 169 182 221 223* 224* 225* 240 249 262 270 272 274 276 285 290 298 320 323 326 329 329 329 355 359 359 507 509 604 604 suppress_name_sw 1(01) 000460 automatic bit(1) initial level 3 packed unaligned dcl 3-6 set ref 3-6* suppress_spacing 1(04) 000460 automatic bit(1) initial level 3 packed unaligned dcl 3-6 set ref 3-6* switches 1 000460 automatic structure level 2 dcl 3-6 set ref 493* tape_input_record based bit(504) dcl 772 set ref 221 223* 224* 225* temp_dir_name 000572 automatic char(168) dcl 558 set ref 520* 523* temp_segname 000562 automatic char(32) dcl 557 set ref 512* 523* temp_snumb 000560 automatic char(5) unaligned dcl 556 set ref 509* 511* 511* 512 513 537* 542 user_name 134 based char(32) level 2 dcl 1-7 set ref 326* 396* 400* 410* user_ring 000011 internal static fixed bin(17,0) dcl 625 set ref 67* 447* version 000460 automatic fixed bin(17,0) level 2 dcl 3-6 set ref 492* write_ptr 000176 automatic pointer dcl 701 set ref 82* 131* 167* 206* 214 221 223 224 225 237* write_size 000107 automatic fixed bin(17,0) dcl 625 set ref 83* 131* 180* 189* 206* yes_or_no_sw 1 000460 automatic bit(1) initial level 3 packed unaligned dcl 3-6 set ref 3-6* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. a_root_dir_len automatic fixed bin(17,0) dcl 625 conv_ptr automatic pointer dcl 613 elements_written automatic fixed bin(17,0) dcl 625 error_table_$namedup external static fixed bin(35,0) dcl 655 query_info_version_3 internal static fixed bin(17,0) initial dcl 3-30 query_info_version_5 internal static fixed bin(17,0) initial dcl 3-32 ret_string automatic char(5) unaligned dcl 614 snumb automatic char(8) dcl 719 NAMES DECLARED BY EXPLICIT CONTEXT. COMMON 000662 constant label dcl 51 set ref 43 DETACH 003022 constant label dcl 377 ref 115 124 138 144 158 164 177 203 210 244 296 307 313 336 341 363 NO_IDENT 003024 constant label dcl 381 RETURN 003342 constant label dcl 416 ref 93 105 407 444 451 458 WRITE 001413 constant label dcl 131 ref 228 252 257 265 280 349 367 373 cards 000630 constant entry external dcl 37 check_access 003363 constant entry internal dcl 425 ref 340 400 check_entry 003645 constant entry internal dcl 465 ref 92 335 dup_resolved 004006 constant entry internal dcl 489 ref 478 end_work 004444 constant entry internal dcl 562 ref 56 386 482 gcos_read_ 000614 constant entry external dcl 35 next_snumb 004650 constant entry internal dcl 593 ref 511 604 tape 000650 constant entry external dcl 46 NAMES DECLARED BY CONTEXT OR IMPLICATION. length builtin function ref 599 rtrim builtin function ref 85 98 491 509 512 599 604 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 5522 6136 5027 5532 Length 6514 5027 414 341 473 272 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME gcos_read_ 714 external procedure is an external procedure. on unit on line 56 64 on unit check_access internal procedure shares stack frame of external procedure gcos_read_. check_entry internal procedure shares stack frame of external procedure gcos_read_. dup_resolved internal procedure shares stack frame of external procedure gcos_read_. end_work 114 internal procedure is called by several nonquick procedures. next_snumb 85 internal procedure calls itself recursively. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 root_dir_len gcos_read_ 000011 user_ring gcos_read_ 000012 ringbrackets gcos_read_ 000015 initialized gcos_read_ 000016 my_name gcos_read_ 000026 default_home_dir gcos_read_ 000100 input_dir gcos_read_ 000152 pool_dir gcos_read_ 000224 root_dir gcos_read_ 000276 abs_data_ptr gcos_read_ 000300 abs_data_len gcos_read_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME gcos_read_ 000100 ecount gcos_read_ 000101 elements_read gcos_read_ 000102 i gcos_read_ 000103 j gcos_read_ 000104 k gcos_read_ 000105 snumb_length1 gcos_read_ 000106 card_no gcos_read_ 000107 write_size gcos_read_ 000110 dir_mode gcos_read_ 000111 rb gcos_read_ 000114 code gcos_read_ 000115 code2 gcos_read_ 000116 record_header gcos_read_ 000117 card_is_data gcos_read_ 000120 dollar_card gcos_read_ 000121 ejb_found gcos_read_ 000122 eof_found gcos_read_ 000123 ident_found gcos_read_ 000124 epa_found gcos_read_ 000125 gsr_write_init_called gcos_read_ 000126 output_is_attached gcos_read_ 000127 reading_cards gcos_read_ 000130 status_stuff gcos_read_ 000132 input gcos_read_ 000166 ascii_ptr gcos_read_ 000170 input_ptr gcos_read_ 000172 rh_ptr gcos_read_ 000174 sp gcos_read_ 000176 write_ptr gcos_read_ 000200 epa_num gcos_read_ 000203 stream_name gcos_read_ 000206 run_en gcos_read_ 000216 segment_name gcos_read_ 000226 ascii gcos_read_ 000252 ac_name gcos_read_ 000324 dir_name gcos_read_ 000376 run_dn gcos_read_ 000456 gutep gcos_read_ 000460 query_info gcos_read_ 000526 bail_out dup_resolved 000527 query_response dup_resolved 000554 resolved dup_resolved 000556 start_snumb dup_resolved 000560 temp_snumb dup_resolved 000562 temp_segname dup_resolved 000572 temp_dir_name dup_resolved next_snumb 000100 in_length next_snumb 000102 conv_block next_snumb THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_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_bin_to_bcd_ expand_path_ gcos_convert_time_ gcos_daemon_temp_$star_ gcos_gsr_read_ gcos_gsr_write_ gcos_gsr_write_$gsr_write_close gcos_gsr_write_$gsr_write_init gcos_user_$validate get_group_id_$tag_star get_ring_ hcs_$acl_add1 hcs_$get_user_effmode hcs_$set_ring_brackets ioa_ ios_$attach ios_$detach ios_$read ios_$setsize THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$moderr error_table_$noentry gcos_daemon_stat_$anonymous_user gcos_daemon_stat_$anonymous_user_len gcos_daemon_stat_$default_home_dir gcos_daemon_stat_$default_home_dir_len gcos_daemon_stat_$home_root_dir gcos_daemon_stat_$home_root_dir_len gcos_daemon_stat_$input_dir gcos_daemon_stat_$input_dir_len gcos_daemon_stat_$pool_dir gcos_daemon_stat_$pool_dir_len gcos_daemon_stat_$root_dir gcos_daemon_stat_$root_dir_len gcos_daemon_stat_$snumb LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 653 000536 676 000551 733 000562 3 6 000565 35 000613 37 000622 39 000636 40 000640 41 000643 43 000645 46 000646 48 000656 49 000657 51 000662 53 000663 54 000665 56 000667 59 000711 61 000714 62 000721 63 000726 64 000730 65 000734 67 000741 68 000752 70 000767 71 000775 74 001000 75 001004 76 001012 78 001013 79 001016 80 001020 81 001022 82 001024 83 001027 85 001031 87 001061 88 001064 90 001070 92 001075 93 001076 96 001100 98 001110 100 001141 101 001204 102 001206 104 001207 105 001237 107 001240 110 001242 111 001273 112 001275 114 001276 115 001326 118 001327 119 001352 121 001354 124 001410 126 001411 131 001413 135 001456 137 001460 138 001514 141 001515 143 001520 144 001521 147 001522 149 001523 152 001525 153 001526 154 001564 155 001566 157 001567 158 001627 160 001630 162 001634 163 001671 164 001673 167 001674 169 001676 172 001703 173 001715 175 001717 177 001760 180 001761 181 001763 182 001767 184 001775 188 001776 189 002002 192 002004 194 002006 199 002007 201 002012 202 002047 203 002051 206 002052 207 002107 209 002111 210 002145 214 002146 221 002163 223 002166 224 002171 225 002174 227 002177 228 002201 234 002202 237 002204 240 002215 242 002223 243 002254 244 002256 249 002257 251 002263 252 002264 257 002265 262 002267 264 002273 265 002275 270 002276 272 002304 274 002310 275 002321 276 002323 280 002333 285 002334 288 002341 290 002343 291 002354 292 002356 294 002362 295 002364 296 002421 298 002422 300 002426 301 002441 303 002443 305 002445 306 002502 307 002504 311 002505 312 002540 313 002542 317 002543 320 002545 322 002557 323 002562 325 002574 326 002577 329 002606 334 002663 335 002667 336 002670 339 002672 340 002701 341 002712 343 002714 345 002725 349 002727 355 002730 359 002737 360 002754 362 002756 363 003013 366 003014 367 003020 373 003021 377 003022 381 003024 383 003061 386 003063 388 003067 391 003071 392 003076 394 003100 395 003103 396 003106 399 003111 400 003116 401 003130 403 003151 404 003176 405 003200 407 003240 410 003241 411 003300 416 003342 421 003354 422 003360 423 003362 425 003363 435 003365 436 003376 439 003402 440 003427 442 003431 443 003471 444 003473 447 003474 448 003531 450 003533 451 003571 454 003572 456 003601 457 003641 458 003643 461 003644 465 003645 467 003646 468 003717 470 003721 473 003761 475 003767 478 003770 481 003777 482 004001 485 004005 489 004006 491 004010 492 004030 493 004032 494 004044 495 004050 496 004051 497 004052 498 004054 499 004055 500 004057 506 004120 507 004121 509 004125 510 004160 511 004163 512 004172 513 004220 516 004230 517 004232 518 004233 520 004234 523 004242 526 004313 528 004315 531 004351 532 004352 533 004354 535 004355 537 004357 540 004403 542 004405 543 004415 544 004417 546 004420 547 004432 548 004433 549 004434 551 004435 562 004443 564 004451 566 004454 567 004476 569 004501 570 004531 575 004537 578 004541 579 004576 580 004601 582 004602 583 004636 585 004644 586 004645 591 004646 593 004647 598 004655 599 004663 600 004675 602 004676 604 004717 606 004770 609 005000 ----------------------------------------------------------- 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