tape_.alm 10/12/77 1543.7rew 10/12/77 1505.1 10116 " ****************************************************** " * * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " * * " ****************************************************** " Outer Module Transfer Vector for the tape_ outer module. entry tape_module tape_module: tra *+1,6 go to proper transfer instruction tra |[attach] tra |[detach] tra |[stream] tra |[stream] tra |[no_entry] tra |[order] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[getsize] tra |[no_entry] tra |[no_entry] tra |[seek] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[no_entry] end  tape_read_.pl1 11/29/79 2133.4rew 11/29/79 2115.0 269541 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ tape_read_: procedure; /* Read portion of Multics standard tape DIM: tape_. */ dcl (cp, wksp) pointer, (offset, nelem, nelemt) fixed bin, arg_status bit(72) aligned; dcl arg_tsegp ptr, arg_workspace_ptr ptr, arg_data_size fixed bin, arg_error_code fixed bin(35); dcl data_size fixed bin, error_code fixed bin(35), retry_count fixed bin, record_retry_flag bit(1), test_checksum bit(36) aligned; dcl (wrdcnt, j, n, rem, /* remainder of buffer */ data_alerts init(0) ) fixed bin, /* distinguish repeating for data alerts or bad format */ rcode fixed bin(35), (wp, cbp, c, /* ptr to tseg */ bp) ptr, /* ptr to current buffer */ 1 x72 based aligned, 2 pad bit(18) unaligned, 2 x bit(52) unaligned, temp_clok_id bit(72), temp fixed bin(35), bk_cnt fixed bin, ret_label label local init(accept_rec), high_cnt fixed bin, bk_code bit(1), tck bit(36) aligned, mover(size) fixed based, size fixed bin, /* replaces use of move_ */ (skip_rec, read_ahead, copy_flag) bit(1); dcl based_data (data_size) bit(36) based aligned; dcl max_record_retry fixed bin init(64) internal static; dcl label_size fixed bin init(12) internal static; dcl (addr, bin, addrel, divide, fixed, mod, null, ptr, substr) builtin, error_table_$invalid_read ext fixed bin(17), error_table_$bad_density ext fixed bin(17), (error_table_$data_improperly_terminated, error_table_$improper_data_format) ext fixed bin(17), (error_table_$device_end, error_table_$device_parity) external fixed bin, (error_table_$blank_tape, error_table_$device_attention) fixed bin external, tdcm_$tdcm_iocall ext entry(pointer, fixed bin(35)), tape_checksum_ ext entry(ptr, ptr); /* */ %include tape_temp_seg; %include ios_sdb; /* */ %include tseg; /* */ %include mstd; /* */ %include mstr; /* */ %include ios_status; %include iom_stat; /* */ record: entry (arg_tsegp, arg_workspace_ptr, arg_data_size, arg_error_code); /* This entry is called to read ONE physical record. Only the actual data in this * Multics standard record will be moved into the caller's workspace. If the record * read is an End of File record no data will be returned. This entry does some * error recovery. Currently, however, it has the following limitations: * 1. It should not be called after stream reading has been started. * 2. It does not check for repeat records. * 3. It only reads in synchronous mode. * 4. It does not check for End of Tape or End of Reel flags. * Currently this entry is called only by tape_ itself to read the label record. */ tsegp = arg_tsegp; /* Initialize pointers and work variables. */ mstd_ptr = tseg.areap; mstrp = addr(tseg.buffer(mstd.work.curr_buf)); string(mstd.flags), /* Reset these values on each call. */ record_retry_flag = "0"b; data_size, error_code, retry_count= 0; tseg.sync = 1; /* All work done in sync mode. */ tseg.buffer_offset = mstd.work.curr_buf - 1; /* All work done in this buffer. */ RECORD_READ_LOOP: tseg.command_count = 0; tseg.buffer_count = 1; /* We want to read ONE record. */ call tdcm_$tdcm_iocall (tsegp, error_code); if error_code ^= 0 /* Bad error!! */ then goto RECORD_RETURN; if tseg.completion_status < 2 /* Check result of read operation. */ then call VALIDATE_RECORD; /* Good read, check if record is valid. */ else call CHECK_ERROR; /* We got an error reading this record. */ if error_code ^= 0 /* Check code returned by either internal procs */ then goto RECORD_RETURN; /* Bad error => no recovery. */ if record_retry_flag /* Is there something wrong that we can retry? */ then do; /* YES. */ if retry_count > max_record_retry then do; /* Too many retries already. */ error_code = error_table_$device_parity; goto RECORD_RETURN; end; retry_count = retry_count + 1;/* Try reading next record. */ goto RECORD_READ_LOOP; end; /* We got a good and valid record. If this is an EOF record we will just return. * If this is a data record we will move the data from the record into the * workspace specified by the caller. We will tell him the number of WORDS of data * that we are giving him. We will move the record header and trailer into the MSTD. */ if mstd.flags.eof /* Was it an End of File record? */ then goto RECORD_RETURN; /* YES. */ data_size = divide(mstr.head.data_bits_used,36,17,0); if data_size = 0 /* Kludge to get past bug in old tape_xtach_$attach. */ then if mstr.head.flags.label /* It didn't set data_bits_used in label. */ then data_size = label_size; /* Trust that this is the size of the label. */ else do; /* Not a label record. */ error_code = error_table_$improper_data_format; goto RECORD_RETURN; end; arg_data_size = data_size; arg_workspace_ptr->based_data = addr(mstr.data)->based_data; mstd.head = mstr.head; /* Return header & trailer data. */ mstd.trail = mstr.trail; RECORD_RETURN: /* Common way out of this entry. */ tseg.sync = 0; /* This must be reset. */ arg_data_size = data_size; /* Set return arguments. */ arg_error_code = error_code; return; /* */ VALIDATE_RECORD: procedure; /* This internal procedure is called to validate a record. The record has beem read * successfully. We want to be sure that the header and trailer data is valid. */ if (mstr.head.c1 ^= mstd.head.c1) | (mstr.head.c2 ^= mstd.head.c2) | (mstr.trail.c1 ^= mstd.trail.c1) | (mstr.trail.c2 ^= mstd.trail.c2) then do; /* Invalid header or trailer. */ record_retry_flag = "1"b; /* Try reading the next record. */ return; end; call tape_checksum_ (mstrp, addr(test_checksum)); if mstr.head.checksum ^= test_checksum then do; /* Checksum error. */ record_retry_flag = "1"b; /* Read the next record. */ return; end; record_retry_flag = "0"b; /* Record is valid, no retry needed. */ return; end VALIDATE_RECORD; /* */ CHECK_ERROR: procedure; /* This internal procedure is called to find out what kind of error occurred * when reading one record. There are the following possible results: * 1. End of File: The error occurred because the record was an End of File. * A flag in mstd is turned ON to indicate the End of File. * If the record_retry_flag is ON, we will return an error code * telling the caller that a data record has been skipped. * 2. Retry: The error is a kind we can retry. The retry flag is set ON. * Retryable errors are: data alert (not blank_tape) and MPC * data alerts. * 3. Bad Error: The error is "blank tape on read" or "bad density" or * some other error which cannot be retried. */ statp = addr(tseg.hardware_status); /* Get pointer to status we will test. */ if status.major = "0100"b /* Is it an EOF? */ then do; /* Yes. */ mstd.flags.eof = "1"b; /* Indicate End of File. */ if record_retry_flag /* Was there a problem with prev record? */ then error_code = error_table_$improper_data_format; return; end; record_retry_flag = "1"b; /* Either we retry or return bad error code. */ if status.major = "0011"b /* Device Data Alert? */ then do; /* Yes, check substatus. */ if status.sub = "000010"b /* Blank tape on read? */ then error_code = error_table_$blank_tape; return; end; if status.major = "1011"b /* MPC Device Data Alert? */ then return; /* Yes, we can retry this too. */ /* We got an error which we can't retry. Unless this is a density problem return * a device attention error code. */ if (status.major = "1010"b) & /* MPC Device Attention? */ (status.sub = "001000"b) /* Incompatible Mode? */ then error_code = error_table_$bad_density; else error_code = error_table_$device_attention; end CHECK_ERROR; /* */ /* Read module for the Multics Standard Tape DSM. Initial coding by T. P. Skinner - Jan., 1969 */ /* completely rewritten for better error recovery and positioning techniques by Mike Grady 10/30/72 */ stream: entry(cp, wksp, offset, nelem, nelemt, arg_status); c = cp; tsegp = addr(c -> tape_temp_seg.tseg); mstd_ptr = tseg.areap; ios_statp = addr(arg_status); /* Ptr to return status. */ arg_status = "0"b; if tseg.write_sw ^= 0 then do; /* error if not right */ ios_status.code = error_table_$invalid_read; return; end; temp_clok_id = "0"b; wp = addrel(wksp, offset); /* take care of offset */ nelemt, wrdcnt = nelem; /* for now give all */ if mstd.flags.begin then go to init_read; if mstd.flags.bad_backup | mstd.flags.abs_record | mstd.flags.bad_record | mstd.flags.bad_format then do; /* if we got an error last time */ mstd.flags.bad_backup, mstd.flags.abs_record, mstd.flags.bad_record, mstd.flags.bad_format = "0"b; /* reset bits */ /* we will try to read ahead to next good rec - 10 times */ j = 0; /* init counter */ hunt_loop: tseg.sync, tseg.buffer_count = 1; /* set some stuff for tdcm */ tseg.buffer_offset, tseg.command_count = 0; call tdcm_$tdcm_iocall(tsegp, rcode); /* call tdcm */ if tseg.completion_status = 2 then do; /* any error ? */ if j < 10 then do; j = j + 1; go to hunt_loop; end; else do; mstd.flags.bad_record = "1"b; go to g_next; end; end; cbp = ptr(c, tseg.bufferptr(1)); /* grab ptr to good rec */ mstd.head.uid = "0"b; /* clear clock */ addr(mstd.head.uid)->x72.x = addr(cbp->mstr.head.uid)->x72.x; /* grab clock */ if mstd.head.uid < mstd.work.label_uid then do; /* check to make sure we have good rec */ mstd.flags.eod = "1"b; /* no more good data */ go to g_next; /* report error */ end; mstd.work.buf_pos = 8; /* set to beginning */ mstd.trail.tot_rec = fixed(cbp->mstr.trail.tot_rec, 35); /* set recno to current */ tseg.sync = 0; /* reset sync mode */ ret_label = g_next; /* if we get another error */ read_ahead = "1"b; copy_flag = "1"b; /* set some switches so we start right */ n = 0; high_cnt = 32; /* and set some error counters */ call read_next; /* grab next rec - bp */ ret_label = accept_rec; /* no error */ go to next; /* process data */ end; cbp = mstd.work.save_ptr_1; bp = mstd.work.save_ptr_2; next: if cbp->mstr.head.flags.eor then do; goto set_end_code; end; rem = divide(fixed(cbp->mstr.head.data_bits_used, 18), 36, 17, 0) + 8 - mstd.work.buf_pos; if rem = 0 then go to g_next; if wrdcnt <= rem then do; if wrdcnt = 0 then go to retn; size = wrdcnt; /* move data */ wp -> mover = addrel(cbp, mstd.work.buf_pos) -> mover; mstd.work.buf_pos = mstd.work.buf_pos + wrdcnt; go to retn; end; size = rem; /* move as much data as we have in this buffer */ wp -> mover = addrel(cbp, mstd.work.buf_pos) -> mover; wrdcnt = wrdcnt - rem; wp = addrel(wp, rem); /* bump word count and ptr */ /* here to g next buffer */ g_next: if mstd.head.flags.eot then do; ios_status.phy_end_data = "1"b; go to set_end_code; end; if mstd.head.flags.eor then go to set_end_code; /* end of reel */ if mstd.flags.eod then do; ios_status.code = error_table_$data_improperly_terminated; /* no end of reel marks */ go to set_end_data; end; if mstd.flags.bad_backup then do; /* couldnt backspace tape */ ios_status.code = error_table_$device_parity; go to set_elements; end; if mstd.flags.abs_record then do; ios_status.code=error_table_$improper_data_format; /* probably should be better code */ go to set_elements; end; if mstd.flags.bad_record then do; ios_status.code = error_table_$device_parity; go to set_elements; end; if mstd.flags.bad_format then do; ios_status.code = error_table_$improper_data_format; go to set_elements; end; supercede: /* back here when next record is copy of current */ cbp = bp; /* set ptr of next to current */ mstd.head.uid = "0"b; /* cbp is current - bp is next */ addr(mstd.head.uid)->x72.x = addr(cbp->mstr.head.uid)->x72.x; /* copy clock */ mstd.trail.tot_rec = fixed(cbp->mstr.trail.tot_rec,35); high_cnt=32; /* set number of reads we will allow in repositioning */ n = 0; /* clear some error counters in main path */ data_alerts = 0; /* all other paths will increment them */ read_again: /* here when we need to read again */ skip_rec = "0"b; /* indicates no skipped records due to bad read */ copy_flag = "0"b; /* no copy needed */ read_ahead="0"b; /* clear read_ahead bit */ call read_next; /* call int proc to get next buffer */ substr(temp_clok_id,19,52) = substr(bp->mstr.head.uid,19,52); /* copy clock from id */ if temp_clok_id < mstd.work.label_uid then go to invalid_1; /* clock wrong - invalid rec */ /* record is valid check for position */ if fixed(bp->mstr.trail.tot_rec,35) = (mstd.trail.tot_rec+1) then go to accept_rec; /* record is right one */ if bp->mstr.head.flags.set then if bp->mstr.head.flags.repeat then go to supercede; /* record is repeat of last one */ if bp->mstr.head.uid = cbp->mstr.head.uid /* If same ID treat as repeat record. */ then goto supercede; /* record is wrong one - assume tape mispositioned */ temp = fixed(bp->mstr.trail.tot_rec,35); /* save the record number for test */ call two_bsr; /* back two recs-physical(hard to do) */ read_ahead="1"b; /* we must read - we have moved tape */ call read_next; /* read the current record */ /* if we can do this then we have a missing record number on the tape */ if cbp->mstr.head.uid = bp->mstr.head.uid then /* see if we backed up to current rec */ if temp < (mstd.trail.tot_rec+1) then do; /* test to see if we have repeated recs(garbage) */ /* this code is a kludge to get around an old tape dim bug which left old records on the tape just before a tape mark here we will attempt to skip over them */ kludge_loop: call read_next; /* grab next record */ substr(temp_clok_id,19,52) = substr(bp->mstr.head.uid,19,52); /* copy clock */ if temp_clok_id < mstd.work.label_uid then go to invalid_1; /* if bad we may not be where thought*/ if fixed(bp->mstr.trail.tot_rec,35) = (mstd.trail.tot_rec+1) then /* got it now */ go to accept_rec; /* keep it */ go to kludge_loop; /* read a few more */ end; else go to missing_rec; /* even worse case of lost rec */ /* tape must be mispositioned */ go to check_pos; /* see if we can fix it up */ invalid_1: /* here for invalid record */ /* two cases here also - 1) we have reached end of good data without a good end of reel mark or 2) we have been mispositioned again */ call two_bsr; /* back up to try to read curr */ read_ahead="1"b; /* we must read - we have moved tape */ call read_next; /* get the current again */ if cbp->mstr.head.uid = bp->mstr.head.uid then do; mstd.flags.eod = "1"b; /* recs are same - end good data */ go to accept_rec; end; /* tape must be mispositioned */ twenty_bsrs: /* back up alot */ do j = 1 to 10; /* 10 at a time */ tseg.command_queue(j) = bin("100110"b, 6); /* BSR op */ end; tseg.command_count=10; /* 10 to do */ bk_cnt=10; /* save backup count for retry */ tseg.sync=1; /* have tdcm wait for this */ call tdcm_$tdcm_iocall(tsegp, rcode); if tseg.completion_status = 2 then do; /* error backing up */ call chk_back(bk_code); /* check the backup */ if bk_code then do; /* chk_back couldnt recover */ mstd.flags.bad_backup = "1"b; go to accept_rec; end; end; tseg.command_count=10; /* do it again */ bk_cnt=10; /* save backup count for retry */ call tdcm_$tdcm_iocall(tsegp, rcode); if tseg.completion_status = 2 then do; call chk_back(bk_code); /* check the backup */ if bk_code then do; /* chk_back couldnt recover */ mstd.flags.bad_backup = "1"b; goto accept_rec; end; end; tseg.sync=0; /* reset sync mode */ read_ahead="1"b; /* must read - moved tape */ read_alpha: /* grab the record */ call read_next; /* go get it */ substr(temp_clok_id,19,52) = substr(bp->mstr.head.uid,19,52); /* grab clock */ /* check to set if we have valid recs yet */ if temp_clok_id < mstd.work.label_uid then go to twenty_bsrs; /* not yet */ if cbp -> mstr.head.uid = bp->mstr.head.uid /* is it same as current */ then go to read_again; /* if yes we are back where we started */ check_pos: /* here to reposition a valid rec */ if temp_clok_id < mstd.head.uid /* where are we in respect to current */ then go to read_alpha; /* we are before it go to read */ if fixed(bp->mstr.trail.tot_rec,35) = mstd.trail.tot_rec then /* is it same */ go to supercede; /* yes we have later copy */ go to twenty_bsrs; /* not back enough yet */ set_bad_format: mstd.flags.bad_format = "1"b; go to accept_rec; missing_rec: /* here when we get missing rec */ if skip_rec then mstd.flags.bad_record = "1"b; /* we skipped one so we have bad parity */ else mstd.flags.abs_record = "1"b; /* really missing ? */ go to accept_rec; accept_rec: if bp->mstr.head.flags.admin then do; /* admin record ? */ if bp->mstr.head.flags.eor then /* is it end of reel */ mstd.head.flags.eor = "1"b; /* yes */ if bp->mstr.head.flags.eot then /* is end of tape */ mstd.head.flags.eot = "1"b; /* yes */ end; mstd.work.buf_pos = 8; /* at beginning */ go to next; retn: mstd.work.save_ptr_1 = cbp; /* save ptrs */ mstd.work.save_ptr_2 = bp; return; set_end_code: ios_status.code=error_table_$device_end; set_end_data: ios_status.log_end_data = "1"b; set_elements: nelemt = nelem - wrdcnt; return; /* initialize to read the tape */ init_read: /* here only once after attach to read */ ret_label = g_next; /* in case of error */ high_cnt = 32; /* set for first time */ read_ahead = "1"b; /* set so we do extra read ahead to get things going */ init_1: cbp=addr(mstd.buffer(1)); copy_flag="0"b; n=0; call read_next; /* will return ptr to first buffer */ if bp->mstr.head.flags.set then if bp->mstr.head.flags.repeat then go to init_1; /* we have repeated label */ init_2: cbp = bp; /* make it current one */ copy_flag="0"b; /* reset flag */ n=0; call read_next; /* grab next one also - bp */ if bp->mstr.head.flags.set then if bp->mstr.head.flags.repeat then go to init_2; /* if this rec is repeated go back */ ret_label = accept_rec; /* for normal path */ mstd.flags.begin="0"b; /* not any more */ go to next; /* done */ /* */ /* this proc reads the next record(logical) */ read_next: proc; again: /* here to try again */ n=n+1; if n > high_cnt then do; /* to many tries */ if data_alerts > 0 then mstd.flags.bad_record = "1"b; /* bad record(hardware) */ else mstd.flags.bad_format = "1"b; /* not Multics standard */ go to ret_label; end; loop_wait: /* here on some status codes to try again */ if copy_flag then do; /* save current */ size = mstd.work.rec_word_size + 16; addr(mstd.buffer(1)) -> mover = cbp -> mover; /* copy data */ cbp=addr(mstd.buffer(1)); /* reset ptr */ end; if read_ahead then do; /* do we need to read to get started ? */ read_ahead = "0"b; /* clear */ tseg.buffer_count = mstd.work.sub_buf_num; /* set to do read */ tseg.buffer_offset=0; /* at start of buffer */ call tdcm_$tdcm_iocall(tsegp, rcode); /* Perhaps status should be checked here? */ mstd.work.curr_buf=1; end; copy_flag="1"b; /* set flag to copy next time */ /* Check to see if we need to start reading in the next subset of buffers. */ if mod(mstd.work.curr_buf, mstd.work.sub_buf_num) = 1 then do; mstd.work.last_buf = tseg.buffer_offset; tseg.buffer_offset = mod((mstd.work.curr_buf + mstd.work.sub_buf_num - 1), mstd.work.tot_buf_num); call start_read; end; /* have started read so we can process stuf in last buffers */ if mstd.work.curr_buf = mstd.work.error_buf then do; /* we got an error on this buffer */ mstd.work.error_buf = 0; /* reset error */ read_ahead="1"b; /* set to do read ahead next */ statp = addr(mstd.work.error_status); /* Get pointer to IOM status. */ if status.major = "0001"b then go to loop_wait; /* busy - wait */ if status.major = "0010"b then do; /* device attention - out of ready */ ios_status.code = error_table_$device_attention; goto set_elements; end; if status.major = "0011"b then do; /* data alert */ if status.sub & "000010"b then do; mstd.flags.eod = "1"b; /* blank tape end good data */ go to ret_label; end; data_alerts=data_alerts+1; skip_rec="1"b; /* bad error we will skip this rec */ go to again; end; if status.major = "1011"b then do; /* MPC data alert */ data_alerts = data_alerts+1; skip_rec = "1"b; goto again; end; if status.major ^= "0100"b then go to set_bad_format;/* unrecoverable error */ go to again; /* must have been tm - read again */ end; bp = ptr(c, tseg.bufferptr(mstd.work.curr_buf)); /* no error - set ptr to next rec */ if mstd.work.curr_buf < mstd.work.tot_buf_num /* Up buffer index. */ then mstd.work.curr_buf = mstd.work.curr_buf + 1; else mstd.work.curr_buf = 1; /* check data constants to see if this good rec */ if bp->mstr.head.c1 ^= mstd.head.c1 then go to set_skipped; /* no good */ if bp->mstr.head.c2 ^= mstd.head.c2 then go to set_skipped; /* no good */ if bp->mstr.trail.c1 ^= mstd.trail.c1 then go to set_skipped; /* no good */ if bp->mstr.trail.c2 ^= mstd.trail.c2 then go to set_skipped; /* no good */ /* we could be at the label */ if mstd.flags.begin then return; /* if we are just setting up ignore this */ if bp->mstr.head.flags.admin then if bp->mstr.head.flags.label then do; /* yes we have label */ high_cnt=10000; /* set number of reads to get back to position */ go to read_alpha; /* go check position */ end; return; /* all done */ set_skipped: skip_rec = "1"b; /* we skipped one */ go to again; end; /* END of read_next */ /* */ /* internal proc to do reads and error recovery */ start_read: proc; dcl tptr ptr, (indx, indx2, indx3, indx4) fixed bin, glick fixed bin; tseg.buffer_count = mstd.work.sub_buf_num; /* always is one whole subset. */ call tdcm_$tdcm_iocall(tsegp, rcode); /* start io */ /* if comp_stats 2 then previous io was in error _a_n_d this one was not done */ if tseg.completion_status = 2 then do; /* there was an error */ statp = addr(tseg.hardware_status); if (status.major ^= "0011"b) & /* bad error - no retry */ (status.major ^= "1011"b) then go to read_error; do indx2 = 1 to 10; /* we will try ten retrys */ tseg.command_count=tseg.error_buffer; /* we must backup this many times */ do indx = 1 to tseg.error_buffer; /* fill in op codes */ tseg.command_queue(indx) = bin("100110"b,6); /* set to do BSR */ end; bk_cnt = tseg.command_count; /* save count */ tseg.buffer_count = 0; /* reset to be sure */ tseg.sync = 1; /* do sync io */ call tdcm_$tdcm_iocall(tsegp, rcode); /* go do it */ if tseg.completion_status = 2 then do; /* bad backspace */ call chk_back(bk_code); /* did backspace go ok */ if bk_code then do; /* no - no recovery */ mstd.flags.bad_backup = "1"b; /* set sw so we know */ go to ret_label; end; end; tseg.buffer_offset=mstd.work.last_buf; /* set to last time */ tseg.buffer_count = mstd.work.sub_buf_num; /* same as always */ call tdcm_$tdcm_iocall(tsegp, rcode); /* go to it */ tseg.sync = 0; /* reset state of things */ if tseg.completion_status ^= 2 then go to read_again; /* good try read next bunch */ end; /* end of retry loop */ read_error: /* retry failed set codes */ mstd.work.error_buf=tseg.error_buffer+mstd.work.last_buf; mstd.work.error_status = tseg.hardware_status; /* set code also */ if addr(mstd.work.error_status)->status.major = "0100"b then do; /* tape mark do ck sums on buffers we got */ glick = tseg.error_buffer-1; /* number buffers we got */ if glick >= 1 then go to ck_sums_st; /* go only if we got some */ end; return; end; glick = mstd.work.sub_buf_num; /* standard path = one subset. */ ck_sums_st: indx4 = 0; /* counter of retrys on chksums */ ck_sums: do indx = 0 to glick-1; /* this computes on last subset */ tptr = ptr(c, tseg.bufferptr(mstd.work.last_buf+indx+1)); /* get ptr */ call tape_checksum_(tptr, addr(tck)); /* compute magic number */ if tck ^= tptr->mstd.head.checksum then do; /* summs do not agree */ tseg.buffer_count=0; tseg.command_count=0; call tdcm_$tdcm_iocall(tsegp, rcode); /* quiet all previous io */ if tseg.completion_status = 2 then indx2 = tseg.error_buffer+mstd.work.sub_buf_num; else if tseg.completion_status = 1 then indx2 = mstd.work.sub_buf_num * 2; /* indx2 is how far to backup. */ else indx2 = glick+1; do indx3 = 1 to 10; /* 10 retrys to reread data */ tseg.command_count=indx2; /* backup */ bk_cnt = indx2; /* save count */ do indx2 = 1 to tseg.command_count; tseg.command_queue(indx2)= bin("100110"b, 6); end; tseg.sync = 1; /* set sync mode */ call tdcm_$tdcm_iocall(tsegp, rcode); if tseg.completion_status = 2 then do; /* error on backspaces */ call chk_back(bk_code); /* check backup */ if bk_code then do; /* no recovery */ mstd.flags.bad_backup = "1"b; go to ret_label; end; end; tseg.buffer_count = mstd.work.sub_buf_num;/* set to one buffer subset */ tseg.buffer_offset = mstd.work.last_buf; /* reset to last buffers */ call tdcm_$tdcm_iocall(tsegp, rcode); tseg.sync=0; /* reset sync mode */ if tseg.completion_status ^= 2 then go to loop_ck; indx2 = tseg.error_buffer; /* set num backups */ if addr(tseg.hardware_status)->status.major = "0100"b then /* is it TM? */ go to loop_ck; /* yes */ end; go to read_error; /* couldnt reread for ck sum */ end; end; return; /* check sums were correct */ loop_ck: indx4=indx4 + 1; /* count number of retrys on ck sums */ if indx4 < 10 then go to ck_sums; /* try it again */ tseg.error_buffer = indx+1; /* set buffer on which cksum failed */ statp = addr(tseg.hardware_status); status.major = "0011"b; /* Data Alert */ status.sub = "000100"b; /* Parity */ go to read_error; /* return it */ end; /* END of start read */ /* */ /* proc to backup 2 physical records from current logical position this is harder than you think */ two_bsr: proc; dcl ti fixed bin, tcb fixed bin; tseg.command_count=0; tseg.buffer_count=0; call tdcm_$tdcm_iocall(tsegp, rcode); /* quiet all previous i/o */ if tseg.completion_status = 2 then /* check io */ if addr(tseg.hardware_status)->status.major = "0100"b then ti = tseg.error_buffer - 1; /* ignore tm */ else ti = tseg.error_buffer; /* whole thing */ else ti = mstd.work.sub_buf_num; /* no error */ tcb = mstd.work.curr_buf - mstd.work.sub_buf_num; /* set tcb to num of buffer cbp pts to */ /* this is the record we wish to reread */ if tcb < 1 then tcb = tcb + mstd.work.tot_buf_num;/* correct for ring effect */ if mod(tcb, mstd.work.sub_buf_num) = 0 /* if at boundary add susset. */ then ti = ti + mstd.work.sub_buf_num; tcb = mod(tcb-1, mstd.work.sub_buf_num); /* get index into current subset. */ tcb = mstd.work.sub_buf_num -tcb; /* number to backup */ tcb = tcb + ti; /* plus extra */ do ti = 1 to tcb; /* fill in ops */ tseg.command_queue(ti) = bin("100110"b, 6); end; tseg.command_count=tcb; /* set count */ bk_cnt=tcb; tseg.sync = 1; /* tell tdcm to wait */ call tdcm_$tdcm_iocall(tsegp, rcode); /* do it */ if tseg.completion_status = 2 then do; call chk_back(bk_code); /* check backup error */ if bk_code then do; /* no recovery */ mstd.flags.bad_backup ="1"b; go to ret_label; end; end; tseg.sync=0; /* reset to async mode */ return; end; /* */ /* internal procedure to recover from backing up over tape marks */ chk_back: proc(sw); dcl sw bit(1), (bi, bj) fixed bin; sw = "0"b; /* clear sw */ statp = addr(tseg.hardware_status); if status.major ^= "0100"b then do; /* not a tape mark */ if status.major = "0101"b then return; sw = "1"b; /* real trouble */ return; end; bi = bk_cnt - tseg.error_buffer + 1; /* get number of backups left to do */ do bj = 1 to bi; tseg.command_queue(bj)=bin("100110"b, 6); /* set OP code */ end; tseg.command_count=bi; /* set count */ call tdcm_$tdcm_iocall(tsegp, rcode); if tseg.completion_status = 2 then if (status.major = "0101"b) | (status.major = "0100"b) then return; else sw="1"b; /* bad error - not another tm */ return; end; /* end of tape_xmt_ */ end tape_read_;  tape_write_.pl1 11/29/79 2133.4rew 11/29/79 2115.0 194454 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ tape_write_: procedure; /* This procedure implements the write functions of the Multics standard tape DIM: tape_. * Originally coded by Bill Silver on 01/14/74. * * All of the functions that involve writing on a tape have been combined in this module. * Previously, these functions were dispersed in every module of tape_. The entry * points contained in this module are: * * stream: Writes stream data onto the tape. The stream is broken up into Multics * standard records. Currently, the element size of the stream must be 36. * record: Writes one Multics standard record. The data that is to be written must * fit into one Multics standard record. Currently, this entry may be * called only from within tape_. * eof: Writes one End of File record. May be called only from within tape_. * flush: Writes all the data we have currently bufferred. This entry * may be called only from within tape_. */ /* ARGUMENTS */ dcl arg_data_size fixed bin, /* (I) Num of WORDS of data to write. */ arg_error_code fixed bin(35), /* (O) Standard system error code. */ arg_nelem fixed bin, /* (I) Num of elements we are requested to write. */ arg_nelemt fixed bin, /* (O) Num of elements actually written. */ arg_offset fixed bin, /* (I) Offset from workspace pointer of * where output data begins. */ arg_status bit(72), /* (O) IOS status that is returned. */ arg_tsegp ptr, /* (I) Pointer to "tseg". Used by entries * that are only called from tape_ itself. */ arg_tts_ptr ptr, /* (I) Pointer to tape temp seg. */ arg_workspace_ptr ptr; /* (I) Pointer to beginning of output data. */ /* AUTOMATIC DATA */ dcl buf_data_ptr ptr, /* Pointer to beginning of unused buffer data area. */ buf_ptr ptr, /* Pointer to beginning of record buffer. */ buf_space fixed bin, /* Num of unused words in record buffer. */ data_size fixed bin, /* Num of words of data to be moved. */ error_code fixed bin(35), /* Standard system error code. */ error_index fixed bin, /* Used in processing write errors. */ full_flag bit(1), /* ON => buffer is full. */ i fixed bin, num_data_bits fixed bin, /* Bit count of actual data in a record. */ retry_count fixed bin, /* Num of times we have retried an operation. */ word_count fixed bin, /* Num of words left to process. */ work_ptr ptr; /* Pointer to workspace + offset. */ /* BASED DATA */ dcl based_data (data_size) bit(36) based aligned; /* Used to move data. */ dcl based_array(1:1040) bit(36) based; /* Array of words. */ /* EXTERNAL DATA */ dcl ( error_table_$bad_label, error_table_$device_attention, error_table_$device_end, error_table_$device_parity, error_table_$invalid_write ) fixed bin external; dcl ioa_ entry options(variable); dcl tdcm_$tdcm_iocall entry (ptr, fixed bin(35)), tape_checksum_ entry (ptr, ptr), unique_bits_ entry returns (bit(70)); dcl (addr, addrel, min, ptr, size) builtin; /* */ %include tape_temp_seg; %include ios_sdb; /* */ %include tseg; /* */ %include mstd; /* */ %include mstr; /* */ %include ios_status; %include iom_stat; /* */ stream: entry (arg_tts_ptr, arg_workspace_ptr, arg_offset, arg_nelem, arg_nelemt, arg_status); /* This entry is called to write stream data onto a tape. The element size of the * stream must be 36 bits. The stream will be broken up into units that can be written * as one Multics standard tape record. */ tts_ptr = arg_tts_ptr; /* Initialize pointers. */ tsegp = addr(tape_temp_seg.tseg); mstd_ptr = tseg.areap; ios_statp = addr(arg_status); word_count = arg_nelem; /* Get num of words to write. Add in offset. */ work_ptr = addrel(arg_workspace_ptr, arg_offset); arg_status = "0"b; error_code = 0; if tseg.write_sw ^= 1 /* May we write on this tape? */ then do; /* NO. */ error_code = error_table_$invalid_write; goto STREAM_RETURN; end; if mstd.head.flags.eot /* Have we past the End of Tape reflector? */ then do; /* YES, can't write anymore. */ error_code = error_table_$device_end; goto STREAM_RETURN; end; /* We will now move the caller's data into the record buffers. This loop breaks the * data up into Multics standard tape records. Each iteration implies that one * tape record has been filled or contains all the data we have to write. */ do while (word_count > 0); /* Keep looping until all data moved. */ call FILL_BUFFER; /* Fill buffer - up to 1 Mult. stand. tape record. */ if error_code ^= 0 /* Was there an error writing some records? */ then goto STREAM_RETURN; /* YES. */ end; STREAM_RETURN: /* Common return from this entry. */ arg_nelemt = arg_nelem - word_count; /* Return number of elements actually processed. */ if error_code ^= 0 /* Was there an error? */ then do; /* YES. */ ios_status.code = error_code; /* Return error code. */ if error_code = error_table_$device_end then ios_status.log_end_data, ios_status.phy_end_data = "1"b; end; return; /* */ record: entry (arg_tsegp, arg_workspace_ptr, arg_data_size, arg_error_code); /* This entry is called to write ONE Multics standard tape record. The data * that the user wants to write MUST fit into one Multics standard tape record. * Note, no record is written unless the caller supplies at least one word. * If there is space in the record which is not used it will be padded with * words of (-1). If there is unwritten data in the current record buffer * then that record will also be padded. We will always begin writing our data * at the beginning of the data portion of the Multics standard record. */ tsegp = arg_tsegp; /* Initialize pointers, etc. */ mstd_ptr = tseg.areap; error_code = 0; word_count = min(arg_data_size, mstd.work.rec_word_size); work_ptr = arg_workspace_ptr; if word_count = 0 /* No data => no write. */ then goto RECORD_RETURN; call PAD; /* If any data in current buffer, pad ... */ if error_code ^= 0 /* it out to the end of the record. */ then if error_code ^= error_table_$device_end then goto RECORD_RETURN; /* Error when writing padded record. */ call FILL_BUFFER; /* Move data into record buffer. */ if error_code ^= 0 then goto RECORD_RETURN; call PAD; /* Pad the rest of this record. */ RECORD_RETURN: /* Common way out of this entry. */ arg_error_code = error_code; /* Return code. */ return; /* */ eof: entry (arg_tsegp, arg_error_code); /* This entry is called to write one End of File record. If there is any * unwritten data in the current buffer it will be padded and written * before the EOF record is written. */ tsegp = arg_tsegp; /* Initialize pointers, etc. */ mstd_ptr = tseg.areap; error_code = 0; call PAD; /* Pad any data in current record buffer. */ if error_code ^= 0 then if error_code ^= error_table_$device_end then goto EOF_RETURN; call WRITE_EOF; /* Write the EOF record. */ EOF_RETURN: /* Common way out of this entry. */ arg_error_code = error_code; return; /* */ flush: entry (arg_tsegp, arg_error_code); /* This entry is called to flush out all the data we currently have * buffered. If the current bffer is only partially full it will be * padded. We may have to call WRITE_BUFFERS twice to be sure that * all the buffers have actually been written out onto the tape. * Calling this entry guarrantees that the next data given to tape_write_ * will be placed at the beginning of the data portion of the next * physical Multics standard record. */ tsegp = arg_tsegp; /* Initialize. */ mstd_ptr = tseg.areap; error_code = 0; call PAD; /* Take care of any data in the current * buffer. */ if error_code ^= 0 then goto FLUSH_RETURN; if mstd.work.next_count > 0 /* Are there any buffers which we haven't * yet tried to write? */ then do; /* YES. */ call WRITE_BUFFERS; /* Write them now. */ if error_code ^= 0 then goto FLUSH_RETURN; end; call WRITE_BUFFERS; /* Make sure last buffer write completed. * mstd.work.next_count is 0 when this * call is made. */ FLUSH_RETURN: arg_error_code = error_code; return; /* */ FILL_BUFFER: procedure; /* This procedure is called to move data into the current record buffer. * It will only move the number of data words needed to fill up this one buffer. * If there is more data to write, this procedure must be called again. * Note, this procedure calls SET_UP_BUFFER to fill in the record header and * the record trailer and to possibly write the current subset of buffers. */ buf_ptr = ptr(tsegp, tseg.bufferptr(mstd.work.curr_buf)); buf_data_ptr = addrel(buf_ptr, mstd.work.buf_pos); buf_space = mstd.work.rec_word_size + size(mstr_header) - mstd.work.buf_pos; if word_count < buf_space /* Will we fill up the buffer with this data? */ then do; /* NO, buffer will not be full. */ full_flag = "0"b; mstd.work.buf_pos = mstd.work.buf_pos + word_count; data_size = word_count; end; else do; /* Buffer will be full. */ full_flag = "1"b; data_size = buf_space; /* The data moved is = to space left. */ end; buf_data_ptr->based_data = work_ptr->based_data; /* Move data into record buffer. */ work_ptr = addrel(work_ptr, data_size); /* Move pointer to next data. */ word_count = word_count - data_size; /* Get num of words left to process. */ if ^full_flag /* Is the buffer full? */ then return; /* NO, don't set up record header, etc. */ num_data_bits = mstd.head.data_bit_len; /* Stream write => using all of record data area. */ call SET_UP_BUFFER; /* Update header and trailer for this record. */ end FILL_BUFFER; /* */ PAD: procedure; /* This procedure is called to pad out the current record with words of * (-1). We will not pad if there is no data in the current buffer. Note, * padded records will have the "set" and "padded" flags ON. */ if mstd.work.buf_pos = size(mstr_header) /* Is there any data in the current buffer? */ then return; /* NO, no padding needed. */ word_count = mstd.work.buf_pos - size(mstr_header); num_data_bits = word_count * 36; /* Get number of actual bits of data. */ buf_ptr = ptr(tsegp, tseg.bufferptr(mstd.work.curr_buf)); do i = (word_count + size(mstr_header) + 1) to (mstd.work.rec_word_size + size(mstr_header)); buf_ptr -> based_array(i) = mstd.trail.pad_pattern; end; mstd.head.flags.set, /* Turn ON padding flags. */ mstd.head.flags.padded = "1"b; call SET_UP_BUFFER; /* Set up header and trailer of this * record. */ end PAD; /* */ SET_UP_BUFFER: procedure; /* This procedure is called to set up the header and trailer of the current * record. First it will update the information that must go into the header * and trailer. Then it will move the work header and trailer into the actual * write buffer for this record. If we are at an End of File boundary * (every 128 records counting from zero) or if we are at the end of * a buffer subset (for writing the total number of buffers is divided * into two subsets) then we will write out all the buffers in the current * subset. */ mstrp = buf_ptr; /* Get pointer to actual record buffer. */ mstd.head.uid, /* Same UID in header & trailer. */ mstd.trail.uid = unique_bits_(); mstd.head.rec_within_file = mstd.head.rec_within_file + 1; mstd.head.data_bits_used = num_data_bits; mstd.trail.tot_data_bits = mstd.trail.tot_data_bits + num_data_bits; mstd.trail.tot_rec = mstd.trail.tot_rec + 1; mstr.head = mstd.head; /* Copy work header and trailer. */ mstr.trail = mstd.trail; call tape_checksum_ (mstrp, addr(mstr.head.checksum)); /* Now the record is all set up for writing. We must update the index to * the current buffer. Note, we handle buffer wrap-around when we write. * We must check here to see if we have to write the current buffer subset. */ mstd.work.buf_pos = size(mstr_header); /* This record full - reset data element offset. */ mstd.work.curr_buf = mstd.work.curr_buf + 1; /* Up index to buf we will fill in. */ mstd.work.next_count = mstd.work.next_count + 1; /* Up count of bufs already filled. */ if mstd.head.rec_within_file = 127 /* Have we reached an EOF boundary? */ then do; /* Yes, we must write an EOF record. */ call WRITE_EOF; /* This procedure forces write of last subset. */ return; end; if mstd.work.next_count = mstd.work.sub_buf_num then call WRITE_BUFFERS; /* We have filled up this buffer subset. */ end SET_UP_BUFFER; /* */ WRITE_EOF: procedure; /* This procedure is called to write one End of File record. There are four main tasks * performed by this procedure: * 1. If there are any data records which we have not tried to write then we must * write them now. * 2. We must make sure that the last attempt to write data records has completed. * 3. We will write the EOF record itself. Note, if we have errors while writing * the EOF record we will retry it 10 times. * 4. We must update the record header and trailer data to reflect the beginning * of a new file. */ if mstd.work.next_count > 0 /* Any data records not yet written? */ then do; /* YES, write them before the EOF. */ call WRITE_BUFFERS; if error_code ^= 0 then if error_code ^= error_table_$device_end then return; end; call WRITE_BUFFERS; /* Make sure last write request has completed. */ if error_code ^= 0 /* Note, "next_count" for this call was 0. */ then if error_code ^= error_table_$device_end then return; retry_count = 0; WRITE_EOF_LOOP: tseg.sync, /* Wait for EOF to be written. */ tseg.command_count = 1; /* One EOF record written. */ tseg.command_queue(1) = 101101b; /* Set up write EOF command. */ call tdcm_$tdcm_iocall (tsegp, error_code); /* Call to actually write the EOF record. */ tseg.sync = 0; /* Make sure this is reset. */ if error_code ^= 0 /* Was there a bad error? */ then return; /* YES. */ if tseg.completion_status = 2 /* Did write EOF fail? */ then do; /* YES. */ statp = addr(tseg.hardware_status); if (status.major = "0011"b) & (status.sub = "100000"b) then goto WRITE_EOF_OK; /* Ignore End of Tape condition. */ retry_count = retry_count + 1;/* Maybe we can retry. */ if retry_count > 10 /* Too many retries? */ then do; /* Yes, can't go on. */ error_code = error_table_$device_parity; return; end; goto WRITE_EOF_LOOP; /* Go retry writing the EOF. */ end; WRITE_EOF_OK: mstd.head.rec_within_file = -1; /* Write EOF OK, update header & trailer. */ mstd.head.phy_file = mstd.head.phy_file + 1; mstd.trail.tot_file = mstd.trail.tot_file + 1; end WRITE_EOF; /* */ WRITE_BUFFERS: procedure; /* This procedure is called to write out the current subset of record buffers. * Note, in order to maximize the use of the tape drive, we have divided the total * number of buffers available into two subsets. The general idea is to write one * subset - and while the tape drive is working on that request - to fill up the next * subset of buffers with data. */ WRITE_NEXT_SUBSET: /* We are writing the subset that we have * just filled with data. */ tseg.command_count = 0; /* No non data transfer commands. */ tseg.buffer_count = mstd.work.next_count; /* "next_count" = num of buffers to write. */ tseg.buffer_offset = mstd.work.next_buf - 1; /* tdcm_ counts buffers from 0. */ call tdcm_$tdcm_iocall (tsegp, error_code); /* Write out this subset. */ if error_code ^= 0 /* Bad error? */ then return; /* YES. */ if tseg.completion_status = 2 /* Status is for last subset. Any error? */ then do; /* Yes, error writing last subset. */ call WRITE_ERROR; /* Try to recover from this error. */ if error_code ^= 0 /* Is it an unrecoverable error. */ then return; /* Yes, can't do any more. */ goto WRITE_NEXT_SUBSET; /* No, WRITE_ERROR recovered. Try again. */ end; /* The last subset of buffers was written successfully. The tape drive is now working * on the next subset of buffers. Now we must switch the subsets so that the last * subset becomes the next subset we will fill up with data. */ if mstd.work.last_buf > mstd.work.sub_buf_num /* Which subset should be filled next? */ then mstd.work.curr_buf = mstd.work.sub_buf_num + 1; /* The second subset. */ else mstd.work.curr_buf = 1; /* The first subset. */ mstd.work.last_buf = mstd.work.next_buf; /* Switch the buffer subsets. */ mstd.work.next_buf = mstd.work.curr_buf; /* Last -> next, next -> last. */ mstd.work.last_count = mstd.work.next_count; /* Save num of bufs in this write request. */ mstd.work.next_count = 0; /* No bufs filled yet in next subset. */ if mstd.head.flags.eot /* Have we reached the end of the tape reel? */ then error_code = error_table_$device_end; /* Yes, return error code. */ end WRITE_BUFFERS; /* */ WRITE_ERROR: procedure; /* This procedure is called to try and recover from a write error. * All errors except data alerts (device and MPC) will be considered fatal. * In handling write errors, the Multics standard tape format requires that * the tape is never backed up. Instead, we will write the record in error * over again. A special flag in the header of the rewritten record will * indicate that it is a repeated record. Note, if we have reached the End * of Tape reflector, then we must do some special processing. */ statp = addr(tseg.hardware_status); /* Ptr to status that tells what error is. */ error_index = tseg.error_buffer - 1; /* Used to determine buffer in error. */ if (status.major ^= "0011"b) & /* If not Device Data Alert ... */ (status.major ^= "1011"b) /* or not MPC Device Data Alert ... */ then goto SETUP_REPEAT_RECORD; /* Bad error, but try to recover anyway. */ if (status.major = "1011"b) & /* Check for PE Burst Write error. */ (status.sub = "001000"b) then do; /* Got one. Can only happen with label. */ error_code = error_table_$bad_label; return; end; if (status.major ^= "0011"b) | /* If not a Device Data Alert ... */ ((status.sub & "100000"b) ^= "100000"b) /* and not an EOT ... */ then goto SETUP_REPEAT_RECORD; /* then we are not at End of Tape. */ /* We have reached the End of Tape reflector. All records written now must have * the EOT bit ON in their header. Note, changing the record requires that the * checksum be recomputed. If the only error encounterd was the EOT condition, * then the error record specified by "tseg.error_buffer" WAS written OK. * We don't want to write it again or repeat it. */ if ^mstd.head.flags.eot /* Is this the 1st EOT error? */ then do; /* Yes, do this only the 1st time. */ mstd.head.flags.eot = "1"b; /* Remember EOT condition. */ do i = 1 to mstd.work.tot_buf_num; /* Set EOT flag ON in all buffers. */ mstrp = ptr(tsegp, tseg.bufferptr(i)); mstr.head.flags.set, mstr.head.flags.eot = "1"b; call tape_checksum_ (mstrp, addr(mstr.head.checksum)); end; end; if status.sub ^= "100000"b /* Are there other errors? */ then goto SETUP_REPEAT_RECORD; /* Yes, we should repeat error record. */ if mstd.work.last_count = tseg.error_buffer /* Was error in work.last buffer of subset? */ then return; /* Yes, nothing to rewrite. */ error_index = error_index + 1; /* Buffer that got error was written OK. */ goto REWRITE_LAST_SUBSET; /* Finish writing buffers in last subset. */ /* We got an error writing the last subset. "last_buf" now indicates the record * which got the error. We must turn on the repeat flag in this record. Note, * whenever we turn ON a flag in the header of a record we must recompute the checksum. * Note also that we will only retry this record 64 times. */ SETUP_REPEAT_RECORD: mstrp = ptr(tsegp, tseg.bufferptr(mstd.work.last_buf + error_index)); mstr.head.repeat_count = mstr.head.repeat_count + 1; if mstr.head.repeat_count > 64 then do; /* We have retried too many times. */ error_code = error_table_$device_parity; return; end; mstr.head.flags.set, /* OK to repeat, now turn ON flags. */ mstr.head.flags.repeat = "1"b; call tape_checksum_ (mstrp, addr(mstr.head.checksum)); mstd.work.error_count = mstd.work.error_count + 1; /* Starting with the buffer that got the error, we will reissue a write * for all the buffers in the last subset which did not get written OK. * We must update the variables that keep track of what was going on * in the last subset. We could get another error while writting these buffers. */ REWRITE_LAST_SUBSET: mstd.work.last_buf = mstd.work.last_buf + error_index; mstd.work.last_count = mstd.work.last_count - error_index; tseg.buffer_count = mstd.work.last_count; tseg.buffer_offset = mstd.work.last_buf - 1; call tdcm_$tdcm_iocall (tsegp, error_code); end WRITE_ERROR; end tape_write_;  tape_labeler_.pl1 11/29/79 2133.4rew 11/29/79 2115.0 104364 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ tape_labeler_: procedure; /* This procedure is part of the Multics standard tape DIM: tape_. * Originally coded by Bill Silver on 01/21/74. * * It is called to write or read the label of a Multics standard tape. */ /* ARGUMENTS */ dcl arg_error_code fixed bin (35), /* (O) Standard system error code. */ arg_tsegp ptr, /* (I) Pointer to tseg set up by tape_. */ arg_volid char (*); /* (I/O) Tape reel ID. */ /* AUTOMATIC DATA */ dcl buf_size fixed bin, /* Size of tdcm_ I/O buffer. */ error_code fixed bin (35), /* Standard system error code. */ extra_bufs fixed bin, /* Number of extra large buffers available. */ i fixed bin, ip ptr, /* Pointer to base of installation_parms segment. */ record_data_size fixed bin, /* Number of words in the data portion of the label record. */ record_size fixed bin, /* Number of words in the physical label record. */ search_retry_count fixed bin, /* Num of times we retry the whole label search. */ tl_ptr ptr, /* Pointer to our tape label data. */ want_eof_flag bit (1), /* ON => we want an End of File record. */ write_retry_count fixed bin; /* Num of times we retry PE Burst error. */ /* BASED DATA */ dcl 1 tape_label based (tl_ptr) aligned, /* Overlay of the data in a tape label. */ 2 installation_id char (32), /* Taken from installation parms. */ 2 tape_reel_id char (16); /* Identifier for this reel. */ /* EXTERNAL ENTRIES */ dcl (addr, divide, fixed, null, rel, size, string, substr) builtin; dcl (error_table_$argerr, error_table_$bad_label, error_table_$device_attention, error_table_$improper_data_format) external fixed bin (35), tape_dim_data_$record_data_size external fixed bin; dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (5), fixed bin (2), ptr, fixed bin (35)), ioa_ entry options (variable), tape_read_$record entry (ptr, ptr, fixed bin, fixed bin (35)), tape_util_$rewind entry (ptr, fixed bin (35)), tape_write_$eof entry (ptr, fixed bin (35)), tape_write_$record entry (ptr, ptr, fixed bin, fixed bin (35)), tdcm_$tdcm_get_buf_size entry (ptr, fixed bin, fixed bin (35)); /* */ %include tseg; /* */ %include mstd; /* */ %include mstr; /* */ %include installation_parms; /* */ write: entry (arg_tsegp, arg_volid, arg_error_code); /* This entry is called to write the label record of a Multics standard tape. It must * also write an EOF record after the label record. Note, currently a Multics standard * record may be one of two sizes. We will get the size used for all the records of this * tape from: tape_dim_data. This size is the number of words in the data portion * of the Multics standard records. */ write_retry_count = 0; record_data_size = tape_dim_data_$record_data_size; if (record_data_size ^= 1024) & /* Validate record data size. */ (record_data_size ^= 256) then do; /* We will only write records of standard size. */ error_code = error_table_$argerr; goto WRITE_RETURN; end; call INIT_MSTD; /* Set up data in an MSTD. */ if error_code ^= 0 then goto WRITE_RETURN; if record_data_size = 1024 /* Set up the number of buffers we will work with. */ then mstd.work.sub_buf_num = 2 + extra_bufs; else mstd.work.sub_buf_num = 6; mstd.work.tot_buf_num = mstd.work.sub_buf_num * 2; mstd.work.last_buf = mstd.work.sub_buf_num + 1; /* Init to beginning of second subset. */ tl_ptr = addr (mstd.buffer); /* Set up label data. */ call hcs_$initiate (">system_control_1", "installation_parms", "", 0b, 1b, ip, error_code); if ip = null () /* Is there an installation_parms segment? */ then tape_label.installation_id = " "; /* NO, use blanks. */ else tape_label.installation_id = installation_parms.installation_id; tape_label.tape_reel_id = arg_volid; /* Caller knows reel ID. */ WRITE_RETRY_LOOP: mstd.head.flags.admin, /* Turn ON label flags. */ mstd.head.flags.label = "1"b; call tape_write_$record (tsegp, tl_ptr, size (tape_label), error_code); if error_code = 0 then do; /* No error, try to write EOF mark. */ string (mstd.head.flags) = "0"b; /* Turn OFF all flags. */ call tape_write_$eof (tsegp, error_code); end; if error_code ^= 0 then do; /* There was some error writing label. */ if error_code ^= error_table_$bad_label then goto WRITE_RETURN; if write_retry_count = 10 /* PE Burst Write Error. */ then do; /* Retry a max of ten times. */ call ioa_ ("tape_: PE Burst Write Error while writing label."); error_code = error_table_$device_attention; goto WRITE_RETURN; end; write_retry_count = write_retry_count + 1; call tape_util_$rewind (tsegp, error_code); if error_code ^= 0 then goto WRITE_RETURN; goto WRITE_RETRY_LOOP; /* Try to write label record again. */ end; call COMPLETE_MSTD; /* Label records written OK. */ WRITE_RETURN: /* Common exit from this entry. */ arg_error_code = error_code; return; /* */ read: entry (arg_tsegp, arg_volid, arg_error_code); /* This entry is called to read a label record and an End of File record from the * beginning of a Multics standard tape. Note, before we look for the label record we * must rewind the tape to be sure that it is at BOT. */ record_data_size = 1024; /* Initially assume that this tape has large records. */ call INIT_MSTD; /* Set up an MSTD. */ if error_code ^= 0 then goto READ_RETURN; tl_ptr = addr (mstd.buffer); /* Read label data into this buffer. */ search_retry_count = 0; SEARCH_RETRY_LOOP: /* Search for the label record and EOF. */ if search_retry_count = 10 /* Have we retried search too many times? */ then goto BAD_LABEL; /* YES, quit. */ search_retry_count = search_retry_count + 1; /* Up count of retries. */ call tape_util_$rewind (tsegp, error_code); /* Must start from BOT. */ if error_code ^= 0 then goto READ_RETURN; want_eof_flag = "0"b; /* 1st record should not be an EOF. */ do i = 1 to 66; /* Read the first record + up to 64 * repeat records + one EOF record. */ call tape_read_$record (tsegp, tl_ptr, record_data_size, error_code); if error_code ^= 0 then if error_code = error_table_$improper_data_format then goto SEARCH_RETRY_LOOP; else goto READ_RETURN; if mstd.flags.eof /* Is this an EOF record? */ then if want_eof_flag /* Do we want an EOF record? */ then goto GOT_LABEL_EOF; /* YES, this is what we are looking for. */ else goto SEARCH_RETRY_LOOP; /* NO, we missed the label record. */ if mstd.trail.tot_rec > 0 /* We got a good data record. */ then goto SEARCH_RETRY_LOOP; /* BUT it is not the label record. */ want_eof_flag = "1"b; /* We have read in one good data record. * Now we are looking for the EOF record. */ end; /* Go read the next record. */ error_code = error_table_$improper_data_format; /* If we get here then bad trouble. */ goto READ_RETURN; /* We have successfully read the first record of the tape and the EOF record that followed * it. Now, we must see how many words are in this record. The rest of the records on * this tape should be the same size. We must also check to see that this record is a * valid Multics standard tape label record. */ GOT_LABEL_EOF: record_data_size = divide (mstd.head.data_bit_len, 36, 17, 0); if (record_data_size ^= 1024) & (record_data_size ^= 256) then goto BAD_LABEL; if ^mstd.head.flags.admin | /* Check that label flags are correct. */ ^mstd.head.flags.label then goto BAD_LABEL; /* Both MUST be ON. */ record_size = record_data_size + size (mstr_header) + size (mstr_trailer); if record_size = 1040 /* Set up number of buffers. */ then mstd.work.sub_buf_num = 2 + extra_bufs; else mstd.work.sub_buf_num = 4; mstd.work.tot_buf_num = mstd.work.sub_buf_num * 3; string (mstd.flags), /* Zero flags. */ string (mstd.head.flags) = "0"b; mstd.flags.begin = "1"b; /* Tell tape_read_ that this is the beginning. */ mstd.work.label_uid = "0"b; /* Save UID of label. Only right 52 bits used. */ substr (mstd.work.label_uid, 19, 52) = substr (mstd.head.uid, 19, 52); call COMPLETE_MSTD; /* Return a good MSTD to tape_. */ arg_volid = tape_label.tape_reel_id; /* Caller wants to know this. */ goto READ_RETURN; BAD_LABEL: error_code = error_table_$bad_label; READ_RETURN: /* Common exit from this entry. */ arg_error_code = error_code; return; /* */ INIT_MSTD: procedure; /* This internal procedure is called by both the write and read entries. Its job is to * find the tseg that we must use. Then it must initialize the MSTD referenced by this tseg. */ error_code = 0; /* Initialize. */ tsegp = arg_tsegp; record_size = record_data_size + size (mstr_header) + size (mstr_trailer); tseg.bufferptr (1) = fixed (rel (addr (tseg.buffer (1))), 18); tseg.buffer_size (1) = record_size; /* Set up first TSEG buffer. */ tseg.mode (1) = 0; mstd_ptr = tseg.areap; /* Now initialize this MSTD. */ mstd.head.c1 = header_c1; /* 670314355245 */ mstd.head.rec_within_file = -1; /* Incremented before record is written. */ mstd.head.phy_file = 0; mstd.head.data_bit_len = record_data_size * 36; string (mstd.head.flags) = "0"b; mstd.head.c2 = header_c2; /* 512556146073 */ mstd.trail.c1 = trailer_c1; /* 107463422532 */ mstd.trail.tot_data_bits = 0; mstd.trail.pad_pattern = "111111111111111111111111111111111111"b; mstd.trail.reel_num, mstd.trail.tot_file = 0; mstd.trail.tot_rec = -1; /* Incremented before record is written. */ mstd.trail.c2 = trailer_c2; /* 265221631704 */ string (mstd.flags) = "0"b; mstd.work.buf_pos = size (mstr_header); /* Start data after header. */ mstd.work.curr_buf, /* Start with the first buffer. */ mstd.work.last_buf, mstd.work.next_buf = 1; mstd.work.error_buf, /* No errors yet. */ mstd.work.error_count, mstd.work.last_count, /* Nothing is going on now. */ mstd.work.next_count = 0; mstd.work.error_status = "0"b; mstd.work.rec_word_size = record_data_size; call tdcm_$tdcm_get_buf_size (tsegp, buf_size, error_code); if buf_size = 4160 /* Do we have a large buffer? */ then extra_bufs = 2; /* Yes, we can have two more large buffers. */ else extra_bufs = 0; end INIT_MSTD; /* */ COMPLETE_MSTD: procedure; /* This internal procedure is called when we have successfully processed the tape label. * Its job is to set up in TSEG all the buffers that we will be using to * process this tape. */ do i = 1 to mstd.work.tot_buf_num; /* Initialize the buffers that will be used. */ tseg.bufferptr (i) = fixed (rel (addr (tseg.buffer (i))), 18); tseg.buffer_size (i) = record_size; tseg.mode (i) = 0; end; end COMPLETE_MSTD; end tape_labeler_;  tape_util_.pl1 11/29/79 2133.4rew 11/29/79 2115.0 87012 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ /* format: style3,ind3,initlm3,dclind6,idind32 */ tape_util_: procedure; /* This procedure is part of the Multics standard tape DIM: tape_. * Recoded by Bill Silver on 01/23/74. * Modified 7/79 by R.J.C. Kissel to support 6250 bpi tapes. * * This procedure contains a set of unrelated utility entries. * Except for the "order" and "seek" entries, all of these utility * routines are used by tape_ itself. A complete list of the entries * contained in this procedure is given below: * * order: - implements the tape_ order call. * seek: - implements the tape_ seek call. getsize: - returns the element size. * rewind: - rewinds the tape reel. * set_density: - sets the density of the tape drive. */ /* ARGUMENTS */ dcl arg_arg_ptr ptr, /* (I) Pointer to order call argument. */ arg_density fixed bin, /* (I) Density code. */ arg_dummy1 char (*), arg_dummy2 char (*), arg_dummy3 fixed bin, arg_elem_size fixed bin, /* (O) Element size. */ arg_error_code fixed bin (35), /* (O) Standard system error code. */ arg_order_name char (*), /* (I) Order call name. */ arg_status bit (72) aligned, /* (O) Standard ios_ status. */ arg_tsegp ptr, /* (I) Pointer to TSEG. */ arg_tts_ptr ptr; /* (I) Pointer to TTS segment. */ /* AUTOMATIC DATA */ dcl error_code fixed bin (35), /* Standard system error code. */ i fixed bin; dcl message (4) fixed bin (71); /* Used in call to ipc_. */ dcl 1 wait_list, /* Used in calls to ipc_. */ 2 num fixed bin, /* Number of event channels = 1. */ 2 ev_chan fixed bin (71); /* Event channel ID. */ /* BASED DATA */ dcl error_count fixed bin based; /* Argument returned by "error_count" * order call. */ /* INTERNAL STATIC DATA */ /* These are the DCW command codes used to set the density on * a tape drive. */ dcl density_codes (0:4) fixed bin (6) internal static init (110100b, /* 200 BPI */ 110001b, /* 556 BPI */ 110000b, /* 800 BPI */ 110101b, /* 1600 BPI */ 100001b); /* 6250 BPI */ /* EXTERNAL ENTRIES */ dcl (addr, null) builtin; dcl ( error_table_$bad_density, error_table_$device_attention, error_table_$undefined_order_request ) external fixed bin (35); dcl convert_ipc_code_ entry (fixed bin (35)), tdcm_$tdcm_iocall entry (ptr, fixed bin (35)), tdcm_$tdcm_reset_signal entry (ptr, fixed bin (35)), tdcm_$tdcm_set_signal entry (ptr, fixed bin (35)), ioa_ entry options (variable), ipc_$block entry (ptr, ptr, fixed bin (35)), tape_attach_$open entry (ptr, fixed bin (35)), tape_detach_$close entry (ptr, fixed bin (35)), tape_util_$order entry (ptr, char (*), ptr, bit (72) aligned), tape_util_$rewind entry (ptr, fixed bin (35)), tape_write_$flush entry (ptr, fixed bin (35)); /* */ %include tape_temp_seg; %include ios_sdb; /* */ %include tseg; /* */ %include mstd; /* */ %include mstr; /* */ %include ios_status; /* */ %include iom_stat; /* */ order: entry (arg_tts_ptr, arg_order_name, arg_arg_ptr, arg_status); /* This entry implements the tape_ order call. Only two order calls * are currently supported: * * error_count: If the tape is opened for reading, a zero value is * returned. If the tape is opened for writing then all * output data currently buffered will be written and the * up-to-date error count will be returned. * * rewind: This order call does more than just rewind the tape. * It closes the tape, then rewinds the tape reel, and * then opens the tape again. */ tts_ptr = arg_tts_ptr; /* Initialize pointers. */ tsegp = addr (tape_temp_seg.tseg); mstd_ptr = tseg.areap; ios_statp = addr (arg_status); arg_status = "0"b; error_code = 0; if arg_order_name = "error_count" /* Which order call is it? */ then goto ORDER_ERROR_COUNT; if arg_order_name = "rewind" then goto ORDER_REWIND; error_code = error_table_$undefined_order_request; goto ORDER_RETURN; ORDER_ERROR_COUNT: arg_arg_ptr -> error_count = 0; /* Initialize error count. */ if tseg.write_sw = 0 /* Is tape opened for reading? */ then goto ORDER_RETURN; /* YES, nothing to do. */ call tape_write_$flush (tsegp, error_code); /* Write all buffered output. */ if error_code ^= 0 then goto ORDER_RETURN; arg_arg_ptr -> error_count = mstd.work.error_count; /* Return error count. */ if mstd.head.flags.eot /* If at End of Tape tell caller. */ then ios_status.log_end_data, ios_status.phy_end_data = "1"b; goto ORDER_RETURN; ORDER_REWIND: call tape_detach_$close (tsegp, error_code); /* CLOSE this tape. */ if error_code ^= 0 then goto ORDER_RETURN; call tape_util_$rewind (tsegp, error_code); /* REWIND tape reel. */ if error_code ^= 0 then goto ORDER_RETURN; call tape_attach_$open (tsegp, error_code); /* OPEN tape again. */ ORDER_RETURN: ios_status.code = error_code; return; /* */ seek: entry (arg_tts_ptr, arg_dummy1, arg_dummy2, arg_dummy3, arg_status); /* This is an obsolete entry. We will tell this to anyone who calls * this entry. This entry is treated as a "rewind" order call. * No checking of arguments is performed. */ call ioa_ ("tape_: seek call no longer checks arguments"); call ioa_ ("tape_: seek should be replaced by rewind order call"); call tape_util_$order (arg_tts_ptr, "rewind", null (), arg_status); return; getsize: entry (arg_tts_ptr, arg_elem_size, arg_status); /* This entry returns the element size. Currently, it is always 36. */ arg_elem_size = 36; arg_status = "0"b; return; /* */ rewind: entry (arg_tsegp, arg_error_code); /* This entry will rewind the tape and wait for the special interrupt. */ tsegp = arg_tsegp; /* Copy arguments and set up. */ statp = addr (tseg.hardware_status); wait_list.num = 1; wait_list.ev_chan = tseg.ev_chan; tseg.command_count, /* Flush any bad status. */ tseg.buffer_count = 0; /* Nothing actually done. */ call tdcm_$tdcm_iocall (tsegp, error_code); if error_code ^= 0 then goto REWIND_RETURN; call tdcm_$tdcm_set_signal (tsegp, error_code); /* Set up to recieve special interrupt. */ if error_code ^= 0 then goto REWIND_RETURN; tseg.sync, /* Now issue REWIND command. */ tseg.command_count = 1; tseg.command_queue (1) = 111000b; call tdcm_$tdcm_iocall (tsegp, error_code); if error_code ^= 0 then goto REWIND_RETURN; if tseg.completion_status ^= 1 /* Was rewind command actually initiated? */ then goto REWIND_ERROR; /* NO, nothing we can do. */ REWIND_WAIT: call ipc_$block (addr (wait_list), addr (message), error_code); if error_code ^= 0 then do; call convert_ipc_code_ (error_code); goto REWIND_RETURN; end; tseg.command_count = 1; tseg.command_queue = 100000b; /* RESET STATUS: make sure rewind done. */ call tdcm_$tdcm_iocall (tsegp, error_code); if (error_code ^= 0) | /* Error? */ (tseg.completion_status = 1) /* Good status? */ then goto REWIND_RETURN; /* In either case nothing more to do. */ if status.major = "0001"b /* DEVICE BUSY: only bad status we handle. */ then goto REWIND_WAIT; /* YES, rewind still in progress. */ REWIND_ERROR: /* We got status we didn't expect. */ error_code = error_table_$device_attention; REWIND_RETURN: /* Cleanup before we return. */ tseg.sync = 0; call tdcm_$tdcm_reset_signal (tsegp, error_code); arg_error_code = error_code; return; /* */ set_density: entry (arg_tsegp, arg_density, arg_error_code); /* This routine is called to set the density of a tape drive. * The density argument is a code which represents one of the * following density settings: * 0 => 200 BPI * 1 => 556 BPI * 2 => 800 BPI * 3 => 1600 BPI * 4 => 6250 BPI */ tsegp = arg_tsegp; /* Initialize. */ error_code = 0; tseg.buffer_count = 0; tseg.sync, tseg.command_count = 1; tseg.command_queue (1) = density_codes (arg_density); call tdcm_$tdcm_iocall (tsegp, error_code); if error_code ^= 0 then goto DENSITY_RETURN; if tseg.completion_status = 1 then goto DENSITY_RETURN; if addr (tseg.hardware_status) -> status.major = "0101"b then error_code = error_table_$bad_density; else error_code = error_table_$device_attention; DENSITY_RETURN: tseg.sync = 0; /* This must be reset. */ arg_error_code = error_code; /* Return whatever code we have. */ return; end tape_util_;  tape_attach_.pl1 11/29/79 2133.4rew 11/29/79 2115.0 116595 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ /* format: style3,ind3,initlm3,dclind6,idind32 */ tape_attach_: procedure; /* Part of the Multics standard tape DIM: tape_. * Originally coded by Bill Silver on 12/27/73. * Converted for RCP by Bill Silver on 03/27/75. * Name canonicalization added by C. D. Tavares, 05/10/79. * Modified 7/79 by R.J.C. Kissel to support 6250 bpi. */ /* ARGUMENT DATA */ dcl arg_error_code fixed bin (35), /* (O) Standard error code. */ arg_ioname1 char (*), /* (I) Dim name, but not used. */ arg_ioname2 char (*), /* (I) Tape reel ID, etc. */ arg_mode char (*), /* (I) Attachment mode. */ arg_status bit (72) aligned, /* (O) Standard ios_ error status. */ arg_tsegp ptr, /* (I) Pointer to TSEG. */ arg_tts_ptr ptr, /* (I) Pointer to TAPE_TEMP_SEG. */ arg_type char (*); /* (I) Not used. */ /* AUTOMATIC DATA */ dcl attach_flag bit (1), /* ON => tape drive attached in ring 0. */ density fixed bin, /* Density of tape. */ density_retry_flag fixed bin, /* number of densities tried. */ initial_den_idx fixed bin, error_code fixed bin (35), /* Standard system error code. */ volid char (16); /* Tape reel ID. */ dcl 1 wait_list aligned, /* Used to call ipc_. */ 2 num fixed bin, /* Number of event channels. Always = 1. */ 2 ev_chan fixed bin (71); /* Event channel ID. */ dcl 1 message aligned, /* Used to call ipc_. */ 2 chan_name fixed bin (71), 2 message fixed bin (71), 2 sender bit (36), 2 origin, ( 3 dev_signal bit (18), 3 ring bit (18) ) unaligned, 2 chanelx fixed bin; /* INTERNAL STATIC DATA */ dcl tts_count fixed bin (35) /* Count of TTS segments created. */ init (0) internal static; dcl ( den_800 fixed bin init (2), /* Density Indexes. */ den_1600 fixed bin init (3), den_6250 fixed bin init (4) ) internal static; /* EXTERNAL ENTRIES */ dcl (addr, index, length, null, ptr, substr) builtin; dcl tape_dim_data_$tdcm_buf_size fixed bin external; dcl ( error_table_$bad_density, error_table_$bad_mode, error_table_$ionmat, error_table_$no_room_for_dsb ) external fixed bin (35); dcl convert_binary_integer_$decimal_string entry (fixed bin (35)) returns (char (12) varying), convert_ipc_code_ entry (fixed bin (35)), hcs_$delentry_seg entry (ptr, fixed bin (35)), hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)), tdcm_$tdcm_attach entry (ptr, fixed bin (35)), tdcm_$tdcm_detach entry (ptr, fixed bin (35)), tdcm_$tdcm_message entry (ptr, char (*) aligned, fixed bin (1), fixed bin (35)), tdcm_$tdcm_reset_signal entry (ptr, fixed bin (35)), tdcm_$tdcm_set_buf_size entry (ptr, fixed bin, fixed bin (35)), tdcm_$tdcm_set_signal entry (ptr, fixed bin (35)), ioa_ entry options (variable), ipc_$block entry (ptr, ptr, fixed bin (35)), ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35)), tape_labeler_$read entry (ptr, char (*), fixed bin (35)), tape_labeler_$write entry (ptr, char (*) aligned, fixed bin (35)), tape_util_$rewind entry (ptr, fixed bin (35)), tape_util_$set_density entry (ptr, fixed bin, fixed bin (35)); /* */ %include tape_temp_seg; %include ios_sdb; /* */ %include tseg; /* */ %include mstd; /* */ %include mstr; /* */ %include ios_status; /* */ attach: entry (arg_ioname1, arg_type, arg_ioname2, arg_mode, arg_status, arg_tts_ptr); /* This entry is called to attach a tape drive to a process. This involves the * following major tasks: * 1. Making a temporary tape segment (TTS) that is used as a work area while * communicating with the attached tape drive. * 2. Filling in the standard fields in the stream_data_block (SDB) associated with * this attachment. * 3. Initialize the data block (TSEG) used to communicate with ring 0. * 4. Call to get a tape drive. * 5. Currently, we will also OPEN the tape. See the tape_attach_$open entry. */ attach_flag, /* Flag turned ON when drive actually attached. */ arg_status = "0"b; error_code = 0; ios_statp = addr (arg_status); tts_ptr = null (); /* tape_temp_seg_ not created yet. */ if arg_tts_ptr ^= null () /* Check for previous attachment. */ then do; error_code = error_table_$ionmat; goto ATTACH_ERROR; end; if (substr (arg_mode, 1, 1) ^= "w") & /* Validate attachment mode. */ (substr (arg_mode, 1, 1) ^= "r") then do; /* Error, mode not "write" or "read". */ error_code = error_table_$bad_mode; goto ATTACH_ERROR; end; /* We must create a temporary work segment for this attachment. This segment is * created in the process directory. Each such segment is given a unique name. */ tts_count = tts_count + 1; call hcs_$make_seg ("", "tape_temp_seg_" || convert_binary_integer_$decimal_string (tts_count) || "_", "", 01011b, tts_ptr, error_code); if error_code ^= 0 then do; error_code = error_table_$no_room_for_dsb; goto ATTACH_ERROR; end; sdb_ptr = addr (tape_temp_seg.sdb); /* Get pointer to SDB. */ mstd_ptr = addr (tape_temp_seg.mstd); /* Get pointer to MSTD. */ tsegp = addr (tape_temp_seg.tseg); /* Get pointer to TSEG. */ sdb.outer_module = "tape_"; /* Fill in SDB. */ sdb.dev_names = addr (sdb.name_list); sdb.name_list.next_device = null (); sdb.name_list.name_size = length (arg_ioname2); sdb.name_list.name_string = arg_ioname2; /* Now set up the TSEG. */ tseg.version_num = tseg_version_1; tseg.areap = mstd_ptr; /* Save pointer to DIM work area. */ call ipc_$create_ev_chn (tseg.ev_chan, error_code); if error_code ^= 0 then do; call convert_ipc_code_ (error_code); goto ATTACH_ERROR; end; call ATTACH; /* Get tape drive. */ if error_code ^= 0 /* Was there an error while attaching? */ then goto ATTACH_ERROR; call OPEN; /* We will automatically open. */ if error_code ^= 0 /* Was there an error while opening? */ then goto ATTACH_ERROR; arg_tts_ptr = tts_ptr; /* Return this pointer. */ return; /* Tape has been successfully attached * and opened. */ ATTACH_ERROR: ios_status.code = error_code; /* Return dim error status. */ ios_status.detach = "1"b; /* Tell caller tape NOT attached. */ if attach_flag /* Was tape ever attached? */ then call tdcm_$tdcm_detach (tsegp, error_code); if tts_ptr ^= null () /* Delete temp seg if created. */ then call hcs_$delentry_seg (tts_ptr, error_code); return; /* */ open: entry (arg_tsegp, arg_error_code); /* Currently this entry is just called from within tape_. It is assumed that * the tape is attached. */ tsegp = arg_tsegp; /* Set up. */ mstd_ptr = tseg.areap; tts_ptr = ptr (tsegp, "0"b); /* Get pointer to base of segment. */ sdb_ptr = addr (tape_temp_seg.sdb); /* Now get pointer to SDB. */ error_code = 0; call OPEN; /* This is all we have to do. */ arg_error_code = error_code; return; /* */ ATTACH: procedure; /* This internal procedure is called to attach a tape. * tdcm_ via RCP will do all of the tape mounting work. */ if substr (arg_mode, 1, 1) = "w" /* Set write/read switch. */ then tseg.write_sw = 1; else tseg.write_sw = 0; if index (arg_ioname2, ",7track") = 0 /* Is this a7 track reel? */ then tseg.tracks = 0; /* NO, default is 9 track. */ else tseg.tracks = 1; /* YES, user specified "7track" in reel name. */ tseg.density = "0"b; /* Take any density. */ call tdcm_$tdcm_attach (tsegp, error_code); /* Perform actual attachment. */ if error_code ^= 0 then return; attach_flag = "1"b; /* Note that tape actually attached. */ call tdcm_$tdcm_set_signal (tsegp, error_code); if error_code ^= 0 /* We must be able to get specials. */ then return; if tape_dim_data_$tdcm_buf_size = 4160 then do; /* Special user who wants a large buffer. */ call tdcm_$tdcm_set_buf_size (tsegp, 4160, error_code); if error_code ^= 0 then return; end; call ioa_ ("tape_: Mounting tape ^a for ^a", arg_ioname2, arg_mode); /* tdcm_ will do the mounting via RCP. */ call tdcm_$tdcm_message (tsegp, sdb.name_list.name_string, tseg.write_sw, error_code); if error_code ^= 0 then return; sdb.name_list.name_size = length (rtrim (sdb.name_list.name_string)); wait_list.num = 1; /* Now wait for mount to complete. */ wait_list.ev_chan = tseg.ev_chan; /* Set up the one event wait channel. */ call ipc_$block (addr (wait_list), addr (message), error_code); if error_code ^= 0 /* Check for any IPC error. */ then do; /* Yes, sort out non standard codes. */ call convert_ipc_code_ (error_code); return; end; call tdcm_$tdcm_reset_signal (tsegp, error_code); if error_code ^= 0 then return; call ioa_ ("tape_: Tape ^a mounted on drive ^a", sdb.name_list.name_string, tseg.drive_name); end ATTACH; /* */ OPEN: procedure; /* This internal procedure is called to OPEN a tape. The concept of opening a * tape is not very precise. Basically, those things which only have to be done * once, when a user is assigned a tape drive, are part of attaching. Those things * which must be done each time a use wants to rewind a tape, and process it again, * are part of opening. At any rate, the major task of opening is label processing. */ /* We must set tye tape density. */ if index (sdb.name_list.name_string, "=1600") ^= 0 then do; density = den_1600; initial_den_idx = 2; end; else if index (sdb.name_list.name_string, "=6250") ^= 0 then do; density = den_6250; initial_den_idx = 3; end; else do; density = den_800; initial_den_idx = 1; end; call tape_util_$set_density (tsegp, density, error_code); if error_code ^= 0 then return; if tseg.write_sw ^= 0 /* Open different for read and write. */ then do; /* WRITE OPEN */ call tape_labeler_$write (tsegp, sdb.name_list.name_string, error_code); return; end; /* READ OPEN */ density_retry_flag = 0; /* Set before entering read loop. */ do while (error_code = 0); /* We may call twice if density problems. */ call tape_labeler_$read (tsegp, volid, error_code); if error_code = 0 /* Was there any error? */ then return; /* NO, jump out of loop. */ else call RESET_DENSITY; /* Yes, check for bad density. */ end; end OPEN; /* */ RESET_DENSITY: procedure; /* This procedure is called to check the error code returned from the call * to tape_labeler_$read. If the error is not a density problem or if * we have already reset the density once, then we will just return the * error code. Otherwize, we will try to set the density to a new value. */ dcl den_table (3, 2) fixed bin internal static options (constant) init (3, 4, 4, 2, 2, 3); if (error_code ^= error_table_$bad_density) | (density_retry_flag = 2) then return; density_retry_flag = density_retry_flag + 1; density = den_table (initial_den_idx, density_retry_flag); call tape_util_$rewind (tsegp, error_code); /* Tape must be at BOT to set density. */ if error_code ^= 0 then return; call tape_util_$set_density (tsegp, density, error_code); end RESET_DENSITY; end tape_attach_;  tape_detach_.pl1 11/29/79 2133.4rew 11/29/79 2115.0 56799 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ tape_detach_: procedure; /* This procedure is part of the Multics standard tape DIM: tape_. * Originally coded by Bill Silver on 01/22/74. * * This module replaces the old tape_xtach_$detach entry. It contains entries * for closing a tape and for detaching a tape drive. */ /* ARGUMENTS */ dcl arg_error_code fixed bin(35), /* (O) Standard system error code. */ arg_ioname2 char(*), /* (I) Tape reel ID. */ arg_status bit(72) aligned, /* (O) Standard ios_ error status. */ arg_tsegp ptr, /* (I) Pointer to TSEG. */ arg_tts_ptr ptr, /* (I) Pointer to Temp Tape Seg. */ arg_type char(*); /* (I) Not used. */ /* AUTOMATIC DATA */ dcl eot_flag bit(1), /* ON => tape at End of Tape. */ error_code fixed bin(35), /* Standard system error code. */ i fixed bin, save_code fixed bin(35); /* Used to play with error code. */ /* EXTERNAL ENTRIES */ dcl ( addr, string ) builtin; dcl ( error_table_$device_end, error_table_$io_still_assnd ) external fixed bin(35); dcl hcs_$delentry_seg entry (ptr, fixed bin(35)), tdcm_$tdcm_detach entry (ptr, fixed bin(35)), tdcm_$tdcm_iocall entry (ptr, fixed bin(35)), ipc_$delete_ev_chn entry (fixed bin(71), fixed bin(35)), convert_ipc_code_ entry (fixed bin(35)), tape_write_$eof entry (ptr, fixed bin(35)), tape_write_$record entry (ptr, ptr, fixed bin, fixed bin(35)); /* */ %include tape_temp_seg; %include ios_sdb; /* */ %include tseg; /* */ %include mstd; /* */ %include mstr; /* */ %include ios_status; /* */ detach: entry (arg_tts_ptr, arg_ioname2, arg_type, arg_status); /* This entry is called when the user wants to detach a tape drive. * Currently it is assumed that the tape is not closed. This entry will * always close the tape before detaching it. Once the tape has been closed * detaching involves the following steps: * 1. Rewinding and unloading the tape reel. * 2. Calling ring 0 to unassign the tape drive. * 3. Deleting the event channel that was created for this drive. * 4. Deleting the TSEG that was created for this drive. */ tts_ptr = arg_tts_ptr; /* Initialize pointers, etc.. */ sdb_ptr = addr(tape_temp_seg.sdb); tsegp = addr(tape_temp_seg.tseg); mstd_ptr = tseg.areap; ios_statp = addr(arg_status); arg_status = "0"b; save_code, error_code = 0; if arg_ioname2 ^= "" /* Check to see if we are detaching the right reel. */ then if arg_ioname2 ^= sdb.name_list.name_string then do; save_code = error_table_$io_still_assnd; goto DETACH_RETURN; end; call CLOSE; /* Got right tape reel. Now close tape. */ call SAVE_CODE; tseg.buffer_count, /* Flush out any existing status. */ tseg.command_count = 0; call tdcm_$tdcm_iocall (tsegp, error_code); call SAVE_CODE; call tdcm_$tdcm_detach (tsegp, error_code); call SAVE_CODE; call ipc_$delete_ev_chn (tseg.ev_chan, error_code); if error_code ^= 0 /* Was there an error deleting event channel? */ then do; /* YES, convert non standart error code. */ call convert_ipc_code_ (error_code); call SAVE_CODE; end; call hcs_$delentry_seg (tts_ptr, error_code); call SAVE_CODE; ios_status.detach = "1"b; /* Now that TSEG deleted and everything else * done, tell user that drive has been detached. */ DETACH_RETURN: ios_status.code = save_code; /* Return our saved code. */ return; /* */ close: entry (arg_tsegp, arg_error_code); /* This entry is called to close a tape. Currently it is called only * from within tape_. */ tsegp = arg_tsegp; /* Initialize pointers. */ mstd_ptr = tseg.areap; error_code = 0; call CLOSE; /* This is all we do. */ arg_error_code = error_code; return; /* */ SAVE_CODE: procedure; /* Called to save first error code that is not zero. */ if error_code = 0 then return; if save_code = 0 then save_code = error_code; end SAVE_CODE; /* */ CLOSE: procedure; /* This procedure is called to close a tape. The concept of closing a tape is not * precisely defined. In general, however, it involves all the cleanup tasks * that must be performed before a tape is rewound. Once a tape has been closed, * it may be rewound and then detached or opened again. * Note, there is nothing to be done when closing a tape that has been opened for reading. * When closing a tape that has been opened for writing we must do the following: * 1. Write out all currently buffered output. * 2. Write an EOF record. * 3. Write an End of Reel record. This records contains all PAD words. * 4. Write two EOF records * Note, when writing this end of tape information we must ignore all device end errors. */ if tseg.write_sw = 0 /* Is tape opened for reading? */ then return; /* YES, nothing to do to close it. */ if mstd.head.flags.eot /* Are we at the End of Tape? */ then eot_flag = "1"b; else eot_flag = "0"b; string(mstd.head.flags) = "0"b; /* Turn OFF all flags. */ call tape_write_$eof(tsegp,error_code); /* This call will flush all buffered output. */ if (error_code ^= 0) & (error_code ^= error_table_$device_end) then return; mstd.head.flags.set, mstd.head.flags.eot = eot_flag; /* Set EOT flag if appropriate. */ mstd.head.flags.admin, mstd.head.flags.eor = "1"b; /* Turn ON End of Reel flag. */ call tape_write_$record (tsegp, addr(mstd.trail.pad_pattern), 1, error_code); if (error_code ^= 0) & (error_code ^= error_table_$device_end) then return; string(mstd.head.flags) = "0"b; /* Make sure all flags are OFF. */ do i = 1 to 2; /* Write two EOF records at end of tape. */ call tape_write_$eof (tsegp, error_code); if (error_code ^= 0) & (error_code ^= error_table_$device_end) then return; end; error_code = 0; /* Getting this far => no error. */ end CLOSE; end tape_detach_; bull_copyright_notice.txt 08/30/05 1008.4r 08/30/05 1007.3 00020025 ----------------------------------------------------------- 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