display_volume_log.pl1 11/11/89 1129.5rew 11/11/89 0851.4 95229 /****^ *********************************************************** * * * Copyright, (C) BULL HN Information Systems Inc., 1989 * * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(88-03-01,GWMay), approve(89-10-03,MCR8135), audit(89-10-04,Beattie), install(89-10-18,MR12.3-1094: Changed to display reload group numbers correctly. Added displays for the number of incr and cons cycles are being retained in the volume log. Changed to display at 79 columns. Changed to add the -label, -no_label, -all and -header options. END HISTORY COMMENTS */ /* format: off */ display_volume_log: proc; /* This command displays the data in the specified volume log. This data consists of the names, start and stop times, and statistics about what was dumped onto each dump volume that contains objects from the physical volume that this volume log pertains to. */ /* Modified 4/27/82 by GA Texada to not REQUIRE w acces to display the volog. */ %page; myname = "display_volume_log"; go to COMMON; display_volog: entry; myname = "display_volog"; go to COMMON; dvl: entry; myname = "dvl"; COMMON: /* init control variables */ header_sw = "1"b; type = 0; volname = ""; bvlp = null; entries = 0; seg_num, seg_rec, dir_num, dir_rec = 0; locked, stats, label_sw, all_sw = "0"b; on finish call finish_; on cleanup call finish_; volog_dir = ">daemon_dir_dir>volume_backup"; call cu_$arg_ptr (1, argp, argl, code); if code ^= 0 then do; argerr: call com_err_ (error_table_$noarg, myname); call ioa_ ( "Usage:^10t^a volog {-control_args} ^10tcontrol_args:^25t^a^-^a^/^25t^a^-^a^/^25t^a^-^a^/^25t^a^-^a^/^25t^a^-^a^/^25t^a", myname, "-incremental, -incr ", "-header, -he ", "-consolidated, -cons ", "-no_header, -nhe ", "-complete, -comp ", "-label, -lbl ", "-volname name, -vol name", "-no_label, -nlbl ", "-working_dir, -wd ", "-status, -st ", "-all, -a "); return; end; if substr (arg, 1, 1) = "-" then goto argerr; call expand_pathname_$add_suffix(arg, "volog", ignore_dir, volog_name, ignore); call cu_$arg_count (narg); ac = 2; do while (ac <= narg); call cu_$arg_ptr (ac, argp, argl, code); if code ^= 0 then do; call com_err_ (code, myname, "Unable to access arg after ^a", arg); goto finale; end; if arg = "-incremental" | arg = "-incr" then type = incr; else if arg = "-working_dir" | arg = "-wd" then volog_dir = wdir_ (); else if arg = "-consolidated" | arg = "-cons" then type = cons; else if arg = "-complete" | arg = "-comp" then type = comp; else if arg = "-all" | arg = "-a" then all_sw = "1"b; else if arg = "-header" | arg = "-he" then header_sw = "1"b; else if arg = "-nhe" | arg = "-no_header" then header_sw = "0"b; else if arg = "-label" | arg = "-lbl" then label_sw = "1"b; else if arg = "-no_label" | arg = "-nlbl" then label_sw = "0"b; else if arg = "-status" | arg = "-st" | arg = "-stats" then do; type = -1; stats = "1"b; end; else if arg = "-vol" | arg = "-volname" then do; ac = ac + 1; call cu_$arg_ptr (ac, argp, argl, code); if code ^= 0 then do; call com_err_ (code, myname, "Error getting volname"); goto finale; end; volname = arg; type = -1; end; else do; call com_err_ (error_table_$badopt, myname, "^a", arg); goto finale; end; ac = ac + 1; end; /* pick up name of volume log */ /* get pointer to volume log */ call hcs_$initiate (volog_dir, volog_name, "", 0, 0, bvlp, code); if bvlp = null then do; call com_err_ (code, myname, "^a>^a", volog_dir, volog_name); goto finale; end; /* If possible, lock log before printing */ call set_lock_$lock (backup_volume_log.lock, lock_wait_time, code); if code ^= 0 then do; if code = error_table_$invalid_lock_reset then code = 0; else do; if code = error_table_$no_w_permission then do; call ioa_("Unable to lock ^a, data may be in the process of being changed.", volog_name); goto cant_lock; end; call com_err_ (code, myname, "Unable to lock volog ^a", volog_name); goto finale; end; end; locked = "1"b; cant_lock: if label_sw | all_sw then do; call ioa_ (" Backup Volume Log Label for Multics Storage System Volume ^a^/", volog_name); call display_disk_label_ (addr (addr (backup_volume_log.info) -> backup_pvol_info.label)); if ^all_sw & type=0 then go to finale; end; if header_sw then do; call ioa_ (" ^2-Backup Volume Log for Physical Volume ^a ^2- Consolidated Sets Saved: ^[all^s^;^d^] ^2- Incremental Sets Saved : ^[all^s^;^d^] ^2- Reload Groups : ^d", reverse(after(reverse(volog_name), ".")), backup_volume_log.Nsaved_cons_sets < 1, backup_volume_log.Nsaved_cons_sets, backup_volume_log.Nsaved_incr_sets < 1, backup_volume_log.Nsaved_incr_sets, backup_volume_log.reload_groups); if ^stats then call ioa_ (" rld dump volume^57tdir dir seg seg grp type name^22tstart time^39tstop time^57tnum rec num rec"); else call ioa_ ("entries^-dir num^-dir rec^-seg num^-seg rec"); end; else call ioa_ (""); /* Examine each entry in the log and print as requested */ comp_cycle_uid = "0"b; group = 1; comp_open_time = 0; do i = backup_volume_log.next to 1 by -1; bvlep = addr (backup_volume_log.array (i)); if (volname ^= "" & volname = bvle.volname) | (volname = "") | stats then do; if bvle.dump_type = comp then do; if bvle.cycle_uid ^= comp_cycle_uid then do; if comp_cycle_uid ^= "0"b then group = group + 1; comp_cycle_uid = bvle.cycle_uid; do lowest_start_idx = i to 1 by -1; if backup_volume_log.array (lowest_start_idx).cycle_uid = bvle.cycle_uid then comp_open_time = backup_volume_log.array (lowest_start_idx).open_time; end; end; end; if ^stats then if type = 0 | type = bvle.dump_type then call ioa_ ("^[^2d^s^;^s^2d^] ^4a ^10a^22t^15a^39t^15a^55t^5d ^5d ^5d ^6d", (comp_open_time < bvle.close_time & bvle.close_time > 0), group, group + 1, ascii_type (bvle.dump_type), bvle.volname, time_string_ (bvle.open_time), time_string_ (bvle.close_time), bvle.dir_num, bvle.dir_rec, bvle.seg_num, bvle.seg_rec); else; else do; entries = entries + 1; dir_num = dir_num + bvle.dir_num; dir_rec = dir_rec + bvle.dir_rec; seg_num = seg_num + bvle.seg_num; seg_rec = seg_rec + bvle.seg_rec; end; end; end; if stats then call ioa_ ("^d^-^d^-^d^-^d^-^d", entries, dir_num, dir_rec, seg_num, seg_rec); finale: /* cleanup - unlock and terminate */ call finish_; return; time_string_: proc (time) returns (char (15)); /* This proc returns a time string suitable for printing */ dcl time fixed bin (71); return (date_time_$format ( "^my/^dm/^yc ^Hd^99v.9MH", time, "", "")); end time_string_; finish_: proc; if (bvlp ^= null) & (locked) then call set_lock_$unlock (backup_volume_log.lock, ignore); if bvlp ^= null then call hcs_$terminate_noname (bvlp, ignore); call ioa_ (""); end finish_; wdir_: proc returns (char (168) aligned); /* This proc returns the working directory */ dcl wdir char (168) aligned; call hcs_$fs_search_get_wdir (addr (wdir), ignore); return (wdir); end wdir_; %page; dcl volog_name char (32); dcl lowest_start_idx fixed bin; dcl group fixed bin; dcl comp_cycle_uid bit (36); dcl comp_open_time fixed bin (71); dcl narg fixed bin; dcl volog_dir char (168); dcl arg char (argl) based (argp); dcl argl fixed bin; dcl argp ptr; dcl i fixed bin; dcl ac fixed bin; dcl ignore_dir char(168); dcl volname char (32); dcl seg_num fixed bin; dcl seg_rec fixed bin; dcl entries fixed bin; dcl dir_rec fixed bin; dcl dir_num fixed bin; dcl stats bit (1); dcl code fixed bin (35); dcl ignore fixed bin (35); dcl type fixed bin; dcl header_sw bit (1); dcl label_sw bit (1); dcl all_sw bit (1); dcl locked bit(1); dcl myname char (32) var; dcl ascii_type (3) char (4) int static init ("incr", "cons", "comp") options(constant); dcl lock_wait_time fixed bin static init(30) options(constant); dcl hcs_$fs_search_get_wdir entry (ptr, fixed bin (35)); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl com_err_ entry options (variable); dcl display_disk_label_ entry (ptr); dcl expand_pathname_$add_suffix entry (char(*), char(*), char(*), char(*), fixed bin(35)); dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35)); dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); dcl ioa_ entry options (variable); dcl date_time_$format entry (char(*), fixed bin(71), char(*), char(*)) returns(char(250) var); dcl set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35)); dcl set_lock_$unlock entry (bit (36) aligned, fixed bin (35)); dcl cu_$arg_count entry (fixed bin); dcl error_table_$badopt ext fixed bin (35); dcl error_table_$invalid_lock_reset ext fixed bin (35); dcl error_table_$noarg fixed bin(35) ext static; dcl error_table_$no_w_permission ext static fixed bin(35); dcl (finish, cleanup) condition; dcl (null, addr, after, reverse, substr) builtin; %page; %include backup_volume_log; %include backup_pvol_info; %include fs_vol_label; %include backup_volume_header; %include backup_static_variables; end display_volume_log;  rdisk_.pl1 11/11/89 1129.5rew 11/11/89 0851.4 1035666 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-09-09,Farley), approve(85-09-09,MCR6979), audit(86-02-21,Coppola), install(86-03-21,MR12.0-1033): Support the IBM3380 remove support of MSU0509. 2) change(86-01-16,Fawcett), approve(86-04-11,MCR7383), audit(86-06-06,GWMay), install(86-07-17,MR12.0-1097): Add support for subvolumes, and 512_WORD_IO, 3380 and 3390. 3) change(86-10-02,Fawcett), approve(86-10-02,PBF7383), audit(86-10-23,Farley), install(86-10-28,MR12.0-1200): Changed 3390 to 3381, "d338" to "3380" & "d339" to "3381". 4) change(87-03-31,Blair), approve(87-03-31,MCR7666), audit(87-06-25,Fawcett), install(87-07-15,MR12.1-1041): Change the setup for Stream_output to equate to put_chars instead of get_chars. END HISTORY COMMENTS */ /* format: style3,linecom,ifthenstmt,indthenelse,^indnoniterdo,indend,dclind5,idind32 */ rdisk_: proc; return; /* should never enter here */ /* MODIFICATION HISTORY: Initially coded by J. A. Weeldreyer -- March, 1975. Modified to conform to new ioi_ interface by J. A. Weeldreyer -- April, 1975. Modified to conform to the rcp_ interface by J. A. Weeldreyer -- July, 1975. modified -- December, 1975 by J. A. Bush to add the raw mode and the format_trk, rd_trk_header, and device_info control orders. Modified to support the new io_call control mechanism By L. E. Johnson -- May, 1976 Modified to provide sequential_(input output update) opening modes, position operation, write_record operation, and more device types by Jim Gildersleeve and Jim Falksen -- 1976 June. Modified by D. R. Vinograd to provide limited stream support for the volume reloader. - July 1976 Modified by Michael R. Jordan on 01/31/79 for MSU0500s Modified 9/79 by R.J.C. Kissel for MSU0501's. Modified 11/79 by Michael R. Jordan for MSU0500 formatting. Modified 1/80 by Michael R. Jordan to add -device and -model control arguments. Modified 2/80 by Michael R. Jordan for MSU0501 and bug fixes. Modified May 1982 by J. Bongiovanni for larger buffers Modified 3/83 by GA Texada for changes made by W. Olin Sibert to make large buffers work and assorted other bugfixes. */ /* DESCRIPTION: * This I/O module supports I/O from/to removable disk packs. * Sequential and indexed file types are supported. * * Entries in this module are not called directly by users; * rather, the module is accessed through the I/O system. See the * MPM section, the Multics I/O System, for a general description of * the I/O system, and see the MPM section, File I/O, for a * discussion of files. * * This I/O module provides a very elementary, physical device * oriented I/O facility, and is the basic user-level interface to a * disk device. All operations are performed through calls to * various I/O Interfacer (ioi_) and Resource Control Package (rcp_) * entries. This I/O module provides the capability to read/write * a caller-specified number of characters to/from a disk_pack. * Supported device types are DSU181, DSU190, DSU191, MSU0400, * MSU0451, MSU0500, MSU0501, MSU3380 and MSU3381. */ /* NOTES: */ %include iocbx; %include iom_pcw; %include iom_dcw; %include track_header_info; %include rcp_disk_info; %include fs_dev_types; %include iox_modes; dcl 1 disk_data based (disk_ptr), /* rdisk_ data structure */ 2 attach_descrip aligned, /* Current attach description */ 3 length fixed bin (17), /* Length of description in chars. */ 3 descrip char (168), /* the actual description */ 2 attach_data aligned, /* attachment data for use by rdisk_ */ 3 sze fixed bin (35), /* if ^= 0 => size specified in attach or control */ ( 3 err_sw, /* on if error messages are to be printed */ 3 write_sw, /* on if device is to be mounted in write mode */ 3 compare_sw, /* on if Write_and_Compare idcw is to be used for writes */ 3 raw_sw, /* ON => raw mode */ 3 alt_sw, /* ON => alt mode */ 3 label_sw, /* ON => label mode */ 3 sys_sw ) bit (1) unal, /* on if this is a privileged system process */ 3 pack_id char (32), /* Current disk pack id. */ 3 rcp_id bit (36), /* rcp unique id. */ 3 max_buff_size fixed bin (19), /* ioi_ buffer size limit set by rcp_ */ 3 wait_list, /* event channel information */ 4 nchan fixed bin, /* number of channels (currently using 1) */ 4 ev_chan fixed bin (71), /* event channel id. */ 3 dev_type fixed bin, /* device type indicator */ 3 devx fixed bin, /* device index returned by ioi_ */ 3 drive fixed bin (6), /* drive number returned by ioi_ */ 3 errors fixed bin, /* error count */ 3 sect_per_dev fixed bin (35), /* sectors per device */ 3 sect_size fixed bin (12), /* quantity of words in one sector */ 3 num_alt_sect fixed bin, /* quantity of sectors reserved for alternate sector usage */ 3 device_group fixed bin, /* 1 = MSU04XX */ /* 2 = MSU0500/1 */ /* 3 = MSU3380/90 */ 3 is_sv bit (1), /* attach subvolume */ 3 sv_num fixed bin, /* attached subvolume number */ 3 att_dev_idx fixed bin, /* index into attachments array for this device */ 3 att_sv_idx fixed bin, /* index into attachments array of this device subvolume */ 2 open_descrip aligned, /* open description */ 3 length fixed bin (17), /* number of characters in open descrip. */ 3 descrip char (32), /* the actual open descrip. */ 2 open_data aligned, /* more rdisk_ data */ 3 mode fixed bin, /* mode number: 4 = sq_i, 5 = sq_o, 7 = sq_u, 11 = d_i, 13 = d_u */ 3 buf_ptr ptr, /* pointer to buffer created by ioi_$workspace */ 3 fill bit (9), /* Fill left-over part of last sector of the current record with this value when writing. */ 3 buf_len fixed bin (19), /* length (words) of buffer */ 3 data_len fixed bin (19), /* length of data area in buffer */ 3 time_int fixed bin (71), /* current time out interval */ 3 next_key fixed bin (35), /* next key as per iox_ */ 3 current_key fixed bin (35), /* current key as per iox_ */ 3 key_for_insertion fixed bin (35), /* key for insertion as per iox_ */ /* key_for_insertion is always null for the present implementation, since write_record is not supported for direct_update. */ 3 bounds, /* current key boundaries */ 4 low fixed bin (35), /* the lower bound */ 4 high fixed bin (35), /* higher bound */ 3 mode_string char (32) varying, /* current modes */ 3 rcp_data (size (disk_info)) fixed bin (35); /* area for rcp_disk_info structure */ dcl 1 attachments based (attachments_ptr), 2 number_attached fixed bin, 2 number_used fixed bin, 2 array (100), 3 device_att char (8), 3 sv (3), 4 this_sv fixed bin, 4 this_iocbp ptr; dcl attachments_ptr ptr static init (null ()); dcl system_area_ptr ptr; dcl system_area area based (system_area_ptr); dcl 1 status based (addr (iom_stat)), /* breakout of iom_stat */ 2 pad bit (2) unal, /* not used */ 2 maj bit (4) unal, /* major status */ 2 sub bit (6) unal, /* sub status */ 2 pad2 bit (48) unal, /* not used */ 2 residue bit (12) unal; /* tally residue */ dcl 1 seek aligned, 2 block_count_limit fixed bin (12) unsigned unal, 2 ti bit (2) unal, 2 mbz bit (1) unal, 2 sector fixed bin (21) unsigned unal; dcl 1 super_seek aligned, 2 sector_number fixed bin (8) unsigned unal, 2 mbz1 bit (4) unal, 2 ti bit (2) unal, 2 is_super_seek bit (1) unal, 2 flag bit (1) unal, 2 mbz2 bit (4) unal, 2 cyl_lower fixed bin (8) unsigned unal, 2 cyl_upper fixed bin (2) unsigned unal, 2 head fixed bin (6) unsigned unal; dcl 1 buffer based (buf_ptr), /* ioi_ buffer */ 2 control_info, /* device control data */ 3 ( rst_idcw, sk_idcw, sk_dcw, rw_idcw, rw_dcw (70), rsr_idcw, rsr_dcw ) bit (36) aligned, /* DCW's */ 3 seek_data like seek, /* Information for seek DCW */ 3 rsr_data bit (72) unal, /* detailed device status read by RSR */ 3 reserved (6) fixed bin (35), /* pad for future expansion */ 3 istat aligned, /* I/O Interfacer status structure */ 4 completion, /* completion flags */ ( 5 st bit (1), /* "1"b if status returned */ 5 er bit (1), /* "1"b if status indicates error condition */ 5 run bit (1), /* "1"b if channel still running */ 5 time_out bit (1) ) unal, /* "1"b if time-out occurred */ 4 level fixed bin (3), /* IOM interrupt level */ 4 offset fixed bin (18), /* DCW list offset */ 4 absaddr fixed bin (24), /* absolute address of workspace */ 4 iom_stat bit (72), /* IOM status */ 4 lpw bit (72), /* LPW residue */ 2 data char (4 * data_len); /* data area */ dcl 1 event_info aligned, /* event message info */ 2 chan_id fixed bin (71), 2 message, 3 pad1 bit (15) unal, 3 int_level bit (3) unal, 3 pad2 bit (36) unal, 3 special_type fixed bin (17) unal, 2 sender bit (36), 2 origin, 3 dev_signal bit (18) unal, 3 ring bit (18) unal, 2 chan_x fixed bin; dcl 1 tp_info, /* terminate_process_ information */ 2 version fixed bin, /* version no. (currently 0) */ 2 code fixed bin (35); /* error code to be printed before process is termed */ dcl 1 query_info aligned, /* command_query_ information */ 2 version fixed bin init (2), 2 yes_or_no_sw bit (1) unal init ("1"b), /* want only "yes" or "no" */ 2 suppress_name_sw bit (1) unal init ("0"b), /* let them know who we are */ 2 (status_code, query_code) fixed bin (35) init (0); dcl pri_iocb_ptr ptr; dcl (disk_ptr, iocb_ptr, real_iocb_ptr, ubuf_ptr, block_ptr, rs_ptr, info_ptr, fmdp) ptr init (null); /* pointers */ dcl dcw_offset fixed bin (18); /* offset in ioi_ buffer to first IDCW */ dcl (code, rec_len, tot_rec_len, data_left, mode_len, mode_start) fixed bin (35); dcl key fixed bin (21); /* working seek key */ dcl control_command bit (6); /* data xfer command in execution */ dcl track_indicators bit (2) init ("00"b); /* track indicator bits for seek cmd */ dcl (count_limit_fixed, block_len) fixed bin (12); dcl (i, j, num_opts, err_ct, old_length, new_length, rcp_state) fixed bin; dcl (cyl, head) fixed bin (16); dcl (again, not_sw, mode_err_sw, cont_sw) bit (1) unal; dcl answer char (3) varying; dcl block char (4 * block_len) based (block_ptr); /* current user data block */ dcl dev_id char (4); /* alpha device id, e.g. D191 */ dcl rs_mode fixed bin (5); /* rcp_sys_ access mode for this process */ dcl old_descrip char (168); /* hold area for changing attach descrip. */ dcl new_pack_id char (32) varying based (info_ptr); /* new pack id for changepack order */ dcl 1 user_bounds based (info_ptr), /* current bounds returned via this structure */ 2 low fixed bin (35), 2 high fixed bin (35); dcl new_size fixed bin (35) based (info_ptr); /* new size for setsize control order */ dcl new_modes char (24); /* new modes for modes oper. */ dcl next_mode char (8) varying init ("dummy"); dcl mask_str bit (36) aligned; /* ips_ mask */ dcl 1 mask based (addr (mask_str)), /* different def'n of above */ 2 pad bit (35) unal, /* we don't use this */ 2 masked bit (1) unal; /* flag to indicate if we are masked */ dcl temp_key fixed bin (35); dcl 1 drive_number, 2 sign char (1), 2 number char (2); dcl drive_dec dec (2) based (addr (drive_number)); /* used for drive number conversion */ dcl drive_name char (8); /* name of the requested device or spaces */ dcl model_number fixed bin; /* model number requested by user */ dcl DEVICE_GROUP (9) fixed bin int static options (constant) init (0, 2, 1, 1, 1, 1, 2, 3, 3); /* "bulk", "d500", "d451", "d400", "d190", "d181", "d501", "3380", "3381" */ dcl FORMAT_DATA_LEN (9) fixed bin int static options (constant) init (0, 88, 6, 6, 6, 6, 24, 24, 24); dcl MSU04XX fixed bin int static options (constant) init (1); dcl MSU33XX fixed bin init static options (constant) init (3); dcl overhead fixed bin int static options (constant) init (192); /* number of control words reserved in ioi_ buffer */ dcl max_retries int static options (constant) fixed bin init (10); /* number of times we will retry certain operations */ dcl ATTENTION int static options (constant) bit (4) init ("0010"b); dcl EOF int static options (constant) bit (4) init ("0100"b); dcl LAST_BLOCK int static options (constant) bit (6) init ("000001"b); dcl LAST_BLOCK_MASK int static options (constant) bit (6) init ("111101"b); dcl TI_MASK int static options (constant) bit (6) init ("011100"b); dcl STANDBY int static options (constant) bit (6) init ("010000"b); dcl EXEC bit (5) int static options (constant) init ("00100"b); dcl FORMAT_TRK bit (6) int static options (constant) init ("001111"b); dcl RD_TRK_HEADER bit (6) int static options (constant) init ("010111"b); dcl SPECIAL_SEEK bit (6) int static options (constant) init ("011110"b); dcl SPECIAL_SEEK_512 bit (6) int static options (constant) init ("35"b3); dcl LONG_WAIT fixed bin int static options (constant) init (2); dcl COMPLETE fixed bin int static options (constant) init (0); dcl RETAIN bit (1) int static options (constant) init ("1"b); dcl DEFAULT bit (1) int static options (constant) init ("0"b); dcl NOT_SET fixed bin (6) int static options (constant) init (-1); dcl num_label_sect fixed bin int static options (constant) init (8); dcl rcp_dev_type char (32) int static options (constant) init ("disk_drive"); dcl IOTD bit (2) aligned int static options (constant) init ("00"b); dcl MAX_DCW_TALLY fixed bin int static options (constant) init (4096); dcl restore_idcw_string int static bit (36) init ("420000720201"b3); dcl seek_idcw_string int static bit (36) init ("340000720000"b3); dcl seek_dcw_string int static bit (36) init ("000000000001"b3); dcl read_idcw_string int static bit (36) init ("250000700000"b3); dcl write_idcw_string int static bit (36) init ("310000700000"b3); dcl write_and_compare_idcw_string int static bit (36) init ("330000700000"b3); dcl control_idcw_string int static bit (36) init ("000000700000"b3); dcl read_write_dcw_string int static bit (36) init ("000000010000"b3); /* IOTP */ dcl 1 restore_idcw_template defined (restore_idcw_string) like idcw; dcl 1 seek_idcw_template defined (seek_idcw_string) like idcw; dcl 1 seek_dcw_template defined (seek_dcw_string) like dcw; dcl 1 read_idcw_template defined (read_idcw_string) like idcw; dcl 1 write_idcw_template defined (write_idcw_string) like idcw; dcl 1 write_and_compare_idcw_template defined (write_and_compare_idcw_string) like idcw; dcl 1 control_idcw_template defined (control_idcw_string) like idcw; dcl 1 read_write_dcw_template defined (read_write_dcw_string) like dcw; dcl ( error_table_$action_not_performed, /* notacted, The requested action was not performed.; */ error_table_$bad_arg, /* bad_arg , Illegal command or subroutine argument.; */ error_table_$bad_conversion, /* bad_conv, Error in conversion.; */ error_table_$bad_mode, /* badmode , Improper mode specification for this device.; */ error_table_$device_end, /* devend , Physical end of device encountered.; */ error_table_$device_parity, /* xmiterr , Unrecoverable data-transmission error on physical device.; */ error_table_$end_of_info, /* eoi , End of information reached.; */ error_table_$incompatible_attach, /* att^=opn, Attach and open are incompatible.; */ error_table_$invalid_device, /* invdev , Attempt to attach to an invalid device.; */ error_table_$invalid_read, /* invread , Attempt to read or move read pointer on device which was not attached as readable.; */ error_table_$invalid_write, /* invwrite, Attempt to write or move write pointer on device which was not attached as writeable.; */ error_table_$no_current_record, /* fm_16 , no_current_record := there is no current record.; */ error_table_$no_operation, /* no_oper , Invalid I/O operation.; */ error_table_$no_record, /* no_rec , Record not located.; */ error_table_$noarg, /* , Expected argument missing.; */ error_table_$not_attached, /* notattch, I/O switch (or device) is not attached.; */ error_table_$not_closed, /* not_clsd, I/O switch is not closed.; */ error_table_$not_detached, /* not_det , I/O switch is not detached.; */ error_table_$not_open, /* not_open, I/O switch is not open.; */ error_table_$request_not_recognized, /* reqnorec, Request not recognized.; */ error_table_$resource_assigned, error_table_$termination_requested, /* termrqu , Process terminated because of system defined error condition.; */ error_table_$user_not_found, /* usernfd , User-name not on access control list for branch.; */ error_table_$unimplemented_version ) external static fixed bin (35); dcl (abs, addr, addrel, bin, bit, bool, ceil, char, divide, fixed, floor, hbound, index, length, max, min, mod, null, rel, search, size, string, substr, unspec, ltrim, rtrim, verify) builtin; dcl get_system_free_area_ entry () returns (ptr); dcl ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35)); dcl iox_$err_no_operation entry options (variable); dcl iox_$err_not_closed entry options (variable); dcl iox_$err_not_open entry options (variable); dcl ioi_$timeout entry (fixed bin, fixed bin (52), fixed bin (35)); dcl ioi_$workspace entry (fixed bin, ptr, fixed bin (19), fixed bin (35)); dcl sub_err_ entry options (variable); /* The above sub_err_ line used to be for com_err_ but clarification on the rules for writing * I/O modules resulted in two significant decisions: * (1) I/O modules should use the sub_err_ subroutine, not the com_err subroutine. * (2) I/O modules should call sub_err_ _o_n_l_y in their attach routine, * and then only if the value of the third argument equals "1"b. * The next "dcl" statement is associated with sub_err_ */ dcl retval fixed bin (35); /* value returned from caller specifying rdisk_ action */ /* No actions in rdisk_ are defined at the moment. */ /* When actions are defined, which value yields what */ /* action could be listed here. */ dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); dcl hcs_$delentry_seg entry (ptr, fixed bin (35)); dcl iox_$propagate entry (ptr); dcl ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35)); dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); dcl ioi_$connect entry (fixed bin, fixed bin (18), fixed bin (35)); dcl ipc_$block entry (ptr, ptr, fixed bin (35)); dcl ioi_$set_status entry (fixed bin, fixed bin (18), fixed bin (8), fixed bin (35)); dcl ioi_$get_detailed_status entry (fixed bin, bit (1) aligned, bit (*), fixed bin (35)); dcl ioa_$ioa_stream entry options (variable); dcl command_query_ entry options (variable); dcl timer_manager_$sleep entry (fixed bin (71), bit (2)); dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); dcl hcs_$fs_get_mode entry (ptr, fixed bin (5), fixed bin (35)); dcl hcs_$set_ips_mask entry (bit (36) aligned, bit (36) aligned); dcl hcs_$reset_ips_mask entry (bit (36) aligned, bit (36) aligned); dcl default_handler_$set entry (entry); dcl terminate_process_ entry (char (*), ptr); dcl rcp_$attach entry (char (*), ptr, fixed bin (71), char (*), bit (36) aligned, fixed bin (35)); dcl rcp_$check_attach entry (bit (36) aligned, ptr, char (*), fixed bin, fixed bin (19), fixed bin (71), fixed bin, fixed bin (35)); dcl rcp_$detach entry (bit (36) aligned, bit (*), fixed bin, char (*), fixed bin (35)); dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); dcl a_iocb_ptr ptr; /* parameter: IOCB pointer */ dcl a_code fixed bin (35); /* parameter: return code */ dcl a_rec_len fixed bin (21); /* parameter: user record length */ dcl a_ubuf_ptr ptr; /* parameter: pointer to user buffer */ dcl a_ubuf_len fixed bin (21); /* parameter: length (chars.) of user buffer */ dcl 1 fmt_dta based (fmdp) aligned, /* data needed by the format trk command */ 2 svcyl bit (16) unaligned, /* seek verification data cylinder number */ 2 svhd bit (16) unaligned, /* seek verification data head number */ 2 hz bit (2) unaligned, /* header bypass switch */ 2 ti bit (2) unaligned, /* track indicator bits */ 2 pad1 bit (10) unaligned, 2 r0cti bit (2) unaligned, /* record zero track indicators */ 2 r0ccyl bit (16) unaligned, /* record zero count field - cyl number */ 2 r0chd bit (16) unaligned, /* record zero count field - head number */ 2 pad2 bit (2) unaligned, 2 chk_chr bit (6) unaligned, /* exclusive or check character */ 2 pad3 bit (12) unaligned, 2 pad4 bit (72) unaligned; dcl 1 fmt_info based (info_ptr) aligned, /* user supplied structure for format_trk order */ 2 hz bit (2) unaligned, /* header bypass information */ 2 ti bit (2) unaligned, /* track indicator bits */ 2 alt_def_cyl fixed bin (16) unaligned, /* user supplied cyl and head address for alt or */ 2 alt_def_hd fixed bin (16) unaligned; /* defective track address */ dcl info_block char (20) based (info_ptr); /* users info buffer for rd_trk_header order */ dcl 1 user_dev_char_table based (info_ptr) aligned, /* Users device Characteristics Table */ 2 user_subsystem_name char (4), /* Disk subsystem name */ 2 user_device_name char (8), /* Device name */ 2 user_sect_per_dev fixed bin (35), /* total no. of non-T&D sectors on pack */ 2 user_cyl_per_dev fixed bin, /* no. of non-T&D cylinders on pack */ 2 user_sect_per_cyl fixed bin, /* no of sectors per cylinder */ 2 user_sect_per_track fixed bin, /* no. of sectors per track */ 2 user_num_label_sect fixed bin, /* no. of sectors to reserve for label */ 2 user_num_alt_sect fixed bin, /* no. of sectors to reserve for alt. track area */ 2 user_sect_size fixed bin (12); /* no. of words in sector */ dcl user_hardware_status bit (72) based (info_ptr); dcl io_command char (8) varying; /* values are "read", "write", or "rewrite" */ dcl current_mode_name char (24); /* name of current opening mode */ dcl dcwx fixed bin; dcl dcw_address fixed bin (18); dcl rw_length fixed bin (18); dcl END fixed bin int static init (-5); /* used to indicate that a key is at the end of the file */ dcl NULL fixed bin int static init (-1); /* used to flag keys as currently being invalid */ dcl unique_chars_ entry (bit (*)) returns (char (15)); dcl unique_entry_name char (22); /* Start of ATTACH module */ rdisk_attach: entry (a_iocb_ptr, options, a_err_sw, a_code); /* * The attach description has the following form: * * rdisk_ device_id pack_id -opt1_- -opt_n- * * 1. device_id is a character string identifying the type number * of the required disk device. The supported disk * devices are listed in the table below, along with * the character string to use for device_id: * device_id * Character * String Device Type * __________ ___________________ * d181 DSU181 * d190 DSU190 * d191 DSU190 with the * high-efficiency format * (40 sectors/track) * d400 MSU0400 * d451 MSU0451 * d500 MSU0500 * d501 MSU0501 * 3380 MSU3380 * 3381 MSU3381 * * 2. pack_id is a character string identifying * the disk pack to be mounted. * * 3. opt_i may be one of the following * options. An option may occur only * once. * * -device device_name Indicate what device the user is * requesting. The device_name format is: * dskX_NN{S}. Where X is the subsystem * name, NN is the device number, and S * the optional subvolume name. If S is * given then the seeks will be relative * to the indicated subvolume. * * -write indicates that the disk pack is to * be written. If omitted, the * operator will be instructed to * mount the pack write inhibited. * * -size n indicates that the value of n is to * override the value of buff_len as a * record size limit for the * read_record operation. * * -system, -sys indicates that the attachment is being * made by a system process and that a disk * drive reserved for system functions is * to be assigned. * * (NOTE: This control argument used to be * supplied by the user as "-priv" but is * being changed to "-system" for greater * consistency with other parts of Multics. * The character string "-priv" will be * honored for awhile, i.e., both "-system" * and "-priv" will have the same effect * for now. With some future release, * "-priv" will no longer be accepted.) * * The attachment causes the specified disk pack to be mounted * on a drive of the specified type. (See the IOI and RCP documentation.) */ dcl options (*) char (*) varying; /* parameter: attach description elements */ dcl a_err_sw bit (1) aligned; /* parameter: print errors flag */ dcl found_dev_att bit (1); dcl rcp_detachment bit (1); if attachments_ptr = null () then do; /* If there is no attachments get the space */ system_area_ptr = get_system_free_area_ (); allocate attachments in (system_area) set (attachments_ptr); attachments.device_att (*) = ""; attachments.array (*).sv (*).this_iocbp = null (); attachments.number_used = 0; attachments.number_attached = 0; end; code = 0; /* clear return code */ unique_entry_name = unique_chars_ ("0"b) || ".rdisk_"; call hcs_$make_seg ("", unique_entry_name, "", 01010b, disk_ptr, code); /* make our work segment */ if disk_ptr = null then call error (code, ""); /* if it didn't work */ iocb_ptr = a_iocb_ptr; /* grab IOCB pointer */ if iocb_ptr -> attach_descrip_ptr ^= null then call att_err (error_table_$not_detached); /* must be detached */ call parse_attach_options; if is_sv then if attach_data.dev_type ^= 0 then if sv_num >= number_of_sv (attach_data.dev_type) then call att_err (error_table_$invalid_device); if attach_data.dev_type = 0 then attach_descrip.descrip = "rdisk_ """" " || pack_id; else attach_descrip.descrip = "rdisk_ " || device_names (attach_data.dev_type) || " " || attach_data.pack_id; /* init. att. descrip. */ attach_descrip.length = length (rtrim (attach_descrip.descrip)); do i = 3 to num_opts; /* add the options */ attach_descrip.descrip = substr (attach_descrip.descrip, 1, attach_descrip.length) || " " || options (i); /* concatenate the next option */ attach_descrip.length = length (rtrim (attach_descrip.descrip)); end; if ^(found_dev_att) then do; call ipc_$create_ev_chn (ev_chan, code);/* create an event channel */ if code ^= 0 then call att_err (code); /* if we didn't make it */ nchan = 1; /* only one channel */ disk_info_ptr = addr (rcp_data); /* init. disk info prior to assignment */ disk_info.version_num = DISK_INFO_VERSION_1; disk_info.usage_time, disk_info.wait_time = 0; disk_info.system_flag = sys_sw; if dev_type ^= 0 then disk_info.model = MODELN (dev_type); else disk_info.model = 0; end; disk_info.device_name = substr (drive_name, 1, 7); disk_info.write_flag = disk_data.write_sw; raw_sw = "0"b; /* reset raw mode if set */ alt_sw = "0"b; label_sw = "1"b; if ^found_dev_att then do; call mount (); /* attach drive, and mount pack */ if code ^= 0 then call att_err (code); /* complain if we didn't make it */ disk_data.dev_type = 0; do i = 1 to hbound (MODELN, 1) while (disk_data.dev_type = 0); if disk_info.model = MODELN (i) then disk_data.dev_type = i; end; if disk_data.dev_type <= 1 then call att_err (error_table_$invalid_device); device_group = DEVICE_GROUP (disk_data.dev_type); if disk_data.is_sv then disk_data.sect_per_dev = sect_per_sv (disk_data.dev_type); else disk_data.sect_per_dev = sect_per_cyl (disk_data.dev_type) * cyl_per_dev (disk_data.dev_type); /* Set up device specific constants */ disk_data.sect_size = words_per_sect (disk_data.dev_type); disk_data.num_alt_sect = last_alt_sect_num (disk_data.dev_type) - first_alt_sect_num (disk_data.dev_type) + 1; if sys_sw then disk_data.bounds.low = 0; else disk_data.bounds.low = num_label_sect; /* initialize the seek low bound */ if disk_data.device_group = MSU04XX then disk_data.bounds.high = last_alt_sect_num (disk_data.dev_type); else if (disk_data.device_group = MSU33XX) & disk_data.is_sv then disk_data.bounds.high = sect_per_sv (disk_data.dev_type) - 1; else disk_data.bounds.high = last_sect_num (disk_data.dev_type); end; else do; disk_data.errors = 0; /* give the pack a fresh start */ disk_data.buf_len = min (max (divide (disk_data.sze, 4, 17, 0), 1024), disk_data.max_buff_size); /* determine ioi_ buffer size */ disk_data.data_len = disk_data.buf_len - overhead; /* set length of data area */ end; disk_data.mode_string = "label,^alttrk,^wrtcmp,^raw"; /* set the modes string */ mask_str = "0"b; /* initialize ips_ mask */ call default_handler_$set (cond_hdlr); /* protect ourselves */ call hcs_$set_ips_mask (mask_str, mask_str); iocb_ptr -> attach_descrip_ptr = addr (attach_descrip); /* fill in IOCB; attach descrip. */ iocb_ptr -> attach_data_ptr = disk_ptr; /* attach data */ iocb_ptr -> detach_iocb = rdisk_detach; /* detach entry */ iocb_ptr -> open = rdisk_open; /* open entry */ iocb_ptr -> iocb.control = rdisk_control; /* control entry */ iocb_ptr -> modes = rdisk_modes; /* modes entry */ call iox_$propagate (iocb_ptr); /* let iox_ have its turn */ call hcs_$reset_ips_mask (mask_str, mask_str); /* back to normal */ next_key, current_key, key_for_insertion = NULL; /* Change when valid values established */ /* add this atttachment to the array */ if found_dev_att then att_dev_idx = pri_iocb_ptr -> attach_data_ptr -> att_dev_idx; else do att_dev_idx = 1 to hbound (attachments.array, 1) while (attachments.array (att_dev_idx).device_att ^= ""); end; if att_dev_idx > attachments.number_used then attachments.number_used = att_dev_idx; if sv_num = -1 then /* user attaching entire device */ att_sv_idx = 1; else do att_sv_idx = 1 to 3 while (attachments.array (att_dev_idx).sv (att_sv_idx).this_iocbp ^= null ()); end; if ^(found_dev_att) then attachments.array (att_dev_idx).device_att = addr (rcp_data) -> disk_info.device_name; attachments.array (att_dev_idx).sv (att_sv_idx).this_iocbp = iocb_ptr -> actual_iocb_ptr; /* the real iocb ptr */ attachments.array (att_dev_idx).sv (att_sv_idx).this_sv = sv_num; attachments.number_attached = attachments.number_attached + 1; exit: a_code = code; /* return the code */ return; /* bye-bye */ parse_attach_options: proc; /* This internal proc sets up the attach_data if this is a subvolume attach */ /* then it will copy the "buddy" disk_data and fill in the new values for */ /* the attach options. */ dcl 1 at_opt, 2 sze fixed bin (35), ( 2 err_sw, 2 write_sw, 2 compare_sw, 2 raw_sw, 2 alt_sw, 2 label_sw, 2 sys_sw ) bit (1) unal, 2 pack_id char (32), 2 dev_type fixed bin, 2 is_sv bit (1), 2 sv_num fixed bin; dcl (dv, sv) fixed bin; at_opt.err_sw = a_err_sw; /* fill in print errors flag */ at_opt.write_sw, at_opt.sys_sw, at_opt.compare_sw = "0"b; /* initialize switches */ at_opt.pack_id = " "; /* clear pack id */ at_opt.sze = 0; /* reset size field */ drive = NOT_SET; /* init drive field */ drive_name = ""; /* no specific drive specified */ model_number = 0; at_opt.is_sv = "0"b; /* default to no subvolume */ at_opt.sv_num = -1; /* -1 indcates not sv */ num_opts = hbound (options, 1); /* how many descrip. elements? */ if num_opts >= 2 then do; /* if enough */ dev_id = options (1); /* set device name */ at_opt.pack_id = options (2); /* set pack id */ end; else call att_err (error_table_$noarg); /* complain if not enough */ if dev_id = "d191" | dev_id = "D191" then dev_id = "d400"; /* set up for compatibility */ /* ******** */ if dev_id = "d450" then dev_id = "d451"; if dev_id = "m400" then dev_id = "d400"; /* For MR7.0 only */ else if dev_id = "m451" then dev_id = "d451"; /* For MR7.0 only */ at_opt.dev_type = 0; /* clear device type indicator */ do i = 1 to maxdevt while (at_opt.dev_type = 0); /* look up dev. name in dev. char. table */ if dev_id = device_names (i) then at_opt.dev_type = i; /* if found, set device type indicator */ end; /* ******** */ do i = 3 to num_opts; /* check out attach options */ if options (i) = "-write" then at_opt.write_sw = "1"b; /* if -write set write mode switch */ else if options (i) = "-size" then do; /* if -size, try to set size */ if i >= num_opts then call att_err (error_table_$noarg); /* if no size value, complain */ i = i + 1; /* set for next option element */ at_opt.sze = cv_dec_check_ ((options (i)), code); /* pick up size value */ if code ^= 0 then call att_err (error_table_$bad_conversion); /* if not number, complain */ if at_opt.sze <= 0 then call error (error_table_$bad_arg, "Value of size option must be positive."); end; else if options (i) = "-system" | options (i) = "-sys" | options (i) = "-priv" /* obsolete */ then do; /* if a reserved drive is wanted */ call hcs_$initiate (">system_library_1", "rcp_sys_", "", 0, 0, rs_ptr, code); /* test rcp_sys_ access */ if rs_ptr ^= null then do; /* if can be initiated */ call hcs_$fs_get_mode (rs_ptr, rs_mode, code); /* check caller's access */ if code = 0 then if bit (rs_mode) & EXEC then at_opt.sys_sw = "1"b; /* if execute, then priv. process */ end; if ^at_opt.sys_sw then call att_err (error_table_$user_not_found); /* User does not have correct access to rcp_sys_ gate. */ end; else if options (i) = "-device" | options (i) = "-dv" then do; /* -device device-name */ if i >= num_opts then call att_err (error_table_$noarg); i = i + 1; drive_name = options (i); if drive_name ^= options (i) then call att_err (error_table_$bad_arg); call check_dev (drive_name); if code ^= 0 then call att_err (code); end; else if options (i) = "-model" then do; /* -model model-number */ if i >= num_opts then call att_err (error_table_$noarg); i = i + 1; model_number = cv_dec_check_ ((options (i)), code); if code ^= 0 then call att_err (error_table_$bad_conversion); at_opt.dev_type = 0; do j = 1 to hbound (MODEL, 1) while (at_opt.dev_type = 0); if model_number = MODEL (j) then at_opt.dev_type = MODELX (j); end; if at_opt.dev_type = 0 then call att_err (error_table_$bad_arg); model_number = MODELN (at_opt.dev_type); end; else call att_err (error_table_$request_not_recognized); /* if not valid option, complain */ end; found_dev_att = "0"b; if drive_name ^= "" then do; do dv = 1 to attachments.number_used while (^found_dev_att); if attachments.device_att (dv) = substr (drive_name, 1, 7) then do; if ^found_dev_att then do; found_dev_att = "1"b; if at_opt.sv_num = -1 then call att_err (error_table_$resource_assigned); do sv = 1 to 3; if attachments.array (dv).this_iocbp (sv) ^= null then do; if attachments.array (dv).this_sv (sv) = -1 | at_opt.sv_num = attachments.array (dv).this_sv (sv) then call att_err (error_table_$resource_assigned); pri_iocb_ptr = attachments.array (dv).this_iocbp (sv); end; end; end; end; end; end; if found_dev_att then disk_data = pri_iocb_ptr -> attach_data_ptr -> disk_data; disk_data.attach_data = at_opt, by name; return; check_dev: proc (at_dev); /* Internal procedure for checking the device name format on attach */ dcl at_dev char (8); dcl at_dev_len fixed bin; dcl s_code fixed bin (35); at_dev_len = length (rtrim (at_dev)); if at_dev_len < 7 then goto invalid_device; if substr (at_dev, 1, 3) ^= "dsk" | substr (at_dev, 5, 1) ^= "_" then goto invalid_device; s_code = verify (substr (at_dev, 6, 2), "0123456789"); if s_code ^= 0 then goto invalid_device; if at_dev_len = 8 then do; s_code = verify (substr (at_dev, 8, 1), valid_sv_string); if s_code ^= 0 then goto invalid_device; at_opt.is_sv = "1"b; at_opt.sv_num = (search (valid_sv_string, substr (at_dev, 8, 1))) - 1; end; else do; at_opt.is_sv = "0"b; at_opt.sv_num = -1; end; code = 0; return; invalid_device: code = error_table_$invalid_device; end check_dev; end parse_attach_options; /* Internal handler for errors occurring during ATTACH */ att_err: proc (b_code); dcl (b_code, c_code) fixed bin (35); /* error code */ c_code = b_code; if err_sw then call sub_err_ (c_code, "rdisk_", "c", null, retval, "^a", iocb_ptr -> iocb.name); call hcs_$delentry_seg (disk_ptr, c_code); /* get rid of work segment */ code = b_code; /* set code */ go to exit; /* return */ end att_err; /* End of ATTACH module */ /* Start of OPEN module */ rdisk_open: entry (a_iocb_ptr, a_mode, a_ext, a_code); /* * The following opening modes are supported: * stream_input * stream_output * stream_input_output * sequential_input * sequential_output * sequential_update * direct_input * direct_update * Note that if the opening mode is of the output or update type, * the attach description must include the -write control argument * so that the operator will not press the PROTECT button when the pack is mounted. */ dcl a_mode fixed bin; /* parameter: open mode */ dcl a_ext bit (1) aligned; /* parameter: extend bit */ call setup ("closed"); /* set up working environment */ /* If setup returns to here, the switch is closed. */ mode = a_mode; /* pick up requested opening mode */ /* Set up various items which are opening-mode dependent. */ /* Since current_key remains NULL for all modes, it is not changed and hence does not show below. */ if mode = Stream_input then do; open_descrip.length = 12; open_descrip.descrip = "stream_input"; real_iocb_ptr -> position = rdisk_position; real_iocb_ptr -> get_chars = rdisk_read; next_key = bounds.low; fill = "101101101"b; /* Should never be used. */ end; else if mode = Stream_output then do; if ^write_sw then call error (error_table_$incompatible_attach, "stream_output requires -write control arg."); /* complain if not attached for write */ open_descrip.length = 13; open_descrip.descrip = "stream_output"; real_iocb_ptr -> position = rdisk_position; real_iocb_ptr -> put_chars = rdisk_write; next_key = bounds.low; fill = "101101101"b; /* Should never be used. */ end; else if mode = Stream_input_output then do; if ^write_sw then call error (error_table_$incompatible_attach, "stream_input_output requires -write control arg."); /* complain if not attached for write */ open_descrip.length = 19; open_descrip.descrip = "stream_input_output"; real_iocb_ptr -> position = rdisk_position; real_iocb_ptr -> get_chars = rdisk_read; real_iocb_ptr -> put_chars = rdisk_write; next_key = bounds.low; fill = "101101101"b; /* Should never be used. */ end; else if mode = Sequential_input then do; open_descrip.length = 16; open_descrip.descrip = "sequential_input"; real_iocb_ptr -> position = rdisk_position; real_iocb_ptr -> read_record = rdisk_read; next_key = bounds.low; fill = "101101101"b; /* Should never be used. */ end; else if mode = Sequential_output then do; if ^write_sw then call error (error_table_$incompatible_attach, "sequential_output requires -write control arg."); /* complain if not attached for write */ open_descrip.length = 17; open_descrip.descrip = "sequential_output"; real_iocb_ptr -> write_record = rdisk_write; next_key = bounds.low; fill = "000100000"b; /* ASCII space fill last sector when write. */ end; else if mode = Sequential_update then do; if ^write_sw then call error (error_table_$incompatible_attach, "sequential_update requires -write control arg."); /* complain if not attached for write */ open_descrip.length = 17; open_descrip.descrip = "sequential_update"; real_iocb_ptr -> position = rdisk_position; real_iocb_ptr -> read_record = rdisk_read; real_iocb_ptr -> rewrite_record = rdisk_rewrite; next_key = bounds.low; fill = "000100000"b; /* ASCII space fill last sector when write. */ end; else if mode = Direct_input then do; open_descrip.length = 12; open_descrip.descrip = "direct_input"; real_iocb_ptr -> read_record = rdisk_read; real_iocb_ptr -> seek_key = rdisk_seek; /* next_key remains NULL */ fill = "110110110"b; /* Should never be used. */ end; else if mode = Direct_update then do; if ^write_sw then call error (error_table_$incompatible_attach, "direct_update requires -write control arg."); /* complain if not attached for write */ open_descrip.length = 13; open_descrip.descrip = "direct_update"; real_iocb_ptr -> read_record = rdisk_read; real_iocb_ptr -> rewrite_record = rdisk_rewrite; real_iocb_ptr -> seek_key = rdisk_seek; /* next_key remains NULL */ fill = "000000000"b; /* Zero fill last sector when write. */ end; else do; /* complain if an invalid opening mode was requested. */ current_mode_name = iox_modes (mode); call error (error_table_$request_not_recognized, current_mode_name); /* complain if invalid opening mode */ end; if a_ext then call error (error_table_$action_not_performed, "Extension attempt -- not valid for disk."); /* extension is meaningless for rdisk_ */ mask_str = "0"b; /* initialize ips_ mask */ call default_handler_$set (cond_hdlr); /* protect ourselves */ call hcs_$set_ips_mask (mask_str, mask_str); /* The file is now open. Set up to allow a close, but not an open or detach. */ real_iocb_ptr -> close = rdisk_close; real_iocb_ptr -> open, real_iocb_ptr -> detach_iocb = iox_$err_not_closed; real_iocb_ptr -> open_descrip_ptr = addr (open_descrip); /* fill in IOCB open descrip. pointer */ call iox_$propagate (iocb_ptr); /* let iox_ have a turn again */ call hcs_$reset_ips_mask (mask_str, mask_str); /* back to normal */ a_code = 0; /* give successful code */ return; /* auf wiedersehen */ /* End of OPEN module */ /* */ /* Start of SEEK module */ rdisk_seek: entry (a_iocb_ptr, a_key, a_rec_len, a_code); /* * S__e_e_k_K__e_y_O__p_e_r_a_t_i_o_n * This operation returns a status code of 0 for any key that is a * valid sector number. The record length returned is always 256 * (current physical sector size in characters) for any valid key. The * specified key must be a character string that could have been produced * by editing through a PL/I picture of "(8)9". * This operation is supported for only the direct opening modes. */ dcl a_key char (256) varying; /* parameter: key to seek on */ call setup ("open"); /* set up working environment */ if mode = Direct_input | mode = Direct_update then ; else call error (error_table_$no_record, "seek valid only for direct openings."); temp_key = cv_dec_check_ (ltrim (rtrim (a_key)), code); if code ^= 0 then call error (error_table_$no_record, (a_key)); if (temp_key < bounds.low) | (temp_key > bounds.high) then call error (error_table_$no_record, "Requested sector outside available area."); else next_key, current_key = temp_key; /* key_for_insertion is not changed */ a_rec_len = 4 * sect_size; /* return canned rec. len. of sect. size (chars.) */ a_code = 0; /* and good code */ return; /* 'til next time */ /* End of SEEK module */ /* */ /* Start of POSITION module */ rdisk_position: entry (a_iocb_ptr, a_type, a_quantity, a_code); /* * Position Operation * * This operation is supported for only the sequential and stream modes * opening modes. In the stream opening modes only position mtype 2 is supported. The type and quanity values are * interpreted as follows: * _t_y_p_e _q_u_a_n_t_i_t_y _a_c_t_i_o_n______________________________________ * * -1 -- position to the beginning of the file. * +1 -- position to the end of the file. * 0 n skip n sectors (forward if n > 0; backward * if n < 0). * 2 n position to sector n. * Abbreviations used in the following table are: b.l = bounds.low = sector address of first sector user can write in. b.h = bounds.high = sector address of last sector user can write in. R(a,b) = range from a to b inclusive, i.e., ( a <= variable <= b ) nk = next_key qty = quantity, i.e., the input parameter called quantity in thee above table. <-------- If all of these conditions are satisfied -----> <-- then do this ----> absolute set value of next_key type next_key quantity quantity nk+qty equal to other action ____ ________ ________ _____________ ____________ _________ ____________ -1 -- -- -- -- b.l -- +1 -- -- -- -- END -- 2 -- < b.l -- -- b.l error 2 -- R(b.l,b.h) -- -- quantity -- 2 -- > b.h -- -- END error 0 NULL -- -- -- -- error 0 R(b.l,b.h) -- -- R(b.l,b.h) nk+qty -- 0 R(b.l,b.h) -- -- < b.l b.l error 0 R(b.l,b.h) -- -- > b.h END error 0 END <= 0 <=(b.h-b.l+1) -- b.h-qty+1 -- 0 END > 0 -- -- END error 0 END < 0 >(b.h-b.l+1) -- b.l error For sequential_update, if no errors occur, current_key = new value of next_key */ /* */ dcl a_type fixed bin; /* type of positioning requested */ dcl type fixed bin; dcl a_quantity fixed bin (21); /* how far to move the position */ dcl quantity fixed bin; dcl desired_key fixed bin; /* possible resulting value */ call setup ("open"); /* set up working environment */ if mode = Direct_update | mode = Direct_input then call error (error_table_$no_operation, "Position operation valid only for sequential or stream openings."); type = a_type; quantity = a_quantity; if (type < -1) | (2 < type) then call error (error_table_$no_operation, "Only legal values for type are -1, 0, +1, and +2"); if mode = Stream_input | mode = Stream_output | mode = Stream_input_output then do; if mod (quantity, sect_size * 4) ^= 0 then do; next_key = NULL; call error (error_table_$no_record, "Byte offset specified not at begining of sector"); end; quantity = divide (quantity, sect_size * 4, 17, 0); end; if type = -1 then do; /* position to beginning of the file */ next_key = bounds.low; end; else if type = +1 then do; /* position to end of the file */ next_key = END; end; /* type = 2 is absolute positioning */ else if (type = 2) & (quantity < bounds.low) then do; call error (error_table_$end_of_info, "quantity is before first available sector"); next_key = bounds.low; end; else if (type = 2) & (bounds.low <= quantity) & (quantity <= bounds.high) then do; next_key = quantity; end; else if (type = 2) & (quantity > bounds.high) then do; call error (error_table_$end_of_info, "quantity is after last available sector"); next_key = END; end; /* type = 0 is relative positioning */ else if (type = 0) & (next_key = NULL) then call error (error_table_$no_current_record, "Present position is undefined."); else if (type = 0) & (next_key ^= NULL) & (next_key ^= END) then do; desired_key = next_key + quantity; if (bounds.low <= desired_key) & (desired_key <= bounds.high) then do; next_key = desired_key; end; else if (desired_key < bounds.low) then do; call error (error_table_$end_of_info, "Present position plus quantity is before start of the file."); next_key = bounds.low; end; else if (desired_key > bounds.high) then do; call error (error_table_$end_of_info, "Present position plus quantity is past end of the file."); next_key = END; end; end; /* May be OK to back up from the end of the file */ else if (type = 0) & (next_key = END) & (quantity <= 0) & (abs (quantity) <= (bounds.high - bounds.low + 1)) then do; next_key = bounds.high + quantity; /* "+ quantity" (not minus) because quantity is negative, or zero */ end; else if (type = 0) & (next_key = END) & (quantity > 0) then call error (error_table_$end_of_info, "Were at file end; quantity attempted to move forward."); /* next_key still = END */ else if (type = 0) & (next_key = END) & (quantity < 0) & (abs (quantity) > (bounds.high - bounds.low + 1)) then do; call error (error_table_$end_of_info, "Were at file end; quantity would put you before file."); next_key = bounds.low; end; else call error (error_table_$no_operation, "Should never get to this point."); if mode = Sequential_update then current_key = next_key; a_code = 0; /* If we get here, there were no errors. */ return; /* End of POSITION module */ /* */ /* Start of READ and WRITE modules */ rdisk_read: entry (a_iocb_ptr, a_ubuf_ptr, a_ubuf_len, a_rec_len, a_code); /* * If the amount of data to be read does not terminate on a * sector boundary, the excess portion of the last sector will be * discarded. A zero code will be returned in this case. */ call setup ("open"); /* set up working environment */ if mode = Sequential_output | mode = Stream_output then /* read OK for all other modes */ call error (error_table_$invalid_read, "read not supported for sqo or so."); if next_key = NULL then call error (error_table_$no_record, "next_key must be non-null to read"); else if next_key = END then do; if mode = Sequential_input | mode = Sequential_update then do; current_key = NULL; call error (error_table_$end_of_info, "Attempted to read (sqi, squ) past end of available area."); end; else do; /* mode = either direct_input or direct_update */ next_key = NULL; current_key = NULL; call error (error_table_$device_end, "Attempted to read (di, du) past end of avilable area."); end; end; io_command = "read"; /* set switch for read */ if sze ^= 0 then rec_len = min (sze, a_ubuf_len); /* set appropriate record length */ else rec_len = a_ubuf_len; a_rec_len = 0; key = next_key; /* set working key value */ go to read_write_common; /* proceed to common code */ rdisk_rewrite: entry (a_iocb_ptr, a_ubuf_ptr, a_rec_len, a_code); /* * If the amount of data to be written does not terminate on a * sector boundary, the remaining portion of the last sector is filled * with spaces in sequential modes and binary zeros in direct modes. A * code of 0 is returned in this case. This * operation is supported for only the update opening modes. */ call setup ("open"); /* set up working environment */ if mode = Sequential_update | mode = Direct_update then ; else call error (error_table_$invalid_write, "rewrite valid only for update."); if current_key = NULL then call error (error_table_$no_record, "Attempted to rewrite before the start of the file."); else if current_key = END then do; next_key = END; call error (error_table_$device_end, "Attempted to rewrite when already at the end of the file."); end; io_command = "rewrite"; /* set switch for rewrite */ rec_len = a_rec_len; /* set output record length */ key = current_key; /* set working key */ go to read_write_common; rdisk_write: entry (a_iocb_ptr, a_ubuf_ptr, a_rec_len, a_code); /* * If the amount of data to be written does not terminate on a * sector boundary, the remaining portion of the last sector is filled * with ASCII spaces. A code of 0 is returned in this case. * This operation is supported for only the * sequential_output opening mode. A series of writes will write * successive records. */ call setup ("open"); /* set up working environment */ if mode = Sequential_output | mode = Stream_output | mode = Stream_input_output then ; else call error (error_table_$invalid_write, "write supported only for sqo, so, and sio."); if next_key = END then do; current_key = NULL; call error (error_table_$device_end, "Already at end of the file."); end; else if next_key = NULL then call error (error_table_$no_record, "Next record designator was NULL."); io_command = "write"; rec_len = a_rec_len; /* set output record length */ key = next_key; /* set working key */ go to read_write_common; read_write_common: /* * For the sequential_input and sequential_update opening modes, if * an attempt is made to read beyond the end of the user-accessible area, * the code error_table_$end_of_info is returned to the calling * program. For all other opening modes, if an attempt is made to read * or write beyond the end of the user-accessible area on disk, the code * error_table_$device_end is returned. If a defective track is * encountered or if any other unrecoverable data transmission error is * encountered, the code error_table_$device_parity is returned. * * The record length is specified through the buff_len parameter in * the read_record operation, and through the rec_len parameter for the * write and rewrite operations, unless overridden by a -size control * argument in the attach description, or by a setsize control order. */ dcl sectors_for_record fixed bin; /* Qty. of sectors necessary to hold the record to be written */ dcl potential_next_sector fixed bin (21); /* Tentative address of sector immediately following the last */ /* sector this record will occupy if this is a write. */ sectors_for_record = ceil (rec_len / (4 * sect_size)); potential_next_sector = key + sectors_for_record; if key = NULL then do; /* if he didn't do a seek */ code = error_table_$no_record; /* complain */ call io_err ("0"b); end; if (io_command = "write") | (io_command = "rewrite") then if potential_next_sector > bounds.high + 1 then call error (error_table_$no_operation, "Record will not fit in space left on disk."); tot_rec_len = 0; /* init total records counter */ ubuf_ptr = a_ubuf_ptr; /* grab pointer to user buffer */ cont_sw = "0"b; /* reset control switch if set */ track_indicators = "00"b; /* reset ti bits if set */ if rec_len > 4 * (floor ((max_buff_size - overhead) / sect_size) * sect_size) then do; /* if record longer than maximum ioi_ buffer size */ if buf_len < max_buff_size then do; /* if current ioi_ buffer len. < max. */ call ioi_$workspace (devx, buf_ptr, max_buff_size, code); /* grow it to max size */ if code ^= 0 then call io_err ("1"b); /* no luck */ buf_len = max_buff_size; /* set current length */ data_len = buf_len - overhead;/* set data area length */ end; block_len = ceil (ceil (data_len / 4) / sect_size) * sect_size; /* set I/O block size */ block_ptr = ubuf_ptr; /* initialize block pointer */ data_left = rec_len; /* initialize amount of data left to xmit */ do while (data_left > 0); /* perform the I/O one block at a time */ call do_io; /* do the I/O */ block_ptr = addrel (block_ptr, block_len); /* set pointer for next block */ tot_rec_len = tot_rec_len + rec_len; /* remember total records */ data_left = data_left - block_len * 4; /* decrement data left to xmit */ key = key + fixed (block_len / sect_size, 21); /* increment the working key */ end; end; else do; /* record will fit within max-sized ioi_ buffer */ if rec_len > 4 * floor (data_len / sect_size) * sect_size then do; /* if record longer than current ioi_ buffer size */ data_len = max (1024 - overhead, ceil (ceil (rec_len / 4) / sect_size) * sect_size); buf_len = data_len + overhead;/* tell ioi_ how much space we need */ call ioi_$workspace (devx, buf_ptr, buf_len, code); /* grow the buffer */ if code ^= 0 then call io_err ("1"b); /* can't win all the time */ end; block_ptr = ubuf_ptr; /* initialize block pointer */ block_len = ceil (ceil (rec_len / 4) / sect_size) * sect_size; /* and block length */ data_left = rec_len; /* and data left to xmit */ call do_io; /* go do the I/O (only one block this time) */ end; io_succeeded: /* PATH 1 */ if io_command = "read" then do; current_key = next_key; if tot_rec_len = 0 then a_rec_len = rec_len; /* Send back length of data actually read. */ else a_rec_len = tot_rec_len; /* ditto */ /* PATH 1a */ if potential_next_sector < bounds.high + 1 then do; /* Record will _n_o_t reach end of available area. */ /* PATH 1a1 */ if mode = Direct_input | mode = Direct_update then next_key = NULL; /* PATH 1a2 */ else next_key = next_key + sectors_for_record; end; /* PATH 1b */ else do; /* potential_next_sector = bounds.high + 1 */ /* Record _w_i_l_l reach end of available area. */ /* PATH 1b1 */ if mode = Direct_input | mode = Direct_update then next_key = NULL; /* PATH 1b2 */ else next_key = END; end; end; /* PATH 2 */ else if io_command = "rewrite" then do; /* No change to current_key */ /* PATH 2a */ if mode = Sequential_update then /* PATH 2a1 */ if potential_next_sector < bounds.high + 1 then /* Record will _n_o_t reach end of available area. */ next_key = current_key + sectors_for_record; /* PATH 2a2 */ else next_key = END; /* potential_next_sector = bounds.high + 1 */ /* Record _w_i_l_l reach end of available area. */ /* PATH 2b */ else next_key = NULL; /* mode = direct_update */ end; /* PATH 3 */ else if io_command = "write" then do; current_key = NULL; /* PATH 3a */ if potential_next_sector < bounds.high + 1 then /* Record will _n_o_t reach end of available area. */ next_key = next_key + sectors_for_record; /* PATH 3b */ else next_key = END; /* potential_next_sector = bounds.high + 1 */ /* Record _w_i_l_l reach end of available area. */ end; /* Do this every time, for any case */ a_code = 0; /* give good code */ return; /* come again, sometime */ /* */ /* Internal Procedure to reset certain fields after the occurrence of an I/O error */ io_err: proc (clear_space); dcl clear_space bit (1); /* flag to tell us to zap ioi_ workspace */ if clear_space then do; /* if space no good */ buf_ptr = null; /* zap it!! */ buf_len, data_len = 0; end; call error (code, ""); /* let user know */ end io_err; /* */ /* Internal procedure to actually perform I/O */ do_io: proc; dcl (true_len, data_read) fixed bin (35); /* internal data manipulation variables */ dcl sector_offset fixed bin; /* used for subvolumes */ true_len = min (4 * block_len, data_left); /* set true amount to xmit */ /* If we are going to write onto the disk, fill in unused area at end of the disk sector with zeros for direct opening modes or with ASCII spaces for sequential opening modes. */ /* and fill in unused space with zeros */ if io_command ^= "read" & ^cont_sw then do; /* if an output command and not format */ substr (data, 1, true_len) = substr (block, 1, true_len); /* move data to ioi_ buffer */ if true_len < 4 * block_len then unspec (substr (data, true_len + 1, 4 * block_len - true_len)) = fill; end; idcwp = addr (sk_idcw); /* get pointer to seek IDCW */ idcw = seek_idcw_template; /* move in template seek IDCW */ idcw.device = bit (drive); /* set drive no. */ count_limit_fixed = ceil (block_len / sect_size); /* and sector count limit in seek data */ if key <= last_sect_num (dev_type) /* in the data region */ then goto BUILD_NORMAL_SEEK; else if key <= last_alt_sect_num (dev_type) /* in the alternate region */ then goto BUILD_ALT_SEEK (device_group); else goto BUILD_TANDD_SEEK (device_group); /* must be T&D region */ BUILD_TANDD_SEEK (1): /* T&D region on MSU04XX device */ idcw.command = SPECIAL_SEEK; /* seek cmd = spiecial seek */ BUILD_ALT_SEEK (1): /* Alternate track region on MSU04XX device */ BUILD_NORMAL_SEEK: idcw.command = seek_command (dev_type); unspec (seek) = "0"b; seek.block_count_limit = count_limit_fixed; seek.ti = track_indicators; if is_sv then do; /* convert the key to real sector */ sector_offset = mod (key, sect_per_cyl (dev_type)); seek.sector = ((key - sector_offset) * number_of_sv (dev_type)) + (sv_num * sect_per_cyl (dev_type)) + sector_offset; end; else seek.sector = key; unspec (seek_data) = unspec (seek); goto SEEK_BUILT; BUILD_ALT_SEEK (2): /* Alternate track region on MSU0500/1 device */ BUILD_TANDD_SEEK (2): /* T&D region on MSU0500/1 device */ idcw.command = SPECIAL_SEEK; BUILD_SUPER_SEEK: unspec (super_seek) = "0"b; super_seek.sector_number = mod (key, sect_per_track (dev_type)); super_seek.ti = track_indicators; super_seek.is_super_seek = "1"b; super_seek.flag = "1"b; /* ON => sector number in 0-12 rather than block count limit */ cyl = divide (key, sect_per_cyl (dev_type), 16, 0); head = mod (key, sect_per_cyl (dev_type)); head = divide (head, sect_per_track (dev_type), 16, 0) * 2 + mod (cyl, 2); if mod (cyl, 2) = mod (drive, 2) then /* see EPS for details of this crock */ if mod (cyl, 2) = 0 then cyl = cyl + 1; else cyl = cyl - 1; super_seek.cyl_lower = mod (cyl, 256); super_seek.cyl_upper = divide (cyl, 256, 2, 0); super_seek.head = head; unspec (seek_data) = unspec (super_seek); goto SEEK_BUILT; BUILD_ALT_SEEK (3): /* Alternate track region on MSU0509 device */ BUILD_TANDD_SEEK (3): /* T&D region on MSU0509 device */ idcw.command = SPECIAL_SEEK_512; goto BUILD_SUPER_SEEK; SEEK_BUILT: /* Seek command and data are ready */ dcwp = addr (sk_dcw); /* get pointer to seek DCW */ dcw = seek_dcw_template; /* put in canned value */ dcw.address = rel (addr (seek_data)); /* fill in data address */ idcwp = addr (rw_idcw); /* get pointer to read/write IDCW */ if cont_sw then do; /* if format trk or rd trk header */ idcw = control_idcw_template; idcw.command = control_command; end; else if (io_command = "read") then idcw = read_idcw_template; /* if read, put in canned read value */ else if compare_sw then idcw = write_and_compare_idcw_template; /* put in compare comd. if in that mode */ else idcw = write_idcw_template; /* put in canned write value */ idcw.device = bit (drive); /* fill in drive number */ dcw_address = bin (rel (addr (data))); /* Beginning of data */ rw_length = block_len; /* Length of data */ do dcwx = 1 by 1 while (rw_length > 0); /* Build each DCW */ dcwp = addr (rw_dcw (dcwx)); /* point to next dcw */ dcw = read_write_dcw_template; /* IOTP */ dcw.address = bit (bin (dcw_address, 18), 18); if rw_length >= MAX_DCW_TALLY then dcw.tally = bit (bin (MAX_DCW_TALLY, 12), 12); else dcw.tally = bit (bin (rw_length, 12), 12); dcw_address = dcw_address + MAX_DCW_TALLY; rw_length = rw_length - MAX_DCW_TALLY; end; dcw.type = IOTD; dcw_offset = fixed (rel (addr (sk_idcw))); /* set offset for ioi_ */ again = "1"b; /* so we do it at least once */ err_ct = 0; /* init. error count */ do while (again); /* I/O loop */ completion.st = "0"b; /* initialize status entry */ completion.run = "1"b; call ioi_$connect (devx, dcw_offset, code); /* Start I/O */ if code ^= 0 then call io_err ("0"b); /* didn't get away from the starting line */ do while (^completion.st & completion.run); /* while connected and no status */ call ipc_$block (addr (wait_list), addr (event_info), code); /* wait for completion */ if code ^= 0 then call io_err ("0"b); /* No loiterers?? */ end; again = "0"b; /* set for no retry */ if completion.time_out | ^(completion.st | completion.er | completion.run | completion.time_out) /* if nothing */ then call retry; /* try again */ else if level <= 1 then call perm_err; /* if fault */ else if level > 3 then call retry; /* if special or marker */ else if status.maj = ATTENTION then if status.sub & STANDBY then call delay_retry; /* other MPC may have control */ else call loud_retry; /* just plain attention, let user know */ else if status.maj = EOF then if (status.sub & LAST_BLOCK_MASK = LAST_BLOCK) then do; /* if we've run off end of the pack */ if (io_command = "read") then do; /* and we were reading */ data_read = min (true_len, (block_len - fixed (status.residue) - 1) * 4); /* amount read */ substr (block, 1, data_read) = substr (data, 1, data_read); /* give user what we can */ a_rec_len, rec_len = rec_len - data_left + data_read; /* and tell him how much */ unspec (substr (block, rec_len + 1, data_left - data_read)) = fill; /* spaces for sequential; zeros for direct */ end; if (mode = Sequential_input) | (mode = Sequential_update) then code = error_table_$end_of_info; else code = error_table_$device_end; /* all other modes */ call io_err ("0"b); /* tell user */ end; else if ((status.sub & TI_MASK) ^= "00"b3) & cont_sw & (io_command = "read") then ; else call perm_err; /* any other EOF is bad news */ else if status.maj ^= "0000"b then call retry; /* don't beat a dead horse */ end; if (io_command = "read") & ^cont_sw then do; /* if normal read command */ substr (block, 1, true_len) = substr (data, 1, true_len); /* give the user his data */ rec_len = true_len; /* Send back length of data actually read. */ end; if (io_command = "read") & cont_sw then substr (info_block, 1, 4 * (block_len - fixed (status.residue))) = substr (data, 1, 4 * (block_len - fixed (status.residue))); /* if rd trk header command */ end do_io; /* */ /* Internal procedure to retry I/O */ retry: proc; if status.maj ^= ATTENTION then err_ct = err_ct + 1; /* don't keep track of attentions */ if err_ct <= max_retries then do; /* is it worth while? */ idcwp = addr (rst_idcw); /* yes, get pointer to restore IDCW */ idcw = restore_idcw_template; /* put in canned restore value */ idcw.device = bit (drive); /* fill in drive no. */ dcw_offset = fixed (rel (addr (rst_idcw))); /* set up offset for ioi_ */ again = "1"b; /* and set flag to try again */ end; else call perm_err; /* our patience has worn thin */ end retry; /* */ /* Internal procedure to handle ATTENTION status with STANDBY sub-status. */ delay_retry: proc; /* Have been told that this status occurs in dual-MPC configurations if the other MPC has the device. This procedure merely delays for a short time, and then retries. */ err_ct = err_ct + 1; /* keep track of how often we do this */ if err_ct >= max_retries then do; /* if too often */ err_ct = 0; /* reset error count */ call loud_retry; /* let user decide what to do */ end; else do; call timer_manager_$sleep (500000, "10"b); /* delay for 1/2 sec. */ call retry; /* and try again */ end; end delay_retry; /* */ /* Internal procedure to handle ATTENTION status (non-STANDBY) */ loud_retry: proc; /* This really should go to the operator's console. */ call command_query_ (addr (query_info), answer, "rdisk_", "Your disk drive (No. ^d) needs attention. Please have the operator check it out and reply appropriately _a_f_t_e_r the device has been checked. Do you wish to retry?", drive); if answer = "yes" then call retry; else call perm_err; /* your wish is my command */ end loud_retry; /* */ /* Internal procedure to handle permanent I/O errors */ perm_err: proc; /* This procedure obtains the detailed device status, and dumps all available status information to the user terminal. It would be nice if this info could be put out on the operator's console, but there is currently no way for a normal user's process to put it there. */ dcl based_rsr_data (9) bit (8) unal based (addr (buffer.control_info.rsr_data)); dcl found bit (1) aligned; call ioi_$get_detailed_status (devx, found, buffer.control_info.rsr_data, code); idcwp = addrel (buf_ptr, offset); /* look at the offending DCW chain */ do while (idcw.code ^= "111"b & fixed (rel (idcwp)) > 0); /* look for IDCW or beginning of seg */ idcwp = addrel (idcwp, -1); /* back track */ end; dcwp = addrel (idcwp, 1); /* set to corresponding DCW */ disk_info_ptr = addr (rcp_data); /* initialize pointer first */ call sub_err_ (0, "rdisk_", "c", null, retval, "Unrecoverable error on ^a device ^a, sector ^o (^d.).^/IOM Status:^-^w ^w^/IDCW/DCW Pair:^-^w ^w", device_names (dev_type), disk_info.device_name, key, key, substr (string (status), 1, 36), substr (string (status), 37, 36), idcw, dcw); if found then call ioa_$ioa_stream ("error_output", "Detailed Device Status: ^( ^2.4b^) (hex)", based_rsr_data); errors = errors + 1; /* increment pack error count */ code = error_table_$device_parity; /* tell user about his misfortune */ goto exit; end perm_err; /* */ /* Start of CONTROL module */ rdisk_control: entry (a_iocb_ptr, order, a_info_ptr, a_code); /* * The following orders are supported when the I/O switch is * open, except for getbounds, which is supported while the switch * is attached. * * changepack causes the current pack to be * dismounted and another pack to be * mounted in its place. The info_ptr * should point to a varying character * string (maximum of 32 characters) * containing the identifier of the * pack to be mounted. * * getbounds causes the lowest and highest * sector numbers accessible by the * caller under the current modes to * be returned. The info_ptr should * point to a structure like the * following: * * dcl 1 bounds, * 2 low fixed bin (35), * 2 high fixed bin (35); * * setsize causes the value of the record size * override setting to be reset. The * info_ptr should point to a fixed * bin(35) quantity containing the new * override value. * * device_info causes information pertaining to * the attached disk device to be * returned to the user. The info_ptr * should point to a structure of the * following form: * * dcl 1 device_info_table aligned, * 2 dev_type char (4), * 2 device_name char (8), * 2 sect_per_dev fixed bin (35), * 2 cyl_per_dev fixed bin, * 2 sect_per_cyl fixed bin, * 2 sect_per_track fixed bin, * 2 num_label_sect fixed bin, * 2 num_alt_sect fixed bin, * 2 sect_size fixed bin (12); * * where: * * 1. subsystem_name is the name of * the Disk subsystem in use (i.e. * "D191"). * * 2. device_name is the name of the * disk device in use (i.e. * "disk_04"). * * 3. sect_per_dev is the total * number of non-T&D sectors on the * disk pack. * * 4. cyl_per_dev is the total number * of non-T&D cylinders on the disk * pack. * * 5. sect_per_cyl is the number of * data sectors on each cylinder * of a disk pack. * * 6. sect_per_track is the number of * data sectors on each track. * * 7. num_label_sect is the number of * data sectors to reserve for * label information. * * 8. num_alt_sect is the number of * data sectors to reserve for * alternate track area. * * 9. sect_size is the number of 36 * bit words in each data sector. * * format_trk causes a format track command to be * issued to the track that was * indicated by a preceeding seek_key * operation. The info_ptr should * point to a user supplied structure * of the following form: * * dcl 1 format_trk_info aligned, * (2 hz bit (2), * 2 ti bit (2), * 2 adcyl fixed bin (16), * 2 adhd fixed bin (16)) unal; * * where: * * 1. hz is a bit pattern indicating * the state of the header bypass * switch. The hz bits are defined * as follows: * * h z bit pattern meaning * 0 0 format home address * and all data records * 0 1 verify home address * and record one, format * home address and all * data records * 1 0 skip home address, * format all data * records * 1 1 verify home address * and data record one, * skip home address and * format all data * records * * 2. ti is a bit pattern indicating * the state of the track indicator * bits. The ti bits are defined as * follows: * * t i bit pattern meaning * 0 0 format trk good * 0 1 format trk alternate * 1 0 format trk defective * with alternate trk * assigned * 1 1 format trk defective * with no alternate trk * assigned * * 3. adcyl and adhd are the alternate * or defective cylinder and head * * numbers used when the track * indicator bits equal "01"b or * "10"b. These two fields are * defined as follows: * * If the track indicator bits are * set to "01"b (alternate trk), * then adcyl and adhd should be * equal to the defective cylinder * and head number for which the * alternate track is being * formatted. * * If the track indicator bits are * set to "10"b (defective with * alternate assigned), then adcyl * and adhd should be equal to the * cylinder and head number of the * alternate track. * * rd_trk_header causes a read track header command * to be issued to the track that was * indicated by a preceeding seek_key * operation. The raw track header * information is passed to the user * in a structure (pointed to by * info_ptr) of the following form: * * dcl 1 trk_header_info aligned, * (2 ha_cyl bit (16), * 2 ha_head bit (16), * 2 pad1 bit (2), * 2 ha_ti bit (2), * 2 pad2 bit (10), * 2 rcd_0_ti bit (2), * 2 rcd_0_cyl bit (16), * 2 rcd_0_head bit (16), * 2 rcd_0_rn bit (8), * 2 pad3 bit (24), * 2 rcd_0_data (8), bit (8), * 2 pad4 bit (4)) unaligned; * * where: * * 1. ha_cyl is the cylinder number * read from the track home * address. * * 2. ha_head is the head number read * from the track home address. * * 3. ha_ti is the track indicator * bits (defined above in the * format_trk order) read from the * track home address. * * 4. rcd_0_ti is the track indicator * bits read from record zero. If * the ha_ti bits indicate "10"b, * then rcd_0_ti should equal "01"b * for alternate track. If ha_ti * indicates "01"b, then rcd_0_ti * should equal "10"b for defective * track. Otherwise rcd_0_ti will * equal ha_ti. * * 5. rcd_0_cyl and rcd_0_head are the * cylinder and head number read * from record zero. If ha_ti * indicates "10"b, then rcd_0_cyl * and rcd_0_head will equal the * cylinder and head number of the * alternate track. If ha_ti * indicates "01"b, then rcd_0_cyl * and rcd_0_head will contain the * cylinder and head number of the * defective track. Otherwise * rcd_0_cyl and rcd_0_head will * equal ha_cyl and ha_head. * * 6. rcd_0_rn is the record number * for record zero (normally equal * to zero). * * 7. rcd_0_data is the eight data * bytes in record zero (not a * normal data record) and will * normally be equal to zero. * * 8. padn are unused bits which will * be returned as "0"b. */ dcl order char (*); /* parameter: the control order */ dcl a_info_ptr ptr; /* parameter: pointer to supplemental information */ call setup ("don't_care"); /* set up working environment */ if order = "io_call" then do; /* special order for io_call command */ call io_call_order; a_code = code; return; end; if order ^= "getbounds" then if real_iocb_ptr -> open_descrip_ptr = null then call error (error_table_$not_open, "Only getbounds is allowed when file is not open."); info_ptr = a_info_ptr; /* grab pointer to additional info */ if (order = "changepack") & media_removable (dev_type) then do; /* process the "changepack" order */ call rcp_$detach (rcp_id, (RETAIN), errors, "", code); /* dismount current pack */ if code ^= 0 then call error (code, "");/* didn't work too well */ pack_id = new_pack_id; /* pick up new pack id. */ call mount (); /* mount it */ if code ^= 0 then call error (code, "");/* it's hard for a little pack to get on a big drive */ new_length = index (pack_id, " ") - 1; /* get length of the new pack id string */ old_length = index (substr (attach_descrip.descrip, 13), " ") - 1; /* and see how long the old one was */ if new_length = old_length then /* if the same, just overlay the old one in the att. desc. */ substr (attach_descrip.descrip, 13, old_length) = substr (pack_id, 1, new_length); else do; /* otherwise, we have to do some juggling */ old_descrip = attach_descrip.descrip; /* put the old one in a temp area */ attach_descrip.descrip = substr (old_descrip, 1, 12) || substr (pack_id, 1, new_length) /* and build */ || substr (old_descrip, 13 + old_length, attach_descrip.length - old_length - 12); /* the new one */ attach_descrip.length = attach_descrip.length + new_length - old_length; /* adjust the length */ end; end; /* changepack */ else if order = "getbounds" then do; /* process the "getbounds" order */ user_bounds.low = bounds.low; /* pass back the low bound */ user_bounds.high = bounds.high; /* and the high bound */ end; /* getbounds */ else if order = "setsize" then sze = new_size; /* The "setsize" order is easy * */ else if order = "disk_info" then do; /* process the disk_info order */ disk_info_ptr = addr (rcp_data); if info_ptr -> disk_info.version_num ^= disk_info.version_num then do; a_code = error_table_$unimplemented_version; return; end; info_ptr -> disk_info = disk_info; end; else if order = "device_info" then do; /* process the device_info order */ disk_info_ptr = addr (rcp_data); /* initialize pointer first */ user_dev_char_table.user_subsystem_name = device_names (dev_type); user_dev_char_table.user_device_name = disk_info.device_name; user_dev_char_table.user_sect_per_dev = sect_per_dev; user_dev_char_table.user_cyl_per_dev = cyl_per_dev (dev_type); user_dev_char_table.user_sect_per_cyl = sect_per_cyl (dev_type); user_dev_char_table.user_sect_per_track = sect_per_track (dev_type); user_dev_char_table.user_num_label_sect = num_label_sect; user_dev_char_table.user_num_alt_sect = num_alt_sect; user_dev_char_table.user_sect_size = sect_size; end; else if (order = "format_trk") & device_group = MSU04XX then do; /* process the "format_trk" order */ fmdp = addr (buffer.data); /* set up data pointer */ key = current_key; /* convert key to binary */ if key < sect_per_cyl (dev_type) then cyl = 0; /* :: */ else cyl = divide (key, sect_per_cyl (dev_type), 16, 0); /* figure cylinder number */ i = mod (key, sect_per_cyl (dev_type)); /* save remainder */ if i <= 0 then head = 0; /* figure out head */ else head = divide (i, sect_per_track (dev_type), 16, 0); fmt_dta = "0"b; /* clear out the buffer first */ fmt_dta.svcyl = bit (cyl); /* set up seek verif. cyl number */ fmt_dta.svhd = bit (head); /* set up seek verif. head number */ if fmt_info.ti = "01"b | fmt_info.ti = "10"b then do; fmt_dta.r0ccyl = bit (fmt_info.alt_def_cyl); /* if alt or def trk to be formated */ fmt_dta.r0chd = bit (fmt_info.alt_def_hd); /* use user supplied cyl and head */ if fmt_info.ti = "10"b then /* for r0 count field */ fmt_dta.r0cti = "01"b; else fmt_dta.r0cti = "10"b; end; else do; fmt_dta.r0ccyl = bit (cyl); /* otherwise use the present position */ fmt_dta.r0chd = bit (head); fmt_dta.r0cti = fmt_info.ti; end; fmt_dta.hz = fmt_info.hz; /* copy the header bypass info */ fmt_dta.ti = fmt_info.ti; /* copy the ti bits */ fmt_dta.chk_chr = cksum (); /* compute cksum char. */ track_indicators = fmt_info.ti; /* copy ti bits for seek command */ control_command = FORMAT_TRK; /* set up the active command to format trk */ io_command = "format"; /* make sure not read */ cont_sw = "1"b; /* set the control sw */ block_len = 5; /* set the data xfer length to 5 words */ call do_io (); /* execute the format command sequence */ end; else if order = "rd_trk_header" & device_group = MSU04XX then do; /* process the "rd_trk_header" order */ key = next_key; /* convert key to binary */ cont_sw = "1"b; /* set control switch */ io_command = "read"; /* set up for read command */ block_len = 5; /* set the data xfer length to 5 words */ track_indicators = "00"b; /* reset track_indicators */ control_command = RD_TRK_HEADER; /* set the command to 27 (8) */ call do_io (); /* execute the read trk header command sequence */ end; else if order = "read_track_header" /* New style read track header order for 451s or 500s. */ then do; /* process the "rd_trk_header" order */ thi_ptr = info_ptr; if thi.version ^= thi_version_1 /* wrong version number in structure */ then call error (error_table_$unimplemented_version, ""); info_ptr = addr (thi.msu4xx_info); /* data is in word after version */ key = next_key; /* convert key to binary */ cont_sw = "1"b; /* set control switch */ io_command = "read"; /* set up for read command */ block_len = FORMAT_DATA_LEN (dev_type); /* set the data xfer length to proper value */ unspec (info_ptr -> block) = "0"b; track_indicators = "00"b; /* reset track_indicators */ control_command = RD_TRK_HEADER; /* set the command to 27 (8) */ call do_io (); /* execute the read trk header command sequence */ end; else if order = "format_track" then do; /* Format either a 4xx or a 5xx device */ thi_ptr = info_ptr; if thi.version ^= thi_version_1 /* wrong version number */ then call error (error_table_$unimplemented_version, "Bad header version."); if dev_type > 7 then call error (error_table_$unimplemented_version, "Bad header version."); key = current_key; track_indicators = bit (thi.msu4xx_info.ti); control_command = FORMAT_TRK; io_command = "format"; cont_sw = "1"b; block_len = FORMAT_DATA_LEN (dev_type); /* set proper block length */ addr (data) -> block = addrel (addr (thi), 1) -> block; call do_io (); end; else if order = "hardware_status" then user_hardware_status = iom_stat; else call error (error_table_$no_operation, order); /* if bad order, tell the user */ a_code = 0; /* made it */ return; /* au revoir */ /* End of CONTROL module */ /* */ /* Start of MODES module */ rdisk_modes: entry (a_iocb_ptr, a_new_modes, a_old_modes, a_code); /* * The modes operation is supported when the I/O switch is * attached. The recognized modes are listed below. Each mode has * a complement indicated by the character "^" (e.g. "^label") that * turns the mode off. * * label,^label specifies that a system-defined * number of sectors at the beginning * of the pack are reserved for a pack * label, and that a seek_key or position * operation is to treat any key * within this area as an invalid key. * (Default is on.) * * alttrk,^alttrk specifies that the pack has been * formatted with the assignment of * alternate tracks, so that a * system-defined number of sectors at * the end of the pack are reserved * for an alternate track area. * Therefore, a seek_key or position operation is * to treat any key within that area * as an invalid key. (Default is * off.) * * wrtcmp,^wrtcmp specifies that the * Write-and-Compare * instruction,rather than the Write * instruction will be used for the * rewrite_record operation. This * causes all data written out to be * read back in and compared to the * data as it was prior to being * written. This mode should be used * with discretion, since it doubles * the data transfer time of every * write. (Default is off.) * * raw, ^raw specifies that the entire disk pack * is available to the user, including * the T & D cylinder (the last * cylinder on the disk pack). (The * default is off.) */ dcl a_new_modes char (*); /* parameter: new modes string */ dcl a_old_modes char (*); /* parameter: put the old modes string here */ dcl temp_next_mode char (16); /* for type conversion for call error */ call setup ("don't_care"); /* set up working environment */ if length (a_old_modes) > 0 then a_old_modes = mode_string; /* if wanted, pass back old modes */ mode_len = length (a_new_modes); /* see how much we've got */ if mode_len > 0 then do; /* if something */ new_modes = a_new_modes; /* grab the new modes */ mode_start = 1; /* keep track of where we are in the string */ do while (next_mode ^= ""); /* mode processing loop */ call get_next_mode; /* extract a mode */ if next_mode ^= "" then do; /* if we got one, do something with it */ mode_err_sw = "0"b; /* give user the benefit of the doubt */ if next_mode = "label" then do; bounds.low = num_label_sect; /* reserve label area */ label_sw = "1"b; end; else if next_mode = "^label" then do; bounds.low = 0;/* let him play,starting at sect. 0 */ label_sw = "0"b; end; else if (next_mode = "alttrk") then do; bounds.high = last_sect_num (dev_type); /* reserve alternate track area */ alt_sw = "1"b; end; else if next_mode = "^alttrk" then do; if device_group = MSU04XX then bounds.high = last_alt_sect_num (dev_type); else bounds.high = last_sect_num (dev_type); alt_sw = "0"b; end; else if next_mode = "wrtcmp" then compare_sw = "1"b; /* set compare mode switch */ else if next_mode = "^wrtcmp" then compare_sw = "0"b; /* set for ordinary write */ else if next_mode = "raw" then do; bounds.low = 0;/* let user have entire pack in this mode */ bounds.high = last_physical_sect_num (dev_type); raw_sw = "1"b; /* set indicator */ end; else if next_mode = "^raw" then do; if label_sw /* in label mode */ then bounds.low = num_label_sect; /* reset origial defaults */ else bounds.low = 0; if ^alt_sw /* in alt mode */ & device_group = MSU04XX /* and on a 400 series device */ then bounds.high = last_alt_sect_num (dev_type); else bounds.high = last_sect_num (dev_type); raw_sw = "0"b; /* reset raw indicator */ end; else do; /* oh oh */ code = error_table_$bad_mode; /* tried to fool mother rdisk_, eh? */ mode_err_sw = "1"b; /* can't let that happen */ end; if ^mode_err_sw then call set_mode; /* update the mode string */ end; end; end; temp_next_mode = next_mode || " "; /* obtain proper type for */ temp_next_mode = substr (temp_next_mode, 1, 16); /* the call to error */ if code ^= 0 then call error (code, temp_next_mode); /* let him know how he did */ else a_code = 0; return; /* don't rush off */ /* Internal procedure to extract single modes from the mode string */ get_next_mode: proc; if mode_len > 0 then do; /* if we still have something left */ new_modes = substr (new_modes, mode_start, mode_len); /* update work string */ i = index (new_modes, ","); /* set i to length of next mode + 1 */ if i = 0 then do; i = index (new_modes, " "); if i = 0 then i = mode_len + 1; end; mode_len = mode_len - i; /* keep track of how much we have left */ mode_start = i + 1; /* and where to start */ next_mode = substr (new_modes, 1, i - 1); /* pass back the mode */ end; else next_mode = ""; /* nothing to return */ end get_next_mode; /* Internal procedure to update the mode string */ set_mode: proc; not_sw = (substr (next_mode, 1, 1) = "^"); /* set switch if a "^" mode */ i = index (mode_string, substr (next_mode, 1 + fixed (not_sw))); /* point to basic mode */ if i <= 1 then if not_sw then mode_string = "^" || mode_string; else ; /* if at beg. just prefix "^" */ else if not_sw & (substr (mode_string, i - 1, 1) ^= "^") /* insert a "^" */ then substr (mode_string, i) = "^" || substr (mode_string, i); else if ^not_sw & (substr (mode_string, i - 1, 1) = "^") then /* delete a "^" */ substr (mode_string, i - 1) = substr (mode_string, i); end set_mode; /* End of MODES module */ /* */ /* Start of CLOSE module */ rdisk_close: entry (a_iocb_ptr, a_code); /* This operation has no effect on the device, but merely resets some fields in the IOCB. */ call setup ("open"); /* set up working environment */ mask_str = "0"b; /* initialize ips_ mask */ call default_handler_$set (cond_hdlr); /* protect ourselves */ call hcs_$set_ips_mask (mask_str, mask_str); real_iocb_ptr -> open_descrip_ptr = null; /* put IOCB in closed state; open descrip. pointer */ real_iocb_ptr -> open = rdisk_open; /* set open entry */ real_iocb_ptr -> detach_iocb = rdisk_detach; /* and detach entry */ real_iocb_ptr -> close, /* shut the close entry */ real_iocb_ptr -> read_record, /* and the read record entry */ real_iocb_ptr -> rewrite_record, /* and the rewrite record entry */ real_iocb_ptr -> position, /* and the position entry */ real_iocb_ptr -> write_record, /* and the write record entry */ real_iocb_ptr -> seek_key = iox_$err_not_open; /* and the seek key entry */ call iox_$propagate (iocb_ptr); /* give iox_ a turn */ call hcs_$reset_ips_mask (mask_str, mask_str); /* back to normal */ next_key, current_key, key_for_insertion = NULL; /* reset all keys to invalid state */ a_code = 0; /* be nice to him */ return; /* and he may call us again, sometime */ /* End of CLOSE module */ /* */ /* Start of DETACH module */ rdisk_detach: entry (a_iocb_ptr, a_code); /* This operation dismounts and detaches the device, and cleans up the IOCB. */ call setup ("closed"); /* set up working environment */ rcp_detachment = "0"b; call delete_attach (rcp_detachment); if rcp_detachment then do; call rcp_$detach (rcp_id, (DEFAULT), errors, "", code); /* detach the device */ call ipc_$delete_ev_chn (ev_chan, code);/* get rid of event channel */ end; call hcs_$delentry_seg (disk_ptr, code); /* get rid of work segment */ disk_ptr = null; /* null the pointer */ mask_str = "0"b; /* initialize ips_ mask */ call default_handler_$set (cond_hdlr); /* protect ourselves */ call hcs_$set_ips_mask (mask_str, mask_str); iocb_ptr -> attach_data_ptr = null; /* clean up the IOCB; null the data pointer */ iocb_ptr -> attach_descrip_ptr = null; /* and the attach descrip. pointer */ iocb_ptr -> iocb.control, /* reset control */ iocb_ptr -> iocb.modes = iox_$err_no_operation; /* and modes operations */ call iox_$propagate (iocb_ptr); /* tell iox_ */ call hcs_$reset_ips_mask (mask_str, mask_str); /* back to normal */ if code ^= 0 then call error (code, "Problem in detaching."); /* tell user if something went wrong */ a_code = 0; /* otherwise, give him a good send-off */ return; delete_attach: proc (detach_rcp); /* Internal proc to delete this attachment from the array */ dcl detach_rcp bit (1); dcl sv_att_idx fixed bin; dcl count_att fixed bin; count_att = 0; if attachments_ptr = null () then detach_rcp = "1"b; /* some this is wrong let rcp complain it may know */ if attachments.array (att_dev_idx).sv (1).this_sv = -1 /* attached as one device can only be one attachment */ then count_att = 1; else do sv_att_idx = 1 to 3; /* count the number of attachments for this device */ if attachments.array (att_dev_idx).sv (sv_att_idx).this_iocbp ^= null () then count_att = count_att + 1; end; attachments.array (att_dev_idx).sv (att_sv_idx).this_iocbp = null (); if count_att = 1 then do; detach_rcp = "1"b; attachments.array (att_dev_idx).device_att = ""; end; attachments.number_attached = attachments.number_attached - 1; if attachments.number_attached = 0 then do; /* free attachment array */ free attachments in (system_area); attachments_ptr = null (); end; return; end delete_attach; /* End of DETACH module */ /* */ /* Internal SETUP Procedure */ setup: proc (setup_input_arg); dcl setup_input_arg char (*); dcl desired_switch_state char (12) varying; /* call setup ("open") means the switch should be open -- complain if it is closed. */ /* call setup ("closed") " " " " " closed -- " " " " open. */ /* call setup ("don't_care") means that the switch can be either open or closed. */ dcl who_did_the_attach char (32) varying; /* Which I/O module attached this file? */ dcl setup_error_msg char (36); /* temporary error message */ code = 0; /* give him a chance to make it */ desired_switch_state = setup_input_arg; iocb_ptr = a_iocb_ptr; /* pick up pointer to IOCB */ real_iocb_ptr = iocb_ptr -> actual_iocb_ptr; /* the real one, this time */ disk_ptr = real_iocb_ptr -> attach_data_ptr; /* and a pointer to our work seg */ if real_iocb_ptr -> attach_descrip_ptr = null then call error (error_table_$not_attached, ""); /* must be attached */ who_did_the_attach = substr (attach_descrip.descrip, 1, index (attach_descrip.descrip, " ") - 1); if who_did_the_attach ^= "rdisk_" then do; setup_error_msg = "Not attached by rdisk_ but by " || who_did_the_attach; call error (error_table_$not_attached, setup_error_msg); end; if desired_switch_state = "open" then if real_iocb_ptr -> open_descrip_ptr = null then call error (error_table_$not_open, ""); else if desired_switch_state = "closed" then if real_iocb_ptr -> open_descrip_ptr ^= null then call error (error_table_$not_closed, ""); else if desired_switch_state = "don't_care" then return; end setup; /* */ /* Internal ERROR Procedure */ error: proc (cd, err_msg); dcl cd fixed bin (35); /* code */ dcl err_msg char (*); /* Additional text. */ if disk_ptr ^= null then /* if we have a work seg, we can check print-error switch */ if err_sw then call sub_err_ (cd, "rdisk_", "c", null, retval, "^a ^a", iocb_ptr -> iocb.name, err_msg); /* print if desired */ else ; else call sub_err_ (cd, "rdisk_", "c", null, retval, "^a ^a", iocb_ptr -> iocb.name, err_msg); /* can't check, just give it to him */ code = cd; /* set code */ go to exit; /* and exit, stage right */ end error; /* */ /* Internal PACK MOUNT procedure */ mount: proc; dcl cleanup condition; errors = 0; /* give the pack a fresh start */ disk_info_ptr = addr (rcp_data); /* init. disk info prior to attaching device */ disk_info.volume_name = pack_id; /* fill in new pack id */ call rcp_$attach ((rcp_dev_type), disk_info_ptr, ev_chan, "", rcp_id, code); /* attach device */ if code ^= 0 then return; /* let caller handle problems */ call rcp_$check_attach (rcp_id, disk_info_ptr, "", devx, max_buff_size, time_int, rcp_state, code); if code ^= 0 then return; /* check attachment completion */ do while (rcp_state ^= COMPLETE); /* loop until attachment is complete or fails */ on cleanup call detach; /* detach disk if user aborting */ call ipc_$block (addr (wait_list), addr (event_info), code); /* wait to hear from rcp_ */ revert cleanup; if code ^= 0 then return; call rcp_$check_attach (rcp_id, disk_info_ptr, "", devx, max_buff_size, time_int, rcp_state, code); if code ^= 0 then return; /* let caller worry about it */ if rcp_state < COMPLETE | rcp_state >= LONG_WAIT then do; code = error_table_$action_not_performed; /* let user know he has a problem */ return; /* let caller pass bad news to user */ end; end; if drive = NOT_SET then do; drive_number.sign = "+"; /* successful assignment, convert and save drive number */ drive_number.number = substr (disk_info.device_name, 6, 2); drive = drive_dec; end; buf_len = min (max (divide (sze, 4, 17, 0), 1024), max_buff_size); /* determine ioi_ buffer size */ call ioi_$workspace (devx, buf_ptr, buf_len, code); /* and try to get it */ if code ^= 0 then return; /* win some -- lose some */ data_len = buf_len - overhead; /* set length of data area */ call ioi_$set_status (devx, fixed (rel (addr (istat))), 1, code); /* tell ioi_ how to reach us */ if code ^= 0 then return; call ioi_$timeout (devx, (time_int), code); /* have ioi_ do it */ if code ^= 0 then return; /* how do you like that! */ detach: proc; call rcp_$detach (rcp_id, "0"b, (0), "", (0)); return; end detach; end mount; /* */ /* Internal CONDITION HANDLER */ cond_hdlr: proc (mc_ptr, cond_name, wc_mc_ptr, info_ptr, cont_sw); /* This procedure handles any unusual conditions signaled while we are masked by terminating the process. This avoids problems we would have if we attempted to use an IOCB which was left in an inconsistent state. */ dcl (mc_ptr, wc_mc_ptr, info_ptr) ptr; dcl cond_name char (*); /* condition name */ dcl cont_sw bit (1) aligned; /* continuation switch */ if masked then do; /* if we were masked, kill the process */ tp_info.version = 0; /* currently version 0 */ tp_info.code = error_table_$termination_requested; /* as good a reason as any */ call terminate_process_ ("fatal_error", addr (tp_info)); /* do the dirty deed */ end; if cond_name ^= "cleanup" then cont_sw = "1"b; /* don't pass on cleanup */ end cond_hdlr; /* */ /* Internal CHECKSUM procedure */ cksum: proc returns (bit (6)); /* routine to compute exclusive or check char */ dcl ckchar bit (6); /* working storage */ dcl fmtsum (30) bit (6) based (fmdp); /* format data as 6 bit char */ ckchar = "0"b; /* initialize working storage */ do i = 1 to 30; /* compute check char */ ckchar = bool (ckchar, fmtsum (i), "0110"b); end; return (ckchar); /* return computed check character */ end cksum; /* */ /* Internal procedure to handle the io_call order */ io_call_order: proc; dcl changepack char (32) var; dcl 1 getbounds aligned, 2 low fixed bin (35), 2 high fixed bin (35); dcl setsize fixed bin (35); dcl 1 device_info_table aligned, 2 dev_type char (4), 2 device_name char (8), 2 sect_per_dev fixed bin (35), 2 cyl_per_dev fixed bin, 2 sect_per_cyl fixed bin, 2 sect_per_track fixed bin, 2 num_label_sect fixed bin, 2 num_alt_sect fixed bin, 2 sect_size fixed bin (12); dcl 1 track_header_data like thi; %include io_call_info; io_call_infop = a_info_ptr; if io_call_info.order_name = "setsize" then do; if io_call_info.nargs ^> 0 then do; call io_call_info.error (error_table_$noarg, io_call_info.caller_name, "New size."); return; end; setsize = cv_dec_check_ ((io_call_info.args (1)), code); if code ^= 0 then do; call io_call_info .error (0, io_call_info.caller_name, "Invalid size: ^a.", io_call_info.args (1)); code = 0; return; end; call iox_$control (iocb_ptr, "setsize", addr (setsize), code); return; end; else if io_call_info.order_name = "changepack" then do; if io_call_info.nargs ^> 0 then do; call io_call_info.error (error_table_$noarg, io_call_info.caller_name, "New pack name."); return; end; changepack = io_call_info.args (1); call iox_$control (iocb_ptr, "changepack", addr (changepack), code); return; end; else if io_call_info.order_name = "getbounds" then do; call iox_$control (iocb_ptr, "getbounds", addr (getbounds), code); if code = 0 then do; call io_call_info . report ("^a: Sectors available are ^d:^d", io_call_info.caller_name, getbounds.low, getbounds.high); end; return; end; else if io_call_info.order_name = "device_info" then do; call iox_$control (iocb_ptr, "device_info", addr (device_info_table), code); if code = 0 then do; call io_call_info . report ("Device Characteristics:^/^/device type:^-^-^a^/device name:^-^-^a", device_info_table.dev_type, device_info_table.device_name); call io_call_info . report ("sectors per device:^-^-^d^/cylinders per device:^-^d", device_info_table.sect_per_dev, device_info_table.cyl_per_dev); call io_call_info . report ("sectors per cylinder:^-^d^/sectors per track:^-^-^d", device_info_table.sect_per_cyl, device_info_table.sect_per_track); call io_call_info . report ("number of label sectors:^-^d^/number of alternate sectors:^-^d", device_info_table.num_label_sect, device_info_table.num_alt_sect); call io_call_info.report ("sector size (words):^-^d", device_info_table.sect_size); end; return; end; else if io_call_info.order_name = "read_track_header" then do; track_header_data.version = thi_version_1; call iox_$control (iocb_ptr, "read_track_header", addr (track_header_data), code); if code = 0 then if io_call_info.nargs > 0 then if io_call_info.args (1) = "-hex" then call print_track_header_info (addr (track_header_data), io_call_info.report, "1"b); else call print_track_header_info (addr (track_header_data), io_call_info.report, "0"b); else call print_track_header_info (addr (track_header_data), io_call_info.report, "0"b) ; return; end; else if io_call_info.order_name = "format_trk" | io_call_info.order_name = "rd_trk_header" | io_call_info.order_name = "read_track_header" then do; call io_call_info . error (0, io_call_info.caller_name, "The ^a control order is not supported by io_call", io_call_info.order_name); return; end; else code = error_table_$no_operation; return; end io_call_order; print_track_header_info: proc (thip, report, all_sw); dcl all_sw bit (1); dcl report entry variable options (variable); dcl thip ptr; dcl header_dumped bit (1) init ("0"b); dcl i fixed bin; dcl last_sector fixed bin; dcl header_array (FORMAT_DATA_LEN (dev_type)) bit (36) based (addrel (thip, 1)); call report ("^/position=(^d/^d) ti=^2b^[ alternate=(^d/^d)^;^2s^] tskip=^d,^d,^d cf=^a", thip -> thi.c0.cyl_lower + thip -> thi.c0.cyl_upper * 256, thip -> thi.c0.head, bit (thip -> thi.c0.ti), (thip -> thi.c0.alt_cyl_lower + thip -> thi.c0.alt_cyl_upper + thip -> thi.c0.alt_head ^= 0), thip -> thi.c0.alt_cyl_lower + thip -> thi.c0.alt_cyl_upper * 256, thip -> thi.c0.alt_head, thip -> thi.c0.t_skip.distance, cond_flag (thip -> thi.c0.cf)); call report ( "physical sector size = ^[512^;64^] words.^[Format of this disk by Honeywell has ^[not ^]completed.^;^s^]", thip -> thi.c0.large_records, thip -> thi.c0.honeywell_formatted, ^(thip -> thi.c0.format_complete)); if thip -> thi.c0.log_track then call report ("*** This is a log track. ***"); call report ("^/skip1^5xskip2^5xcf^/"); call report ("^8a^2x^8a^2x^a", skip_mess (thip -> thi.c0.skip (1)), skip_mess (thip -> thi.c0.skip (2)), cond_flag (thip -> thi.c0.cf)); if dev_type = msu0500devt then last_sector = 40; else if dev_type = msu0501devt then last_sector = 8; else last_sector = 0; do i = 1 to last_sector - 1; call report ("^8a^2x^8a^2x^a", skip_mess (thip -> thi.c (i).skip (1)), skip_mess (thip -> thi.c (i).skip (2)), cond_flag (thip -> thi.c (i).cf)); end; if all_sw /* dump it in hex also */ then call dump_header (); return; cond_flag: proc (cf) returns (char (*)); dcl cf bit (8) unal; if cf = "0011100"b then return ("No Error"); else if cf = "00111001"b then return ("EDAC Error - Corrected"); else if cf = "00111010"b then return ("EDAC Error - Uncorrectable"); else return (char (cf)); end cond_flag; dump_header: proc (); if header_dumped then return; call report ("^(^/^4(^9.4b^2x^)^)", header_array); header_dumped = "1"b; return; end dump_header; skip_mess: proc (skip) returns (char (8)); dcl 1 skip like thi.msu5xx_info.c0.skip unal; dcl 1 retval unal, 2 disp pic "zzzz9", 2 space char (1) init (" "), 2 type char (2); if ^skip.used then return ("none "); if skip.gap_following_count then type = "FC"; else if skip.gap_following_data then type = "FD"; else type = "ID"; disp = skip.displacement; return (string (retval)); end skip_mess; end print_track_header_info; end rdisk_;  recover_volume_log.pl1 11/11/89 1129.5rew 11/11/89 0851.4 270594 /****^ *********************************************************** * * * Copyright, (C) BULL HN Information Systems Inc., 1989 * * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style1,ind2,^inddcls,ifthenstmt,dclind2,declareind2,ifthendo,ifthen*/ recover_volume_log: proc; /* This utility command is used in the rare case when a volume log is not available, either because it has been deleted, or because we are reloading the RPV. It recovers the latest volume log by name from the dump volume that the requestor provides. It is the requestor's responsibility to provide the latest dump volume. */ /* Modified 6/79 by D. Vinograd to correct check for beginning of logical record */ /* Modified 11/79 by D. Vinograd to add -wd as control arg and add code to delete volume log if recovered when there is one already there */ /* Modified: 9/83 by GA Texada to allow multiple pvnames to be specified, and to reformat and move includes. */ /* Modified: 3/14/84 by GA Texada to allow for 'stranger' volume logs. */ /****^ HISTORY COMMENTS: 1) change(88-10-10,Farley), approve(88-10-10,MCR8005), audit(88-10-15,Beattie), install(88-10-17,MR12.2-1173): Added new read routine and associated surrounding code to support the version 2 volume dump tapes. These tapes have a pair of unique strings that delimit the object data of vtoce_type records. 2) change(89-08-31,GWMay), approve(89-10-03,MCR8135), audit(89-10-04,Beattie), install(89-10-10,MR12.3-1089): Updated to process version 3 of backup_volume_log.incl.pl1 structures. END HISTORY COMMENTS */ dcl (att_desc, input_volume_desc) char (256); dcl (ac, argl, enl, itype, nargs, words_skipped, i, pvindex) fixed bin; dcl (char_read, read_char) fixed bin (21); dcl recovery_dir char (168); dcl temp_dir char (168); /* a place to put my pdir */ dcl (argp, iocbp) ptr; dcl (debug, wd_specified, new_tape, first_input_volume, ok_to_abc, resynching) bit (1); dcl delimited bit (1) aligned; /* ON = reading object data delimited by unique matching strings */ dcl (irpvpvid, irpvlvid, time) bit (36); dcl input_buf (divide (char_read, CHARS_PER_WORD, 17, 0)) bit (36) based (recordp); dcl word (size (backup_volume_header)) bit (36) based (recordp); dcl string bit (BITS_PER_WORD * size (backup_volume_header)) based (recordp); dcl pattern_match_label label; dcl (ilvname, volname) char (32); dcl var_volname char (32) varying; dcl (code, ignore) fixed bin (35); dcl arg char (argl) based (argp); dcl objectp ptr; dcl input_buffer_ptr ptr; dcl input_buffer_start fixed bin; dcl input_buffer_len fixed bin (21); dcl old_256K_switch bit (2) aligned; dcl tp (3) ptr; dcl 1 rvl aligned based (rvlp), /* structure to control multiple pv's */ 2 npvs fixed bin, /* number of valid per_pv's */ 2 per_pv (maxpvs), /* max that can be done (same as nargs) */ 3 pvname char (32), /* pvname name to be recovered */ 3 volname char (32), /* tape volume the log found on */ 3 ename char (32), /* name to terminate */ 3 temp_logp ptr, /* for pdir recovery */ 3 new_logp ptr, /* ptr to recoverd log */ 3 time bit (36), /* fs time of recover log */ 3 flags, 4 abandoned bit (1) unal, /* if I had to abandon this one */ 4 volog_found bit (1) unal, /* if I found his */ 4 mbz bit (34) unal, /* RFU */ rvlp ptr, maxpvs fixed bin; /* will be set to nargs for allocation of rvl */ dcl (cleanup, linkage_error) condition; dcl error_table_$data_loss fixed bin (35) ext; dcl error_table_$noentry fixed bin (35) ext; dcl error_table_$entlong fixed bin (35) ext; dcl error_table_$segknown fixed bin (35) ext; dcl error_table_$namedup fixed bin (35) ext; dcl error_table_$device_end fixed bin (35) ext; dcl error_table_$end_of_info fixed bin (35) ext; dcl error_table_$badopt ext fixed bin (35); dcl sys_info$seg_size_256K fixed bin (19) ext static; dcl sys_info$max_seg_size fixed bin (18) ext static; dcl DEFAULT_RECOVERY_DIR char (168) int static init (">daemon_dir_dir>volume_backup") options (constant); dcl myname char (32) static init ("recover_volume_log") options (constant); dcl DELIMITED bit (1) aligned internal static options (constant) init ("1"b); dcl FORWARD_CHAR_POSITIONING fixed bin int static init (3) options (constant); dcl hcs_$delentry_file entry (char (*), char (*), fixed bin (35)); dcl hcs_$delentry_seg entry (ptr, fixed bin (35)); dcl hphcs_$delentry_file entry (char (*), char (*), fixed bin (35)); dcl get_group_id_ entry returns (char (32)); dcl get_pdir_ entry () returns (char (168)); dcl hcs_$level_get entry returns (fixed bin); dcl date_time_$fstime entry (bit (36), char (*)); dcl adjust_bit_count_ entry (char (*), char (*), bit (1), fixed bin, fixed bin (35)); dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl hcs_$fs_search_get_wdir entry (ptr, fixed bin (35)); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl com_err_ entry options (variable); dcl get_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)); dcl ioa_$rsnnl entry options (variable); dcl ioa_ entry options (variable); dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); dcl hcs_$fs_move_seg entry (ptr, ptr, fixed bin, fixed bin (35)); dcl hcs_$set_256K_switch entry (bit (2) aligned, bit (2) aligned, fixed bin (35)); dcl hcs_$set_max_length_seg entry (ptr, fixed bin (19), fixed bin (35)); dcl hcs_$truncate_seg entry (ptr, fixed bin (19), fixed bin (35)); dcl iox_$attach_ioname entry (char (*), ptr, char (*), fixed bin (35)); dcl command_query_ entry () options (variable); dcl mdc_$pvname_info entry (char (*), bit (36), char (*), bit (36), fixed bin, fixed bin (35)); dcl release_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)); dcl (addcharno, addr, divide, index, length, min, null, ptr, size, substr) builtin; /* init local control variables */ temp_dir = get_pdir_ (); /* all recovery is done here first, moved after validation*/ recovery_dir = DEFAULT_RECOVERY_DIR; debug, resynching, time, ok_to_abc = "0"b; first_input_volume = "1"b; input_volume_desc = ""; old_256K_switch = ""b; tp (*) = null; bvlp, iocbp, rvlp = null (); code, maxpvs = 0; query_info.version = query_info_version_6; on cleanup call finish_; /* set up cleanup handler */ call cu_$arg_count (nargs, code); if nargs <= 0 then do; argerr: call com_err_ (0, myname, " USAGE: ^a pvnames [-input_volume_desc ""alternate attach decscription""] [-working_dir | -wd]", myname); return; end; do ac = 1 to nargs; call cu_$arg_ptr (ac, argp, argl, code); if code ^= 0 then do; call com_err_ (code, myname); goto finish; end; if arg = "-input_volume_desc" then do; ac = ac + 1; call cu_$arg_ptr (ac, argp, argl, code); if code ^= 0 then do; call com_err_ (code, myname, "Unable to access input volume desc"); goto finish; end; input_volume_desc = arg; end; else if arg = "-working_dir" | arg = "-wd" then do; wd_specified = "1"b; recovery_dir = wdir_ (); end; else if substr (arg, 1, 1) = "-" then do; call com_err_ (error_table_$badopt, myname, "^a", arg); goto finish; end; else do; /* should be a pvname, we will validate it later */ if rvlp = null () then do; maxpvs = (nargs - ac) + 1; /* this is the max we could need */ allocate rvl set (rvlp); /* allocate the space */ rvl.npvs = 0; /* get ready */ end; rvl.npvs = rvl.npvs + 1; /* bump to the next slot */ rvl.pvname (rvl.npvs) = arg; /* and put in the unvalidated name */ rvl.volname (rvl.npvs), rvl.ename (rvl.npvs) = "";/* now, initialize the entry */ rvl.temp_logp (rvl.npvs), rvl.new_logp (rvl.npvs) = null (); /* so the cleanup handler works properly*/ rvl.time (rvl.npvs), rvl.flags (rvl.npvs) = "0"b; end; end; if (rvlp = null ()) | (rvl.npvs = 0) then do; /* hmmmm, no pvnames given, complain */ call com_err_ (0, myname, "No pvnames were specified."); goto finish; end; call setup_data_segments; if code ^= 0 then do; call com_err_ (code, myname, "Unable to get temp segs"); goto finish; end; code = 0; call attach; /* The search loop reads successive records from the dump volume until it encounters a volume log with the name that matches pvname. It then creates a segment, if one does not already exist and copies the data into it. The dump volume is read until the end of tape is reached. */ search_loop: pvindex = 0; /* pvindex is set by read_volume_record */ do while (pvindex = 0 & code = 0 & not_all_abandoned ()); /* not_all_abandoned returns true if */ call read_volume_record; /* there is at least one pvname that we are still looking for*/ end; if code ^= 0 then do; call com_err_ (code, myname, "Error while reading input volume"); goto finish; end; /* create entry name */ if pvindex ^= 0 then do; call ioa_$rsnnl ("^a.^a", rvl.ename (pvindex), enl, rvl.pvname (pvindex), "volog"); if enl > length (rvl.ename (1)) then do; code = error_table_$entlong; call com_err_ (code, myname, "Error creating volog name for ^a. Recovery for it will be abandoned.", rvl.pvname (pvindex)); rvl.abandoned (pvindex) = "1"b; /* don't do this anymore! */ goto search_loop; end; call delete_make_and_move (temp_dir, bvlp, rvl.temp_logp (pvindex)); /* create and get ptr to segment */ if rvl.abandoned (pvindex) then ; /* sorry charlie... */ else rvl.volog_found (pvindex) = "1"b; /* only mark it if all operations worked... */ goto search_loop; end; finish_all_temp: if validate_all_vologs () then do; /* ok, we've got all vologs in the process dir */ /* they all must match as to who the RPV is */ if ^wd_specified then do; /* but, if we are NOT wd mode, then they also */ /* must belong to the mounted RPV */ call mdc_$pvname_info ("rpv", irpvpvid, ilvname, irpvlvid, itype, (0)); if irpvpvid ^= rvl.new_logp (1) -> backup_volume_log.info.root_pvid then do; call com_err_ (0, myname, "Invalid attempt to recover a 'stranger' volume log. Use ""-wd""."); goto finish; end; end; do pvindex = 1 to rvl.npvs; if ((rvl.volog_found (pvindex)) & ^(rvl.abandoned (pvindex))) then call delete_make_and_move (recovery_dir, rvl.temp_logp (pvindex), rvl.new_logp (pvindex)); end; end; else call com_err_ (0, myname, "All volume logs must belong to the same RPV."); /* cleanup attachments, temp segs, and address space */ finish: call finish_; return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ all_vologs_found: proc () returns (bit (1)); dcl i fixed bin; do i = 1 to rvl.npvs; if (^rvl.volog_found (i)) then return ("0"b); /* if one hasn't been found, return... */ end; return ("1"b); end all_vologs_found; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ not_all_abandoned: proc () returns (bit (1)); dcl i fixed bin; do i = 1 to rvl.npvs; if rvl.abandoned (i) then ; else return ("1"b); /* at least one is still ok */ end; return ("0"b); /* nope, all abandoned */ end not_all_abandoned; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ detach: proc; /* This proc closes and detaches the dump volume. */ call iox_$close (iocbp, ignore); call iox_$detach_iocb (iocbp, ignore); iocbp = null; /* be sure */ end detach; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ setup_data_segments: proc; /* This proc sets up the data segments used during the recovery. */ call get_temp_segments_ (myname, tp, code); if code ^= 0 then return; recordp = tp (1); objectp = tp (2); input_buffer_ptr = tp (3); call hcs_$set_256K_switch ("11"b, (""b), code); if code ^= 0 then return; call hcs_$set_max_length_seg (objectp, sys_info$seg_size_256K, code); if code ^= 0 then return; call hcs_$set_max_length_seg (input_buffer_ptr, sys_info$seg_size_256K, code); if code ^= 0 then return; input_buffer_start = 1; input_buffer_len = 0; return; end setup_data_segments; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ attach: proc; /* This proc queries the caller for the dump volume name, attaches to it and opens it. */ reask: call command_query_ (addr (query_info), var_volname, myname, "Type ^[next ^;^s^]most recent dump volume name (Type ""."" to quit): ", (^first_input_volume)); if var_volname = "" then goto reask; if var_volname = "." then goto finish; volname = var_volname; first_input_volume = "0"b; if input_volume_desc ^= "" then call ioa_$rsnnl (input_volume_desc, att_desc, (0), volname); else call ioa_$rsnnl ("tape_mult_ ^a ^[-system^]", att_desc, (0), volname, ^debug); call iox_$attach_ioname ("input_volume", iocbp, att_desc, code); if code ^= 0 then do; call com_err_ (code, myname, "Unable to attach input volume with attach desc ^a", att_desc); goto finish; end; call iox_$open (iocbp, Stream_input, "0"b, code); if code ^= 0 then do; call com_err_ (code, myname, "Error opening input volume"); goto finish; end; end attach; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ delete_make_and_move: proc (temp_dir_in, ptr_in1, ptr_in2); dcl temp_dir_in char (*), (ptr_in1, ptr_in2) ptr; on linkage_error goto delerr; call hcs_$delentry_file (temp_dir_in, (rvl.ename (pvindex)), code); if code ^= 0 & code ^= error_table_$noentry then do; call hphcs_$delentry_file (temp_dir_in, (rvl.ename (pvindex)), code); if code ^= 0 then do; delerr: call com_err_ (code, myname, "Unable to delete ^a>^a. Recovery for it will be abandoned.", temp_dir_in, rvl.ename (pvindex)); rvl.abandoned (pvindex) = "1"b; /* well, forget this one... */ return; end; end; call hcs_$make_seg (temp_dir_in, (rvl.ename (pvindex)), "", 01010b, ptr_in2, code); if (code = 0 | code = error_table_$namedup | code = error_table_$segknown) then ; else do; call com_err_ (code, myname, "Unable to create volog seg ^a>^a. Recovery for it will be abandoned.", temp_dir_in, rvl.ename (pvindex)); rvl.abandoned (pvindex) = "1"b; /* forget this one */ return; end; /* copy data */ call hcs_$fs_move_seg (ptr_in1, ptr_in2, 1, code); if code ^= 0 then do; call com_err_ (code, myname, "Unable to move volog from temp seg to target. Recovery for it will be abandoned."); rvl.abandoned (pvindex) = "1"b; return; end; end delete_make_and_move; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ validate_all_vologs: proc () returns (bit (1)); dcl i fixed bin, mismatch bit (1) init ("0"b); do i = 1 to rvl.npvs; if rvl.temp_logp (i) -> backup_volume_log.info.root_pvid = rvl.temp_logp (1) -> backup_volume_log.info.root_pvid then ; else mismatch = "1"b; end; return (^mismatch); end validate_all_vologs; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ resynch_volume: proc; /* This proc is used for error recovery. It reads the dump volume word by word looking for a match on the 3 words which are part of the header of the logical dump record. When it gets a match it returns to specified label. While resynchronization is in progress , io error handling is suppressed except if we reach the end of a dump volume. This code is freely adapted from the volume reloader. */ resynching = "1"b; input_buf (*) = "0"b; new_tape = "0"b; read_char = CHARS_PER_WORD * size (backup_volume_header); call read (recordp, read_char, char_read, ^DELIMITED, code); call check_input_error; if new_tape then goto search_loop; words_skipped = 0; test: if word (1) = pattern1 & word (4) = pattern2 & word (7) = pattern3 then do; call com_err_ (0, myname, "Synchronization completed ^d words skipped", words_skipped); resynching = "0"b; delimited = "0"b; code = 0; goto pattern_match_label; end; string = substr (string, 37, (size (backup_volume_header) - 1) * BITS_PER_WORD); new_tape = "0"b; read_char = CHARS_PER_WORD; call read (addr (word (size (backup_volume_header))), read_char, char_read, ^DELIMITED, code); call check_input_error; if new_tape then goto search_loop; words_skipped = words_skipped + 1; if words_skipped > 1000000 then do; /* put a limit on it */ call com_err_ (0, myname, "Resynchronization failed"); code = error_table_$end_of_info; call check_input_error; goto search_loop; end; goto test; end resynch_volume; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ skip_chars: proc; /* This proc skips forward on a dump volume. */ call read (objectp, read_char, char_read, delimited, code); call check_input_error; end skip_chars; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ check_input_error: proc; /* This proc is used to check all io errors after a read request. If no error we return. If we are at the end of the dump volume, then it is detached. If a volume log has not been found, a new dump volume is requested. Otherwise we are done. If the error is the result of a bad read we start resynchronization. If it has already been started we just return. */ new_tape = "0"b; if read_char ^= char_read | code ^= 0 then do; if (code = error_table_$end_of_info) | (code = error_table_$device_end) then do; call detach; /* if all have been found OR all */ if (all_vologs_found ()) | (^not_all_abandoned ()) then goto finish_all_temp; /* have been abandoned, then forget it... */ else do; call attach; /* try the next tape */ new_tape = "1"b; end; return; end; else if resynching then do; call com_err_ (code, myname, "I/O error reading input volume"); call detach; goto finish; end; else if ^resynching then do; if read_char ^= char_read then do; if code = error_table_$data_loss then call com_err_ (code, myname, "Incomplete object detected"); else do; if code = 0 then call com_err_ (code, myname, "Read did not complete"); else call com_err_ (code, myname, "I/O error reading input volume"); end; end; else do; if code = -1 then call com_err_ (0, myname, "Invalid dump record header"); else call com_err_ (code, myname, "I/O error reading input volume"); end; call ioa_ ("^a: Resynching started", myname); call resynch_volume; end; end; end check_input_error; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ read_volume_record: proc; /* This proc reads a logical dump record, and checks to see it it is a volume log with the name pvname. If so it returns with pvindex pointing to the correct rvl entry. If the logical dump record is not what we are looking for, the next logical dump record is examined. */ pattern_match_label = pattern_match; new_tape = "0"b; delimited = "0"b; read_char = CHARS_PER_WORD * size (backup_volume_header); call read (recordp, read_char, char_read, delimited, code); call check_input_error; if new_tape then return; if backup_volume_record.pattern1 ^= pattern1 | backup_volume_record.pattern2 ^= pattern2 | backup_volume_record.pattern3 ^= pattern3 then do; code = -1; call check_input_error; end; pattern_match: read_char = backup_volume_record.rec1_len - size (backup_volume_header) * CHARS_PER_WORD; call read (ptr (recordp, size (backup_volume_header)), read_char, char_read, delimited, code); call check_input_error; if new_tape then return; if backup_volume_record.rec1_type ^= volume_log_type then do; read_char = backup_volume_record.rec2_len; if backup_volume_record.rec1_type = vtoce_type & backup_volume_record.version > backup_volume_record_version_1 then delimited = "1"b; /* object data is delimited */ call skip_chars; return; end; bvlp = recordp; if (backup_volume_log.version = backup_volume_log_version_1) | (backup_volume_log.version = backup_volume_log_version_2) | (backup_volume_log.version = backup_volume_log_version_3) then ; else do; call com_err_ (0, myname, "Invalid volume log version"); return; end; do pvindex = 1 to rvl.npvs; /* include the check for previous abandonment here...*/ if (backup_volume_log.pvname = rvl.pvname (pvindex)) & ^(rvl.abandoned (pvindex)) then do; if (rvl.volog_found (pvindex)) & (rvl.time (pvindex) > backup_volume_log.time_dumped) then do; pvindex = 0; /* it is older than the one we already have */ return; /* we don't want this one */ end; rvl.time (pvindex) = backup_volume_log.time_dumped; rvl.volname (pvindex) = volname; return; /* pvindex is set */ end; end; pvindex = 0; /* not found */ end read_volume_record; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ read: proc (return_buffer_ptr, Nrequested_chars, Nreturned_chars, Sdelimited, code); dcl return_buffer_ptr ptr, Nrequested_chars fixed bin (21), Nreturned_chars fixed bin (21), Sdelimited bit (1) aligned, code fixed bin (35); dcl input_buffer char (256 * CHARS_PER_PAGE) based (input_buffer_ptr); dcl return_string char (Nrequested_chars) based (return_buffer_ptr); dcl Nassign_chars fixed bin (21), Nread_chars fixed bin (21), end_of_record fixed bin, tape_check1 /* bit (72) */ char (8), tape_check2 /* bit (72) */ char (8); Nreturned_chars, Nread_chars, code = 0; do while (Nreturned_chars < Nrequested_chars & code = 0); if input_buffer_len = 0 then do; input_buffer_start = 1; if Sdelimited & Nreturned_chars = 0 then do; call iox_$get_chars (iocbp, addr (tape_check1), length (tape_check1), Nread_chars, code); if code ^= 0 then return; end; if return_buffer_ptr = null then do; call iox_$position (iocbp, FORWARD_CHAR_POSITIONING, Nrequested_chars - Nreturned_chars, code); Nreturned_chars = Nreturned_chars + Nrequested_chars; end; else do; call iox_$get_chars (iocbp, addcharno (return_buffer_ptr, Nreturned_chars), Nrequested_chars - Nreturned_chars, Nread_chars, code); Nreturned_chars = Nreturned_chars + Nread_chars; end; if code ^= 0 then return; if Sdelimited then do; call iox_$get_chars (iocbp, addr (tape_check2), length (tape_check2), Nread_chars, code); if code ^= 0 then return; if tape_check1 ^= tape_check2 then do; /* found a short segment, move */ /* return string into the temp input */ /* buffer and start parsing */ input_buffer_len = Nreturned_chars; substr (input_buffer, 1, input_buffer_len) = return_string; end; end; end; else if Sdelimited then do; tape_check1 = substr (input_buffer, input_buffer_start, length (tape_check1)); tape_check2 = ""; input_buffer_start = input_buffer_start + length (tape_check1); input_buffer_len = input_buffer_len - length (tape_check1); end; if input_buffer_len > 0 then do; Nassign_chars = min (input_buffer_len, Nrequested_chars); if Sdelimited then do; if tape_check1 ^= tape_check2 then do; end_of_record = index (substr (input_buffer, input_buffer_start, input_buffer_len), tape_check1); if end_of_record > 0 then do; Nassign_chars = end_of_record - 1; if Nrequested_chars ^= Nassign_chars then code = error_table_$data_loss; end; end; end; if return_buffer_ptr ^= null then return_string = substr (input_buffer, input_buffer_start, Nassign_chars); Nreturned_chars = Nassign_chars; input_buffer_start = input_buffer_start + Nassign_chars; input_buffer_len = input_buffer_len - Nassign_chars; if Sdelimited & input_buffer_len > 0 then do; input_buffer_start = input_buffer_start + length (tape_check2); substr (input_buffer, 1, input_buffer_len) = substr (input_buffer, input_buffer_start, input_buffer_len - length (tape_check2)) || tape_check2; input_buffer_start = 1; end; end; end; return; end read; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ wdir_: proc returns (char (168) aligned); /* This proc returns the pathname of the working directory. */ dcl wdir char (168) aligned; call hcs_$fs_search_get_wdir (addr (wdir), ignore); return (wdir); end wdir_; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ time_string: proc (i) returns (char (24)); dcl string char (24), i fixed bin; call date_time_$fstime ((rvl.time (i)), string); return (string); end time_string; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ finish_: proc; if iocbp ^= null then call detach; if tp (1) ^= null then do; call hcs_$truncate_seg (objectp, 0, ignore); /* clean up our 256K segs */ call hcs_$truncate_seg (input_buffer_ptr, 0, ignore); call hcs_$set_max_length_seg (objectp, (sys_info$max_seg_size), ignore); call hcs_$set_max_length_seg (input_buffer_ptr, (sys_info$max_seg_size), ignore); call release_temp_segments_ (myname, tp, ignore); call hcs_$set_256K_switch (old_256K_switch, (""b), ignore); end; if get_group_id_ () ^= "Initializer.SysDaemon.z" & hcs_$level_get () ^= 1 then ok_to_abc = "1"b; if rvlp ^= null () then do; do i = 1 to rvl.npvs; if rvl.temp_logp (i) ^= null () then call hcs_$delentry_seg (rvl.temp_logp (i), (0)); if rvl.new_logp (i) ^= null then do; if ok_to_abc then call adjust_bit_count_ (wdir_ (), (rvl.ename (i)), "0"b, (0), ignore); call hcs_$terminate_noname (rvl.new_logp (i), ignore); end; call ioa_ ("Volume log ^a ^[recovered from tape volume ^a, dump time ^a^;not recovered^s^s ^]", rvl.pvname (i), (rvl.volog_found (i)), rvl.volname (i), time_string (i)); end; free rvl; end; end finish_; %page; %include backup_volume_log; %include backup_pvol_info; %page; %include fs_vol_label; %page; %include backup_volume_record; %include backup_volume_header; %include backup_static_variables; %page; %include vtoce; %page; %include query_info; %page; %include iox_dcls; %page; %include iox_modes; %page; %include system_constants; end recover_volume_log; 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