nstd_.alm 11/04/82 1932.4rew 11/04/82 1632.5 11043 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " " " " " " " " " " " " This is the I/O switch transfer vector for the nstd_dim outer module " " " " " " " " " " " entry nstd_module nstd_module: tra *+1,6 go to proper transfer instruction tra |[nstd_attach] tra |[nstd_detach] tra |[nstd_read] tra |[nstd_write] tra |[no_entry] tra |[nstd_order] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[nstd_getsize] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[nstd_cmode] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[no_entry] end  nstd_dim.pl1 11/04/82 1932.4rew 11/04/82 1606.1 289782 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* The non-standard tape DIM. coded by MAP, 8/70. Liberally cribbed from NIM */ /* Modified by Dick Snyder 2/71 to allow a mode request of "rw" or blank (read/write) */ /* Also changed to allow order request "err_count" for on-line T&D's and to add */ /* stream data block as specified in MCB 638 */ /* Modified by Mike Grady to add fixed_record_length order call 11/03/72 */ /* Modified on 09/19/77 by R.J.C. Kissel to call tape_nstd_ to get the max buffer size. */ /* Modified on 02/15/78 by M. R. Jordan to remove the call to tape_nstd_ and add the ,block= and ,blk= strings. */ /* Modified on 04/28/78 by Michael R. Jordan to _n_o_t unload tapes. */ /* Modified on 08/09/78 by Bob May to add TEMPORARY GCOS facility for large buffers . This interface will disappear when the GCOS simulator moves to tape_ioi_. */ /* Modified 4/79 by R.J.C. Kissel to add 6250 bpi and data security erase capability. */ /* Modified on 05/10/79 by C. D. Tavares to add name canonicalization support */ /* Modified sometime in 1981 by M. R. Jordan to fix some bugs */ /* format: style4,delnl,insnl,indattr,ifthen,dclind9 */ nstd_dim: proc; return; /* Shouldn't be called here */ dcl (name1, type, name2, rw, order) char (*); dcl st bit (72); dcl (sdb_ptr, wksp, ap) ptr; dcl ( error_table_$no_backspace, error_table_$undefined_order_request, error_table_$bad_mode, error_table_$buffer_big, error_table_$bad_arg, error_table_$ionmat ) ext fixed bin (35); dcl code fixed bin (35); dcl setbit bit (18), rdycmd fixed bin (6), fix_sw bit (1), attach_sw bit (1), j fixed bin; dcl (off, nelem, nelemt, ring, count, i) fixed bin (17); dcl density fixed bin; dcl temp_name char (32); dcl 1 wait_list, 2 n fixed bin (17), 2 chn fixed bin (71); dcl 1 message, 2 channel fixed bin (71), 2 mess fixed bin (71), 2 sender bit (36), 2 origin, 3 dersig bit (18) unaligned, 3 ring bit (18) unaligned, 2 channel_index fixed bin (17); dcl dum (tseg.buffer_size (1)) fixed bin (35) based; dcl sst bit (18) aligned based; dcl ord char (32); dcl (addr, addrel, bit, length, null, ptr, rel, rtrim, search, substr, unspec) builtin; dcl (bin, bool, divide, index, max, string, lbound, hbound) builtin; dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin, ptr, fixed bin (35)); dcl ( tdcm_$tdcm_attach, tdcm_$tdcm_detach, tdcm_$tdcm_set_signal, tdcm_$tdcm_reset_signal, tdcm_$tdcm_iocall ) entry (ptr, fixed bin (35)), tdcm_$tdcm_set_buf_size entry (ptr, fixed bin, fixed bin (35)), tdcm_$tdcm_message entry (ptr, char (*), fixed bin, fixed bin (35)); dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); dcl ipc_$create_ev_chn ext entry (fixed bin (71), fixed bin (35)); dcl hcs_$delentry_seg entry (ptr, fixed bin (35)); dcl ( ioa_, ioa_$rsnnl ) entry options (variable); dcl ipc_$block entry (ptr, ptr, fixed bin (35)); dcl instance fixed bin (35) int static init (1); /* used to generate sdb seg name */ dcl segnm char (32); /* name of stream data block */ dcl sav_stat bit (36); dcl newerr fixed bin based (ap); dcl cleanup condition; /* cleanup handler for interrupted attachment */ dcl 1 hsbc aligned, /* tape status word format */ 2 padx bit (2) unaligned, 2 maj bit (4) unaligned, 2 min bit (6) unaligned, 2 pady bit (24); dcl 1 stream_data_block aligned based (sdb_ptr), 2 outer_module_name char (32) aligned, 2 device_name_list ptr, 2 tseg_ptr ptr, 2 retry_cnt fixed bin, /* no. of times to retry i/o */ 2 some_bits aligned, 3 no_data_sw bit (1) unaligned, /* 1 = start next blocked i/o */ 3 fix_rec bit (1) unaligned, /* 1 = fixed record i/o (buffered i/o) */ 3 eot_bit bit (1) unaligned, /* 1 = end of tape was reached */ 3 eof_bit bit (1) unaligned, /* 1 = end of file was reached */ 3 rewind bit (1) unaligned, /* 1 = last tape order was rewind */ 3 unload bit (1) unaligned, /* 1 = last tape order was unload */ 3 fix_init bit (1) unaligned, /* initial io for fixed length rec. */ 3 spare_bits bit (29) unaligned, 2 max_rec_len fixed bin, /* maximum record length in words */ 2 fix_rec_size fixed bin, /* length of records for fixed record length option */ 2 buf_mask bit (18), /* used to get index to block of buffers */ 2 buf_count fixed bin, /* no. of buffers in data transfer */ 2 data_count fixed bin, /* no. of buffers read/written */ 2 bufchk fixed bin, /* index of current buffer in block (0 to 2*buffer_count-1) */ 2 device_name, 3 next_device_ptr ptr, 3 name_size fixed bin (17), 3 name char (256) aligned, 2 tsegarea fixed bin (71); dcl 1 ord_tab (18) aligned internal static, /* lookup table for simple order types */ 2 oname char (32) aligned init (/* orders */ "back", "eof", "reset_status", "forward_record", "forward_file", /* NOTE: order of these orders */ "backspace_file", "erase", "high", "low", "protect", "unload", "rewind", /* must be maintained */ "d200", "d556", "d800", "d1600", "d6250", "data_security_erase"), /* since there is code which is */ /* dependent on it */ 2 cmd bit (6) aligned init (/* actual orders */ "46"b3, "55"b3, "40"b3, "44"b3, "45"b3, "47"b3, "54"b3, "60"b3, "61"b3, "62"b3, "72"b3, "70"b3, "64"b3, "61"b3, "60"b3, "65"b3, "41"b3, "73"b3); %include tseg; /* */ set_block_size: entry (a_user_block_size, a_code); /* Temporary entry to allow users of the GCOS simulators to tell nstd_ to use large buffers. Bob May, 08/07/78 */ dcl a_user_block_size fixed bin, /* size in words */ a_code fixed bin (35); dcl user_block_size fixed bin int static; /* override size */ dcl user_block_size_sw bit (1) int static init ("0"b); /* to keep track of buffer needs */ if a_user_block_size ^= 0 then do; user_block_size = a_user_block_size; user_block_size_sw = "1"b; end; else user_block_size_sw = "0"b; /* reset function */ a_code = 0; /* assume its ok for now. we checked it before */ return; /* End of set_block_size Entry */ /* A T T A C H E N T R Y P O I N T */ nstd_attach: entry (name1, type, name2, rw, st, sdb_ptr); attach_sw = "0"b; if sdb_ptr ^= null then do; /* check for multiple attachments */ substr (st, 1, 36) = unspec (error_table_$ionmat); return; /* if multiple attachment return error code */ end; on cleanup call clear_attach; /* cleanup in case user quits while attaching */ /* Create name for segment to hold stream data block. Name consists of */ /* "nstd_sdbN_" where N is a number which increments by one for */ /* each attach call. */ call ioa_$rsnnl ("nstd_sdb^d_", segnm, code, instance); instance = instance + 1; /* bump instance */ call hcs_$make_seg ("", segnm, "", 01011b, sdb_ptr, code); /* Make an sdb */ if sdb_ptr = null then do; /* failure? */ BAD_OUT: substr (st, 1, 36) = unspec (code); substr (st, 52, 1) = "1"b; /* Send back a detach bit */ return; end; outer_module_name = "nstd_"; /* fill in stream data block */ device_name_list = addr (device_name); next_device_ptr = null; /* only one device */ name_size = 32; name = name2; /* put in tape name */ tseg_ptr = addr (tsegarea); /* set up tseg for DCM use */ tsegp = tseg_ptr; /* copy tseg pointer for better code */ tseg.version_num = tseg_version_2; stream_data_block.retry_cnt = 10; /* set default error retry count */ fix_init = "0"b; /* initialization for fixed rec. length */ /* initialize tseg */ call ipc_$create_ev_chn (tseg.ev_chan, code); /* create event channel for the */ if code ^= 0 then go to BAD_ATTACH; /* signalling of special interrupts */ tseg.sync = 1; /* i/o will be synchronous */ tseg.get_size = 1; /* we want DCM to tell us record sizes */ tseg.buffer_offset = 0; /* start at front of buffer */ tseg.bufferptr (1) = bin (rel (addr (tseg.buffer (1))), 17); /* set up first buffer ptr */ do i = 1 to 12; tseg.mode (i) = 0; /* default mode is binary * */ end; /* Hook up the dcm */ if (rw ^= "r" & rw ^= "w" & rw ^= "rw" & rw ^= "") then do; code = error_table_$bad_mode; /* set error code */ go to BAD_ATTACH; end; if rw = "r" then ring, tseg.write_sw = 0; /* mode read */ else ring, tseg.write_sw = 1; /* mode write */ if index (name2, ",7track") ^= 0 then /* set indicator to 7 or 9 track drive type */ tseg.tracks = 1; else tseg.tracks = 0; call tdcm_$tdcm_attach (tsegp, code); /* ask DCM to grab a drive */ if code ^= 0 then go to BAD_ATTACH; /* DCM gripped */ attach_sw = "1"b; max_rec_len = 2800; i = index (name2, ",block=") + 7; if i <= 7 then do; i = index (name2, ",blk=") + 5; if i <= 5 then i = index (name2, ",bk=") + 4; end; if i > 4 then do; if i > length (name2) then do; code = error_table_$bad_arg; goto BAD_ATTACH; end; j = search (substr (name2, i), ", ") - 1; if j < 0 then j = length (name2) - i + 1; max_rec_len = cv_dec_check_ (substr (name2, i, j), code); if code ^= 0 then do; code = error_table_$bad_arg; goto BAD_ATTACH; end; end; /* do the special block function only when block=nnnn not specified for individual attach */ else if user_block_size_sw then max_rec_len = max (user_block_size, max_rec_len); /* don't go too small */ call tdcm_$tdcm_set_buf_size (tsegp, max_rec_len, code); if code ^= 0 then goto BAD_ATTACH; density = 800; tseg.density = "00100"b; i = index (name2, ",density=") + 9; if i <= 9 then i = index (name2, ",den=") + 5; if i > 5 then do; if i > length (name2) then do; code = error_table_$bad_arg; goto BAD_ATTACH; end; j = search (substr (name2, i), ", ") - 1; if j < 0 then j = length (name2) - i + 1; density = cv_dec_check_ (substr (name2, i, j), code); if code ^= 0 then do; code = error_table_$bad_arg; goto BAD_ATTACH; end; end; if density = 1600 then do; rdycmd = bin ("65"b3); tseg.density = "00010"b; end; else if density = 800 then do; rdycmd = bin ("60"b3); tseg.density = "00100"b; end; else if density = 556 then do; rdycmd = bin ("61"b3); tseg.density = "01000"b; end; else if density = 200 then do; rdycmd = bin ("64"b3); tseg.density = "10000"b; end; else if density = 6250 then do; rdycmd = bin ("41"b3); tseg.density = "00001"b; end; else do; code = error_table_$bad_arg; goto BAD_ATTACH; end; call tdcm_$tdcm_set_signal (tsegp, code); /* enable special interrupt so we */ /* know when operator mounts tape */ if code ^= 0 then go to BAD_ATTACH; /* error */ call ioa_ ("Tape ^a will be mounted with ^[a^;no^] write ring.", name, (ring = 1)); temp_name = name; call tdcm_$tdcm_message (tsegp, temp_name, ring, code); /* Send mount message */ if code ^= 0 then go to BAD_ATTACH; /* error */ /* and send info to user */ name = temp_name; name_size = length (rtrim (name)); /* Do readiness checking/waiting */ call wait; /* wait for operator */ if code ^= 0 then go to BAD_ATTACH; /* trouble?? */ call ioa_ ("Tape ^a mounted on drive ^a with ^[a^;no^] write ring.", name, tseg.drive_name, (ring = 1)); return; /* and go home */ BAD_ATTACH: substr (st, 52, 1) = "1"b; /* detach bit */ substr (st, 1, 36) = unspec (code); call clear_attach; /* release drive and stream data block */ return; DCM_ERR: substr (st, 1, 36) = unspec (code); /* standard code was returned */ return; /* So there */ /* R E A D E N T R Y P O I N T */ nstd_read: entry (sdb_ptr, wksp, off, nelem, nelemt, st); nelemt = 0; /* Clear it, right away, in case of errors or EOF */ call check_rewind; count = stream_data_block.retry_cnt; /* Initialize for possible retries */ if fix_rec then do; if fix_init then do; no_data_sw = "1"b; /* no data yet */ tseg.buffer_offset = 0; /* put data in first set of buffs */ tseg.buffer_count = buf_count; /* no. of buffers to read */ tseg.write_sw = 0; /* set io to read */ call tdcm_$tdcm_iocall (tsegp, code); /* start read */ fix_init = "0"b; end; if tseg.write_sw = 0 then go to fix_read; /* continue reading */ call reset_fix_rec; /* finish write */ end; tseg.write_sw = 0; /* set to read */ if nelem > max_rec_len then go to BAD_BUF; RLOOP: tseg.buffer_size (1) = nelem; /* We'll read no more than we can, and maybe less */ tseg.buffer_count = 1; tseg.command_count = 0; /* This is what makes the dcm know it's a read/write request */ tseg.buffer_offset = 0; /* use the 1st buffer */ call tdcm_$tdcm_iocall (tsegp, code); /* Go get 'em */ if code ^= 0 then go to DCM_ERR; if tseg.completion_status = 1 then do; /* Good read */ call move (1); /* move data to user's buffer */ GOOD_OUT: /* Common successful return point */ substr (st, 1, 36) = "0"b; nelemt = tseg.buffer_size (1); return; end; /* Here on bad completion status--retry if not done with count */ RECOV: if substr (tseg.hardware_status, 3, 4) = "0100"b then go to BAD_ORD; /* If it's EOF send it back */ if substr (tseg.hardware_status, 3, 4) = "0011"b /* data alert */ then if (substr (tseg.hardware_status, 7, 6) & "100010"b) = "000010"b then go to BAD_ORD; /* don't try any more--will still get blank tape */ RECOV1: if count > 0 then do; /* More re-tries left */ count = count - 1; /* decrement error retry cnt */ tseg.command_count = 1; /* we'll issue one */ tseg.command_queue (1) = 100110b; /* backspace order */ call tdcm_$tdcm_iocall (tsegp, code); /* let DCM do it */ if code ^= 0 then go to DCM_ERR; /* error */ if tseg.completion_status ^= 1 then do; /* error on bksp */ substr (st, 1, 36) = unspec (error_table_$no_backspace); /* couldn't bksp due */ return; /* to being on bot */ end; if tseg.write_sw = 1 then go to WLOOP; /* retry write */ go to RLOOP; /* retry read */ end; else do; /* can't recover. */ nelemt = tseg.buffer_size (1); /* amount of buffer actually sent */ if tseg.write_sw = 0 then call move (1); /* put data read in user's buffer */ end; /* Here when re-tries or order codes fail */ BAD_ORD: substr (st, 1, 1) = "1"b; /* set high order bit of */ /* status to indicate that actual */ /* tape major and minor status is being returned */ /* and not a standard error code */ if stream_data_block.unload then stream_data_block.rewind = "0"b; /* don't wait for special */ /* interrupt after rewind if tape unloaded */ substr (st, 25, 12) = tseg.hardware_status; /* return major/minor status */ return; fix_read: /* proc to do quick reads for fixed recs */ fix_sw = "0"b; /* indicate read */ fix_com: if nelem ^= fix_rec_size then go to BAD_BUF; /* must ask for 1 buff at a time */ if no_data_sw then do; /* any data left ? */ if eof_bit then do; /* did we get eof last time ? */ substr (st, 1, 1) = "1"b; /* yes reflect status */ substr (st, 25, 12) = substr (sav_stat, 1, 12); /* put in saved eof code (9 or 7) */ eof_bit = "0"b; fix_init = "1"b; /* restart read */ return; /* done it */ end; if eot_bit then do; /* have we already said eot ? */ substr (st, 1, 1) = "1"b; /* yes, but do it again */ substr (st, 25, 12) = "000011100000"b; /* eot status */ return; /* maybe we can convince him */ end; bufchk = tseg.buffer_offset; /* return data starting with this buff */ setbit = bit (bin (tseg.buffer_offset, 18), 18); /* switch buffers with x-or */ restart: setbit = bool (setbit, buf_mask, "0110"b); /* do sw */ tseg.buffer_offset = bin (setbit, 17); /* get number */ tseg.sync = 0; /* make sure */ tseg.buffer_count = buf_count; /* read n buffers of data */ call tdcm_$tdcm_iocall (tsegp, code); /* start io */ if code ^= 0 then go to DCM_ERR; if tseg.completion_status ^< 2 then do; /* bad error */ string (hsbc) = tseg.hardware_status; /* copy status */ if hsbc.maj = "0100"b then do; data_count = tseg.error_buffer - 1;/* indicate amt we got */ sav_stat = tseg.hardware_status; /* save for 9 or 7 code */ if data_count = 0 then go to BAD_ORD; /* no more data send error */ eof_bit = "1"b; /* tape mark */ no_data_sw = "0"b; go to fix_out; /* finish proccessing data */ end; if hsbc.maj ^= "0011"b then go to BAD_ORD; /* only recoverable is data alert */ if hsbc.min & "100000"b then do; /* eot marker sensed (write only) */ setbit = bool (setbit, buf_mask, "0110"b); /* switch buffers */ tseg.buffer_offset = bin (setbit, 17) + tseg.error_buffer; /* start with one after eot mark */ tseg.buffer_count = buf_count - tseg.error_buffer; /* and do only ones remaining */ call tdcm_$tdcm_iocall (tsegp, code); setbit = bool (setbit, buf_mask, "0110"b); tseg.buffer_offset = bin (setbit, 17); /* set to do next bunch */ tseg.buffer_count = buf_count; /* set to reissue past io(last one completed) */ call tdcm_$tdcm_iocall (tsegp, code); /* go to DCM */ substr (st, 1, 1) = "1"b; /* reflect eot to user */ substr (st, 25, 12) = "000011100000"b; /* eot status */ eot_bit = "1"b; /* remember this fact */ return; /* go to user */ end; do j = 1 to count; /* retry io */ setbit = bool (setbit, buf_mask, "0110"b); /* back to buffers which failed */ tseg.buffer_offset = bin (setbit, 17); /* set tseg */ do i = 1 to tseg.error_buffer; /* backspaces n times */ tseg.command_queue (i) = 100110b; /* backspace rec op */ end; tseg.command_count = tseg.error_buffer; /* go to it */ tseg.buffer_count = 0; /* clear it since last attempt didnt go */ tseg.sync = 1; /* we will wait for these io's */ call tdcm_$tdcm_iocall (tsegp, code); /* do backup */ if code ^= 0 then go to DCM_ERR; if tseg.completion_status ^< 2 then do; /* bad error */ substr (st, 1, 36) = unspec (error_table_$no_backspace); return; end; tseg.buffer_count = buf_count; /* retry io again */ call tdcm_$tdcm_iocall (tsegp, code); /* go -- this is sync so it will wait */ if tseg.completion_status < 2 then go to restart; /* go this time restart the io we wanted */ end; go to BAD_ORD; /* retry failed us */ end; no_data_sw = "0"b; /* we data now */ data_count = buf_count; /* this much */ end; fix_out: /* come here to finish sending data */ call move (bufchk + 1); /* move data to buffer */ bufchk = bufchk + 1; /* this one next time */ data_count = data_count - 1; /* reduce number of buffers full */ if data_count = 0 then no_data_sw = "1"b; /* set sw saying none left */ nelemt = nelem; /* set count */ substr (st, 1, 36) = "0"b; /* no error */ return; /* W R I T E E N T R Y P O I N T */ nstd_write: entry (sdb_ptr, wksp, off, nelem, nelemt, st); nelemt = 0; /* Clear it */ call check_rewind; count = stream_data_block.retry_cnt; /* no. of possible retries */ if fix_rec then do; if fix_init then do; tseg.sync = 0; no_data_sw = "0"b; /* mark buffers empty now */ data_count = buf_count; /* n to fill before write */ tseg.buffer_offset = buf_count; /* set so first switch will go */ bufchk = 0; /* start filling buffers at offset 0 */ tseg.write_sw = 1; fix_init = "0"b; end; if tseg.write_sw = 1 then go to fix_r_write; /* check for write access */ call reset_fix_rec; /* clean up after read */ end; tseg.write_sw = 1; /* set io to write */ if nelem > max_rec_len then do; /* buffer too large for DCM? */ BAD_BUF: substr (st, 1, 36) = unspec (error_table_$buffer_big); /* put error in status */ return; end; WLOOP: tseg.buffer_size (1) = nelem; /* copy no elements */ tseg.command_count = 0; /* not doing a special command */ tseg.buffer_count = 1; /* one buffer */ tseg.buffer_offset = 0; /* use the 1st buffer */ call move (1); /* move data into tseg buffer for write */ call tdcm_$tdcm_iocall (tsegp, code); /* issue write */ if code ^= 0 then go to DCM_ERR; /* error */ if tseg.completion_status = 1 then go to GOOD_OUT; /* success */ if substr (tseg.hardware_status, 3, 5) = "00111"b then do; /* If it's EOT send it back */ nelemt = tseg.buffer_size (1); /* But give him the nelemt */ go to BAD_ORD; end; go to RECOV1; /* go try to recover from write error */ fix_r_write: fix_sw = "1"b; /* indicate write */ go to fix_com; /* go to common routine for this */ /* O R D E R E N T R Y P O I N T */ nstd_order: entry (sdb_ptr, order, ap, st); call check_rewind; ord = order; /* Copy arg for better code */ if fix_rec then call reset_fix_rec; /* clear out buffers */ do i = lbound (ord_tab, 1) to hbound (ord_tab, 1);/* look in table for common orders */ if ord = ord_tab (i).oname then do; tseg.command_queue (1) = bin (ord_tab (i).cmd); /* hit..pick up command */ if i = 11 then stream_data_block.unload = "1"b; /* remember that unload done */ if i = 12 then stream_data_block.rewind = "1"b; /* remember that rewind done */ go to COM; /* go issue command */ end; end; if ord = "fixed_record_length" then do; /* fix_rec order call */ fix_rec = "1"b; /* set bit */ fix_rec_size = newerr; /* just happens to be based var with ptr to arg */ buf_count = divide (max_rec_len, fix_rec_size, 17, 0); /* get num buffers */ if buf_count < 1 then go to BAD_BUF; /* too big? */ if buf_count > 6 then buf_count = 6; /* 6 is most we can use */ tseg.get_size = 0; /* no sizes, we know them */ buf_mask = bit (bin (buf_count, 18), 18); /* for x-or of buffer offset */ eof_bit, eot_bit = "0"b; /* reset bits */ tseg.sync = 0; /* set sync mode for io */ do i = 1 to 2 * buf_count; /* init buffer sizes and ptrs */ tseg.buffer_size (i) = fix_rec_size; /* known size */ tseg.bufferptr (i) = bin (rel (addrel (addr (tseg.buffer (1)), (i - 1) * fix_rec_size)), 17); /* rel buf addrs */ end; fix_init = "1"b; /* start io on 1st read */ go to ORD_OUT; /* return */ end; if ord = "bcd" then do; /* "bcd" hardware mode */ do i = 1 to 12; tseg.mode (i) = 1; end; go to ORD_OUT; end; if ord = "binary" then do; /* "binary" hardware mode */ do i = 1 to 12; tseg.mode (i) = 0; end; go to ORD_OUT; end; if ord = "nine" then do; /* "nine" hardware mode */ do i = 1 to 12; tseg.mode (i) = 2; end; go to ORD_OUT; end; if ord = "saved_status" then do; STAT: ap -> sst = tseg.hardware_status; /* copied from tseg; this will get special iom stuff too */ go to ORD_OUT; end; if ord = "request_status" then do; tseg.command_count = 1; tseg.command_queue (1) = 000000b; call tdcm_$tdcm_iocall (tsegp, code); /* call DCM */ if code ^= 0 then go to DCM_ERR; if tseg.completion_status ^= 1 then go to BAD_ORD; go to STAT; end; if ord = "err_count" then do; if ap = null then do; /* new error supplied? */ stream_data_block.retry_cnt = 10; /* no..use default */ go to ORD_OUT; end; if newerr > 100 | newerr < 0 then go to UOR; /* yes..is it legal ? */ stream_data_block.retry_cnt = newerr; /* yes..use it */ go to ORD_OUT; end; UOR: substr (st, 1, 36) = unspec (error_table_$undefined_order_request); /* bum order */ return; COM: if stream_data_block.rewind then do; /* rewind to be done?? */ call tdcm_$tdcm_set_signal (tsegp, code); /* yes..tell DCM we want to know when it's done */ if code ^= 0 then go to DCM_ERR; /* DCM squawked */ end; tseg.command_count = 1; call tdcm_$tdcm_iocall (tsegp, code); /* issue order */ if tseg.completion_status ^= 1 then go to BAD_ORD; if stream_data_block.rewind then /* was a rewind just issued? */ if substr (tseg.hardware_status, 3, 4) = "0"b & /* yes..was the tape */ substr (tseg.hardware_status, 11, 1) then do; /* positioned on load point? */ stream_data_block.rewind = "0"b; /* yes..turn off rewind sw */ call tdcm_$tdcm_reset_signal (tsegp, code); /* there won't be a special interrupt */ if code ^= 0 then go to DCM_ERR; /* goof */ end; ORD_OUT: substr (st, 1, 36) = "0"b; /* return good status */ return; nstd_getsize: entry (sdb_ptr, size, st); dcl size fixed bin; size = 36; /* nstd_ deals only in words */ return; /* D E T A C H E N T R Y P O I N T */ nstd_detach: entry (sdb_ptr, type, name2, st); call check_rewind; if fix_rec then do; call reset_fix_rec; end; if stream_data_block.unload then go to DET; /* don't unload if user already did */ tseg.buffer_count = 0; tseg.command_queue (1) = 111000b; /* rewind tape */ tseg.command_count = 1; call tdcm_$tdcm_iocall (tsegp, code); /* have DCM do it */ if code ^= 0 then go to DCM_ERR; /* error */ if tseg.completion_status ^= 1 then go to BAD_ORD; /* failure on order */ DET: call tdcm_$tdcm_detach (tsegp, code); /* detach tape drive */ if code ^= 0 then go to DCM_ERR; /* error */ call hcs_$delentry_seg (sdb_ptr, code); /* then try to get rid of sdb */ if code ^= 0 then do; /* error */ substr (st, 1, 36) = unspec (code); /* return error code to caller */ go to DET_BIT; /* but indicate that detach worked */ end; substr (st, 1, 36) = "0"b; DET_BIT: substr (st, 52, 1) = "1"b; /* your detach bit */ return; /* */ nstd_cmode: entry (sdb_ptr, rw, oldrw, st); dcl oldrw char (*); tsegp = tseg_ptr; if tseg.write_sw = 1 then oldrw = "w"; else oldrw = "r"; if (rw ^= "w") & (rw ^= "r") & (rw ^= "rw") & (rw ^= "") then do; substr (st, 1, 36) = unspec (error_table_$bad_mode); return; end; if fix_rec then call reset_fix_rec; /* clear buffs */ if rw = "r" then tseg.write_sw = 0; else tseg.write_sw = 1; substr (st, 1, 36) = "0"b; return; /* */ /* internal proc to clear out write ahead buffs */ reset_fix_rec: proc; tseg.sync = 1; /* set sync for orders */ fix_rec = "0"b; if fix_init then do; /* no io yet - no clean up */ fix_init = "0"b; return; end; if tseg.write_sw = 1 then do; /* write remaining buffers */ setbit = bit (bin (tseg.buffer_offset, 18), 18); setbit = bool (setbit, buf_mask, "0110"b); tseg.buffer_offset = bin (setbit, 17); tseg.buffer_count = bufchk; tseg.command_count = 0; call tdcm_$tdcm_iocall (tsegp, code); if code ^= 0 then go to DCM_ERR; if tseg.completion_status ^< 2 then go to BAD_ORD; if ord = "eof" then do; /* RESET to fixed_length_record */ fix_rec = "0"b; fix_init = "1"b; end; return; end; if eof_bit then do; /* no io pending */ data_count = data_count + 1; /* backspace over file */ eof_bit = "0"b; go to BACKSPACE; /* no io pending */ end; tseg.buffer_count = 0; /* no data transfer */ tseg.command_count = 0; /* no commands */ call tdcm_$tdcm_iocall (tsegp, code); /* complete last read */ if code ^= 0 then go to DCM_ERR; if tseg.completion_status = 0 then go to BACKSPACE; /* no io pending */ if tseg.completion_status = 1 then do; data_count = data_count + buf_count; go to BACKSPACE; end; data_count = data_count + tseg.error_buffer; BACKSPACE: /* backspace records read but not asked for */ tseg.buffer_count = 0; do i = 1 to data_count; tseg.command_count = 1; tseg.command_queue (1) = 100110b; call tdcm_$tdcm_iocall (tsegp, code); /* backspace one record */ if code ^= 0 then go to DCM_ERR; end; return; end; /* */ /* Internal procedure to wait for a special interrupt from the tape controller. */ /* Used to wait for interrupt when tape drive made ready and after a rewind. */ wait: proc; READY_CHK: wait_list.n = 1; /* will wait for one event channel */ wait_list.chn = tseg.ev_chan; /* which is the one associated with this tseg */ call ipc_$block (addr (wait_list), addr (message), code); /* go blocked waiting */ if code ^= 0 then do; /* error */ substr (st, 1, 36) = unspec (code); return; end; /* We could have gotten another drive's wakeup so.... */ tseg.command_count = 1; /* ready to do one order */ tseg.buffer_count = 0; tseg.command_queue (1) = rdycmd; /* which is a reset status */ call tdcm_$tdcm_iocall (tsegp, code); /* issue order */ if code ^= 0 then return; /* goof..exit */ if tseg.completion_status ^= 1 then go to READY_CHK; /* not us..wait some more */ stream_data_block.rewind = "0"b; /* turn off rewind sw */ call tdcm_$tdcm_reset_signal (tsegp, code); /* disable special interrupt */ return; end; /* Move copies data from a tseg buffer into the user's buffer after a read or copies * data from the user's buffer ito a tseg buffer before a write. */ move: proc (no); dcl no fixed bin; /* index to tseg buffer */ dcl ptseg ptr; /* ptr to current tseg buffer */ dcl puser ptr; /* ptr to current user buffer */ ptseg = ptr (tsegp, tseg.bufferptr (no)); /* tseg buffer */ puser = addrel (wksp, off); /* user buffer */ if tseg.write_sw = 1 then ptseg -> dum = puser -> dum; /* copy into tseg buffer for a write */ else puser -> dum = ptseg -> dum; /* copy into user's buffer for a read */ return; end move; /* Called if attachment was not completed. It releases the stream data block and the tape drive */ clear_attach: proc; if attach_sw then call tdcm_$tdcm_detach (tsegp, code); /* detach tape drive */ if sdb_ptr ^= null then call hcs_$delentry_seg (sdb_ptr, code); /* delete stream data block */ return; end clear_attach; /* check_rewind goes blocked if the tape is still rewinding. */ check_rewind: proc; tsegp = tseg_ptr; /* copy for better access */ if stream_data_block.rewind then do; /* wait if rewind just done */ rdycmd = 100000b; /* Use reset status command here. */ call wait; if code ^= 0 then go to DCM_ERR; /* error?? */ end; return; end check_rewind; end; 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